×undefined«Œ÷Ys³/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* dict5cvt.p - convert V5 .df into V6 .df */
/*
  user_env[1] = V5 .df file name (source)
  user_env[2] = V6 .df file name (destination)
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE ddl    AS CHARACTER EXTENT 30 NO-UNDO.
DEFINE VARIABLE flag   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE x-file AS CHARACTER           NO-UNDO.
DEFINE VARIABLE x-temp AS CHARACTER           NO-UNDO.
DEFINE VARIABLE err    AS LOGICAL                    NO-UNDO INITIAL FALSE.

DEFINE WORKFILE fil NO-UNDO LIKE DICTDB._File.
DEFINE WORKFILE fld NO-UNDO LIKE DICTDB._Field.
DEFINE WORKFILE idx NO-UNDO LIKE DICTDB._Index.
DEFINE WORKFILE key NO-UNDO LIKE DICTDB._Index-field.

DEFINE STREAM olddf.
DEFINE STREAM newdf.

INPUT  STREAM olddf FROM VALUE(user_env[1]) NO-ECHO NO-MAP.
OUTPUT STREAM newdf TO   VALUE(user_env[2]) NO-ECHO NO-MAP.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 9 NO-UNDO INITIAL [
  /* 1*/ "An input record starting with",
  /* 2*/ "was read,",
  /* 3*/ "but a FILE, REN-FILE, NEW-FILE, CHG-FILE or DEL-FILE",
  /* 4*/ "record was expected.",
  /* 5*/ "Processing will be terminated.",
  /* 6*/ "But a NEW-FIELD, CHG-FIELD, REN-FIELD or DEL-FIELD",
  /* 7*/ "But an NEW-INDEX, REN-INDEX, CHG-INDEX or DEL-INDEX",
  /* 8*/ "But an INDEX-FIELD record was expected",
  /* 9*/ ".df translation completed."
].

FORM
  flag FORMAT "x(32)" LABEL " Working on table"
  WITH FRAME working 
  ROW 5 CENTERED SIDE-LABELS ATTR-SPACE USE-TEXT.
COLOR DISPLAY MESSAGES flag WITH FRAME working.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

SESSION:IMMEDIATE-DISPLAY = yes.
IF TERMINAL <> "" THEN
  run adecomm/_setcurs.p ("WAIT").

processing:
REPEAT ON ENDKEY UNDO,LEAVE:

  FOR EACH fil: DELETE fil. END.
  FOR EACH fld: DELETE fld. END.
  FOR EACH idx: DELETE idx. END.
  FOR EACH key: DELETE key. END.

  /*------------------------------------------------ file translation start */
  CREATE fil.
  IMPORT STREAM olddf
    flag           fil._File-Name  fil._Can-Create fil._Can-Read
    fil._Can-Write fil._Can-delete fil._Desc       fil._Valexp
    fil._Valmsg    fil._Frozen     fil._Hidden     fil._Db-lang.
  IF TERMINAL <> "" THEN
    DISPLAY fil._File-name @ flag WITH FRAME working.
  ddl = "".
  RUN "prodict/_dctquot.p" (fil._File-name ,'"',OUTPUT ddl[1]).
  RUN "prodict/_dctquot.p" (fil._Can-Create,'"',OUTPUT ddl[2]).
  RUN "prodict/_dctquot.p" (fil._Can-Read  ,'"',OUTPUT ddl[3]).
  RUN "prodict/_dctquot.p" (fil._Can-Write ,'"',OUTPUT ddl[4]).
  RUN "prodict/_dctquot.p" (fil._Can-Delete,'"',OUTPUT ddl[5]).
  RUN "prodict/_dctquot.p" (fil._Desc      ,'"',OUTPUT ddl[6]).
  RUN "prodict/_dctquot.p" (fil._Valexp    ,'"',OUTPUT ddl[7]).
  RUN "prodict/_dctquot.p" (fil._Valmsg    ,'"',OUTPUT ddl[8]).
  x-file = ddl[1].

  IF flag = "NEW-FILE" OR flag = "CHG-FILE" THEN DO:
    PUT STREAM newdf UNFORMATTED
      (IF flag = "NEW-FILE" THEN "ADD" ELSE "UPDATE")
        " FILE " ddl[1]
        " TYPE " (IF fil._Db-lang = 1 THEN "SQL" ELSE "PROGRESS") SKIP
      "  CAN-CREATE " ddl[2] SKIP
      "  CAN-READ   " ddl[3] SKIP
      "  CAN-WRITE  " ddl[4] SKIP
      "  CAN-DELETE " ddl[5] SKIP
      "  DESCRIPTION "  ddl[6] SKIP
      "  VALEXP " ddl[7] SKIP
      "  VALMSG " + ddl[8] SKIP.
    IF fil._Frozen THEN PUT STREAM newdf UNFORMATTED "  FROZEN" SKIP.
    IF fil._Hidden THEN PUT STREAM newdf UNFORMATTED "  HIDDEN" SKIP.
    PUT STREAM newdf UNFORMATTED SKIP(1).
  END.
  ELSE
  IF flag = "REN-FILE" THEN DO:
    PUT STREAM newdf UNFORMATTED
      "RENAME FILE " ddl[1] " TO " ddl[2] SKIP(1).
  END.
  ELSE
  IF flag = "DEL-FILE" THEN DO:
    PUT STREAM newdf UNFORMATTED
      "DROP FILE " ddl[1] SKIP(1).
    NEXT.
  END.
  ELSE
  IF flag <> "FILE" THEN DO:
    /* "An input record starting with" INPUT flag "was read," */
    /* "but a FILE, REN-FILE, NEW-FILE, CHG-FILE or DEL-FILE" */
    /* "was expected." */
    /* "Processing terminated" */
    MESSAGE new_lang[1] INPUT flag new_lang[2] SKIP
                  new_lang[3] SKIP
                  new_lang[4] SKIP
                  new_lang[5]
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    err = true.
    LEAVE processing.
  END.
  DELETE fil.
  /*-------------------------------------------------- file translation end */

  /*----------------------------------------------- field translation start */
  REPEAT ON ENDKEY UNDO,LEAVE:
    CREATE fld.
    IMPORT STREAM olddf
      flag           fld._Field-Name fld._Data-type fld._Decimals
      fld._Format    fld._Initial    fld._Label     fld._Mandatory
      fld._Order     fld._Can-Read   fld._Can-Write fld._Extent
      fld._Valexp    fld._Valmsg     fld._Help      fld._Desc
      fld._Col-label fld._Fld-case.
    IF _Data-type = "boolean" THEN _Data-type = "logical".
    IF _Data-type = "dbkey"   THEN _Data-type = "recid".

    RUN "prodict/_dctquot.p" (fld._Field-name,'"',OUTPUT ddl[ 1]).
    RUN "prodict/_dctquot.p" (fld._Desc      ,'"',OUTPUT ddl[ 2]).
    RUN "prodict/_dctquot.p" (fld._Format    ,'"',OUTPUT ddl[ 3]).
    RUN "prodict/_dctquot.p" (fld._Initial   ,'"',OUTPUT ddl[ 4]).
    RUN "prodict/_dctquot.p" (fld._Label     ,'"',OUTPUT ddl[ 5]).
    RUN "prodict/_dctquot.p" (fld._Col-label ,'"',OUTPUT ddl[ 6]).
    RUN "prodict/_dctquot.p" (fld._Can-Read  ,'"',OUTPUT ddl[ 7]).
    RUN "prodict/_dctquot.p" (fld._Can-Write ,'"',OUTPUT ddl[ 8]).
    RUN "prodict/_dctquot.p" (fld._Valexp    ,'"',OUTPUT ddl[ 9]).
    RUN "prodict/_dctquot.p" (fld._Valmsg    ,'"',OUTPUT ddl[10]).
    RUN "prodict/_dctquot.p" (fld._Help      ,'"',OUTPUT ddl[11]).
    RUN "prodict/_dctquot.p" (fld._Data-type ,'"',OUTPUT ddl[12]).

    IF flag = "NEW-FIELD" OR flag = "CHG-FIELD" THEN DO:
      PUT STREAM newdf UNFORMATTED
        (IF flag = "NEW-FIELD" THEN "ADD" ELSE "UPDATE")
          " FIELD " ddl[1]
          " OF " x-file
          " TYPE " fld._Data-type SKIP
        "  DESCRIPTION "  ddl[ 2] SKIP
        "  FORMAT "       ddl[ 3] SKIP
        "  INITIAL "      ddl[ 4] SKIP
        "  LABEL "        ddl[ 5] SKIP
        "  COLUMN-LABEL " ddl[ 6] SKIP
        "  CAN-READ  "    ddl[ 7] SKIP
        "  CAN-WRITE "    ddl[ 8] SKIP
        "  VALEXP "       ddl[ 9] SKIP
        "  VALMSG "       ddl[10] SKIP
        "  HELP "         ddl[11] SKIP
        "  ORDER "    STRING(fld._Order)    SKIP.
      IF fld._Decimals <> ? THEN PUT STREAM newdf UNFORMATTED
        "  DECIMALS " STRING(fld._Decimals) SKIP.
      IF fld._Extent > 0 THEN PUT STREAM newdf UNFORMATTED
        "  EXTENT " STRING(fld._Extent) SKIP.
      IF fld._Mandatory THEN PUT STREAM newdf UNFORMATTED
        "  MANDATORY" SKIP.
      IF fld._Fld-case THEN PUT STREAM newdf UNFORMATTED
        "  CASE-SENSITIVE" SKIP.
      PUT STREAM newdf UNFORMATTED SKIP(1).
    END.
    ELSE
    IF flag = "REN-FIELD" THEN DO:
      PUT STREAM newdf UNFORMATTED
        "RENAME FIELD " ddl[1] " TO " ddl[12] " OF " x-file SKIP(1).
    END.
    ELSE
    IF flag = "DEL-FIELD" THEN DO:
      PUT STREAM newdf UNFORMATTED
        "DROP FIELD " ddl[1] " OF " x-file SKIP(1).
    END.
    ELSE IF flag <> "FIELD" THEN DO:
      /* "An input record starting with" INPUT flag "was read," */
      /* "But a NEW-FIELD, CHG-FIELD, REN-FIELD or DEL-FIELD" */
      /* "record was expected" */
      /* "Processing terminated" */
      MESSAGE new_lang[1] INPUT flag new_lang[2] SKIP
              new_lang[6] SKIP
              new_lang[4] SKIP
              new_lang[5] 
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      err = true.
      LEAVE processing.  
    END.
    DELETE fld.
  END.
  /*------------------------------------------------- field translation end */

  /*----------------------------------------------- index translation start */
  REPEAT ON ENDKEY UNDO,LEAVE:
    CREATE idx.
    IMPORT STREAM olddf flag idx._Index-name x-temp idx._Active.
    idx._Unique = (x-temp = "yes").

    IF flag = "NEW-INDEX" OR flag = "CHG-INDEX" THEN DO:
      PUT STREAM newdf UNFORMATTED
        (IF flag = "NEW-INDEX" THEN "ADD" ELSE "UPDATE")
          (IF idx._Unique THEN " UNIQUE" ELSE "")
          (IF idx._Active THEN "" ELSE " INACTIVE")
          " INDEX ~"" idx._Index-name "~""
          " ON " x-file SKIP.
    END.
    ELSE
    IF flag = "REN-INDEX" THEN DO:
      PUT STREAM newdf UNFORMATTED
        "RENAME INDEX ~"" idx._Index-name
          "~" TO ~"" x-temp "~" ON " x-file SKIP.
    END.
    ELSE
    IF flag = "DEL-INDEX" THEN DO:
      PUT STREAM newdf UNFORMATTED
        "DROP INDEX ~"" idx._Index-name "~" ON " x-file SKIP.
    END.
    ELSE IF flag <> "INDEX" THEN DO:
      /* "An input record starting with" INPUT flag "was read," */
      /* "But an NEW-INDEX, REN-INDEX, CHG-INDEX or DEL-INDEX" */
      /* "record was expected" */
      /* "Processing terminated" */
      MESSAGE new_lang[1] INPUT flag new_lang[2] SKIP
              new_lang[7] SKIP
              new_lang[4] SKIP
              new_lang[5]
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      err = true.
      LEAVE processing.  
    END.

    IF flag = "NEW-INDEX" THEN REPEAT ON ENDKEY UNDO,LEAVE:
      CREATE key.
      IMPORT STREAM olddf flag
        key._Index-Seq x-temp key._Ascending key._Abbreviate.
      IF flag = "INDEX-FIELD" THEN DO:
        PUT STREAM newdf UNFORMATTED
          "  INDEX-FIELD ~"" x-temp "~" "
          (IF key._Ascending THEN "A" ELSE "DE") + "SCENDING"
          (IF key._Abbreviate THEN " ABBREVIATED" ELSE "") SKIP.
      END.
      ELSE DO:
        /* "An input record starting with" INPUT flag "was read," */
        /* "But an INDEX-FIELD record was expected" */
        /* "Processing terminated" */
        MESSAGE new_lang[1] INPUT flag new_lang[2] SKIP
                new_lang[8] SKIP
                       new_lang[5] 
                      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
              err = true.
               LEAVE processing.  
      END.
      DELETE key.
    END.

    DELETE idx.
    PUT STREAM newdf UNFORMATTED SKIP(1).
  END.
  /*------------------------------------------------- index translation end */

  /*---------------------------------------------- primary index flag start */
  REPEAT ON ENDKEY UNDO,LEAVE:
    IMPORT STREAM olddf flag x-temp.
    PUT STREAM newdf UNFORMATTED
      "UPDATE PRIMARY INDEX ~"" x-temp "~" ON " x-file SKIP(1).
  END.
  /*------------------------------------------------ primary index flag end */

END.

OUTPUT STREAM newdf CLOSE.
INPUT  STREAM olddf CLOSE.
IF TERMINAL <> "" THEN
  run adecomm/_setcurs.p ("").

HIDE FRAME working NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
IF TERMINAL <> "" THEN
  MESSAGE new_lang[9] VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* _dmp_raw.p - dump the value of an _Db field whose data type is RAW to 
   a .df file.  Output 16 bytes per line to make it easier for the user
   to edit the dump file if necessary (instead of outputting all bytes
   as one lonnnnng line).

   Input Parameters:
      raw_val - is the value to dump.
*/

DEFINE SHARED STREAM ddl.

DEFINE INPUT PARAMETER raw_val AS RAW NO-UNDO.

DEFINE VAR ix             AS INT NO-UNDO.
DEFINE VAR jx      AS INT NO-UNDO.
DEFINE VAR byte    AS INT NO-UNDO.

IF raw_val = ? OR LENGTH(raw_val, "raw":U) = 0 THEN 
   PUT STREAM ddl UNFORMATTED "  ?" SKIP.
ELSE DO:
   DO ix = 0 TO LENGTH(raw_val, "raw":U) - 1 BY 16:
      PUT STREAM ddl UNFORMATTED "  /*".  /* beginning of byte # comment */
      DO jx = 1 TO 16:
         IF jx = 1 THEN
            PUT STREAM ddl UNFORMATTED STRING(ix, "999") + "-" + 
                                       STRING(ix + 15, "999") + "*/  ".
         byte = GETBYTE(raw_val,ix + jx).
         PUT STREAM ddl UNFORMATTED STRING(byte, "999") " ".
      END.
      PUT STREAM ddl UNFORMATTED SKIP.
   end.
   PUT STREAM ddl UNFORMATTED SKIP.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

File: dump/_dmpasci.p 

Description:
    program to dump data in 'ascii' format

Input Parameters:
    user_env[ 1] = filename to export
    user_env[ 2] = 'where' clause
    user_env[ 3] = 'by' clause
    user_env[ 4] = output file name
    user_env[ 5] = number of fields
    user_env[ 6] = field list, comma delimited
    user_env[ 7] = ?, or filename to save generated code in
    user_env[ 8] = 'y' for first line to be field names, 'n' for no header
    user_env[ 9] = format name for message
    user_env[10] = field delimiter (e.g. quotes)
    user_env[11] = field separator (e.g. commas)
    user_env[12] = record separator (e.g. linefeeds)
    user_env[13] = record starter
    user_env[14] = "y" - disable triggers, "n" - do not disable triggers

History:
    95/07   hutegger    prepend <db>.<table> to field-names in order to
                        make generated program work with multiple-schema-
                        environement
    10/15/03 D. McMann  Add support for datetime and datetime-tz  

*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED VARIABLE totrecs AS INTEGER NO-UNDO.
DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
DEFINE VARIABLE dbfn      AS CHARACTER NO-UNDO.
DEFINE VARIABLE qual      AS CHARACTER NO-UNDO.
DEFINE VARIABLE sort      AS CHARACTER NO-UNDO.
DEFINE VARIABLE fld-sep   AS CHARACTER NO-UNDO.
DEFINE VARIABLE rec-end   AS CHARACTER NO-UNDO.
DEFINE VARIABLE rec-beg   AS CHARACTER NO-UNDO.
DEFINE VARIABLE fld-dlm   AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 2 NO-UNDO INITIAL [
  /* 1*/ "records were dumped in",
  /* 2*/ "format to"
].

FORM HEADER
   " Exporting.  Press " +
     KBLABEL("STOP") + " to terminate export process. " format "x(60)" skip(0.5)
   WITH FRAME exporting CENTERED ROW 5 USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

RUN "prodict/_dctquot.p" (INPUT user_env[10],'"',OUTPUT fld-dlm).
RUN "prodict/_dctquot.p" (INPUT user_env[11],'"',OUTPUT fld-sep).
RUN "prodict/_dctquot.p" (INPUT user_env[12],'"',OUTPUT rec-end).
RUN "prodict/_dctquot.p" (INPUT user_env[13],'"',OUTPUT rec-beg).

ASSIGN
  fld-dlm = SUBSTRING(fld-dlm,2,LENGTH(fld-dlm) - 2)
  fld-sep = SUBSTRING(fld-sep,2,LENGTH(fld-sep) - 2)
  rec-beg = SUBSTRING(rec-beg,2,LENGTH(rec-beg) - 2)
  rec-end = SUBSTRING(rec-end,2,LENGTH(rec-end) - 2)
  dbfn    = user_dbname + "." + user_env[1]
  qual    = user_env[2]
  sort    = user_env[3]
  totrecs = 0.

IF user_env[7] = ?
 THEN RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
OUTPUT TO VALUE(IF user_env[7] = ?
                 THEN tmpfile
                 ELSE user_env[7]
               ) NO-MAP.
PUT UNFORMATTED
  "DEFINE SHARED VARIABLE totrecs AS INTEGER NO-UNDO."      SKIP
  "DEFINE VARIABLE hlddt AS CHARACTER NO-UNDO. "            SKIP
  "OUTPUT TO ~"" user_env[4] "~" NO-MAP."                   SKIP
  "ASSIGN totrecs = 0."                                     SKIP.

IF user_env[14] = "y"
 THEN PUT UNFORMATTED
   "DISABLE TRIGGERS FOR DUMP OF " dbfn "."                 SKIP.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
  FIND DICTDB._File
    WHERE DICTDB._File._Db-recid  = drec_db
    AND   DICTDB._File._File-name = user_env[1]
    AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
ELSE
  FIND DICTDB._File
    WHERE DICTDB._File._Db-recid  = drec_db
    AND   DICTDB._File._File-name = user_env[1].    

IF user_env[8] = "y"
 THEN DO:

  PUT UNFORMATTED
    "PUT UNFORMATTED".

  DO i = 1 TO NUM-ENTRIES(user_env[6]): /* count_chosen */

    FIND DICTDB._Field OF DICTDB._File
      WHERE DICTDB._Field._Field-name = ENTRY(i,user_env[6]).
    PUT UNFORMATTED                                         SKIP
      "  ~""
      fld-dlm DICTDB._Field._Field-name fld-dlm
      ( IF i < INTEGER(user_env[5])
         THEN fld-sep
         ELSE rec-end
      )
      "~"".

    END.

  PUT UNFORMATTED
    "."                                                     SKIP.

  END.

PUT UNFORMATTED
  "FOR EACH " SPACE(0) dbfn                                 SKIP
  "  " qual " " sort ":"                                    SKIP
  "  ASSIGN totrecs = totrecs + 1."                         SKIP.

DO i = 1 TO NUM-ENTRIES(user_env[6]): /* count_chosen */

  FIND DICTDB._Field OF DICTDB._File
    WHERE DICTDB._Field._Field-name = ENTRY(i,user_env[6]).
  IF CAN-DO("datetime,datetime-tz",DICTDB._Field._Data-type) THEN DO:
    PUT UNFORMATTED 
      '  ASSIGN hlddt = ISO-DATE(' dbfn + "." + DICTDB._Field._Field-name ').' SKIP.
    PUT UNFORMATTED "  PUT UNFORMATTED ~"" 
      ( IF i = 1 THEN rec-beg ELSE "" ) fld-dlm "~" 
      hlddt  ~"" fld-dlm ( IF i < INTEGER(user_env[5]) THEN fld-sep ELSE rec-end )
          "~"" "."      SKIP.
  END.
  ELSE
    PUT UNFORMATTED
      "  PUT UNFORMATTED ~"" 
      ( IF i = 1
         THEN rec-beg
         ELSE ""
      )
      fld-dlm "~" "
      dbfn + "." + DICTDB._Field._Field-name
      " ~"" fld-dlm
      ( IF i < INTEGER(user_env[5])
         THEN fld-sep
         ELSE rec-end
      )
      "~"" "."                                                SKIP.
END.

PUT UNFORMATTED
  "  END."                                                  SKIP
  "OUTPUT CLOSE."                                           SKIP
  "RETURN."                                                 SKIP.

OUTPUT CLOSE.

IF user_env[7] = ?
 THEN DO:
  SESSION:IMMEDIATE-DISPLAY = yes.
  VIEW FRAME exporting.
  run adecomm/_setcurs.p ("WAIT").

  DO ON STOP UNDO, LEAVE:
    RUN VALUE(tmpfile).
    END.

  HIDE FRAME exporting NO-PAUSE.
  SESSION:IMMEDIATE-DISPLAY = no.
  run adecomm/_setcurs.p ("").

  MESSAGE totrecs new_lang[1] user_env[9] new_lang[2] user_env[4]
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  OS-DELETE VALUE(tmpfile).
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dmpbulk.p - Make .fd file for _proutil -C bulkload 

   D. McMann 04/09/03 Added logic for LOB Directory
   fernando  12/12/07 Handle large list of tables.

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE isCpUndefined AS LOGICAL NO-UNDO.
DEFINE VARIABLE i             AS INT     NO-UNDO.
DEFINE VARIABLE j             AS INT     NO-UNDO.
DEFINE VARIABLE l             AS LOGICAL NO-UNDO.

DEFINE TEMP-TABLE ttNames NO-UNDO
    FIELD NAME AS CHAR
    INDEX NAME NAME.

DEFINE STREAM bulk.

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

/* copy items from the list of tables to work with to temp-table */
/* this is to handle a long list of table names */
IF user_filename = "SOME" THEN DO:
    IF NOT isCpUndefined AND user_env[1] = "" THEN DO:
        ASSIGN l = YES
               j = NUM-ENTRIES(user_longchar).
    END.
    ELSE
        j = NUM-ENTRIES(user_env[1]).
    
    REPEAT i = 1 TO j.
        CREATE ttNames.
        ttNames.NAME = (IF l THEN ENTRY(i,user_longchar) ELSE ENTRY(i,user_env[1])).
        RELEASE ttNames.
    END.
END.

IF TERMINAL <> "" THEN 
  run adecomm/_setcurs.p ("WAIT").
OUTPUT STREAM bulk TO VALUE(user_env[2]) NO-MAP.

PUT STREAM bulk UNFORMATTED
  "# Database:  " PDBNAME("DICTDB") SKIP
  "# Date/Time: " STRING(YEAR(TODAY),"9999")
    "/" STRING(MONTH(TODAY),"99")
    "/" STRING(DAY(TODAY),"99")
    "-" STRING(TIME,"HH:MM:SS") SKIP.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
  FOR EACH _File
    WHERE _File._Db-recid = drec_db
      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
      AND (IF user_filename = "ALL" THEN
            _File._File-number > 0 AND
             _File._Tbl-Type <> "V"
           ELSE
            IF user_filename NE "SOME" THEN
               RECID(_File) = drec_file
            ELSE TRUE )
    BREAK BY _File._File-num:

    /* check if this is not a table we want. Can't use LONGCHAR in where clause
       or CAN-DO. That's why I am using a temp-table here.
    */
    IF user_filename = "SOME" AND 
       NOT CAN-FIND(FIRST ttNames WHERE ttNames.NAME = _File._File-name) THEN 
       NEXT.

    HIDE MESSAGE NO-PAUSE.
    IF TERMINAL <> "" THEN MESSAGE "Working on" _File._File-name.
    IF CAN-FIND(FIRST _Field OF _File WHERE _Field._Data-type = "BLOB" OR
                                            _Field._Data-type = "CLOB") THEN
      PUT STREAM bulk UNFORMATTED
        _File._File-name " "
        (IF _File._Dump-name = ? THEN _File._File-name ELSE _File._Dump-name) ".d "
        (IF _File._Dump-name = ? THEN _File._File-name ELSE _File._Dump-name) ".e "
        user_env[30]
        SKIP.
    ELSE
       PUT STREAM bulk UNFORMATTED
        _File._File-name " "
        (IF _File._Dump-name = ? THEN _File._File-name ELSE _File._Dump-name) ".d "
        (IF _File._Dump-name = ? THEN _File._File-name ELSE _File._Dump-name) ".e"
        SKIP.


    FOR EACH _Field OF _File BY _Field._Order:
      IF _sys-field OR _Data-type = "recid" THEN NEXT.
      PUT STREAM bulk UNFORMATTED "  " _Field-name SKIP.
    END.

    IF NOT LAST(_File._File-num) THEN
      PUT STREAM bulk UNFORMATTED "." SKIP.

END. /* for each _file in V9 */
ELSE  
   FOR EACH _File
    WHERE _File._Db-recid = drec_db
      AND (IF user_filename = "ALL" THEN
            _File._File-number > 0 AND
             _File._Tbl-Type <> "V"
           ELSE
            IF user_filename = "SOME" THEN
              CAN-DO(user_env[1],_File._File-name)
            ELSE
             RECID(_File) = drec_file)
    BREAK BY _File._File-num:

    HIDE MESSAGE NO-PAUSE.
    IF TERMINAL <> "" THEN MESSAGE "Working on" _File._File-name.

    PUT STREAM bulk UNFORMATTED
      _File._File-name " "
      (IF _File._Dump-name = ? THEN _File._File-name ELSE _File._Dump-name) ".d "
      (IF _File._Dump-name = ? THEN _File._File-name ELSE _File._Dump-name) ".e"
      SKIP.

    FOR EACH _Field OF _File BY _Field._Order:
      IF _sys-field OR _Data-type = "recid" THEN NEXT.
      PUT STREAM bulk UNFORMATTED "  " _Field-name SKIP.
    END.

    IF NOT LAST(_File._File-num) THEN
      PUT STREAM bulk UNFORMATTED "." SKIP.

  END. /* for each _file in version < 9 */

ASSIGN user_env[1] = "".
IF NOT isCpUndefined THEN
    user_longchar = "".

PUT STREAM bulk UNFORMATTED "# end-of-file" SKIP.
OUTPUT STREAM bulk CLOSE.
IF TERMINAL <> "" THEN 
  run adecomm/_setcurs.p ("").

IF TERMINAL <> "" THEN
  MESSAGE "Making of bulk load description file completed."
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

RETURN.
/*********************************************************************
* Copyright (C) 2007,2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dmpdata.p */ /**** Data Dictionary dump contents module ****/ 

/*
input:
  user_env[1] = comma-sep list of filenames to dump
                or it may be in user_longchar, if list was too big.
  user_env[2] = directory (if >1 file in user_env[1]) or filename to dump into
  user_env[3] = "MAP <name>" or "NO-MAP" OR ""
  user_env[4] = comma separated list of table numbers for table that we should not
                disable trigger for when the dump is done. All other tables will
                have triggers disabled by default.
                We may still get called with the old method if called from an
                old dumpo_d.p. For the old method:
                comma separated list of "y" (yes) or "n" (no) which
                      corresponds to file list in user_env[1], indicating for each,
                             whether triggers should be disabled when the dump is done.
  user_env[5] = "<internal defaults apply>" or "<target-code-page>"
  user_env[6] = "no-alert-boxes" or something else

History:
    Mario B     99/06/15    support for -numsep -numdec parameters
    hutegger    95/01/24    single-files in multiple schemas
    hutegger    94/02/22    added code-page-stuff
    D. McMann   02/03/03    Added lob directory
    K. McIntosh Apr 25, 2005  Added Auditing Support.
    K. McIntosh Jul 11, 2005  Changed logic to rule out just the 
                              tables that begin with "_aud" 20050711-026. 
    K. McIntosh Oct 19, 2005  Insert a slash between the directory and filename
                              just in case there isn't one already 20050928-004.
    fernando    Nov 03, 2005  Added code to audit dump operation                          
    fernando    Mar 14, 2006  Handle case with too many tables selected - bug 20050930-006. 
    fernando    Jun 19, 2007  Support for large files
    fernando    Dec 12, 2007  Improved how we use user_env[4].
    rkamboj 	11/11/2011 Fixed issue of dump data for Lob field. bug OE00214956.
*/
/*h-*/

using Progress.Lang.*.

/* ensure that errors from directory functions are thrown   
   this also allows us to use errorHandler 
   this does not affect _runload.i whihc does not throw, bit handles all error   
*/ 
routine-level on error undo, throw.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED STREAM   dump.
DEFINE NEW SHARED VARIABLE recs AS DECIMAL FORMAT ">>>>>>>>>>>>9" NO-UNDO.
 
DEFINE VARIABLE cerr        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE cntr        AS INTEGER   NO-UNDO.
DEFINE VARIABLE fil         AS CHARACTER NO-UNDO.
DEFINE VARIABLE loop        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE addfilename AS LOGICAL   NO-UNDO.
DEFINE VARIABLE mdy         AS CHARACTER NO-UNDO.
DEFINE VARIABLE msg         AS CHARACTER NO-UNDO.
DEFINE VARIABLE stamp       AS CHARACTER NO-UNDO.
DEFINE VARIABLE tableexpression       AS CHARACTER NO-UNDO.
define variable exceptfields as character no-undo.
DEFINE VARIABLE yy          AS INTEGER   NO-UNDO.
DEFINE VARIABLE stopped     AS LOGICAL   NO-UNDO init true.
DEFINE VARIABLE CodeOut     AS CHARACTER NO-UNDO.
DEFINE VARIABLE lobdir      AS CHARACTER NO-UNDO.
DEFINE VARIABLE cTemp       AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cSlash      AS CHARACTER   NO-UNDO.
 
DEFINE VARIABLE phdbname    AS CHARACTER   NO-UNDO.

DEFINE VARIABLE numCount  AS INTEGER      NO-UNDO.
DEFINE VARIABLE ix        AS INTEGER      NO-UNDO.
DEFINE VARIABLE ilast     AS INTEGER      NO-UNDO.
DEFINE VARIABLE has_lchar AS LOGICAL      NO-UNDO.
DEFINE VARIABLE has_aud   AS LOGICAL      NO-UNDO.
DEFINE VARIABLE isCpUndefined AS LOGICAL  NO-UNDO.
DEFINE VARIABLE cRecords  AS CHARACTER    NO-UNDO.
DEFINE VARIABLE dis_trig     AS CHARACTER NO-UNDO.
DEFINE VARIABLE old_dis_trig AS LOGICAL   NO-UNDO.
define variable isSuperTenant as logical no-undo. 
define variable cGroupName     as char     no-undo.
define variable lSkipCodePageValidation  as logical no-undo.
define variable xUseDefault    as character no-undo init "<default>".
DEFINE VARIABLE cMsg          AS CHARACTER NO-UNDO.
define variable lImmediatedisp as logical no-undo.
define variable xDumpTerminatedMsg as character no-undo init "Dump terminated.".

FORM
  DICTDB._File._File-name FORMAT "x(32)" LABEL "Table"  
  SPACE(0) fil            FORMAT "x(32)" LABEL "Dump File" SPACE(0)
  msg                     FORMAT "x(13)"  LABEL "Records" 
  HEADER 
    " Dumping Data.   Press " + 
    KBLABEL("STOP") + " to terminate the dump process." format "x(66)" SKIP(1)
  WITH FRAME dumpdata NO-ATTR-SPACE USE-TEXT SCROLLABLE
  SCREEN-LINES - 8 DOWN ROW 2 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN THREE-D &ENDIF.


/*--------------------------- FUNCTIONS  --------------------------*/
function validDirectory returns logical ( cValue as char):
  
    IF cValue <> "" THEN 
    DO:
        /* not a propath search - use logic blank is default 
          - the directory is currently used as-is in output to and os-create
          
           */ 
        if not (cValue begins "/" or cvalue begins "~\" or index(cValue,":") <> 0) then
            cValue = "./" + cValue.  
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        return SUBSTRING(FILE-INFO:FILE-TYPE,1,1) = "D".
    END.
        
    return true.
 
end function. /* validDirectory */

function createDirectoryIf returns logical ( cdirname as char):
    define variable iStat as integer no-undo.
    if not validdirectory(cdirname) then
    do:
        OS-CREATE-DIR VALUE(cdirname). 
        iStat = OS-ERROR. 
        if iStat <> 0 then
            undo, throw new AppError(xDumpTerminatedMsg + " Cannot create directory " + cdirname + ". System error:" + string(iStat),?).
    end.
    return true.
end function. /* createDirectoryIf */


IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  cSlash = "/".
&ELSE 
  cSlash = "~\".
&ENDIF
 
IF NOT isCpUndefined THEN 
DO:

  IF user_longchar <> "" AND user_longchar <> ? THEN
     ASSIGN has_lchar = TRUE.

/* The only Audit table that can be dumped through this program is the
   _audit-event table, so we remove it from the templist and check for 
   instances of the _aud string in the table list. */

/* let's use a longchar in case the string is too big, and because
   the code below can be generic 
*/

   IF NOT has_lchar THEN
   do:
      user_longchar = user_env[1].
      has_lchar = true.
   end.   
END.

IF (isCpUndefined AND user_env[1] NE "" AND user_env[1] NE ?)
   OR ((NOT isCpUndefined) AND (user_longchar NE "" AND user_longchar NE ?)) THEN 
DO:

   ASSIGN ix = (IF isCpUndefined 
                THEN INDEX(user_env[1],",_aud")
                ELSE INDEX(user_longchar,",_aud")).

   IF user_env[9] = "e" THEN DO:

       ASSIGN iLast = (IF isCpUndefined 
                       THEN INDEX(user_env[1],"_aud-event")
                       ELSE INDEX(user_longchar,"_aud-event")).

       /* check if there is another aud table other than _aud-event */
        IF iLast NE 0 AND ix NE 0 AND ix = (iLast - 1) THEN
           ix = (IF isCpUndefined 
                 THEN INDEX(user_env[1],",_aud",ix + 1) 
                 ELSE INDEX(user_longchar,",_aud",ix + 1)).
   END.
   
   IF ix NE 0 THEN DO:
      IF NOT isCpUndefined AND NOT user_longchar BEGINS "_aud" THEN
         has_aud = TRUE.

      IF isCpUndefined AND NOT user_env[1] BEGINS "_aud" THEN
         has_aud = TRUE.
   END.
END.

/* free longchar if we don't need it */
IF NOT isCpUndefined AND NOT has_lchar THEN
   user_longchar = ?.

IF has_aud = TRUE THEN DO:
    cMsg =  "Dump Failed!" + "~n" +
        "You cannot dump Audit Policies or Data through this utility!" . 
    
    if user_env[6] NE "dump-silent" then
        MESSAGE cMsg
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     else 
          undo, throw new AppError(cMsg).
  RETURN.
END.

IF NOT CONNECTED(user_dbname) THEN 
DO:
   cMsg =  "Database " + user_dbname +
        "is not connected!" . 
   if user_env[6] NE "dump-silent" then
      MESSAGE cMsg
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
   else 
      undo, throw new AppError(cMsg).     
    RETURN.
END.     

/* don't display frame */
if user_env[6] NE "dump-silent" then 
do:
  PAUSE 0.
  lImmediatedisp = SESSION:IMMEDIATE-DISPLAY.
  SESSION:IMMEDIATE-DISPLAY = yes.
  VIEW FRAME dumpdata.
  run adecomm/_setcurs.p ("WAIT").
end.

/* check if we are supposed to skip the code page vaidation. 
   this is signaled by adding a skip in front of the actual code page.. 
   hacky, but what can you do with this code.   
   When silent we cannot have the message box appearing, so the code page check 
   throws an error instead of continuing. This setting allows us to bypass the 
   check. Typically set from UI after the error has occured first time . */  
if user_env[5] begins "skip-" then
do:
    lSkipCodePageValidation = true.
    user_env[5] =  substr(user_env[5],6).
    if user_env[5] = '?' then  user_env[5] = ?.
end.    

IF user_env[5] = " " OR user_env[5] = ?  THEN 
    assign user_env[5] = "<internal defaults apply>".

/* Used in numformat output */
CodeOut = IF user_env[5] = "<internal defaults apply>" 
          THEN SESSION:CPINTERNAL
	      ELSE user_env[5].

RUN "prodict/_dctyear.p" (OUTPUT mdy,OUTPUT yy).

ASSIGN
  phDbName = PDBNAME("DICTDB") /* for logging audit event */
  cntr = 0
  addfilename = (IF has_lchar THEN INDEX(user_longchar,",") > 0 ELSE INDEX(user_env[1],",") > 0)
                or
                user_env[2] = ""
                or
                user_env[2] = "."
                or
                user_env[2] matches "*/" 
                or 
                user_env[2] matches "*~~~\". 
  
  loop = TRUE. /* use this to mark initial entry into loop */

PAUSE 5 BEFORE-HIDE.

IF has_lchar THEN
   numCount = NUM-ENTRIES(user_longchar).
ELSE
   numCount = NUM-ENTRIES(user_env[1]).

/* it user_env[5] has the old format, remember this */
/* this is just in case someone is using an old version of dump_d.p */
IF ENTRY(1, user_env[4]) = "y" OR ENTRY(1, user_env[4]) = "n" THEN
  ASSIGN old_dis_trig = YES.

if int(dbversion("dictdb")) > 10 then
do:
    isSuperTenant = can-find(first dictdb._tenant) and tenant-id("dictdb") < 0.
   
    /* if tenant was explicitly set by the tool then verify that it still matches
       the effective tenant also set there.
       The UI sets this and dump_d.p sets this when setEffectiveTenant is used 
       It is allowed to set-effective-tenant before running dump_d though (user_env[32]).
      */
    if isSuperTenant
    and user_env[32] <> ""
    and user_env[32] <> get-effective-tenant-name("dictdb") then
    do:
        cMsg =  "Dump Aborted!" + "~n" +
        "The ABL get-effective-tenant-name returns"  + quoter(get-effective-tenant-name("dictdb")) + 
        "while the effective tenant that was last selected in the Data Administration dump dialog or utility is" + quoter(user_env[32]).
        if user_env[6] NE "dump-silent" then   
            MESSAGE cMsg
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        else
            undo, throw new AppError(cMsg).
        RETURN.
    end.
    
end.

if addfilename then
do: 
   if not validDirectory(user_env[2]) then 
   do:
       cMsg = xDumpTerminatedMsg + " Directory " + user_env[2] + " does not exist.".
       if user_env[6] NE "dump-silent" then   
           message cMsg
               view-as alert-box error buttons ok.
       else
           undo, throw new AppError(cMsg).
   end.
end.
 
DO ON STOP UNDO, LEAVE:
    /* if not specifically skippng this check and not the no-convert case, 
       check utf-8 case  */
    IF not lSkipCodePageValidation 
    and user_env[5] NE "<internal defaults apply>" THEN 
    DO:
        FIND FIRST DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.
        IF DICTDB._Db._db-xl-name = "UTF-8" 
        AND (SESSION:CHARSET NE "UTF-8" OR TRIM(user_env[5]) NE "utf-8") THEN 
        DO:

            cMsg = "The database codepage is 'UTF-8' but -cpinternal and/or the codepage" + "~n" +
                   "for output is not, which can cause some data not to be dumped properly" + "~n" +
                   "if it cannot be represented in that codepage." + "~n" +
                   "It's recommended that you dump the data from a session with the 'UTF-8'" + "~n" +
                   "codepage to avoid possible data corruption.".
            if user_env[6] = "dump-silent" then 
            do:    
                undo, throw new AppError(cMsg).
            END.
            else if user_env[6] = "no-alert-boxes" then 
            do:  /* output WITHOUT alert-box */
                MESSAGE cMsg.
            END.
            ELSE DO:
                MESSAGE cMsg
                    VIEW-AS ALERT-BOX WARNING.
            END.
        END.
    END.
  
    DO FOR DICTDB._File ix = 1 to numCount ON ERROR UNDO,NEXT:

        ASSIGN cTemp = IF has_lchar THEN ENTRY(ix,user_longchar) ELSE ENTRY(ix,user_env[1]).
    
        IF INTEGER(DBVERSION("DICTDB")) > 8 THEN 
            FIND DICTDB._File WHERE DICTDB._File._Db-recid = drec_db 
             AND DICTDB._File._File-name = cTemp 
             AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
        ELSE
            FIND DICTDB._File WHERE DICTDB._File._Db-recid = drec_db 
             AND DICTDB._File._File-name = cTemp.
            
        IF loop THEN .
        ELSE if user_env[6] NE "dump-silent"  then 
        do:
            if FRAME-LINE(dumpdata) = FRAME-DOWN(dumpdata) THEN
                UP FRAME-LINE(dumpdata) - 1 WITH FRAME dumpdata.
            ELSE
                DOWN 1 WITH FRAME dumpdata.
        end.
    
        /* if super tenant or use default    */ 
        if user_env[32] > "" 
        and (issupertenant or user_env[33] = xUseDefault) 
        and int(dbversion("dictdb")) > 10 
        and dictdb._file._file-attributes[1] 
        and addfilename then
        do:  
            cgroupName = "".
            if user_env[37] > "" then
                run GetGroupName(user_env[32],dictdb._file._file-number,OUTPUT cgroupname).
            
            if cgroupName > "" then
            do:
                /* use default then [37] is a subdir name to append to root */
                if user_env[33] = xUseDefault then
                do:
                    if index(user_env[2],"/") > 0 then
                        cSlash = "/". 
                    fil = (IF user_env[2] EQ "" OR user_env[2] EQ "." 
                           THEN ""
                           ELSE RIGHT-TRIM(user_env[2],cSlash) + cSlash) 
                        +  user_env[37]. 
                    /* create the groups directory if necessary */    
                    createDirectoryIf(fil). 
                    /* add group name */
                    fil = fil 
                        + cSlash
                        + cGroupName 
                        + cSlash.
                    /* create the group name directory if necessary */    
                    createDirectoryIf(fil). 
                end.
                else do:
                    if index(user_env[37],"/") > 0 then
                        cSlash = "/". 
                    /* add group name to groupdir */
                    fil = (IF user_env[37] EQ "." THEN ""
                           ELSE RIGHT-TRIM(user_env[37],cSlash) + cSlash)
                        + cgroupName 
                        + cSlash. 
                end.
                /* deal with lob dir */
                if user_env[33] = xUseDefault then
                do:
                    if user_env[40] > "" then
                    do:
                        lobdir = user_env[40].
                        /* create the group name lob directory if necessary */    
                        createDirectoryIf(fil + lobdir). 
                    end.
                    else 
                        lobdir = "".
                end.
                /** somewhat questionable -
                   use tenant lob dir to check 
                   currently no var for group lob dir 
                   unless usedefault */
                else if user_env[34] > "" then 
                    lobdir = "lobs".
                else
                    lobdir = "".
            end. /* cgroupName */
            else do: /* no group = tenant dump */   
                /* if use default use dir named from tenant create if necessary */ 
                if user_env[33] = xUseDefault then
                do:
                    if index(user_env[2],"/") > 0 then
                        cSlash = "/". 
                    fil = (IF user_env[2] EQ "" OR user_env[2] EQ "." 
                           THEN ""
                           ELSE RIGHT-TRIM(user_env[2],cSlash) + cSlash) 
                        +  user_env[32] + cslash. 
                    /* create tenant directory if necessary */
                    createDirectoryIf(fil). 
                end. 
                else do:   
                    if index(user_env[33],"/") > 0 then
                        cSlash = "/". 
                     
                    fil = (IF user_env[33] EQ "" OR user_env[33] EQ "." THEN ""
                           ELSE RIGHT-TRIM(user_env[33],cSlash) + cSlash).
                end.
                
                /* deal with lob dir */
                if user_env[33] = xUseDefault then
                do:
                    if user_env[40] > "" then
                    do:
                        lobdir = user_env[40].
                        /* create tenant lob directory if necessary */
                        createDirectoryIf(fil + lobdir). 
                    end.
                    else 
                        lobdir = "".
                end.
                else if user_env[34] > "" THEN
                    lobdir = user_env[34].
                ELSE
                    lobdir = "".
            end.
            if addfilename then
               fil = fil             
                   + ( IF DICTDB._File._Dump-name = ?
                       THEN DICTDB._File._File-name
                       ELSE DICTDB._File._Dump-name
                      ) + ".d".         
             if valid-object(dictMonitor) then
             do: 
                 if cGroupName > "" then         
                    dictMonitor:StartTable(dictdb._file._file-name,"Group",cGroupName,fil).          
                 else 
                    dictMonitor:StartTable(dictdb._file._file-name,"Tenant",user_env[32],fil).          
             end. 
        end.
        else do:
            if index(user_env[2],"/") > 0 then
                cSlash = "/". 
            /* don't add file yet as we need the path to 
               add lob directory */    
            if addfilename then
                fil = (IF user_env[2] EQ "" OR user_env[2] EQ "." 
                       THEN ""
                       ELSE RIGHT-TRIM(user_env[2],cSlash) + cSlash). 
            else
                fil = user_env[2].
            
            if user_env[33] = xUseDefault then
            do:
                if user_env[40] > "" then
                do:
                    if not addfilename then
                    do:
                        /* this should not happen.. 
                        _usrdump passes root-only also for single table 
                        in this case, but it is conceivable that 
                        we could get here with some combination of dump_d params  */
                        undo, throw new apperror("Cannot dump lobs using default location if directory is specified with file-name").
                    end.    
                    lobdir = user_env[40].
                    /* create lob directory if necessary */
                    createDirectoryIf(fil + lobdir). 
                end.
                else 
                    lobdir = "".
            end.
            else if user_env[30] > "" then 
                lobdir = user_env[30].
            else 
                lobdir = "".  
            
            IF addfilename then
                fil = fil 
                    + (IF DICTDB._File._Dump-name = ?
                       THEN DICTDB._File._File-name
                       ELSE DICTDB._File._Dump-name) + ".d".
        
            if valid-object(dictMonitor) then
                dictMonitor:StartTable(dictdb._file._file-name,"Shared","",fil).          
      
        end.        
        assign
            loop = FALSE
            recs = 0.
   
        if user_env[6] NE "dump-silent" then 
        do: 
            DISPLAY DICTDB._File._File-name fil "Dumping" @ msg WITH FRAME dumpdata.
            COLOR DISPLAY MESSAGES DICTDB._File._File-name fil msg WITH FRAME dumpdata.
        end.
        ASSIGN
            stamp = STRING(YEAR( TODAY),"9999") + "/"
                  + STRING(MONTH(TODAY),"99"  ) + "/"
                  + STRING(DAY(  TODAY),"99"  ) + "-"
                  + STRING(TIME,"HH:MM:SS")
            cerr  = TRUE
            exceptfields = ""
            tableexpression = " NO-LOCK".
        
        IF DICTDB._File._Prime-Index <> ? AND user_dbtype = "PROGRESS" THEN 
        DO:
            FIND DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._File._Prime-Index.
            IF NOT DICTDB._Index._Active THEN 
            DO:
                FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Active NO-ERROR.
                IF NOT AVAILABLE DICTDB._Index THEN 
                DO:
                    cMsg = "Cannot dump {&PRO_DISPLAY_NAME} data when all indexes for a table are inactive.".
                    if user_env[6] NE "dump-silent" then 
                    do:
                        DISPLAY "Error!" @ msg WITH FRAME dumpdata.
                        COLOR DISPLAY NORMAL DICTDB._File._File-name fil msg WITH FRAME dumpdata.
                        MESSAGE cMsg.
                    end.
                    else
                        undo, throw new AppError(cMsg).
                    NEXT.
                END.
                tableexpression = "USE-INDEX " + DICTDB._Index._Index-name + tableexpression.
            END.
        END.
        if dictdb._file._file-name = "_user" then
        do:
            exceptfields = "EXCEPT _Tenantid".  
        end.    
        else if dictdb._file._file-name = "_sec-authentication-domain" then
        do:
/*             tableexpression = "WHERE DICTDB2._sec-authentication-domain._Domain-category = 0 " + tableexpression.*/
               exceptfields = "EXCEPT _Domain-id".
        end.
/*        else if dictdb._file._file-name = "_sec-authentication-system" then                                                     */
/*        do:                                                                                                                     */
/*             tableexpression = "WHERE (DICTDB2._sec-authentication-system._domain-type begins '_') = false "  + tableexpression.*/
/*        end.                                                                                                                    */
               
        DO ON ERROR UNDO,LEAVE:      /* code-page-stuf <hutegger> 94/02 */
            IF user_env[3] = "" OR user_env[3] = "NO-MAP" THEN 
            DO:
                IF user_env[5] = "<internal defaults apply>" THEN 
                DO:
                    IF lobdir <> "" THEN
                        OUTPUT STREAM dump TO VALUE(fil) LOB-DIR VALUE(lobdir)
                            NO-ECHO NO-MAP NO-CONVERT.
                    ELSE
                        OUTPUT STREAM dump TO VALUE(fil) 
                            NO-ECHO NO-MAP NO-CONVERT.
                END.
                ELSE DO:
                    IF lobdir <> "" THEN
                        OUTPUT STREAM dump TO VALUE(fil) LOB-DIR VALUE(lobdir) NO-ECHO NO-MAP
                            CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].
                    ELSE 
                        OUTPUT STREAM dump TO VALUE(fil) NO-ECHO NO-MAP
                            CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].
                END.
            END.
            ELSE DO:
                IF user_env[5] = "<internal defaults apply>" THEN 
                DO:
                    IF lobdir <> "" THEN 
                        OUTPUT STREAM dump TO VALUE(fil) LOB-DIR VALUE(lobdir) NO-ECHO 
                            MAP VALUE(SUBSTRING(user_env[3],5,-1,"character"))
                            NO-CONVERT.
                    ELSE
                        OUTPUT STREAM dump TO VALUE(fil) NO-ECHO 
                            MAP VALUE(SUBSTRING(user_env[3],5,-1,"character"))
                            NO-CONVERT.
                END.
                ELSE DO:
                    IF lobdir <> "" THEN
                        OUTPUT STREAM dump TO VALUE(fil) LOB-DIR VALUE(lobdir) NO-ECHO 
                            MAP VALUE(SUBSTRING(user_env[3],5,-1,"character"))
                            CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].
                    ELSE 
                        OUTPUT STREAM dump TO VALUE(fil)  NO-ECHO 
                            MAP VALUE(SUBSTRING(user_env[3],5,-1,"character"))
                            CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].
                END.
            END.
            cerr = FALSE.
        END. 
        IF cerr THEN 
        DO:
            if user_env[6] NE "dump-silent" then 
            do:
                DISPLAY "Error!" @ msg WITH FRAME dumpdata.
                COLOR DISPLAY NORMAL DICTDB._File._File-name fil msg WITH FRAME dumpdata.
            end.
            else 
                undo, throw new AppError ("Error!").
            NEXT.
        END.
      
        CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname).
    
        /* check if we can disable triggers. List now contains just the
          table numbers for tables that we should not disable triggers for.
        */
        ASSIGN dis_trig = ENTRY(1, user_env[4]).
        IF NOT old_dis_trig THEN 
        DO:
            IF dis_trig NE "" AND dis_trig = STRING(_File._File-number) THEN
               ASSIGN dis_trig = "n".
            ELSE 
               ASSIGN dis_trig = "y".
        END.
        
        RUN "prodict/misc/_rundump.i" (INPUT dis_trig)
                    VALUE(_File._File-name) 
                    VALUE(tableexpression) 
                    VALUE(user_env[31])
                    VALUE(exceptfields).
                                           
        /* move on to the next one in the list */
        IF old_dis_trig OR (dis_trig = "n") THEN
           user_env[4] = SUBSTRING(user_env[4]
                                   ,LENGTH(ENTRY(1,user_env[4]),"character") + 2
                                   ,-1
                                   ,"character"
                                   ).
        if valid-object(dictMonitor) then
            dictMonitor:EndTable(fil,int64(recs)).                
         
        /*------------------ Trailer-INFO ------------------*/
    
        /* if value is too large to fit in format, write it as it is */
        ASSIGN cRecords = STRING(recs,"9999999999999") NO-ERROR.
        IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
            ASSIGN cRecords = STRING(recs).
        
        {prodict/dump/dmptrail.i
            &entries      = "PUT STREAM dump UNFORMATTED
                          ""filename=""   DICTDB._File._File-name SKIP
                          ""records=""    cRecords SKIP
                          ""ldbname=""    LDBNAME(user_dbname) SKIP
                          ""timestamp=""  stamp SKIP
                          ""numformat=""
                       STRING(ASC(
    		   SESSION:NUMERIC-SEPARATOR,CodeOut,SESSION:CPINTERNAL))     +
                       "",""                                                      +                   STRING(ASC(
    		   SESSION:NUMERIC-DECIMAL-POINT,CodeOut,SESSION:CPINTERNAL))
                            SKIP
                            ""dateformat="" mdy STRING(- yy) SKIP.
                        IF user_env[3] = ""NO-MAP"" THEN
                          PUT STREAM dump UNFORMATTED ""map=NO-MAP"" SKIP.
                        ELSE
                        IF user_env[3] <> """" THEN
                          PUT STREAM dump UNFORMATTED ""map=MAP:"" 
                            SUBSTRING(user_env[3],4,-1,""character"") SKIP.
                        "  
            &seek-stream  = "dump"
            &stream       = "STREAM dump"
        }  /* adds trailer with code-page-entrie to end of file */
        
        /*------------------ Trailer-INFO ------------------*/
    
        OUTPUT STREAM dump CLOSE.
        
        if user_env[6] NE "dump-silent" then 
        do:  
            COLOR DISPLAY NORMAL DICTDB._File._File-name fil msg WITH FRAME dumpdata.
            DISPLAY DICTDB._File._File-name fil WITH FRAME dumpdata.
            /* make sure value can fit in format */
            msg = STRING(recs,">>>>>>>>>>>>9") NO-ERROR.
            IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
                msg = "**********". /* too big to fit on the screen */
    
            DISPLAY msg WITH FRAME dumpdata.
        end.
        
        cntr = cntr + 1.
      
        /* audit dump of tables */
        AUDIT-CONTROL:LOG-AUDIT-EVENT(10213, 
                                      phDbName + "." +  DICTDB._File._File-name /* db-name.table-name */, 
                                      "" /* detail */).
        /* this block has on error, undo next, so handle error so we can throw in case we are running silent */
        catch e as Progress.Lang.Error :
        	run handleError(e).	
        end catch.      
    END. /* DO FOR DICTDB._File ix = 1 to numCount ON ERROR UNDO,NEXT:*/

    stopped = false.
END.  /* on stop */

if user_env[6] NE "dump-silent" then 
do:
    DO WHILE FRAME-LINE(dumpdata) < FRAME-DOWN(dumpdata):
        DOWN 1 WITH FRAME dumpdata.
        CLEAR FRAME dumpdata NO-PAUSE.
    END.
end.

run adecomm/_setcurs.p ("").
 
if user_env[6] = "dump-silent" then 
do:  /* output WITHOUT alert-box */
  IF stopped THEN
      undo, throw new AppError(xDumpTerminatedMsg).
end.      /* output WITHOUT alert-box */

else if user_env[6] = "no-alert-boxes" then 
do:  /* output WITHOUT alert-box */

  IF stopped THEN
    MESSAGE xDumpTerminatedMsg.
  ELSE
    MESSAGE "Dump of database contents completed:" 
                    cntr "table(s) dumped successfully.".
end.      /* output WITHOUT alert-box */
else do:  /* output WITH alert-box */

  IF stopped THEN
      MESSAGE xDumpTerminatedMsg
                 VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  ELSE
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      MESSAGE "Dump of database contents completed:" 
                    cntr "table(s) dumped successfully.".
      pause.
   &ELSE
      MESSAGE "Dump of database contents completed:" SKIP
              cntr "table(s) dumped successfully."
              VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   &ENDIF
  
end.     /* output WITH alert-box */

RETURN.

catch e as Progress.Lang.Error :
	run handleError(e).	
end catch.

finally:
   IF NOT isCpUndefined THEN
       ASSIGN user_longchar = "".
   if user_env[6] = "dump-silent" then 
   do:
      HIDE FRAME dumpdata NO-PAUSE.
      SESSION:IMMEDIATE-DISPLAY = if lImmediatedisp <> ? then lImmediatedisp else no.
   end.
end finally.

procedure handleError:
    define input parameter pError as Progress.Lang.Error no-undo.
    define variable i as integer no-undo.
    define variable cMsg as character no-undo.
    if pError:NumMessages = 0 and type-of(pError,AppError)then 
        cmsg = cast(perror,AppError):ReturnValue.
    else  
    do i = 1 to pError:NumMessages:
        cmsg = cmsg + pError:GetMessage(i) + "~n".
    end.  
    
    if user_env[6] NE "dump-silent" then
        message cmsg
            view-as alert-box error.      
    else do:
        undo, throw new AppError(cmsg).
    end.
end.

procedure GetGroupName  :
    define input parameter pcTenant as character no-undo. 
    define input parameter piFileNumber as int no-undo. 
    define output parameter pcName as character no-undo. 
      
    find dictdb._tenant where dictdb._tenant._tenant-name = user_env[32] no-lock.   
             
    find dictdb._Partition-Set-Detail 
               where dictdb._Partition-Set-Detail._object-type = 1         
                 and dictdb._Partition-Set-Detail._object-number = piFileNumber        
                 and dictdb._Partition-Set-Detail._Tenantid = dictdb._tenant._tenantid 
                 no-lock no-error.
    if avail dictdb._Partition-Set-Detail then 
    do: 
        find dictdb._Partition-Set 
           where dictdb._Partition-Set._object-type = dictdb._Partition-Set-Detail._object-type        
             and dictdb._Partition-Set._object-number = dictdb._Partition-Set-Detail._object-number
             and dictdb._Partition-Set._PSetId = dictdb._Partition-Set-Detail._PSetId
             and dictdb._Partition-Set._PSet-Type = 1 no-lock.
          pcname = dictdb._Partition-Set._Pset-name.
    end.
end procedure.

 /***************************************************************************
* Copyright (C) 2000,2004-2011 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions                *
* contributed by participants of Possenet.                                  *
*                                                                           *
*****************************************************************************/
/* _dmpdefs.p - Dump Data Definitions for *all* DBTYPEs */
/*

history:
    fernando    04/08/09    Alternate buffer pool support
    knavneet    08/08/22    OE00170417 - Changed the dump of FOREIGN_NAME for Sequences
                            Also changed the dump for FOREIGN_OWNER for Sequences (in case of 
                            LDAP it may be quoted, so we must take care of that)
    fernando    07/18/08    Encryption support
    fernando    12/06/07    Dump collation name for DataServer schemas
    S. Watt &
    K. McIntosh 05/13/04    Installed support for dumping collation tables for UTF-8
    D. McMann   10/17/03    Add NO-LOCK statement to _Db find in support of on-line schema add
    D. McMann   07/22/03    Added CLOB information
    D. McMann   02/24/03    Added LOB support
    D. McMann   09/19/02    Change SQL-WIDTH to MAX-WIDTH
    D. McMann   08/14/02    Removed "UPDATE DATABASE ?" for all tables - On-line schema support
    D. McMann   08/08/02    Eliminated any sequences whose name begins "$" - Peer Direct
    D. McMann   00/08/17    Added _db-recid to StorageObject find 20000815029
    D. McMann   00/05/26    Changed check for shadow column for only ORACLE
    D. McMann   00/03/08    Added check for default indices for SQL tables
    D. McMann   99/03/25    Added check for phantom field so index-field is not blank
    Mario B     99/03/15    Conditionalized dump of _Field._Field-rpos using 
                            user_env[26]
    D. McMann   99/01/27    Added logic to dump _field._Width when not ?
    D. McMann   98/04/28    Added support for Oracle version 7 or 8
                            default to 7 if not in _db-misc1[3]
    D. McMann   98/04/22    Quoted Area Names
    D. McMann   98/03/31    Added logic to dump _field-rpos
    D. McMann   98/03/26    Added logic to dump Area name
    hutegger    94/05/04    special cases for old codepage-names:
                                ISO-Latin-1   =now=>  ISO8859-1
                                ISO 8859-1    =now=>  ISO8859-1
                                Codepage 850  =now=>  IBM850
    kmayur      06/21/11    Added support for constraint dump OE00195067
    rkamboj     11/30/09    Added logic to dump category field.
*/

DEFINE INPUT  PARAMETER pi_method  AS CHARACTER NO-UNDO.
DEFINE INPUT  PARAMETER pi_recid   AS RECID     NO-UNDO.
DEFINE INPUT  PARAMETER pi_DmpRpos AS CHARACTER NO-UNDO.

DEFINE VARIABLE lIsPro      AS LOGICAL    NO-UNDO.
DEFINE VARIABLE iByte1      AS INTEGER    NO-UNDO.
DEFINE VARIABLE iByte2      AS INTEGER    NO-UNDO.
DEFINE VARIABLE cODBType    AS CHARACTER  NO-UNDO. /* list of ODBC-types */
DEFINE VARIABLE cTemp       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE iCounter1   AS INTEGER    NO-UNDO.
DEFINE VARIABLE iCounter2   AS INTEGER    NO-UNDO.
DEFINE VARIABLE iLongLen    AS INTEGER    NO-UNDO.
DEFINE VARIABLE iLongOff    AS INTEGER    NO-UNDO INIT 29.   /* offset of IcuCollTable->longRules */
DEFINE VARIABLE iShortOff   AS INTEGER    NO-UNDO INIT 69.   /* offset of IcuCollTable->shortRules */
DEFINE VARIABLE cShortRules AS CHARACTER  NO-UNDO.
DEFINE VARIABLE lcLongRules AS LONGCHAR   NO-UNDO.
DEFINE VARIABLE lcLongLine  AS LONGCHAR   NO-UNDO.
DEFINE VARIABLE lpMemRules  AS MEMPTR     NO-UNDO.
DEFINE VARIABLE lpMemLine   AS MEMPTR     NO-UNDO.
DEFINE VARIABLE lError      AS LOGICAL    NO-UNDO.
define variable lNoArea     as logical no-undo.
DEFINE SHARED STREAM ddl.
DEFINE BUFFER   CON_DICTDB          FOR DICTDB._Constraint.
DEFINE BUFFER   FILE_DICTDB         FOR DICTDB._File.
DEFINE VARIABLE i             AS INTEGER               NO-UNDO.
DEFINE SHARED VARIABLE df-con AS CHARACTER EXTENT 7    NO-UNDO.
DEFINE SHARED VARIABLE dfseq  AS INTEGER  NO-UNDO.
DEFINE SHARED TEMP-TABLE df-info NO-UNDO
    FIELD df-seq  AS INTEGER
    FIELD df-line AS CHARACTER
    FIELD df-tbl  AS CHARACTER
    FIELD df-fld  AS CHARACTER
    INDEX rt-line IS PRIMARY df-seq.
    
ASSIGN
  cODBType      = {adecomm/ds_type.i
                  &direction = "ODBC"
                  &from-type = "cODBType"
                  }.
         
IF pi_method BEGINS "d" OR pi_method BEGINS "a" THEN DO: /* auto-conn records */
  /* Only output auto-connect records if current db is */
  /* Progress.  The auto-conn records themselves have a */
  /* name other than ?.  Or if given the Id of a */
  /* specific _Db record, then dump that */
  FIND _Db WHERE RECID(_Db) = pi_recid NO-LOCK.
  lIsPro = (_Db._Db-name = ?).
  FOR EACH _Db
    WHERE (lIsPro AND _Db._Db-type = "PROGRESS" AND _Db._Db-name <> ?)
      OR  (NOT lIsPro AND RECID(_Db) = pi_recid) NO-LOCK
    BY _Db._Db-name:
    PUT STREAM ddl UNFORMATTED
      "ADD DATABASE """ _Db._Db-name """ "
      "TYPE " _Db._Db-type " " SKIP.
    IF _Db._Db-addr <> ? AND _Db._Db-addr <> '' THEN DO:
      PUT STREAM ddl CONTROL "  DBNAME ".
      EXPORT STREAM ddl _Db._Db-addr.
    END.
    IF _Db._Db-comm <> ? AND _Db._Db-comm <> '' THEN DO:
      PUT STREAM ddl CONTROL "  PARAMS ".
      EXPORT STREAM ddl _Db._Db-comm.
    END.
    IF (_Db._Db-misc1[1] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC11 " _Db._Db-misc1[1] SKIP.
    IF (_Db._Db-misc1[2] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC12 " _Db._Db-misc1[2] SKIP.
      
    IF (_Db._Db-misc1[3] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC13 " _Db._Db-misc1[3] SKIP.
    ELSE IF _Db._Db-misc1[3] = ? AND _DB._DB-type = "ORACLE" THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC13 7  " SKIP.
      
    IF (_Db._Db-misc1[4] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC14 " _Db._Db-misc1[4] SKIP.
    IF (_Db._Db-misc1[5] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC15 " _Db._Db-misc1[5] SKIP.
    IF (_Db._Db-misc1[6] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC16 " _Db._Db-misc1[6] SKIP.
    IF (_Db._Db-misc1[7] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC17 " _Db._Db-misc1[7] SKIP.
    IF (_Db._Db-misc1[8] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  DB-MISC18 " _Db._Db-misc1[8] SKIP.
    IF _Db._Db-misc2[1] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DRIVER-NAME ".
      EXPORT STREAM ddl _Db._Db-misc2[1].
    END.
    IF _Db._Db-misc2[2] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DRIVER-VERS ".
      EXPORT STREAM ddl _Db._Db-misc2[2].
    END.
    IF _Db._Db-misc2[3] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  ESCAPE-CHAR ".
      EXPORT STREAM ddl _Db._Db-misc2[3].
    END.
    IF _Db._Db-misc2[4] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DRIVER-CHARS ".
      EXPORT STREAM ddl _Db._Db-misc2[4].
    END.
    IF _Db._Db-misc2[5] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DBMS-VERSION ".
      EXPORT STREAM ddl _Db._Db-misc2[5].
    END.
    IF _Db._Db-misc2[6] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DSRVR-VERSION ".
      EXPORT STREAM ddl _Db._Db-misc2[6].
    END.
    IF _Db._Db-misc2[7] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  PROGRESS-VERSION ".
      EXPORT STREAM ddl _Db._Db-misc2[7].
    END.
    IF _Db._Db-misc2[8] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DSRVR-MISC ".
      EXPORT STREAM ddl _Db._Db-misc2[8].
    END.
    PUT STREAM ddl CONTROL "  CODEPAGE-NAME ".
    CASE _Db._Db-xl-name: /* special cases for old codepage-names */
     WHEN "ISO-Latin-1"                         /* # 94-04-28-015 */
          THEN EXPORT STREAM ddl "ISO8859-1".
     WHEN "ISO 8859-1"  
          THEN EXPORT STREAM ddl "ISO8859-1".
     WHEN "Codepage 850"  
          THEN EXPORT STREAM ddl "IBM850".
     OTHERWISE EXPORT STREAM ddl _Db._Db-xl-name.
     END CASE. 

    /* for DataServer schemas, need to dump collation name too */
    IF NOT lIsPro THEN DO:
       IF _Db._Db-coll-name NE ? THEN DO:
           PUT STREAM ddl CONTROL "  COLLATION-NAME ".
           EXPORT STREAM ddl _Db._Db-coll-name.
       END.
    END.
    PUT STREAM ddl UNFORMATTED SKIP(1).
  END.
END.


/* If the user wants the collation-stuff he gets it in _tran.df. */

IF pi_method BEGINS "c" THEN DO: /* collation and conversion tables */
  FIND _Db WHERE RECID(_Db) = pi_recid NO-LOCK.
  PUT STREAM ddl UNFORMATTED "UPDATE DATABASE """ _Db._Db-name """" SKIP.
  /* _Db-collate[5] is used to store the version #.  e.g., 2.0 would be
     stored as 2 bytes, 0x0200.  We only started storing the # starting
     at 2.0, so if it's not there, the version is 1.0.
  */
  ASSIGN iByte1 = GETBYTE(_Db._Db-collate[5], 1) 
         iByte2 = GETBYTE(_Db._Db-collate[5], 2).
  IF iByte1 <> ? AND iByte1 > 0 THEN 
    cTEmp = STRING(iByte1) + "." + STRING(iByte2) + "-16".
  ELSE
    cTemp = "1.0-16".

  PUT STREAM ddl UNFORMATTED "  COLLATION-TRANSLATION-VERSION " cTemp SKIP.
  PUT STREAM ddl CONTROL "  COLLATION-NAME ".

  EXPORT STREAM ddl _Db._Db-coll-name.

  PUT STREAM ddl CONTROL "  CODEPAGE-NAME ".

  EXPORT STREAM ddl _Db._Db-xl-name.

  PUT STREAM ddl CONTROL "  INTERNAL-EXTERNAL-TRAN-TABLE ".
  PUT STREAM ddl UNFORMATTED SKIP(1).

  RUN prodict/dump/_dmp_raw.p (_Db._Db-xlate[1]).

  PUT STREAM ddl CONTROL "  EXTERNAL-INTERNAL-TRAN-TABLE ".
  PUT STREAM ddl UNFORMATTED SKIP(1).

  RUN prodict/dump/_dmp_raw.p (_Db._Db-xlate[2]).

  PUT STREAM ddl CONTROL "  CASE-INSENSITIVE-SORT ".
  PUT STREAM ddl UNFORMATTED SKIP(1).

  RUN prodict/dump/_dmp_raw.p (_Db._Db-collate[1]).

  PUT STREAM ddl CONTROL "  CASE-SENSITIVE-SORT ".
  PUT STREAM ddl UNFORMATTED SKIP(1).

  RUN prodict/dump/_dmp_raw.p (_Db._Db-collate[2]).

  PUT STREAM ddl CONTROL "  UPPERCASE-MAP ".
  PUT STREAM ddl UNFORMATTED SKIP(1).

  RUN prodict/dump/_dmp_raw.p (_Db._Db-collate[3]).

  PUT STREAM ddl CONTROL "  LOWERCASE-MAP ".
  PUT STREAM ddl UNFORMATTED SKIP(1).

  RUN prodict/dump/_dmp_raw.p (_Db._Db-collate[4]).
  
/** GIH - Temporarily removing ICU for multiple collation schema changes **
  IF iByte1 = 5 THEN ERR-BLK: DO:
    iLongLen = 0.
    DO iCounter1 = 29 TO 32:
      iLongLen = iLongLen * 256 + GET-BYTE(_Db._Db-collate[1], iCounter1).
    END.
    IF iLongLen > 0 THEN DO:
      iCounter1 = 513.
      iCounter2 = 1.

      FIND FIRST _Codepage WHERE _cp-name = _Db._Db-xl-name NO-ERROR.
      IF AVAILABLE _codepage THEN DO:
        SET-SIZE(lpMemRules) = iLongLen.
        FOR EACH _Collation WHERE _Coll-name = _Db._Db-coll-name AND 
                                  _coll-cp   = _cp-sequence BY _coll-segment:

          SET-SIZE(lpMemLine) = LENGTH(_coll-data,"RAW").
          lpMemLine = _coll-data.
          
          COPY-LOB lpMemLine STARTING AT iCounter1 TO lpMemRules OVERLAY AT iCounter2 NO-ERROR.
          IF ERROR-STATUS:ERROR THEN DO:
            lError = TRUE.
            MESSAGE "Errors were encountered when trying to dump collation rules." SKIP
                    "The .df file will not be usable."
                VIEW-AS ALERT-BOX INFO BUTTONS OK.
            LEAVE ERR-BLK.
          END.

          iCounter2 = iCounter2 + LENGTH(_coll-data, "RAW") - (iCounter1 - 1).
          iCounter1 = 1.

          SET-SIZE(lpMemLine) = 0.
        END. 
          
        COPY-LOB lpMemRules TO lcLongRules 
            CONVERT SOURCE CODEPAGE "UTF-8" TARGET CODEPAGE "UTF-8" NO-ERROR.

        IF ERROR-STATUS:ERROR THEN DO:
          lError = TRUE.
          MESSAGE "Errors were encountered when trying to dump collation rules." SKIP
                  "The .df file will not be usable."
              VIEW-AS ALERT-BOX INFO BUTTONS OK.
          LEAVE ERR-BLK.
        END.
        iLongLen = LENGTH(lcLongRules).
        iCounter1 = 0.

        PUT STREAM ddl CONTROL "  ICU-RULES ".
        PUT STREAM ddl UNFORMATTED SKIP(1).

        DO WHILE iCounter1 < iLongLen:
          lcLongLine = SUBSTRING(lcLongRules, iCounter1 + 1, 64).

          COPY-LOB lcLongLine TO lpMemLine NO-CONVERT NO-ERROR.
          IF ERROR-STATUS:ERROR THEN DO:
            lError = TRUE.
            MESSAGE "Errors were encountered when trying to dump collation rules." SKIP
                    "The .df file will not be usable."
                VIEW-AS ALERT-BOX INFO BUTTONS OK.
            LEAVE ERR-BLK.
          END.

          cShortRules = GET-STRING(lpMemLine, 1).

          PUT STREAM ddl CONTROL cShortRules.
          PUT STREAM ddl UNFORMATTED SKIP(1).

          iCounter1 = iCounter1 + LENGTH(lcLongLine).
        END.
             
      END. 
      ELSE lError = TRUE.
          
    END.
    ELSE DO:
      iCounter1 = 0.
      cShortRules = GET-STRING(_Db._Db-collate[1], iShortOff).

      SET-SIZE(lpMemRules) = LENGTH(cShortRules, "RAW").
      PUT-STRING(lpMemRules,1,LENGTH(cShortRules, "RAW")) = cShortRules.

      COPY-LOB lpMemRules TO lcLongRules 
          CONVERT SOURCE CODEPAGE "UTF-8" TARGET CODEPAGE "UTF-8" NO-ERROR.
      IF ERROR-STATUS:ERROR THEN DO:
        lError = TRUE.
        MESSAGE "Errors were encountered when trying to dump collation rules." SKIP
                "The .df file will not be usable."
            VIEW-AS ALERT-BOX INFO BUTTONS OK.
        LEAVE ERR-BLK.
      END.

      PUT STREAM ddl CONTROL "  ICU-RULES ".
      PUT STREAM ddl UNFORMATTED SKIP(1).

      iLongLen = LENGTH(lcLongRules).
      DO WHILE iCounter1 < iLongLen:
        lcLongLine = SUBSTRING(lcLongRules, iCounter1 + 1, 64).

        PUT STREAM ddl CONTROL cShortRules.
        PUT STREAM ddl UNFORMATTED SKIP(1).

        iCounter1 = iCounter1 + LENGTH(lcLongLine).
      END.
    END.
        
    PUT STREAM ddl CONTROL "  END-RULES ".
    
  END.
** GIH - End of temporarily removed code **/
  PUT STREAM ddl UNFORMATTED SKIP(1).
  IF (lError = TRUE) THEN
    PUT STREAM ddl UNFORMATTED "Bad Collation Data.  Do not proceed with LOAD." SKIP(1).
  
END.
ELSE IF pi_method BEGINS "s" THEN DO: /*-------------------------*/ /* sequences */
  FIND _Db WHERE RECID(_Db) = pi_recid NO-LOCK.
  FOR EACH _Sequence OF _Db WHERE NOT _Sequence._Seq-name BEGINS "$" NO-LOCK BY _Seq-Num:
    PUT STREAM ddl UNFORMATTED "ADD SEQUENCE """ _Sequence._Seq-Name """" SKIP.
    if (_Db._Db-type = "PROGRESS" and _Sequence._Seq-attributes[1]) then  
      PUT STREAM ddl UNFORMATTED "  MULTITENANT " _Sequence._Seq-attributes[1] SKIP.
    PUT STREAM ddl UNFORMATTED "  INITIAL " _Sequence._Seq-Init SKIP.
    PUT STREAM ddl UNFORMATTED "  INCREMENT " _Sequence._Seq-Incr SKIP.
    PUT STREAM ddl CONTROL "  CYCLE-ON-LIMIT ".
    EXPORT STREAM ddl _Sequence._Cycle-Ok.
    IF _Sequence._Seq-Min <> ? THEN
      PUT STREAM ddl UNFORMATTED "  MIN-VAL " _Sequence._Seq-Min SKIP.
    IF _Sequence._Seq-Max <> ? THEN
      PUT STREAM ddl UNFORMATTED "  MAX-VAL " _Sequence._Seq-Max SKIP.
    IF _Sequence._Seq-Misc[1] <> ?  THEN /* OE00170417: Name may be quoted */
    DO:
      PUT STREAM ddl UNFORMATTED "  FOREIGN-NAME ".
      EXPORT STREAM ddl _Sequence._Seq-Misc[1].
    END.
    IF _Sequence._Seq-Misc[2] <> ? THEN /* Owner name may be quoted in case of LDAP */
    DO:
          PUT STREAM ddl UNFORMATTED "  FOREIGN-OWNER ". 
          EXPORT STREAM ddl _Sequence._Seq-Misc[2].
    END.
    IF _Sequence._Seq-Misc[3] <> ? THEN
      PUT STREAM ddl UNFORMATTED "  SEQ-MISC3 " _Sequence._Seq-Misc[3] SKIP.
    IF _Sequence._Seq-Misc[4] <> ? THEN
      PUT STREAM ddl UNFORMATTED "  SEQ-MISC4 " _Sequence._Seq-Misc[4] SKIP.
    IF _Sequence._Seq-Misc[5] <> ? THEN
      PUT STREAM ddl UNFORMATTED "  SEQ-MISC5 " _Sequence._Seq-Misc[5] SKIP.
    IF _Sequence._Seq-Misc[6] <> ? THEN
      PUT STREAM ddl UNFORMATTED "  SEQ-MISC6 " _Sequence._Seq-Misc[6] SKIP.
    IF _Sequence._Seq-Misc[7] <> ? THEN
      PUT STREAM ddl UNFORMATTED "  SEQ-MISC7 " _Sequence._Seq-Misc[7] SKIP.
    IF _Sequence._Seq-Misc[8] <> ? THEN
      PUT STREAM ddl UNFORMATTED "  SEQ-MISC8 " _Sequence._Seq-Misc[8] SKIP.

    PUT STREAM ddl UNFORMATTED SKIP(1).
  END.
END.

ELSE

IF pi_method BEGINS "t" THEN DO: /*----------------------*/ /* table_record */
  FIND _File WHERE RECID(_File) = pi_recid NO-LOCK NO-ERROR.
  IF NOT AVAILABLE _File THEN DO:
    FIND _Field WHERE RECID(_Field) = pi_recid NO-LOCK NO-ERROR.
    IF AVAILABLE _Field THEN FIND _File OF _Field NO-LOCK.
  END.
  IF NOT AVAILABLE _File THEN DO:
    FIND _Index WHERE RECID(_Index) = pi_recid NO-LOCK NO-ERROR.
    IF AVAILABLE _Index THEN FIND _File OF _Index NO-LOCK.
  END.
  FIND _Db OF _File NO-LOCK NO-ERROR.
  IF RECID(_File) = pi_recid THEN DO:
    FIND  _StorageObject
      WHERE _StorageObject._Db-recid = RECID(_Db)
        AND _StorageObject._Object-Number = _File._File-Number 
        AND _StorageObject._Object-type = 1
        AND _Storageobject._Partitionid = 0
        NO-LOCK NO-ERROR.
    PUT STREAM ddl UNFORMATTED "ADD TABLE """ _File._File-name """".
    IF _File._Db-lang > 0 THEN
      PUT STREAM ddl UNFORMATTED SKIP "  TYPE SQL" SKIP.
    ELSE IF _Db._Db-type <> "PROGRESS"
      THEN PUT STREAM ddl UNFORMATTED "  TYPE " _Db._Db-type SKIP.
      ELSE PUT STREAM ddl UNFORMATTED skip.
    
    if (_Db._Db-type = "PROGRESS" and _File._File-attributes[1]) then  
      PUT STREAM ddl UNFORMATTED "  MULTITENANT " _File._File-attributes[1] SKIP.
    
    lNoArea = false.
  
    IF _File._File-attributes[1] AND _File._File-attributes[2] = FALSE THEN
    DO:
        PUT STREAM ddl UNFORMATTED "  NO-DEFAULT-AREA "  SKIP.    
        lNoArea = true.
    END.
    ELSE IF AVAILABLE _StorageObject THEN 
    DO:
        FIND _Area WHERE _Area._Area-number = _StorageObject._Area NO-LOCK.
        PUT STREAM ddl UNFORMATTED "  AREA """ _Area._Area-name """" SKIP.
    END. 
     /* multitenant and no keep default -   */ 
    ELSE DO: 
        FIND _Area WHERE _Area._Area-number = 6 NO-LOCK.
        PUT STREAM ddl UNFORMATTED "  AREA """ _Area._Area-name """" SKIP.
    END.  
     
    IF _File._Can-Create <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-CREATE ".
      EXPORT STREAM ddl _File._Can-Create.
    END.
    IF _File._Can-Delete <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-DELETE ".
      EXPORT STREAM ddl _File._Can-Delete.
    END.
    IF _File._Can-Read <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-READ ".
      EXPORT STREAM ddl _File._Can-Read.
    END.
    IF _File._Can-Write <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-WRITE ".
      EXPORT STREAM ddl _File._Can-Write.
    END.
    IF _File._Can-Dump <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-DUMP ".
      EXPORT STREAM ddl _File._Can-Dump.
    END.
    IF _File._Can-Load <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-LOAD ".
      EXPORT STREAM ddl _File._Can-Load.
    END.
    IF _File._File-Label <> ? AND _File._File-Label <> '' THEN DO:
      PUT STREAM ddl CONTROL "  LABEL ".
      EXPORT STREAM ddl _File._File-Label.
    END.
    IF _File._File-Label-SA <> ? AND _File._File-Label-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  LABEL-SA ".
      EXPORT STREAM ddl _File._File-Label-SA.
    END.
    IF _File._Desc <> ? AND _File._Desc <> '' THEN DO:
      PUT STREAM ddl CONTROL "  DESCRIPTION ".
      EXPORT STREAM ddl _File._Desc.
    END.
    IF _File._Valexp <> ? AND _File._Valexp <> '' THEN DO:
      PUT STREAM ddl CONTROL "  VALEXP ".
      EXPORT STREAM ddl _File._Valexp.
    END.
    IF _File._Valmsg <> ? AND _File._Valmsg <> '' THEN DO:
      PUT STREAM ddl CONTROL "  VALMSG ".
      EXPORT STREAM ddl _File._Valmsg.
    END.
    IF _File._Valmsg-SA <> ? AND _File._Valmsg-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  VALMSG-SA ".
      EXPORT STREAM ddl _File._Valmsg-SA.
    END.
    IF _File._Frozen THEN
      PUT STREAM ddl UNFORMATTED "  FROZEN" SKIP.
    IF _File._Hidden THEN
      PUT STREAM ddl UNFORMATTED "  HIDDEN" SKIP.
    IF _File._Dump-name <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DUMP-NAME ".
      EXPORT STREAM ddl _File._Dump-name.
    END.
    IF _File._For-Flag <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-FLAGS " _File._For-Flag SKIP.
    IF _File._For-Format <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-FORMAT ".
      EXPORT STREAM ddl _File._For-Format.
    END.
    IF _File._For-Cnt1 <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-GLOBAL " _File._For-Cnt1 SKIP.
    IF _File._For-Id <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-ID " _File._For-Id SKIP.
    IF _File._For-Cnt2 <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-LOCAL " _File._For-Cnt2 SKIP.
    IF _File._For-Info <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-MARK ".
      EXPORT STREAM ddl _File._For-Info.
    END.
    IF _File._For-Name <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-NAME ".
      EXPORT STREAM ddl _File._For-Name.
    END.
    IF _File._For-Number <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-NUMBER " _File._For-Number SKIP.
    IF _File._For-Owner <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-OWNER ".
      EXPORT STREAM ddl _File._For-Owner.
    END.
    IF _File._For-Size <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-SIZE " _File._For-Size SKIP.
    IF _File._For-Type <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-TYPE ".
      EXPORT STREAM ddl _File._For-Type.
    END.
    IF _File._Fil-misc1[1] <> ? THEN DO:
      IF CAN-DO("ORACLE,SYBASE," + cODBType,_Db._Db-type)
        THEN PUT STREAM ddl UNFORMATTED "  PROGRESS-RECID " _File._Fil-misc1[1] SKIP.
        ELSE PUT STREAM ddl UNFORMATTED "  FILE-MISC11 "    _File._Fil-misc1[1] SKIP.
    END.
    IF _File._Fil-misc1[2] <> ? THEN DO:
      IF CAN-DO("RMS",_Db._Db-type)
        THEN DO:
          PUT STREAM ddl CONTROL "  FOREIGN-SPAN ".
          EXPORT STREAM ddl (IF _File._Fil-misc1[2] = 1 THEN 'yes' ELSE 'no').
        END.
        ELSE PUT STREAM ddl UNFORMATTED "  FILE-MISC12 "    _File._Fil-misc1[2] SKIP.
    END.
    IF _File._Fil-misc1[3] <> ? THEN DO:
      IF CAN-DO(cODBType,_Db._Db-type)
        THEN PUT STREAM ddl UNFORMATTED "  INDEX-FREE-FLD " _File._Fil-misc1[3] SKIP.
        ELSE PUT STREAM ddl UNFORMATTED "  FILE-MISC13 "    _File._Fil-misc1[3] SKIP.
    END.
    IF (_File._Fil-misc1[4] <> ?) THEN DO:
      IF CAN-DO("ORACLE",_Db._Db-type)
        THEN PUT STREAM ddl UNFORMATTED "  RECID-COL-NO " _File._Fil-misc1[4] SKIP.
        ELSE PUT STREAM ddl UNFORMATTED "  FILE-MISC14 "  _File._Fil-misc1[4] SKIP.
    END.
    IF (_File._Fil-misc1[5] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  FILE-MISC15 " _File._Fil-misc1[5] SKIP.
    IF (_File._Fil-misc1[6] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  FILE-MISC16 " _File._Fil-misc1[6] SKIP.
    IF (_File._Fil-misc1[7] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  FILE-MISC17 " _File._Fil-misc1[7] SKIP.
    IF (_File._Fil-misc1[8] <> ?) THEN
      PUT STREAM ddl UNFORMATTED "  FILE-MISC18 " _File._Fil-misc1[8] SKIP.
    IF _File._Fil-misc2[1] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  QUALIFIER ".
      EXPORT STREAM ddl  _File._Fil-misc2[1].
    END.
    IF _File._Fil-misc2[2] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  HIDDEN-FLDS ".
      EXPORT STREAM ddl  _File._Fil-misc2[2].
    END.
    IF _File._Fil-misc2[3] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  RECID-FLD-NAME ".
      EXPORT STREAM ddl  _File._Fil-misc2[3].
    END.
    IF _File._Fil-misc2[4] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FLD-NAMES-LIST ".
      EXPORT STREAM ddl  _File._Fil-misc2[4].
    END.
    IF _File._Fil-misc2[5] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FILE-MISC25 ".
      EXPORT STREAM ddl  _File._Fil-misc2[5].
    END.
    IF _File._Fil-misc2[6] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FILE-MISC26 ".
      EXPORT STREAM ddl  _File._Fil-misc2[6].
    END.
    IF _File._Fil-misc2[7] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FILE-MISC27 ".
      EXPORT STREAM ddl  _File._Fil-misc2[7].
    END.
    IF _File._Fil-misc2[8] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  DB-LINK-NAME ".
      EXPORT STREAM ddl  _File._Fil-misc2[8].
    END.
    IF _File._category <> ? AND _File._category <> '' THEN DO:
      PUT STREAM ddl CONTROL "  CATEGORY ".
      EXPORT STREAM ddl _File._category.
    END.
    FOR EACH _File-trig OF _File NO-LOCK BY _Event:
      PUT STREAM ddl UNFORMATTED
        "  TABLE-TRIGGER """ _File-Trig._Event """ "
        (IF _File-Trig._Override THEN 'OVERRIDE' ELSE 'NO-OVERRIDE') " "
        "PROCEDURE """ _File-Trig._Proc-Name """ "
        "CRC """ _File-Trig._Trig-CRC """ " SKIP.
    END.
    PUT STREAM ddl UNFORMATTED SKIP(1).
  END.
  FOR EACH _Field OF _File NO-LOCK BY _Field-rpos:
    IF RECID(_File) <> pi_recid AND RECID(_Field) <> pi_recid THEN NEXT.
    PUT STREAM ddl UNFORMATTED
      "ADD FIELD """ _Field._Field-name """ "
      "OF """ _File._File-name """ "
      "AS " _Field._Data-type " " SKIP.
    IF _Field._Desc <> ? AND _Field._Desc <> '' THEN DO:
      PUT STREAM ddl CONTROL "  DESCRIPTION ".
      EXPORT STREAM ddl _Field._Desc.
    END.
    PUT STREAM ddl CONTROL "  FORMAT ".
    EXPORT STREAM ddl _Field._Format.
    IF _Field._Format-SA <> ? AND _Field._Format-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  FORMAT-SA ".
      EXPORT STREAM ddl _Field._Format-SA.
    END.
    PUT STREAM ddl CONTROL "  INITIAL ".
    EXPORT STREAM ddl _Field._Initial.
    IF _Field._Initial-SA <> ? AND _Field._Initial-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  INITIAL-SA ".
      EXPORT STREAM ddl _Field._Initial-SA.
    END.
    IF _Field._Label <> ? THEN DO:
      PUT STREAM ddl CONTROL "  LABEL ".
      EXPORT STREAM ddl _Field._Label.
    END.
    IF _Field._Label-SA <> ? AND _Field._Label-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  LABEL-SA ".
      EXPORT STREAM ddl _Field._Label-SA.
    END.
    IF pi_DmpRpos = "y" THEN DO:
       PUT STREAM ddl CONTROL "  POSITION ".
       EXPORT STREAM ddl _Field._Field-rpos. 
    END.
    IF _Field._Width <> ? THEN DO:
      IF _Db._Db-type = "Progress" THEN DO: 
        IF _Field._Data-type = "BLOB" OR _Field._Data-type = "CLOB" OR _Field._Data-type = "XLOB" THEN DO:
          if lNoArea = false then 
          do:         
              FIND _storageobject WHERE _Storageobject._Db-recid = RECID(_Db)
                                    AND _Storageobject._Object-type = 3
                                    AND _Storageobject._Object-number = _Field._Fld-stlen
                                    AND _Storageobject._Partitionid = 0
                                  NO-LOCK.
              FIND _Area WHERE _Area._Area-number = _StorageObject._Area-number NO-LOCK.
              PUT STREAM ddl UNFORMATTED '  LOB-AREA "' _Area._Area-name '"' SKIP.   
          end.
          PUT STREAM ddl UNFORMATTED "  LOB-BYTES " _Field._Width SKIP.
          PUT STREAM ddl UNFORMATTED "  LOB-SIZE " _Field._Fld-Misc2[1] SKIP.
        END.
        ELSE DO:
          PUT STREAM ddl CONTROL "  MAX-WIDTH ".
          EXPORT STREAM ddl _Field._Width.
        END.
      END.
      ELSE DO: /* Not a Progress Database */
        PUT STREAM ddl CONTROL "  MAX-WIDTH ".
        EXPORT STREAM ddl _Field._Width.
      END.
    END.
    IF _Field._Data-type = "CLOB" THEN DO:
        PUT STREAM ddl UNFORMATTED '  CLOB-CODEPAGE "' _Field._Charset '"' SKIP.
        PUT STREAM ddl UNFORMATTED '  CLOB-COLLATION "' _Field._Collation '"' SKIP.
        PUT STREAM ddl UNFORMATTED '  CLOB-TYPE ' _Field._Attributes1 SKIP.
    END.
    IF _Field._View-As <> ? THEN DO:
      PUT STREAM ddl CONTROL "  VIEW-AS ".
      EXPORT STREAM ddl _Field._View-As.
    END.
    IF _Field._Col-label <> ? THEN DO:
      PUT STREAM ddl CONTROL "  COLUMN-LABEL ".
      EXPORT STREAM ddl _Field._Col-label.
    END.
    IF _Field._Col-label-SA <> ? AND _Field._Col-label-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  COLUMN-LABEL-SA ".
      EXPORT STREAM ddl _Field._Col-label-SA.
    END.
    IF _Field._Can-Read <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-READ ".
      EXPORT STREAM ddl _Field._Can-Read.
    END.
    IF _Field._Can-Write <> '*' THEN DO:
      PUT STREAM ddl CONTROL "  CAN-WRITE ".
      EXPORT STREAM ddl _Field._Can-Write.
    END.
    IF _Field._Valexp <> ? AND _Field._Valexp <> '' THEN DO:
      PUT STREAM ddl CONTROL "  VALEXP ".
      EXPORT STREAM ddl _Field._Valexp.
    END.
    IF _Field._Valmsg <> ? AND _Field._Valmsg <> '' THEN DO:
      PUT STREAM ddl CONTROL "  VALMSG ".
      EXPORT STREAM ddl _Field._Valmsg.
    END.
    IF _Field._Valmsg-SA <> ? AND _Field._Valmsg-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  VALMSG-SA ".
      EXPORT STREAM ddl _Field._Valmsg-SA.
    END.
    IF _Field._Help <> ? AND _Field._Help <> '' THEN DO:
      PUT STREAM ddl CONTROL "  HELP ".
      EXPORT STREAM ddl _Field._Help.
    END.
    IF _Field._Help-SA <> ? AND _Field._Help-SA <> '' THEN DO:
      PUT STREAM ddl CONTROL "  HELP-SA ".
      EXPORT STREAM ddl _Field._Help-SA.
    END.
    IF _Field._Extent > 0 THEN
      PUT STREAM ddl UNFORMATTED "  EXTENT " _Field._Extent SKIP.
    IF _Field._Decimals <> ? AND _Field._dtype = 5 THEN
      PUT STREAM ddl UNFORMATTED "  DECIMALS " _Field._Decimals SKIP.
    IF _Field._Decimals <> ? AND _Field._dtype = 1 THEN
      PUT STREAM ddl UNFORMATTED "  LENGTH " _Field._Decimals SKIP.
    PUT STREAM ddl UNFORMATTED "  ORDER " _Field._Order SKIP.
    IF _Field._Mandatory THEN
      PUT STREAM ddl UNFORMATTED "  MANDATORY" SKIP.
    IF _Field._Fld-case THEN
      PUT STREAM ddl UNFORMATTED "  CASE-SENSITIVE" SKIP.
    IF _Field._Fld-stoff <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-POS " _Field._Fld-stoff SKIP.
    IF _Field._Fld-stlen <> ? AND _Db._Db-type <> "Progress" THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-SIZE " _Field._Fld-stlen SKIP.   
    IF _Field._Fld-stdtype = 38 AND _Db._Db-type = 'RMS' THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-BITS " _Field._Decimals SKIP.
    IF _Field._For-Itype <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-CODE " _Field._For-Itype SKIP.
    IF _Field._For-Id <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-ID " _Field._For-Id SKIP.
    IF _Field._For-Name <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-NAME ".
      EXPORT STREAM ddl _Field._For-Name.
    END.
    IF _Field._For-Retrieve <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-RETRIEVE ".
      EXPORT STREAM ddl _Field._For-Retrieve.
    END.
    IF _Field._For-Scale <> ? AND _Field._For-Scale <> 0 THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-SCALE " _Field._For-Scale SKIP.
    IF _Field._For-Spacing <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-SPACING " _Field._For-Spacing SKIP.
    IF _Field._For-Type <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-TYPE ".
      EXPORT STREAM ddl _Field._For-Type.
    END.
    IF _Field._For-xpos <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-XPOS " _Field._For-xpos SKIP.
    IF _Field._For-Separator <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-SEP ".
      EXPORT STREAM ddl _Field._For-Separator.
    END.
    IF _Field._For-Allocated <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-ALLOCATED " _Field._For-Allocated SKIP.
    IF _Field._For-Maxsize <> ? THEN
      PUT STREAM ddl UNFORMATTED "  FOREIGN-MAXIMUM " _Field._For-Maxsize SKIP.
    IF _Field._Fld-misc1[1] <> ? THEN DO:
      IF CAN-DO("ORACLE," + cODBType,_Db._Db-type) 
        THEN PUT STREAM ddl CONTROL "  DSRVR-PRECISION ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC11 ".
      EXPORT STREAM ddl _Field._Fld-misc1[1].
    END.
    IF _Field._Fld-misc1[2] <> ? THEN DO:
      IF CAN-DO(cODBType,_Db._Db-type) 
        THEN PUT STREAM ddl CONTROL "  DSRVR-SCALE ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC12 ".
      EXPORT STREAM ddl _Field._Fld-misc1[2].
    END.
    IF _Field._Fld-misc1[3] <> ? THEN DO:
      IF CAN-DO(cODBType,_Db._Db-type)
        THEN PUT STREAM ddl CONTROL "  DSRVR-LENGTH ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC13 ".
      EXPORT STREAM ddl _Field._Fld-misc1[3].
    END.
    IF _Field._Fld-misc1[4] <> ? THEN DO:
      IF CAN-DO(cODBType,_Db._Db-type)
        THEN PUT STREAM ddl CONTROL "  DSRVR-FLDMISC ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC14 ".
      EXPORT STREAM ddl _Field._Fld-misc1[4].
    END.
    IF _Field._Fld-misc1[5] <> ? THEN DO:
      IF CAN-DO(cODBType,_Db._Db-type)
        THEN PUT STREAM ddl CONTROL "  DSRVR-SHADOW ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC15 ".
      EXPORT STREAM ddl _Field._Fld-misc1[5].
    END.
    IF _Field._Fld-misc1[6] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC16 ".
      EXPORT STREAM ddl _Field._Fld-misc1[6].
    END.
    IF _Field._Fld-misc1[7] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC17 ".
      EXPORT STREAM ddl _Field._Fld-misc1[7].
    END.
    IF _Field._Fld-misc1[8] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC18 ".
      EXPORT STREAM ddl _Field._Fld-misc1[8].
    END.
    IF _Field._Fld-misc2[1] <> ? AND _Db._Db-type <> "Progress" THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC21 ".
      EXPORT STREAM ddl _Field._Fld-misc2[1].
    END.
    IF _Field._Fld-misc2[2] <> ? THEN DO:
      IF _db._Db-type = "ORACLE" THEN     
        PUT STREAM ddl CONTROL "  SHADOW-COL ".
      ELSE PUT STREAM ddl CONTROL "  FIELD-MISC22 ".
      EXPORT STREAM ddl _Field._Fld-misc2[2].
    END.
    IF _Field._Fld-misc2[3] <> ? THEN DO:
      IF CAN-DO("ORACLE,SYBASE," + cODBType,_Db._Db-type)
        THEN PUT STREAM ddl CONTROL "  QUOTED-NAME ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC23 ".
      EXPORT STREAM ddl _Field._Fld-misc2[3].
    END.
    IF _Field._Fld-misc2[4] <> ? THEN DO:
      IF CAN-DO("ORACLE,SYBASE," + cODBType,_Db._Db-type)
        THEN PUT STREAM ddl CONTROL "  MISC-PROPERTIES ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC24 ".
      EXPORT STREAM ddl _Field._Fld-misc2[4].
    END.
    IF _Field._Fld-misc2[5] <> ? THEN DO:
      IF _Db._Db-type = "ODBC"
        THEN PUT STREAM ddl CONTROL "  SHADOW-NAME ".
        ELSE PUT STREAM ddl CONTROL "  FIELD-MISC25 ".
      EXPORT STREAM ddl _Field._Fld-misc2[5].
    END.
    IF _Field._Fld-misc2[6] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC26 ".
      EXPORT STREAM ddl _Field._Fld-misc2[6].
    END.
    IF _Field._Fld-misc2[7] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC27 ".
      EXPORT STREAM ddl _Field._Fld-misc2[7].
    END.
    IF _Field._Fld-misc2[8] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FIELD-MISC28 ".
      EXPORT STREAM ddl _Field._Fld-misc2[8].
    END.
    FOR EACH _Field-trig OF _Field NO-LOCK BY _Event:
      PUT STREAM ddl UNFORMATTED
        "  FIELD-TRIGGER """ _Field-Trig._Event """ "
        (IF _Field-Trig._Override THEN 'OVERRIDE' ELSE 'NO-OVERRIDE') " "
        "PROCEDURE """ _Field-Trig._Proc-Name """ "
        "CRC """ _Field-Trig._Trig-CRC """ " SKIP.
    END.
    PUT STREAM ddl UNFORMATTED SKIP(1).
  END.

  FOR EACH _Index
    OF _File WHERE NOT _File._dft-pk OR 
       _File._Prime-Index <> RECID(_Index) NO-LOCK
    BY STRING(_File._Prime-Index = RECID(_Index),"1/2") + _Index-name:
    IF RECID(_File) <> pi_recid AND RECID(_Index) <> pi_recid THEN NEXT.
    IF _Index-name = "sql-default" THEN NEXT.
    PUT STREAM ddl UNFORMATTED
          "ADD INDEX """ _Index._Index-Name """ "
          "ON """ _File._File-name """ " SKIP.
    if lNoArea = false then 
    do:
        /* first for collation */
        FIND FIRST _StorageObject
          WHERE _StorageObject._Db-recid = _File._Db-recid
            AND _StorageObject._Object-Number = _Index._Idx-num 
            AND _StorageObject._Object-type = 2 
            AND _Storageobject._Partitionid = 0
            NO-LOCK NO-ERROR.
        IF AVAILABLE _StorageObject THEN
            FIND _Area WHERE _Area._Area-number = _StorageObject._Area NO-LOCK.
        
        ELSE
            FIND _Area WHERE _Area._Area-number = 6 NO-LOCK.
        PUT STREAM ddl UNFORMATTED "  AREA """ _Area._Area-name """" SKIP.
    end.
    IF _Index._Unique THEN
      PUT STREAM ddl UNFORMATTED "  UNIQUE" SKIP.
    IF NOT _Index._Active THEN
      PUT STREAM ddl UNFORMATTED "  INACTIVE" SKIP.
    IF _File._Prime-index = RECID(_Index) THEN
      PUT STREAM ddl UNFORMATTED "  PRIMARY" SKIP.
    IF _Index._Wordidx = 1 THEN
      PUT STREAM ddl UNFORMATTED "  WORD" SKIP.
    IF _Index._Desc <> ? AND _Index._Desc <> '' THEN DO:
      PUT STREAM ddl CONTROL "  DESCRIPTION ".
      EXPORT STREAM ddl _Index._Desc.
    END.
    IF _Index._Idx-num <> ? AND _Db._Db-type <> 'PROGRESS' THEN
      PUT STREAM ddl UNFORMATTED "  INDEX-NUM " _Index._Idx-num SKIP.
    IF _Index._For-Name <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-NAME ".
      EXPORT STREAM ddl _Index._For-Name.
    END.
    IF _Index._For-Type <> ? THEN DO:
      PUT STREAM ddl CONTROL "  FOREIGN-TYPE ".
      EXPORT STREAM ddl _Index._For-Type.
    END.
    IF _Index._I-misc2[1] <> ? THEN DO:
      PUT STREAM ddl CONTROL "  RECID-INDEX ".
      EXPORT STREAM ddl _Index._I-misc2[1].
    END.
    FOR EACH _Index-field OF _Index NO-LOCK,
      _Field OF _Index-field NO-LOCK
      BY _Index-field._Index-seq:     
      IF AVAILABLE _Field AND (_Field._Field-name <> "" AND _Field._Field-name <> ?) THEN
        PUT STREAM ddl UNFORMATTED
          "  INDEX-FIELD """ _Field._Field-Name """ "
          (IF _Index-field._Ascending THEN "ASCENDING " ELSE "")
          (IF NOT _Index-field._Ascending THEN "DESCENDING " ELSE "")
          (IF _Index-field._Abbreviate THEN "ABBREVIATED " ELSE "")
          (IF _Index-field._Unsorted THEN "UNSORTED " ELSE "") SKIP.
    END.
    PUT STREAM ddl UNFORMATTED SKIP(1).
  END.
  
  FOR EACH _constraint OF _File WHERE NOT _constraint._con-type = "F":
  IF ((_constraint._con-Status = "N" OR _constraint._con-Status = "C" OR _constraint._con-Status = "M"))
  THEN DO:
    IF RECID(_File) <> pi_recid AND RECID(_constraint) <> pi_recid THEN NEXT.
    PUT STREAM ddl UNFORMATTED
          "ADD CONSTRAINT """ _constraint._con-name """ "
          "ON """ _File._File-name """ " SKIP.
    IF _constraint._con-type = "U" THEN
      PUT STREAM ddl UNFORMATTED "  UNIQUE" SKIP.
    IF _constraint._con-type = "P" THEN
      PUT STREAM ddl UNFORMATTED "  PRIMARY" SKIP.
    IF _constraint._con-type = "PC" OR  _constraint._con-type = "MP" THEN  
      PUT STREAM ddl UNFORMATTED "  PRIMARY-CLUSTERED" SKIP.      
    IF _constraint._con-type = "C" THEN
      PUT STREAM ddl UNFORMATTED "  CHECK" SKIP.
    IF _constraint._con-type = "D" THEN
      PUT STREAM ddl UNFORMATTED "  DEFAULT" SKIP.
    IF _constraint._con-type = "M" THEN
      PUT STREAM ddl UNFORMATTED "  CLUSTERED" SKIP.
    
    IF _constraint._Con-Active = TRUE
    THEN PUT STREAM ddl UNFORMATTED "  ACTIVE" SKIP.
    ELSE PUT STREAM ddl UNFORMATTED "  INACTIVE" SKIP.
    
    FIND FIRST _Index where RECID(_Index) = _Constraint._Index-recid NO-LOCK NO-ERROR.
    FIND FIRST _Field where RECID(_Field) = _Constraint._Field-recid NO-LOCK NO-ERROR.  
	
	IF _constraint._con-type = "P" OR _constraint._con-type = "PC" OR _constraint._con-type = "MP" 
	  OR _constraint._con-type = "M" OR _constraint._con-type = "U" THEN
	PUT STREAM ddl UNFORMATTED "  CONSTRAINT-INDEX """ _Index._index-name """" SKIP.
	
	ELSE IF _constraint._con-type = "D" OR  _constraint._con-type = "C" THEN
	   PUT STREAM ddl UNFORMATTED "  CONSTRAINT-FIELD """ _Field._Field-name """" SKIP.
	
	IF _constraint._con-type = "C" OR _constraint._con-type = "D" THEN
	PUT STREAM ddl UNFORMATTED "  CONSTRAINT-EXPR """ _constraint._con-expr """" SKIP.
	
    PUT STREAM ddl UNFORMATTED SKIP(1).
  END. /* IF CON-STATUS. */
  END.

  FOR EACH _constraint OF _File WHERE _constraint._con-type = "F":
  IF ((_constraint._con-Status = "N" OR _constraint._con-Status = "C" OR _constraint._con-Status = "M"))
  THEN DO:
    IF RECID(_File) <> pi_recid AND RECID(_constraint) <> pi_recid THEN NEXT.
    df-con[1] = 'ADD CONSTRAINT "' +  _constraint._con-name + '" ON "' +  _File._File-name + '"'.
    
    FIND FIRST _Index where RECID(_Index) = _Constraint._Index-recid NO-LOCK NO-ERROR. 
    FIND FIRST CON_DICTDB WHERE CON_DICTDB._Index-Recid = _Constraint._Index-parent-recid NO-LOCK NO-ERROR.
    FIND FIRST FILE_DICTDB WHERE RECID(FILE_DICTDB) = CON_DICTDB._File-Recid NO-LOCK NO-ERROR.
    df-con[2] = "  FOREIGN-KEY".
    
    IF _constraint._Con-Active = TRUE
    THEN df-con[3] = "  ACTIVE".
    ELSE df-con[3] = "  INACTIVE".
    
	df-con[4] = '  CONSTRAINT-INDEX "' +  _Index._index-name + '"'. 
	df-con[5] = '  PARENT-TABLE "' + FILE_DICTDB._File-name + '"'.
    FIND FIRST _Index where RECID(_Index) = _Constraint._Index-Parent-recid NO-LOCK NO-ERROR.	
	df-con[6] = '  PARENT-INDEX "' + _Index._Index-name + '"'. 
	df-con[7] = '  CONSTRAINT-ACTION "' + _Constraint._Con-Misc2[1] + '"'.   
  END. /* IF CON-STATUS. */
     IF df-con[1] <> ? THEN DO:
        DO i = 1 TO 7:
          IF df-con[i] <> ? THEN DO:
             CREATE df-info.
             ASSIGN df-info.df-seq = dfseq
                    dfseq = dfseq + 1
                    df-info.df-tbl = _File._File-name
                    df-info.df-line = df-con[i].
          END.
        END.
      ASSIGN df-con = ?.
      END.   
  END. /* FOR EACH _constraint OF _File */
END.
ELSE IF pi_method BEGINS "o" THEN DO: /*----------------------*/ 
    /* options (encryption, alternate buffer pool) */

    /* we get the info to dump in pi_DmpRpos */
    /* table.obj;obj-type;cipher,value[;buffer-pool,value] */

    iCounter1 = NUM-ENTRIES(pi_DmpRpos, ";").

    IF iCounter1 > 2 THEN DO:
       cTemp = ENTRY(1,pi_DmpRpos, ";").
       IF NUM-ENTRIES(cTemp, ".") = 1 THEN
          PUT STREAM ddl UNFORMATTED 'UPDATE TABLE "' cTemp '"' SKIP.
       ELSE
          PUT STREAM ddl UNFORMATTED 'UPDATE ' UPPER(ENTRY(2, pi_DmpRpos, ";")) 
              ' "' ENTRY(2,cTemp, ".") '" OF "' ENTRY(1,cTemp, ".") '"' SKIP.

       /* now we will have a variable length list of item separated by ';',
          where each entry is "tag,value".
       */
       REPEAT iCounter2 = 3 TO iCounter1.

           cTemp = ENTRY(iCounter2,pi_DmpRpos, ";").
           IF ENTRY(1,cTemp) = "cipher" THEN DO:
              IF ENTRY(2,cTemp) EQ "" THEN
                  PUT STREAM ddl UNFORMATTED "  ENCRYPTION NO" SKIP.
              ELSE DO:
                  PUT STREAM ddl UNFORMATTED "  ENCRYPTION YES" SKIP.
                  PUT STREAM ddl UNFORMATTED "  CIPHER-NAME " ENTRY(2,cTemp) SKIP.
              END.
           END.
           ELSE IF ENTRY(1,cTemp) = "buffer-pool" THEN DO:
               PUT STREAM ddl UNFORMATTED "  BUFFER-POOL " QUOTER(ENTRY(2,cTemp)) SKIP.
           END.
       END.
       PUT STREAM ddl UNFORMATTED SKIP(1).
    END.
END.

RETURN.








/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*---------------------------------------------------------------------- 

File: dump/_dmpdiff.p 

Description:
    program to dump data in 'dif' format 

Input Parameters:
    user_env[ 1] = filename to export
    user_env[ 2] = 'where' clause
    user_env[ 3] = 'by' clause
    user_env[ 4] = output file name
    user_env[ 5] = number of fields
    user_env[ 6] = field list, comma delimited
    user_env[ 7] = ?, or filename to save generated code in
    user_env[ 9] = format name for message
    user_env[14] = "y" - disable triggers, "n" - do not disable triggers


History:
    95/07   hutegger    prepend <db>.<table> to field-names in order to
                        make generated program work with multiple-schema-
                        environement
    10/15/03 D. McMann  Add support for datetime and datetime-tz  

----------------------------------------------------------------------*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED VARIABLE totrecs AS INTEGER NO-UNDO.
DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
DEFINE VARIABLE dbfn      AS CHARACTER NO-UNDO.
DEFINE VARIABLE qual      AS CHARACTER NO-UNDO.
DEFINE VARIABLE sort      AS CHARACTER NO-UNDO.
DEFINE VARIABLE scrap     AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER NO-UNDO.
DEFINE VARIABLE hlddt     AS CHARACTER NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 2 NO-UNDO INITIAL [
  /* 1*/ "records were dumped in DIF format to",
  /* 2*/ ""
].

FORM HEADER
   " Exporting.  Press "
   + KBLABEL("STOP")
   + " to terminate export process. " format "x(60)" skip(0.5)
   WITH FRAME exporting CENTERED ROW 5 USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------*/

/*--------------------------------------------------------------------*/

ASSIGN
  dbfn    = user_env[1]
  qual    = user_env[2]
  sort    = user_env[3]
  totrecs = 0.

/* This thing counts records into 'totrecs' for the 'dif' file header. */
CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.
DO ON STOP UNDO, LEAVE:
  RUN "prodict/misc/_rundift.i" dbfn qual.
  END.

IF user_env[7] = ?
 THEN RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
OUTPUT TO VALUE(IF user_env[7] = ?
                 THEN tmpfile
                 ELSE user_env[7]
               ) NO-MAP.
PUT UNFORMATTED
  'DEFINE SHARED VARIABLE totrecs AS INTEGER NO-UNDO.'  SKIP
  'DEFINE VARIABLE ans AS CHARACTER NO-UNDO.'           SKIP
  'DEFINE VARIABLE hlddt AS CHARACTER NO-UNDO. '        SKIP
  'OUTPUT TO "' user_env[4] '" NO-MAP.'                 SKIP.

IF user_env[14] = "y"
 THEN PUT UNFORMATTED
    "DISABLE TRIGGERS FOR DUMP OF DICTDB2." user_env[1] "." SKIP.

PUT UNFORMATTED
  'PUT UNFORMATTED "TABLE" SKIP'                SKIP
  '  "0,1" SKIP'                                SKIP
  '  """" "' user_env[1] '" """" SKIP'          SKIP /*file-name*/
  '  "VECTORS" SKIP'                            SKIP
  '  "0,' user_env[5] '" SKIP'                  SKIP /*count_chosen*/
  '  """""" SKIP'                               SKIP
  '  "TUPLES" SKIP'                             SKIP
  '  "0,' totrecs '" SKIP'                      SKIP
  '  """""" SKIP'                               SKIP
  '  "DATA" SKIP'                               SKIP
  '  "0,0" SKIP'                                SKIP
  '  """""" SKIP.'                              SKIP.

ASSIGN totrecs = 0.
PUT UNFORMATTED
  'FOR EACH DICTDB2.' dbfn                      SKIP
  '  ' qual ' ' sort ':'                        SKIP
  '  PUT UNFORMATTED "-1,0" SKIP "BOT" SKIP.'   SKIP.

FIND DICTDB._File
  WHERE DICTDB._File._Db-recid  = drec_db
  AND   DICTDB._File._File-name = user_env[1]
  AND  (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").

DO i = 1 TO NUM-ENTRIES(user_env[6]): /* count_chosen */

  FIND DICTDB._Field OF DICTDB._File
    WHERE DICTDB._Field._Field-name = ENTRY(i,user_env[6]).
  ASSIGN scrap = "DICTDB2." + DICTDB._File._File-name
               + "."        + DICTDB._Field._Field-name.

  IF CAN-DO("character,date",_Field._Data-type)
   THEN PUT UNFORMATTED
      '  PUT UNFORMATTED "1,0" SKIP """" ' scrap
        ' """" SKIP.'                                           SKIP.
  IF CAN-DO("datetime,datetime-tz",_Field._Data-type)THEN DO:
    PUT UNFORMATTED
      ' ASSIGN hlddt = ISO-DATE(' scrap ').'                    SKIP.
    PUT UNFORMATTED
      '  PUT UNFORMATTED "1,0" SKIP """"  hlddt  """" SKIP.'  SKIP.
  END.
  ELSE IF CAN-DO("integer,recid",_Field._Data-type)
   THEN PUT UNFORMATTED
      '  PUT UNFORMATTED "0," ' scrap
        ' SKIP "V" SKIP.'                                       SKIP.
  ELSE IF DICTDB._Field._Data-type = "decimal"
   THEN PUT UNFORMATTED
      '  RUN to_scientific (INPUT ' scrap ',OUTPUT ans).'       SKIP
      '  PUT UNFORMATTED "0," ans SKIP "V" SKIP.'               SKIP.
  ELSE IF DICTDB._Field._Data-type = "logical"
   THEN PUT UNFORMATTED
      '  ASSIGN ans = (IF ' scrap ' THEN "TRUE" ELSE IF NOT '
        scrap ' THEN "FALSE" ELSE "NA").'
      '  PUT UNFORMATTED "1,0" SKIP ans SKIP.'                  SKIP.
  END.

PUT UNFORMATTED
  '  ASSIGN totrecs = totrecs + 1.'                              SKIP
  '  END.'                                                       SKIP
  'PUT UNFORMATTED "-1,0" SKIP "EOD" SKIP.'                      SKIP
  'OUTPUT CLOSE.'                                                SKIP
  'RETURN.'                                                      SKIP(1)
  'PROCEDURE to_scientific.'                                     SKIP
  '  DEFINE INPUT  PARAMETER numb    AS DECIMAL   NO-UNDO.'      SKIP
  '  DEFINE OUTPUT PARAMETER ans     AS CHARACTER NO-UNDO.'      SKIP
  '  DEFINE        VARIABLE  negsign AS LOGICAL   NO-UNDO.'      SKIP
  '  DEFINE        VARIABLE  expnumb AS INTEGER   NO-UNDO.'      SKIP
  '  DEFINE        VARIABLE  lognumb AS DECIMAL   NO-UNDO.'      SKIP
  '  IF numb = 0'                                                SKIP
  '    THEN ans = "0.0000000000E+01".'                           SKIP
  '    ELSE ASSIGN'                                              SKIP
  '      negsign = numb < 0'                                     SKIP
  '      numb    = ABSOLUTE(numb)'                               SKIP
  '      ans     = STRING(numb,FILL("9",50) + ".9999999999")'    SKIP
  '      lognumb = LOG(numb,10)'                                 SKIP
  '      expnumb = TRUNCATE(lognumb -'                           SKIP
  '                (IF lognumb > 0 THEN 0 ELSE 0.9999999999),0)' SKIP
  '      ans     = SUBSTRING(ans,1,50) + SUBSTRING(ans,52)'      SKIP
  '      ans     = SUBSTRING(ans,50 - expnumb,1) + "."'          SKIP
  '              + SUBSTRING(ans,51 - expnumb)'                  SKIP
  '      ans     = ans + "E" + STRING(expnumb,"+99")'            SKIP
  '      ans     = (IF negsign THEN "-" ELSE "") + ans.'         SKIP
  '  END PROCEDURE.'                                             SKIP.
OUTPUT CLOSE.

IF user_env[7] = ?
 THEN DO:
  SESSION:IMMEDIATE-DISPLAY = yes.
  VIEW FRAME exporting.
  run adecomm/_setcurs.p ("WAIT").
  
  DO ON STOP UNDO, LEAVE:
    RUN VALUE(tmpfile).
    END.

  HIDE FRAME exporting NO-PAUSE.
  SESSION:IMMEDIATE-DISPLAY = no.
  run adecomm/_setcurs.p ("").

  MESSAGE totrecs new_lang[1] user_env[4]
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   OS-DELETE VALUE(tmpfile).
  END.

RETURN.

/*--------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2005-2009,2011 by Progress Software Corporation. All *
* rights  reserved.  Prior versions of this work may contain portions*
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dmpincr.p - phase 2 of incremental .df maker 

   DICTDB  is the current database
   DICTDB2 is the database chosen to compare against

   The aim is to produce a database like DICTDB.  So this .df file will be
   run against a database like DICTDB2 to create a database like DICTDB.
   
*/

/*
DICTDB  = new definitions
DICTDB2 = old definitions

for each file:
  match up filename
  match up indexnames
  match up fieldnames
  handle differences
end.

match up:
  find object of same name.
  if found, leave.
  otherwise, make note and continue until all matched.
  if none left over, assume deletes.
  otherwise, ask if renamed.
  return.
end.
*/
/*
in:       user_env[2] = Name of file to dump to.
          user_env[5] = "<internal defaults apply>" or "<target-code-page>"
changes:  user_env[19]

History:
    gfs         12/05/94    fixed problem with drop field if in pri indx
    hutegger    94/02/24    code-page - support and trailer-info added
    laurief     03/31/98    BUG 97-08-14-029 see note below    
    mcmann      04/24/98    Added output of POSITION (_field-rpos).
    mcmann      05/07/98    Added logic to skip "default" indices 98-05-06-041
    laurief     06/02/98    Added database names to screen display and 
                            combined thw two separate frames into one that can
                            be viewed in three-d.
    mcmann      06/18/99    Added third parameter to call of _dmpdefs.p
    Mario B     10/19/99    Several Bug Fixes and support for AREAS.  Added
                            warnings mechanisim.  BUG#'s  19981112-011,
                                        19990915-022, 19970814-029 (re-opened & re-fixed).
    McMann      12/15/99    Supporting hidden user files. 19991029-048
    McMann      01/11/00    Dump index desc 19991029042
    McMann      01/18/00    Added check for sql-default 19991102027
    McMann      02/02/00    Added comparison of Frozen 19991227010
    McMann      02/14/00    Checking for available index-alt in wrong place
                            20000209031
    McMann      03/28/00    Passing incorrect recid to function 20000327012
    McMann      04/20/00    Added code to only inactive unique indices if user
                            has specified to.
    McMann      06/28/00    Added code for renaming indexes 20000621001
    McMann      08/17/00    Added _db-recid to _StorageObject find 20000815029
    vap         01/29/02    Added batch-mode support
    McMann      08/08/02    Eliminated any sequences whose name begins "$" - Peer Direct
    McMann      09/13/02    Added logic to put inactive on non-unique indices if the record
                            is inactive 20020913-002
    McMann      02/24/03    Added LOB support    
    P. Kullman  09/22/03    Changed call to _dmpisub.p from _dmpincr.p 12796                        
    McMann      10/17/03    Add NO-LOCK statement to _Db find in support of on-line schema add
    K. McIntosh 07/26/04    Added CLOB support for incremental dump
    kmcintos    09/16/05    Fixed problems with renaming indexed and non
                               indexed fields (Supporting changes in 
                               dump/_dmputil.p) 20040402-004.
    fernando    06/12/06    Support for int64 - allow int->int64 type change
    fernando    08/16/06    raw comparison when checking if char values are different - 20060301-002
    fernando    02/27/2007  Added case for critical field change - OE00147106   
    fernando    08/10/2007  Close error stream when area mismatch error is detected - OE00136202
    fernando    11/12/07    Ignore blank -sa fields during incremental - OE00150364
    fernando    07/22/08    Support for encryption
    fernando    11/24/08    Handle clob field differences - OE00177533
    fernando    04/08/09    Support for alternate buffer pool
    Rkamboj     05/06/11    Add multitenant support for incremental dump
    rkamboj     06/02/11    Fixed problem of case-sensitive issue with index field.
    kmayur      06/21/11    Added support for constraint dump
    rkamboj     07/19/2011  Fixed problem of multi-tenant problem of shared table during dump.
                            Also fixed no _area found problem.
    Rkamboj     09/30/11    Added CATEGORY field support for incremental dump.
    rkamboj     03/30/2012  Added check for sql-92 tables with unsupported ABL prop - OE00208080
*/

using Progress.Lang.*.
routine-level on error undo, throw.

/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/dump/dumpvars.i "NEW SHARED" }
{ prodict/sec/sec-pol.i}

/* these are for the encryption policies and object attributes for
   objects in the DICTDB2 db */
DEFINE TEMP-TABLE ttObjAttrs2 NO-UNDO 
    LIKE ttObjAttrs BEFORE-TABLE bfttObjAttrs2.
DEFINE TEMP-TABLE ttObjEncPolicyVersions2 NO-UNDO LIKE ttObjEncPolicyVersions.
DEFINE DATASET dsObjAttrs2 FOR ttObjAttrs2, ttObjEncPolicyVersions2.

DEFINE TEMP-TABLE renameList
    FIELD old-name AS CHAR
    FIELD new-name AS CHAR
    INDEX old-name old-name.

DEFINE            VARIABLE ans            AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE            VARIABLE c              AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE db             AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE db2            AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE fil            AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE fil2           AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE fld            AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE fld2           AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE idx            AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE idx2           AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE seq            AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE seq2           AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE i              AS INTEGER                 NO-UNDO.
DEFINE            VARIABLE j              AS INTEGER                 NO-UNDO.
DEFINE            VARIABLE l              AS LOGICAL                 NO-UNDO.
DEFINE            VARIABLE stopped        AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE            VARIABLE tmp_Field-name AS CHARACTER               NO-UNDO.
/* 02/01/29 vap (IZ# 1525) */
DEFINE            VARIABLE p-batchmode    AS LOGICAL                 NO-UNDO.
DEFINE            VARIABLE p-index-mode   AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE p-rename-file  AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE p-debug-mode   AS INTEGER                 NO-UNDO.
DEFINE            VARIABLE p-log-line     AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE p-list         AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE p-comma        AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE p-foo          AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE p-foo2         AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE to-int64       AS LOGICAL                 NO-UNDO.
DEFINE            VARIABLE i-to-int64     AS INTEGER                 NO-UNDO.
DEFINE            VARIABLE numEntries     AS INTEGER                 NO-UNDO.
DEFINE            VARIABLE num-diff       AS INTEGER                 NO-UNDO.
DEFINE            VARIABLE dumpPol        AS LOGICAL                 NO-UNDO.
DEFINE            VARIABLE dumpAltBuf     AS LOGICAL                 NO-UNDO.
DEFINE            VARIABLE p-silentincrd  AS LOGICAL                 NO-UNDO.
DEFINE            VARIABLE isDictdbMultiTenant  AS LOGICAL           NO-UNDO.
DEFINE            VARIABLE isDictdb2MultiTenant AS LOGICAL           NO-UNDO.
DEFINE            VARIABLE Constr         AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE Constr1        AS CHARACTER               NO-UNDO.
DEFINE            VARIABLE isIndexDel           AS LOGICAL           NO-UNDO.
DEFINE            VARIABLE indxRecid            AS RECID             NO-UNDO.
DEFINE            VARIABLE l_sys-obj      AS CHARACTER               NO-UNDO.

DEFINE NEW SHARED VARIABLE df-con AS CHARACTER EXTENT 7    NO-UNDO.
DEFINE NEW SHARED VARIABLE dfseq  AS INTEGER INITIAL 1 NO-UNDO.
DEFINE NEW SHARED TEMP-TABLE df-info NO-UNDO
    FIELD df-seq  AS INTEGER
    FIELD df-line AS CHARACTER
    FIELD df-tbl  AS CHARACTER
    FIELD df-fld  AS CHARACTER
    INDEX rt-line IS PRIMARY df-seq.


/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 52 NO-UNDO INITIAL [
  /* 1*/ "(initializing)",
  /* 2*/ "", /* See Below */
  /* 3*/ "WARNING: The ",
  /* 4*/ " file AREA has",     
  /* 5*/ "changed.  The incremental dump utility cannot be used to",   
  /* 6*/ "change database AREAS.  Create AREAS with the ""prostrct""",
  /* 7*/ "utility and move tables with the ""proutil tablemove""",    
  /* 8*/ "utility.  See the {&PRO_DISPLAY_NAME} Database Administration Guide and", 
  /* 9*/ "Reference for details.",
  /*10*/ "WARNING: The index ",
  /*11*/ " in database ",
  /*12*/ "is identical to the index ",
  /*13*/ "except they are in different database AREAS.  The incremental dump",
  /*14*/ "utility cannot be used to change database AREAS.  Create",
  /*15*/ "AREAS with the ""prostrct"" utility and move indices",
  /*16*/ "with the ""proutil idxmove"" utility.  See the {&PRO_DISPLAY_NAME}",
  /*17*/ "Database Administration Guide and Reference for details.",
  /*18*/ "WARNING: The .df contains at least one new definition of an unique",
  /*19*/ "index that has been created as inactive.  Remember to use", 
  /*20*/ """proutil -C idxbuild"" to activate this index.",
  /*21*/ " AREA does not exist",
  /*22*/ "in the target database.  This area must be created before",
  /*23*/ "loading this .df or an error will result.  The new index",       
  /*24*/ " is in this AREA.  See the ""PROSTRCT""",
  /*25*/ "entry in the {&PRO_DISPLAY_NAME} Database Administration Guide and",
  /*26*/ "Reference for details.",
  /*27*/ "Warnings have been written to a file called "{&errFileName}"",
  /*28*/ "located in your current working directory.  Please check",   
  /*29*/ "this file prior to loading this incremental .df.  Failure",
  /*30*/ "to do so could result in errors or other undesirable results.",
  /*31*/ "loading this .df or an error will result.  The new table",
  /*32*/ "The target database does not have encryption enabled." ,
  /*33*/ "The .df may contain encryption policy information but you will have",
  /*34*/ "to enable encryption on the target database before you can load",
  /*35*/ "the .df successfully.",
  /*36*/ "The .df file will not contain any encryption policy settings.",
  /*37*/ "The target database does not support buffer pool settings.",
  /*38*/ "The .df file will not contain any buffer pool settings.",
  /*39*/ " is multi-tenant database and ",
  /*40*/ " is non multi-tenant database. As a result some multi-tenant features have been ignored while generating incremental df.",
  /*41*/ " is non multi-tenant database and ",
  /*42*/ " is multi-tenant database. As a result some multi-tenant features have been ignored while generating incremental df.",
  /*43*/ " table is defined as multi-tenant table in ",
  /*44*/ " multi-tenant database but ",
  /*45*/ " database is non multi-tenant. The generated incremental df will not be uploaded in the non multi-tenant database.",
  /*46*/ " defined as non multi-tenant in ",
  /*47*/ " database. Multi-tenant table can not be changed into non multi-tenant table.",
  /*48*/ " sequence is defined as multi-tenant in ",
  /*49*/ " database but defined as non multi-tenant in  ",
  /*50*/ " database is defined as non multi-tenant database. Multi-tenant sequence feature has been ignored while generating incremental df.",
  /*51*/ "sequence ", 
  /*52*/ " definition is not identical in both databases."
]. 

new_lang[2] = "The incremental definitions file will contain at least "
            + "one new definition of an  unique index. "
            + "If {&PRO_DISPLAY_NAME} finds duplicate values when creating the new "
            + "unique index, it will UNDO the entire transaction, causing "
            + "you to lose any other schema changes made.  Creating an "
            + "inactive index and then building it with ~"proutil -C "
            + "idxbuild~" will eliminate this problem.  Do you want to "
            + "create definitions for unique indexes as inactive?"
.

/* s_DbRecId is not unknown when the logical database
   of a DataServer schema image is used as the database to be changed */
IF s_DbType1 = "MSS" OR s_DbType2 = "MSS" THEN
  assign l_sys-obj = {prodict/mss/mss_sys.i}. 
ELSE
  IF s_DbType1 = "ORACLE" OR s_DbType2 = "ORACLE" THEN 
      assign l_sys-obj = {prodict/ora/ora_sys.i}.

/* LANGUAGE DEPENDENCIES END */ /*-------------------------------------------*/

FORM
  db      LABEL "Scanning"              COLON 10 FORMAT "x(27)"
  db2     LABEL "Working on"            COLON 50 FORMAT "x(27)" SKIP
  fil     LABEL "TABLE"                 COLON 10 FORMAT "x(27)"
  fil2    LABEL "TABLE"                 COLON 50 FORMAT "x(27)" SKIP
  fld     LABEL "FIELD"                 COLON 10 FORMAT "x(27)"
  fld2    LABEL "FIELD"                 COLON 50 FORMAT "x(27)" SKIP
  idx     LABEL "INDEX"                 COLON 10 FORMAT "x(27)"
  idx2    LABEL "INDEX"                 COLON 50 FORMAT "x(27)" SKIP
  seq     LABEL "SEQ"                   COLON 10 FORMAT "x(27)"
  seq2    LABEL "SEQ"                   COLON 50 FORMAT "x(27)" SKIP
  HEADER 
    " Press " +
    KBLABEL("STOP") + " to terminate the dump." FORMAT "x(50)"
  WITH FRAME seeking 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN VIEW-AS DIALOG-BOX THREE-D &ENDIF
  SIDE-LABELS WIDTH 80
  ROW 4 COLUMN 1 USE-TEXT.
COLOR DISPLAY MESSAGES fil fil2 fld fld2 idx idx2 seq seq2 WITH FRAME seeking.
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/* Definitions */ /*-------------------------------------------------------*/

DEFINE VARIABLE ddl  AS CHARACTER EXTENT 40 NO-UNDO.
DEFINE VARIABLE iact AS LOGICAL   INITIAL ? NO-UNDO.
DEFINE VARIABLE pri1 AS CHARACTER           NO-UNDO.
DEFINE VARIABLE pri2 AS CHARACTER           NO-UNDO.
/*DEFINE VARIABLE setincrdmpSilent AS LOGICAL INITIAL FALSE NO-UNDO.*/

DEFINE BUFFER database2 FOR DICTDB2._Db.
FIND FIRST database2 WHERE database2._Db-local NO-LOCK.
DEFINE BUFFER confile2 FOR DICTDB._File.
DEFINE BUFFER index2 FOR DICTDB._Index.

DEFINE WORKFILE drop-list NO-UNDO
   FIELD file-name  LIKE _File._File-Name
   FIELD f1-name    LIKE _Field._Field-Name
   FIELD f2-name    LIKE _Field._Field-Name.

DEFINE WORKFILE drop-temp-idx NO-UNDO
    FIELD temp-name LIKE _Index._Index-name
    FIELD fil-name  LIKE _File._File-name.
   
DEF VAR myEPolicy  AS prodict.sec._sec-pol-util    EXTENT 2 NO-UNDO.
DEF VAR myObjAttrs AS prodict.pro._obj-attrib-util EXTENT 2 NO-UNDO.
/* Persistent procedure library */
RUN prodict/dump/_dmputil.p PERSISTENT SET h_dmputil.

/* Forward Declare functions contained in library */
FUNCTION fileAreaMatch RETURNS LOGICAL (INPUT db1FileNo AS INT,
                                        INPUT db2FileNo AS INT,
                                        INPUT db1recid  AS RECID,
                                        INPUT db2recid  AS RECID) IN h_dmputil.

FUNCTION indexAreaMatch RETURNS LOGICAL(INPUT db1IndexNo AS INT,
                                        INPUT db2IndexNo AS INT,
                                        INPUT db1recid   AS RECID,
                                        INPUT db2recid   AS RECID) IN h_dmputil.                                        
FUNCTION inprimary RETURNS LOGICAL (INPUT p_db1PrimeIndex AS RECID,
                                    INPUT p_db1RecId      AS RECID)
                                    IN h_dmputil.

FUNCTION inindex RETURNS LOGICAL (INPUT p_db1File AS RECID,
                                  INPUT p_db1Field      AS RECID)
                                  IN h_dmputil.

FUNCTION checkRenameTable RETURNS CHARACTER (  /* 02/01/29 vap (IZ# 1525) */
                          INPUT pcRenameFrom   AS CHARACTER ,
                          INPUT pcRenameToList AS CHARACTER ) IN h_dmputil.

FUNCTION checkRenameField RETURNS CHARACTER (  /* 02/01/29 vap (IZ# 1525) */
                          INPUT pcTableName    AS CHARACTER ,
                          INPUT pcRenameFrom   AS CHARACTER ,
                          INPUT pcRenameToList AS CHARACTER ) IN h_dmputil.

FUNCTION checkRenameSequence RETURNS CHARACTER (  /* 02/01/29 vap (IZ# 1525) */
                             INPUT pcRenameFrom   AS CHARACTER ,
                             INPUT pcRenameToList AS CHARACTER ) IN h_dmputil.

FUNCTION CHECK_SA_FIELDS RETURNS LOGICAL (INPUT c1 AS CHAR, INPUT c2 AS CHAR) FORWARD.

/* Functions and procedures */

FUNCTION CHECK_SA_FIELDS RETURNS LOGICAL (INPUT c1 AS CHAR, INPUT c2 AS CHAR) :

    /* ignore this field if they are a combination of ? and empty strings */
    RETURN 
            ( NOT (c1 EQ '' AND c2 EQ ?) AND 
              NOT (c1 EQ ? AND c2 EQ '')).

END FUNCTION.

PROCEDURE checkEPolicy:

    DEF VAR cMsg      AS CHAR EXTENT 2 NO-UNDO.
    DEF VAR cTmp      AS CHAR          NO-UNDO.
    
    DO ON ERROR UNDO, LEAVE
       ON STOP UNDO, LEAVE:
        /* we will try to compare encryption current policies. Must be enabled
           in both, or we won't do anything with them.
        */
        myEPolicy[1] = NEW prodict.sec._sec-pol-util(LDBNAME("DICTDB")).
        CATCH ae AS PROGRESS.Lang.AppError:
           /* if encryption is not enabled, we simply ignore it */
            IF ae:GetMessageNum(1) NE 14889 THEN
               cMsg[1] = "Database " + LDBNAME("DICTDB") + " : " + ae:GetMessage(1).
            DELETE OBJECT ae.
        END CATCH.
    END.

    DO ON ERROR UNDO, LEAVE
        ON STOP UNDO, LEAVE:
        /* we will try to compare encryption current policies. Must be enabled
           in both, or we won't do anything with them.
        */
        myEPolicy[2] = NEW prodict.sec._sec-pol-util(LDBNAME("DICTDB2")).
        CATCH ae AS PROGRESS.Lang.AppError:
            /* if encryption is not enabled, we simply ignore it */
            IF ae:GetMessageNum(1) NE 14889 THEN
               cMsg[2] = "Database " + LDBNAME("DICTDB2") + " : " + ae:GetMessage(1).
            DELETE OBJECT ae.
        END CATCH.
    END.
    
    /* if both are valid, we are good */
    IF NOT (VALID-OBJECT(myEPolicy[1]) AND VALID-OBJECT(myEPolicy[2])) THEN DO:
       /* now if both are invalid and there is no error, then both have encryption
          disabled, and we are also good. And if the target only is invalid and there
          is no error (meaning it's disabled), then we will issue a warning message and
          let it go through.
       */
        IF cMsg[1] = "" AND cMsg[2] = "" AND NOT VALID-OBJECT(myEPolicy[2]) THEN DO:
            /* here both have encryption disabled or the target does */
            IF VALID-OBJECT(myEPolicy[1]) THEN DO:
                IF NOT p-batchmode and not p-silentincrd THEN DO:
                    MESSAGE new_lang[32] SKIP
                            new_lang[33] SKIP
                            new_lang[34] SKIP
                            new_lang[35]
                        VIEW-AS ALERT-BOX WARNING BUTTONS OK.

                    ASSIGN s_errorsLogged = TRUE.         
                    OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.

                    PUT STREAM err-log UNFORMATTED
                         new_lang[32]    SKIP
                         new_lang[33]    SKIP
                         new_lang[34]    SKIP
                         new_lang[35]    SKIP(1).

                    OUTPUT STREAM err-log CLOSE.
                END.
                ELSE DO:
                   if p-silentincrd THEN 
                       undo, throw new AppError(new_lang[32] + "~n" +
                            new_lang[33] + "~n" +
                            new_lang[34] + "~n" +
                            new_lang[35]). 
                   ELSE
                    MESSAGE new_lang[32] SKIP
                            new_lang[33] SKIP
                            new_lang[34] SKIP
                            new_lang[35].
                END.
            END.
        END.
        ELSE DO:
            IF cMsg[1] = "" AND cMsg[2] = "" AND VALID-OBJECT(myEPolicy[2]) THEN
                cTmp = "Source db does not have encryption enabled".
            ELSE DO:
                IF cMsg[1] NE "" THEN
                   cTmp = cMsg[1].
                IF cTmp NE "" THEN
                   cTmp = cTmp + "~n".
                IF cMsg[2] NE "" THEN
                   cTmp = cTmp + cMsg[2].
            END.
                   
            IF NOT p-batchmode and not p-silentincrd THEN
                MESSAGE new_lang[36] SKIP cTmp
                    VIEW-AS ALERT-BOX WARNING.
            ELSE DO:
                   if p-silentincrd THEN 
                       undo, throw new AppError(new_lang[36] + "~n" + cTmp). 
                   ELSE
                       MESSAGE new_lang[36] SKIP cTmp.
            END.

            ASSIGN s_errorsLogged = TRUE.         
            OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.

            PUT STREAM err-log UNFORMATTED
                 new_lang[36]   SKIP
                 cTmp           SKIP(1).

            OUTPUT STREAM err-log CLOSE.

            /* don't need them if they are not both enabled */
            IF VALID-OBJECT(myEPolicy[1]) THEN
                DELETE OBJECT myEPolicy[1].

            IF VALID-OBJECT(myEPolicy[2]) THEN
                DELETE OBJECT myEPolicy[2].
        END.
    END.

END.

PROCEDURE checkObjectAttributes:

    DEF VAR cMsg      AS CHAR EXTENT 2 NO-UNDO.
    DEF VAR cTmp      AS CHAR          NO-UNDO.
    
    DO ON ERROR UNDO, LEAVE
       ON STOP UNDO, LEAVE:
        /* we will try to compare encryption current policies. Must be enabled
           in both, or we won't do anything with them.
        */
        myObjAttrs[1] = NEW prodict.pro._obj-attrib-util(LDBNAME("DICTDB")).
        CATCH ae AS PROGRESS.Lang.AppError:
           /* if database doesn't support it, we just ignore it */
            IF ae:GetMessageNum(1) NE 4634 THEN
               cMsg[1] = "Database " + LDBNAME("DICTDB") + " : " + ae:GetMessage(1).
            DELETE OBJECT ae.
        END CATCH.
    END.

    DO ON ERROR UNDO, LEAVE
        ON STOP UNDO, LEAVE:
        /* we will try to compare encryption current policies. Must be enabled
           in both, or we won't do anything with them.
        */
        myObjAttrs[2] = NEW prodict.pro._obj-attrib-util(LDBNAME("DICTDB2")).
        CATCH ae AS PROGRESS.Lang.AppError:
            /* if database doesn't support it, we just ignore it */
            IF ae:GetMessageNum(1) NE 4634 THEN
               cMsg[2] = "Database " + LDBNAME("DICTDB2") + " : " + ae:GetMessage(1).
            DELETE OBJECT ae.
        END CATCH.
    END.
    
    /* if both are valid, we are good */
    IF NOT (VALID-OBJECT(myObjAttrs[1]) AND VALID-OBJECT(myObjAttrs[2])) THEN DO:
       /* now if both are invalid and there is no error, then both don't support 
          object attributes and we are also good. And if the target only is invalid and there
          is no error (meaning it doesn't support), then we will issue a warning message and
          let it go through.
       */
        IF cMsg[1] = "" AND cMsg[2] = "" AND NOT VALID-OBJECT(myObjAttrs[2]) THEN DO:
            /* here both don't support obj attribs or the target doesn't */
            IF VALID-OBJECT(myObjAttrs[1]) THEN DO:
                IF NOT p-batchmode and not p-silentincrd  THEN DO:
                    MESSAGE new_lang[37] SKIP
                            new_lang[38]
                        VIEW-AS ALERT-BOX WARNING BUTTONS OK.

                    ASSIGN s_errorsLogged = TRUE.         
                    OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.

                    PUT STREAM err-log UNFORMATTED
                         new_lang[37]    SKIP
                         new_lang[38]    SKIP(1).

                    OUTPUT STREAM err-log CLOSE.
                END.
                ELSE DO:
                   if p-silentincrd THEN 
                       undo, throw new AppError(new_lang[37] + "~n" + new_lang[38]). 
                   ELSE
                    MESSAGE new_lang[37] SKIP
                            new_lang[38].
                   END.

                /* don't need it */
                ASSIGN myObjAttrs[1] = ?.
            END.
        END.
        ELSE DO:
            IF cMsg[1] = "" AND cMsg[2] = "" AND VALID-OBJECT(myObjAttrs[2]) THEN
                cTmp = "Source db does not support alternate buffer pool".
            ELSE DO:
                IF cMsg[1] NE "" THEN
                   cTmp = cMsg[1].
                IF cTmp NE "" THEN
                   cTmp = cTmp + "~n".
                IF cMsg[2] NE "" THEN
                   cTmp = cTmp + cMsg[2].
            END.
                   
            IF NOT p-batchmode and not p-silentincrd THEN
                MESSAGE new_lang[38] SKIP cTmp
                    VIEW-AS ALERT-BOX WARNING.
            ELSE DO:
                   if p-silentincrd THEN 
                       undo, throw new AppError(new_lang[38] + "~n" + cTmp).
                   ELSE
                       MESSAGE new_lang[38] SKIP cTmp.
            END.

            ASSIGN s_errorsLogged = TRUE.         
            OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.

            PUT STREAM err-log UNFORMATTED
                 new_lang[38]   SKIP
                 cTmp           SKIP(1).

            OUTPUT STREAM err-log CLOSE.

            /* don't need them if they are not both enabled */
            IF VALID-OBJECT(myObjAttrs[1]) THEN
                DELETE OBJECT myObjAttrs[1].

            IF VALID-OBJECT(myObjAttrs[2]) THEN
                DELETE OBJECT myObjAttrs[2].
        END.
    END.

END.

/* mainline code **********************************************************/

/* 02/01/29 vap (IZ# 1525) */
ASSIGN p-batchmode = SESSION:BATCH-MODE.
/*IF p-batchmode THEN DO: */
  ASSIGN p-rename-file = ENTRY(1,user_env[19])
         p-index-mode  = ENTRY(2,user_env[19])
         p-debug-mode  = INTEGER(ENTRY(3,user_env[19])) 
         p-silentincrd = LOGICAL(ENTRY(4,user_env[19])) NO-ERROR.
  RUN set_Variables           IN h_dmputil(p-rename-file, p-debug-mode, p-silentincrd).
  RUN load_Rename_Definitions IN h_dmputil.
/*END. */  /* batchmode */

IF  ENTRY(1,user_env[5]) = "" 
 OR ENTRY(1,user_env[5]) = ?  THEN assign user_env[5] = "<internal defaults apply>". 

IF  user_env[5] = "<internal defaults apply>" 
 THEN OUTPUT STREAM ddl TO VALUE(user_env[2]) NO-ECHO NO-MAP
            NO-CONVERT.
 ELSE OUTPUT STREAM ddl TO VALUE(user_env[2]) NO-ECHO NO-MAP
            CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].

SESSION:IMMEDIATE-DISPLAY = yes.
/* Display database name at the top of the respective column. */
FIND FIRST DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-LOCK.
IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
  DISPLAY LDBNAME("DICTDB") @ db WITH FRAME seeking.

IF s_DbType2 = "PROGRESS" THEN
  FIND FIRST DICTDB2._Db WHERE RECID(DICTDB2._Db) = RECID(database2) NO-LOCK.
ELSE
  FIND FIRST DICTDB2._Db WHERE RECID(DICTDB2._Db) = s_DbRecId.

IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
  DISPLAY LDBNAME("DICTDB2") @ db2 WITH FRAME seeking.

IF NOT p-batchmode and not p-silentincrd THEN DO:  /* 02/01/29 vap (IZ# 1525) */
  DISPLAY new_lang[1] @ fil  WITH FRAME seeking. /* initializing */
  DISPLAY new_lang[1] @ fil2 WITH FRAME seeking. /* initializing */
  run adecomm/_setcurs.p ("WAIT").
END.  /* batchmode */
ASSIGN isDictdbMultiTenant  = can-find(first dictdb._tenant)
       isDictdb2MultiTenant = can-find(first dictdb2._tenant).

/* If either db is non-progress, it means one or both of the comparisons is with a 
 * "foreign" schema image.  As there are no real objects, just schema definitions 
 * in the schema image, skip the database encryption comparisons.  By avoiding setup 
 * of both "myEPolicy" and "myObjAttrs" arrays here, we avoid future comparisons 
 * during delta.df processing.
 */
IF s_DbType1 = "PROGRESS" AND s_DbType2 = "PROGRESS" THEN
  RUN checkEPolicy.

IF s_DbType1 = "PROGRESS" AND s_DbType2 = "PROGRESS" THEN
  RUN checkObjectAttributes.

DO ON STOP UNDO, LEAVE
   ON ERROR UNDO, LEAVE:
    
  /* build missing file list for rename/delete determination */
  
  FOR EACH DICTDB2._File
    WHERE (IF s_DbType2 = "PROGRESS" 
           THEN DICTDB2._File._Db-recid = RECID(database2)
           ELSE DICTDB2._File._Db-recid = s_DbRecId)
      AND (IF s_DbType2 = "PROGRESS" 
           THEN DICTDB2._File._Owner = "PUB" OR DICTDB2._File._Owner = "_FOREIGN"
           ELSE DICTDB2._File._Owner = "_FOREIGN")
      AND (IF s_DbType2 <> "PROGRESS"
           THEN LOOKUP(DICTDB2._File._File-name, l_sys-obj) = 0
           ELSE yes)
      AND DICTDB2._File._tbl-type = "T":
    FIND FIRST DICTDB._File
      WHERE DICTDB._File._Db-recid = drec_db
        AND DICTDB._File._File-name = DICTDB2._File._File-name
      AND (IF s_DbType1 = "PROGRESS" 
           THEN DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"
           ELSE DICTDB._File._Owner = "_FOREIGN")
      AND (IF s_DbType1 <> "PROGRESS"
           THEN LOOKUP(DICTDB._File._File-name, l_sys-obj) = 0
           ELSE yes)
      AND DICTDB._File._Tbl-type = "T" NO-ERROR.
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY DICTDB2._File._File-name @ fil WITH FRAME seeking.
    /* Skip File Area check for a DataServer Schema holder (s_DbType(s) <> "PROGRESS") */
    IF AVAILABLE DICTDB._File THEN DO:
      IF NOT fileAreaMatch(INPUT DICTDB._File._File-number,
                           INPUT DICTDB2._File._File-Number,
                           INPUT DICTDB._File._Db-recid,
                           INPUT DICTDB2._File._Db-recid) 
         AND s_DbType1 = "PROGRESS" AND s_DbType2 = "PROGRESS" THEN DO:
                               
        s_errorsLogged = TRUE.
        OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
        p-log-line = new_lang[3] + '"' + DICTDB2._File._File-Name + '"' + 
                     new_lang[4].  /* 02/01/29 vap (IZ# 1525) */
        PUT STREAM err-log UNFORMATTED p-log-line SKIP.
        DO i = 5 TO 8:          
            PUT STREAM err-log UNFORMATTED new_lang[i] SKIP.
        END.
        PUT STREAM err-log UNFORMATTED new_lang[9] SKIP(1).
        OUTPUT STREAM err-log CLOSE.
      END.
      NEXT.
    END.
    CREATE missing.
    missing.name = DICTDB2._File._File-name.
  END.

  /* build list of new or renamed files */
  FOR EACH DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                          AND (IF s_DbType1 = "PROGRESS" 
                               THEN DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"
                               ELSE DICTDB._File._Owner = "_FOREIGN")
                          AND (IF s_DbType1 <> "PROGRESS"
                               THEN LOOKUP(DICTDB._File._File-name, l_sys-obj) = 0
                               ELSE yes)      
                          AND DICTDB._File._Tbl-type = "T":
     
    FIND FIRST DICTDB2._File WHERE (IF s_DbType2 = "PROGRESS"
                                    THEN DICTDB2._File._Db-recid = RECID(database2)
                                    ELSE DICTDB2._File._Db-recid = s_DbRecId)
                               AND DICTDB2._File._File-name = 
                                   DICTDB._File._File-name
                               AND (IF s_DbType2 = "PROGRESS"
                                    THEN DICTDB2._File._Owner = "PUB" OR DICTDB2._File._Owner = "_FOREIGN"
                                    ELSE DICTDB2._File._Owner = "_FOREIGN")
                               AND (IF s_DbType2 <> "PROGRESS"
                                    THEN LOOKUP(DICTDB._File._File-name, l_sys-obj) = 0 
                                    ELSE yes)
                                    NO-ERROR.
    IF NOT p-batchmode and not p-silentincrd THEN /* 02/01/29 vap (IZ# 1525) */
      DISPLAY DICTDB._File._File-name @ fil WITH FRAME seeking.
    CREATE table-list.
    ASSIGN table-list.t1-name = DICTDB._File._File-name.
    IF AVAILABLE DICTDB2._File THEN
      table-list.t2-name = DICTDB._File._File-name.
  END.
  
  /* look for matches for renamed files with user input.  A prompt 
     is given for each file in DICTDB2 that's not in DICTDB but only when
     there is also a file in DICTDB that's not in DICTDB2.  The 2nd list
     is the potential values to rename to.
  */
  IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
    run adecomm/_setcurs.p ("").  /* while dmpisub is running */
  ELSE DO:  /* 02/01/29 vap (IZ# 1525) */
    ASSIGN p-comma = "":U
           p-list  = "":U.
    FOR EACH table-list WHERE
             table-list.t2-name = ?:
      ASSIGN p-list  = p-list + p-comma + table-list.t1-name
             p-comma = ",":U.
    END.
  END.
  FOR EACH missing:
    /* 02/01/29 vap (IZ# 1525) */
    IF NOT p-batchmode and not p-silentincrd THEN DO:
      DISPLAY missing.name @ fil WITH FRAME seeking.
      RUN "prodict/dump/_dmpisub.p"
        (INPUT "t",INPUT-OUTPUT missing.name,OUTPUT ans).
      IF missing.name = ? THEN
         DELETE missing.
      IF ans = ? THEN DO:
        HIDE FRAME seeking NO-PAUSE.
        user_path = "".
        RETURN.
      END.
    END.  /* NOT p-batchmode */
    ELSE DO:  /* 02/01/29 vap (IZ# 1525) */
      ASSIGN p-foo = checkRenameTable(missing.name, p-list).
      IF p-foo NE ? THEN DO:
         FIND FIRST table-list WHERE
                    table-list.t1-name = p-foo AND
                    table-list.t2-name = ?
                    NO-ERROR.
         IF AVAILABLE(table-list) THEN          
           ASSIGN table-list.t2-name = missing.name.
         /* tablemove check */ /* peterk fix 12796*/
         RUN prodict/dump/_dmpisub.p(INPUT "table_check,":U + p-foo + 
                                            ",":U + missing.name,
                                     INPUT-OUTPUT p-foo2,
                                     OUTPUT       ans).   /* dummy var */
         DELETE missing.
      END.  /* p-foo NE ? */
    END.  /* p-batchmode */
  END.
  IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
    run adecomm/_setcurs.p ("WAIT").
  
  /* handle deleted files */
  ans = FALSE.
  FOR EACH missing:
    ans = TRUE.
    PUT STREAM ddl UNFORMATTED
      'DROP TABLE "' missing.name '"' SKIP.
    IF NOT p-batchmode and not p-silentincrd THEN DO: /* 02/01/29 vap (IZ# 1525) */
      DISPLAY missing.name @ fil WITH FRAME seeking.
      DISPLAY missing.name @ fil2 WITH FRAME seeking.
    END.
    DELETE missing.
  END.
  IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  
  /* handle renamed files */
  ans = FALSE.
  FOR EACH table-list WHERE table-list.t1-name <> table-list.t2-name
                        AND table-list.t2-name <> ?:
    ASSIGN ans = TRUE.
    PUT STREAM ddl UNFORMATTED
      'RENAME TABLE "' table-list.t2-name
      '" TO "' table-list.t1-name '"' SKIP.
    IF NOT p-batchmode and not p-silentincrd THEN DO: /* 02/01/29 vap (IZ# 1525) */
      DISPLAY table-list.t1-name @ fil WITH FRAME seeking.
      DISPLAY table-list.t1-name @ fil2 WITH FRAME seeking.
    END.
  END.
  IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  IF isDictdbMultiTenant = yes and isDictdb2MultiTenant = no THEN  /* IF one database is MT and other one is non MT. Give warning message */
  DO:
     ASSIGN s_errorsLogged = TRUE.        
     OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
         
       PUT STREAM err-log UNFORMATTED new_lang[3] +
                  '"' + LDBNAME("DICTDB") + '"' + new_lang[39]     SKIP
                  '"' + LDBNAME("DICTDB2") + '"' + new_lang[40]    SKIP(1).
     OUTPUT STREAM err-log CLOSE.
   END.
   ELSE IF isDictdbMultiTenant = no and isDictdb2MultiTenant = yes THEN
   DO:
      ASSIGN s_errorsLogged = TRUE.        
      OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
         
       PUT STREAM err-log UNFORMATTED new_lang[3] +
                  '"' + LDBNAME("DICTDB") + '"' + new_lang[41]     SKIP
                  '"' + LDBNAME("DICTDB2") + '"' + new_lang[42]    SKIP(1).
     OUTPUT STREAM err-log CLOSE.
   END.
  /* dump newly created files */
  FOR EACH table-list WHERE table-list.t2-name = ?:
    FIND DICTDB._File WHERE DICTDB._File._Db-recid = drec_db AND
         DICTDB._File._File-name = table-list.t1-name AND
       (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
    /* OE00208080 
       Now due to the unified schema for sql92, we will get through
       for PUB tables but we can't dump tables with constraints 
       or non-ABL data types.
    */
    IF DICTDB._File._Has-Ccnstrs = "Y" 
       OR DICTDB._File._Has-Fcnstrs = "Y"
       OR DICTDB._File._Has-Pcnstrs = "Y" 
       OR DICTDB._File._Has-Ucnstrs = "Y"  THEN
       NEXT.
    /* check if any of the non-ABL data types are used in any of the columns */
    FIND FIRST DICTDB._Field OF DICTDB._File WHERE
         CAN-DO("short,byte,fixchar,fixraw,time,double,float":U,
                 DICTDB._Field._Data-type) NO-LOCK NO-ERROR.
    IF AVAILABLE DICTDB._Field THEN
       NEXT.   
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY DICTDB._File._File-name @ fil WITH FRAME seeking.
    FIND DICTDB._StorageObject
         where DICTDB._StorageObject._Db-recid      = DICTDB._File._Db-recid
           and DICTDB._StorageObject._Object-type   = 1 
           and DICTDB._StorageObject._Object-number = DICTDB._File._File-number
           and DICTDB._Storageobject._Partitionid   = 0                       
         NO-ERROR.
   
    IF AVAILABLE DICTDB._StorageObject THEN
       FIND DICTDB._Area WHERE
            DICTDB._Area._Area-number = DICTDB._StorageObject._Area-number
       NO-ERROR.
       IF AVAILABLE DICTDB._Area THEN
       FIND DICTDB2._Area WHERE
            DICTDB2._Area._Area-name = DICTDB._Area._Area-name NO-ERROR.
       IF NOT AVAILABLE DICTDB2._Area THEN
       DO:
         ASSIGN s_errorsLogged = TRUE.
         OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
         PUT STREAM err-log UNFORMATTED new_lang[3] +
            '"' + IF AVAIL DICTDB._Area THEN DICTDB._Area._Area-name ELSE '' + '"' + new_lang[21]     SKIP
            new_lang[22]                                           SKIP
            new_lang[31]                                           SKIP
            '"' + DICTDB._File._File-name + '"' + new_lang[24]     SKIP
            new_lang[25]                                           SKIP
            new_lang[26]                                           SKIP(1).      
         OUTPUT STREAM err-log CLOSE.
       END.         
       IF isDictdb2MultiTenant = no and DICTDB._File._File-attributes[1] = yes THEN
       DO:
          ASSIGN s_errorsLogged = TRUE.
             OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
               PUT STREAM err-log UNFORMATTED new_lang[3] +
                        '"' + DICTDB._File._File-name + '"' + new_lang[43]     SKIP
                        '"' + LDBNAME("DICTDB")       + '"' + new_lang[44]     SKIP
                        '"' + LDBNAME("DICTDB2")      + '"' + new_lang[45]     SKIP(1).
             OUTPUT STREAM err-log CLOSE.
       END.
       ELSE IF isDictdbMultiTenant = yes and isDictdb2MultiTenant = yes 
            AND DICTDB._File._File-attributes[1] = no and available DICTDB2._File and DICTDB2._File._File-attributes[1] = yes THEN
       DO:
           ASSIGN s_errorsLogged = TRUE.
             OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
               PUT STREAM err-log UNFORMATTED new_lang[3] +
                        '"' + DICTDB._File._File-name + '"' + new_lang[43]     SKIP
                        '"' + LDBNAME("DICTDB2")      + '"' + new_lang[49]    SKIP
                        '"' + LDBNAME("DICTDB")      + '"'  + new_lang[47]     SKIP.
                        
             OUTPUT STREAM err-log CLOSE.
       END.
    RUN "prodict/dump/_dmpdefs.p" ("t",RECID(DICTDB._File),"Y").
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY DICTDB._File._File-name @ fil2 WITH FRAME seeking.
    DELETE table-list.

    /* let's cache the encryption info in a temp-table */
    IF VALID-OBJECT(myEPolicy[1]) OR VALID-OBJECT(myObjAttrs[1]) THEN DO:

       IF VALID-OBJECT(myEPolicy[1]) THEN
           myEPolicy[1]:getPolicyVersions(DICTDB._File._File-Number, 
                                          DICTDB._File._File-Name, 
                                          "Table", 
                                          OUTPUT DATASET dsObjAttrs BY-REFERENCE).

       IF VALID-OBJECT(myObjAttrs[1]) and NOT DICTDB._File._File-attributes[1] THEN
           myObjAttrs[1]:getObjectAttributes(DICTDB._File._File-Number, 
                                             DICTDB._File._File-Name, 
                                             "Table", 
                                             OUTPUT DATASET dsObjAttrs BY-REFERENCE). 

       FOR EACH DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Dtype = 18 /* blob*/ OR
           DICTDB._Field._Dtype = 19 /* clob */ NO-LOCK:
           IF VALID-OBJECT(myEPolicy[1]) THEN
               myEPolicy[1]:getPolicyVersions(DICTDB._Field._fld-stlen, 
                                              DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name, 
                                              DICTDB._Field._Data-type, 
                                              OUTPUT DATASET dsObjAttrs BY-REFERENCE).

           IF VALID-OBJECT(myObjAttrs[1]) and NOT DICTDB._File._File-attributes[1] 
               AND NOT DICTDB._Field._Field-attributes[1] THEN
               myObjAttrs[1]:getObjectAttributes(DICTDB._Field._fld-stlen, 
                                                 DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name, 
                                                 DICTDB._Field._Data-type, 
                                                 OUTPUT DATASET dsObjAttrs BY-REFERENCE). 
       END.

       FOR EACH DICTDB._Index OF DICTDB._File NO-LOCK:
           IF VALID-OBJECT(myEPolicy[1]) THEN
               myEPolicy[1]:getPolicyVersions(DICTDB._Index._Idx-num, 
                                              DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                              "Index", 
                                              OUTPUT DATASET dsObjAttrs BY-REFERENCE).

           IF VALID-OBJECT(myObjAttrs[1]) and not DICTDB._File._File-attributes[1] THEN
               myObjAttrs[1]:getObjectAttributes(DICTDB._Index._Idx-num, 
                                                 DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                                 "Index", 
                                                 OUTPUT DATASET dsObjAttrs BY-REFERENCE).
       END.
    END.

  END.
  
  /* handle potentially altered files */
  FOR EACH table-list:
    IF NOT p-batchmode and not p-silentincrd THEN DO: /* 02/01/29 vap (IZ# 1525) */
      DISPLAY table-list.t1-name @ fil "" @ fld "" @ idx WITH FRAME seeking.
      DISPLAY table-list.t1-name @ fil2 "" @ fld2 "" @ idx2 WITH FRAME seeking.
    END.
    FIND DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
      AND DICTDB._File._File-name = table-list.t1-name
      AND (IF s_DbType1 = "PROGRESS" 
           THEN DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"
           ELSE DICTDB._File._Owner = "_FOREIGN")
      AND (IF s_DbType1 <> "PROGRESS"
           THEN LOOKUP(DICTDB._File._File-name, l_sys-obj) = 0
           ELSE yes).
    FIND DICTDB2._File WHERE (IF s_DbType2 = "PROGRESS"  
                              THEN DICTDB2._File._Db-recid = RECID(database2)
                              ELSE DICTDB2._File._Db-recid = s_DbRecId)
      AND DICTDB2._File._File-name = table-list.t2-name
      AND (IF s_DbType2 = "PROGRESS"
           THEN DICTDB2._File._Owner = "PUB" OR DICTDB2._File._Owner = "_FOREIGN"
           ELSE DICTDB2._File._Owner = "_FOREIGN")
      AND (IF s_DbType2 <> "PROGRESS"
           THEN LOOKUP(DICTDB2._File._File-name, l_sys-obj) =  0
           ELSE yes).
  
    /* clean out working storage */
    FOR EACH field-list:
      DELETE field-list.
    END.
    FOR EACH index-list:
      DELETE index-list.
    END.

      /* write out appropriate file definition changes */
    ASSIGN
      j      = 1
      ddl    = ""
      ddl[1] = 'UPDATE TABLE "' + DICTDB._File._File-name + '"'.
    /*RUN dctquot IN h_dmputil (DICTDB._File._File-Attributes[1],'"',OUTPUT c).*/
    IF DICTDB._File._File-Attributes[1] = yes AND AVAILABLE DICTDB2._File and DICTDB2._File._File-Attributes[1] = no THEN
    ASSIGN j = j + 1
           ddl[j] = "  MULTITENANT " + STRING(DICTDB._File._File-Attributes[1]) .
    ELSE IF DICTDB._File._File-Attributes[1] = no AND AVAILABLE DICTDB2._File AND DICTDB2._File._File-Attributes[1] = yes THEN  
    DO:
        ASSIGN s_errorsLogged = TRUE.
        OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
            PUT STREAM err-log UNFORMATTED new_lang[3] +
                        '"' + DICTDB._File._File-name  + '"'  + new_lang[43]     SKIP
                        '"' + LDBNAME("DICTDB2")       + '"'  + new_lang[49]     SKIP
                        '"' + LDBNAME("DICTDB")        + '"'  + new_lang[47]     SKIP.
                        
        OUTPUT STREAM err-log CLOSE.
    END.
    RUN dctquot IN h_dmputil (DICTDB._File._Can-Read,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Can-read,"NE",DICTDB2._File._Can-read,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CAN-READ " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Can-Write,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Can-write,"NE",DICTDB2._File._Can-write,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CAN-WRITE " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Can-Create,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Can-create,"NE",DICTDB2._File._Can-create,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CAN-CREATE " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Can-Delete,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Can-delete,"NE",DICTDB2._File._Can-delete,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CAN-DELETE " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Can-Dump,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Can-Dump,"NE",DICTDB2._File._Can-Dump,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CAN-DUMP " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Can-Load,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Can-Load,"NE",DICTDB2._File._Can-Load,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CAN-LOAD " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Desc,'"',OUTPUT c).
    IF DICTDB._File._Desc <> DICTDB2._File._Desc THEN ASSIGN
      j = j + 1
      ddl[j] = "  DESCRIPTION " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._File-label,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._File-label,"NE",DICTDB2._File._File-label,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  LABEL " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._File-label-SA,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._File-label-SA,"NE",DICTDB2._File._File-label-SA,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  LABEL-SA " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Valexp,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Valexp,"NE",DICTDB2._File._Valexp,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  VALEXP " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Valmsg,'"',OUTPUT c).
    IF DICTDB._File._Valmsg <> DICTDB2._File._Valmsg THEN ASSIGN
      j = j + 1
      ddl[j] = "  VALMSG " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Valmsg-SA,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Valmsg-SA,"NE",DICTDB2._File._Valmsg-SA,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  VALMSG-SA " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Dump-name,'"',OUTPUT c).
    IF DICTDB._File._Dump-name <> DICTDB2._File._Dump-name THEN ASSIGN
      j = j + 1
      ddl[j] = "  DUMP-NAME " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._category,'"',OUTPUT c).
    IF COMPARE(DICTDB._File._category,"NE",DICTDB2._File._category,"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  CATEGORY " + c.
    RUN dctquot IN h_dmputil (DICTDB._File._Fil-misc2[6],'"',OUTPUT c).
    IF COMPARE(DICTDB._File._Fil-misc2[6],"NE",DICTDB2._File._Fil-misc2[6],"RAW") THEN ASSIGN
      j = j + 1
      ddl[j] = "  FILE-MISC26 " + c.
    IF DICTDB._File._Hidden <> DICTDB2._File._Hidden THEN DO:
        IF DICTDB._File._Hidden THEN 
          ASSIGN j = j + 1    
                 ddl[j] = "  HIDDEN ".
        ELSE
          ASSIGN j = j + 1
                 ddl[j] = " NOT-HIDDEN ".
    END.
    IF DICTDB._File._Frozen <> DICTDB2._File._Frozen AND NOT DICTDB2._File._Frozen THEN
        ASSIGN j = j + 1
               ddl[j] = "  FROZEN".
  
    /* let's cache the encryption info and object attributes in temp-tables */
    IF VALID-OBJECT(myEPolicy[1]) OR VALID-OBJECT(myObjAttrs[1]) THEN DO:

       IF  VALID-OBJECT(myEPolicy[1]) THEN
           myEPolicy[1]:getPolicyVersions(DICTDB._File._File-Number, 
                                          DICTDB._File._File-Name, 
                                          "Table", 
                                          OUTPUT DATASET dsObjAttrs BY-REFERENCE).

       IF VALID-OBJECT(myObjAttrs[1]) and not DICTDB._File._File-attributes[1] THEN
           myObjAttrs[1]:getObjectAttributes(DICTDB._File._File-Number, 
                                             DICTDB._File._File-Name, 
                                             "Table", 
                                             OUTPUT DATASET dsObjAttrs BY-REFERENCE). 

       IF VALID-OBJECT(myEPolicy[2]) OR VALID-OBJECT(myObjAttrs[2]) THEN DO:
           /* need to save away old and new name for table if different, so we find the
              right object when comparing the encryption policies.
           */
           IF DICTDB._File._File-Name NE DICTDB2._File._File-Name THEN DO:
               CREATE renameList.
               ASSIGN renameList.old-name = DICTDB2._File._File-Name
                      renameList.new-name = DICTDB._File._File-Name.
           END.

           IF VALID-OBJECT(myEPolicy[2]) THEN
               myEPolicy[2]:getPolicyVersions(DICTDB2._File._File-Number, 
                                              DICTDB2._File._File-Name,
                                              "Table", 
                                              OUTPUT DATASET dsObjAttrs2 BY-REFERENCE).
           IF VALID-OBJECT(myObjAttrs[2]) and not DICTDB2._File._File-attributes[1]THEN 
               myObjAttrs[2]:getObjectAttributes(DICTDB2._File._File-Number, 
                                                 DICTDB2._File._File-Name, 
                                                 "Table", 
                                                 OUTPUT DATASET dsObjAttrs2 BY-REFERENCE). 
       END.
    END.

    /* deal with file triggers */
    /* 1st, find ones to be deleted */
    FOR EACH DICTDB2._File-trig OF DICTDB2._File:
      FIND DICTDB._File-trig OF DICTDB._File
        WHERE DICTDB._File-trig._Event = DICTDB2._File-trig._Event NO-ERROR.
      IF NOT AVAILABLE DICTDB._File-trig THEN DO:
        RUN dctquot IN h_dmputil (DICTDB2._File-trig._Event,'"',OUTPUT c).
        j = j + 1.
        ddl[j] = "  TABLE-TRIGGER " + c + " DELETE".
      END.
    END.
    /* now record updated or new ones */
    FOR EACH DICTDB._File-trig OF DICTDB._File:
      FIND DICTDB2._File-trig OF DICTDB2._File 
        WHERE DICTDB2._File-trig._Event = DICTDB._File-trig._Event NO-ERROR.
      IF AVAILABLE DICTDB2._File-trig AND 
        DICTDB2._File-trig._Override = DICTDB._File-trig._Override AND
        DICTDB2._File-trig._Proc-name = DICTDB._File-trig._Proc-name AND
        DICTDB2._File-trig._Trig-CRC = DICTDB._File-trig._Trig-CRC THEN
        NEXT.
        
      RUN dctquot IN h_dmputil (DICTDB._File-trig._Event,'"',OUTPUT c).
      j = j + 1.
      ddl[j] = "  TABLE-TRIGGER " + c +
               (IF DICTDB._File-trig._Override THEN " OVERRIDE " 
                                               ELSE " NO-OVERRIDE ").
      RUN dctquot IN h_dmputil (DICTDB._File-trig._Proc-name,'"',OUTPUT c).
      ddl[j] = ddl[j] + "PROCEDURE " + c + " CRC """ 
               + (IF DICTDB._File-trig._Trig-CRC = ? 
                  THEN "?" ELSE STRING(DICTDB._File-trig._Trig-CRC))
               + """".
    END.
    
 
  
    /* don't write out ddl[1] if j = 1 (i.e., we only have table header) */
    IF j > 1 THEN 
      DO i = 1 TO j + 1:
        IF ddl[i] = "" THEN  /* this puts an extra skip after the last one */
          PUT STREAM ddl UNFORMATTED SKIP(1).
        ELSE
          PUT STREAM ddl UNFORMATTED ddl[i] SKIP.
      END.
  
    /* build missing field list for rename/delete determination */
    FOR EACH DICTDB2._Field OF DICTDB2._File BY DICTDB2._Field._field-rpos:
      FIND FIRST DICTDB._Field OF DICTDB._File 
        WHERE DICTDB._Field._Field-name = DICTDB2._Field._Field-name NO-ERROR.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY DICTDB2._Field._Field-name @ fld WITH FRAME seeking.
      IF AVAILABLE DICTDB._Field THEN DO: 
          /* OE00147106
             If the type or extent changed we need to give the user
             the option of selecting another field in case the original
             one still exists with a different name.
          */
          IF DICTDB._Field._Data-type EQ DICTDB2._Field._Data-type AND
             DICTDB._Field._Extent EQ DICTDB2._Field._Extent THEN NEXT.
          ELSE DO:
              /* SQL timestamp/datetime is not a difference. int -> int64
                 is not a change that require a field to be recreated,
                 so don't need to check in those cases.
              */
              IF NOT(DICTDB._Field._Dtype = 41 AND DICTDB2._Field._Dtype = 4) 
                  AND NOT (DICTDB._Field._Dtype = DICTDB2._Field._Dtype AND
                  DICTDB._Field._Dtype = 34) THEN DO:
                  /* create a missing record with crit = yes - special case */
                  CREATE missing.
                  ASSIGN missing.name = DICTDB2._Field._Field-name
                         missing.crit = YES.
              END.

              NEXT. /* go to the next record */
          END.
      END.
      CREATE missing.
      missing.name = DICTDB2._Field._Field-name.
    END.
  
    /* build field rename list */
    FOR EACH DICTDB._Field OF DICTDB._File BY DICTDB._Field._field-rpos:
      FIND FIRST DICTDB2._Field OF DICTDB2._File
        WHERE DICTDB2._Field._Field-name = DICTDB._Field._Field-name NO-ERROR.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY DICTDB._Field._Field-name @ fld WITH FRAME seeking.
      CREATE field-list.
      field-list.f1-name = DICTDB._Field._Field-name.
      IF AVAILABLE DICTDB2._Field THEN
        ASSIGN field-list.f2-name = DICTDB._Field._Field-name.
    END.

    /* look for matches for renamed fields with user input.  A prompt 
       is given for each field in DICTDB2 that's not in DICTDB but only when
       there is also a field in DICTDB that's not in DICTDB2.  The 2nd list
       is the potential values to rename to.
    */

    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      run adecomm/_setcurs.p ("").
    ELSE DO:  /* 02/01/29 vap (IZ# 1525) */
      ASSIGN p-comma = "":U
             p-list  = "":U.
      FOR EACH field-list WHERE
               field-list.f2-name = ?:
        ASSIGN p-list  = p-list + p-comma + field-list.f1-name
               p-comma = ",":U.
      END.
    END.
    user_env[19] = DICTDB._File._File-name. /* this is a hack */
    FOR EACH missing:
      /* 02/01/29 vap (IZ# 1525) */
      IF NOT p-batchmode and not p-silentincrd THEN DO:
        DISPLAY missing.name @ fld WITH FRAME seeking.
        /* OE00147106 If crit = yes, this is a special case. See above */
        IF missing.crit = YES THEN
            RUN "prodict/dump/_dmpisub.p"
              (INPUT "fc",INPUT-OUTPUT missing.name,OUTPUT ans).
        ELSE
            RUN "prodict/dump/_dmpisub.p"
              (INPUT "f",INPUT-OUTPUT missing.name,OUTPUT ans).
        /* we always delete the missing record if crit = yes */
        IF missing.name = ? OR missing.crit THEN DELETE missing.
        IF ans = ? THEN DO:    
          HIDE FRAME seeking NO-PAUSE.
          user_path = "".
          RETURN.
        END.
      END.  /* NOT p-batchmode */
      ELSE DO:  /* 02/01/29 vap (IZ# 1525) */
        ASSIGN p-foo = checkRenameField(DICTDB._File._File-name,
                                        missing.name, p-list).
        IF p-foo NE ? THEN DO:
           FIND FIRST field-list WHERE
                      field-list.f1-name = p-foo AND
                      field-list.f2-name = ?
                      NO-ERROR.
           IF AVAILABLE(field-list) THEN DO:
             ASSIGN field-list.f2-name = missing.name.

             IF missing.crit = YES THEN DO: /* OE00147106 special case */
                 /* fix the original field-list record so that we consider
                    it a new field .
                 */
                 FIND FIRST field-list WHERE field-list.f1-name = missing.name.
                 ASSIGN field-list.f2-name = ?.
             END.
           END.
           DELETE missing.
        END.  /* p-foo NE ? */
        ELSE IF missing.crit = YES THEN
            DELETE missing. /* always delete missing if crit = yes */

      END.  /* p-batchmode */
    END.
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      run adecomm/_setcurs.p ("WAIT").
  
    /* We use to handle deleted fields here but now it's done after
       index stuff.  See below.
     */
    
    /* handle renamed fields */
    ans = FALSE.
    FOR EACH field-list
      WHERE field-list.f1-name <> field-list.f2-name 
        AND field-list.f2-name <> ?:
      FIND FIRST DICTDB._Field OF DICTDB._File
        WHERE DICTDB._Field._Field-name = field-list.f1-name.
      FIND FIRST DICTDB2._Field OF DICTDB2._File
        WHERE DICTDB2._Field._Field-name = field-list.f1-name NO-ERROR.

      ans = TRUE.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY field-list.f1-name @ fld2 WITH FRAME seeking.

      /* If the field is in an index and a critical aspect of it changed,
         such as data-type or extent, it will be handled later */
      IF AVAILABLE DICTDB2._Field                               AND
         (DICTDB._Field._Data-type <> DICTDB2._Field._Data-type OR
          DICTDB._Field._Extent    <> DICTDB2._Field._Extent)   THEN NEXT.

      PUT STREAM ddl UNFORMATTED
        'RENAME FIELD "' field-list.f2-name
        '" OF "' DICTDB._File._File-name
        '" TO "' field-list.f1-name '"' SKIP.
    END.
    IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  
    ASSIGN i-to-int64 = 0.

    /* handle new or potentially altered fields */
    FOR EACH field-list:
      FIND FIRST DICTDB._Field OF DICTDB._File
        WHERE DICTDB._Field._Field-name = field-list.f1-name.
      FIND FIRST DICTDB2._Field OF DICTDB2._File
        WHERE DICTDB2._Field._Field-name = field-list.f2-name NO-ERROR.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY field-list.f1-name @ fld2 WITH FRAME seeking.

      ASSIGN l = AVAILABLE DICTDB2._Field
             to-int64 = FALSE.

      /* 20060220-021 
         In 10.1A, SQL timestamp is now datetime, in which case it's not a
         difference, so we need to check if the dype if 34.
      */
      IF l THEN DO:

        IF DICTDB._Field._Data-type <> DICTDB2._Field._Data-type THEN DO:
            
           /* check if this is a change from integer to int64 */
           ASSIGN to-int64 = (DICTDB._Field._Dtype = 41 AND DICTDB2._Field._Dtype = 4).

           IF DICTDB._Field._Dtype = DICTDB2._Field._Dtype AND
              DICTDB._Field._Dtype = 34 THEN
              ans = FALSE.
           ELSE IF to-int64 THEN
               /* we will allow integer to int64 changes */
               ASSIGN ans = FALSE
                      i-to-int64 = i-to-int64 + 1.
           ELSE
              ans = TRUE.
        END.
        ELSE DO:
           ans = FALSE.

           IF DICTDB._Field._Data-type = "CLOB" THEN DO:
               /* OE00177533 - if a clob field, check if there was a change
                  in codepage or collation */
               IF (DICTDB._Field._Charset NE DICTDB2._Field._Charset) OR 
                   (DICTDB._Field._Collation NE DICTDB2._Field._Collation) THEN
                   ans = TRUE.
           END.
        END.
      END.
      
      IF l AND (ans OR DICTDB._Field._Extent <> DICTDB2._Field._Extent) THEN DO:

        /* If DICTDB2 field is part of a primary index, we cannot simply drop it.
         * instead, we will rename it to something else, and delete it
         * later, after the indexes are processed.
         */
        IF inprimary(INPUT DICTDB2._File._Prime-Index,
                     INPUT RECID(DICTDB2._Field)) THEN DO:
          
          /* field is part of primary index, don't DROP*/
          RUN tmp-name IN h_dmputil (INPUT DICTDB2._Field._Field-name,
                                     OUTPUT tmp_Field-name).
          PUT STREAM ddl UNFORMATTED
            'RENAME FIELD "' DICTDB2._Field._Field-name
            '" OF "' DICTDB2._File._File-name
            '" TO "' tmp_Field-name '"' SKIP.
          CREATE missing. 
          ASSIGN missing.name = tmp_Field-name. /*record name to 'DROP' later*/
                            l = false.          
        END.
        ELSE IF inindex(INPUT RECID(DICTDB2._File),
                        INPUT RECID(DICTDB2._Field)) THEN  DO:
        
          RUN tmp-name IN h_dmputil (INPUT DICTDB2._Field._Field-name,
                                     OUTPUT tmp_Field-name).
          PUT STREAM ddl UNFORMATTED
            'RENAME FIELD "' DICTDB2._Field._Field-name
            '" OF "' DICTDB2._File._File-name
            '" TO "' tmp_Field-name '"' SKIP.
          CREATE missing. 
          ASSIGN missing.name = tmp_Field-name. /*record name to 'DROP' later*/
                            l = false.     
        END.
        ELSE DO: /* is not in a primary index, we can DROP it now */
        
          /* We need to know it has been dropped in case it is a component *
           * of an index.  In that case, we don't want to drop the index   *
           * because dropping the field accomplished that.                 *
           * 19981112-011                                             */

          CREATE drop-list.
          ASSIGN drop-list.file-name  = DICTDB._File._File-Name
                 drop-list.f1-name    = field-list.f1-name
                 drop-list.f2-name    = field-list.f2-name.
          PUT STREAM ddl UNFORMATTED
            'DROP FIELD "' DICTDB._Field._Field-name
            '" OF "' DICTDB._File._File-name '"' SKIP.
          RELEASE DICTDB2._Field.
          l = FALSE.
        END.
      END.
      /* If l is true we're updating otherwise we're adding */
      /* we are checking if case-sensitive is diffrent in both db's field 
       If they are changes we have to check if it is part of any index. If it is, then we have to drop index and 
       then recreate. */
      IF l and DICTDB._Field._Fld-case <> DICTDB2._Field._Fld-case THEN 
      DO:                                                               
          FIND FIRST DICTDB2._Index-Field WHERE DICTDB2._Index-Field._Field-recid = RECID(DICTDB2._Field) NO-LOCK .
          IF AVAIL(DICTDB2._Index-Field) THEN
          DO:
              FIND FIRST DICTDB2._Index WHERE RECID(DICTDB2._Index) = DICTDB2._Index-Field._Index-recid NO-LOCK .
              IF AVAIL(DICTDB2._Index) 
              AND CAN-FIND(FIRST DICTDB._Index WHERE DICTDB._Index._Index-Name = DICTDB2._Index._Index-Name
                  AND DICTDB._Index._File-recid = RECID(DICTDB._File) ) THEN
              DO:
                 ASSIGN isIndexDel = yes
                        indxRecid  = RECID(DICTDB2._Index).
                 PUT STREAM ddl UNFORMATTED
                 'DROP INDEX "' DICTDB2._Index._Index-Name
                 '" ON "' DICTDB2._File._File-Name '"' SKIP(1).
              END.
              ELSE
              Assign isIndexDel = no.
          END.
      END.
      ASSIGN ddl    = ""
             ddl[1] = (IF l THEN "UPDATE" ELSE "ADD")
                      + ' FIELD "' + DICTDB._Field._Field-name
                      + '" OF "' + DICTDB._File._File-name + '"'
                      + (IF l AND NOT to-int64 THEN "" ELSE " AS " + DICTDB._Field._Data-type).

      /* don't write lines with unknown or blank value (like we do in _dmpdefs.p) */
      IF NOT l AND (DICTDB._Field._Desc = ? OR DICTDB._Field._Desc = '') THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Desc,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Desc,"NE",DICTDB2._Field._Desc,"RAW") THEN 
               ddl[2] = "  DESCRIPTION " + c.
      END.

      RUN dctquot IN h_dmputil (DICTDB._Field._Format,'"',OUTPUT c).
      IF NOT l OR COMPARE(DICTDB._Field._Format,"NE",DICTDB2._Field._Format,"RAW") THEN 
        ddl[3] = "  FORMAT " + c.
      
      IF NOT l AND (DICTDB._Field._Format-SA = ? OR DICTDB._Field._Format-SA = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Format-SA,'"',OUTPUT c).
          IF NOT l OR 
              /* ignore this field if they are a combination of ? and empty strings */
              (CHECK_SA_FIELDS(DICTDB._Field._Format-SA,DICTDB2._Field._Format-SA) AND 
              COMPARE(DICTDB._Field._Format-SA,"NE",DICTDB2._Field._Format-SA,"RAW")) THEN
            ddl[4] = "  FORMAT-SA " + c.
      END.

      IF NOT l OR DICTDB._Field._Field-rpos <> DICTDB2._Field._Field-rpos THEN 
        ddl[5] = "  POSITION " + STRING(DICTDB._Field._Field-rpos).       

      RUN dctquot IN h_dmputil (DICTDB._Field._Initial,'"',OUTPUT c).
      IF NOT l OR COMPARE(DICTDB._Field._Initial,"NE",DICTDB2._Field._Initial,"RAW") THEN
        ddl[6] = "  INITIAL " + c.

      IF NOT l AND (DICTDB._Field._Initial-SA = ? OR DICTDB._Field._Initial-SA = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Initial-SA,'"',OUTPUT c).
          IF NOT l OR 
               /* ignore this field if they are a combination of ? and empty strings */
               (CHECK_SA_FIELDS(DICTDB._Field._Initial-SA,DICTDB2._Field._Initial-SA) AND 
                 COMPARE(DICTDB._Field._Initial-SA,"NE",DICTDB2._Field._Initial-SA,"RAW")) THEN
            ddl[7] = "  INITIAL-SA " + c.
      END.

      IF NOT l AND (DICTDB._Field._Help = ? OR DICTDB._Field._Help = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Help,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Help,"NE",DICTDB2._Field._Help,"RAW") THEN
            ddl[8] = "  HELP " + c.
      END.

      IF NOT l AND (DICTDB._Field._Help-SA = ? OR DICTDB._Field._Help-SA = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Help-SA,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Help-SA,"NE",DICTDB2._Field._Help-SA,"RAW") THEN
            ddl[9] = "  HELP-SA " + c.
      END.

      IF NOT l AND DICTDB._Field._Label = ? THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Label,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Label,"NE",DICTDB2._Field._Label,"RAW") THEN
            ddl[10] = "  LABEL " + c.
      END.

      IF NOT l AND (DICTDB._Field._Label-SA = ? OR DICTDB._Field._Label-SA = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Label-SA,'"',OUTPUT c).
          IF NOT l OR 
                 /* ignore this field if they are a combination of ? and empty strings */
                 (CHECK_SA_FIELDS(DICTDB._Field._Label-SA,DICTDB2._Field._Label-SA) AND 
                 COMPARE(DICTDB._Field._Label-SA,"NE",DICTDB2._Field._Label-SA,"RAW")) THEN
            ddl[11] = "  LABEL-SA " + c.
      END.

      IF NOT l AND DICTDB._Field._Col-label = ? THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Col-label,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Col-label,"NE",DICTDB2._Field._Col-label,"RAW") THEN
            ddl[12] = "  COLUMN-LABEL " + c.
      END.

      IF NOT l AND (DICTDB._Field._Col-label-SA = ? OR DICTDB._Field._Col-label-SA = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Col-label-SA,'"',OUTPUT c).
          IF NOT l OR 
                  /* ignore this field if they are a combination of ? and empty strings */
                  (CHECK_SA_FIELDS(DICTDB._Field._Col-label-SA,DICTDB2._Field._Col-label-SA) AND 
                   COMPARE(DICTDB._Field._Col-label-SA,"NE",DICTDB2._Field._Col-label-SA,"RAW")) THEN
            ddl[13] = "  COLUMN-LABEL-SA " + c.
      END.

      /* don't write default value for new field */
      IF NOT l AND DICTDB._Field._Can-Read = '*' THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Can-Read,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Can-read,"NE",DICTDB2._Field._Can-read,"RAW") THEN
            ddl[14] = "  CAN-READ " + c.
      END.

      /* don't write default value for new field */
      IF NOT l AND DICTDB._Field._Can-Write = '*' THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Can-Write,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Can-write,"NE",DICTDB2._Field._Can-write,"RAW") THEN
            ddl[15] = "  CAN-WRITE " + c.
      END.

      IF NOT l AND (DICTDB._Field._Valexp = ? OR DICTDB._Field._Valexp = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Valexp,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Valexp,"NE",DICTDB2._Field._Valexp,"RAW") THEN
            ddl[16] = "  VALEXP " + c.
      END.

      IF NOT l AND (DICTDB._Field._Valmsg = ? OR DICTDB._Field._Valmsg = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Valmsg,'"',OUTPUT c).
          IF NOT l OR DICTDB._Field._Valmsg <> DICTDB2._Field._Valmsg THEN
            ddl[17] = "  VALMSG " + c.
      END.

      IF NOT l AND (DICTDB._Field._Valmsg-SA = ? OR DICTDB._Field._Valmsg-SA = '' ) THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._Valmsg-SA,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._Valmsg-SA,"NE",DICTDB2._Field._Valmsg-SA,"RAW") THEN
            ddl[18] = "  VALMSG-SA " + c.
      END.

      IF NOT l AND DICTDB._Field._View-as = ? THEN .
      ELSE DO:
          RUN dctquot IN h_dmputil (DICTDB._Field._View-as,'"',OUTPUT c).
          IF NOT l OR COMPARE(DICTDB._Field._View-as,"NE",DICTDB2._Field._View-as,"RAW") THEN
            ddl[19] = "  VIEW-AS " + c.
      END.

      IF NOT l AND DICTDB._Field._Extent = 0 THEN .
      ELSE DO:
          IF NOT l OR DICTDB._Field._Extent <> DICTDB2._Field._Extent THEN
            ddl[20] = "  EXTENT " + STRING(DICTDB._Field._Extent).
      END.

      IF NOT l AND DICTDB._Field._Decimals = ? THEN .
      ELSE DO:
          IF NOT l OR DICTDB._Field._Decimals <> DICTDB2._Field._Decimals THEN
            ddl[21] = "  DECIMALS " + (IF DICTDB._Field._Decimals = ? THEN "?"
                        ELSE STRING(DICTDB._Field._Decimals)).
      END.

      IF NOT l OR DICTDB._Field._Order <> DICTDB2._Field._Order THEN
        ddl[22] = "  ORDER " + STRING(DICTDB._Field._Order).

      IF NOT l AND NOT DICTDB._Field._Mandatory THEN .
      ELSE IF NOT l OR DICTDB._Field._Mandatory <> DICTDB2._Field._Mandatory THEN
        ddl[23] = (IF DICTDB._Field._Mandatory
                    THEN "  MANDATORY" ELSE "  NULL-ALLOWED").

      IF NOT l AND NOT DICTDB._Field._Fld-case THEN .
      ELSE IF NOT l OR DICTDB._Field._Fld-case <> DICTDB2._Field._Fld-case THEN
        ddl[24] = (IF DICTDB._Field._Fld-case
                    THEN "  CASE-SENSITIVE" ELSE "  NOT-CASE-SENSITIVE").

      IF NOT l AND CAN-DO("BLOB,CLOB",DICTDB._Field._Data-type) THEN DO:
        FIND DICTDB._storageobject WHERE DICTDB._Storageobject._Db-recid = RECID(DICTDB._Db)
                                AND DICTDB._Storageobject._Object-type = 3
                                AND DICTDB._Storageobject._Object-number = DICTDB._Field._Fld-stlen
                                and DICTDB._Storageobject._Partitionid   = 0                
                              NO-LOCK.
        FIND DICTDB._Area WHERE DICTDB._Area._Area-number = DICTDB._StorageObject._Area-number NO-LOCK .
        
        ASSIGN ddl[25] = "  LOB-AREA " + IF AVAIL DICTDB._Area THEN QUOTER(DICTDB._Area._Area-name) ELSE ''
               ddl[26] = "  LOB-BYTES "+ STRING(DICTDB._Field._Width)
               ddl[27] = "  LOB-SIZE " + DICTDB._Field._Fld-Misc2[1].

        IF DICTDB._Field._Data-Type = "CLOB" THEN
          ASSIGN ddl[28] = "  CLOB-CODEPAGE "  + DICTDB._Field._Charset
                 ddl[29] = "  CLOB-COLLATION " + DICTDB._Field._Collation
                 ddl[30] = "  CLOB-TYPE "      + STRING(DICTDB._Field._Attributes1).
      END.
      /* Changing blob/clob field */
      ELSE IF l AND CAN-DO("BLOB,CLOB",DICTDB._Field._Data-type) THEN DO:
        IF DICTDB._Field._Width <> DICTDB2._Field._Width THEN
            ddl[25] = "  LOB-BYTES " + STRING(DICTDB._Field._Width).
        IF DICTDB._Field._Fld-Misc2[1] <> DICTDB2._Field._Fld-Misc2[1] THEN
            ddl[26] = "  LOB-SIZE " + DICTDB._Field._Fld-Misc2[1].

        IF DICTDB._Field._Data-type = "CLOB" AND
           DICTDB._Field._Attributes1  <> DICTDB2._Field._Attributes1 THEN DO:

          IF DICTDB._Field._Attributes1 = 1 AND DICTDB2._Field._Attributes1 = 2 THEN DO:
             /* OE00177533 - can't change it from 2 to 1 in the target db 
               if the codepage of the db and column are not the same */
             IF UPPER(DICTDB2._Field._Charset) EQ UPPER(DICTDB2._Db._db-xl-name) THEN
                 ddl[27] = "  CLOB-TYPE "      + STRING(DICTDB._Field._Attributes1).
          END.
          ELSE
             ddl[27] = "  CLOB-TYPE "      + STRING(DICTDB._Field._Attributes1).
        END.

        FIND DICTDB._storageobject WHERE DICTDB._Storageobject._Db-recid = RECID(DICTDB._Db)
                                AND DICTDB._Storageobject._Object-type = 3
                                AND DICTDB._Storageobject._Object-number = DICTDB._Field._Fld-stlen
                                and DICTDB._Storageobject._Partitionid   = 0                
                                NO-LOCK. 
        FIND DICTDB2._storageobject WHERE DICTDB2._Storageobject._Db-recid = RECID(DICTDB2._Db)
                                AND DICTDB2._Storageobject._Object-type = 3
                                AND DICTDB2._Storageobject._Object-number = DICTDB2._Field._Fld-stlen
                                and DICTDB2._Storageobject._Partitionid   = 0                
                                NO-LOCK.
        IF DICTDB._StorageObject._Area-number <> DICTDB2._StorageObject._Area-number THEN DO:
          OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
   
          PUT STREAM err-log UNFORMATTED "Warning: Blob Field " +
                 '"' + DICTDB._Field._Field-name + '"' + new_lang[11] + 
                 '"' + LDBNAME("DICTDB") + '"'     SKIP
                 "and Blob Field " + '"' + DICTDB2._Field._Field-name + '"' +
                 new_lang[11] + '"' + LDBNAME("DICTDB2") + '"'   SKIP
                "are not in the same area." SKIP(1).
          OUTPUT STREAM err-log CLOSE.
          
          ASSIGN s_errorsLogged = TRUE.
        END.        
      END.
      ELSE IF NOT l OR DICTDB._Field._Width <> DICTDB2._Field._Width THEN
        ddl[25] = "  MAX-WIDTH " + STRING(DICTDB._Field._Width).

      /* let's cache the encryption info and/or object attributes in temp-tables 
         for BLOB and CLOB fields */
      IF CAN-DO("BLOB,CLOB",DICTDB._Field._Data-type) AND 
         (VALID-OBJECT(myEPolicy[1]) OR VALID-OBJECT(myObjAttrs[1])) THEN DO:

          IF VALID-OBJECT(myEPolicy[1]) THEN
             myEPolicy[1]:getPolicyVersions(DICTDB._Field._fld-stlen, 
                                            DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name, 
                                            DICTDB._Field._Data-type, 
                                            OUTPUT DATASET dsObjAttrs BY-REFERENCE).
    
         IF VALID-OBJECT(myObjAttrs[1]) and NOT DICTDB._File._File-attributes[1] 
             AND not DICTDB._Field._Field-attributes[1] THEN
             myObjAttrs[1]:getObjectAttributes(DICTDB._Field._fld-stlen, 
                                               DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name, 
                                               DICTDB._Field._Data-type, 
                                               OUTPUT DATASET dsObjAttrs BY-REFERENCE). 

         /* if field is available, do this too. Note that the object name is from the DICTDB db,
            even though we are reading DICTDB2, because the field may have been renamed.
         */
         IF l AND (VALID-OBJECT(myEPolicy[2]) OR VALID-OBJECT(myObjAttrs[2])) THEN DO:
         
             /* need to save away old and new name for field if different, so we find the
                right object when comparing the encryption policies.
             */
             IF DICTDB._File._File-Name   NE DICTDB2._File._File-Name OR 
                DICTDB._Field._Field-Name NE DICTDB2._Field._Field-Name THEN DO:
                 CREATE renameList.
                 ASSIGN renameList.old-name = DICTDB2._File._File-Name + "." + DICTDB2._Field._Field-Name
                        renameList.new-name = DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name.
             END.

             IF VALID-OBJECT(myEPolicy[2]) THEN
                 myEPolicy[2]:getPolicyVersions(DICTDB2._Field._fld-stlen, 
                                                DICTDB2._File._File-Name + "." + DICTDB2._Field._Field-Name, 
                                                DICTDB2._Field._Data-type, 
                                                OUTPUT DATASET dsObjAttrs2 BY-REFERENCE).

             IF VALID-OBJECT(myObjAttrs[2]) and NOT DICTDB2._File._File-attributes[1] 
                AND not DICTDB2._Field._Field-attributes[1] THEN
                 myObjAttrs[2]:getObjectAttributes(DICTDB2._Field._fld-stlen, 
                                                   DICTDB2._File._File-Name + "." + DICTDB2._Field._Field-Name, 
                                                   DICTDB2._Field._Data-type, 
                                                   OUTPUT DATASET dsObjAttrs2 BY-REFERENCE).
         END.
      END.

      /* deal with field triggers */
      /* 1st, find ones to be deleted if field is being updated */
      j = 31.
      IF l THEN
        FOR EACH DICTDB2._Field-trig OF DICTDB2._Field:
          FIND DICTDB._Field-trig OF DICTDB._Field
            WHERE DICTDB._Field-trig._Event = DICTDB2._Field-trig._Event 
                  NO-ERROR.
          IF NOT AVAILABLE DICTDB._Field-trig THEN DO:
            RUN dctquot IN h_dmputil (DICTDB2._Field-trig._Event,'"',OUTPUT c).
            j = j + 1.
            ddl[j] = "  FIELD-TRIGGER " + c + " DELETE".
          END.
        END.
      /* now record updated or new ones */
      FOR EACH DICTDB._Field-trig OF DICTDB._Field:
        FIND DICTDB2._Field-trig OF DICTDB2._Field 
          WHERE DICTDB2._Field-trig._Event = DICTDB._Field-trig._Event NO-ERROR.
        IF AVAILABLE DICTDB2._Field-trig AND 
          DICTDB2._Field-trig._Override = DICTDB._Field-trig._Override AND
          DICTDB2._Field-trig._Proc-name = DICTDB._Field-trig._Proc-name AND
          DICTDB2._Field-trig._Trig-CRC = DICTDB._Field-trig._Trig-CRC THEN
          NEXT.
          
        RUN dctquot IN h_dmputil (DICTDB._Field-trig._Event,'"',OUTPUT c).
        j = j + 1. 
        ddl[j] = "  FIELD-TRIGGER " + c +
                 (IF DICTDB._Field-trig._Override THEN " OVERRIDE " 
                                                  ELSE " NO-OVERRIDE ").
        RUN dctquot IN h_dmputil (DICTDB._Field-trig._Proc-name,'"',OUTPUT c).
        ddl[j] = ddl[j] + "PROCEDURE " + c + " CRC """ 
                 + (IF DICTDB._Field-trig._Trig-CRC = ? 
                    THEN "?" ELSE STRING(DICTDB._Field-trig._Trig-CRC))
                 + """".
      END. 
  
      /* don't write out header or anything unless there's values to output */
      l = FALSE.
      DO i = 2 TO j WHILE NOT l:
        l = ddl[i] <> "".
      END.
      IF l THEN DO i = 1 TO j:
        /* if ddl[i] = "" this doesn't do anything */
        PUT STREAM ddl UNFORMATTED ddl[i] SKIP.  
      END.
      ELSE IF to-int64 AND ddl[1] <> "" THEN /* write the type change from int to int64 */
          PUT STREAM ddl UNFORMATTED ddl[1] SKIP(1).  

      IF l THEN PUT STREAM ddl UNFORMATTED SKIP(1).
    END.         /* end FOR EACH field-list */  
  
    /* note that there is no user interface for resolving renamed
    indexes.  this is because we can completely match indexes by their
    component lists, which are invariant once the index is created.  */
    ASSIGN
      pri1   = ""
      pri2   = "".
    /* Checking if Drop Index statement has been generated or not in case of field case-sensitivity.
       If it has been generated then we need to create Index again. */
    
    IF isIndexDel THEN
    DO:
       FIND FIRST DICTDB2._Index WHERE RECID(DICTDB2._Index) = indxRecid NO-LOCK NO-ERROR.
       IF AVAIL(DICTDB2._Index) THEN
       DO:
           PUT STREAM ddl UNFORMATTED "ADD "
           'INDEX "' DICTDB2._Index._Index-Name
           '" ON "' DICTDB2._File._File-name '"' SKIP. 
           FIND FIRST DICTDB2._StorageObject where DICTDB2._StorageObject._Db-recid  = DICTDB2._File._Db-recid
           and DICTDB2._StorageObject._Object-type   = 2 
           and DICTDB2._StorageObject._Object-number = DICTDB2._Index._idx-num
           and DICTDB2._Storageobject._Partitionid   = 0  NO-LOCK NO-ERROR.
           IF AVAILABLE DICTDB2._StorageObject THEN
             FIND DICTDB2._Area WHERE DICTDB2._Area._Area-number = DICTDB2._StorageObject._Area-number NO-LOCK .
           ELSE
             FIND DICTDB2._Area WHERE DICTDB2._Area._Area-number = DICTDB2._Index._idx-num NO-LOCK .

           PUT STREAM ddl UNFORMATTED
             "  AREA " '"' IF AVAIL DICTDB2._Area THEN DICTDB2._Area._Area-name ELSE '' '"' SKIP.
           
           IF DICTDB2._Index._Unique THEN 
           DO:     
             PUT STREAM ddl UNFORMATTED "  UNIQUE" SKIP.
             IF NOT DICTDB2._Index._Active THEN
             PUT STREAM ddl UNFORMATTED "  INACTIVE" SKIP.
           END.
           ELSE IF NOT DICTDB2._Index._Active AND NOT DICTDB2._Index._Unique THEN
           PUT STREAM ddl UNFORMATTED "  INACTIVE" SKIP.
           
           IF DICTDB2._Index._Wordidx = 1 THEN 
             PUT STREAM ddl UNFORMATTED "  WORD" SKIP.
             
           IF DICTDB2._Index._Desc <> ? AND DICTDB2._Index._Desc <> '' THEN 
           DO:
              PUT STREAM ddl CONTROL "  DESCRIPTION ".
              EXPORT STREAM ddl DICTDB2._Index._Desc SKIP.
           END.
           
           FOR EACH DICTDB2._Index-field OF _Index,DICTDB2._Field OF _Index-field
           BREAK BY DICTDB2._Index-field._Index-seq:
             PUT STREAM ddl UNFORMATTED
               '  INDEX-FIELD "' DICTDB2._Field._Field-Name '" '
               TRIM(STRING(DICTDB2._Index-field._Ascending,"A/DE")) "SCENDING"
              (IF DICTDB2._Index-field._Abbreviate THEN " ABBREVIATED" ELSE "")
              (IF DICTDB2._Index-field._Unsorted   THEN " UNSORTED"    ELSE "") SKIP.
           END.
           PUT STREAM ddl UNFORMATTED SKIP(1).
           IF DICTDB2._File._Prime-Index = RECID(DICTDB2._Index) THEN
             PUT STREAM ddl UNFORMATTED
               'UPDATE PRIMARY INDEX "' DICTDB2._Index._Index-name
               '" ON "' DICTDB2._File._File-name '"' SKIP(1).
        END.       
    END.
    /* build index component match list */
    
    FOR EACH DICTDB2._Index OF DICTDB2._File:
      IF DICTDB2._Index._Index-name = "default" OR
          DICTDB2._Index._Index-name = "sql-default"  THEN NEXT.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY DICTDB2._Index._Index-name @ idx WITH FRAME seeking.
      c = STRING(DICTDB2._Index._Unique,"u/a")
        + (IF DICTDB2._Index._Wordidx = 1 THEN "w" ELSE "f").
      FOR EACH DICTDB2._Index-field OF DICTDB2._Index,
        DICTDB2._Field OF DICTDB2._Index-field:
        FIND FIRST field-list
          WHERE field-list.f2-name = DICTDB2._Field._Field-name NO-ERROR.
        c = c + ","
          + STRING(DICTDB2._Field._dtype) + ","
          + STRING(DICTDB2._Index-field._Ascending,"+/-")
          + STRING(DICTDB2._Index-field._Abbreviate,"y/n")
          + (IF AVAILABLE field-list THEN field-list.f2-name ELSE "*").
      END.
      CREATE index-list.
      ASSIGN
        index-list.i1-name = DICTDB2._Index._Index-name
        index-list.i1-comp = c
        index-list.i1-i2   = FALSE.
      IF DICTDB2._File._Prime-Index = RECID(DICTDB2._Index) THEN pri2 = c.
    END.
    FOR EACH DICTDB._Index OF DICTDB._File:
      IF DICTDB._Index._Index-name = "default" OR 
         DICTDB._Index._Index-name = "sql-default" THEN NEXT.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY DICTDB._Index._Index-name @ idx WITH FRAME seeking.
      c = STRING(DICTDB._Index._Unique,"u/a")
        + (IF DICTDB._Index._Wordidx = 1 THEN "w" ELSE "f").
      FOR EACH DICTDB._Index-field OF DICTDB._Index,
        DICTDB._Field OF DICTDB._Index-field:
        FIND FIRST field-list
          WHERE field-list.f1-name = DICTDB._Field._Field-name NO-ERROR.  
        c = c + ","
          + STRING(DICTDB._Field._dtype) + ","
          + STRING(DICTDB._Index-field._Ascending,"+/-")
          + STRING(DICTDB._Index-field._Abbreviate,"y/n")
          + (IF AVAIL field-list THEN field-list.f2-name ELSE DICTDB._Field._Field-name).
      END.
      CREATE index-list.
      ASSIGN
        index-list.i1-name = DICTDB._Index._Index-name
        index-list.i1-comp = c
        index-list.i1-i2   = TRUE.
      IF DICTDB._File._Prime-Index = RECID(DICTDB._Index) THEN pri1 = c.
    END.
    
    FOR EACH index-list WHERE index-list.i1-i2:
      FIND FIRST index-alt WHERE NOT index-alt.i1-i2 
                             AND index-alt.i1-name = index-list.i1-name NO-LOCK NO-ERROR.
      IF AVAILABLE index-alt AND index-list.i1-comp <> index-alt.i1-comp THEN DO:

        /* let's check if the only change is a int->int64 change, i-to-int64 will not be 0
           if we processed a int->int64 change for the current table
        */
        IF i-to-int64 NE 0 THEN DO:
       
            ASSIGN numEntries = NUM-ENTRIES(index-list.i1-comp)
                   i-to-int64 = 0
                   num-diff = 0.
    
            /* if the number of entries is different, then there were field deleted or added to the 
               index, so we just process it as usual .
            */
            IF numEntries EQ NUM-ENTRIES(index-alt.i1-comp) THEN DO:
                IF ENTRY(1, index-list.i1-comp) NE ENTRY(1, index-alt.i1-comp) THEN
                    num-diff = num-diff + 1.
                ELSE REPEAT i = 2 TO numEntries BY 2:
                    IF ENTRY(i + 1, index-list.i1-comp) NE ENTRY(i + 1, index-alt.i1-comp) THEN DO:
                       num-diff = num-diff + 1.
                       /* if anything other than data type is different, we have to recreate it, so 
                          leave now 
                       */
                       LEAVE.
                    END.
    
                    IF ENTRY(i, index-list.i1-comp) NE ENTRY(i, index-alt.i1-comp) THEN DO:
                        ASSIGN num-diff = num-diff + 1.
    
                        /* check if we are going from int->int64 */
                        IF ENTRY(i, index-list.i1-comp) = "41" AND
                           ENTRY(i, index-alt.i1-comp) = "4"  THEN
                           ASSIGN i-to-int64 = i-to-int64 + 1.
                        ELSE /* if other type change, leave now */
                            LEAVE.
                    END.
                END.
    
                /* if the only changes are from int->int64, then we are all set */
                IF num-diff EQ i-to-int64 THEN DO:
                    /* primary is also ok, so make them the same so we don't try to update it later */
                    IF pri1 = index-list.i1-comp AND pri2 = index-alt.i1-comp THEN
                       ASSIGN pri1 = pri2.
    
                    DELETE index-alt.
                    DELETE index-list.
                    
                    NEXT. /* go to the next index */
                END.
    
            END.
        END.

        RUN Check_Index_Conflict IN h_dmputil (INPUT index-alt.i1-name,
          INPUT DICTDB._File._File-name).

        CREATE drop-temp-idx.
        ASSIGN temp-name = index-alt.i1-name
               fil-name  = DICTDB._File._File-name.
      END.
    END.

    /* find all unchanged or renamed indexes by comparing idx comp lists */
    FOR EACH index-list WHERE index-list.i1-i2:    
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY index-list.i2-name @ idx WITH FRAME seeking.
      FIND FIRST index-alt WHERE NOT index-alt.i1-i2
        AND index-list.i1-comp = index-alt.i1-comp NO-ERROR.
      IF NOT AVAILABLE index-alt THEN NEXT.
     /* Determine if area has changed and issue warning if so */        
      FIND DICTDB._Index WHERE
           DICTDB._Index._Index-name = index-list.i1-name AND
           DICTDB._Index._File-recid = RECID(DICTDB._File) NO-ERROR.
      FIND DICTDB2._Index WHERE
           DICTDB2._Index._Index-name = index-alt.i1-name AND
           DICTDB2._Index._File-recid = RECID(DICTDB2._File) NO-ERROR.
      IF AVAIL DICTDB._Index AND AVAIL DICTDB2._Index THEN DO:
      
          IF NOT indexAreaMatch(INPUT DICTDB._Index._idx-num,
                                INPUT DICTDB2._Index._idx-num,
                                INPUT RECID(DICTDB._Db),
                                INPUT RECID(DICTDB2._DB)) THEN DO:
            ASSIGN s_errorsLogged = TRUE.
                
            OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
                
            PUT STREAM err-log UNFORMATTED new_lang[10] +
                     '"' + DICTDB._Index._Index-name + '"' + new_lang[11] + 
                     '"' + LDBNAME("DICTDB") + '"'     SKIP
                     new_lang[12] + DICTDB2._Index._Index-name + '"' +
                     new_lang[11] + '"' + LDBNAME("DICTDB2") + '"'   SKIP.
            DO i = 13 TO 16:          
              PUT STREAM err-log UNFORMATTED new_lang[i] SKIP.
            END.
                
            PUT STREAM err-log UNFORMATTED new_lang[17] SKIP(1).            
            OUTPUT STREAM err-log CLOSE.
          END.
    
          /* store encryption policy info */
          IF VALID-OBJECT(myEPolicy[1]) OR VALID-OBJECT(myObjAttrs[1]) THEN DO:
              IF VALID-OBJECT(myEPolicy[1])  THEN
                  myEPolicy[1]:getPolicyVersions(DICTDB._Index._Idx-num, 
                                                 DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                                 "Index", 
                                                 OUTPUT DATASET dsObjAttrs BY-REFERENCE).

              IF VALID-OBJECT(myObjAttrs[1]) and NOT DICTDB._File._File-attributes[1] 
                 AND not DICTDB._Index._Index-attributes[1] THEN
                  myObjAttrs[1]:getObjectAttributes(DICTDB._Index._Idx-num, 
                                                    DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                                    "Index", 
                                                    OUTPUT DATASET dsObjAttrs BY-REFERENCE).

              IF VALID-OBJECT(myEPolicy[2]) OR VALID-OBJECT(myObjAttrs[2]) THEN DO:
              
                  /* need to save away old and new name for field if different, so we find the
                     right object when comparing the encryption policies.
                  */
                  IF DICTDB._File._File-Name   NE DICTDB2._File._File-Name OR 
                     DICTDB._Index._Index-name NE DICTDB2._Index._Index-name THEN DO:
                      CREATE renameList.
                      ASSIGN renameList.old-name = DICTDB2._File._File-Name + "." + DICTDB2._Index._Index-name
                             renameList.new-name = DICTDB._File._File-Name + "." + DICTDB._Index._Index-name.
                  END.

                  IF VALID-OBJECT(myEPolicy[2]) THEN
                      myEPolicy[2]:getPolicyVersions(DICTDB2._Index._Idx-num, 
                                                     DICTDB2._File._File-Name + "." + DICTDB2._Index._Index-name, 
                                                     "Index", 
                                                     OUTPUT DATASET dsObjAttrs2 BY-REFERENCE).

                  IF VALID-OBJECT(myObjAttrs[2]) and NOT DICTDB2._File._File-attributes[1] 
                     AND not DICTDB2._Index._Index-attributes[1] THEN
                     myObjAttrs[2]:getObjectAttributes(DICTDB2._Index._Idx-num, 
                                                       DICTDB2._File._File-Name + "." +  DICTDB2._Index._Index-name, 
                                                       "Index", 
                                                       OUTPUT DATASET dsObjAttrs2 BY-REFERENCE).
                                                       

              END.
          END.

      END.

      ASSIGN index-list.i2-name = index-alt.i1-name.
      DELETE index-alt. 
    END.

   /* Now all index-list records where i1-i2 is false represent
      indexes in db2 that will not be renamed, therefore they will
      be deleted.   
    */

    /* check deactivation on unchanged indexes */
    FOR EACH index-list WHERE index-list.i1-name = index-list.i2-name:
      FIND DICTDB._Index OF DICTDB._File
        WHERE DICTDB._Index._Index-name = index-list.i1-name NO-ERROR.
      IF NOT AVAILABLE DICTDB._Index THEN NEXT.
      FIND DICTDB2._Index OF DICTDB2._File
        WHERE DICTDB2._Index._Index-name = index-list.i2-name NO-ERROR.
      IF NOT AVAILABLE DICTDB2._Index THEN NEXT.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY DICTDB._Index._Index-name @ idx2 WITH FRAME seeking.
      IF NOT DICTDB._Index._Active AND DICTDB2._Index._Active THEN DO:
        PUT STREAM ddl UNFORMATTED
          'UPDATE INACTIVE INDEX "' DICTDB._Index._Index-name
          '" OF "' DICTDB._File._File-name '"' SKIP.
        IF DICTDB._Index._Desc <> DICTDB2._Index._Desc THEN DO:
          PUT STREAM ddl CONTROL "  DESCRIPTION ".
          EXPORT STREAM ddl DICTDB._Index._Desc SKIP(1).         
        END.
      END.
      ELSE IF DICTDB._Index._Desc <> DICTDB2._Index._Desc THEN DO:
        PUT STREAM ddl UNFORMATTED
          'UPDATE INDEX "' DICTDB._Index._Index-name
               '" OF "' DICTDB._File._File-name '"' SKIP.
        PUT STREAM ddl CONTROL "  DESCRIPTION ".
        EXPORT STREAM ddl DICTDB._Index._Desc SKIP(1).        
      END. 
      DELETE index-list.
    END.
  
    /* handle renamed indexes */
    ans = FALSE.
    FOR EACH index-list WHERE index-list.i2-name <> ?:
      FIND DICTDB._Index OF DICTDB._File
        WHERE DICTDB._Index._Index-name = index-list.i1-name NO-ERROR.
      FIND DICTDB2._Index OF DICTDB2._File
        WHERE DICTDB2._Index._Index-name = index-list.i2-name NO-ERROR.
      IF NOT AVAILABLE DICTDB._Index OR NOT AVAILABLE DICTDB2._Index THEN NEXT.
      ans = TRUE.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY index-list.i1-name @ idx2 WITH FRAME seeking.
      RUN Check_Index_Conflict IN h_dmputil (INPUT index-list.i1-name,
          INPUT DICTDB._File._File-name).     
      PUT STREAM ddl UNFORMATTED
        'RENAME INDEX "' index-list.i2-name
        '" TO "' index-list.i1-name
        '" ON "' DICTDB._File._File-name '"' SKIP(1).
      IF NOT DICTDB._Index._Active AND DICTDB2._Index._Active THEN DO:
        PUT STREAM ddl UNFORMATTED
          'UPDATE INACTIVE INDEX "' DICTDB._Index._Index-name
          '" OF "' DICTDB._File._File-name '"' SKIP.
        IF DICTDB._Index._Desc <> DICTDB2._Index._Desc THEN DO:
          PUT STREAM ddl CONTROL "  DESCRIPTION ".
          EXPORT STREAM ddl DICTDB._Index._Desc SKIP(1).
        END.
      END.
      ELSE IF DICTDB._Index._Desc <> DICTDB2._Index._Desc THEN DO:
        PUT STREAM ddl UNFORMATTED
          'UPDATE INDEX "' DICTDB._Index._Index-name
               '" OF "' DICTDB._File._File-name '"' SKIP.
        PUT STREAM ddl CONTROL "  DESCRIPTION ".
        EXPORT STREAM ddl DICTDB._Index._Desc SKIP(1).
      END. 
      DELETE index-list.
    END.
    IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  
    /* check if unique indexes to be created as inactive */
    FOR EACH index-list WHERE index-list.i1-i2,
      EACH DICTDB._Index OF DICTDB._File
      WHERE DICTDB._Index._Index-name = index-list.i1-name
        AND DICTDB._Index._Unique AND DICTDB._Index._Active:
      /* 02/01/29 vap (IZ# 1525) */
      IF NOT p-batchmode and not p-silentincrd THEN DO:
        iact = TRUE.
        RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT iact,?,?,new_lang[2]).
      END.
      ELSE
        iact = p-index-mode NE "active":U.

      IF iact THEN DO:
        ASSIGN s_errorsLogged = TRUE.         
        OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
         
        PUT STREAM err-log UNFORMATTED
             new_lang[18]                                  SKIP
             new_lang[19]                                  SKIP
             new_lang[20]                                  SKIP(1).
         
        OUTPUT STREAM err-log CLOSE.
      END. 
      iact = NOT iact.
      LEAVE. /* we only need to ask once */
    END.
  
    /* handle new indexes */
    FOR EACH index-list WHERE index-list.i1-i2,
        DICTDB._Index OF DICTDB._File
        WHERE DICTDB._Index._Index-name = index-list.i1-name.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY DICTDB._Index._Index-name @ idx2 WITH FRAME seeking.
      /* Determine if a component of this index has been dropped.  If so,    *
       * no need to rename the index first.  Since the field is dropped,     *
       * the index no longer exists. Trying to rename it will cause a load   *
       * error.  Oh yes, this IS a hack way of doing it, but you find a      *
       * better way.                                                         */
      FIND FIRST drop-list WHERE
         (INDEX(index-list.i1-comp,drop-list.f1-name) > 0  OR
          INDEX(index-list.i1-comp,drop-list.f2-name) > 0) AND
         DICTDB._File._File-Name = drop-list.file-name NO-ERROR.
      IF NOT AVAIL drop-list THEN      
        RUN Check_Index_Conflict IN h_dmputil (INPUT index-list.i1-name,
          INPUT DICTDB._File._File-name).      
      PUT STREAM ddl UNFORMATTED "ADD "
        'INDEX "' DICTDB._Index._Index-Name
        '" ON "' DICTDB._File._File-name '"' SKIP.
      /* first - could have collation */
      FIND first DICTDB._StorageObject
         where DICTDB._StorageObject._Db-recid      = DICTDB._File._Db-recid
           and DICTDB._StorageObject._Object-type   = 2 
           and DICTDB._StorageObject._Object-number = DICTDB._Index._idx-num
           and DICTDB._Storageobject._Partitionid   = 0                       
      NO-LOCK NO-ERROR.
      
      IF AVAILABLE DICTDB._StorageObject THEN
         FIND DICTDB._Area WHERE
              DICTDB._Area._Area-number = DICTDB._StorageObject._Area-number
         NO-ERROR.
      ELSE
      FIND DICTDB._Area WHERE
           DICTDB._Area._Area-number = DICTDB._Index._idx-num NO-LOCK .
      IF AVAIL DICTDB._Area THEN   
      FIND DICTDB2._Area WHERE
           DICTDB2._Area._Area-name = DICTDB._Area._Area-name no-error.
      IF NOT AVAIL DICTDB2._Area THEN DO:
        ASSIGN s_errorsLogged = TRUE.        
        OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
         
        PUT STREAM err-log UNFORMATTED new_lang[3] +
             '"' + IF AVAIL DICTDB._Area THEN DICTDB._Area._Area-name ELSE '' + '"' + new_lang[21]     SKIP
             new_lang[22]                                           SKIP
             new_lang[23]                                           SKIP
             '"' + DICTDB._Index._Index-name + '"' + new_lang[24]   SKIP
             new_lang[25]                                           SKIP
             new_lang[26]                                           SKIP(1).
      
        OUTPUT STREAM err-log CLOSE.
      END.      
      IF AVAIL DICTDB._Area THEN   
      PUT STREAM ddl UNFORMATTED
         "  AREA " '"' DICTDB._Area._Area-name '"' SKIP.

      IF DICTDB._Index._Unique THEN DO:     
        PUT STREAM ddl UNFORMATTED "  UNIQUE" SKIP.
        IF NOT (DICTDB._Index._Active AND (IF iact = ? THEN TRUE ELSE iact)) THEN
        PUT STREAM ddl UNFORMATTED "  INACTIVE" SKIP.
      END.
      ELSE IF NOT DICTDB._Index._Active AND NOT DICTDB._Index._Unique THEN
          PUT STREAM ddl UNFORMATTED "  INACTIVE" SKIP.
      
      IF DICTDB._Index._Wordidx = 1 THEN 
        PUT STREAM ddl UNFORMATTED "  WORD" SKIP.
      IF DICTDB._Index._Desc <> ? AND DICTDB._Index._Desc <> '' THEN DO:
        PUT STREAM ddl CONTROL "  DESCRIPTION ".
        EXPORT STREAM ddl DICTDB._Index._Desc SKIP.
      END.
      FOR EACH DICTDB._Index-field OF _Index,DICTDB._Field OF _Index-field
        BREAK BY DICTDB._Index-field._Index-seq:
        PUT STREAM ddl UNFORMATTED
          '  INDEX-FIELD "' DICTDB._Field._Field-Name '" '
          TRIM(STRING(DICTDB._Index-field._Ascending,"A/DE")) "SCENDING"
          (IF DICTDB._Index-field._Abbreviate THEN " ABBREVIATED" ELSE "")
          (IF DICTDB._Index-field._Unsorted   THEN " UNSORTED"    ELSE "") SKIP.
      END.
      PUT STREAM ddl UNFORMATTED SKIP(1).

      /* store encryption policy info */
      IF VALID-OBJECT(myEPolicy[1]) THEN
          myEPolicy[1]:getPolicyVersions(DICTDB._Index._Idx-num, 
                                         DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                         "Index", 
                                         OUTPUT DATASET dsObjAttrs BY-REFERENCE).

      IF VALID-OBJECT(myObjAttrs[1]) and NOT DICTDB._File._File-attributes[1] 
         AND not DICTDB._Index._Index-attributes[1] THEN
          myObjAttrs[1]:getObjectAttributes(DICTDB._Index._Idx-num, 
                                            DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                            "Index", 
                                            OUTPUT DATASET dsObjAttrs BY-REFERENCE).
    END.
  
    /* set primary index */
    RELEASE DICTDB._Index.
    IF DICTDB._File._Prime-Index <> ? THEN
      FIND DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._File._Prime-Index
        NO-ERROR.
    IF AVAILABLE DICTDB._Index AND pri1 <> pri2 THEN
      PUT STREAM ddl UNFORMATTED
        'UPDATE PRIMARY INDEX "' DICTDB._Index._Index-name
        '" ON "' DICTDB._File._File-name '"' SKIP(1).

    /* handle deleted indexes */
    ans = FALSE.
    FOR EACH index-list WHERE NOT index-list.i1-i2:
      /* Determine if a component of this index has been dropped.  If so,    *
       * no need to drop the index; dropping it would cause a load error.    *
       * Oh yes, this IS a hack way of doing it, but you find a better way.  */
      FIND FIRST drop-temp-idx WHERE drop-temp-idx.temp-name = index-list.i1-name NO-ERROR.
        IF AVAILABLE drop-temp-idx THEN
           DELETE drop-temp-idx.
      FIND FIRST drop-list WHERE
         (INDEX(index-list.i1-comp,drop-list.f1-name) > 0  OR
          INDEX(index-list.i1-comp,drop-list.f2-name) > 0) AND
         DICTDB._File._File-Name = drop-list.file-name NO-ERROR.
      IF AVAIL drop-list THEN DO:        
         DELETE index-list.
             NEXT.
      END.
      ans = TRUE.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY index-list.i1-name @ idx2 WITH FRAME seeking.
      IF index-list.i1-name <> "default" AND
          index-list.i1-name <> "sql-default" THEN
        PUT STREAM ddl UNFORMATTED
          'DROP INDEX "' index-list.i1-name
          '" ON "' DICTDB._File._File-name '"' SKIP.
      DELETE index-list.
    END.
    IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).

    ans = FALSE.

    FOR EACH drop-temp-idx:
       PUT STREAM ddl UNFORMATTED
          'DROP INDEX "' temp-name
          '" ON "' Fil-name '"' SKIP.
       DELETE drop-temp-idx.
       IF NOT ans THEN ASSIGN ans =TRUE.
    END.
    IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).

    /* handle deleted fields.  
       Do this after index deletes since fields cannot be dropped when they 
       belong to a primary index.  This is not done for fields that were 
       dropped but replaced with another field (different data type or extent) 
       but with the same name.  This still has to be done above so we can add 
       the new field without conflict.
    */
    FIND FIRST missing NO-ERROR.
    ans = FALSE.
    FOR EACH missing:
      ans = TRUE.
      IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
        DISPLAY missing.name @ fld2 WITH FRAME seeking.
      PUT STREAM ddl UNFORMATTED
        'DROP FIELD "' missing.name
        '" OF "' DICTDB._File._File-name '"' SKIP.
      DELETE missing.
    END.
    IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  
  
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      HIDE MESSAGE.
    END.
/************************************************************************************************/
/********************************         constraint       **************************************/
/************************************************************************************************/

    FOR EACH DICTDB._Constraint OF DICTDB._File WHERE DICTDB._constraint._con-Status <> "O"
                          AND DICTDB._constraint._con-Status <> "D"
                          AND DICTDB._File._Db-recid = drec_db:
     Constr = "".
     FIND FIRST DICTDB2._Constraint OF DICTDB2._File WHERE DICTDB2._constraint._con-Status <> "O" 
                              AND DICTDB2._constraint._con-Status <> "D" 
                              AND DICTDB2._Constraint._Con-Name = DICTDB._Constraint._Con-Name
                              AND (IF s_DbType2 = "PROGRESS" 
                                   THEN DICTDB2._File._Db-recid = RECID(database2) 
                                   ELSE DICTDB2._File._Db-recid = s_DbRecId) NO-LOCK NO-ERROR.
     IF NOT AVAILABLE (DICTDB2._Constraint)
      THEN DO:
          FIND FIRST DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._Constraint._Index-Recid NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Field WHERE RECID(DICTDB._Field) = DICTDB._Constraint._Field-Recid NO-LOCK NO-ERROR.
          
          IF DICTDB._Constraint._Con-Type <> "F" THEN DO:
           
           Constr = Constr + 'ADD CONSTRAINT ' + '"' + DICTDB._Constraint._Con-Name + '" ON "' + DICTDB._File._File-Name + '"'+ "~n".
           IF  DICTDB._Constraint._Con-Type = "P" THEN       
                Constr = Constr + '  PRIMARY' + "~n".
           ELSE IF DICTDB._constraint._con-type = "PC" OR  DICTDB._constraint._con-type = "MP" THEN  
                Constr = Constr + '  PRIMARY-CLUSTERED' + "~n".
           ELSE IF DICTDB._Constraint._Con-Type = "M" THEN
                Constr = Constr + '  CLUSTERED' + "~n".
           ELSE IF DICTDB._Constraint._Con-Type = "U" THEN
                Constr = Constr + '  UNIQUE' + "~n".
           ELSE IF DICTDB._Constraint._Con-Type = "D" THEN
                Constr = Constr + '  DEFAULT' + "~n".
           ELSE IF DICTDB._Constraint._Con-Type = "C" THEN
                Constr = Constr + '  CHECK' + "~n".  
                     
           IF DICTDB._Constraint._Con-Active = FALSE
           THEN Constr = Constr + '  INACTIVE' + "~n".
           ELSE Constr = Constr + '  ACTIVE' + "~n".    
           
           IF DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" OR 
           DICTDB._Constraint._Con-Type = "M" OR DICTDB._Constraint._Con-Type = "U" THEN
                Constr = Constr + '  CONSTRAINT-INDEX "' + DICTDB._Index._Index-Name + '"' + "~n" + "~n".
           ELSE IF DICTDB._Constraint._Con-Type = "C" OR DICTDB._Constraint._Con-Type = "D" THEN
                Constr = Constr + '  CONSTRAINT-FIELD "' + DICTDB._Field._Field-Name + '"' + "~n". 
           
           IF DICTDB._Constraint._Con-Type = "D" THEN
                Constr = Constr + '  CONSTRAINT-EXPR "' + DICTDB._Constraint._Con-Expr + '"' + "~n" + "~n".
           ELSE IF DICTDB._Constraint._Con-Type = "C" THEN
                Constr = Constr + '  CONSTRAINT-EXPR "' + DICTDB._Constraint._Con-Expr + '"' + "~n" + "~n".
          END.   
          ELSE IF DICTDB._Constraint._Con-Type = "F" THEN DO:
               df-con[1] = 'ADD CONSTRAINT ' + '"' + DICTDB._Constraint._Con-Name + '" ON "' + DICTDB._File._File-Name + '"'.
               df-con[2] = '  FOREIGN-KEY'.

               IF DICTDB._Constraint._Con-Active = FALSE
                THEN df-con[3] = '  INACTIVE'.
                ELSE df-con[3] = '  ACTIVE'.
               
               df-con[4] = '  CONSTRAINT-INDEX "' + DICTDB._Index._Index-Name + '"'.
               
               FIND FIRST Index2 WHERE RECID(Index2) = DICTDB._Constraint._Index-Parent-Recid NO-LOCK NO-ERROR.
               IF AVAILABLE (Index2)
               THEN DO:
               FIND FIRST confile2 WHERE Index2._File-Recid = RECID(confile2) NO-LOCK NO-ERROR.
               IF AVAILABLE (confile2) THEN 
                 df-con[5] = '  PARENT-TABLE "' + confile2._File-Name + '"'.     
                 df-con[6] = '  PARENT-INDEX "' + Index2._Index-Name + '"'.         
               END.
	             df-con[7] = '  CONSTRAINT-ACTION "' + DICTDB._Constraint._Con-Misc2[1] + '"'.               
               IF df-con[1] <> ? THEN DO:
               DO i = 1 TO 7:
                  IF df-con[i] <> ? THEN DO:
                     CREATE df-info.
                     ASSIGN df-info.df-seq = dfseq
                            dfseq = dfseq + 1
                            df-info.df-tbl = DICTDB._File._File-name
                            df-info.df-line = df-con[i].
                  END.
               END.
               ASSIGN df-con = ?.
               END.
           END.    
      END.
      ELSE IF DICTDB._Constraint._Con-Active <> DICTDB2._Constraint._Con-Active 
      THEN DO:
        Constr = Constr + 'UPDATE CONSTRAINT ' + '"' + DICTDB2._Constraint._Con-Name + '" ON "' + DICTDB._File._File-Name + '"'+ "~n".
        IF DICTDB._Constraint._Con-Active = FALSE 
        THEN Constr = Constr + '  INACTIVE' + "~n" + "~n".
        ELSE Constr = Constr + '  ACTIVE' + "~n" + "~n".           
      END.
      
     PUT STREAM ddl UNFORMATTED Constr.
    END.          
    /** code for drop constraints. we dont drop clustered constraint **/
    FOR EACH DICTDB2._Constraint OF DICTDB2._File  WHERE DICTDB2._constraint._con-Status <> "O" AND
      DICTDB2._constraint._con-Status <> "D" AND DICTDB._Constraint._Con-Type <> "M": 
     Constr1 = "".
     df-con = ?.
     FIND FIRST DICTDB._Constraint OF DICTDB._File WHERE
     DICTDB._Constraint._Con-Name = DICTDB2._Constraint._Con-Name NO-LOCK NO-ERROR.
     IF NOT AVAILABLE (DICTDB._Constraint)
      THEN
       IF DICTDB2._Constraint._Con-Type = "C" OR DICTDB2._Constraint._Con-Type = "D" OR DICTDB2._Constraint._Con-Type = "F" THEN
         Constr1 = Constr1 + 'DROP CONSTRAINT "' + DICTDB2._Constraint._Con-Name + '" ON "' + DICTDB2._File._File-Name + '"'+ "~n" + "~n" .
       ELSE DO:
           df-con[1] = 'DROP CONSTRAINT "' + DICTDB2._Constraint._Con-Name + '" ON "' + DICTDB2._File._File-Name + '"'.
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-info.df-tbl = DICTDB2._File._File-name
                  df-info.df-line = df-con[1].           
       END.           
       IF Constr1 <> "" THEN 
          PUT STREAM ddl UNFORMATTED Constr1.
    END.          
  
  END.  /* end FOR EACH potentially altered file */

  FOR EACH df-info:  
    IF SUBSTRING(df-line,1,1) <> " " THEN
      PUT STREAM ddl UNFORMATTED " " SKIP.
    PUT STREAM ddl UNFORMATTED df-line SKIP.
  END.
    
  IF NOT p-batchmode and not p-silentincrd THEN DO: /* 02/01/29 vap (IZ# 1525) */
    DISPLAY "" @ fil "" @ fld "" @ idx WITH FRAME seeking.
    DISPLAY "" @ fil2 "" @ fld2 "" @ idx2 WITH FRAME seeking.
  END.
  
  /* build missing sequence list for rename/delete determination */
  FOR EACH DICTDB2._Sequence
    WHERE (IF s_DbType2 = "PROGRESS"  
           THEN DICTDB2._Sequence._Db-recid = RECID(database2)
           ELSE DICTDB2._Sequence._Db-recid = s_DbRecId)
      AND NOT DICTDB2._Sequence._Seq-name BEGINS "$":
    FIND FIRST DICTDB._Sequence
      WHERE DICTDB._Sequence._Db-recid = drec_db
        AND DICTDB._Sequence._Seq-name = DICTDB2._Sequence._Seq-name NO-ERROR.
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY DICTDB2._Sequence._Seq-name @ seq WITH FRAME seeking.
    IF AVAILABLE DICTDB._Sequence THEN NEXT.
    CREATE missing.
    missing.name = DICTDB2._Sequence._Seq-name.
  END.
  
  /* build list of new or renamed sequences */
  FOR EACH DICTDB._Sequence
    WHERE DICTDB._Sequence._Db-recid = drec_db
      AND NOT DICTDB._Sequence._Seq-name BEGINS "$":
    FIND FIRST DICTDB2._Sequence
      WHERE (IF s_DbType2 = "PROGRESS" 
             THEN DICTDB2._Sequence._Db-recid = RECID(database2)
             ELSE DICTDB2._Sequence._Db-recid = s_DbRecId)
        AND DICTDB2._Sequence._Seq-name = DICTDB._Sequence._Seq-name NO-ERROR.
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY DICTDB._Sequence._Seq-name @ seq WITH FRAME seeking.
    CREATE seq-list.
    seq-list.s1-name = DICTDB._Sequence._Seq-name.
    IF AVAILABLE DICTDB2._Sequence THEN
      seq-list.s2-name = DICTDB._Sequence._Seq-name.
  END.
  
  /* look for matches for renamed sequences with user input.  A prompt 
     is given for each seq in DICTDB2 that's not in DICTDB but only when
     there is also a seq in DICTDB that's not in DICTDB2.  The 2nd list
     is the potential values to rename to.
  */
  IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
    run adecomm/_setcurs.p ("").
  ELSE DO:  /* 02/01/29 vap (IZ# 1525) */
    ASSIGN p-comma = "":U
           p-list  = "":U.
    FOR EACH seq-list WHERE
             seq-list.s2-name = ?:
      ASSIGN p-list  = p-list + p-comma + seq-list.s1-name
             p-comma = ",":U.
    END.
  END.
  FOR EACH missing:
    IF NOT p-batchmode and not p-silentincrd THEN DO:  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY missing.name @ seq WITH FRAME seeking.
      RUN "prodict/dump/_dmpisub.p"
        (INPUT "s",INPUT-OUTPUT missing.name,OUTPUT ans).
      IF missing.name = ? THEN DELETE missing.
      IF ans = ? THEN DO:
        IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
          HIDE FRAME seeking NO-PAUSE.
        user_path = "".
        RETURN.
      END.
    END.  /* NOT p-batchmode */
    ELSE DO:  /* 02/01/29 vap (IZ# 1525) */
      ASSIGN p-foo = checkRenameSequence(missing.name, p-list).
      IF p-foo NE ? THEN DO:
         FIND FIRST seq-list WHERE
                    seq-list.s1-name = p-foo AND
                    seq-list.s2-name = ?
                    NO-ERROR.
         IF AVAILABLE(seq-list) THEN          
           ASSIGN seq-list.s2-name = missing.name.
         DELETE missing.
      END.  /* p-foo NE ? */
    END.  /* p-batchmode */
  END.  /* FOR EACH missing */
  IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
    run adecomm/_setcurs.p ("WAIT").
  
  /* handle deleted sequences */
  ans = FALSE.
  FOR EACH missing:
    ans = TRUE.
    PUT STREAM ddl UNFORMATTED
      'DROP SEQUENCE "' missing.name '"' SKIP.
    IF NOT p-batchmode and not p-silentincrd THEN DO: /* 02/01/29 vap (IZ# 1525) */
      DISPLAY missing.name @ seq WITH FRAME seeking.
      DISPLAY missing.name @ seq2 WITH FRAME seeking.
    END.
    DELETE missing.
  END.
  IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  
  /* handle renamed sequences */
  ans = FALSE.
  FOR EACH seq-list
    WHERE seq-list.s1-name <> seq-list.s2-name
      AND seq-list.s2-name <> ?:
    ans = TRUE.
    PUT STREAM ddl UNFORMATTED
      'RENAME SEQUENCE "' seq-list.s2-name
      '" TO "' seq-list.s1-name '"' SKIP.
    IF NOT p-batchmode and not p-silentincrd THEN DO: /* 02/01/29 vap (IZ# 1525) */
      DISPLAY seq-list.s1-name @ seq WITH FRAME seeking.
      DISPLAY seq-list.s1-name @ seq2 WITH FRAME seeking.
    END.
  END.
  IF ans THEN PUT STREAM ddl UNFORMATTED SKIP(1).
  
  /* handle new or potentially altered sequences.  
     We can't use dumpdefs here like we do with files because it wasn't 
     made to handle individual sequences - it would dump them all.
     Some day!
  */
  FOR EACH seq-list:
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY seq-list.s1-name @ seq WITH FRAME seeking.
  
    FIND DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = drec_db
      AND DICTDB._Sequence._Seq-name = seq-list.s1-name.
    FIND DICTDB2._Sequence WHERE (IF s_DbType2 = "PROGRESS" 
                                  THEN DICTDB2._Sequence._Db-recid = RECID(database2)
                                  ELSE DICTDB2._Sequence._Db-recid = s_DbRecId)
      AND DICTDB2._Sequence._Seq-name = seq-list.s2-name NO-ERROR.
  
    IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
      DISPLAY seq-list.s1-name @ seq2 WITH FRAME seeking.
  
    /* If l is true we're updateing otherwise we're adding */
    l = AVAILABLE DICTDB2._Sequence.
  
    /* write out appropriate seq definition changes */
    ASSIGN
      j      = 1
      ddl    = ""
      ddl[1] = (IF l THEN "UPDATE" ELSE "ADD")
               + ' SEQUENCE "' + DICTDB._Sequence._Seq-name + '"'.
      
      IF NOT l THEN 
      DO:
         IF isDictdbMultiTenant = yes and isDictdb2MultiTenant = no THEN
         DO:
             ASSIGN s_errorsLogged = TRUE.
             OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
               PUT STREAM err-log UNFORMATTED new_lang[3] +
                        '"' + DICTDB._Sequence._Seq-name + '"' + new_lang[48]     SKIP
                        '"' + LDBNAME("DICTDB")      + '"'    + new_lang[44]      SKIP
                        '"' + LDBNAME("DICTDB2")      + '"'     + new_lang[50]     SKIP(1).
                        
             OUTPUT STREAM err-log CLOSE.
 
         END.
         ELSE
         ASSIGN j = j + 1
                ddl[j] = " MULTITENANT "  + STRING(DICTDB._Sequence._Seq-attributes[1]).
      END.
      ELSE
      DO:
         IF DICTDB._Sequence._Seq-attributes[1] <> DICTDB2._Sequence._Seq-attributes[1] THEN
         DO:
             ASSIGN s_errorsLogged = TRUE.        
             OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
         
             PUT STREAM err-log UNFORMATTED new_lang[3] + new_lang[51]
                 '"' + DICTDB._Sequence._Seq-name + '"' + new_lang[52] SKIP(1).
             OUTPUT STREAM err-log CLOSE.    
         END.
      END.
      IF NOT l OR 
               DICTDB._Sequence._Seq-init <> DICTDB2._Sequence._Seq-init THEN 
        ASSIGN
          j = j + 1
          ddl[j] = "  INITIAL " + (IF DICTDB._Sequence._Seq-init = ? THEN "?"
                   ELSE STRING(DICTDB._Sequence._Seq-init)).
      IF NOT l OR 
               DICTDB._Sequence._Seq-incr <> DICTDB2._Sequence._Seq-incr THEN 
        ASSIGN
          j = j + 1
          ddl[j] = "  INCREMENT " + (IF DICTDB._Sequence._Seq-incr = ? THEN "?" 
                   ELSE STRING(DICTDB._Sequence._Seq-incr)).
      IF NOT l OR 
               DICTDB._Sequence._Cycle-OK <> DICTDB2._Sequence._Cycle-OK THEN 
        ASSIGN
          j = j + 1
          ddl[j] = "  CYCLE-ON-LIMIT " + 
                   (IF DICTDB._Sequence._Cycle-OK THEN "yes" ELSE "no").
      IF NOT l OR DICTDB._Sequence._Seq-min <> DICTDB2._Sequence._Seq-min THEN 
        ASSIGN
          j = j + 1
          ddl[j] = "  MIN-VAL " + (IF DICTDB._Sequence._Seq-min = ? THEN "?" 
                   ELSE STRING(DICTDB._Sequence._Seq-min)).
      IF NOT l OR DICTDB._Sequence._Seq-max <> DICTDB2._Sequence._Seq-max THEN 
        ASSIGN
          j = j + 1
          ddl[j] = "  MAX-VAL " + (IF DICTDB._Sequence._Seq-max = ? THEN "?" 
                   ELSE STRING(DICTDB._Sequence._Seq-max)).
  
      /* don't write out ddl[1] if j = 1 (i.e., we only have seq header) */
      IF j > 1 THEN 
        DO i = 1 TO j + 1:
          IF ddl[i] = "" THEN  /* this puts an extra skip after the last one */
            PUT STREAM ddl UNFORMATTED SKIP(1).
          ELSE
            PUT STREAM ddl UNFORMATTED ddl[i] SKIP.
        END.
  
  END.  /* end FOR EACH new or potentially altered sequence */
  
  /* Sync up the auto-connect records.  If there's any auto-connect records
     in either database, drop all the ones in DICTDB2 and add what's in
     DICTDB.  Since there's no data associated with these, we can drop with
     a clear conscience.   This is easier than trying to compare the 
     differences.
  */
  FOR EACH DICTDB2._Db WHERE DICTDB2._Db._Db-name <> ? AND 
                             NOT DICTDB2._Db._Db-slave AND  /* not foreign db */
                             NOT DICTDB2._Db._Db-local NO-LOCK:
     PUT STREAM ddl UNFORMATTED 
        'DROP DATABASE "' DICTDB2._Db._Db-name '"' SKIP(1).
  END.
  FOR EACH DICTDB._Db WHERE DICTDB._Db._Db-name <> ? AND 
                            NOT DICTDB._Db._Db-slave AND  /* not foreign db */
                            NOT DICTDB._Db._Db-local NO-LOCK:
     PUT STREAM ddl UNFORMATTED 
        'ADD DATABASE "' DICTDB._Db._Db-name '" TYPE PROGRESS' SKIP.
     PUT STREAM ddl UNFORMATTED 'DBNAME "' DICTDB._Db._Db-addr '"' SKIP.
     IF DICTDB._Db._Db-comm <> "" THEN
        PUT STREAM ddl UNFORMATTED 'PARAMS "'  DICTDB._Db._Db-comm '"' SKIP.
     PUT STREAM ddl UNFORMATTED SKIP(1).
  END.

/*
OUTPUT TO a.LOG.
FOR EACH ttObjAttrs.
    EXPORT ttObjAttrs.
END.

FOR EACH ttObjAttrs2.
    EXPORT ttObjAttrs2.
END.
       
OUTPUT CLOSE.

*/

  /* now for every object we collected, let's dump their encryption policy settings and/or
     buffer pool settings */
  FOR EACH ttObjAttrs:
      /* first see if the object name has been renamed */
      FIND FIRST renameList WHERE renameList.new-name = ttObjAttrs.obj-name NO-ERROR.
      IF AVAILABLE renameList THEN
         FIND FIRST ttObjAttrs2 WHERE ttObjAttrs2.obj-name = renameList.old-name NO-ERROR.
      ELSE
         FIND FIRST ttObjAttrs2 WHERE ttObjAttrs2.obj-name = ttObjAttrs.obj-name NO-ERROR.
      
      /* if new one with encryption disabled and in primary buffer pool,
         or in both db's with same cipher or same buffer pool, skip it */
      IF NOT AVAILABLE ttObjAttrs2 AND ttObjAttrs.obj-cipher = "" AND
         (ttObjAttrs.obj-buf-pool = "Primary" OR ttObjAttrs.obj-buf-pool = "") THEN NEXT.

      /* now it's either a new one with a cipher or not primary buffer pool,
        or a different cipher or buffer pool in one of the db's */
      IF NOT AVAILABLE ttObjAttrs2
          OR ttObjAttrs.obj-cipher NE ttObjAttrs2.obj-cipher
          OR ttObjAttrs.obj-buf-pool NE ttObjAttrs2.obj-buf-pool THEN DO:

          /* syntax is 
            obj-name;obj-type;cipher,value;[buffer-pool,value]
             
            where obj-type is TABLE,INDEX or FIELD 
            cipher and/or buffer-pool may be an empty string
          */

          ASSIGN c = ttObjAttrs.obj-name + ";".
          IF ttObjAttrs.obj-type = "blob" OR ttObjAttrs.obj-type = "clob" THEN
              ASSIGN c = c + "FIELD".
          ELSE
              ASSIGN c = c + ttObjAttrs.obj-type.
    
          IF (NOT AVAILABLE ttObjAttrs2 AND ttObjAttrs.obj-cipher NE "")
              OR (AVAILABLE ttObjAttrs2 AND ttObjAttrs.obj-cipher NE ttObjAttrs2.obj-cipher) THEN DO:
              ASSIGN dumpPol= YES
                     c = c + ";cipher," + ttObjAttrs.obj-cipher.
          END.
    
          IF (NOT AVAILABLE ttObjAttrs2 AND ttObjAttrs.obj-buf-pool NE "Primary")
              OR (AVAILABLE ttObjAttrs2 AND ttObjAttrs.obj-buf-pool NE ttObjAttrs2.obj-buf-pool) THEN DO:
              ASSIGN dumpAltBuf= YES
                     c = c + ";buffer-pool," + ttObjAttrs.obj-buf-pool.
          END.

          RUN "prodict/dump/_dmpdefs.p" ("o",0, c).
      END.
  END.

  {prodict/dump/dmptrail.i
    &entries      = "IF dumpPol THEN PUT STREAM ddl UNFORMATTED
                      ""encpolicy=yes"" SKIP.
                     IF dumpAltBuf THEN PUT STREAM ddl UNFORMATTED
                                            ""bufpool=yes"" SKIP."
    &seek-stream  = "ddl"
    &stream       = "STREAM ddl "
    }  /* adds trailer with code-page-entrie to end of file */
    
  stopped = false.
END. /* on stop */

/* 02/01/29 vap (IZ# 1525) */
IF NOT p-batchmode and not p-silentincrd AND NOT stopped AND s_errorsLogged THEN
   MESSAGE new_lang[27] SKIP
           new_lang[28] SKIP
           new_lang[29] SKIP
           new_lang[30]
   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   
IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
  IF stopped THEN
     MESSAGE "Dump terminated."
                   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  ELSE
     MESSAGE "Dump completed."
                   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

DELETE PROCEDURE h_dmputil NO-ERROR.
IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
  HIDE FRAME seeking NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
IF NOT p-batchmode and not p-silentincrd THEN  /* 02/01/29 vap (IZ# 1525) */
  run adecomm/_setcurs.p ("").

FINALLY:
   /* make sure we always delete these */
   IF VALID-OBJECT(myEPolicy[1]) THEN
      DELETE OBJECT myEPolicy[1].

   IF VALID-OBJECT(myEPolicy[2]) THEN
      DELETE OBJECT myEPolicy[2].

   IF VALID-OBJECT(myObjAttrs[1]) THEN
      DELETE OBJECT myObjAttrs[1].

   IF VALID-OBJECT(myObjAttrs[2]) THEN
      DELETE OBJECT myObjAttrs[2].
   
END FINALLY.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights*
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dmpisub.p - subroutine of _dmpincr.p ------------------------------------

History:
    Mario B     10/19/99    Several Bug Fixes and support for AREAS.  Added
                            warnings mechanisim.  BUG#'s  19981112-011,
                            19990915-022, 19970814-029 (re-opened & re-fixed).
                20000926-011 Needed to add parameters to FileAreaMatch call
    vap         01/29/02     Added batch-mode support (IZ# 1525)
    fernando    02/27/2007   Added case for critical field change - OE00147106
                            
-----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }
{ prodict/dump/dumpvars.i SHARED }

DEFINE INPUT        PARAMETER which   AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER missing AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER answer  AS LOGICAL   NO-UNDO.

DEFINE        VARIABLE c     AS CHARACTER NO-UNDO.
DEFINE        VARIABLE ix    AS INTEGER   NO-UNDO.
DEFINE        VARIABLE name  AS CHARACTER NO-UNDO.
DEFINE        VARIABLE fname AS CHARACTER NO-UNDO.
DEFINE        VARIABLE type  AS CHARACTER NO-UNDO.
DEFINE        VARIABLE i     AS INTEGER   NO-UNDO.

FUNCTION fileAreaMatch RETURNS LOGICAL (INPUT db1FileNo AS INT,
                                        INPUT db2FileNo AS INT,
                                        INPUT db1recid  AS RECID,
                                        INPUT db2recid  AS RECID) IN h_dmputil.
                                        
/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 23 NO-UNDO INITIAL [
  /* 1*/ "<deleted>",
  /* 2*/ ? /* see below */ ,
  /* 3*/ "Does this mean you want to abort this program?",
  /* 4*/ "Table:",
  /* 5*/ "Field:",
  /* 6*/ "does not exist.",
  /* 7*/ "If it is renamed, please choose",
  /* 8*/ "the new name from the list of",
  /* 9*/ "unmatched names shown here.",
  /*10*/ "Otherwise, select ~"<deleted>~".",
  /*11*/ "Sequence:",
  /*12*/ "WARNING: ",
  /*13*/ " and ",
  /*14*/ " are in different AREAS.",
  /*15*/ "The incremental dump utility cannot be used to change database",
  /*16*/ "AREAS.  Create AREAS with the ""PROSTRCT"" utility and move",
  /*17*/ "tables with the ""proutil tablemove"" utility.  See the",
  /*18*/ "Progress Database Administration Guide and Reference for details.",
  /*19*/ "A ""RENAME TABLE"" statement has been written to the",
  /*20*/ "incremental .df file for these tables without regard for AREA.",
  /*21*/ "will be dropped and recreated.",
  /*22*/ "Otherwise, select ~"<recreated>~".",
  /*23*/ "<recreated>"
].

new_lang[2] = "You pressed [" + KBLABEL("END-ERROR") + "] or Cancel.".

FORM
  new_lang[4]  FORMAT "x(6)"
     name      FORMAT "x(32)" SKIP
  new_lang[6]  FORMAT "x(32)" SKIP(1)
  new_lang[7]  FORMAT "x(32)" SKIP
  new_lang[8]  FORMAT "x(32)" SKIP
  new_lang[9]  FORMAT "x(32)" SKIP
  new_lang[10] FORMAT "x(30)"
  WITH FRAME t-help NO-LABELS NO-ATTR-SPACE ROW 3 COLUMN 1 USE-TEXT.

FORM
  new_lang[4] FORMAT "x(6)"
    DICTDB._File._File-name   FORMAT "x(32)" SKIP
  new_lang[5] FORMAT "x(6)"
    DICTDB._Field._Field-name FORMAT "x(32)" SKIP
  new_lang[6]                             FORMAT "x(32)" SKIP(1)
  new_lang[7]                      FORMAT "x(32)" SKIP
  new_lang[8]                      FORMAT "x(32)" SKIP
  new_lang[9]                      FORMAT "x(32)" SKIP
  new_lang[10]                      FORMAT "x(30)"
  WITH FRAME f-help NO-LABELS NO-ATTR-SPACE ROW 3 COLUMN 1 USE-TEXT.

FORM
  new_lang[11] FORMAT "x(9)"
     name      FORMAT "x(28)" SKIP
  new_lang[6]  FORMAT "x(32)" SKIP(1)
  new_lang[7]  FORMAT "x(32)" SKIP
  new_lang[8]  FORMAT "x(32)" SKIP
  new_lang[9]  FORMAT "x(32)" SKIP
  new_lang[10] FORMAT "x(30)"
  WITH FRAME s-help NO-LABELS NO-ATTR-SPACE ROW 3 COLUMN 1 USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

ASSIGN
  answer      = FALSE
  pik_row     = 5
  pik_column  = 42
  pik_count   = 1
  pik_list[1] = new_lang[1]. /* <deleted> */

PAUSE 0.

IF which = "t" THEN _file: DO:
  FOR EACH table-list WHERE table-list.t2-name = ?:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = table-list.t1-name.
  END.
  IF pik_count = 1 THEN LEAVE _file.
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    DISPLAY
      new_lang[4] 
      missing @ name
      new_lang[6] new_lang[7] 
      new_lang[8] new_lang[9] 
      new_lang[10]
      WITH FRAME t-help.
    RUN "prodict/user/_usrpick.p".
  &ELSE
    pik_text = new_lang[4] + " " + missing.
    DO ix = 6 TO 10:
      pik_text = pik_text + "~n" + new_lang[ix].
    END.
    ASSIGN
      pik_text = pik_text + c
      pik_help = {&Resolve_Mismatched_Table_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF

  IF pik_return = 0 THEN DO:
    MESSAGE new_lang[2] SKIP new_lang[3]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF answer THEN answer = ?.
    IF answer = ? THEN LEAVE _file.
  END.
  IF pik_chosen[1] = 1 THEN pik_first = ?.
  FIND FIRST table-list WHERE table-list.t1-name = pik_first NO-ERROR.
  IF AVAILABLE table-list THEN
  DO:
     ASSIGN
       table-list.t2-name = missing
       missing            = ?
       which              = "table_check," + table-list.t1-name + "," +
                             table-list.t2-name.
  END.
END.

/* 02/01/29 vap (IZ# 1525) */
IF which BEGINS "table_check" AND
   NUM-ENTRIES(which) EQ 3 THEN DO:
   FIND DICTDB._File WHERE
        DICTDB._File._File-name = ENTRY(2, which) NO-ERROR.
   FIND DICTDB2._File WHERE
        DICTDB2._File._File-name = ENTRY(3, which) NO-ERROR.
   IF NOT fileAreaMatch(INPUT DICTDB._File._File-number,
                        INPUT DICTDB2._File._File-number,
                        INPUT DICTDB._File._Db-recid,
                        INPUT DICTDB2._File._Db-recid) THEN
   DO:
     s_errorsLogged = TRUE.
     OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
     PUT STREAM err-log UNFORMATTED new_lang[12] +
     '"' + LDBNAME("DICTDB") + "." + DICTDB._File._File-name + '"' +
     new_lang[13] +
     '"' + LDBNAME("DICTDB2") + "." + DICTDB2._File._File-name + '"' +
     new_lang[14]                                                   SKIP.
     DO i = 15 to 19:
        PUT STREAM err-log UNFORMATTED new_lang[i]                  SKIP.
     END.
     PUT STREAM err-log UNFORMATTED new_lang[20]                    SKIP(1).
     OUTPUT STREAM err-log CLOSE.
   END.
END.  /* check table area */
/* 02/01/29 vap (IZ# 1525) */

IF which = "f" THEN _field: DO:
  FOR EACH field-list WHERE
      field-list.f2-name   = ?:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = field-list.f1-name.
  END.
  IF pik_count = 1 THEN LEAVE _field.
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    DISPLAY
      new_lang[4]
      user_env[19] @ DICTDB._File._File-name /* this is a hack */
      new_lang[5]
      missing @ DICTDB._Field._Field-name
      new_lang[6] new_lang[7] 
      new_lang[8] new_lang[9] 
      new_lang[10] 
      WITH FRAME f-help.
    RUN "prodict/user/_usrpick.p".
  &ELSE         
    pik_text = new_lang[4] + " " + user_env[19] + ", " + 
                     new_lang[5] + " " + missing.
    DO ix = 6 TO 10:
      pik_text = pik_text + "~n" + new_lang[ix].
    END.
    ASSIGN
      pik_text = pik_text + c
      pik_help = {&Resolve_Mismatched_Field_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF

  IF pik_return = 0 THEN DO:
    MESSAGE new_lang[2] SKIP new_lang[3]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF answer THEN answer = ?.
    IF answer = ? THEN LEAVE _field.
  END.
  IF pik_chosen[1] = 1 THEN pik_first = ?.
  FIND FIRST field-list WHERE field-list.f1-name = pik_first NO-ERROR.
  IF AVAILABLE field-list THEN ASSIGN
    field-list.f2-name = missing
    missing            = ?.
END.

/* Added to fix OE00147106 */
IF which = "fc" THEN _field: DO: /* critical field change */

  pik_list[1] = new_lang[23]. /* <recreated> */
  FOR EACH field-list WHERE
      field-list.f2-name   = ?:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = field-list.f1-name.
  END.
  IF pik_count = 1 THEN LEAVE _field.

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    DISPLAY
      new_lang[4]
      user_env[19] @ DICTDB._File._File-name /* this is a hack */
      new_lang[5]
      missing @ DICTDB._Field._Field-name
      new_lang[21] @ new_lang[6]
      new_lang[7] 
      new_lang[8] new_lang[9] 
      new_lang[22] @  new_lang[10]
      WITH FRAME f-help.
    RUN "prodict/user/_usrpick.p".
  &ELSE         
    pik_text = new_lang[4] + " " + user_env[19] + ", " + 
               new_lang[5] + " " + missing + 
               "~n" + new_lang[21].

    DO ix = 7 TO 9:
      pik_text = pik_text + "~n" + new_lang[ix].
    END.
    pik_text = pik_text + "~n" + new_lang[22].

    ASSIGN
      pik_text = pik_text + c
      pik_help = {&Resolve_Mismatched_Field_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF

  IF pik_return = 0 THEN DO:
    MESSAGE new_lang[2] SKIP new_lang[3]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF answer THEN answer = ?.
    IF answer = ? THEN LEAVE _field.
  END.
  IF pik_chosen[1] = 1 THEN pik_first = ?.
  FIND FIRST field-list WHERE field-list.f1-name = pik_first NO-ERROR.
  IF AVAILABLE field-list THEN DO:
      ASSIGN field-list.f2-name = missing.
      /* fix the original field-list record so that we consider it a new
         field 
      */
      FIND FIRST field-list WHERE field-list.f1-name = missing.
      ASSIGN field-list.f2-name = ?.
  END.
END.

IF which = "s" THEN _seq: DO:
  FOR EACH seq-list WHERE seq-list.s2-name = ?:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = seq-list.s1-name.
  END.
  IF pik_count = 1 THEN LEAVE _seq.
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    DISPLAY
      new_lang[11]
      missing @ name
      new_lang[6] new_lang[7] 
      new_lang[8] new_lang[9] 
      new_lang[10]
      WITH FRAME s-help.
    RUN "prodict/user/_usrpick.p".
  &ELSE
    pik_text = new_lang[4] + " " + missing.
    DO ix = 6 TO 10:
      pik_text = pik_text + "~n" + new_lang[ix].
    END.
    ASSIGN
      pik_text = pik_text + c
      pik_help = {&Resolve_Mismatched_Sequence_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF

  IF pik_return = 0 THEN DO:
    MESSAGE new_lang[2] SKIP new_lang[3]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF answer THEN answer = ?.
    IF answer = ? THEN LEAVE _seq.
  END.
  IF pik_chosen[1] = 1 THEN pik_first = ?.
  FIND FIRST seq-list WHERE seq-list.s1-name = pik_first NO-ERROR.
  IF AVAILABLE seq-list THEN ASSIGN
    seq-list.s2-name = missing
    missing            = ?.
END.

HIDE FRAME t-help NO-PAUSE.
HIDE FRAME f-help NO-PAUSE.
HIDE FRAME s-help NO-PAUSE.
RETURN.


/*********************************************************************
* Copyright (C) 2006-2011,2013 by Progress Software Corporation. All *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* _dmpsddl.p - dump data definitions */

/*
in:  user_env[1]   = containing comma-separated list of filenames in
                     current database, *only* if user_filename = "SOME".
                     But it may be in user_longchar, if list was too big.
     user_env[2]   = Name of file to dump to.
     user_env[5]   = "<internal defaults apply>" or "<target-code-page>"
                     (only for "d"!)   /* hutegger 94/02 */
     user_env[6]   = "no-alert-boxes" or something else
     user_env[9]   = "d" - dump defs 
      	       	     	 - if user selected a specific table: translates into
      	       	     	   "t" for dumpdefs.
      	       	     	 - if user selected ALL: translates into "d","s"
      	       	     	   and "t" for dumpdefs where "d" will output both
      	       	     	   auto connect and collation info.
                     "a" - auto connect 
      	       	     "c" - collation info
                     "s" - sequences.
     user_env[25]  = "AUTO" or ""
     user_env[26]  = "y" or "n" yes/no to dump field Field._Field-rpos (POSITION)
     user_filename = "ALL"        all files of a schema
                     "SOME"       some of the files of the first schema
                     "SOME MORE"  some of the files of a following schema
                     "ONE"        one file of the first schema
                     "ONE MORE"   one file of a following schema
out: user_filename = if user_env[25] = "AUTO", then comma-separated list
                     which can have encpolicy and/or bufpool if encryption
                     policies and/or alternate buffer pool settings were
                     dumped.

When dumping automatically all definitions of all schemas, the .df-file 
should contain only one trailer - at the very   end. Therefor the batch-
program passes "AUTO" to suppress the trailer for the 1. to 
n-1. db.
"" symbolizes the default-behaviour (:= generate trailer).

History:
    hutegger    02/24/94    code-page - support and trailer-info added
    hutegger    06/09/94    batch-automatism
    hutegger    01/24/95    single-files in multiple schemas
    Mario B     03/15/99    Added user_env[26] for dump _Field._Field-rpos
    D. McMann   09/12/02    Changed where check for owner is done 20020912-009
    D. McMann   09/30/02    Added check for SQL92 tables.
    D. McMann   10/03/02    Added USE-INDEX for On-line schema add
    fernando    03/14/06    Handle case with too many tables selected - bug 20050930-006.        
    fernando    09/27/06    Added check for sql-92 tables with unsupported ABL prop - 20060324-001
    fernando    06/19/07    Support for large files
    fernando    07/18/08    Support for encryption
    fernando    04/08/09    Support for alternate buffer pool    
*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/fhidden.i}
{prodict/sec/sec-pol.i}

DEFINE VARIABLE Dbs         AS CHARACTER    NO-UNDO.
DEFINE VARIABLE file_len    AS INTEGER      NO-UNDO.
DEFINE VARIABLE Seqs        AS CHARACTER    NO-UNDO.
DEFINE VARIABLE stopped     AS LOGICAL      NO-UNDO init true.
DEFINE VARIABLE hBuffer2 AS HANDLE NO-UNDO.

DEFINE VARIABLE numCount  AS INTEGER      NO-UNDO.
DEFINE VARIABLE ix        AS INTEGER      NO-UNDO.
DEFINE VARIABLE ilast     AS INTEGER      NO-UNDO.
DEFINE VARIABLE has_lchar AS LOGICAL      NO-UNDO.
DEFINE VARIABLE c         AS CHARACTER.
DEFINE VARIABLE dumpPol   AS LOGICAL      NO-UNDO.
DEFINE VARIABLE dumpAltBuf AS LOGICAL     NO-UNDO.
DEFINE VARIABLE cMsg AS CHARACTER NO-UNDO.
DEFINE VARIABLE myEPolicy  AS prodict.sec._sec-pol-util    NO-UNDO.
DEFINE VARIABLE myObjAttrs AS prodict.pro._obj-attrib-util NO-UNDO.
DEFINE VARIABLE brk        AS LOGICAL INITIAL NO NO-UNDO.
DEFINE NEW SHARED STREAM ddl.
DEFINE NEW SHARED VARIABLE df-con  AS CHARACTER EXTENT 7    NO-UNDO.
DEFINE NEW SHARED VARIABLE dfseq  AS INTEGER INITIAL 1 NO-UNDO.
DEFINE NEW SHARED TEMP-TABLE df-info NO-UNDO
    FIELD df-seq  AS INTEGER
    FIELD df-line AS CHARACTER
    FIELD df-tbl  AS CHARACTER
    FIELD df-fld  AS CHARACTER
    INDEX rt-line IS PRIMARY df-seq.
    
/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

FORM
  Dbs 	       	    LABEL "Database"  COLON 11 FORMAT "x(32)" SKIP
  DICTDB._File._File-name  LABEL "Table"     COLON 11 FORMAT "x(32)" SKIP
  Seqs 	       	    LABEL "Sequence"  COLON 11 FORMAT "x(32)" SKIP
  HEADER 
    "Dumping Definitions.  Press " +
     KBLABEL("STOP") + " to terminate the dump process." format "x(70)"
  WITH FRAME working 
  ROW 4 CENTERED SIDE-LABELS ATTR-SPACE USE-TEXT &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D TITLE "Dump Data Definitions" &ENDIF.

if  user_env[6] NE "dump-silent" THEN 
  COLOR DISPLAY MESSAGES
    DICTDB._File._File-name Dbs Seqs
    WITH FRAME working.

if TERMINAL <> "" and user_env[6] NE "dump-silent"
 then DISPLAY
    ""   @ Dbs
    ""	 @ DICTDB._File._File-name
    ""   @ Seqs
    WITH FRAME working.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

if TERMINAL <> "" 
 then run adecomm/_setcurs.p ("WAIT").

if  user_env[5] = " "
 OR user_env[5] = ? 
 then assign user_env[5] = "<internal defaults apply>".
 
if user_env[5] = "<internal defaults apply>"
 then OUTPUT STREAM ddl TO VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
 else OUTPUT STREAM ddl TO VALUE(user_env[2]) NO-ECHO NO-MAP
             CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].

assign SESSION:IMMEDIATE-DISPLAY = yes.

DO ON STOP UNDO, LEAVE:
  if user_env[9] = "a" then DO:
    if TERMINAL <> "" and user_env[6] NE "dump-silent"  then 
      DISPLAY "(Auto-Connect)" @ Dbs WITH FRAME working.
    RUN "prodict/dump/_dmpdefs.p" ("a",drec_db,user_env[26]).
    end.
  else if user_env[9] = "c" then DO:
    if TERMINAL <> "" and user_env[6] NE "dump-silent" then 
      DISPLAY user_dbname + " (Collate)" @ Dbs WITH FRAME working.
    RUN "prodict/dump/_dmpdefs.p" ("c",drec_db, user_env[26]).
    end.
  else if user_env[9] = "s"  and user_env[6] NE "dump-silent" then DO:
    if TERMINAL <> "" then 
      DISPLAY user_dbname @ Dbs 
      	"ALL" @ Seqs 
      	WITH FRAME working.
    RUN "prodict/dump/_dmpdefs.p" ("s",drec_db,user_env[26]).
    end.
  else do:
    /* check if caller stored list in user_longchar, which happens when list is too big
       to fit into user_env[1].
    */
    IF user_longchar <> "" AND user_longchar <> ? THEN DO:
       /* this means that the list of table was too big to fit into user_env[1].
          We will keep a count of the number of entries so that we loop through them
          in batches .
       */
       ASSIGN numCount = NUM-ENTRIES(user_longchar)
              has_lchar = TRUE.
    END.
    ELSE 
       ASSIGN numCount = 1. /* just need 1 iteration in this case */

    ASSIGN ilast = 0
           c = user_env[1].

       
   FIND _Db WHERE RECID(_Db) = drec_db NO-LOCK.
  
   IF _Db._Db-type = "PROGRESS" THEN DO ON ERROR UNDO, LEAVE:

        CREATE BUFFER hBuffer2 FOR TABLE "DICTDB._database-feature" NO-ERROR.
        IF VALID-HANDLE(hBuffer2) THEN DO:
          hBuffer2:FIND-FIRST("WHERE _database-feature._dbfeature_name = ~'encryption~'",
                             NO-LOCK) NO-ERROR.
	  IF hBuffer2:AVAILABLE AND hBuffer2::_dbfeature_enabled EQ "1" THEN 
                myEPolicy = NEW prodict.sec._sec-pol-util(). 
          ELSE 
                hBuffer2:BUFFER-RELEASE().
          
          DELETE OBJECT hBuffer2 NO-ERROR.
        END.

        CATCH ae AS PROGRESS.Lang.AppError:
           /* if encryption is not enabled, then we silently ignore this */
            IF ae:GetMessageNum(1) NE 14889 THEN 
            DO:
               cMsg =  "The dump file will not contain any encryption definitions for the objects." + "~n" + 
                         ae:GetMessage(1).
                          
               if user_env[6] eq "dump-silent" THEN 
                   undo, throw new Progress.Lang.AppError(cmsg). 
               else IF user_env[6] = "no-alert-boxes" THEN
                   MESSAGE cmsg.
               ELSE
                   MESSAGE cmsg  
                        VIEW-AS ALERT-BOX WARNING BUTTONS OK.
            END.

            DELETE OBJECT ae.
        END CATCH.
    END.
    
    IF _Db._Db-type = "PROGRESS" THEN DO ON ERROR UNDO, LEAVE:
        myObjAttrs = NEW prodict.pro._obj-attrib-util().

        CATCH ae AS PROGRESS.Lang.AppError:
           /* if db doesn't support alternate buffer pools, then we silently ignore this */
            IF ae:GetMessageNum(1) NE 4634 THEN DO:
                
                cMsg =  "The dump file will not contain any buffer pool definitions for the objects." + "~n" + 
                         ae:GetMessage(1).
                if user_env[6] eq "dump-silent" THEN 
                     undo, throw new Progress.Lang.AppError(cmsg).
                ELSE IF user_env[6] = "no-alert-boxes" THEN
                     MESSAGE  cMSG.
                ELSE
                     MESSAGE  cMsg 
                        VIEW-AS ALERT-BOX WARNING BUTTONS OK.
            END.
            DELETE OBJECT ae.
        END CATCH.
    END.

    DO WHILE (ilast < numCount):

      IF has_lchar AND user_filename begins "SOME" THEN DO:
         /* we will go through this as many times as needed to process
            all the selected entries. Can't put longchar in WHERE clause,
            so need to break it down in chunks  .
         */
         c = "".

         DO ix = iLast + 1 TO numCount:
            brk = NO.     
            IF c = "" THEN
                c = entry(ix,user_longchar) NO-ERROR.
            ELSE
            DO:
               IF LENGTH(c + "," + entry(ix,user_longchar)) > 2400 THEN 
                  ASSIGN brk = YES.
               ELSE    
                  ASSIGN c = c + "," + 
                                 entry(ix,user_longchar) no-error.
            END.                    
            IF ERROR-STATUS:ERROR OR brk THEN DO:
                ASSIGN ix = ix - 1.
                LEAVE. /* process what we'got so far */
            END.
           
         end.
         
         /* remember the last one we processed, so we continue from where we left off */
         ASSIGN ilast = ix.

      END.
      ELSE
         /* in this case, we don't need another iteration */
         ASSIGN ilast = numCount. 

      FOR EACH DICTDB._File
      WHERE DICTDB._File._Db-recid = drec_db
        AND ( if user_filename = "ALL"
              then (IF NOT fHidden THEN NOT DICTDB._File._Hidden
	      	    	    	   ELSE DICTDB._File._File-Number > 0 )
             else if user_filename begins "SOME" 
                  THEN CAN-DO(c, DICTDB._File._File-name)
                  ELSE RECID(DICTDB._File) = drec_file
           )
        USE-INDEX _File-name
      BREAK BY DICTDB._File._File-name:

      if   FIRST(DICTDB._File._File-name) 
       then do:  /* first _file of this _db */

        if  user_filename = "ALL"
         or user_filename = "SOME MORE"
         or user_filename = "ONE MORE"
         then do:  /* we need db-token */
          if TERMINAL <> "" and user_env[6] NE "dump-silent" then
             DISPLAY "ALL" @ Dbs
              WITH FRAME working.
          RUN "prodict/dump/_dmpdefs.p" ("d",drec_db,user_env[26]).
          end.     /* we need db-token */
  
        if user_filename = "ALL"
         then do:  /* "all" to dump */
          if TERMINAL <> "" and user_env[6] NE "dump-silent" then
              DISPLAY
              user_dbname @ Dbs
      	      "ALL"       @ Seqs
      	      WITH FRAME working.
          RUN "prodict/dump/_dmpdefs.p" ("s",drec_db,user_env[26]).
          end.     /* "all" to dump */
        
        end.     /* first _file of this _db */
        
      else
        if TERMINAL <> "" and user_env[6] NE "dump-silent" then 
          DISPLAY user_dbname @ Dbs
      	    WITH FRAME working.

     /* This check has to be done after the FIRST-OF statment if SQL92
        tables are also in the database 20020912-009*/         
      IF INTEGER(DBVERSION("DICTDB")) > 8         
        AND (DICTDB._File._Owner <> "PUB" AND DICTDB._File._Owner <> "_FOREIGN")
          THEN NEXT.

      /* Do not dump SQL92 tables */
      IF DICTDB._File._Db-lang > 1 THEN NEXT.

      /* 20060324-001
         Now due to the unified schema for sql92, we will get through
         for PUB tables but we can't dump tables with constraints 
         or non-ABL data types. Primary constraint (_Has-Pcnstrs) 
         is fine.
      */
      IF DICTDB._File._Has-Ccnstrs = "Y" 
         OR DICTDB._File._Has-Fcnstrs = "Y"
         OR DICTDB._File._Has-Ucnstrs = "Y"  THEN
         NEXT.

      /* check if any of the non-ABL data types are used in any of the columns */
      FIND FIRST DICTDB._Field OF DICTDB._File WHERE
           CAN-DO("short,byte,fixchar,fixraw,time,double,float":U,
                  DICTDB._Field._Data-type) NO-LOCK NO-ERROR.
      IF AVAILABLE DICTDB._Field THEN
          NEXT.

      if TERMINAL <> "" and user_env[6] NE "dump-silent" then 
        DISPLAY DICTDB._File._File-name WITH FRAME working.
      RUN "prodict/dump/_dmpdefs.p" ("t",RECID(DICTDB._File),user_env[26]).

      /* let's cache the encryption info in a temp-table */
      /* and the object attributes - for alt buffer pool settings */
      /* Skip multi-tennat objects since they have buffer pool per tenant */
      IF  (DICTDB._File._File-Attributes[1] = false ) 
      and (VALID-OBJECT(myEPolicy) OR VALID-OBJECT(myObjAttrs)) THEN 
      DO:
         
         IF VALID-OBJECT(myEPolicy) THEN
             myEPolicy:getPolicyVersions(DICTDB._File._File-Number, 
                                         DICTDB._File._File-Name, 
                                         "Table", 
                                         OUTPUT DATASET dsObjAttrs BY-REFERENCE).

         IF VALID-OBJECT(myObjAttrs) THEN
            myObjAttrs:getObjectAttributes(DICTDB._File._File-Number, 
                                           DICTDB._File._File-Name, 
                                           "Table", 
                                           OUTPUT DATASET dsObjAttrs BY-REFERENCE).

         FOR EACH DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Dtype = 18 /* blob*/ OR
             DICTDB._Field._Dtype = 19 /* clob */ NO-LOCK:
             IF VALID-OBJECT(myEPolicy) THEN
                 myEPolicy:getPolicyVersions(DICTDB._Field._fld-stlen, 
                                             DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name, 
                                             DICTDB._Field._Data-type, 
                                             OUTPUT DATASET dsObjAttrs BY-REFERENCE).
             IF VALID-OBJECT(myObjAttrs) THEN
                 myObjAttrs:getObjectAttributes(DICTDB._Field._fld-stlen, 
                                                DICTDB._File._File-Name + "." + DICTDB._Field._Field-Name, 
                                                DICTDB._Field._Data-type, 
                                                OUTPUT DATASET dsObjAttrs BY-REFERENCE).
         END.

         FOR EACH DICTDB._Index OF DICTDB._File NO-LOCK:
             IF VALID-OBJECT(myEPolicy) THEN
                 myEPolicy:getPolicyVersions(DICTDB._Index._Idx-num, 
                                             DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                             "Index", 
                                             OUTPUT DATASET dsObjAttrs BY-REFERENCE).
             IF VALID-OBJECT(myObjAttrs) THEN
                 myObjAttrs:getObjectAttributes(DICTDB._Index._Idx-num, 
                                                DICTDB._File._File-Name + "." + DICTDB._Index._Index-name, 
                                                "Index", 
                                                OUTPUT DATASET dsObjAttrs BY-REFERENCE).
         END.
      END.
      end. /* for each _file */

    END. /* while */
  END.

  /* if encryption not enabled and not assigned to alternate buffer pool,
     don't care about them.
  */
  FOR EACH ttObjAttrs WHERE ttObjAttrs.obj-cipher = "" AND 
      ttObjAttrs.obj-buf-pool = 'Primary':
      DELETE ttObjAttrs.
  END.

  /* now for every object that has a valid not-null cipher and/or
     is assigned to the alternate buffer pool, dump it */
  FOR EACH ttObjAttrs:
      /* syntax is 
        obj-name;obj-type;cipher,value;[buffer-pool,value]
         
        where obj-type is TABLE,INDEX or FIELD 
        cipher or buffer-pool may be an empty string but not both
      */
      ASSIGN c = ttObjAttrs.obj-name + ";".
      IF ttObjAttrs.obj-type = "blob" OR ttObjAttrs.obj-type = "clob" THEN
          ASSIGN c = c + "FIELD".
      ELSE
          ASSIGN c = c + ttObjAttrs.obj-type.

      IF ttObjAttrs.obj-cipher NE "" THEN DO:
          ASSIGN dumpPol = YES
                  c = c + ";cipher," + ttObjAttrs.obj-cipher.
      END.
  
      IF ttObjAttrs.obj-buf-pool NE "Primary" THEN DO:
          dumpAltBuf = YES.
          ASSIGN c = c + ";buffer-pool," + ttObjAttrs.obj-buf-pool.
      END.

      RUN "prodict/dump/_dmpdefs.p" ("o",0, c).
  END.

  FOR EACH df-info:  
    IF SUBSTRING(df-line,1,1) <> " " THEN
      PUT STREAM ddl UNFORMATTED " " SKIP.
    PUT STREAM ddl UNFORMATTED df-line SKIP.
  END.
  if user_env[25] <> "AUTO"
   then do:  /* no other _db-schema will follow -> trailer */
      {prodict/dump/dmptrail.i
        &entries      = "IF dumpPol THEN PUT STREAM ddl UNFORMATTED
                      ""encpolicy=yes"" SKIP.
                        IF dumpAltBuf THEN PUT STREAM ddl UNFORMATTED
                        ""bufpool=yes"" SKIP."
        &seek-stream  = "ddl"
        &stream       = "stream ddl"
        }  /* adds trailer with code-page-entry to end of file */
   end.    /* no other _db-schema will follow -> trailer */  
   ELSE DO:
       /* in this case, the caller dumps the trailer info, so we pass
          the values for encpolicy and bufpool back.
       */
       user_filename = "".

       IF dumpPol THEN
          ASSIGN user_filename = 'encpolicy'.

       IF dumpAltBuf THEN
          ASSIGN user_filename = user_filename 
                   + (IF user_filename = '' THEN "" ELSE ",") 
                   + 'bufpool'.
   END.

  stopped = false.
  end. 

file_len = SEEK(ddl).
OUTPUT STREAM ddl CLOSE.

SESSION:IMMEDIATE-DISPLAY = no.
if TERMINAL <> "" and user_env[6] NE "dump-silent" then 
  run adecomm/_setcurs.p ("").

if user_env[6] = "no-alert-boxes" or user_env[6] = "dump-silent" then
do:  /* output WITHOUT alert-box */

  if stopped then DO:
      cMsg = "Dump terminated.".
      if user_env[6] eq "dump-silent" THEN 
            undo, throw new Progress.Lang.AppError(cMsg). 
      else 
           MESSAGE cMsg.
   end.
   else do:
    if file_len < 3 
     then do:  /* the file is empty - nothing to dump */

      OS-DELETE VALUE(user_env[2]). 
      if TERMINAL <> "" then do:
          
          cMsg =  "There were no " +  
             (if user_env[9] = "a" then "auto-connect records" else
              if user_env[9] = "s" then "sequence definitions" else
                               "data definitions"     ) + 
                               " to dump." + "~n" +
                               "The output file has been deleted.".
               
          if user_env[6] EQ "dump-silent" THEN  
             undo, throw new Progress.Lang.AppError(cMsg).
          else
             MESSAGE cMsg.
	   end.   
      end.
    else 
      if TERMINAL <> ""  then do:
          cMsg = "Dump of definitions completed.".
        if user_env[6] EQ "dump-silent" THEN  
            undo, throw new Progress.Lang.AppError(cMsg).
        else
            MESSAGE cMsg.
      end.       
  end.  
  
end.      /* output WITHOUT alert-box */

 else do:  /* output WITH alert-box */

  if stopped then do:
      if user_env[6] EQ "dump-silent" THEN  
             undo, throw new Progress.Lang.AppError("Dump terminated."). 
      else    
         MESSAGE "Dump terminated."
      	   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      end.
   else do:
    if file_len < 3 
     then do:  /* the file is empty - nothing to dump */

      OS-DELETE VALUE(user_env[2]). 
      if TERMINAL <> "" then do:
           cMsg =  "There were no " +  
             (if user_env[9] = "a" then "auto-connect records" else
              if user_env[9] = "s" then "sequence definitions" else
                               "data definitions"     ) + 
                               " to dump." + "~n" +
                               "The output file has been deleted.".
               
          if user_env[6] EQ "dump-silent" THEN  
             undo, throw new Progress.Lang.AppError(cMsg).
          else
             MESSAGE cMsg VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
       end.
      end. 
    else if TERMINAL <> "" then do:
        cMsg = "Dump of definitions completed.". 
        if user_env[6] EQ "dump-silent" THEN  
            undo, throw new Progress.Lang.AppError(cMsg).
        else
            MESSAGE cMsg 
	         VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
	    end.     
    end.
  
  end.     /* output WITH alert-box */

if TERMINAL <> "" and user_env[6] NE "dump-silent" then
  HIDE FRAME working NO-PAUSE.

IF SESSION:CPINTERNAL NE "undefined":U THEN
   ASSIGN user_longchar = "".

IF VALID-OBJECT(myEPolicy) THEN
    DELETE OBJECT myEPolicy.

IF VALID-OBJECT(myObjAttrs) THEN
    DELETE OBJECT myObjAttrs.

RETURN.



/*********************************************************************
* Copyright (C) 2005,2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dmpseqs.p - dump _Sequence file into _Seqvals.d */
/*
in:  user_env[2] = Name of file to dump to.
     user_env[5] = "<internal defaults apply>" or "<target-code-page>"

History:
    hutegger    94/02/24    code-page - support and trailer-info added
    mcmann      08/08/02    Eliminated any sequences whose name begins "$" - Peer Direct
    fernando    06/19/07    Support for large files    
*/
using Progress.Lang.*.
routine-level on error undo, throw.

/*h-*/

{ prodict/user/uservar.i }
{ prodict/dictvar.i }

DEFINE VARIABLE tmpfile AS CHARACTER NO-UNDO.
define variable lApplAlertBox as logical no-undo.
DEFINE VARIABLE cMsg          AS CHARACTER NO-UNDO.

lApplAlertBox = SESSION:APPL-ALERT-BOXES.

if user_env[6] eq "no-alert-boxes":u then
    SESSION:APPL-ALERT-BOXES  = No.
else
    /* Set explicitly to Yes since this was the previous behaviour 
       for the MESSAGE statements used in this procedure. */
    SESSION:APPL-ALERT-BOXES  = Yes.

FIND FIRST _Db WHERE RECID(_Db) = drec_db NO-LOCK.

IF NOT CAN-FIND(FIRST DICTDB._Sequence OF _Db WHERE NOT
                DICTDB._Sequence._Seq-name BEGINS "$") THEN DO:
   cMsg =  "There are no sequences to dump." + "~n" +
           "The output file has not been modified." .           
   if user_env[6] = "dump-silent" then
              undo, throw new AppError(cMsg).
   else
              MESSAGE cMsg.
   RETURN.
END.

run adecomm/_setcurs.p ("WAIT").

RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
OUTPUT TO VALUE(tmpfile) NO-MAP NO-ECHO.

FOR EACH _Sequence OF _Db WHERE NOT _Sequence._Seq-name BEGINS "$"
                          and (   user_env[33] = ""
                               or (user_env[33] = "Tenant" and
                                   _Sequence._Seq-attributes[1])
                               or (user_env[33] = "Shared" and
                                   _Sequence._Seq-attributes[1] = false)
                               ):
                             
  PUT UNFORMATTED
    'EXPORT '
    _Sequence._Seq-Num
    ' "'
    _Sequence._Seq-Name
    '" CURRENT-VALUE(' _Sequence._Seq-Name ',' LDBNAME(user_dbname) ').' SKIP.
END.
OUTPUT CLOSE.

IF  user_env[5] = " "
 OR user_env[5] = ?  THEN assign user_env[5] = "<internal defaults apply>".
 
IF user_env[5] = "<internal defaults apply>"
 then OUTPUT TO VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
 else OUTPUT TO VALUE(user_env[2]) NO-ECHO NO-MAP
             CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].
RUN VALUE(tmpfile).

  {prodict/dump/dmptrail.i
    &entries      = " "
    &seek-stream  = "OUTPUT"
    &stream       = " "
    }  /* adds trailer with code-page-entrie to end of file */
    
OUTPUT CLOSE.

OS-DELETE VALUE(tmpfile).

/* auditing of application data */
AUDIT-CONTROL:LOG-AUDIT-EVENT(10213, 
                              PDBNAME("dictdb") + "._sequence" /* db-name.table-name */, 
                              "" /* detail */).

run adecomm/_setcurs.p ("").

cMsg = "Dump of sequence values completed." .
if user_env[6] = "dump-silent" then 
   .
else
MESSAGE cMsg .


RETURN.
finally:
    session:appl-alert-boxes = lApplAlertBox.
    user_env[33] = "".
end.    
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------

File: dump/_dmpsylk.p 

Description:
    program to dump data in 'sylk' format

Input Parameters:
    user_env[ 1] = filename to export
    user_env[ 2] = 'where' clause
    user_env[ 3] = 'by' clause
    user_env[ 4] = output file name
    user_env[ 5] = number of fields
    user_env[ 6] = field list, comma delimited
    user_env[ 7] = ?, or filename to save generated code in
    user_env[ 9] = format name for message
    user_env[14] = "y" - disable triggers, "n" - do not disable triggers

History:
    95/07   hutegger    prepend <db>.<table> to field-names in order to
                        make generated program work with multiple-schema-
                        environement
    07/13/98 D. McMann  Added _Owner to _File Finds     
    10/15/03 D. McMann  Add support for datetime and datetime-tz                   

----------------------------------------------------------------------*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED VARIABLE totrecs AS INTEGER NO-UNDO.
DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
DEFINE VARIABLE dbfn      AS CHARACTER NO-UNDO.
DEFINE VARIABLE qual      AS CHARACTER NO-UNDO.
DEFINE VARIABLE sort      AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 2 NO-UNDO INITIAL [
  /* 1*/ "records were dumped in SYLK format to",
  /* 2*/ ""
].

FORM
  HEADER 
    " Exporting.   Press " +
     KBLABEL("STOP") + " to terminate the export process." format "x(60)" skip(0.5)
   WITH FRAME exporting CENTERED ROW 5 USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------*/

/*--------------------------------------------------------------------*/

ASSIGN
  dbfn    = user_dbname + "." + user_env[1]
  qual    = user_env[2]
  sort    = user_env[3]
  totrecs = 0.

IF user_env[7] = ?
 THEN RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
OUTPUT TO VALUE(IF user_env[7] = ?
                 THEN tmpfile
                 ELSE user_env[7]
               ) NO-MAP.
PUT UNFORMATTED
  "DEFINE SHARED VARIABLE totrecs AS INTEGER NO-UNDO." SKIP
  "DEFINE VARIABLE hlddt AS CHARACTER NO-UNDO. " SKIP
  "OUTPUT TO ~"" user_env[4] "~" NO-MAP." SKIP.

IF user_env[14] = "y"
 THEN PUT UNFORMATTED "DISABLE TRIGGERS FOR DUMP OF " dbfn "." SKIP.

PUT UNFORMATTED
  "PUT UNFORMATTED ~"ID;PNP~" SKIP." SKIP
  "ASSIGN totrecs = 0."                     SKIP.

PUT UNFORMATTED
  "FOR EACH " SPACE(0) dbfn         SKIP
  "  " qual " " sort ":"            SKIP
  "  ASSIGN totrecs = totrecs + 1." SKIP.

FIND DICTDB._File
  WHERE DICTDB._File._Db-recid  = drec_db
  AND   DICTDB._File._File-name = user_env[1]
  AND   (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").

DO i = 1 TO NUM-ENTRIES(user_env[6]): /* count_chosen */
  FIND DICTDB._Field OF DICTDB._File
    WHERE DICTDB._Field._Field-name = ENTRY(i,user_env[6]).

  IF CAN-DO("datetime,datetime-tz",DICTDB._Field._Data-type) THEN 
    PUT UNFORMATTED 
      ' ASSIGN hlddt = ISO-DATE(' DICTDB._Field._Field-name ').'.

  PUT UNFORMATTED
    "  PUT UNFORMATTED ~"C;Y~" totrecs ~";X" i ";K~" ".

  IF CAN-DO("character,date",DICTDB._Field._Data-type)
   THEN PUT UNFORMATTED 
      "~"~"~"~" " dbfn + "." + DICTDB._Field._Field-name " ~"~"~"~"".
   ELSE IF CAN-DO("datetime,datetime-tz",DICTDB._Field._Data-type) THEN
     PUT UNFORMATTED 
      "~"~"~"~"  hlddt   ~"~"~"~"".
   ELSE PUT UNFORMATTED 
                  dbfn + "." + DICTDB._Field._Field-name.

  PUT UNFORMATTED " SKIP."   SKIP.

  END.

PUT UNFORMATTED
  "  END."                      SKIP
  "PUT UNFORMATTED ~"E~" SKIP." SKIP
  "OUTPUT CLOSE."               SKIP
  "RETURN."                     SKIP.
OUTPUT CLOSE.

IF user_env[7] = ?
 THEN DO:
  SESSION:IMMEDIATE-DISPLAY = yes.
  VIEW FRAME exporting.
  run adecomm/_setcurs.p ("WAIT").
   
  DO ON STOP UNDO, LEAVE:
    RUN VALUE(tmpfile).
    END.

  HIDE FRAME exporting NO-PAUSE.
  SESSION:IMMEDIATE-DISPLAY = no.
  run adecomm/_setcurs.p ("").

  MESSAGE totrecs new_lang[1] user_env[4] 
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   OS-DELETE VALUE(tmpfile).
  END.

RETURN.

/*--------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2005-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* _dmpuser.p   */

/*
in:  user_env[2] = Name of file to dump to.
     user_env[5] = "<internal defaults apply>" or "<target-code-page>"

History:
    hutegger    94/02/24    code-page - support and trailer-info added
    fernando    06/19/07    Support for large files    
*/
/*h-*/

{ prodict/user/uservar.i }

IF NOT CAN-FIND(FIRST DICTDB._User) THEN DO:
   MESSAGE "There are no user records to dump." SKIP
      	   "The output file has not been modified."
      	    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   RETURN.
END.

RUN adecomm/_setcurs.p ("WAIT").

IF  user_env[5] = ?
 OR user_env[5] = "" THEN ASSIGN user_env[5] = "<internal defaults apply>".

IF  user_env[5] = "<internal defaults apply>" 
 THEN OUTPUT TO VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
 ELSE OUTPUT TO VALUE(user_env[2]) NO-ECHO NO-MAP
            CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].

FOR EACH DICTDB._User:
  EXPORT DICTDB._User EXCEPT DICTDB._User._tenantid.
END.

  {prodict/dump/dmptrail.i
    &entries      = " "
    &seek-stream  = "OUTPUT"
    &stream       = " "
    }  /* adds trailer with code-page-entrie to end of file */
    
OUTPUT CLOSE.

/* auditing of application data */
AUDIT-CONTROL:LOG-AUDIT-EVENT(10213, 
                              PDBNAME("dictdb") + "._user" /* db-name.table-name */, 
                              "" /* detail */).

RUN adecomm/_setcurs.p ("").
MESSAGE "Dump of users completed." 
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.
/*********************************************************************
* Copyright (C) 2000,2011 by Progress Software Corporation. All      *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dmputil.p

Description:
   This is a persistent procedure library used by the incremental dump utility,
   _dmpincr.p.  

Author: Mario Brunetti

Date Created: 10/04/99
     History: 09/06/02 D. McMann inprimary should have been checking for
                                 field being in any index. 20020828-012
              03/28/00 D. McMann Checking inprimary was looking at the
                                 wrong database to determine if field was there
                                 20000327012.
              08/16/00 D. McMann Added _Db-recid to _storageObject find 
                                 20000815029
              01/29/02 vap       Added batch-mode support (IZ# 1525)
              09/16/05 kmcintos  Fixed problems with determining if fields 
                                 are members of an index 20040402-004.
              07/12/11 rkamboj   Fixed no record found issue for _Area.
-----------------------------------------------------------------------------*/


using Progress.Lang.*.
routine-level on error undo, throw.


/*------------------------ D E C L A R A T I O N S --------------------------*/

{ prodict/dump/dumpvars.i SHARED }

DEFINE TEMP-TABLE ttRenameTable                   /* 02/01/29 vap (IZ# 1525) */
  FIELD RenameFrom LIKE DICTDB._Field._Field-Name COLUMN-LABEL "From":U
  FIELD RenameTo   LIKE DICTDB._Field._Field-Name COLUMN-LABEL "To":U
  INDEX ttRenameTable IS PRIMARY UNIQUE
  RenameFrom.

DEFINE TEMP-TABLE ttRenameField                   /* 02/01/29 vap (IZ# 1525) */
  FIELD TableName  LIKE DICTDB._File._File-Name   COLUMN-LABEL "Table":U
  FIELD RenameFrom LIKE DICTDB._Field._Field-Name COLUMN-LABEL "From":U
  FIELD RenameTo   LIKE DICTDB._Field._Field-Name COLUMN-LABEL "To":U
  INDEX ttRenameField IS PRIMARY UNIQUE
  TableName RenameFrom.

DEFINE TEMP-TABLE ttRenameSequence                /* 02/01/29 vap (IZ# 1525) */
  FIELD RenameFrom LIKE DICTDB._Field._Field-Name COLUMN-LABEL "From":U
  FIELD RenameTo   LIKE DICTDB._Field._Field-Name COLUMN-LABEL "To":U
  INDEX ttRenameSequence IS PRIMARY UNIQUE
  RenameFrom.

DEFINE VARIABLE debug-mode  AS INTEGER   NO-UNDO. /* 02/01/29 vap (IZ# 1525) */
DEFINE VARIABLE rename-file AS CHARACTER NO-UNDO  /* 02/01/29 vap (IZ# 1525) */
                            INITIAL ?.
DEFINE VARIABLE setincrdmpSilent AS LOGICAL  NO-UNDO INITIAL FALSE.

/* 02/01/29 vap (IZ# 1525) */
/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 03 NO-UNDO INITIAL [
  /*01*/ "WARNING: Ambiguous &1-rename definition (~"&2-&3~").",
  /*02*/ "WARNING: Unrecognized rename-file line: ~"&1~".",
  /*03*/ "WARNING: Wrong &1-rename definition: (~"&2-&3~"), ignored."
]. 
/* LANGUAGE DEPENDENCIES END */ /*-------------------------------------------*/

/*--------------- F U N C T I O N S   &  P R O C E D U R E S ----------------*/
FUNCTION fileAreaMatch RETURNS LOGICAL (INPUT db1FileNo AS INT,
                                        INPUT db2FileNo AS INT,
                                        INPUT db1recid  AS RECID,
                                        INPUT db2recid  AS RECID).
   /* Checks to see that the DICTDB2 file area exists in DICTDB */
   FIND DICTDB._StorageObject 
        where DICTDB._StorageObject._Db-recid    = db1recid
          and DICTDB._StorageObject._Object-type = 1 
          and DICTDB._StorageObject._Object-number = db1FileNo 
          and DICTDB._Storageobject._Partitionid = 0                       
        NO-ERROR.
   
   IF AVAILABLE DICTDB._StorageObject THEN
      FIND DICTDB._Area WHERE
         DICTDB._Area._Area-number = DICTDB._StorageObject._Area-number
      NO-ERROR.
                                      
   FIND DICTDB2._StorageObject where DICTDB2._StorageObject._Db-recid    = db2recid
          and DICTDB2._StorageObject._Object-type = 1 
          and DICTDB2._StorageObject._Object-number = db2FileNo 
          and DICTDB2._Storageobject._Partitionid = 0                       
        NO-ERROR.
    
   IF AVAILABLE DICTDB2._StorageObject THEN
      FIND DICTDB2._Area WHERE
           DICTDB2._Area._Area-number = DICTDB2._StorageObject._Area-number
      NO-ERROR.
   IF AVAIL DICTDB._Area AND AVAIL DICTDB2._Area THEN
   DO:
      IF DICTDB._Area._Area-Name = DICTDB2._Area._Area-Name THEN
      RETURN TRUE.
   END.
   /* DICTDB._StorageObject._Area-number = 0 and DICTDB2._StorageObject._Area-number = 0 
      but there is no record with _Area-number = 0 in _Area table */
   IF AVAIL DICTDB._StorageObject AND AVAIL DICTDB2._StorageObject 
      AND DICTDB._StorageObject._Area-number = 0 AND DICTDB2._StorageObject._Area-number = 0 THEN
      RETURN TRUE.
   RETURN FALSE.

END FUNCTION.

FUNCTION indexAreaMatch RETURNS LOGICAL(INPUT db1IndexNo AS INT,
                                        INPUT db2IndexNo AS INT,
                                        INPUT db1recid   AS RECID,
                                        INPUT db2recid   AS RECID).

   FIND DICTDB._StorageObject WHERE
        DICTDB._StorageObject._Db-recid = db1recid AND
        DICTDB._StorageObject._Object-type = 2 AND
        DICTDB._Storageobject._Object-number = db1IndexNo and
        DICTDB._Storageobject._Partitionid = 0 NO-ERROR.
   IF AVAILABLE DICTDB._StorageObject THEN
      FIND DICTDB._Area WHERE
           DICTDB._Area._Area-number = DICTDB._StorageObject._Area-number
      NO-ERROR.
   ELSE
   FIND DICTDB._Area WHERE
        DICTDB._Area._Area-number = db1IndexNo NO-ERROR.

   FIND DICTDB2._StorageObject WHERE
        DICTDB2._StorageObject._db-recid = db2recid AND
        DICTDB2._StorageObject._Object-type = 2 AND
        DICTDB2._Storageobject._Object-number = db2IndexNo and
        DICTDB2._Storageobject._Partitionid = 0 NO-ERROR.
   IF AVAILABLE DICTDB2._StorageObject THEN
      FIND DICTDB2._Area WHERE
           DICTDB2._Area._Area-number = DICTDB2._StorageObject._Area-number
      NO-ERROR.
   ELSE
   FIND DICTDB2._Area WHERE
        DICTDB2._Area._Area-number = db2IndexNo NO-ERROR.
   IF AVAIL DICTDB._Area AND AVAIL DICTDB2._Area THEN
   DO:
      IF DICTDB._Area._Area-Name = DICTDB2._Area._Area-Name THEN
         RETURN TRUE.
   END.
   /* Assuming if nothing is available then dictdb and dictdb2 index areas are same */
   IF NOT AVAIL DICTDB._StorageObject AND NOT AVAIL DICTDB2._StorageObject
      AND NOT AVAIL DICTDB._Area AND NOT AVAIL DICTDB2._Area THEN 
      RETURN TRUE.
    
   RETURN FALSE.

END FUNCTION.

FUNCTION inprimary RETURNS LOGICAL (INPUT p_db1PrimeIndex AS RECID,
                                    INPUT p_db1RecId      AS RECID).
   
  /* Determines whether a field is part of a primary index */
  /* Function changed to verify if in any index so drop and add
     are done in the proper order 20020828-012 */

  FIND DICTDB2._index-field 
      WHERE DICTDB2._index-field._index-recid = p_db1PrimeIndex AND
            DICTDB2._index-field._field-recid = p_db1RecId NO-ERROR.
  RETURN AVAILABLE DICTDB2._index-field.
   
END FUNCTION.

FUNCTION inindex RETURNS LOGICAL (INPUT p_db1File  AS RECID,
                                  INPUT p_db1Field AS RECID).
   
  /* Function added to verify if in any index so drop and add
     are done in the proper order 20020828-012 */

  FOR EACH DICTDB2._Index WHERE DICTDB2._Index._File-recid = p_db1File:
    FIND DICTDB2._index-field OF DICTDB2._index 
        WHERE DICTDB2._index-field._field-recid = p_db1Field NO-ERROR.
    IF AVAILABLE DICTDB2._index-field THEN
      RETURN TRUE.
  END.

  RETURN FALSE.
   
END FUNCTION.

/* 02/01/29 vap (IZ# 1525) */
FUNCTION checkRenameTable RETURNS CHARACTER (
  INPUT pcRenameFrom   AS CHARACTER ,
  INPUT pcRenameToList AS CHARACTER ).
  /* It is allways a good practice to strong-scope all buffers in persistent
   * libraries, even although here it's not necessary. ADE code just should
   * serve as a code reference, too...
   */
  DEFINE BUFFER B_RenameTable FOR ttRenameTable.
  DEFINE VARIABLE cReturnValue AS CHARACTER NO-UNDO.
  FIND B_RenameTable WHERE
       B_RenameTable.RenameFrom EQ pcRenameFrom
       NO-ERROR.
  IF NOT AVAILABLE(B_RenameTable) THEN
    ASSIGN cReturnValue = ?.
  ELSE DO:
    IF CAN-DO(pcRenameToList, B_RenameTable.RenameTo) THEN
      ASSIGN cReturnValue = B_RenameTable.RenameTo.
    ELSE DO:
      ASSIGN cReturnValue = ?.
      IF debug-mode GT 0 THEN DO:
          if setincrdmpSilent THEN 
                undo, throw new AppError(SUBSTITUTE(new_lang[03], "Table":U, B_RenameTable.RenameFrom,
                           B_RenameTable.RenameTo)). 
          ELSE
                MESSAGE SUBSTITUTE(new_lang[03], "Table":U, B_RenameTable.RenameFrom,
                           B_RenameTable.RenameTo).
      END.
    END.
  END.  /* AVAILABLE(B_RenameTable) */
  RETURN cReturnValue.
END FUNCTION.  /* checkRenameTable() */

/* 02/01/29 vap (IZ# 1525) */
FUNCTION checkRenameField RETURNS CHARACTER (
  INPUT pcTableName    AS CHARACTER ,
  INPUT pcRenameFrom   AS CHARACTER ,
  INPUT pcRenameToList AS CHARACTER ).
  /* It is allways a good practice to strong-scope all buffers in persistent
   * libraries, even although here it's not necessary. ADE code just should
   * serve as a code reference, too...
   */
  DEFINE BUFFER B_RenameField FOR ttRenameField.
  DEFINE VARIABLE cReturnValue AS CHARACTER NO-UNDO.
  FIND B_RenameField WHERE
       B_RenameField.TableName  EQ pcTableName AND
       B_RenameField.RenameFrom EQ pcRenameFrom
       NO-ERROR.
  IF NOT AVAILABLE(B_RenameField) THEN
    ASSIGN cReturnValue = ?.
  ELSE DO:
    IF CAN-DO(pcRenameToList, B_RenameField.RenameTo) THEN
      ASSIGN cReturnValue = B_RenameField.RenameTo.
    ELSE DO:
      ASSIGN cReturnValue = ?.
      IF debug-mode GT 0 THEN DO:
         if setincrdmpSilent THEN 
                undo, throw new AppError(SUBSTITUTE(new_lang[03], "Field":U, B_RenameField.RenameFrom,
                           B_RenameField.RenameTo)). 
         ELSE
         MESSAGE SUBSTITUTE(new_lang[03], "Field":U, B_RenameField.RenameFrom,
                           B_RenameField.RenameTo).
      END.
    END.
  END.  /* AVAILABLE(B_RenameField) */
  RETURN cReturnValue.
END FUNCTION.  /* checkRenameField() */

/* 02/01/29 vap (IZ# 1525) */
FUNCTION checkRenameSequence RETURNS CHARACTER (
  INPUT pcRenameFrom   AS CHARACTER ,
  INPUT pcRenameToList AS CHARACTER ).
  /* It is allways a good practice to strong-scope all buffers in persistent
   * libraries, even although here it's not necessary. ADE code just should
   * serve as a code reference, too...
   */
  DEFINE BUFFER B_RenameSequence FOR ttRenameSequence.
  DEFINE VARIABLE cReturnValue AS CHARACTER NO-UNDO.
  FIND B_RenameSequence WHERE
       B_RenameSequence.RenameFrom EQ pcRenameFrom
       NO-ERROR.
  IF NOT AVAILABLE(B_RenameSequence) THEN
    ASSIGN cReturnValue = ?.
  ELSE DO:
    IF CAN-DO(pcRenameToList, B_RenameSequence.RenameTo) THEN
      ASSIGN cReturnValue = B_RenameSequence.RenameTo.
    ELSE DO:
      ASSIGN cReturnValue = ?.
      IF debug-mode GT 0 THEN DO:
         if setincrdmpSilent THEN 
                undo, throw new AppError(SUBSTITUTE(new_lang[03], "Sequence":U, B_RenameSequence.RenameFrom,
                           B_RenameSequence.RenameTo)). 
         ELSE
                MESSAGE SUBSTITUTE(new_lang[03], "Sequence":U, 
                           B_RenameSequence.RenameFrom,
                           B_RenameSequence.RenameTo).
      END.
    END.
  END.  /* AVAILABLE(B_RenameSequence) */
  RETURN cReturnValue.
END FUNCTION.  /* checkRenameSequence() */

/* We don't delete indexes first because Progress doesn't let you delete
   the last index.  So if we are about to rename an index or add a new
   one, see if an index with this name is in the list to be deleted.
   If so, rename that one so we don't get a name conflict.  It will 
   be deleted later.
*/
PROCEDURE Check_Index_Conflict:

   DEFINE INPUT PARAMETER p_i1Name LIKE index-list.i1-name.
   DEFINE INPUT PARAMETER p_db1-file-name LIKE _File._FIle-name.

   DEFINE VAR tempname AS CHAR INITIAL "temp-" NO-UNDO.
   DEFINE VAR lastCnt  AS INTEGER NO-UNDO.
   
   FIND FIRST index-alt WHERE NOT index-alt.i1-i2 AND /* to be deleted */
                    index-alt.i1-name = p_i1Name NO-ERROR. 
   IF AVAILABLE index-alt THEN DO:
      lastCnt = cnt.
      DO WHILE cnt = lastCnt:
         cnt = RANDOM(10000,99999).
      END.
      tempname = tempname + STRING(cnt).
      PUT STREAM ddl UNFORMATTED
        'RENAME INDEX "' index-alt.i1-name
        '" TO "' tempname
        '" ON "' p_db1-file-name '"' SKIP(1).
      index-alt.i1-name = tempname.
   END.
END.

PROCEDURE tmp-name:
   /* This procedure takes a field name and renames it to a unique
    * name so it can be deleted later. This is done in the instance
    * when a field has changed data-type or extent and is part of a
    * primary index. Since the index will not be deleted until later
    * on in the code. We will rename it and delete it later
    */
   DEFINE INPUT  PARAMETER fname   AS CHAR NO-UNDO.
   DEFINE OUTPUT PARAMETER newname AS CHAR NO-UNDO.

   DEFINE VARIABLE s AS INT NO-UNDO.

   DO s = 1 to 99:
     newname = "Z_" + substring(fname,1,28) + string(s,"99").
     FIND FIRST DICTDB.old-field WHERE DICTDB.old-field._Field-name = newname
          NO-ERROR.
     IF NOT AVAILABLE(DICTDB.old-field) THEN DO:
       FIND FIRST DICTDB2.new-field WHERE 
           DICTDB2.new-field._Field-name = newname
           NO-ERROR.
       IF NOT AVAILABLE(DICTDB2.new-field) THEN DO:
         FIND FIRST missing WHERE missing.name = newname NO-ERROR.
         IF NOT AVAILABLE(missing) THEN LEAVE. /* got it! */
       END.
     END.
   END. 
END PROCEDURE.   

/* Stolen from _dctquot.p - SO!  If you update this for any reason   
 *  (not very likely) consider if that should be updated             
 */
PROCEDURE dctquot:

   DEFINE INPUT  PARAMETER inline  AS CHARACTER            NO-UNDO.
   DEFINE INPUT  PARAMETER quotype AS CHARACTER            NO-UNDO.
   DEFINE OUTPUT PARAMETER outline AS CHARACTER INITIAL "" NO-UNDO.
   DEFINE        VARIABLE  i       AS INTEGER              NO-UNDO.

   IF INDEX(inline,quotype) > 0 THEN
     DO i = 1 TO LENGTH(inline):
       outline = outline + (IF SUBSTRING(inline,i,1) = quotype
                 THEN quotype + quotype ELSE SUBSTRING(inline,i,1)).
     END.
   ELSE
     outline = inline.

   outline = (IF outline = ? THEN "?" ELSE quotype + outline + quotype).

END PROCEDURE.

/* 02/01/29 vap (IZ# 1525) */
PROCEDURE set_Variables:
  DEFINE INPUT PARAMETER pcRenameFile AS CHARACTER NO-UNDO.
  DEFINE INPUT PARAMETER piDebugMode  AS INTEGER   NO-UNDO.
  DEFINE INPUT PARAMETER pcSilentincr AS LOGICAL   NO-UNDO.
  ASSIGN rename-file = pcRenameFile
         debug-mode = piDebugMode
	 setincrdmpSilent =  pcSilentincr.
  RETURN "":U.
END PROCEDURE.  /* set_Variables */

/* Loading the `rename definitions' for batch-mode from the
 * rename-file into respective temp-tables.
 * 02/01/29 vap (IZ# 1525)
 */
PROCEDURE load_Rename_Definitions:
  /* It is allways a good practice to strong-scope all buffers in persistent
   * libraries, even although here it's not necessary. ADE code just should
   * serve as a code reference, too...
   */
  DEFINE BUFFER B_RenameTable    FOR ttRenameTable.
  DEFINE BUFFER B_RenameField    FOR ttRenameField.
  DEFINE BUFFER B_RenameSequence FOR ttRenameSequence.

  DEFINE VARIABLE cInputLine AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cTable     AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cFrom      AS CHARACTER NO-UNDO.
  DEFINE VARIABLE cTo        AS CHARACTER NO-UNDO.

  EMPTY TEMP-TABLE B_RenameTable.
  EMPTY TEMP-TABLE B_RenameField.
  EMPTY TEMP-TABLE B_RenameSequence.

  IF rename-file NE "":U THEN DO:
    INPUT FROM VALUE(rename-file) NO-ECHO.
    REPEAT:
      ASSIGN cInputLine = "":U.
      IMPORT cInputLine.
      ASSIGN cInputLine = TRIM(cInputLine).
      IF cInputLine EQ "":U OR cInputLine BEGINS "#":U THEN
        NEXT.
      CASE TRIM(ENTRY(1, cInputLine)):
        WHEN "T":U THEN DO:
          IF NUM-ENTRIES(cInputLine) EQ 3 THEN DO:
            ASSIGN cFrom = TRIM(ENTRY(2, cInputLine))
                   cTo   = TRIM(ENTRY(3, cInputLine)).
            FIND B_RenameTable WHERE
                 B_RenameTable.RenameFrom EQ cFrom
                 NO-ERROR.
            IF AVAILABLE(B_RenameTable) THEN DO:
              IF debug-mode GT 0 THEN DO:
                 if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[01], "Table":U, cFrom, cTo)). 
                 ELSE
                   MESSAGE SUBSTITUTE(new_lang[01], "Table":U, cFrom, cTo).
              END.
            END.
            ELSE DO:
              CREATE B_RenameTable.
              ASSIGN B_RenameTable.RenameFrom = cFrom.
            END.
            ASSIGN B_RenameTable.RenameTo = cTo.
          END.
          ELSE IF debug-mode GT 0 THEN DO:
               if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[02], cInputLine)). 
               ELSE
                      MESSAGE SUBSTITUTE(new_lang[02], cInputLine).
          END.
        END.  /* Table */
        WHEN "F":U THEN DO:
          IF NUM-ENTRIES(cInputLine) EQ 4 THEN DO:
            ASSIGN cTable = TRIM(ENTRY(2, cInputLine))
                   cFrom  = TRIM(ENTRY(3, cInputLine))
                   cTo    = TRIM(ENTRY(4, cInputLine)).
            FIND B_RenameField WHERE
                 B_RenameField.TableName  EQ cTable AND
                 B_RenameField.RenameFrom EQ cFrom
                 NO-ERROR.
            IF AVAILABLE(B_RenameField) THEN DO:
              IF debug-mode GT 0 THEN DO:
                  if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[01], "Field":U, cFrom, cTo)). 
                  ELSE
                      MESSAGE SUBSTITUTE(new_lang[01], "Field":U, cFrom, cTo).
              END.
            END.
            ELSE DO:
              CREATE B_RenameField.
              ASSIGN B_RenameField.TableName  = cTable
                     B_RenameField.RenameFrom = cFrom.
            END.         
            ASSIGN B_RenameField.RenameTo = cTo.
          END.
          ELSE IF debug-mode GT 0 THEN DO:
                if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[02], cInputLine)). 
                ELSE
                      MESSAGE SUBSTITUTE(new_lang[02], cInputLine).
          END.
        END.  /* Field */
        WHEN "S":U THEN DO:
          IF NUM-ENTRIES(cInputLine) EQ 3 THEN DO:
            ASSIGN cFrom = TRIM(ENTRY(2, cInputLine))
                   cTo   = TRIM(ENTRY(3, cInputLine)).
            FIND B_RenameSequence WHERE
                 B_RenameSequence.RenameFrom EQ cFrom
                 NO-ERROR.
            IF AVAILABLE(B_RenameSequence) THEN DO:
              IF debug-mode GT 0 THEN DO:
                  if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[01], "Sequence":U, cFrom, cTo)). 
                  ELSE
                      MESSAGE SUBSTITUTE(new_lang[01], "Sequence":U, cFrom, cTo).
              END.
            END.
            ELSE DO:
              CREATE B_RenameSequence.
              ASSIGN B_RenameSequence.RenameFrom = cFrom.
            END.  
            ASSIGN B_RenameSequence.RenameTo = cTo.
          END.
          ELSE IF debug-mode GT 0 THEN DO:
                if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[02], cInputLine)). 
                ELSE
                      MESSAGE SUBSTITUTE(new_lang[02], cInputLine).
          END.
        END.  /* Sequence */
        OTHERWISE DO:
          IF debug-mode GT 0 THEN DO:
              if setincrdmpSilent THEN 
                      undo, throw new AppError(SUBSTITUTE(new_lang[02], cInputLine)). 
              ELSE
                      MESSAGE SUBSTITUTE(new_lang[02], cInputLine).
          END.
        END.  /* Unrecognized input */
      END CASE.  /* TRIM(ENTRY(1, cInputLine)) */
    END.  /* REPEAT: */
    INPUT CLOSE.

    IF debug-mode GT 1 THEN DO:
      OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
      FOR EACH B_RenameTable:
        DISPLAY STREAM err-log B_RenameTable WITH TITLE "Rename Table":U .
        DOWN.
      END.
      FOR EACH B_RenameField:
        DISPLAY STREAM err-log B_RenameField WITH TITLE "Rename Field":U WIDTH 120.
        DOWN.
      END.
      FOR EACH B_RenameSequence:
        DISPLAY STREAM err-log B_RenameSequence WITH TITLE "Rename Sequence":U.
        DOWN.
      END.
      PUT STREAM err-log UNFORMATTED " " SKIP(1).
      OUTPUT STREAM err-log CLOSE.
    END.  /* config-info */
  END.  /* rename-file NE ? */

  RETURN "":U.
END PROCEDURE.  /* load_Rename_Definitions */

/* prodict/dump/_dmputil.p */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* dumpv5df - Data Dictionary dump definitions module */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE STREAM chg.

run adecomm/_setcurs.p ("WAIT").
OUTPUT STREAM chg TO VALUE(user_env[2]) NO-ECHO NO-MAP.

FOR EACH _File
  WHERE _File._Db-recid = drec_db
   AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
   AND (
     IF user_filename = "ALL" THEN
       _File._File-number > 0
     ELSE
     IF user_filename = "SOME" THEN
       CAN-DO(user_env[1],_File._File-name)
     ELSE
       RECID(_File) = drec_file)
  BREAK BY _File._File-num:

  EXPORT STREAM chg "NEW-FILE   "
    _File-Name _Can-Create _Can-Read _Can-Write _Can-Delete
    SUBSTRING(_File._Desc,1,72)
    SUBSTRING(_File._Valexp,1,72)
    _Valmsg _Frozen _Hidden _Db-lang _Dump-name.

  FOR EACH _Field OF _File BY _Field-rpos:
    EXPORT STREAM chg "NEW-FIELD  "
      _Field-Name _Data-Type _Decimals _Format _Initial _Label _Mandatory
      _Order _Field._Can-Read _Field._Can-Write _Extent _Valexp _Valmsg
      _Help _Field._Desc _Col-label _Fld-case.
  END.
  PUT STREAM chg UNFORMATTED "." SKIP.

  FOR EACH _Index OF _File:
    /* dont print the default index */
    IF _File._dft-pk AND _File._Prime-Index = RECID(_Index) THEN NEXT.
    EXPORT STREAM chg "NEW-INDEX  " _Index-Name _Unique _active.
    FOR EACH _Index-Field OF _Index:
      FIND _Field OF _Index-Field.
      EXPORT STREAM chg "INDEX-FIELD"
        _Index-Seq _Field-Name _Ascending _Abbreviate.
    END.
    PUT STREAM chg UNFORMATTED "." SKIP.
  END.
  PUT STREAM chg UNFORMATTED "." SKIP.

  IF NOT _File._dft-pk THEN DO:
    FIND _Index WHERE _File._Prime-Index = RECID(_Index).
    EXPORT STREAM chg "PRIMARY    " _Index-Name.
  END.
  PUT STREAM chg UNFORMATTED "." SKIP.

END. /* for each file ... */

OUTPUT STREAM chg CLOSE.
run adecomm/_setcurs.p ("").
MESSAGE "Dump Completed." VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dmpview.p - dump _View, _View-col and _View-ref records for SQL views */

/*
in:  user_env[2] = Name of file to dump to.
     user_env[5] = "<internal defaults apply>" or "<target-code-page>"

History:
    hutegger    94/02/24    code-page - support and trailer-info added
    fernando    06/19/07    Support for large files    
*/
/*h-*/

{ prodict/user/uservar.i }


IF NOT CAN-FIND(FIRST DICTDB._View) THEN DO:
   MESSAGE "There are no views to dump." SKIP
      	   "The output file has not been modified."
      	    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   RETURN.
END.

run adecomm/_setcurs.p ("WAIT").

IF  user_env[5] = " "
 OR user_env[5] = ?  THEN assign user_env[5] = "<internal defaults apply>".
 
IF user_env[5] = "<internal defaults apply>"
 then OUTPUT TO VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
 else OUTPUT TO VALUE(user_env[2]) NO-ECHO NO-MAP
             CONVERT SOURCE SESSION:CHARSET TARGET user_env[5].

FOR EACH DICTDB._View:
  EXPORT DICTDB._View.
END.
PUT UNFORMATTED "." SKIP.
FOR EACH DICTDB._View-col:
  EXPORT DICTDB._View-col.
END.
PUT UNFORMATTED "." SKIP.
FOR EACH DICTDB._View-ref:
  EXPORT DICTDB._View-ref.
END.


  {prodict/dump/dmptrail.i
    &entries      = " "
    &seek-stream  = "OUTPUT"
    &stream       = " "
    }  /* adds trailer with code-page-entrie to end of file */
    
OUTPUT CLOSE.
run adecomm/_setcurs.p ("").
MESSAGE "Dump of views completed." 
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.
/*********************************************************************
* Copyright (C) 2000,2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
File:
    prodict/dump/_lod_dbs.p
    
descr:
    transfers dbs-info from tmp-table to real db

history:
    hutegger    95/06/16    DataServer need DICTDB._Db-xl-name to be <> ?. If
                            .df doesn't contain codepage-name entry, I
                            set it to session:charset and also create a 
                            s_ttb_fake-cp record for this DICTDB._Db.  At the
                            end of the load-transaction in _lodsddl.p, 
                            I assign ? to DICTDB._Db-xl-name for all these 
                            DICTDB._Db-records
    hutegger    94/05/04    special cases for old codepage-names:
                                ISO-Latin-1   =now=>  ISO8859-1
                                ISO 8859-1    =now=>  ISO8859-1
                                Codepage 850  =now=>  IBM850
    hutegger    94/05/06    updated rule for "codepage allowed" when
                            modifying DICTDB._Db
                            
   fernando     10/04/07    Handle error modifying collation table
   fernando     12/06/07    Load collation name for DataServers
   sgarg        07/12/10    Disallow ? as case-insesitive entry (OE00198732)
   sgarg        08/30/11    Bug[17] should be OFF for MSS drivers (OE00198733)
   
*/
/*h-*/

/*---------------------------------------------------------------------*/

{ prodict/dump/loaddefs.i }
{ prodict/dictvar.i }
{ prodict/user/uservar.i }

define shared temp-table s_ttb_fake-cp
    field   db-name     as character
    field   db-recid    as recid.
    
DEFINE VARIABLE scrap AS CHARACTER NO-UNDO.
DEFINE VARIABLE canned AS LOGICAL NO-UNDO.
DEFINE VARIABLE bugpos AS INTEGER NO-UNDO.
DEFINE VARIABLE drvchrs AS CHARACTER NO-UNDO.

/*---------------------------------------------------------------------*/
FIND FIRST wdbs.
if imod <> "a":u
 then if wdbs._Db-name = "?"/* Comparing to the string value "?" fails whereas
                               comparing against the unknown value works.
                            */
   then FIND DICTDB._Db WHERE DICTDB._Db._Db-name = ? NO-ERROR.
   else FIND DICTDB._Db WHERE DICTDB._Db._Db-name = wdbs._Db-name. /* already proven to exist */


if imod = "a":u then do: /*--------------------------------------------*/

  if CAN-FIND(DICTDB._Db WHERE DICTDB._Db._Db-name = wdbs._Db-name) then
    ierror = 7. /* "&2 already exists with this name" */
  if ierror > 0 then RETURN.

  /* _Db-misc1[1] should be either 1 or 0 for case-insensitive db setting. 
   * For MSS DataServer UNKNOWN value for DBMISC11 attribute in .df file 
   * will be stored as 0 in _Db-misc1[1].
   */
  if (wdbs._Db-type = "MSS") then do:
    if (wdbs._Db-misc1[1] <> 1) then
      wdbs._Db-misc1[1]  = 0.

   /* _Db-misc2[4] should not contain bug[17] switch as 
    * all the MS SQL Server drivers used by MSS DataServer
    * support UPPER. Said that a definition file which has
    * been dumped before this bug fix would have an erroenous 
    * entry of bug switch 17 in the driver characteristics. 
    * Loading such definition file should remove that entry.
    */
    bugpos = INDEX (wdbs._Db-misc2[4], "17").
    if (bugpos <> 0) then do:
       drvchrs = substring (wdbs._Db-misc2[4], 1, bugpos - 1) +
                 substring (wdbs._Db-misc2[4], bugpos + 3).
    end.
    else drvchrs = wdbs._Db-misc2[4].
  end.

  CREATE DICTDB._Db.
  ASSIGN
    DICTDB._Db._Db-name  = wdbs._Db-name
    DICTDB._Db._Db-addr  = wdbs._Db-addr
    DICTDB._Db._Db-comm  = (if wdbs._Db-comm = ? then "" else wdbs._Db-comm)
    DICTDB._Db._Db-type  = wdbs._Db-type
    DICTDB._Db._Db-slave = (wdbs._Db-type <> "PROGRESS":u)
    DICTDB._Db._Db-misc1[1] = wdbs._Db-misc1[1]
    DICTDB._Db._Db-misc1[2] = wdbs._Db-misc1[2]
    DICTDB._Db._Db-misc1[3] = wdbs._Db-misc1[3]
    DICTDB._Db._Db-misc1[4] = wdbs._Db-misc1[4]
    DICTDB._Db._Db-misc1[5] = wdbs._Db-misc1[5]
    DICTDB._Db._Db-misc1[6] = wdbs._Db-misc1[6]
    DICTDB._Db._Db-misc1[7] = wdbs._Db-misc1[7]
    DICTDB._Db._Db-misc1[8] = wdbs._Db-misc1[8]
    DICTDB._Db._Db-misc2[1] = wdbs._Db-misc2[1]
    DICTDB._Db._Db-misc2[2] = wdbs._Db-misc2[2]
    DICTDB._Db._Db-misc2[3] = wdbs._Db-misc2[3]
    DICTDB._Db._Db-misc2[4] = (if wdbs._Db-type = "MSS" then drvchrs
                                else wdbs._Db-misc2[4])
    DICTDB._Db._Db-misc2[5] = wdbs._Db-misc2[5]
    DICTDB._Db._Db-misc2[6] = wdbs._Db-misc2[6]
    DICTDB._Db._Db-misc2[7] = wdbs._Db-misc2[7]
    DICTDB._Db._Db-misc2[8] = wdbs._Db-misc2[8]
    DICTDB._Db._Db-xl-name  = wdbs._Db-xl-name.
  if wdbs._Db-type <> "PROGRESS":u 
   then do:    /* switch only if not auto-connect DICTDB._Db */
    assign
      user_dbname    = wdbs._Db-name
      user_dbtype    = wdbs._Db-type
      drec_db        = RECID(DICTDB._Db).
    IF wdbs._Db-type = "ORACLE" AND wdbs._Db-misc1[3] = ? THEN DO:       
       IF OS-GETENV("ORAVERSION")   <> ? THEN
            DICTDB._Db._Db-misc1[3] = INTEGER(OS-GETENV("ORAVERSION")). 
          ELSE
            DICTDB._Db._Db-misc1[3] = 7.       
    END.  

    /* for DataServers, load collation name if it was specified */
    IF wdbs._Db-coll-name ne ? and wdbs._Db-coll-name NE "" THEN
       ASSIGN DICTDB._Db._Db-coll-name = wdbs._Db-coll-name.    

    {prodict/dictgate.i
      &action =query
      &dbtype =user_dbtype 
       &dbrec =? 
       &output=scrap
       }
    assign scrap = "prodict/" + ENTRY(9,scrap) 
                       + "/_" + ENTRY(9,scrap) 
                       + "_sys.p".
    RUN VALUE (scrap) (drec_db,INPUT-OUTPUT imod).
    end.

  end. /*--------------------------------------------------------------*/
else if imod = "m":u then do: /*---------------------------------------*/

  if DICTDB._Db._Db-type <> wdbs._Db-type
   then ierror = 6. /* "cannot change dbtype" */
  if ierror > 0 then RETURN.
  assign wdbs._Db-comm = (if wdbs._Db-comm = ? then "" else wdbs._Db-comm).
  if DICTDB._Db._Db-addr <> wdbs._Db-addr
    then assign DICTDB._Db._Db-addr = wdbs._Db-addr.
  if DICTDB._Db._Db-comm <> wdbs._Db-comm 
   then assign DICTDB._Db._Db-comm = wdbs._Db-comm.
  if DICTDB._Db._Db-type <> "PROGRESS":u OR DICTDB._Db._Db-local
   then assign
    user_dbname = ( if DICTDB._Db._Db-type = "PROGRESS":u
                     then LDBNAME("DICTDB")
                     else wdbs._Db-name
                  )
    user_dbtype = wdbs._Db-type
    drec_db     = RECID(DICTDB._Db).

  DO ON ERROR UNDO, LEAVE:
  ASSIGN canned = YES.
  
  if DICTDB._Db._Db-xl-name <> wdbs._Db-xl-name then do:
/* Jannery: codepage can be changed via .df-load, but
 *          only when db is empty! <hutegger> 94/06 
 *     assign ierror = 32. /*invalid code-page */
 *       RETURN.
 *       end.
 */
 
     /* don't allow changes to DICTDB._Db-xl-name if               */
     /* + the PROGRESS database already contains            */
     /*     + data-definition  or                           */
     /*     + _User -records   or                           */
     /*     + slave-db's (= shwmaholders)                   */
     /*     => the user should use PROUTIL                  */
     /* + the DICTDB._Db is a schemaHolder for a foreign DB        */
     /*     => the user should use the Admin-Tool           */
     if    DICTDB._Db._db-slave
      and not can-find(first s_ttb_fake-cp
                       where s_ttb_fake-cp.db-recid = RECID(DICTDB._Db))
      then do:
       assign ierror = 32. /*invalid code-page */
       RETURN.
       end.
     
     if  DICTDB._Db._db-local
      and ( can-find(first DICTDB._file 
               where DICTDB._file._db-recid = RECID(DICTDB._Db)
               and   DICTDB._File._file-number > 0
	       and   DICTDB._File._Tbl-Type <> "V")
      or    can-find(first DICTDB._User)
          )
      then do:
       assign ierror = 32. /*invalid code-page */
       RETURN.
       end.
     case wdbs._Db-xl-name:
      when "ISO-Latin-1"  then assign DICTDB._Db._Db-xl-name = "ISO8859-1".
      when "ISO 8859-1"   then assign DICTDB._Db._Db-xl-name = "ISO8859-1".
      when "codepage 850" then assign DICTDB._Db._Db-xl-name = "IBM850".
      otherwise                assign DICTDB._Db._Db-xl-name = wdbs._Db-xl-name.
      end case.
      end.     /* codepage-name of db to be changed */

          
  if DICTDB._Db._Db-coll-name <> wdbs._Db-coll-name then
     DICTDB._Db._Db-coll-name = wdbs._Db-coll-name.
     
  /* _Db-misc2[4] should not contain bug[17] switch as 
   * all the MS SQL Server drivers used by MSS DataServer
   * support UPPER. Said that a definition file which has
   * been dumped before this bug fix would have an erroenous 
   * entry of bug switch 17 in the driver characteristics. 
   * Loading such definition file should remove that entry.
   */
  if (wdbs._Db-type = "MSS") then do:
    bugpos = INDEX (wdbs._Db-misc2[4], "17").
    if (bugpos <> 0) then do:
       drvchrs = substring (wdbs._Db-misc2[4], 1, bugpos - 1) +
                 substring (wdbs._Db-misc2[4], bugpos + 3).
    end.
    else drvchrs = wdbs._Db-misc2[4].
  end.

  ASSIGN
    DICTDB._Db._Db-xlate[1]   = wdbs._Db-xlate[1]
    DICTDB._Db._Db-xlate[2]   = wdbs._Db-xlate[2]
    DICTDB._Db._Db-collate[1] = wdbs._Db-collate[1]
    DICTDB._Db._Db-collate[2] = wdbs._Db-collate[2]
    DICTDB._Db._Db-collate[3] = wdbs._Db-collate[3]
    DICTDB._Db._Db-collate[4] = wdbs._Db-collate[4]
    DICTDB._Db._Db-collate[5] = wdbs._Db-collate[5]
    DICTDB._Db._Db-misc1[1] = wdbs._Db-misc1[1]
    DICTDB._Db._Db-misc1[2] = wdbs._Db-misc1[2]
    DICTDB._Db._Db-misc1[3] = wdbs._Db-misc1[3]
    DICTDB._Db._Db-misc1[4] = wdbs._Db-misc1[4]
    DICTDB._Db._Db-misc1[5] = wdbs._Db-misc1[5]
    DICTDB._Db._Db-misc1[6] = wdbs._Db-misc1[6]
    DICTDB._Db._Db-misc1[7] = wdbs._Db-misc1[7]
    DICTDB._Db._Db-misc1[8] = wdbs._Db-misc1[8]
    DICTDB._Db._Db-misc2[1] = wdbs._Db-misc2[1]
    DICTDB._Db._Db-misc2[2] = wdbs._Db-misc2[2]
    DICTDB._Db._Db-misc2[3] = wdbs._Db-misc2[3]
    DICTDB._Db._Db-misc2[4] = (if (wdbs._Db-type = "MSS") then drvchrs
                                else wdbs._Db-misc2[4])
    DICTDB._Db._Db-misc2[5] = wdbs._Db-misc2[5]
    DICTDB._Db._Db-misc2[6] = wdbs._Db-misc2[6]
    DICTDB._Db._Db-misc2[7] = wdbs._Db-misc2[7]
    DICTDB._Db._Db-misc2[8] = wdbs._Db-misc2[8].

    ASSIGN canned = NO.
   END.

   IF canned THEN DO:
       ierror = 56.
       RETURN.
   END.
  end. /*--------------------------------------------------------------*/
else if imod = "r":u then do: /*---------------------------------------*/

  if CAN-FIND(FIRST DICTDB._Db WHERE DICTDB._Db._Db-name = irename) then
    ierror = 7. /* "&2 already exists with name &3" */
  if ierror > 0 then RETURN.
  DICTDB._Db._Db-name = irename.
  if DICTDB._Db._Db-type <> "PROGRESS":u
   OR DICTDB._Db._Db-local
   then drec_db = RECID(DICTDB._Db).

  end. /*--------------------------------------------------------------*/
else if imod = "d":u then do: /*---------------------------------------*/

  if DICTDB._Db._Db-type <> "PROGRESS":u then do:
    { prodict/dictgate.i
      &action = can_delete
      &dbtype = DICTDB._Db._Db-type
      &dbrec  = RECID(DICTDB._Db)
      &output = scrap
      }
    if scrap <> "ok":u then ierror = 21. /* "Cannot del database with files" */
    if ierror > 0 then RETURN.
    FOR EACH _File OF DICTDB._Db:
      { prodict/dump/loadkill.i }
      end.
    end.
  DELETE DICTDB._Db.

  end. /*--------------------------------------------------------------*/

kindexcache = "". /* and reset index delete cache on db or file change */

/* Any loading after the load of this DB record, until the next DICTDB._Db record 
   will be for this database type.  The DICTDB._Db record is always dumped for
   foreign databases.
*/
if imod <> "d":u
 then do:  /* add/modify */

  if wdbs._db-type    <> "PROGRESS"
   and DICTDB._Db._db-xl-name =  ?
   and not can-find(first s_ttb_fake-cp
                    where s_ttb_fake-cp.db-recid = RECID(DICTDB._Db))
   then do:
    create s_ttb_fake-cp.
    assign
      DICTDB._Db._db-xl-name = SESSION:CHARSET
      s_ttb_fake-cp.db-name = DICTDB._Db._db-name
      s_ttb_fake-cp.db-recid = RECID(DICTDB._Db).
    end.

  if gate_dbtype <> DICTDB._Db._db-type
   then do:
    assign
      user_dbname = ( if DICTDB._Db._Db-type = "PROGRESS":u
                     then LDBNAME("DICTDB")
                     else DICTDB._Db._Db-name
                    )
      user_dbtype = DICTDB._Db._Db-type
      gate_dbtype = DICTDB._Db._Db-type 
      drec_db     = RECID(DICTDB._Db).

    if gate_dbtype <> "PROGRESS"
     then do:
      {prodict/dictgate.i 
         &action=query 
         &dbtype=gate_dbtype 
      	 &dbrec =? 
         &output=scrap
         }
      gate_proc = "prodict/" + ENTRY(9,scrap) + "/_" + ENTRY(9,scrap) + "_typ.p".
      end.
    end.

  end.     /* add/modify */

RETURN.

/*---------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* _lod_fil.p  -  moves temptable-info to new or existing _File

   History:  98-10-05-016 added block for dbversion DLM
             99-01-21-013 Reinitialized file-area-number DLM
	     99-07-08 Mario B. Assign _File._File-name when trigger is created
	                       or updated.  BUG# 99-02-09-002
      
      fernando 08/16/06 Raw comparison when checking if char values are different - 20060301-002
                           
   
 */

{ prodict/dictvar.i }
{ prodict/dump/loaddefs.i }

DEFINE VARIABLE scrap    AS CHARACTER NO-UNDO.
DEFINE VARIABLE old_name AS CHARACTER NO-UNDO CASE-SENS.
DEFINE VARIABLE new_name AS CHARACTER NO-UNDO CASE-SENS.

/* defines for dumpname.i */
DEFINE VARIABLE nam  AS CHARACTER NO-UNDO.
DEFINE VARIABLE pass AS INTEGER   NO-UNDO.

define variable lForceSharedSchema   as logical no-undo.

define variable dictLoader as OpenEdge.DataAdmin.Binding.IDataDefinitionLoader no-undo.


/*---------------------------  MAIN-CODE  --------------------------*/

/* dictLoadOptions - could have options only or be a logger/loader or reader/parser  */

if valid-object(dictLoadOptions) then
do: 
    /* the code below use valid-object(dictLoader) as flag to logg data and return */
    dictLoader = dictLoadOptions:Logger.
    lForceSharedSchema = dictLoadOptions:ForceSharedSchema.
  
end.

FIND FIRST wfil.
 
IF imod <> "a" THEN DO:
  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
    FIND DICTDB._File WHERE DICTDB._File._db-recid  = drec_db
                        AND DICTDB._File._File-name = wfil._File-name
                        AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"). /* proven to exist */
  ELSE
    FIND DICTDB._File WHERE DICTDB._File._db-recid  = drec_db
                        AND DICTDB._File._File-name = wfil._File-name.
                   
  IF DICTDB._File._Frozen THEN ierror = 16. /* "Cannot &1 frozen file &3" */

END.
 
IF ierror > 0 THEN RETURN.

IF imod = "a" THEN DO: /*---------------------------------------------------*/
  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
    IF CAN-FIND(DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                               AND DICTDB._File._File-name = wfil._File-name
                               AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN") ) THEN
    do:
        if valid-object(dictLoader) and dictLoader:isReader then
        do:   
            /* this is not an error if parsing and the existing table is renamed */
            if dictLoader:TableNewName(wfil._File-name) = "" then
                ierror = 7. /* "&2 already exists with name &3" */
              
         end. 
         else   
            ierror = 7. /* "&2 already exists with name &3" */  
    end.
  END.  
  ELSE IF CAN-FIND(DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                                  AND DICTDB._File._File-name = wfil._File-name) THEN
    ierror = 7. /* "&2 already exists with name &3" */
 
  IF CAN-FIND(FIRST DICTDB._View WHERE DICTDB._View._View-name = wfil._File-name) THEN
    ierror = 19. /* VIEW exists with name &3" */
  
  IF ierror > 0 THEN RETURN.

/* tmp-change: check for duplicate dump-names <hutegger> 94/05 */
  IF wfil._Dump-name <> ? THEN
  DO:
    ASSIGN nam = wfil._Dump-name.

    {prodict/dump/dumpname.i}

    ASSIGN wfil._Dump-name = nam.
  END. 
  
  if wfil._File-Attributes[1] = true then
  do:
      if not can-find(first _tenant) then
      do:
         /* db must be mt enabled to add mt sequence */
         iError = 72.
         RETURN.
      end.     
  end.    
   
  If lForceSharedSchema and wfil._File-Attributes[1] and wfil._File-Attributes[2] = false then
  do:
      /* cannot force shared with keep default area false  */
      iError = 71.
      return.
  end.       
        
  If wfil._File-Attributes[1] = false or wfil._File-Attributes[2] = true then
  do:
      RUN check_area_num (OUTPUT is-area).
      IF NOT is-area THEN DO:
        ierror = 31.
        RETURN NO-APPLY.
      END.
  end.
  
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddTable(iMod,buffer wfil:handle,file-area-number).
      return.
  end.
  
  ierror = 23. /* default error to general table attr error */

  CREATE DICTDB._File.
  assign
    DICTDB._File._Db-recid    = drec_db
    DICTDB._File._ianum       = file-area-number
    DICTDB._File._File-Number = ?
    
    file-area-number = 6.

  { prodict/dump/copy_fil.i &from=wfil &to=_File &all=false}
  
  If wfil._File-Attributes[1] then
  do:
      if not lForceSharedSchema then
      do:          
          DICTDB._File._File-Attributes[1] = wfil._File-Attributes[1]. 
          DICTDB._File._File-Attributes[2] = wfil._File-Attributes[2]. 
      end.
  end.  
   
  IF wfil._Dump-name <> ? THEN DICTDB._File._Dump-name = wfil._Dump-name.

  IF wfil._Db-lang = 1 THEN
    dblangcache = dblangcache + "," + STRING(RECID(DICTDB._File)).
  IF wfil._Frozen THEN
    frozencache = frozencache + "," + STRING(RECID(DICTDB._File)).

  ierror = 0.  /* if we get here, there were no errors */

END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "m" THEN DO: /*---------------------------------------------------*/
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddTable(iMod,buffer wfil:handle,?).
      return.
  end.
  
  ierror = 23. /* default error to general table attr error */
  IF DICTDB._File._Db-lang = 0 THEN DO:
    IF COMPARE(DICTDB._File._Can-create,"NE", wfil._Can-create,"RAW") THEN
      DICTDB._File._Can-create = wfil._Can-create.
    IF COMPARE(DICTDB._File._Can-delete,"NE",wfil._Can-delete,"RAW") THEN
      DICTDB._File._Can-delete = wfil._Can-delete.
    IF COMPARE(DICTDB._File._Can-write,"NE",wfil._Can-write,"RAW") THEN
      DICTDB._File._Can-write = wfil._Can-write.
    IF COMPARE(DICTDB._File._Can-read,"NE",wfil._Can-read,"RAW") THEN
      DICTDB._File._Can-read = wfil._Can-read.
    IF COMPARE(DICTDB._File._Can-dump,"NE",wfil._Can-dump,"RAW") THEN
      DICTDB._File._Can-dump = wfil._Can-dump.
    IF COMPARE(DICTDB._File._Can-load,"NE",wfil._Can-load,"RAW") THEN
      DICTDB._File._Can-load = wfil._Can-load.
  END.
  
  IF DICTDB._File._Desc       	<> wfil._Desc   THEN DICTDB._File._Desc   = wfil._Desc.
  IF COMPARE(DICTDB._File._File-label,"NE",wfil._File-label,"RAW") THEN 
    DICTDB._File._File-label = wfil._File-label.
  IF COMPARE(DICTDB._File._File-label-SA,"NE",wfil._File-label-SA,"RAW") THEN 
    DICTDB._File._File-label-SA = wfil._File-label-SA.
  IF COMPARE(DICTDB._File._Valexp,"NE",wfil._Valexp,"RAW") THEN DICTDB._File._Valexp = wfil._Valexp.
  IF DICTDB._File._Valmsg   	<> wfil._Valmsg THEN DICTDB._File._Valmsg = wfil._Valmsg.
  IF COMPARE(DICTDB._File._Valmsg-SA,"NE",wfil._Valmsg-SA,"RAW") THEN 
    DICTDB._File._Valmsg-SA = wfil._Valmsg-SA.
  IF DICTDB._File._Hidden   	<> wfil._Hidden THEN DICTDB._File._Hidden = wfil._Hidden.
  IF DICTDB._File._Dump-name 	<> wfil._Dump-name AND wfil._Dump-name <> ? THEN
    DICTDB._File._Dump-name = wfil._Dump-name.

  IF DICTDB._File._For-Format <> wfil._For-Format THEN
    DICTDB._File._For-Format = wfil._For-Format.
  IF DICTDB._File._For-Owner <> wfil._For-Owner THEN
    DICTDB._File._For-Owner = wfil._For-Owner.
  IF DICTDB._File._For-number <> wfil._For-number THEN
    DICTDB._File._For-number = wfil._For-number.
  IF DICTDB._File._For-Id   <> wfil._For-Id   THEN DICTDB._File._For-Id   = wfil._For-Id.
  IF DICTDB._File._For-Cnt1 <> wfil._For-Cnt1 THEN DICTDB._File._For-Cnt1 = wfil._For-Cnt1.
  IF DICTDB._File._For-Cnt2 <> wfil._For-Cnt2 THEN DICTDB._File._For-Cnt2 = wfil._For-Cnt2.
  IF DICTDB._File._For-Flag <> wfil._For-Flag THEN DICTDB._File._For-Flag = wfil._For-Flag.
  IF DICTDB._File._For-Info <> wfil._For-Info THEN DICTDB._File._For-Info = wfil._For-Info.
  IF DICTDB._File._For-Name <> wfil._For-Name THEN DICTDB._File._For-Name = wfil._For-Name.
  IF DICTDB._File._For-Size <> wfil._For-Size THEN DICTDB._File._For-Size = wfil._For-Size.
  IF DICTDB._File._For-Type <> wfil._For-Type THEN DICTDB._File._For-Type = wfil._For-Type.

  IF DICTDB._File._Fil-misc2[1] <> wfil._Fil-misc2[1] THEN
    DICTDB._File._Fil-misc2[1] = wfil._Fil-misc2[1].

  IF DICTDB._File._Fil-misc2[2] <> wfil._Fil-misc2[2] THEN
    DICTDB._File._Fil-misc2[2] = wfil._Fil-misc2[2].

  IF DICTDB._File._Fil-misc2[3] <> wfil._Fil-misc2[3] THEN
    DICTDB._File._Fil-misc2[3] = wfil._Fil-misc2[3].

  IF DICTDB._File._Fil-misc2[4] <> wfil._Fil-misc2[4] THEN
    DICTDB._File._Fil-misc2[4] = wfil._Fil-misc2[4].

  IF DICTDB._File._Fil-misc2[5] <> wfil._Fil-misc2[5] THEN
    DICTDB._File._Fil-misc2[5] = wfil._Fil-misc2[5].

  IF COMPARE(DICTDB._File._Fil-misc2[6],"NE",wfil._Fil-misc2[6],"RAW") THEN
    DICTDB._File._Fil-misc2[6] = wfil._Fil-misc2[6].

  IF DICTDB._File._Fil-misc2[7] <> wfil._Fil-misc2[7] THEN
    DICTDB._File._Fil-misc2[7] = wfil._Fil-misc2[7].

  IF DICTDB._File._Fil-misc2[8] <> wfil._Fil-misc2[8] THEN
    DICTDB._File._Fil-misc2[8] = wfil._Fil-misc2[8].

  IF DICTDB._File._Fil-misc1[1] <> wfil._Fil-misc1[1] THEN
    DICTDB._File._Fil-misc1[1] = wfil._Fil-misc1[1].

  IF DICTDB._File._Fil-misc1[2] <> wfil._Fil-misc1[2] THEN
    DICTDB._File._Fil-misc1[2] = wfil._Fil-misc1[2].

  IF DICTDB._File._Fil-misc1[3] <> wfil._Fil-misc1[3] THEN
    DICTDB._File._Fil-misc1[3] = wfil._Fil-misc1[3].

  IF DICTDB._File._Fil-misc1[4] <> wfil._Fil-misc1[4] THEN
    DICTDB._File._Fil-misc1[4] = wfil._Fil-misc1[4].

  IF DICTDB._File._Fil-misc1[5] <> wfil._Fil-misc1[5] THEN
    DICTDB._File._Fil-misc1[5] = wfil._Fil-misc1[5].

  IF DICTDB._File._Fil-misc1[6] <> wfil._Fil-misc1[6] THEN
    DICTDB._File._Fil-misc1[6] = wfil._Fil-misc1[6].

  IF DICTDB._File._Fil-misc1[7] <> wfil._Fil-misc1[7] THEN
    DICTDB._File._Fil-misc1[7] = wfil._Fil-misc1[7].

  IF DICTDB._File._Fil-misc1[8] <> wfil._Fil-misc1[8] THEN
    DICTDB._File._Fil-misc1[8] = wfil._Fil-misc1[8].
  
  IF DICTDB._File._File-attributes[1] = false and wfil._File-attributes[1] THEN
  DO.
      if not lForceSharedSchema then
      do:          
          DICTDB._File._File-Attributes[1] = wfil._File-Attributes[1]. 
          /* keep default area is set to True in the UI when _wfil._File-Attributes[1] changes */
          DICTDB._File._File-Attributes[2] = wfil._File-Attributes[2]. 
      end.
  END.
  /* keep default area is currently not changable 
  ELSE 
  IF DICTDB._File._File-attributes[1] = true 
  and DICTDB._File._File-attributes[2] <> wfil._File-attributes[2] THEN
  do:
      DICTDB._File._File-attributes[2] = wfil._File-attributes[2].
  end. 
  */
  
  IF wfil._Frozen THEN
    frozencache = frozencache + "," + STRING(RECID(_File)).
  
  ierror = 0.  /* if we get here, there were no errors */

END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "r" THEN DO: /*---------------------------------------------------*/
  IF CAN-FIND(FIRST DICTDB._View-ref WHERE DICTDB._View-ref._Ref-Table = wfil._File-name) THEN
    ierror = 20. /* "Cannot &1 &2 referenced in SQL view" */
  IF DICTDB._File._Db-lang = 1 THEN
    ierror = 18. /* "Cannot rename SQL table" */
  IF CAN-FIND(FIRST DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
    AND DICTDB._File._File-name = irename
    AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN") ) THEN
    ierror = 7. /* "&2 already exists with name &3" */
  
  IF ierror > 0 THEN RETURN.
  
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:RenameTable(wfil._File-name,irename).
      return.
  end.
  
  DICTDB._File._File-name = irename.
END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "d" THEN DO: /*---------------------------------------------------*/
  IF DICTDB._File._Db-lang = 1 THEN
    ierror = 17. /* "Use SQL DROP TABLE to remove &3" */
  IF CAN-FIND(FIRST DICTDB._View-ref WHERE DICTDB._View-ref._Ref-Table = DICTDB._File._File-name) THEN
    ierror = 20. /* "Cannot &1 &2 referenced in SQL view" */
  IF ierror > 0 THEN RETURN.
  
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddTable(iMod,buffer wfil:handle,?).
      return.
  end.
  
  &scop alias dictdb.
  { prodict/dump/loadkill.i }
  &undefine alias  

END. /*---------------------------------------------------------------------*/

/* update triggers */
IF imod = "a" OR imod = "m" THEN DO:
  scrap = "".
  trig_loop:
  FOR EACH wfit:
    IF wfit._Proc-name = "!" THEN DO:
      DELETE wfit. /* triggers are deleted via .df when proc-name set to "!" */
      NEXT trig_loop.
    END.
    scrap = scrap + (IF scrap = "" THEN "" ELSE ",") + wfit._Event.
    FIND DICTDB._File-trig OF DICTDB._File WHERE DICTDB._File-trig._Event = wfit._Event NO-ERROR.
    IF AVAILABLE DICTDB._File-trig THEN DO:
      old_name = DICTDB._File-trig._Proc-name.
      new_name = wfit._Proc-name.
      IF  DICTDB._File-trig._Event     = wfit._Event
      AND DICTDB._File-trig._Override  = wfit._Override
      AND old_name              = new_name
      AND DICTDB._File-trig._Trig-CRC  = wfit._Trig-CRC THEN NEXT trig_loop.
    END.

    /* Progress doesn't let you modify a trigger record, so delete and
       recreate. */
    IF AVAILABLE DICTDB._File-trig THEN DELETE DICTDB._File-trig.
    CREATE DICTDB._File-trig.
    ASSIGN
      DICTDB._File-trig._File-recid = RECID(DICTDB._File)
      DICTDB._File-trig._Event      = wfit._Event
      DICTDB._File-trig._Override   = wfit._Override
      DICTDB._File-trig._Proc-Name  = wfit._Proc-Name
      DICTDB._File-trig._Trig-CRC   = wfit._Trig-CRC.
      
    /* Update DICTDB._File._File-name.  Force timestamp change.   *
     * Refer to bug# 99-02-09-002                          */
    IF AVAIL DICTDB._File THEN
    DO:
       ASSIGN DICTDB._File._File-name = wfil._File-name.    
    END.
    
  END.
  FOR EACH DICTDB._File-trig OF DICTDB._File WHERE NOT CAN-DO(scrap,DICTDB._File-trig._Event):
    DELETE DICTDB._File-trig.
  END.
END.

ASSIGN
  drec_file   = RECID(DICTDB._File)
  kindexcache = "". /* and reset index delete cache on db or file change */

RETURN.

/*---------------------- INTERNAL PROCEDURES -----------------------*/

PROCEDURE check_area_num:
  DEFINE OUTPUT PARAMETER is-area AS LOGICAL INITIAL TRUE NO-UNDO.

    FIND FIRST DICTDB._Area WHERE DICTDB._Area._Area-number = file-area-number AND DICTDB._Area._Area-number >= 6 NO-ERROR.
    IF NOT AVAILABLE DICTDB._Area THEN DO:
      is-area = NOT is-area.
      RETURN.
     END.
     ELSE DO:
       is-area = TRUE.
       RETURN.
     END.
END PROCEDURE.


/*********************************************************************
* Copyright (C) 2005-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
    History:

      04/14/98 Added assignment of _field-rpos if in workfile  D. McMann
      06/12/98 Added assignment for modify field of _field-rpos
               98-06-01-027 D. McMann
      12/27/98 Added check for _file._Prime-index = ? 98-11-23-038 D. McMann
      01/27/99 Added logic for assignment of _width D. McMann
      08/24/99 Added logic for update of _width Mario B. 19990824-019
      04/10/00 Added warning for case sensitive field in index  
      04/11/01 Added warning for SQL Table Updates ISSUE 310
      04/09/03 Added check for not RECID of field on rename 20030407-015
      06/12/03 Added check for _Width field in temp table being ? 20030611-060
      09/22/03 Added check for CLOB to have codepage and collation set.
      09/29/03 Added check for invalid data type 20030925-014
      07/09/04 Added abbreviations for data types 20040430-023
      04/25/06 Added int64 to list of data types
      06/12/06 Allow int->int64 type change and check for _Initial overflow
      08/16/06 Raw comparison when checking if char values are different - 20060301-002
      10/02/07 Error handling - OE00158774
      04/30/08 Fix handling of Order values - OE00166224
      11/24/08 Changes for clob field - OE00177533
*/    
    
define input-output parameter minimum-index as integer.

{ prodict/dump/loaddefs.i }
{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE scrap    AS CHARACTER NO-UNDO.
DEFINE VARIABLE fldrecid AS RECID     NO-UNDO.
DEFINE VARIABLE fldrpos  AS INTEGER   NO-UNDO.

DEFINE VARIABLE i        AS INTEGER   NO-UNDO.
DEFINE VARIABLE gotError AS LOGICAL   NO-UNDO.
DEFINE VARIABLE freeOrder AS INT      NO-UNDO.
define variable lnewparent  as logical no-undo.

define variable dictLoader as OpenEdge.DataAdmin.Binding.IDataDefinitionLoader no-undo.

/* dictLoadOptions - could have options only or be a logger/loader or reader/parser  */

if valid-object(dictLoadOptions) then
do:
    /* the code below use valid-object(dictLoader) as flag to logg data and return */
    dictLoader = dictLoadOptions:Logger.
end.

if valid-object(dictLoader) and dictLoader:isReader and imod = "a" then
    lnewparent = dictLoader:AddingChildToNewTable.

if not lnewParent then
do:  
    FIND _File WHERE RECID(_File) = drec_file NO-ERROR.

    IF NOT AVAILABLE _File THEN
      RETURN.
    IF _File._Frozen THEN
      ierror = 14. /* "Cannot alter field from frozen file" */
    IF _File._Db-lang = 1 AND imod <> "m" THEN
      ierror = 15. /* "Use SQL ALTER TABLE to change field" */
    IF ierror > 0 THEN 
       RETURN.
end.

DO ON ERROR UNDO, LEAVE: /* OE00158774 */

ASSIGN gotError = YES.

FIND FIRST wfld.
 
IF imod <> "a" THEN
  FIND _Field OF _File
    WHERE _Field._Field-name = wfld._Field-name. /* proven to exist */

IF imod = "a" THEN DO: /*---------------------------------------------------*/
  if not lnewparent then
  do:
      IF CAN-FIND(_Field WHERE _Field._File-recid = drec_file
                           AND _Field._Field-name = wfld._Field-name) THEN
      do:  
          if valid-object(dictLoader) and dictLoader:isReader then
          do:   
             /* this is not an error if parsing and the existing field is renamed */
              if dictLoader:IndexNewName(_File._File-name,wfld._Field-name) = "" then
                 ierror = 7. /* "&2 already exists with name &3" */
              
          end. 
          else   
             ierror = 7. /* "&2 already exists with name &3" */
      end.  
  end.
  
  IF wfld._Data-type = "CLOB" AND
    (wfld._Charset = ? OR wfld._Collation = ?) THEN
    ierror = 46.

  /* OE00177533 - make sure attributes1 is correct based on column and db codepage */
  IF  wfld._Data-type = "CLOB" AND wfld._Attributes1 = 1 THEN DO:
     if not lnewParent then
        FIND _Db WHERE RECID(_Db)= _File._Db-recid.
     else
        FIND _Db WHERE RECID(_Db)= drec_db.
     
     /* if codepages don't match, then this must be 2 in spite of what the .df has */
     IF UPPER(wfld._Charset) NE UPPER(_Db._db-xl-name) THEN
        wfld._Attributes1 = 2.
  END.

  /* allow int64 for 10.1B an later */
  IF LOOKUP(wfld._Data-type,"CHARACTER,CHAR,DATE,DECIMAL,DEC,INTEGER,INT,LOGICAL,DATETIME,DATETIME-TZ,BLOB,CLOB,RAW,RECID"
                            + (IF NOT is-pre-101b-db THEN ",INT64" ELSE "")) = 0 THEN 
    ASSIGN ierror = 47.

  IF (wfld._Data-type = "CLOB" OR wfld._Data-type = "BLOB") AND 
      wfld._Extent > 0 THEN
      ierror = 55.

  IF ierror > 0 THEN RETURN.
  
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddField(iMod,if lnewparent then ? else _File._file-name,buffer wfld:handle,wfld._Fld-stlen).
      return.   
  end.
  
  IF wfld._Order = ? THEN DO:
    FIND LAST _Field WHERE _Field._File-recid = drec_file
      USE-INDEX _field-position NO-ERROR.
    wfld._Order = (IF AVAILABLE _Field THEN _Field._Order ELSE 0) + 10.
  END.
  
  /* existing order! */
  IF CAN-FIND(_Field WHERE _Field._File-recid = drec_file
    AND _Field._Order = wfld._Order) THEN
    RUN bump_sub (wfld._Order).

  IF gate_dbtype <> "PROGRESS" THEN DO:
    wfld._Fld-stdtype = ?.
    RUN VALUE(gate_proc) (
      INPUT-OUTPUT wfld._Fld-stdtype,
      INPUT-OUTPUT wfld._Fld-stlen,
      INPUT-OUTPUT wfld._Data-type,
      INPUT-OUTPUT wfld._For-type,
      OUTPUT scrap).

    /* check if found valid type */
    IF wfld._For-type = ? or wfld._For-type = "" THEN DO:
       ierror = 59.
       RETURN.
    END.

    IF wfld._Format = ? THEN wfld._Format = scrap.
  END.

  CREATE _Field.
  ASSIGN
    _Field._File-recid = drec_file
    _Field._Field-name = wfld._Field-name
    _Field._Data-type  = wfld._Data-type
    _Field._Order      = wfld._Order NO-ERROR.

  { prodict/dump/copy_fld.i &from=wfld &to=_Field &all=false}

  fldrecid = RECID(_Field).
  IF wfld._Format  <> ?  THEN _Field._Format  = wfld._Format.
  
  IF wfld._Initial <> "" THEN DO:
      /* check for overflow (in case this is an int/int64 field */
      ASSIGN _Field._Initial = wfld._Initial NO-ERROR. 
      IF ERROR-STATUS:ERROR THEN DO:
        ierror = 52.
        RETURN.
      END.
  END.
  
  IF wfld._Field-rpos <> ? THEN _Field._Field-rpos = wfld._Field-rpos.
  IF wfld._Width <> ? THEN _Field._Width = wfld._Width.
  IF wfld._Charset <> ? THEN _Field._Charset = wfld._Charset.
  IF wfld._Collation <> ? THEN _Field._Collation = wfld._Collation.
  IF wfld._Attributes1 <> 0 AND wfld._Attributes1 <> ? THEN _Field._Attributes1 = wfld._Attributes1.

END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "m" THEN DO: /*---------------------------------------------------*/
  IF _Field._Data-type <> wfld._Data-type THEN DO:
    /* allow integer to int64 updates for 10.1B and later */
    IF (_Field._Data-type = "int" OR _Field._Data-type = "integer") AND 
        wfld._Data-type = "int64" AND NOT is-pre-101b-db THEN
        _Field._Data-type  = wfld._Data-type.
    ELSE
        ierror = 10. /* "Cannot change datatype of existing field" */
  END.
  IF _Field._Extent <> wfld._Extent THEN
    ierror = 11. /* "Cannot change extent of existing field" */
  IF ierror > 0 THEN RETURN.
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddField(iMod,_File._file-name,buffer wfld:handle,?).
      return.   
  end.

  /* OE00177533 - make sure attributes1 is correct based on column and db codepage */
  IF _Field._Data-type = "CLOB" AND 
     _Field._Attributes1 = 2  AND wfld._Attributes1 = 1 THEN DO:
     FIND _Db WHERE RECID(_Db)= _File._Db-recid.
     /* if codepages don't match, then this must be 2 in spite of what the .df has */
     IF UPPER(_Field._Charset) NE UPPER(_Db._db-xl-name) THEN
        wfld._Attributes1 = _Field._Attributes1.
  END.

  /* existing order! */
  IF _Field._Order <> wfld._Order
    AND CAN-FIND(_Field WHERE _Field._File-recid = drec_file
      AND _Field._Order = wfld._Order) THEN
    RUN bump_sub (wfld._Order).

  IF gate_dbtype <> "PROGRESS" THEN DO:
    wfld._Fld-stdtype = ?.
    RUN VALUE(gate_proc) (
      INPUT-OUTPUT wfld._Fld-stdtype,
      INPUT-OUTPUT wfld._Fld-stlen,
      INPUT-OUTPUT wfld._Data-type,
      INPUT-OUTPUT wfld._For-type,
      OUTPUT scrap).
    IF wfld._Format = ? THEN wfld._Format = scrap.
  END.

  IF _File._Db-lang = 0 THEN DO:
    IF COMPARE(_Field._Can-write,"NE",wfld._Can-write,"RAW") THEN _Field._Can-write     = wfld._Can-write.
    IF COMPARE(_Field._Can-read,"NE",wfld._Can-read,"RAW")   THEN _Field._Can-read      = wfld._Can-read.
    IF _Field._Mandatory   <> wfld._Mandatory    THEN _Field._Mandatory     = wfld._Mandatory.
    IF _Field._Decimals    <> wfld._Decimals     THEN _Field._Decimals      = wfld._Decimals.
  END.
  ELSE IF _file._db-lang = 1 THEN DO:
    IF COMPARE(_Field._Can-write,"NE",wfld._Can-write,"RAW") OR
       COMPARE(_Field._Can-read,"NE",wfld._Can-read,"RAW")   OR
       _Field._Mandatory   <> wfld._Mandatory  OR
       _Field._Decimals    <> wfld._Decimals   THEN
       ASSIGN iwarnlst = iwarnlst + "23,"
              ierror = 50.
  END.

  IF COMPARE(_Field._Col-label,"NE",wfld._Col-label,"RAW")  THEN _Field._Col-label     = wfld._Col-label.
  IF COMPARE(_Field._Col-label-SA,"NE",wfld._Col-label-SA,"RAW") THEN _Field._Col-label-SA  = wfld._Col-label-SA.
  IF COMPARE(_Field._Desc,"NE",wfld._Desc,"RAW")            THEN _Field._Desc          = wfld._Desc.
  IF COMPARE(_Field._Format,"NE",wfld._Format,"RAW")        THEN _Field._Format        = wfld._Format.
  IF COMPARE(_Field._Format-SA,"NE",wfld._Format-SA,"RAW")  THEN _Field._Format-SA     = wfld._Format-SA.
  IF COMPARE(_Field._Help,"NE",wfld._Help,"RAW")            THEN _Field._Help          = wfld._Help.
  IF COMPARE(_Field._Help-SA ,"NE",wfld._Help-SA,"RAW")     THEN _Field._Help-SA       = wfld._Help-SA.
  IF COMPARE(_Field._Initial,"NE",wfld._Initial,"RAW")      THEN _Field._Initial       = wfld._Initial.
  IF COMPARE(_Field._Initial-SA,"NE",wfld._Initial-SA,"RAW") THEN _Field._Initial-SA    = wfld._Initial-SA.
  IF COMPARE(_Field._Label,"NE",wfld._Label,"RAW")          THEN _Field._Label         = wfld._Label.
  IF COMPARE(_Field._Label-SA,"NE",wfld._Label-SA,"RAW")    THEN _Field._Label-SA      = wfld._Label-SA.
  IF _Field._Field-rpos    <> wfld._Field-rpos              THEN _Field._Field-rpos    = wfld._Field-rpos.
  IF COMPARE(_Field._Valexp,"NE",wfld._Valexp,"RAW")        THEN _Field._Valexp        = wfld._Valexp.
  IF _Field._Valmsg        <> wfld._Valmsg                  THEN _Field._Valmsg        = wfld._Valmsg.
  IF COMPARE(_Field._Valmsg-SA,"NE",wfld._Valmsg-SA,"RAW")  THEN _Field._Valmsg-SA     = wfld._Valmsg-SA.
  IF COMPARE(_Field._View-as,"NE",wfld._View-as,"RAW")      THEN _Field._View-as       = wfld._View-as.

  IF _Field._Fld-case      <> wfld._Fld-case                THEN DO:
   IF NOT CAN-FIND(FIRST _Index-field OF _Field) THEN _Field._Fld-case     = wfld._Fld-case.
   ELSE 
       ASSIGN iwarnlst = iwarnlst + "24,"
              ierror = 50.
  END.

  IF _Field._Fld-stlen     <> wfld._Fld-stlen               THEN _Field._Fld-stlen     = wfld._Fld-stlen.
  IF _Field._Fld-stoff     <> wfld._Fld-stoff               THEN _Field._Fld-stoff     = wfld._Fld-stoff.
  IF _Field._Fld-stdtype   <> wfld._Fld-stdtype             THEN _Field._Fld-stdtype   = wfld._Fld-stdtype.
  IF _Field._For-Id        <> wfld._For-Id                  THEN _Field._For-Id        = wfld._For-Id.
  IF _Field._For-Name      <> wfld._For-Name                THEN _Field._For-Name      = wfld._For-Name.
  IF _Field._For-Type      <> wfld._For-Type                THEN _Field._For-Type      = wfld._For-Type.
  IF _Field._For-Xpos      <> wfld._For-Xpos                THEN _Field._For-Xpos      = wfld._For-Xpos.
  IF _Field._For-Itype     <> wfld._For-Itype               THEN _Field._For-Itype     = wfld._For-Itype.
  IF _Field._For-Retrieve  <> wfld._For-Retrieve            THEN _Field._For-Retrieve  = wfld._For-Retrieve.
  IF _Field._For-Scale     <> wfld._For-Scale               THEN _Field._For-Scale     = wfld._For-Scale.
  IF _Field._For-Spacing   <> wfld._For-Spacing             THEN _Field._For-Spacing   = wfld._For-Spacing.
  IF _Field._For-Separator <> wfld._For-Separator           THEN _Field._For-Separator = wfld._For-Separator.
  IF _Field._For-Allocated <> wfld._For-Allocated           THEN _Field._For-Allocated = wfld._For-Allocated.
  IF _Field._For-Maxsize   <> wfld._For-Maxsize             THEN _Field._For-Maxsize   = wfld._For-Maxsize.
  IF _Field._Fld-misc2[1]  <> wfld._Fld-misc2[1]            THEN _Field._Fld-misc2[1]  = wfld._Fld-misc2[1].
  IF _Field._Fld-misc2[2]  <> wfld._Fld-misc2[2]            THEN _Field._Fld-misc2[2]  = wfld._Fld-misc2[2].
  IF _Field._Fld-misc2[3]  <> wfld._Fld-misc2[3]            THEN _Field._Fld-misc2[3]  = wfld._Fld-misc2[3].
  IF _Field._Fld-misc2[4]  <> wfld._Fld-misc2[4]            THEN _Field._Fld-misc2[4]  = wfld._Fld-misc2[4]. 
  IF _Field._Fld-misc2[5]  <> wfld._Fld-misc2[5]            THEN _Field._Fld-misc2[5]  = wfld._Fld-misc2[5].
  IF _Field._Fld-misc2[6]  <> wfld._Fld-misc2[6]            THEN _Field._Fld-misc2[6]  = wfld._Fld-misc2[6].
  IF _Field._Fld-misc2[7]  <> wfld._Fld-misc2[7]            THEN _Field._Fld-misc2[7]  = wfld._Fld-misc2[7].
  IF _Field._Fld-misc2[8]  <> wfld._Fld-misc2[8]            THEN _Field._Fld-misc2[8]  = wfld._Fld-misc2[8].
  IF _Field._Fld-misc1[1]  <> wfld._Fld-misc1[1]            THEN _Field._Fld-misc1[1]  = wfld._Fld-misc1[1].
  IF _Field._Fld-misc1[2]  <> wfld._Fld-misc1[2]            THEN _Field._Fld-misc1[2]  = wfld._Fld-misc1[2].
  IF _Field._Fld-misc1[3]  <> wfld._Fld-misc1[3]            THEN _Field._Fld-misc1[3]  = wfld._Fld-misc1[3].
  IF _Field._Fld-misc1[4]  <> wfld._Fld-misc1[4]            THEN _Field._Fld-misc1[4]  = wfld._Fld-misc1[4].
  IF _Field._Fld-misc1[5]  <> wfld._Fld-misc1[5]            THEN _Field._Fld-misc1[5]  = wfld._Fld-misc1[5].
  IF _Field._Fld-misc1[6]  <> wfld._Fld-misc1[6]            THEN _Field._Fld-misc1[6]  = wfld._Fld-misc1[6].
  IF _Field._Fld-misc1[7]  <> wfld._Fld-misc1[7]            THEN _Field._Fld-misc1[7]  = wfld._Fld-misc1[7].
  IF _Field._Fld-misc1[8]  <> wfld._Fld-misc1[8]            THEN _Field._Fld-misc1[8]  = wfld._Fld-misc1[8].
  
  IF wfld._Width <> ? AND _Field._Width <> wfld._Width      THEN 
      _Field._Width  = wfld._Width.

  IF _Field._Order <> wfld._Order THEN DO: 
      ASSIGN freeOrder = _Field._Order
             _Field._Order = wfld._Order.

      /* OE00166224 - see if some other field wanted this order value */
      RUN retryOrder(INPUT freeOrder).
  END.

  /* OE00177533 - catch incorrect changes for clob fields - manual editing */
  IF _Field._data-type = "clob" THEN DO:
      IF (wfld._Charset   <> ? AND UPPER(_Field._Charset) NE UPPER(wfld._Charset)) OR
         (wfld._Collation <> ? AND UPPER(_Field._Collation) NE UPPER(wfld._Collation)) THEN DO:
          ASSIGN ierror = 66. /* Cannot change codepage or collation of existing column */
          RETURN.
      END.

      IF wfld._Attributes1 <> 0 AND wfld._Attributes1 <> ? THEN 
         _Field._Attributes1 = wfld._Attributes1.
  END.

  fldrecid = RECID(_Field).

END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "r" THEN DO: /*---------------------------------------------------*/
  IF CAN-FIND(FIRST _View-ref
    WHERE _View-ref._Ref-Table = _File._File-name
    AND _View-ref._Base-Col = _Field._Field-name) THEN
    ierror = 20. /* "Cannot &1 &2 referenced in SQL view" */
  IF CAN-FIND(FIRST _Field OF _File WHERE _Field._Field-name = irename
                                      AND RECID(_Field) <> RECID (_Field)) THEN
    ierror = 7. /* "&2 already exists with name &3" */
  IF ierror > 0 THEN RETURN.
  
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:RenameField(_File._file-name,_Field._Field-Name, irename).
      return.   
  end.
  
  /* OE00166224 - if this field is in the list of fields to be reordered,
     change its name in the temp-table too.
  */
  FIND FIRST ttFldOrder WHERE ttFldOrder.FILE-NAME = _File._File-name AND
             ttFldOrder.Field-Name = _Field._Field-Name NO-ERROR.
  IF AVAILABLE ttFldOrder THEN
     ttFldOrder.Field-Name = irename.

  /* finally, change the field name now */
  ASSIGN _Field._Field-name = irename.

END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "d" THEN DO: /*---------------------------------------------------*/
  IF CAN-FIND(FIRST _View-ref
    WHERE _View-ref._Ref-Table = _File._File-name
    AND _View-ref._Base-Col = _Field._Field-name) THEN
    ierror = 20. /* "Cannot &1 &2 referenced in SQL view" */
  IF ierror > 0 THEN RETURN.
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddField(iMod,_File._file-name,buffer wfld:handle,?).
      return.   
  end.

  /* This moves the primary index if the field being deleted is */
  /* part of the primary index. */
  FIND FIRST _Index-field OF _Field
    WHERE _Index-field._Index-recid = _File._Prime-Index NO-ERROR.
  IF AVAILABLE _Index-field THEN
    FOR EACH _Index-field OF _Field,
      _Index OF _Index-field
        WHERE _File._Prime-Index <> RECID(_Index) AND _Index._Wordidx <> 1:
      _File._Prime-Index = RECID(_Index).
      LEAVE.
    END.

  /* Now complain if we can't find another index to serve as primary. */
  IF _File._Prime-Index <> ? AND _File._Prime-index = RECID(_Index) THEN
    ierror = 8. /* "Field being deleted is part of primary index" */
  IF ierror > 0 THEN RETURN.

  /* The following is a sneaky way to delete all index-field records */
  /* associated with a given field, using only one index cursor. */
  FIND FIRST _Index-field OF _Field NO-ERROR.
  DO WHILE AVAILABLE _Index-field:
    FIND _Index OF _Index-field.
    FOR EACH _Index-field OF _Index:
      DELETE _Index-field.
    END.
    kindexcache = kindexcache + "," + _Index._Index-name.
    DELETE _Index.
    FIND FIRST _Index-field OF _Field NO-ERROR.
  END.

  /* and remove associated triggers */
  FOR EACH _Field-trig OF _Field:
    DELETE _Field-trig.
  END.
  FOR EACH _Constraint OF _Field:
    FOR EACH _Constraint-Keys WHERE _Constraint-Keys._Con-Recid = RECID(_Constraint):
       DELETE _Constraint-Keys.
    END.  
    DELETE _Constraint.
  END.

  freeOrder = _Field._Order.
  DELETE _Field.

  /* OE00166224 - see if some other field wanted this order value */
  RUN retryOrder (INPUT freeOrder).

END. /*---------------------------------------------------------------------*/

/* update triggers */
IF imod = "a" OR imod = "m" THEN DO:
  scrap = "".
  FOR EACH wflt:
    IF wflt._Proc-name = "!" THEN DO:
      DELETE wflt. /* triggers are deleted via .df when proc-name set to "!" */
      NEXT.
    END.
    FIND _Field-trig OF _Field WHERE _Field-trig._Event = wflt._Event NO-ERROR.
    FIND _Field WHERE RECID(_Field) = fldrecid.
    ASSIGN
      scrap = scrap + (IF scrap = "" THEN "" ELSE ",") + wflt._Event.
    IF AVAILABLE _Field-trig
      AND _Field-trig._Event     = wflt._Event
      AND _Field-trig._Override  = wflt._Override
      AND _Field-trig._Proc-name = wflt._Proc-name 
      AND _Field-trig._Trig-CRC  = wflt._Trig-CRC THEN NEXT.
    IF AVAILABLE _Field-trig THEN DELETE _Field-trig.
    CREATE _Field-trig.
    ASSIGN
      _Field-trig._File-recid  = drec_file
      _Field-trig._Field-recid = fldrecid
      _Field-trig._Event       = wflt._Event
      _Field-trig._Override    = wflt._Override
      _Field-trig._Proc-Name   = wflt._Proc-Name
      _Field-trig._Trig-CRC    = wflt._Trig-CRC.
  END.
  FOR EACH _Field-trig OF _Field WHERE NOT CAN-DO(scrap,_Field-trig._Event):
    DELETE _Field-trig.
  END.
END.

ASSIGN gotError = NO.
END.

IF gotError THEN
   ierror = 56. /* generic error - some client error raised */
   

RETURN.


PROCEDURE bump_sub.
  DEFINE INPUT  PARAMETER norder AS INTEGER NO-UNDO.

  DEFINE BUFFER uField FOR _Field.
  DEFINE VARIABLE i AS INTEGER NO-UNDO.
  DEFINE VARIABLE j AS INTEGER NO-UNDO.

  FIND uField OF _File WHERE uField._Order = norder NO-ERROR.
  IF NOT AVAILABLE uField THEN RETURN.

  DO i = norder + 1 TO i + 1:
    FIND uField OF _File WHERE uField._Order = i NO-ERROR.
    IF NOT AVAILABLE uField THEN LEAVE.
  END.

  DO j = i - 1 TO norder BY -1:
    FIND uField OF _File WHERE uField._Order = j.
    uField._Order = uField._Order + 1.

    /* OE00166224 - if this is the first time we are changing it for this field
       on this table, record the old value so we try to reassign it back, in 
       case some fields were deleted or had the order changed, freeing this
       order value.
    */
    FIND FIRST ttFldOrder WHERE ttFldOrder.FILE-NAME = _File._File-name
         AND ttFldOrder.Field-Name = uField._Field-name
         AND ttFldOrder.Prev-Order = norder NO-ERROR.
    IF NOT AVAILABLE ttFldOrder THEN DO:
        CREATE ttFldOrder.
        ASSIGN ttFldOrder.FILE-NAME = _File._File-name
               ttFldOrder.Field-name = uField._Field-Name
               ttFldOrder.Prev-Order = uField._Order - 1.
    END.
  END.

END PROCEDURE.

PROCEDURE retryOrder.
    DEFINE INPUT PARAMETER pOrder AS INT NO-UNDO.

    DEFINE BUFFER uField FOR _Field.

    /* OE00166224 - now that this Order is free, see if there was a field
       that needed this order value on this table.
    */
    FIND FIRST ttFldOrder WHERE ttFldOrder.FILE-NAME = _File._File-name AND
               ttFldOrder.Prev-Order = pOrder NO-ERROR.
    IF AVAILABLE ttFldOrder THEN DO:
        FIND FIRST uField OF _File WHERE uField._Field-Name = ttFldORder.Field-Name NO-ERROR.
        IF AVAILABLE uField THEN
            ASSIGN uField._Order = pOrder.
        DELETE ttFldOrder. /* done */
    END.
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/                    
/*
    History:
   
    21/06/2011 Added logic to delete constraint OE00195067 kmayur 
*/ 
define input-output parameter minimum-index as integer.

{ prodict/dictvar.i }
{ prodict/dump/loaddefs.i }
{ prodict/user/uservar.i }

/*---------------------- INTERNAL PROCEDURES -----------------------*/

PROCEDURE check_area_num:
  DEFINE OUTPUT PARAMETER is-area AS LOGICAL INITIAL TRUE NO-UNDO.

    FIND FIRST DICTDB._Area WHERE DICTDB._Area._Area-number = index-area-number AND DICTDB._Area._Area-number >= 6 NO-ERROR.
    IF NOT AVAILABLE DICTDB._Area THEN DO:
      is-area = NOT is-area.
      RETURN.
     END.
     ELSE DO:
       is-area = TRUE.
       RETURN.
     END.
END PROCEDURE.

/*------------------------------------------------------------------*/
DEFINE VARIABLE scrap AS LOGICAL NO-UNDO.
DEFINE BUFFER another_index FOR _Index.
define variable lnewparent  as logical no-undo.
DEFINE VARIABLE gotError AS LOGICAL   NO-UNDO.
DEFINE BUFFER   con        FOR  _Constraint. 

define variable dictLoader as OpenEdge.DataAdmin.Binding.IDataDefinitionLoader no-undo.

/* dictLoadOptions - could have options only or be a logger/loader or reader/parser  */

if valid-object(dictLoadOptions) then
do:
    /* the code below use valid-object(dictLoader) as flag to logg data and return */
    dictLoader = dictLoadOptions:Logger.
end.

if valid-object(dictLoader) and dictLoader:isReader and imod = "a" then
    lnewparent = dictLoader:AddingChildToNewTable.

if not lnewParent then
do:  
    FIND _File WHERE RECID(_File) = drec_file no-error.
    IF NOT AVAILABLE _File THEN
        RETURN.
end.
FIND FIRST widx.
IF imod <> "a" AND imod <> "d" THEN
  FIND _Index OF _File
    WHERE _Index._Index-name = widx._Index-name. /* proven to exist */

DO ON ERROR UNDO, LEAVE:

    ASSIGN gotError = YES.
    
    IF imod = "a" THEN DO: /*----------------------------------------------*/
      if not lnewparent then
      do:
        IF CAN-FIND(FIRST _Index OF _File 
              	    WHERE _Index._Index-name = widx._Index-name) THEN 
        DO:
            if valid-object(dictLoader) and dictLoader:isReader then
            do:   
                /* this is not an error if the existing index is renamed */
                if dictLoader:IndexNewName(_File._File-name,widx._Index-name) = "" then
                do:
                   ierror = 7. /* "&2 already exists with name &3" */
                   RETURN.
                end.    
            end. 
            else do:
               ierror = 7. /* "&2 already exists with name &3" */
               RETURN.
            end.   
        END.
      end.
      
      /* if multi-tenant and keep-default is off, it's ok to have area number zero */
      If lnewparent OR 
         index-area-number NE 0 OR
         NOT (_File._File-Attributes[1] = TRUE AND /* MT */
              _File._File-Attributes[2] = FALSE) THEN /* keep-default off */
      DO:
         RUN check_area_num (OUTPUT is-area).
         IF NOT is-area THEN DO:
           ierror = 31.
           RETURN NO-APPLY.
         END.
      END.
      
      if valid-object(dictLoader) and dictLoader:isReader then
      do:
          dictLoader:AddIndex(iMod,if lnewparent then ? else _File._file-name,buffer widx:handle,index-area-number).
          return.   
      end.
    
      CREATE _Index.
      ASSIGN
        _Index._File-recid = drec_file
        _Index._I-misc1[1] = widx._I-misc1[1]
        _Index._Index-name = widx._Index-name
        _Index._ianum      = index-area-number
        index-area-number = 6 /* reset it to default value */
        _Index._Unique     = widx._Unique.
      IF widx._Desc       <> ? THEN _Index._Desc       = widx._Desc.
      IF widx._Wordidx    <> ? THEN _Index._Wordidx    = widx._Wordidx.
      IF widx._Idx-num    <> ? THEN _Index._Idx-num    = widx._Idx-num.
      IF widx._For-name   <> ? THEN _Index._For-name   = widx._For-name.
      IF widx._I-misc2[1] <> ? THEN _Index._I-misc2[1] = widx._I-misc2[1].
     
      IF NOT widx._Active 
      or (valid-object(dictLoadOptions) and dictLoadOptions:ForceIndexDeactivate) THEN 
          _Index._Active = FALSE.
     
      FOR EACH wixf:
        CREATE _Index-field.
        ASSIGN
          _Index-field._Index-recid = RECID(_Index)
          _Index-field._Field-recid = wixf._Field-recid
          _Index-field._Index-Seq   = wixf._Index-Seq
          _Index-field._Abbreviate  = wixf._Abbreviate
          _Index-field._Ascending   = wixf._Ascending
          _Index-field._Unsorted    = FALSE.
        /*_Index-field._Unsorted    = wixf._Unsorted*/
        /*   The above line will be turned on when */
        /*   we implement a gateway that needs it. */
      END.
    
      /* only delete default index if there is a non-word index also */
      IF _File._dft-pk AND _Index._Wordidx <> 1 THEN DO:
        FIND another_Index WHERE RECID(another_Index) = _File._Prime-Index NO-ERROR.
        IF AVAILABLE _Index THEN DO:
          ASSIGN
            _File._Prime-Index = RECID(_Index) /* this block will delete the */
            _File._dft-pk      = FALSE.     /* default index if there is one */
          FOR EACH _index-field OF another_Index:
            DELETE _Index-field.
          END.    
          DELETE another_Index.
        END.
      END.
      IF iprimary THEN _File._Prime-index = RECID(_Index).
    END. /*---------------------------------------------------------------------*/
    ELSE
    IF imod = "m" THEN DO: /*---------------------------------------------------*/
      if valid-object(dictLoader) and dictLoader:isReader then
      do:
          dictLoader:AddIndex(iMod,_File._file-name,buffer widx:handle,?).
          return.   
      end.
      
      IF NOT widx._Active AND _Index._Active THEN _Index._Active = FALSE.
       
      IF iprimary AND _Index._Wordidx <> 1
        AND _File._Prime-index <> RECID(_Index) THEN
        _File._Prime-index = RECID(_Index).
    
      IF widx._Desc     <> _Index._Desc     THEN _Index._Desc     = widx._Desc.
      IF widx._For-name <> _Index._For-name THEN _Index._For-name = widx._For-name.
      IF widx._For-type <> _Index._For-type THEN _Index._For-type = widx._For-type.
      IF widx._I-misc1[1] <> _Index._I-misc1[1] THEN _Index._I-misc1[1] = widx._I-misc1[1].
      IF widx._I-misc2[1] <> _Index._I-misc2[1] THEN _Index._I-misc2[1] = widx._I-misc2[1].
    END. /*---------------------------------------------------------------------*/
    ELSE
    IF imod = "r" THEN DO: /*---------------------------------------------------*/
      IF CAN-FIND(FIRST _Index OF _File WHERE _Index._Index-name = irename) THEN
        ierror = 7. /* "&2 already exists with name &3" */
      IF ierror > 0 THEN RETURN.
      if valid-object(dictLoader) and dictLoader:isReader then
      do:
          dictLoader:RenameIndex(_File._file-name,_Index._Index-name ,irename).
          return.   
      end.
      
      IF irename <> "default" THEN _Index._Index-name = irename.
    END. /*---------------------------------------------------------------------*/
    ELSE
    IF imod = "d" THEN DO: /*---------------------------------------------------*/
      FIND _Index OF _File WHERE _Index._Index-name = widx._Index-name NO-ERROR.
    
      /* if a field is deleted, then its index is deleted.  therefore, this
         index might be missing.  so don't complain if we don't find it. */
      IF NOT AVAILABLE _Index AND NOT CAN-DO(kindexcache,widx._Index-name) THEN
        ierror = 9. /* "Index already deleted" */
      IF ierror > 0 THEN RETURN.
      
      if valid-object(dictLoader) and dictLoader:isReader then
      do:
          dictLoader:AddIndex(iMod,_File._file-name,buffer widx:handle,?).
          return.   
      end.
      
      IF AVAILABLE _Index THEN DO:
        FIND _File OF _Index.
        IF RECID(_Index) = _File._Prime-Index THEN DO:
          /* move primary to another index */
          FIND FIRST another_index OF _File
            WHERE RECID(another_index) <> RECID(_Index)
            AND another_index._Wordidx <> 1 NO-ERROR.
          IF NOT AVAILABLE another_index THEN ierror = 22.
            /* "Cannot remove last non-word index" */
          IF ierror > 0 THEN RETURN.
          _File._Prime-Index = RECID(another_index).
        END.
        FOR EACH _Constraint OF _Index:
           FOR EACH con WHERE con._Index-Parent-Recid = _Constraint._Index-Recid :
              ASSIGN con._con-status = "O"
                     con._con-active = FALSE.
           END.                     
           FOR EACH _Constraint-Keys WHERE _Constraint-Keys._Con-Recid = RECID(_Constraint):
              DELETE _Constraint-Keys.
           END.  
           DELETE _Constraint.

        END.
        FOR EACH _Index-field OF _Index:
          DELETE _Index-field.
        END.
        DELETE _Index.
      END.
    
    END. /*---------------------------------------------------------------------*/

    ASSIGN gotError = NO.
END.

IF gotError THEN
   ierror = 56. /* generic error - some client error raised */

RETURN.

/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/


/* _lod_raw.i - load the value of an _Db field whose data type is RAW.

   The first element of ilin should be a comment.  After that, the
   first num bytes (from the version) of the raw value are in the ilin 
   array - one array element per byte.  Each byte is in it's 3-digit 
   ascii representation.  Handle this line and all subsequent lines for 
   this field attribute.  The value will be stored in the wdbs buffer.

   {1} field length (# of bytes to load)

   Input Parameters:
      p_Version - The version # of the collate/translate table format
      hField    - handle of the field to be updated
      p_index   - index of element if field is an array, or 0 for non-array field
      
   History:
   fernando    08/21/06 Fixing load of collation into pre-10.1A db (20060413-001)
*/

&GLOBAL-DEFINE NO_TABLES 1
{ prodict/dump/loaddefs.i }

DEFINE INPUT  PARAMETER p_Version AS CHAR    NO-UNDO.
DEFINE INPUT  PARAMETER hField   AS HANDLE  NO-UNDO.
DEFINE INPUT  PARAMETER p_index   AS INTEGER NO-UNDO.
DEFINE OUTPUT PARAMETER p_Changed AS LOGICAL NO-UNDO.

DEFINE VAR ix              AS INT NO-UNDO init 0.
DEFINE VAR jx       AS INT NO-UNDO.
DEFINE VAR byte     AS INT NO-UNDO.
DEFINE VAR num      AS INT NO-UNDO.  /* # of bytes per line */
DEFINE VAR raw_val  AS RAW NO-UNDO.
DEFINE VAR orig_val AS RAW NO-UNDO.
DEFINE VAR modify   AS LOGICAL NO-UNDO.

/* Do some rudimentary error checking on the format of the data */
IF NOT (ilin[1] BEGINS "/*") THEN DO:
   ierror = 24.
   return.
END.
jx = INTEGER(ilin[2]) NO-ERROR.
IF ERROR-STATUS:ERROR THEN DO:
   ierror = 24.
   return.
END.

/* The version # format is n.n-m where m is the # of bytes on one
   line of the .df file.
*/
num = INTEGER(SUBSTR(p_Version, INDEX(p_Version, "-") + 1)).

orig_val = hField:BUFFER-VALUE(p_index).

IF ilin[1] = ? THEN 
   hField:BUFFER-VALUE(p_index) = ?.
ELSE DO:
   IF hField:BUFFER-VALUE(p_index) = ? THEN
      /* This is the only way to replace the unknown value.
               putbyte won't do it!.
      */
      hField:BUFFER-VALUE(p_index) = raw_val.  

   IF ix < {1} THEN
       modify = YES.
   ELSE
       modify = NO.

   DO WHILE ix < {1}:
      DO jx = 1 to num:
         byte = INTEGER(ilin[jx + 1]).
         PUTBYTE(raw_val, ix + jx) = byte.
      END.
      ix = ix + num.
      IF ix < {1} THEN DO:
         IMPORT ilin.
               ipos = ipos + 1.
      END.
   END.

   IF modify THEN
      hField:BUFFER-VALUE(p_index) = raw_val.  
END.

p_Changed = (IF orig_val <> hField:BUFFER-VALUE(p_index) THEN yes ELSE no).

/*********************************************************************
* Copyright (C) 2005,2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* History:  
     
     D. McMann  03/11/99 Added _db-recid to can-find for _sequence
    K. McIntosh 06/17/04 Added subtransaction to avoid exceeding
				 max sequences 20030619-003
    K. McIntosh 09/14/04 Fixed error number for max sequences 20040910-010
    fernando    11/13/07 Check _initial value - OE00112332
*/

{ prodict/dump/loaddefs.i }
{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE scrap AS CHARACTER NO-UNDO.
define variable dictLoader as OpenEdge.DataAdmin.Binding.IDataDefinitionLoader no-undo.

/* dictLoadOptions - could have options only or be a logger/loader or reader/parser  */

if valid-object(dictLoadOptions) then
do:
    /* the code below use valid-object(dictLoader) as flag to logg data and return */
    dictLoader = dictLoadOptions:Logger.
end.

FIND FIRST wseq.
IF imod <> "a" THEN /* already proven to exist */
  FIND _Sequence
    WHERE _Sequence._Db-recid = drec_db
      AND _Sequence._Seq-name = wseq._Seq-name.

IF imod = "a" THEN crt-blk: DO ON ERROR UNDO, LEAVE: 
  
  IF CAN-FIND(_Sequence WHERE _Sequence._Db-recid = drec_db
                        AND _Sequence._Seq-name = wseq._Seq-name) THEN
  do:   
      if valid-object(dictLoader) and dictLoader:isReader then
      do:   
          /* this is not an error if parsing and the existing field is renamed */
          if dictLoader:SequenceNewName(wseq._Seq-name) = "" then
              ierror = 7. /* "&2 already exists with name &3" */
              
      end. 
      else   
          ierror = 7. /* "&2 already exists with name &3" */  
  end.
  
  if wseq._Seq-Attributes[1] = true then
  do:
      if not can-find(first _tenant) then
      do:
         /* db must be mt enabled to add mt sequence */
         iError = 72.
         RETURN.
      end.     
  end.    
   
  IF ((wseq._Seq-Incr > 0) AND (wseq._Seq-Init >= wseq._Seq-Max)) THEN
      ierror = 57.
  ELSE IF ((wseq._Seq-Incr < 0) AND (wseq._Seq-Init <= wseq._Seq-Min)) THEN
      ierror = 58.
      
  IF ierror > 0 THEN RETURN.
  
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddSequence(iMod,buffer wseq:handle).
      return.
  end.
  
  CREATE _Sequence.
  ASSIGN
    _Sequence._Db-recid = drec_db
    _Sequence._Seq-Attributes[1] = wseq._Seq-Attributes[1]
    _Sequence._Seq-Name = wseq._Seq-Name
    _Sequence._Seq-Init = wseq._Seq-Init
    _Sequence._Seq-Incr = wseq._Seq-Incr
    _Sequence._Seq-Min  = wseq._Seq-Min
    _Sequence._Seq-Max  = wseq._Seq-Max
    _Sequence._Cycle-Ok = wseq._Cycle-Ok
    _Sequence._Seq-Misc[1] = wseq._Seq-Misc[1]
    _Sequence._Seq-Misc[2] = wseq._Seq-Misc[2]
    _Sequence._Seq-Misc[3] = wseq._Seq-Misc[3]
    _Sequence._Seq-Misc[4] = wseq._Seq-Misc[4]
    _Sequence._Seq-Misc[5] = wseq._Seq-Misc[5]
    _Sequence._Seq-Misc[6] = wseq._Seq-Misc[6]
    _Sequence._Seq-Misc[7] = wseq._Seq-Misc[7]
    _Sequence._Seq-Misc[8] = wseq._Seq-Misc[8] NO-ERROR.
  
  IF ERROR-STATUS:ERROR THEN DO:
    ierror = 51.
    UNDO crt-blk, LEAVE crt-blk.
  END.
  
END. /*crt-blk*/
ELSE
IF imod = "m" THEN DO: /*---------------------------------------------------*/
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddSequence(iMod,buffer wseq:handle).
      return.
  end.
  IF _Sequence._Seq-Name <> wseq._Seq-Name THEN
    _Sequence._Seq-Name = wseq._Seq-Name.
  IF _Sequence._Seq-Init <> wseq._Seq-Init THEN
    _Sequence._Seq-Init = wseq._Seq-Init.
  IF _Sequence._Seq-Min  <> wseq._Seq-Min THEN
    _Sequence._Seq-Min  = wseq._Seq-Min.
  IF _Sequence._Seq-Max  <> wseq._Seq-Max THEN
    _Sequence._Seq-Max  = wseq._Seq-Max.
  IF _Sequence._Seq-Incr <> wseq._Seq-Incr THEN
    _Sequence._Seq-Incr = wseq._Seq-Incr.
  IF _Sequence._Cycle-Ok <> wseq._Cycle-Ok THEN
    _Sequence._Cycle-Ok = wseq._Cycle-Ok.
END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "r" THEN DO: /*---------------------------------------------------*/
  IF CAN-FIND(FIRST _Sequence WHERE _Sequence._Db-recid = drec_db
    AND _Sequence._Seq-name = irename) THEN
    ierror = 7. /* "&2 already exists with name &3" */
  IF ierror > 0 THEN RETURN.
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:RenameSequence(_Sequence._Seq-name,irename).
      return.
  end.  
  _Sequence._Seq-name = irename.
END. /*---------------------------------------------------------------------*/
ELSE
IF imod = "d" THEN DO: /*---------------------------------------------------*/
  if valid-object(dictLoader) and dictLoader:isReader then
  do:
      dictLoader:AddSequence(iMod,buffer wseq:handle).
      return.
  end.
  
  DELETE _Sequence.
END. /*---------------------------------------------------------------------*/

RETURN.

/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* loadasci */

/* History:
     D. McMann   06/05/00  Added check for return error from osquoter.p  
    fernando     06/20/07  Support for large files
*/     

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE recs   AS INT64   INITIAL 0. /*UNDO*/
DEFINE NEW SHARED VARIABLE errs   AS INTEGER           NO-UNDO.
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE fil-d  AS CHARACTER         NO-UNDO.

DEFINE VARIABLE i        AS INTEGER   NO-UNDO.
DEFINE VARIABLE reason   AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile  AS CHARACTER NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /*  1*/ "records in Delimited ASCII format loaded into",
  /*  2*/ "records in FIXED-LENGTH format loaded into",
  /*  3*/ "There was one error encountered during the translation.",
  /*  4*/ "It is listed in the error file",
  /*5,6*/ "There were", "errors encountered during the translation.",
  /*  7*/ "They are listed in the error file"
].

FORM HEADER
   " Importing.  Press " + 
   KBLABEL("STOP") + " to terminate import process. " format "x(60)" skip(0.5)
   WITH FRAME importing CENTERED ROW 5 USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
RUN "prodict/misc/osquoter.p"
  (user_env[4],user_env[3],user_env[7],tmpfile).

IF RETURN-VALUE = "error" THEN
    RETURN.
/* create and run import program */

/* user_env[1]=filename, 
   user_env[6]=fieldnames, 
   user_env[10]=disable trigger flag
*/
OUTPUT STREAM loaderr TO VALUE(user_env[1] + ".e") NO-ECHO.
INPUT FROM VALUE(tmpfile) NO-ECHO NO-MAP.
CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.

run adecomm/_setcurs.p ("WAIT").
SESSION:IMMEDIATE-DISPLAY = yes.
VIEW FRAME importing.

DO ON STOP UNDO, LEAVE:
  RUN "prodict/misc/_runload.i" (INPUT user_env[10])
      VALUE(user_env[1]) 100 100 user_env[6] 0.
END.

HIDE FRAME importing NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
INPUT CLOSE.
OUTPUT STREAM loaderr CLOSE.
run adecomm/_setcurs.p ("").

IF errs = 0 THEN DO:
  MESSAGE recs new_lang[IF user_env[3] = ? THEN 2 ELSE 1] user_env[1] 
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  OS-DELETE VALUE(user_env[1] + ".e").  
END.
ELSE
  MESSAGE recs new_lang[IF user_env[3] = ? THEN 2 ELSE 1] user_env[1] SKIP
      	  new_lang[IF errs = 1 THEN 3 ELSE 5] 
      	  (IF errs = 1 THEN "" ELSE STRING(errs) + " " + new_lang[6]) SKIP
          "***" new_lang[IF errs = 1 THEN 4 ELSE 7] user_env[1] + ".e"
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

OS-DELETE VALUE(tmpfile).
RETURN.



/*********************************************************************
* Copyright (C) 2005-2009,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _loddata.p */ /**** Data Dictionary load contents module ****/

/*
  user_env[1] = comma-delim file list
                or it may be in user_longchar, if list was too big.
  user_env[2] = load path (for >1 file) or load filename (for 1 file)
  user_env[3] = "MAP <name>" or "NO-MAP" OR ""
  user_env[4] = error percentage
  user_env[5] = comma separated list of table numbers of tables not to disable
                triggers for. We'll disable triggers for all other tables.
                May bet called by old version of load_d.p with old method:
                comma separated list of "y" (yes) or "n" (no) which
                corresponds to file list in user_env[1], indicating for each,
                whether triggers should be disabled when the dump is done.
  user_env[10] = codepage (set in _usrload.p)

history
    D. McMann   03/03/03    Added support for LOB Directory and NO-LOBS
    D. McMann   02/11/19    Turned off suppress-warinings so that if checkwidth is set to 1
                            the code can catch warnings.
    D. McMann   00/06/30    Added assignement of load_size for Oracle
    D. McMann   00/02/07    Support for oracle bulk insert
    Mario B     99/06/15    Support for -numsep -numdec parameters
    mcmann      98/07/13    Added check for DBVERSION and _Owner for V9 finds
    laurief     98/06/09    removed any remaining code that defaults to
                            message alert-boxes by using user_env[6] as a
                            flag for screen or no-screen display, which is
                            now a toggle box in the data load dialog
    hutegger    95/06/26    removed message alert-boxes and output error
                            to <file>.e instead; and "!ERROR!" displayed 
                            in line on screen
    hutegger    95/05/08    PDBNAME brings "<dbname>.db" instead of
                            "<dbname>". So we work around it.
    gfs         94/07/25    use new lodtrail.i
    gfs         94/07/21    expanded "load" message for Windows
    hutegger    94/06/27    uses codepage of trailer if user_env[10] = ""
    gfs         94/06/24    removed lodtrail.i support, codepage now set
                            in _usrload.p and is available via user_env[10]
                            (bug 94-04-28-032)
    hutegger    94/02/24    code-page support
                            new error-message, new input-statments
    kmcintos    Apr 25, 2005  Added Auditing Support
    kmcintos    May 10, 2005  Changed logic to rule out tables beginning 
                              with "_aud".  Bug # 20050510-001
    fernando    Nov 03, 2005  Added code to audit dump operation         
    fernando    Mar 14, 2006  Handle case with too many tables selected - bug 20050930-006.                         
    fernando    Sep 14, 2006  Log error messages when a stop condition was raised - 20060905-013
    fernando    Jun 20, 2007  Support for large files
    fernando    Dec 12, 2007  Improved use of user_env[5]
    fernando    Nov  4, 2008  Output number of records to .ds file
    rkamboj     Nov 15, 2011  Fixed lod directory upload issue.
*/

/* ensure that errors from directory functions are thrown   
   this also allows us to use errorHandler 
   this does not affect _runload.i whihc does not throw, bit handles all error   
*/ 
routine-level on error undo, throw.
 
using Progress.Lang.*.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* can only fit 8 digits in the recs value in the form */
&SCOPED-DEFINE MAX_RECS_FORMAT      "ZZZZZZZ9"
&SCOPED-DEFINE MAX_RECS_FORMAT_SIZE 8

DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE errs   AS INTEGER  NO-UNDO.
DEFINE NEW SHARED VARIABLE recs   AS INT64.   /*UNDO*/
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER  NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER  NO-UNDO.

DEFINE VARIABLE c          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cerror     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cerrors    AS INTEGER   INITIAL 0 NO-UNDO.
DEFINE VARIABLE codepage   AS CHARACTER           NO-UNDO init "UNDEFINED".
DEFINE VARIABLE d-ldbname  AS CHARACTER           NO-UNDO.
DEFINE VARIABLE d-was      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dsname     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE error%     AS INTEGER             NO-UNDO.
DEFINE new shared VARIABLE fil-d      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE fil-e      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE i          AS INT64               NO-UNDO.
DEFINE VARIABLE infinity   AS LOGICAL             NO-UNDO.
DEFINE VARIABLE irecs      AS INT64               NO-UNDO.
DEFINE VARIABLE crecs      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE l          AS LOGICAL             NO-UNDO.
DEFINE VARIABLE load_size  AS INT64               NO-UNDO.
DEFINE VARIABLE lvar       AS CHARACTER EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#      AS INTEGER             NO-UNDO.
DEFINE VARIABLE maptype    AS CHARACTER           NO-UNDO.
DEFINE VARIABLE mdy        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE msg        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE numformat  AS CHARACTER           NO-UNDO.
DEFINE VARIABLE terrors    AS INTEGER   INITIAL 0 NO-UNDO.
DEFINE VARIABLE addfilename     AS LOGICAL             NO-UNDO.
DEFINE VARIABLE yy         AS INTEGER             NO-UNDO.
DEFINE VARIABLE stopped    AS LOGICAL   INIT TRUE NO-UNDO.
DEFINE VARIABLE NumProcRun AS LOGICAL             NO-UNDO.
DEFINE VARIABLE lobdir     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE cTemp      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE phDbName   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE newAppCtx  AS LOGICAL   INIT NO   NO-UNDO.
DEFINE VARIABLE dis_trig   AS CHARACTER   NO-UNDO.
DEFINE VARIABLE old_dis_trig  AS LOGICAL  NO-UNDO.

DEFINE VARIABLE numCount  AS INTEGER      NO-UNDO.
DEFINE VARIABLE ix        AS INTEGER      NO-UNDO.
DEFINE VARIABLE ilast     AS INTEGER      NO-UNDO.
DEFINE VARIABLE has_lchar AS LOGICAL      NO-UNDO.
DEFINE VARIABLE has_aud   AS LOGICAL      NO-UNDO.
DEFINE VARIABLE isCpUndefined AS LOGICAL  NO-UNDO.
define variable exceptList as character no-undo.
define variable isSuperTenant as logical no-undo. 
DEFINE VARIABLE cMsg          AS CHARACTER NO-UNDO.
define variable cGroupName     as char     no-undo.
define variable cslash    as character no-undo.
define variable xUseDefault    as character no-undo init "<default>".
define variable lSuppressWarnings as logical no-undo.
define variable lImmediateDisplay  as logical no-undo.
define variable cSearchFile        as character no-undo.
define variable cFileType          as character no-undo.
define variable cFileTypeSubdir    as character no-undo.

DEFINE STREAM dsfile.

DEFINE FRAME loaddata
  DICTDB._File._File-name  COLUMN-LABEL "Table" FORMAT "x(18)" AT 2
    ATTR-SPACE SPACE(0)
  fil-d  FORMAT "x(27)"    COLUMN-LABEL "Load file"
  msg    FORMAT "x(8)"     COLUMN-LABEL "Records!Loaded"
  errs   FORMAT "ZZZZZZZ9" COLUMN-LABEL "Total  !Errors " 
    ATTR-SPACE SPACE(0)
  crecs  FORMAT "X({&MAX_RECS_FORMAT_SIZE})" COLUMN-LABEL "Expected! Records" SPACE(1)
  HEADER
    " Loading Data.   Press " +
    KBLABEL("STOP") + " to terminate the load process." format "x(66)" SKIP(1)
  WITH
  NO-ATTR-SPACE
  SCREEN-LINES - 7 DOWN ROW 1 CENTERED USE-TEXT
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D SCROLLABLE WIDTH 84 TITLE "Load Table Contents"
  &ENDIF.  /* Move this here to scope above the internal procedure */


/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 15 NO-UNDO INITIAL [
  /* 1*/ "Loading",
  /* 2*/ "Could not find load file",
  /* 3*/ "for table",
  /* 4*/ "Load of database contents completed.",
  /* 5*/ "Errors/Warnings listed in .e files placed into same directory as .d files",
  /* 6*/ "ERROR! Trailer indicated",
  /* 7*/ "records, but",
  /* 8*/ "records were loaded.",
  /* 9*/ "ERROR! -d <mdy> or -yy <n> settings of dump were",
  /*10*/ "but current settings are",
  /*11*/ "May cause load errors.",
  /*12*/ "!ERROR!",
  /*13*/ "Take a look at .ds file placed in same directory as your database.",
  /*14*/ "Expected # of records is unknown.Error % interpreted as absolute #.",
  /*15*/ "Load terminated."
].

DEFINE VARIABLE no-file AS CHARACTER FORMAT "x(32)".
 
FORM
  DICTDB._File._File-name FORMAT "x(12)" LABEL "Table"
  fil-d                   FORMAT "x(14)" LABEL "Input File"
  recs                    FORMAT "ZZZZZZZZZZZZZZZZZZ9" LABEL "# of Records Read"
  errs                                   LABEL "# of Errors"
  fil-e                   FORMAT "x(14)" LABEL "Error File"
  WITH FRAME dsfile DOWN NO-BOX NO-ATTR-SPACE USE-TEXT.


/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/*--------------------------- FUNCTIONS  --------------------------*/
function validDirectory returns logical ( cValue as char):
  
    IF cValue <> "" THEN 
    DO:
        /* not a propath search - use logic blank is default 
        - the directory is currently used as-is in output to and os-create */
        if not (cValue begins "/" or cvalue begins "~\" or index(cValue,":") <> 0) then
            cValue = "./" + cValue.  
      /*  message cValue 
        view-as alert-box.*/
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        
        return SUBSTRING(FILE-INFO:FILE-TYPE,1,1) = "D".
    END.
        
    return true.
 
end function. /* validDirectory */

function checkDirectory returns logical ( pDirname as char):
    define variable iStat as integer no-undo.
    define variable cMessage as character no-undo.
    if not validdirectory(pDirname) then
    do:
        cMessage =  new_lang[15] + " Directory " + pDirname + " does not exist.". 
        undo, throw new AppError("Directory " + pdirname + " does not exist.",?).
    end.
    return true.
end function. /* checkDirectory */

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  cSlash = "/".
&ELSE 
  cSlash = "~\".
&ENDIF

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

IF NOT isCpUndefined THEN DO:
    IF user_longchar <> "" AND user_longchar <> ? THEN
       ASSIGN has_lchar = TRUE.
    
    /* The only Audit table that can be loaded through this program is the
       _audit-event table, so we remove it from the templist and check for 
       instances of the _aud string in the table list. */
    
    IF NOT has_lchar THEN
    do:
       user_longchar = user_env[1].
       has_lchar = true.   
   end.   
END.

IF (isCpUndefined AND user_env[1] NE "" AND user_env[1] NE ?)
   OR (NOT isCpUndefined AND user_longchar NE "" AND user_longchar NE ?) THEN DO:

   ASSIGN ix = (IF isCpUndefined 
                THEN INDEX(user_env[1],",_aud")
                ELSE INDEX(user_longchar,",_aud")).

   IF user_env[9] = "e" THEN DO:

       ASSIGN iLast = (IF isCpUndefined 
                       THEN INDEX(user_env[1],"_aud-event")
                       ELSE INDEX(user_longchar,"_aud-event")).

       /* check if there is another aud table other than _aud-event */
        IF iLast NE 0 AND ix NE 0 AND ix = (iLast - 1) THEN
           ix = (IF isCpUndefined 
                 THEN INDEX(user_env[1],",_aud",ix + 1) 
                 ELSE INDEX(user_longchar,",_aud",ix + 1)).
   END.
   
   IF ix NE 0 THEN DO:
      IF NOT isCpUndefined AND NOT user_longchar BEGINS "_aud" THEN
         has_aud = TRUE.

      IF isCpUndefined AND NOT user_env[1] BEGINS "_aud" THEN
         has_aud = TRUE.
   END.
END.

/* free longchar if we don't need it */
IF NOT isCpUndefined AND NOT has_lchar THEN
   user_longchar = ?.

IF has_aud THEN DO:
   cMsg =  "Load Failed!" + "~n" +
        "You cannot load Audit Policies or Data through this utility!" .  
   if user_env[6] NE "load-silent" then
       MESSAGE cMsg
           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
   else 
          undo, throw new AppError(cMsg).       
   RETURN.
END.

/* Add the suppress warnings assignment so that when a warning is issued the code can put out into
   the .e file.  Warnings are generally suppressed throughout the dictionary but in this case we
   need to trap */
lSuppressWarnings = SESSION:SUPPRESS-WARNINGS.   
SESSION:SUPPRESS-WARNINGS = NO.
PAUSE 0.
if user_env[6] NE "load-silent" then do:
  VIEW FRAME loaddata.
  PAUSE 5 BEFORE-HIDE.
  lImmediateDisplay = SESSION:IMMEDIATE-DISPLAY.
  SESSION:IMMEDIATE-DISPLAY = yes.
  run adecomm/_setcurs.p ("WAIT").
end.

RUN "prodict/_dctyear.p" (OUTPUT mdy,OUTPUT yy).
{ prodict/dictgate.i &action=query &dbtype=user_dbtype &dbrec=? &output=c }


ASSIGN
  load_size   = INTEGER(ENTRY(4,c))
  infinity    = TRUE /* use this to mark initial entry into loop */
  addfilename = (IF has_lchar THEN INDEX(user_longchar,",") > 0 ELSE INDEX(user_env[1],",") > 0)
                or
                user_env[2] = ""
                or
                user_env[2] = "."
                or
                user_env[2] matches "*/" 
                or 
                user_env[2] matches "*~~~\"
   
  error%      = INTEGER(user_env[4])
  dsname      = (IF user_dbtype = "PROGRESS"
                THEN PDBNAME(user_dbname)
                ELSE user_dbname
              )
  cerrors     = 0 - integer(NOT addfilename).

IF index(dsname,".db") > 0
 THEN SUBSTRING(dsname,INDEX(dsname,".db"),3,"RAW") = "".

IF addfilename THEN OUTPUT STREAM dsfile TO VALUE(dsname + ".ds") NO-ECHO.

/* auditing - start a new application context so that one can report
   all the records that are loaded as a group, if one wasn't set by the
   caller.
*/
IF AUDIT-CONTROL:APPL-CONTEXT-ID = ? THEN DO:
   ASSIGN newAppCtx = YES.
   AUDIT-CONTROL:SET-APPL-CONTEXT("Data Administration", "Load Table Contents", "").
END.

ASSIGN phDbName = PDBNAME("DICTDB"). /* get the physical db name - for auditing */

IF has_lchar THEN
   numCount = NUM-ENTRIES(user_longchar).
ELSE
   numCount = NUM-ENTRIES(user_env[1]).

/* it user_env[5] has the old format, remember this */
/* this is just in case someone is using an old version of load_d.p */
IF ENTRY(1, user_env[5]) = "y" OR ENTRY(1, user_env[5]) = "n" THEN
   ASSIGN old_dis_trig = YES.

if int(dbversion("dictdb")) > 10 then
do:
   isSuperTenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
   
   /* if tenant was explicitly set by the tool then verify that it still matches
      the effective tenant also set there.
      The UI sets this and load_d.p sets this when setEffectiveTenant is used 
      It is allowed to set-effective-tenant before running loadd though (user_env[32]).
      */
   if isSuperTenant
   and user_env[32] <> ""
   and user_env[32] <> get-effective-tenant-name("dictdb") then
   do:
      cMsg = "Dump Aborted!" + "~n" +
             "The ABL get-effective-tenant-name returns" + quoter(get-effective-tenant-name("dictdb")) +
             "while the effective tenant that was last selected in the Data Administration dump dialog or utility is" + quoter(user_env[32]).
      if user_env[6] NE "load-silent" then          
          MESSAGE cMsg
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      else
          undo, throw new AppError(cMsg).
      RETURN.
   end.
end.

if addfilename then 
    checkDirectory(user_env[2]).

stoploop:
DO ON STOP UNDO, LEAVE:
  DO ix = 1 to numCount /*WHILE ENTRY(1,user_env[1]) <> ""*/ :

   ASSIGN 
       cTemp     = IF has_lchar THEN ENTRY(ix,user_longchar) ELSE ENTRY(ix,user_env[1]).
   IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
      FIND DICTDB._File WHERE DICTDB._File._File-name = cTemp
                          AND DICTDB._File._Db-recid = drec_db
                          AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
   ELSE    
      FIND DICTDB._File WHERE DICTDB._File._File-name = cTemp
                          AND DICTDB._File._Db-recid = drec_db.
        
    IF infinity THEN .
    ELSE do:
       &IF "{&WINDOW-SYSTEM}" begins "MS-WIN"
       &THEN
         /* Nothing to do */
         if user_env[6] NE "load-silent" then down 1 with Frame loaddata.
       &ELSE
          IF FRAME-LINE(loaddata) = FRAME-DOWN(loaddata) THEN
             UP FRAME-LINE(loaddata) - 1 WITH FRAME loaddata.
          ELSE DOWN 1 WITH FRAME loaddata.
       &ENDIF
    END.
 
    ASSIGN
      infinity = FALSE
      recs     = 0
      irecs    = ?
      crecs    = STRING(irecs,{&MAX_RECS_FORMAT})
      d-was    = ?
      exceptList = ""
      maptype  = ""
      cFileType = ""
      cFileTypesubdir = "". 
  
    
    /* if mt table   */ 
    if user_env[32] > "" 
    and (issupertenant or user_env[33] = xUseDefault) 
    and int(dbversion("dictdb")) > 10 
    and dictdb._file._file-attributes[1] 
    and addfilename then
    do:  
        fil-d = "".
        cgroupName = "".
        if user_env[37] > "" then 
            run GetGroupName(user_env[32],dictdb._file._file-number,OUTPUT cgroupname).
        
        if cgroupName > "" then
        do:
            /* use default then [37] is a subdir name to append to root */
            if user_env[33] = xUseDefault then
            do:
                if index(user_env[2],"/") > 0 then
                    cSlash = "/". 
                fil-d = (IF user_env[2] EQ "" OR user_env[2] EQ "." 
                         THEN ""
                         ELSE RIGHT-TRIM(user_env[2],cSlash) + cSlash) 
                       +  user_env[37].
                 /* check if the groups directory exists */        
                 checkDirectory(fil-d).
                 fil-d = fil-d         
                       + cSlash
                       + cGroupName 
                       + cSlash.
                 /* check if the group name directory exists */        
                 checkDirectory(fil-d).
            end.
            else do:
                if index(user_env[37],"/") > 0 then
                    cSlash = "/". 
                /* add group name to groupdir */
                fil-d = (IF user_env[37] EQ "." THEN ""
                         ELSE RIGHT-TRIM(user_env[37],cSlash) + cSlash)
                      + cgroupName 
                      + cSlash. 
            end.
            /* deal with lob dir */
            if user_env[33] = xUseDefault then
            do:
                if user_env[40] > "" then
                do:
                    lobdir = user_env[40].
                    /* check if group name lob directory if exists */    
                    checkDirectory(fil-d + lobdir). 
              end.
                else 
                    lobdir = "".
            end.
            /** somewhat questionable -
                use tenant lob dir to check 
                currently no var for group lob dir 
                unless usedefault */
            else if user_env[34] > "" then 
                lobdir = "lobs".  
            else
                lobdir = "".
             
            /* monitor params - call startTable after search */  
            assign    
               cFileType = "group"
               cFileTypeSubdir = cgroupName.
        end. /* cgroupName */
        else do: /* no group = tenant dump */   
            /* if use default use dir named from tenant create if necessary */ 
            if user_env[33] = xUseDefault then
            do:
                if index(user_env[2],"/") > 0 then
                    cSlash = "/". 
                fil-d = (IF user_env[2] EQ "" OR user_env[2] EQ "." 
                         THEN ""
                         ELSE RIGHT-TRIM(user_env[2],cSlash) + cSlash) 
                      +  user_env[32] + cslash. 
                /* check if tenant directory exists */    
                checkDirectory(fil-d).
            end. 
            else do:   
                if index(user_env[33],"/") > 0 then
                    cSlash = "/". 
                 
                fil-d = (IF user_env[33] EQ "" OR user_env[33] EQ "." THEN ""
                         ELSE RIGHT-TRIM(user_env[33],cSlash) + cSlash).
            end.
            
            /* deal with lob dir */
            if user_env[33] = xUseDefault then
            do:
                if user_env[40] > "" then
                do:
                    lobdir = user_env[40].
                    /* check if tenant lob directory exists */    
                    checkDirectory(fil-d + lobdir).
                end.
                else 
                    lobdir = "".
            end.
            else if user_env[34] > "" THEN
                lobdir = user_env[34].
            ELSE
                lobdir = "".
        
            /* monitor params - call startTable after search */  
            assign    
               cFileType = "tenant"
               cFileTypeSubdir = user_env[32].
        end.
        if addfilename then
            fil-d = fil-d             
                  + ( IF DICTDB._File._Dump-name = ?
                      THEN DICTDB._File._File-name
                      ELSE DICTDB._File._Dump-name
                  ) + ".d".    
    end.
    else do: 
        if index(user_env[2],"/") > 0 then
            cSlash = "/". 
        /* don't add file yet as we need the path to 
               add lob directory */    
        if addfilename then
            fil-d = (IF user_env[2] EQ "" OR user_env[2] EQ "." 
                     THEN ""
                     ELSE RIGHT-TRIM(user_env[2],cSlash) + cSlash). 
        else
            fil-d = user_env[2].

        if user_env[33] = xUseDefault then
        do:
            if user_env[40] > "" then
            do:
                if not addfilename then
                do:
                    /* this should not happen.. 
                    _usrload passes root-only also for single table 
                    in this case, but it is conceivable that 
                    we could get here with some combination of dump_d params  */
                    undo, throw new apperror("Cannot load lobs using default location if directory is specified with file-name").
                end.    
                lobdir = user_env[40].
                /* check if lob directory exists */      
                checkDirectory(fil-d + lobdir). 
            end.
            else 
                lobdir = "".
        end.
        else if user_env[30] > "" then 
            lobdir = user_env[30].
        else 
            lobdir = "".  
            
        if addfilename then
            fil-d = fil-d 
                + (IF DICTDB._File._Dump-name = ?
                   THEN DICTDB._File._File-name
                   ELSE DICTDB._File._Dump-name) 
                + ".d".
    
       cfileType = "shared".  
    end.
    
    cSearchFile = SEARCH(fil-d). 
    IF cSearchFile <> ? THEN fil-d = cSearchFile.
    
    if valid-object(dictMonitor) then
        dictMonitor:StartTable(dictdb._file._file-name,cFileType,cFileTypeSubdir,fil-d).          
         
    fil-e = SUBSTRING(fil-d,1,LENGTH(fil-d,"character") - 1,"character") + "e".

    if user_env[6] NE "load-silent" then 
    do:
      DISPLAY DICTDB._File._File-name fil-d new_lang[1] @ msg
        WITH FRAME loaddata. /* loading */
      COLOR DISPLAY MESSAGES DICTDB._File._File-name fil-d msg errs crecs
        WITH FRAME loaddata.
    end.
      
    IF cSearchFile  <> ? THEN 
    DO:    
        {prodict/dump/lodtrail.i
        &file    = "fil-d"
        &entries = "IF lvar[i] BEGINS ""records=""
                      THEN irecs     = INT64(SUBSTRING(lvar[i],9,-1,""character"")).
                    IF lvar[i] BEGINS ""ldbname=""    
                      THEN d-ldbname = SUBSTRING(lvar[i],9,-1,""character"").
                    IF lvar[i] BEGINS ""dateformat=""
                      THEN d-was     = SUBSTRING(lvar[i],12,-1,""character"").
                    IF lvar[i] BEGINS ""numformat=""
                      THEN numformat = SUBSTRING(lvar[i],11,-1,""character"").
                    IF lvar[i] BEGINS ""map=""       
                      THEN maptype   = SUBSTRING(lvar[i],5,-1,""character"").
                   "
        }
    END.
    ELSE DO:
         ASSIGN no-file = (IF DICTDB._File._Dump-name <> ? 
                            THEN DICTDB._File._Dump-name + ".d" ELSE fil-d).
    
         if user_env[6] NE "load-silent" then 
             DISPLAY new_lang[12] @ msg WITH FRAME loaddata. /* !ERROR! */
         OUTPUT STREAM loaderr TO VALUE(fil-e) NO-ECHO APPEND. 
         PUT STREAM loaderr
            "The file " no-file "can not be found." SKIP.
         OUTPUT STREAM loaderr CLOSE.
         
         if valid-object(dictMonitor) then      
             dictMonitor:AddTableError(fil-d,"The file can not be found.").          
             
         ASSIGN terrors = terrors + 1.
    
         next. /* skip that file */
    END.
    /**  the monitor reads the trail 
    if valid-object(dictMonitor) then      
        dictMonitor:SetTableExpectedNumRows(fil-d,irecs).          
       **/  
    /* if we can't fit the value in the format, display asterisks */
    crecs = STRING(irecs,{&MAX_RECS_FORMAT}) NO-ERROR.
    IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
       crecs = "**********".

    if user_env[6] NE "load-silent" then DISPLAY crecs WITH FRAME loaddata.
   
    /* check if number of records is unknown or known */
    IF irecs = ? AND (error% > 0 AND error% < 100) THEN 
    DO:
        if user_env[6] NE "load-silent" then 
            DISPLAY new_lang[14] @ msg WITH FRAME loaddata. /* !Warning! */
        OUTPUT STREAM loaderr TO VALUE(fil-e) NO-ECHO APPEND. 
        PUT STREAM loaderr
              "Expected # of records is unknown."        SKIP
                    "Error percentage will be interpreted"     SKIP   
                    "as an absolute number of errors."         SKIP.
        OUTPUT STREAM loaderr CLOSE.
        ASSIGN terrors = terrors + 1.
    END.
           
    IF cerror = ? THEN
    DO:  /* conversion needed but NOT possible */
         
       IF user_env[6] = "f" or user_env[6] = "load-silent" THEN 
          OUTPUT STREAM loaderr TO fil-e NO-ECHO.
        
       if user_env[6] NE "load-silent" then    
          COLOR DISPLAY NORMAL DICTDB._File._File-name fil-d msg errs crecs
            WITH FRAME loaddata.
       
       DISPLAY DICTDB._File._File-name fil-d new_lang[12] @ msg crecs
            WITH FRAME loaddata. /* ERROR! */
        
       IF user_env[6] = "f" or user_env[6] = "load-silent" THEN 
          OUTPUT STREAM loaderr CLOSE.
       
       IF addfilename THEN 
       DO:
           if user_env[6] NE "load-silent" then do:
               DISPLAY STREAM dsfile
                   DICTDB._File._File-name fil-d recs errs 
                   "Conversion-error" @ fil-e
               WITH FRAME dsfile.
               DOWN STREAM dsfile WITH FRAME dsfile.
           end.  
       END.
       
       /* error-count */
       assign cerrors = cerrors + 1.
       
        /* skip this file */
       NEXT.

    END.     /* conversion needed but NOT possible */

    ELSE DO:  /* conversion not needed OR needed and possible */
      IF cerror = "no-convert" then do:
        IF maptype BEGINS "MAP:" THEN DO:
          IF lobdir = ""  THEN
            INPUT FROM VALUE(fil-d) NO-ECHO 
               MAP VALUE(SUBSTRING(maptype,5,-1,"character"))
               NO-CONVERT.
          ELSE
            INPUT FROM VALUE(fil-d) LOB-DIR VALUE(lobdir) NO-ECHO 
               MAP VALUE(SUBSTRING(maptype,5,-1,"character"))
               NO-CONVERT.
        END.
        ELSE DO: 
          IF lobdir = "" THEN
            INPUT FROM VALUE(fil-d) NO-ECHO NO-MAP NO-CONVERT.
          ELSE
            INPUT FROM VALUE(fil-d) LOB-DIR VALUE(lobdir)  
              NO-ECHO NO-MAP NO-CONVERT.
        END.
      end.
      else do:
        IF maptype BEGINS "MAP:" THEN DO:
          IF lobdir = "" THEN
            INPUT FROM VALUE(fil-d) NO-ECHO
               MAP VALUE(SUBSTRING(maptype,5,-1,"character"))
               CONVERT SOURCE codepage TARGET SESSION:CHARSET.
          ELSE
            INPUT FROM VALUE(fil-d) LOB-DIR VALUE(lobdir) NO-ECHO
               MAP VALUE(SUBSTRING(maptype,5,-1,"character"))
               CONVERT SOURCE codepage TARGET SESSION:CHARSET.
        END.
        ELSE DO: 
          IF lobdir = "" THEN
            INPUT FROM VALUE(fil-d) NO-ECHO 
              NO-MAP CONVERT SOURCE codepage TARGET SESSION:CHARSET.
          ELSE
            INPUT FROM VALUE(fil-d) LOB-DIR VALUE(lobdir) NO-ECHO 
              NO-MAP CONVERT SOURCE codepage TARGET SESSION:CHARSET.
        END.
      end.
    END.     /* conversion not needed OR needed and possible */

    /* check for numeric format (-E set or not) and error out if wrong */
    IF numformat <> "" THEN
    DO:
       IF LENGTH(numformat) = 1 THEN
       DO:
          IF index(string(1.5,"9.9"),numformat) = 0 THEN
          DO:  /* sesion-format and .d-format don't match */
             RUN NumFormatErr IN THIS-PROCEDURE (INPUT "EparmErr").
             ASSIGN terrors = terrors + 1.
                    NumProcRun = NO.
             if valid-object(dictMonitor) then      
                dictMonitor:AddTableError(fil-d,"Numeric Format error").          
 
             NEXT.   /* skip this file */
          END.    /* sesion-format and .d-format don't match */
       END. /* Above deals with the old format, below handles the new */ 
       ELSE
       DO:  /* Test for existence of 2 numeric values, or at least something *
             * translatable to numerics. */
             
          ASSIGN i = INTEGER(ENTRY(1,numformat)) + INTEGER(ENTRY(2,numformat))
             NO-ERROR.
          IF ERROR-STATUS:ERROR THEN
          DO: 
             RUN NumFormatErr IN THIS-PROCEDURE (INPUT "FmtErr").
             ASSIGN terrors = terrors + 1.
             NumProcRun = NO.
             
             if valid-object(dictMonitor) then      
                 dictMonitor:AddTableError(fil-d,"Numeric Format error").          
             
             NEXT.
          END.
          IF INTEGER(ENTRY(1,numformat)) + INTEGER(ENTRY(2,numformat)) < 3 THEN
          DO:  /* 0 is not allowed, and the characters must be different. */
             RUN NumFormatErr IN THIS-PROCEDURE (INPUT "FmtErr").
             ASSIGN terrors = terrors + 1.
             NumProcRun = NO.
             if valid-object(dictMonitor) then      
                 dictMonitor:AddTableError(fil-d,"Numeric Format error").          
             NEXT.
          END.
          IF CHR(INT(ENTRY(1,numformat)),SESSION:CPINTERNAL,codepage) <>
          SESSION:NUMERIC-SEPARATOR THEN
          DO:
             RUN NumFormatErr IN THIS-PROCEDURE (INPUT "SepErr").
             ASSIGN terrors = terrors + 1.
          END.
          IF CHR(INT(ENTRY(2,numformat)),SESSION:CPINTERNAL,codepage) <>
          SESSION:NUMERIC-DECIMAL-POINT THEN
          DO:
             RUN NumFormatErr IN THIS-PROCEDURE (INPUT "DecErr").
             ASSIGN terrors = terrors + 1.
          END.
          IF NumProcRun THEN
          DO:
             NumProcRun = NO.
             if valid-object(dictMonitor) then      
                 dictMonitor:AddTableError(fil-d,"Numeric Format error").          
             NEXT.
          END.
       END.
    END.
    
    if dictdb._file._file-name = "_user" then
    do:
        exceptList = "EXCEPT _Tenantid".  
    end.    
    else if dictdb._file._file-name = "_sec-authentication-domain" then
    do:
        exceptList = "EXCEPT _Domain-id".  
    end.    
    
    ASSIGN
      c    = DICTDB._File._File-name
      &IF "{&WINDOW-SYSTEM}" begins "MS-WIN"
      &THEN
          .
      &ELSE
        xpos = FRAME-COL(loaddata) + 49
        ypos = FRAME-ROW(loaddata) + FRAME-LINE(loaddata) + 5.
      &ENDIF
    CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.
    OUTPUT STREAM loaderr TO VALUE(fil-e) NO-ECHO.
     
    IF SEEK(INPUT) = ? THEN DO:
      PUT STREAM loaderr UNFORMATTED 
        new_lang[2] ' "' fil-d '" ' new_lang[3] ' "' c '".'.
      errs = 1.
    END.
    ELSE DO:

      /* check if we can disable triggers. List now contains just the
        table numbers for tables that we should not disable triggers for.
      */
      ASSIGN dis_trig = ENTRY(1, user_env[5]).

      IF NOT old_dis_trig THEN DO:
         IF dis_trig NE "" AND dis_trig = STRING(_File._File-number) THEN
            dis_trig = "n".
         ELSE
            dis_trig = "y".
      END.
      IF caps(user_env[35]) = "ORA" THEN DO:
         IF irecs <> ? THEN
           ASSIGN load_size = irecs.  
         ELSE DO:
           cMsg = "The .d file does not contain the number of records to be loaded" + "~n" +
                  "You must use the reqular Administration Load Table Contents Utility."  + "~n".
           if user_env[6] NE "load-silent" then         
             MESSAGE cMsg
               VIEW-AS ALERT-BOX ERROR.
           else
               undo, throw new AppError(cMsg).   
           ASSIGN user_path = "".
           RETURN.
         END.
         RUN "prodict/ora/_runload.i" (INPUT dis_trig)
                                    c 
                                    error%
                                    load_size 
                                    c 
                                    (IF irecs = ? THEN 100 else irecs).
      END.
      ELSE
 
        RUN "prodict/misc/_runload.i" (INPUT dis_trig)
                                    c 
                                    error%
                                    load_size 
                                    c 
                                    (IF irecs = ? THEN 100 else irecs)
                                     user_env[31]
                                     exceptList.
       
      IF RETURN-VALUE = "stopped" THEN 
          UNDO stoploop, LEAVE stoploop.
      
      /* move on to the next one in the list */
      IF old_dis_trig OR (dis_trig = "n") THEN
         user_env[5] = SUBSTRING(user_env[5]
                                 ,LENGTH(ENTRY(1,user_env[5]),"character") + 2
                                 ,-1
                                 ,"character"
                                 ).
  
      IF irecs = ? THEN 
      _irecs: 
      DO: /*----------- for reading damaged trailer */
        /* this code is used when a trailer might be present, but not in its
           proper relative offset from the start of the file.  this can happen
           if the file is edited or damaged, changing its length. */
        i = SEEK(INPUT).
        READKEY PAUSE 0. IF LASTKEY <> ASC("P") THEN LEAVE _irecs.
        READKEY PAUSE 0. IF LASTKEY <> ASC("S") THEN LEAVE _irecs.
        READKEY PAUSE 0. IF LASTKEY <> ASC("C") THEN LEAVE _irecs.
        SEEK INPUT TO i. /* just to get eol right */
        REPEAT WHILE irecs = ?:
          IMPORT c.
          IF c BEGINS "records=" THEN irecs = INT64(SUBSTRING(c,9,-1,"character")).
        END.
      END. /*---------------------------------- end of damaged trailer reader */
  
      INPUT CLOSE.
    END.
    
    IF irecs <> ? AND irecs <> recs THEN 
    DO:
        ASSIGN errs = errs + 1.
        /* ERROR! Trailer indicated <n> records, but only <n> records loaded. */
        PUT STREAM loaderr UNFORMATTED 
              ">> " new_lang[6] " " irecs " " new_lang[7] " " recs " " 
              new_lang[8] SKIP.
        if valid-object(dictMonitor) then  
            dictMonitor:AddTableError(fil-d,
              new_lang[6] + " " + string(irecs) + " " + new_lang[7] + " " + string(recs) + " " 
              + new_lang[8]).          
   
    END.
    IF d-was <> ? AND d-was <> mdy + STRING(- yy) THEN 
    DO:
        ASSIGN errs = errs + 1.
        /* ERROR! -d <mdy> or -yy <n> settings of dump were <mdy>-<nnnn> */
        /* but current settings are <mdy>-<nnnn>. */
        PUT STREAM loaderr UNFORMATTED
            ">> " new_lang[9] " " d-was SKIP
            "** " new_lang[10] " " mdy STRING(- yy) ".  " new_lang[11] SKIP.
        
        if valid-object(dictMonitor) then  
           dictMonitor:AddTableError(fil-d,
              new_lang[9] 
              + " " + d-was + "~n** "
              + new_lang[10] + " " +  mdy + " " + STRING(- yy) + ".  "
              + new_lang[11]).          
   
    
    END.
    
    OUTPUT STREAM loaderr CLOSE.
    
    if valid-object(dictMonitor) then      
        dictMonitor:EndTable(fil-d,int64(recs)).          
      
    IF errs = 0 THEN OS-DELETE VALUE(fil-e).
       
    /* if value can't fit into format, display asterisks */
    crecs = STRING(irecs,{&MAX_RECS_FORMAT}) NO-ERROR.
    IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
        crecs = "**********".

    if user_env[6] NE "load-silent" then 
    do:
      COLOR DISPLAY NORMAL DICTDB._File._File-name fil-d msg errs crecs
        WITH FRAME loaddata.

      DISPLAY
      DICTDB._File._File-name fil-d errs crecs WITH FRAME loaddata.
    end.  

    /* if the value is too big to be displayed, display asterisks */
    ASSIGN msg = STRING(recs,"ZZZZZZZ9") NO-ERROR.
    IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN
       msg = "********".

    if user_env[6] NE "load-silent" then 
    do:
        DISPLAY msg WITH FRAME loaddata NO-ERROR.

        IF addfilename THEN 
        DO:
            DISPLAY STREAM dsfile
                DICTDB._File._File-name fil-d recs errs
                (IF errs = 0 THEN "-" ELSE fil-e) @ fil-e
            WITH FRAME dsfile.
            DOWN STREAM dsfile WITH FRAME dsfile.
        end.  
    END.
    
    terrors = terrors + errs.
  
    IF recs > 0 THEN DO:
        /* audit the data loaded, even if an error happended, if at least one record was loaded */
        AUDIT-CONTROL:LOG-AUDIT-EVENT(10214, 
                                      phDbName + "." +  DICTDB._File._File-name /* db-name.table-name */, 
                                      "" /* detail */).
    END.

  END. /* do num count  */

  stopped = false.
   
END. /* end stop */

/* 20060905-013
   If a stop condition was raised, log the error messages to the .e file 
*/
IF STOPPED THEN DO:
    IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
    DO i = 1 TO  ERROR-STATUS:NUM-MESSAGES:
            PUT STREAM loaderr UNFORMATTED
              ">> ERROR READING LINE #" recs + 1
              " " ERROR-STATUS:GET-MESSAGE(i) SKIP.
    END.
END.

IF addfilename THEN 
     OUTPUT STREAM dsfile CLOSE.

&IF "{&WINDOW-SYSTEM}" begins "MS-WIN"
&THEN
   /* Nothing to Do */
&ELSE 

if user_env[6] NE "load-silent" then 
DO WHILE FRAME-LINE(loaddata) < FRAME-DOWN(loaddata):
     DOWN 1 WITH FRAME loaddata.
     CLEAR FRAME loaddata NO-PAUSE.
END.

&ENDIF

run adecomm/_setcurs.p ("").

/* for auditing - clear the application context, if we have set one */
IF newAppCtx THEN
   AUDIT-CONTROL:CLEAR-APPL-CONTEXT.
 
IF stopped THEN 
do:
    if user_env[6] NE "load-silent" then 
        MESSAGE new_lang[15]
                 VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    else do:
        undo, throw new AppError(new_lang[15]).   
    end.   
end.                
ELSE DO:
    if valid-object (dictMonitor) then
    do:
        IF cerrors > 0 THEN 
        do:
            dictMonitor:AnyError = true.
            dictMonitor:ErrorMessage = new_lang[13].
        end.
        ELSE IF terrors > 0 THEN
        do:     
            dictMonitor:AnyError = true.
            dictMonitor:ErrorMessage = new_lang[5].
        end.
    end. 
    
    if user_env[6] NE "load-silent" then
    do:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
        /* Don't use alert box in TTY because it obscures status report
           and you can't move it out of the away.
        */
        HIDE MESSAGE NO-PAUSE.
        
        IF      cerrors > 0 THEN MESSAGE new_lang[4] skip new_lang[13]. 
        ELSE IF terrors > 0 THEN MESSAGE new_lang[4] skip new_lang[5]. 
        ELSE                     MESSAGE new_lang[4]. 
        pause.
      &ELSE
        IF cerrors > 0 THEN 
            MESSAGE new_lang[4] skip new_lang[13] VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
        ELSE IF terrors > 0 THEN  
            MESSAGE new_lang[4] skip new_lang[5]  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
        ELSE 
            MESSAGE new_lang[4]                   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      &ENDIF
    end.  
END.

RETURN.

/* catch message for silent load, but keep old behavior for unhandled messages and just show the message. */
catch e as Progress.Lang.Error :
    run handleError(e).
end catch.

finally:
    /* Make sure to set back the suppress warnings again */
    SESSION:SUPPRESS-WARNINGS = lSuppressWarnings.
    
    IF NOT isCpUndefined THEN
       ASSIGN user_longchar = "".
    
    if user_env[6] NE "load-silent" then 
    do:
        HIDE MESSAGE NO-PAUSE.
        HIDE FRAME loaddata NO-PAUSE.
        SESSION:IMMEDIATE-DISPLAY = lImmediateDisplay.
    end.
end finally.

/*-------------------------- Internal Procedures -------------------------------------------------------*/
procedure handleError:
    define input parameter pError as Progress.Lang.Error no-undo.
    define variable i as integer no-undo.
    define variable cMsg as character no-undo.
    
    if pError:NumMessages = 0 and type-of(pError,AppError)then 
        cmsg = cast(perror,AppError):ReturnValue.
    else  
    do i = 1 to pError:NumMessages:
        cmsg = cmsg + pError:GetMessage(i) + "~n".
    end.  
    
    if user_env[6] NE "dump-silent" then
        message cmsg
            view-as alert-box error.      
    else do:
        undo, throw new AppError(cmsg).
    end.
end.

/*----- Output the error messages for invalid numeric formats -----*/
PROCEDURE NumFormatErr:

     /* Logical Variable NumProcRun is external in order to scope to .p  */
     DEF INPUT PARAM ErrType AS CHAR NO-UNDO.

     OUTPUT STREAM loaderr TO VALUE(fil-e) NO-ECHO APPEND.

     IF NOT NumProcRun THEN
     DO:
        NumProcRun = NOT NumProcRun.
        if user_env[6] NE "load-silent" then 
          DISPLAY new_lang[12] @ msg WITH FRAME loaddata. /* !ERROR! */           
        PUT STREAM loaderr UNFORMATTED
            "The numeric formats of this {&PRO_DISPLAY_NAME}-session"   SKIP
            "and the .d-file don't match!"                   SKIP   
            "Please exit {&PRO_DISPLAY_NAME} and start a new session"   SKIP.
     END.

     /* What type of error do we want to output this time through? */
     /* One or both of the following could be wrong.               */
     CASE ErrType:
     WHEN "EparmErr" THEN
     DO:
        PUT STREAM loaderr UNFORMATTED
           (IF numformat = "." THEN "without " ELSE "with " ) + 
            "the -E startup parameter, or set the"                 SKIP   
            "-numsep parameter to " +
            (IF numformat = "." THEN "44 " ELSE "46 ") + "and -numdec to " +
            (IF numformat = "." THEN "46." ELSE "44.") SKIP.    
     END.
     WHEN "SepErr" THEN
     DO:
        PUT STREAM loaderr UNFORMATTED
           "with the -numsep startup parameter set to " 
           ASC(CHR(INT(ENTRY(1,numformat)),SESSION:CPINTERNAL,codepage)) SKIP.
     END.
     WHEN "DecErr" THEN
     DO:
        PUT STREAM loaderr UNFORMATTED
           "with the -numdec startup parameter set to " 
           ASC(CHR(INT(ENTRY(2,numformat)),SESSION:CPINTERNAL,codepage)) SKIP.
     END.
     WHEN "FmtErr" THEN
     DO:
        PUT STREAM loaderr UNFORMATTED
          "with the -numdec and -numsep parameters set to valid values."  SKIP
          "The current value of " + numformat + " is not valid."
          SKIP.
     END.
     WHEN "BlnkErr" THEN
     DO:
        PUT STREAM loaderr UNFORMATTED
          "with valid values in the ~"numformat=~" section of the .d trailer."
          SKIP.
     END.
     END CASE.
     
     OUTPUT STREAM loaderr CLOSE.  

END PROCEDURE.

 
procedure GetGroupName  :
    define input parameter pcTenant as character no-undo. 
    define input parameter piFileNumber as int no-undo. 
    define output parameter pcName as character no-undo. 
      
    find dictdb._tenant where dictdb._tenant._tenant-name = user_env[32] no-lock.   
             
    find dictdb._Partition-Set-Detail 
               where dictdb._Partition-Set-Detail._object-type = 1         
                 and dictdb._Partition-Set-Detail._object-number = piFileNumber        
                 and dictdb._Partition-Set-Detail._Tenantid = dictdb._tenant._tenantid 
                 no-lock no-error.
    if avail dictdb._Partition-Set-Detail then 
    do: 
        find dictdb._Partition-Set 
           where dictdb._Partition-Set._object-type = dictdb._Partition-Set-Detail._object-type        
             and dictdb._Partition-Set._object-number = dictdb._Partition-Set-Detail._object-number
             and dictdb._Partition-Set._PSetId = dictdb._Partition-Set-Detail._PSetId
             and dictdb._Partition-Set._PSet-Type = 1 no-lock.
          pcname = dictdb._Partition-Set._Pset-name.
    end.
end procedure.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* loaddbff 

  fernando   06/20/07  Support for large files
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE recs   AS INT64   INITIAL 0. /*UNDO*/
DEFINE NEW SHARED VARIABLE errs   AS INTEGER           NO-UNDO.
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE fil-d  AS CHARACTER         NO-UNDO.

DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
DEFINE VARIABLE reason    AS CHARACTER NO-UNDO.
DEFINE VARIABLE answer    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE tmpfile_e AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile_d AS CHARACTER NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 8 NO-UNDO INITIAL [
  /*  1*/ "Data Conversion Complete", /* DO NOT CHANGE - output from 'dbf' */
  /*  2*/ "records in DBF format loaded into",
  /*  3*/ "There was one error encountered during the translation.",
  /*  4*/ "It is listed in the error file",
  /*5,6*/ "There were", "errors encountered during the translation.",
  /*  7*/ "They are listed in the error file",
  /*  8*/ "Do you want to continue?"
].
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


RUN "adecomm/_tmpfile.p" (INPUT "e", INPUT ".adm", OUTPUT tmpfile_e).
RUN "adecomm/_tmpfile.p" (INPUT "d", INPUT ".adm", OUTPUT tmpfile_d).
RUN "prodict/misc/osdbfutl.p"
  ("1",user_env[3],user_env[4],tmpfile_e,tmpfile_d).

INPUT FROM VALUE(tmpfile_e) NO-ECHO.
REPEAT:
  IMPORT reason.
  IF reason = "" OR reason = new_lang[1] THEN NEXT.
  answer = no.
  MESSAGE reason SKIP new_lang[8] 
    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
  IF answer = no THEN DO:
    HIDE MESSAGE NO-PAUSE.
    user_path = "".
    RETURN.
  END.
END.
INPUT CLOSE.

/* create and run import program */

/* user_env[1]=filename, user_env[6]=fieldnames */
run adecomm/_setcurs.p ("WAIT").
OUTPUT STREAM loaderr TO VALUE(user_env[1] + ".e") NO-ECHO.
INPUT FROM VALUE(tmpfile_d) NO-ECHO NO-MAP.
CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.

DO ON STOP UNDO, LEAVE:
   RUN "prodict/misc/_runload.i" (INPUT "n")
      VALUE(user_env[1]) 100 100 user_env[6] 0.
END.

INPUT CLOSE.
OUTPUT STREAM loaderr CLOSE.
run adecomm/_setcurs.p ("").

IF errs = 0 THEN DO:
  MESSAGE recs new_lang[2] user_env[1] /* records loaded */
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  OS-DELETE VALUE(user_env[1] + ".e").  /* delete temp external files */
END.
ELSE
  MESSAGE recs new_lang[2] user_env[1] SKIP
      	  new_lang[IF errs = 1 THEN 3 ELSE 5] 
      	  (IF errs = 1 THEN "" ELSE STRING(errs) + " " + new_lang[6]) SKIP
          "***" new_lang[IF errs = 1 THEN 4 ELSE 7] user_env[1] + ".e"
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

OS-DELETE VALUE(tmpfile_e) VALUE(tmpfile_d).
RETURN.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* loaddiff 

  fernando   06/20/07  Support for large files
*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* fields for dif interpretation */
DEFINE VARIABLE holdline  AS CHARACTER FORMAT "x(80)" NO-UNDO.
DEFINE VARIABLE holdline2 AS CHARACTER FORMAT "x(80)" NO-UNDO.
DEFINE VARIABLE numfields AS INTEGER   INITIAL      0 NO-UNDO.
DEFINE VARIABLE numvalue  AS DECIMAL   DECIMALS    10 NO-UNDO.
DEFINE VARIABLE reccount  AS INT64     INITIAL      0 NO-UNDO.

/* fields for dif load */
DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE recs   AS INT64   INITIAL 0. /*UNDO*/
DEFINE NEW SHARED VARIABLE fil-d  AS CHARACTER NO-UNDO. /*UNDO*/
DEFINE NEW SHARED VARIABLE errs   AS INTEGER           NO-UNDO.
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER INITIAL ? NO-UNDO.

DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
DEFINE VARIABLE reason    AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile_i AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmpfile_o AS CHARACTER NO-UNDO.
DEFINE STREAM a.
DEFINE STREAM b.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /*  1*/ "File Not In Standard DIF Format",
  /*  2*/ "records in DIF format loaded into",
  /*  3*/ "There was one error encountered during the translation.",
  /*  4*/ "It is listed in the error file",
  /*5,6*/ "There were", "errors encountered during the translation.",
  /*  7*/ "They are listed in the error file"
].

DEFINE VARIABLE err_lang AS CHARACTER EXTENT 14 NO-UNDO INITIAL [
  /* 1*/ "First record is not TABLE",
  /* 2*/ "Second record is not 0,1",
  /* 3*/ "4th record is not VECTORS",
  /* 4*/ "5th record doesn't start with 0,",
  /* 5*/ "7th record is not TUPLES",
  /* 6*/ "8th record doesn't start with 0,",
  /* 7*/ "Incorrect DATA-header, 0,0 is missing",
  /* 8*/ "First DATA-record is not -1,0",
  /* 9*/ "Second DATA-record is not BOT (Beginning Of Tuple)",
  /*10*/ "A type-indicator of a data-value is -1 (reserved for BOT,EOD)",
  /*11*/ "String-value for numeric data is not V NA ERROR TRUE or FALSE",
  /*12*/ "Wrong combination of type indicator and value",
  /*13*/ "Second last record is not -1,0",
  /*14*/ "Last record is not EOD"
].

FORM HEADER
   " Importing.  Press " +
   KBLABEL("STOP") + " to terminate import process. " format "x(60)" skip (0.5)
   WITH FRAME importing CENTERED ROW 5 USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

PROCEDURE un_scientific. /* convert scientific notation to PROGRESS decimal */

  DEFINE INPUT  PARAMETER holdline AS CHARACTER NO-UNDO.
  DEFINE OUTPUT PARAMETER numvalue AS DECIMAL   NO-UNDO.

  DEFINE VARIABLE decpart AS CHARACTER NO-UNDO. /* will hold decimal portion */
  DEFINE VARIABLE epos    AS INTEGER   NO-UNDO. /* the POS of 'E' in holdline */
  DEFINE VARIABLE exppart AS INTEGER   NO-UNDO. /* exponent part of number */
  DEFINE VARIABLE negsign AS LOGICAL   NO-UNDO.

  ASSIGN
    negsign  = SUBSTRING(holdline,1,1,"character") = "-"
    holdline = SUBSTRING(holdline,IF negsign THEN 2 ELSE 1,-1,"character")
    epos     = INDEX(holdline,"E").

  IF epos = 0 THEN
    decpart = holdline.
  ELSE DO:
    ASSIGN
      decpart = SUBSTRING(holdline,1,epos - 1,"character")
      exppart = INTEGER(SUBSTRING(holdline,epos + 1,-1,"character")).
    IF exppart < -10 THEN DO: /* Exponent too small for decimal datatype */
      numvalue = 0.
      RETURN.
    END.
    IF exppart > 49 THEN DO: /* Exponent too large for decimal datatype */
      numvalue = ?.
      RETURN.
    END.
    ASSIGN
      decpart = FILL("0",10) + SUBSTRING(decpart,1,1,"character") +
                SUBSTRING(decpart,3,-1,"character") + FILL("0",50)
      decpart = SUBSTRING(decpart,1,11 + exppart,"character") + "."
              + SUBSTRING(decpart,12 + exppart,-1,"character").
  END.
  numvalue = DECIMAL(decpart).
  IF negsign THEN numvalue = - numvalue.

END PROCEDURE.

/*---------------------------  MAIN-CODE  --------------------------*/

/* user_env[4]=filename.dif */
RUN "adecomm/_tmpfile.p" (INPUT "i", INPUT ".adm", OUTPUT tmpfile_i).
RUN "adecomm/_tmpfile.p" (INPUT "o", INPUT ".adm", OUTPUT tmpfile_o).
RUN "prodict/misc/osquoter.p" (user_env[4],?,?,tmpfile_i).
reason = "".

run adecomm/_setcurs.p ("WAIT").

_outer:
DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE: /* start reading the data */
/* check for required entries */

  INPUT  STREAM b FROM VALUE(tmpfile_i) NO-ECHO NO-MAP.
  OUTPUT STREAM a TO VALUE(tmpfile_o) NO-ECHO NO-MAP.

  IMPORT STREAM b holdline.
  IF holdline <> "TABLE" THEN DO:
    reason = err_lang[1]. /* First record is not TABLE */
    LEAVE _outer.
  END.

  IMPORT STREAM b holdline.
  IF holdline <> "0,1" THEN DO:
    reason = err_lang[2]. /* Second record is not 0,1 */
    LEAVE _outer.
  END.

  IMPORT STREAM b ^.  /* read comment-record */
  IMPORT STREAM b holdline.
  IF holdline <> "VECTORS" THEN DO:
    reason = err_lang[3]. /* 4th record is not VECTORS */
    LEAVE _outer.
  END.

  IMPORT STREAM b holdline.
  IF NOT holdline BEGINS "0," THEN DO:
    reason = err_lang[4]. /* 5th record doesn't start with 0, */
    LEAVE _outer.
  END.
  numfields = INTEGER(SUBSTRING(holdline,3,78,"character")). /* read num of fields */

  IMPORT STREAM b holdline. /* get rid of blank comment line */
  IMPORT STREAM b holdline.
  IF holdline <> "TUPLES" THEN DO:
    reason = err_lang[5]. /* 7th record is not TUPLES */
    LEAVE _outer.
  END.

  IMPORT STREAM b holdline.
  IF NOT holdline BEGINS "0," THEN DO:
    reason = err_lang[6]. /* 8th record doesn't start with 0, */
    LEAVE _outer.
  END.
  reccount = INT64(SUBSTRING(holdline,3,78,"character")). /* read number of records */

  IMPORT STREAM b holdline. /* get rid of blank comment line */
  DO WHILE TRUE:
    IMPORT STREAM b holdline.
    IF holdline <> "DATA" THEN DO: /* if any of the optional header items */
      IMPORT STREAM b ^.
      IMPORT STREAM b ^. /* getting rid of the next two comment lines */
    END. /* if */
    ELSE
      LEAVE. /* time to read the data */
  END. /* do while true */

  IMPORT STREAM b holdline.
  IF holdline <> "0,0" THEN DO:
    reason = err_lang[7]. /* Incorrect DATA-header, 0,0 is missing */
    LEAVE _outer.
  END.

  IMPORT STREAM b holdline. /* get rid of the "" line */

  /* read the data and then subsequently write it out. */
  DO WHILE recs < reccount:
    IMPORT STREAM b holdline.
    IF holdline <> "-1,0"  THEN DO:
      reason = err_lang[8]. /* First DATA-record is not -1,0 */
      LEAVE _outer.
    END.

    recs = recs + 1. /* increase record counter */
    IMPORT STREAM b holdline.
    IF holdline <> "BOT" THEN DO:
      reason = err_lang[9]. /* Second DATA-record is not BOT */
      LEAVE _outer.
    END.

    PAUSE 0 BEFORE-HIDE.
    DO i = 1 TO numfields:
      IMPORT STREAM b holdline.
      IF holdline BEGINS "-1" THEN DO:
        reason = err_lang[10]. /* A type-indicator of a data-value is -1 */
        LEAVE _outer.
      END.

      IF holdline BEGINS "0," THEN DO:
        holdline = SUBSTRING(holdline,3,78,"character").
        IMPORT STREAM b holdline2.
        IF holdline2 = "V" THEN DO:           /* Value */
          /* function to convert scientific notation to PROGRESS decimal */
          RUN un_scientific (INPUT holdline,OUTPUT numvalue).
          PUT STREAM a UNFORMATTED numvalue " ".
        END. /* if "v" */
        ELSE IF holdline2 = "NA"    THEN PUT STREAM a UNFORMATTED ?.
        ELSE IF holdline2 = "ERROR" THEN PUT STREAM a UNFORMATTED 0.
        ELSE IF holdline2 = "TRUE"  THEN PUT STREAM a UNFORMATTED "yes".
        ELSE IF holdline2 = "FALSE" THEN PUT STREAM a UNFORMATTED "no".
        ELSE DO:
          reason = err_lang[11]. /* Value isn't V NA ERROR TRUE FALSE */
          LEAVE _outer.
        END.
      END. /* if case "0" */
      ELSE IF holdline = "1,0" THEN DO:
        IMPORT STREAM b holdline.
        IF holdline = "~"~"" THEN PUT STREAM a UNFORMATTED "- ".
        ELSE PUT STREAM a UNFORMATTED holdline SPACE.
      END. /* if case "1" */
      ELSE DO:
        reason = err_lang[12]. /* Wrong combo of type indicator and value */
        LEAVE _outer.
      END.
    END. /* do numfields */
    PUT STREAM a UNFORMATTED SKIP.
  END. /* do while recs */

  IF reason = "" THEN DO:
    IMPORT STREAM b holdline.
    IF holdline <> "-1,0" THEN DO:
      reason = err_lang[13]. /* Second last record is not -1,0 */
      LEAVE _outer.
    END.
    IMPORT STREAM b holdline.
    IF holdline <> "EOD" THEN DO:
      reason = err_lang[14]. /* Last record is not EOD */
      LEAVE _outer.
    END.
  END.
END.  /* end outer */


INPUT  STREAM b CLOSE.
OUTPUT STREAM a CLOSE.

IF reason <> "" THEN DO:
  run adecomm/_setcurs.p ("").
  MESSAGE new_lang[1] SKIP /* File Not In Standard DIF Format */
      	  reason  
      	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
END.
ELSE DO:
  /* create and run import program */

  /* user_env[1]=filename, 
     user_env[6]=fieldnames, 
     user_env[10]=disable trigger flag
  */
  OUTPUT STREAM loaderr TO VALUE(user_env[1] + ".e") NO-ECHO.
  INPUT FROM VALUE(tmpfile_o) NO-ECHO NO-MAP.
  CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.

  SESSION:IMMEDIATE-DISPLAY = yes.
  VIEW FRAME importing.
  recs = 0. 
  DO ON STOP UNDO, LEAVE:
    RUN "prodict/misc/_runload.i" (INPUT user_env[10])
        VALUE(user_env[1]) 100 100 user_env[6] 0.
  END.
  HIDE FRAME importing NO-PAUSE.
  SESSION:IMMEDIATE-DISPLAY = no.
  INPUT CLOSE.
  OUTPUT STREAM loaderr CLOSE.
  run adecomm/_setcurs.p ("").

  IF errs = 0 THEN DO:
    MESSAGE recs new_lang[2] user_env[1] /* records loaded */
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    OS-DELETE VALUE(user_env[1] + ".e").  /* delete temporary external files */
  END.
  ELSE 
    MESSAGE recs new_lang[2] user_env[1] SKIP
      	    new_lang[IF errs = 1 THEN 3 ELSE 5] 
      	    (IF errs = 1 THEN "" ELSE STRING(errs) + " " + new_lang[6]) SKIP
      	    "***" new_lang[IF errs = 1 THEN 4 ELSE 7] user_env[1] + ".e"
            VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
END.

OS-DELETE VALUE(tmpfile_i) VALUE(tmpfile_o).
RETURN.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _lodfini.p - finish up .df load process */

{ prodict/dump/loaddefs.i }
{ prodict/dictvar.i }

DEFINE VARIABLE i AS INTEGER NO-UNDO.

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
  FIND FIRST _File WHERE _File._Dump-name = ?
                     AND NOT _File._File-name BEGINS "_" 
                     AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
ELSE
  FIND FIRST _File WHERE _File._Dump-name = ?
                     AND NOT _File._File-name BEGINS "_".
                                          
IF AVAILABLE _File THEN DO TRANSACTION:
  HIDE MESSAGE NO-PAUSE.
  IF TERMINAL <> "" AND CURRENT-WINDOW:MESSAGE-AREA = yes THEN
     MESSAGE "Assigning Dump-names".
  RUN "prodict/dump/_lodname.p".
END.

IF dblangcache <> "" THEN DO TRANSACTION:
  HIDE MESSAGE NO-PAUSE.
  IF TERMINAL <> "" AND CURRENT-WINDOW:MESSAGE-AREA = yes THEN
     MESSAGE "Marking SQL tables".
  DO i = 1 TO NUM-ENTRIES(dblangcache):
    FIND _File WHERE RECID(_File) = INTEGER(ENTRY(i,dblangcache)) NO-ERROR.
    IF AVAILABLE _File AND _File._Db-lang = 0 THEN _File._Db-lang = 1.
  END.
END.

IF frozencache <> "" THEN DO TRANSACTION:
  HIDE MESSAGE NO-PAUSE.
  IF TERMINAL <> "" AND CURRENT-WINDOW:MESSAGE-AREA = yes THEN
     MESSAGE "Marking FROZEN tables".
  DO i = 1 TO NUM-ENTRIES(frozencache):
    FIND _File WHERE RECID(_File) = INTEGER(ENTRY(i,frozencache)) NO-ERROR.
    IF AVAILABLE _File AND NOT _File._Frozen THEN _File._Frozen = TRUE.
  END.
END.

HIDE MESSAGE NO-PAUSE.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _lodname.p - assigns unique dump-names to file w/o them
 
 History:  _Db recid was not being used in finds added drec_db vairable
           which is used thoughout the dictionary.  D. McMann  05/26/00
 */

DEFINE VARIABLE nam  AS CHARACTER NO-UNDO.
DEFINE VARIABLE pass AS INTEGER   NO-UNDO.

DEFINE SHARED VARIABLE drec_db AS RECID  NO-UNDO.

/* when pulling oracle schema we could have two db's with the same
 * table-name (distributed dbs...). We result in one table named
 * <name> and the other named <name>-1. To make sure, their dump-names
 * are corresponding, we first try to assing the dump-names to the
 * tables with _fil-misc2[8] = ? (:= local-db). In the second-step we
 * assign dump-names to all the rest (:= distributed db's when ORACLE,
 * or do-never-loop for non-oracle-db's)
 */
 

FOR EACH _File
  WHERE   _Dump-name    =    ?
    AND  _db-recid = drec_db
  AND NOT _File-name  BEGINS "_"
  AND     _Fil-misc2[8] =    ?:
    
    IF INTEGER(DBVERSION("DICTDB")) > 8 
      AND(_File._Owner<> "PUB" AND _File._Owner <>"_FOREIGN") THEN NEXT.
      
    assign nam = _File-name.
    {prodict/dump/dumpname.i}
    assign _Dump-name = nam.

END.

FOR EACH _File
  WHERE   _Dump-name    =    ?
    AND _db-recid = drec_db
  AND NOT _File-name  BEGINS "_"
  BY      _Fil-misc2[8]:

    IF INTEGER(DBVERSION("DICTDB")) > 8 
      AND (_File._Owner<> "PUB" AND _File._Owner <>"_FOREIGN") THEN NEXT.
      
    assign nam = _File-name.
    {prodict/dump/dumpname.i}
    assign _Dump-name = nam.

END.

RETURN.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* loadsdbf - translate dbase .dbf and .ndx into .df file */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* The file to display - if this is ? then use sho_pages. */
DEFINE VARIABLE sho_file  AS CHARACTER INITIAL ?   NO-UNDO.

/* Data to display - 1 line per array element */
DEFINE VARIABLE sho_pages AS CHARACTER EXTENT 1024 NO-UNDO. 

/* The number of lines to display (only used with sho_pages) */
DEFINE VARIABLE sho_limit AS INTEGER               NO-UNDO.

/* The title for the frame */
DEFINE VARIABLE sho_title AS CHARACTER             NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 8 NO-UNDO INITIAL [
  /*  1*/ "",
  /*  2*/ "Could not find DBF Utility with current path.",
  /*  3*/ "Could not find file",
  /*  4*/ "Could not find index",
  /*  5*/ "These are the messages from the <dbf> utility.",
  /*  6*/ "To load the definitions, press OK, otherwise Cancel",
  /*  7*/ "Converting",
  /*  8*/ "<dbf> Utility Messages"
].
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*
user_env[1] = dbf file name
user_env[2] = nuxi mode? (y/n)
user_env[4..13] = ndx file name(s)

dbf utility params:
Usage: dbf <dbfmode> <nuximode> <args...>
  dbfmode =  1 (produce .d file)
          =  2 (produce old V5 format .df file (table info))
          =  3 (produce old V5 format .df file (index info))
          = -2 (produce new V6 format .df file (table info))
          = -3 (produce new V6 format .df file (index info))
  nuximode = 0 .dbf file created by 680x0 (lsb, msb format)
           = 1 .dbf file created by 80x86 (msb, lsb format)
  args... =
    if dbfmode = 1: filename.dbf filename.err >filename.d
               = 2: filename.dbf filename.err >filename.df
               = 3: filename.dbf filename.ndx filename.err >filename.df
*/

DEFINE VARIABLE c      AS CHARACTER NO-UNDO.
DEFINE VARIABLE dbffil AS CHARACTER NO-UNDO.
DEFINE VARIABLE dbfutl AS CHARACTER NO-UNDO.
DEFINE VARIABLE errmsg AS CHARACTER NO-UNDO.
DEFINE VARIABLE i      AS INTEGER   NO-UNDO.
DEFINE VARIABLE nuxi   AS CHARACTER NO-UNDO.

ASSIGN
  dbfutl = SEARCH(IF OPSYS = "UNIX"  THEN "dbf"
           ELSE   IF CAN-DO("MSDOS,WIN32",OPSYS) THEN "dbf.exe"
           ELSE   ?)
  errmsg = ?
  dbffil = SEARCH(user_env[1])
  nuxi   = STRING(user_env[2] = "y","1/0").

IF dbfutl = ? THEN errmsg = new_lang[2].
ELSE IF dbffil = ? THEN errmsg = new_lang[3] + ' "' + user_env[1] + '"'.

IF errmsg <> ? THEN DO:
  MESSAGE errmsg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

run adecomm/_setcurs.p ("WAIT").

OUTPUT TO "_dict.err" NO-ECHO.
PUT UNFORMATTED '"' new_lang[7] ' <' dbffil '>"' SKIP. /* converting... */
OUTPUT CLOSE.
c = "-2 " + nuxi + " " + dbffil + " _dict.tmp >_dict.ddl".
IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DOS  SILENT VALUE(dbfutl) VALUE(c).
ELSE IF OPSYS = "UNIX"  THEN UNIX SILENT VALUE(dbfutl) VALUE(c).
RUN "prodict/misc/osappend.p" ("_dict.tmp","_dict.err").
OS-DELETE "_dict.tmp".

DO i = 4 TO 13:
  IF user_env[i] = "" OR user_env[i] = ? THEN NEXT.
  IF SEARCH(user_env[i]) = ? THEN DO:
    OUTPUT TO "_dict.err" APPEND.
    PUT UNFORMATTED new_lang[4] '"' user_env[i] '"' SKIP. /* ndx not found */
    OUTPUT CLOSE.
    NEXT.
  END.

  c = "-3 " + nuxi + " " + dbffil + " " + SEARCH(user_env[i])
    + " _dict.tmp >>_dict.ddl".
  IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DOS  SILENT VALUE(dbfutl) VALUE(c).
  ELSE IF OPSYS = "UNIX"  THEN UNIX SILENT VALUE(dbfutl) VALUE(c).

  OUTPUT TO "_dict.err" NO-ECHO APPEND.
  PUT UNFORMATTED SKIP(1)
    '"' new_lang[7] ' <' SEARCH(user_env[i]) '>"' SKIP. /* converting... */
  OUTPUT CLOSE.
  RUN "prodict/misc/osappend.p" ("_dict.tmp","_dict.err").
  OS-DELETE "_dict.tmp".
END.

run adecomm/_setcurs.p ("").

ASSIGN
  sho_file = "_dict.err"
  sho_title = new_lang[8]
  user_env[5] = ""
  user_env[6] = new_lang[5]  /* dbf messages */
  user_env[7] = new_lang[6]. /* ok/cancel instructions */
RUN "prodict/user/_usershw.p" 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
   (INPUT 0).
   &ELSE
   /* help contexts are only defined for gui */
   (INPUT {&Import_dBase_Definition_Results_Dlg_Box}).
   &ENDIF

IF RETURN-VALUE = "ok" THEN DO:
  ASSIGN
    user_env[2] = "_dict.ddl"
    user_env[8] = user_dbname.
  RUN "prodict/dump/_lodsddl.p".
END.

OS-DELETE "_dict.err" "_dict.ddl".

RETURN.
/*********************************************************************
* Copyright (C) 2006-2011,2014 by Progress Software Corporation. All *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
**********************F***********************************************/
/*------------------------------------------------------------------------
    File        : _lodsddl
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   :  
    Created     :  
    Notes       : The shared var dictLoader class is used to parse without UI (no save) 
                  or save without any UI.
                   -   The existance (valid-object) of this is used to suppress all 
                       display or messages. 
                   -   The assumption is that user-env[6] = "f" also is set to avoid 
                        all messages. "b" or "s" would cause error messages to be shown. 
                        this is not tested   
                   -   The dictLoader:IsReader signals parsing (read-only) 
                       NOTE: This is currently only for display purposes 
                             and only table, field, index and sequence (MT tool)
                             Other tables like triggers, index-fields is not passed to 
                             the loader. 
                                 
 history
   D. McMann   04/11/01 Added warning for SQL Table Updates ISSUE 310
   D. McMann   02/24/03 Added LOB Support
   D. McMann   09/22/03 Added check for object names not being keywords 20030618-015
   D. McMann   09/22/03 Added check for Progress df trying to be loaded into a foreign
                        data source. 20030815-039
   D. McMann   09/29/03 Added check for invalid data type 20030925-014
   S. Watt &
   K. McIntosh 05/13/04 Added support for loading collation tables for UTF-8
   F. Souza    07/09/04 Added data type abbreviations 20040430-023
   K. McIntosh 09/17/04 Increased number of elements of the error_text array to 60 
                  and moved Max Sequences message to 51. 20030619-003
   K. McIntosh 09/17/04 Backed out fix for bug number 20040910-010
   fernando    03/16/06 Handle case where error message was not displayed becasue
                        the block was not retried - 20060316-011
   fernando    05/25/06 Added support for large sequences
   fernando    08/21/06 Fixing load of collation into pre-10.1A db (20060413-001)
   moloney     09/22/06 Set initial value for TIME & TIMESTAMP columns mapped to CHARCTER and load w/out an initial value
   fernando    10/02/07 Error handling - OE00158774
   fernando    11/13/07 Check _initial value for sequences - OE00112332
   gih         11/27/07 Fix load of ICU rules - OE00129463
   fernando    07/18/08 Encryption support
   fernando    11/24/08 Handle clob field changes - OE00177533
   fernando    03/20/09 More enryption support
   fernando    04/13/09 Alternate buffer pool support
   hdaniels    03/26/10 throw AppError that wraps STOP errors, use CATCH 
                        in transaction and show error(s) in showLoadError 
   hdaniels    2010     use dictLoader class to parse without UI (no save) or 
                        save without any UI. 
   kmayur      06/21/11 Added logic for loading constraint OE00195067  
   rkamboj     09/23/11 Update _File-Attributes[2] = true if table is Multitenant.
   rkamboj     09/30/11 Added logic for loading category field.
*/

{ prodict/dump/loaddefs.i NEW }
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prohelp/msgs.i}
&IF DEFINED(SKP)
&THEN
  /* Don't do anything.  It's DEFINEd already */
&ELSE
   &SCOPED-DEFINE SKP SKIP
&ENDIF

DEFINE NEW SHARED TEMP-TABLE s_ttb_fake-cp
    FIELD   db-name     AS CHARACTER
    FIELD   db-recid    AS RECID.
 
DEFINE VARIABLE error_text AS CHARACTER EXTENT 76 NO-UNDO.
ASSIGN
  error_text[ 1] = "Unknown action":t72
  error_text[ 2] = "Unknown object":t72
  error_text[ 3] = "Try to modify unknown &2":t72
  error_text[ 4] = "Unknown &2 keyword":t72
  error_text[ 5] = "Try to modify &2 without table":t72
  error_text[ 6] = "Cannot change dbtype":t72
  error_text[ 7] = "&2 already exists with name &3":t72
  error_text[ 8] = "Field being deleted is part of primary index":t72
  error_text[ 9] = "Index already deleted":t72
  error_text[10] = "Cannot change datatype of existing field":t72
  error_text[11] = "Cannot change extent of existing field":t72
  error_text[12] = "Cannot add index field to existing index":t72
  error_text[13] = "Cannot find field to index":t72
  error_text[14] = "Cannot alter field from frozen table":t72
  error_text[15] = "Use SQL ALTER TABLE to change field":t72
  error_text[16] = "Cannot &1 frozen table &3":t72
  error_text[17] = "Use SQL DROP TABLE to remove &3":t72
  error_text[18] = "Cannot rename SQL table":t72
  error_text[19] = "VIEW exists with name &3":t72
  error_text[20] = "Cannot &1 &2 referenced in SQL view":t72
  error_text[21] = "Cannot delete database with tables":t72
  error_text[22] = "Cannot remove last non-word index":t72
  error_text[23] = "Invalid table attribute":t72
  error_text[24] = "Invalid collate/translate table format":t72
  error_text[25] = "Invalid PROGRESS-recid column":t72
  error_text[26] = "Invalid Shadow column":t72
  error_text[27] = "Incompatible translation table version - Load will be terminated":t72
  error_text[28] = "Load will be terminated":t72
  error_text[29] = "Load unsuccessful - backing out":t72
  error_text[30] = "Table-type mismatch. Current database-type is &1":t72 /* ^F: [30] */
                  /*....+....1....+....2....+....3....+....4....+....5....+....6....+....7..*/
  error_text[31] = "AREA NAME either not found in database or not type d (data).":t72
  error_text[32] = "CODEPAGE-NAME in the .df file is different from the db's current":t72
  error_text[33] = "codepage. To change the latter use the AdminTool for DataServers":t72
  error_text[34] = "or PROUTIL for {&PRO_DISPLAY_NAME}. This .df file can't be loaded.":t72
  error_text[40] = "Errors occurred loading collation rules. Verify that definition":t72
  error_text[41] = "file is not corrupted.":t72
  error_text[43] = "Field-position and file-size don't match. File-size is too small.":t72
  error_text[44] = "Please use Dictionary to set the codepage for this database.":t72
  error_text[45] = "{&PRO_DISPLAY_NAME} keywords can not be object names.":t72
  error_text[46] = "CLOB data type must have CODEPAGE and COLLATION defined.":t72
  error_text[47] = "Unknown data type in field definition. ":t72
  error_text[50] = "" /* DO NOT USE.  If ierror is 50, then it's a warning */
  error_text[51] = "Maximum number of sequences has been reached.":t72
  error_text[52] = "Invalid Initial value":t25
  error_text[53] = "Value is too large":t25
  error_text[54] = "Invalid character in the Dump Name":t35
  error_text[55] = "Neither BLOB nor CLOB fields may have extents":t46
  error_text[56] = "Client error raised while loading definitions":t46
  error_text[57] = "The upper limit must be greater than the initial value":t54
  error_text[58] = "The lower limit must be less than the initial value":t51
  error_text[59] = "Invalid foreign data type for field":t35
  error_text[60] = "Invalid keyword for a non-OpenEdge database":t44
  error_text[61] = "" /* don't use - for encryption */
  error_text[62] = "Invalid keyword for this field type.":t36
  error_text[63] = "Cannot change object encryption policy until encrypted data has been updated":t76
  error_text[64] = "Invalid cipher name.":t20
  error_text[65] = "Missing or invalid settings for ENCRYPTION or CIPHER-NAME.":t58
  error_text[66] = "Cannot change codepage or collation of existing column":t54
  error_text[67] = "Missing or invalid settings for BUFFER-POOL.":t50
  error_text[68] = "Definitions for policies and attributes are loaded in a separate transaction.":t77
  error_text[69] = " Errors caused that transaction to rollback. Other definitions were committed.":t78
  error_text[70] = "" /* don't use - for buffer-pool */
  error_text[71] = "Cannot force shared schema with no area and keep default area false.":t68
                   /* used for both table and sequence */
  error_text[72] = "Database must be multi-tenant enabled to create a multi-tenant object":t71.
  error_text[73] = "Constraint Expression Missing for DEFAULT/CHECK Constraints":t58.
  error_text[74] = "All Colums of the Index Should me mandatory for Primary Constraint":t70.
  error_text[75] = "Primary Index for Table &2 already exist":t68.
  error_text[76] = "Primary Index not available for foreign key":t50.

&SCOPED-DEFINE WARN_MSG_SQLW 48

DEFINE VARIABLE warn_text AS CHARACTER EXTENT 50 NO-UNDO.
ASSIGN
  warn_text[23] = "Can't change Can-read or write, Mandatory, or Decimals of field in SQL table." 
  warn_text[24] = "Can't change case-sensitivity of ""&1""  because it is part of an index.":t72
  warn_text[25] = "Can't change Decimals of field ""&1"". Field type is not DECIMAL.":t72
  warn_text[26] = "Ignoring encryption setting which matches the current policy.":t68
  
  /* these three lines need to go together, so if you need to add new warnings, add them here, 
     and adjust the numbers below. Then change WARN_MSG_SQLW to point to the next warning ID */
  warn_text[48] = "SQL client cannot access fields having widths greater than 31995.  ":t72
  warn_text[49] = "The width of the field ""&1"" in the .df file is &2.  ":t72
  warn_text[50] = "Use the data dictionary Adjust Width Utility to correct width.":t72
  /* DON'T ADD MESSAGES HERE. See comment below */
.

/* This is going to be used to store the warning message after calling substitute so we don't
   change the warn_text variable */
DEFINE VARIABLE warn_message AS CHARACTER.

DEFINE NEW SHARED STREAM loaderr.

DEFINE VARIABLE dbload-e      AS CHARACTER           NO-UNDO.
DEFINE VARIABLE hdr           AS INTEGER INIT 0      NO-UNDO.

DEFINE VARIABLE scrap         AS CHARACTER           NO-UNDO.

DEFINE VARIABLE cerror        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE codepage      AS CHARACTER           NO-UNDO INIT "UNDEFINED".
DEFINE VARIABLE i             AS INTEGER             NO-UNDO.
DEFINE VARIABLE j             AS INTEGER             NO-UNDO.
DEFINE VARIABLE w             AS INTEGER             NO-UNDO.
DEFINE VARIABLE k             AS INTEGER             NO-UNDO.
DEFINE VARIABLE iobj          AS CHARACTER           NO-UNDO. /* d,t,f,i */
DEFINE VARIABLE inot          AS LOGICAL             NO-UNDO.
DEFINE VARIABLE inum          AS INTEGER             NO-UNDO.
DEFINE VARIABLE l_fld-stlen   AS INTEGER             NO-UNDO. /* foreign dbs... */
DEFINE VARIABLE l_fld-stoff   AS INTEGER             NO-UNDO. /* foreign dbs... */
DEFINE VARIABLE lvar          AS CHARACTER EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#         AS INTEGER             NO-UNDO.
DEFINE VARIABLE stopped       AS LOGICAL             NO-UNDO INIT TRUE.
DEFINE VARIABLE sav_dbnam     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE sav_dbtyp     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE sav_err       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE sav_drec      AS RECID               NO-UNDO.
DEFINE VARIABLE xerror        AS LOGICAL             NO-UNDO. /* any error during process? */
DEFINE VARIABLE xwarn         AS LOGICAL             NO-UNDO. /* any warnings during process? */
DEFINE VARIABLE do-commit     AS LOGICAL             NO-UNDO.
DEFINE VARIABLE parent-table  AS CHARACTER           NO-UNDO.

/* collate/translate information */
DEFINE VARIABLE ct_version    AS CHARACTER           NO-UNDO.                /* version # */
DEFINE VARIABLE ct_changed    AS LOGICAL             NO-UNDO INIT no.  /* tables modified? */
DEFINE VARIABLE ix            AS INTEGER             NO-UNDO. /* for parsing version # */
DEFINE VARIABLE len           AS INTEGER             NO-UNDO. /* ditto */
DEFINE VARIABLE raw_val       AS RAW                 NO-UNDO.
DEFINE VARIABLE orig_vers     AS RAW                 NO-UNDO.
DEFINE VARIABLE rules         AS LONGCHAR            NO-UNDO.

DEFINE variable minimum-index AS INTEGER initial 0.
DEFINE variable new-number    AS INTEGER initial 0.
DEFINE VARIABLE hBuffer       AS HANDLE              NO-UNDO.

/* messages for frames working2 and backout. */
DEFINE VARIABLE msg1          AS CHARACTER           NO-UNDO FORMAT "x(53)":u.
DEFINE VARIABLE msg2noalert   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE msg2          AS CHARACTER           NO-UNDO FORMAT "x(56)":u.
DEFINE VARIABLE msg3          AS CHARACTER           NO-UNDO FORMAT "x(12)":u.
DEFINE VARIABLE msg4          AS CHARACTER           NO-UNDO FORMAT "x(16)":u.
DEFINE VARIABLE msg5          AS CHARACTER           NO-UNDO FORMAT "x(40)":u.
DEFINE VARIABLE skipEPolicy   AS LOGICAL             NO-UNDO.
DEFINE VARIABLE encryptOpts   AS LOGICAL             NO-UNDO EXTENT 2.
DEFINE VARIABLE skipObjAttrs  AS LOGICAL             NO-UNDO.
DEFINE VARIABLE hasEncPol     AS LOGICAL             NO-UNDO.
DEFINE VARIABLE hasBufPool    AS LOGICAL             NO-UNDO.
DEFINE VARIABLE showedCommitMsg AS LOGICAL            NO-UNDO.
DEFINE VARIABLE got-error     AS LOGICAL            NO-UNDO.
DEFINE VARIABLE main_trans_success  AS LOGICAL            /*UNDO*/.
/*DEFINE VARIABLE okay          AS LOGICAL            NO-UNDO.*/

define variable oAppError    as Progress.Lang.AppError no-undo. 
define variable cStopMessage as character no-undo.
define variable cNewFile     as character no-undo.
define variable cRenamed  as character no-undo.
define variable dictLoader as OpenEdge.DataAdmin.Binding.IDataDefinitionLoader no-undo.

msg1="Phase 1 of Load completed.  Working.  Please wait ...".
msg2noalert = "Error occured during load.".
msg2= msg2noalert + "  Press OK to back out transaction.".
msg3="Please check".
msg4="for load errors and/or warnings.".

FORM
  wdbs._Db-name    LABEL "Database" COLON 11 FORMAT "x(32)":u SKIP
  wfil._File-name  LABEL "Table"    COLON 11 FORMAT "x(32)":u SKIP
  wfld._Field-name LABEL "Field"    COLON 11 FORMAT "x(32)":u SKIP
  widx._Index-name LABEL "Index"    COLON 11 FORMAT "x(32)":u SKIP
  wseq._Seq-Name   LABEL "Sequence" COLON 11 FORMAT "x(32)":u SKIP
  wcon._Con-Name   LABEL "Constraint" COLON 11 FORMAT "x(32)":u SKIP
  HEADER 
    " Loading Definitions.  Press " +
    KBLABEL("STOP") + " to terminate load process." FORMAT "x(70)" 
  WITH FRAME working 
  ROW 4 CENTERED USE-TEXT SIDE-LABELS ATTR-SPACE &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D TITLE "Load Data Definitions" &ENDIF.

FORM
  msg1 VIEW-AS TEXT NO-LABELS WITH FRAME working2 CENTERED USE-TEXT. 

FORM
  msg2 VIEW-AS TEXT NO-LABELS WITH FRAME backout CENTERED USE-TEXT.

FORM
 msg3 dbload-e msg4 VIEW-AS TEXT NO-LABELS WITH FRAME errorlog CENTERED USE-TEXT.

FORM
 msg5 VIEW-AS TEXT NO-LABELS WITH FRAME encryptlog ROW 7 CENTERED USE-TEXT.

/*=======================Internal Procedures===========================*/


PROCEDURE Put_Header:

 DEFINE INPUT        PARAMETER efile_nam AS CHARACTER  NO-UNDO.
 DEFINE INPUT-OUTPUT PARAMETER hdr_cnt   AS INTEGER    NO-UNDO.
 IF hdr_cnt = 0 THEN DO:
   IF user_env[6] = "f" OR user_env[6] = "b" THEN DO:
     OUTPUT STREAM loaderr TO VALUE(efile_nam) APPEND.
     PUT STREAM loaderr UNFORMATTED SKIP(2)
     "The following errors and/or warnings occurred while loading " user_env[2] SKIP
     "into database " LDBNAME("DICTDB") " on " TODAY " at " STRING(TIME,"HH:MM")
 "." SKIP(1).
     hdr_cnt = 1.
     OUTPUT STREAM loaderr CLOSE.
   END.
 END.

END. /* PROCEDURE Put_Header */

/*-----------------------------------------------------
   Show an error.  IF p_cmd = "prev" it means the
   error occurred when flushing data for the previous
   command and we no longer have the error command
   in ilin.  IF p_cmd = "curr", it means ilin still
   contains the command which caused the error.
   imod and iobj however, always pertain to the 
   error command.
------------------------------------------------------*/
PROCEDURE Show_Error:
  DEFINE INPUT PARAMETER p_cmd AS CHAR NO-UNDO.
   
 
  DEFINE VAR msg AS CHAR    NO-UNDO INIT "".
  DEFINE VAR ix  AS INTEGER NO-UNDO.

  IF ierror = 50 THEN DO:
    RUN Show_Warning (INPUT p_cmd).
    RETURN.
  END.
  
  IF imod = "sp":u THEN
      scrap = "load of file". /* special case for enryption / buffer-pool */
  ELSE
  scrap = (IF imod = "cp":u THEN "ADD/MODIFY":u
      ELSE IF imod = "a":u  THEN "ADD":u
      ELSE IF imod = "m":u  THEN "MODIFY":u
      ELSE IF imod = "r":u  THEN "RENAME":u
      ELSE IF imod = "d":u  THEN "DELETE":u
      ELSE IF imod = "e":u  THEN "":u
      ELSE "?":u)
    + " ":u
    + (IF     iobj begins "cp":u THEN "DATABASE ":u + 
               SUBSTRING(iobj,3,-1,"CHARACTER")
      ELSE IF iobj    =   "d":u  THEN "DATABASE ":u + 
               (IF wdbs._Db-name    = ? THEN "" ELSE wdbs._Db-name)
      ELSE IF iobj    =   "t":u  THEN "TABLE ":u    + 
               (IF wfil._File-name  = ? THEN "" ELSE wfil._File-name)
      ELSE IF iobj    =   "f":u  THEN "FIELD ":u    + 
               (IF wfld._Field-name = ? THEN "" ELSE wfld._Field-name)
      ELSE IF iobj    =   "i":u  THEN "INDEX ":u    + 
               (IF widx._Index-name = ? THEN "" ELSE widx._Index-name)
      ELSE IF iobj    =   "s":u  THEN "SEQUENCE ":u + 
               (IF wseq._Seq-Name   = ? THEN "" ELSE wseq._Seq-Name)
      ELSE IF iobj    =   "c":u  THEN "CONSTRAINT ":u +
               (IF wcon._con-name   = ? THEN "" ELSE wcon._con-name)  
      ELSE "? ?":u).

  IF p_cmd = "curr" THEN DO:
     msg = "** Line " + STRING(ipos).
     DO ix = 1 to 9:
       msg = msg + (IF ilin[ix] <> ? THEN " " + ilin[ix] ELSE "").
     END.
  END.

  IF user_env[6] = "f" THEN 
  DO:  /* output only to file */

      OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.
    
      IF  ierror <= 31
      OR ierror >  42 THEN 
      DO:
          IF msg = "" THEN
             PUT STREAM loaderr UNFORMATTED
             SKIP(1) "** Error during " scrap " **" SKIP(1)
             SUBSTITUTE(error_text[ierror],
             ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
          ELSE
             PUT STREAM loaderr UNFORMATTED
             SKIP(1) "** Error during " scrap " **" SKIP(1)
             msg SKIP(1)
             SUBSTITUTE(error_text[ierror],
             ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
      END.  
      ELSE /* IF ierror <= 42 THEN */ 
          PUT STREAM loaderr UNFORMATTED
              SKIP(1) "** Error during" scrap "**"           SKIP(1)
              error_text[ierror]                     {&SKP}
              error_text[ierror + 1]                 {&SKP} 
              error_text[ierror + 2].
  END.     /* output only to file */

  /* output only with alert-boxes */
  ELSE IF user_env[6] = "s" THEN 
  DO: 
      IF  ierror <= 31
      OR ierror >  42 THEN
      DO:
          IF msg = "" THEN 
             MESSAGE 
                 "** Error during" scrap "**" SKIP(1)
                 SUBSTITUTE(error_text[ierror],
                 ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) 
                 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          ELSE 
              MESSAGE 
                 "** Error during" scrap "**" SKIP(1)
                 msg SKIP(1) 
                 SUBSTITUTE(error_text[ierror],
                 ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) 
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      end.
      ELSE /* IF ierror <= 42 THEN */ 
          MESSAGE
             "** Error during" scrap "**"           SKIP(1)
             error_text[ierror]                     {&SKP}
             error_text[ierror + 1]                 {&SKP} 
             error_text[ierror + 2] 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.

  END. /* output only with alert-boxes */  
  ELSE IF user_env[6] = "b" THEN DO:  /* output to both file and alert-boxes */
      OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.
      IF  ierror <= 31
      OR ierror >  42 THEN 
      DO:
          IF msg = "" THEN 
          DO: 
               MESSAGE
                  "** Error during" scrap "**" SKIP(1)
                  SUBSTITUTE(error_text[ierror],
                  ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u))
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        
                  PUT STREAM loaderr UNFORMATTED
                  SKIP(1) "** Error during " scrap " **" SKIP(1)
                  SUBSTITUTE(error_text[ierror],
                  ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
          END.
          ELSE 
          DO: 
              MESSAGE
              "** Error during" scrap "**" SKIP(1)
              msg SKIP(1)
              SUBSTITUTE(error_text[ierror],
              ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u))
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    
              PUT STREAM loaderr UNFORMATTED
              SKIP(1) "** Error during " scrap " **" SKIP(1)
              msg SKIP(1)
              SUBSTITUTE(error_text[ierror],
              ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
          END.
      END.
      ELSE /* IF ierror <= 42 THEN */
      DO:
          MESSAGE
            "** Error during" scrap "**"           SKIP(1)
            error_text[ierror]                     {&SKP}
            error_text[ierror + 1]                 {&SKP}
            error_text[ierror + 2]
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    
            PUT STREAM loaderr UNFORMATTED
            SKIP(1) "** Error during " scrap " **"           SKIP(1)
            error_text[ierror]                     {&SKP}
            error_text[ierror + 1]                 {&SKP}
            error_text[ierror + 2] SKIP(1).
      END.
  END. /* output to both file and alert-boxes */
  if valid-object(dictLoader) then
  do:
      dictLoader:AddError("** Error during " + scrap + " **").
      IF  ierror <= 31
      OR ierror >  42 THEN 
      DO:
          if msg > "" then
             dictLoader:AddError(msg).
          
          dictLoader:AddError(
               SUBSTITUTE(error_text[ierror],
                          ENTRY(1,scrap," ":u),
                          ENTRY(2,scrap," ":u),
                          ENTRY(3,scrap," ":u)) 
               ).
      end.
      else do:
          dictLoader:AddError(error_text[ierror]).
          dictLoader:AddError(error_text[ierror + 1]).
          dictLoader:AddError(error_text[ierror + 2]).
      end.
  end.    
  ASSIGN xerror = true.

  OUTPUT STREAM loaderr CLOSE.

END PROCEDURE. /* Show_Error */

/* Show warning */
/* CAUTION:::::::::::::::::::::::::::::::::::::::::::::::::::::::
 * This procedure is nearly identical to Show_Error.  Be careful to modify
 * the correct one or both as necessary.
 */
PROCEDURE Show_Warning:
  DEFINE INPUT PARAMETER p_cmd AS CHAR NO-UNDO.

  DEFINE VAR msg AS CHAR    NO-UNDO INIT "".
  DEFINE VAR ix  AS INTEGER NO-UNDO.

  scrap = (IF imod = "cp":u THEN "ADD/MODIFY":u
      ELSE IF imod = "a":u  THEN "ADD":u
      ELSE IF imod = "m":u  THEN "MODIFY":u
      ELSE IF imod = "r":u  THEN "RENAME":u
      ELSE IF imod = "d":u  THEN "DELETE":u
      ELSE "?":u)
    + " ":u
    + (IF     iobj begins "cp":u THEN "DATABASE ":u + 
               SUBSTRING(iobj,3,-1,"CHARACTER")
      ELSE IF iobj    =   "d":u  THEN "DATABASE ":u + 
               (IF wdbs._Db-name    = ? THEN "" ELSE wdbs._Db-name)
      ELSE IF iobj    =   "t":u  THEN "TABLE ":u    + 
               (IF wfil._File-name  = ? THEN "" ELSE wfil._File-name)
      ELSE IF iobj    =   "f":u  THEN "FIELD ":u    + 
               (IF wfld._Field-name = ? THEN "" ELSE wfld._Field-name)
      ELSE IF iobj    =   "i":u  THEN "INDEX ":u    + 
               (IF widx._Index-name = ? THEN "" ELSE widx._Index-name)
      ELSE IF iobj    =   "s":u  THEN "SEQUENCE ":u + 
               (IF wseq._Seq-Name   = ? THEN "" ELSE wseq._Seq-Name)
      ELSE IF iobj    =   "c":u  THEN "CONSTRAINT ":u +
               (IF wcon._con-name   = ? THEN "" ELSE wcon._con-name)         
      ELSE "? ?":u).
  IF user_env[6] = "f" THEN DO:
    OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.

    IF p_cmd = "curr" THEN DO:
      msg = "** Line " + STRING(ipos).
      DO ix = 1 to 9:
        msg = msg + (IF ilin[ix] <> ? THEN " " + ilin[ix] ELSE "").
      END.
    END.

    IF user_env[6] = "f" THEN DO:  /* output only to file */
      IF  iwarn < {&WARN_MSG_SQLW} THEN DO:
        IF msg = "" THEN
          PUT STREAM loaderr UNFORMATTED
             SKIP(1) "** " scrap " caused a warning **" SKIP(1)
             SUBSTITUTE(warn_message,
             ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
        ELSE
          PUT STREAM loaderr UNFORMATTED
             SKIP(1) "** " scrap " caused a warning **" SKIP(1)
             msg SKIP(1)
             SUBSTITUTE(warn_message,
             ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
      END.  
      ELSE /* IF iwarn >= {&WARN_MSG_SQLW} THEN */ 
        PUT STREAM loaderr UNFORMATTED
             SKIP(1) "** " scrap " caused a warning **"           SKIP(1)
             warn_text[iwarn]                     {&SKP}
             warn_message                         {&SKP} 
             warn_text[iwarn + 2].
    END.     /* output only to file */
  END.
  ELSE IF user_env[6] = "s" THEN DO: /* output only with alert-boxes */
    IF  iwarn < {&WARN_MSG_SQLW}  THEN
      IF msg = "" THEN 
         MESSAGE 
          "**" scrap "caused a warning **" SKIP(1)
          SUBSTITUTE(warn_message,
          ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) 
          VIEW-AS ALERT-BOX WARNING BUTTONS OK.
      ELSE 
        MESSAGE 
          "**" scrap "caused a warning **" SKIP(1)
          msg SKIP(1) 
          SUBSTITUTE(warn_message,
          ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) 
          VIEW-AS ALERT-BOX WARNING BUTTONS OK.
      ELSE /* IF iwarn >= {&WARN_MSG_SQLW} THEN */ 
        MESSAGE
          "**" scrap "caused a warning **"           SKIP(1)
          warn_text[iwarn]                     {&SKP}
          warn_message                         {&SKP} 
          warn_text[iwarn + 2] 
          VIEW-AS ALERT-BOX WARNING BUTTONS OK.

  END.     /* output only with alert-boxes */
  ELSE IF user_env[6] = "b" THEN DO:  /* output to both file and alert-boxes */
    OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.

    IF  iwarn < {&WARN_MSG_SQLW} THEN DO:
      IF msg = "" THEN DO: 
        MESSAGE
          "**" scrap "caused a warning **" SKIP(1)
          SUBSTITUTE(warn_message,
          ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u))
          VIEW-AS ALERT-BOX WARNING BUTTONS OK.

          PUT STREAM loaderr UNFORMATTED
          SKIP(1) "** " scrap " caused a warning **" SKIP(1)
          SUBSTITUTE(warn_message,
          ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
      END.
      ELSE DO: 
        MESSAGE
          "**" scrap "caused a warning **" SKIP(1)
          msg SKIP(1)
          SUBSTITUTE(warn_message,
          ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u))
          VIEW-AS ALERT-BOX WARNING BUTTONS OK.

        PUT STREAM loaderr UNFORMATTED
              SKIP(1) "** " scrap " caused a warning **" SKIP(1)
              msg SKIP(1)
              SUBSTITUTE(warn_message,
              ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u)) SKIP(1).
      END.
    END.
    ELSE /* IF iwarn >= {&WARN_MSG_SQLW} THEN */ DO:
      MESSAGE
        "**" scrap "caused a warning **"           SKIP(1)
        warn_text[iwarn]                     {&SKP}
        warn_message                         {&SKP}
        warn_text[iwarn + 2]
        VIEW-AS ALERT-BOX WARNING BUTTONS OK.

      PUT STREAM loaderr UNFORMATTED
        SKIP(1) "** " scrap " caused a warning **"           SKIP(1)
        warn_text[iwarn]                     {&SKP}
        warn_message                         {&SKP}
        warn_text[iwarn + 2] SKIP(1).
    END.

  END.     /* output to both file and alert-boxes */
  
  OUTPUT STREAM loaderr CLOSE.
  
  if valid-object(dictLoader) then
  do: 
      dictLoader:AddWarning("** " + scrap + " caused a warning **" ).
      dictLoader:AddWarning(SUBSTITUTE(warn_message,
                           ENTRY(1,scrap," ":u),ENTRY(2,scrap," ":u),ENTRY(3,scrap," ":u))). 
      
  end.
  
  ASSIGN xwarn = true
         warn_message = "".

END PROCEDURE. /* Show_Warnings */

/*  Show message and/or output to file according to user settings.  
    called from catch in transaction */
procedure showLoadError:
    define input parameter poError as Progress.Lang.Error no-undo.
    define variable iLoop as integer no-undo.
    define variable cMessage as character no-undo.
    
    /* if user_env[6] = "b" (both) or "s" (screen) display the message
       unless the error is an AppError in which case the message is 
       already shown as it is used to wrap STOP in the transaction.) 
       - Note: Use Error.Severity to identify this if AppError need to 
               be used for other errors. */
    if (user_env[6] = "b" or user_env[6] = "s") 
    and not type-of(poError,Progress.Lang.AppError) then
    do:
       do i = 1 to poError:NumMessages:
          cMessage = (if i = 1 then "" else cMessage + chr(10) + chr(10))
                   + poError:GetMessage(i).
       end. 
       message cMessage view-as alert-box error.
    end. 
    
    /* if user_env[6] = "b" (both) or "f" (file) output the message */
    if user_env[6] = "b" or user_env[6] = "f" then
    do:   
      OUTPUT TO VALUE (dbload-e) APPEND.
      PUT UNFORMATTED TODAY " " STRING(TIME,"HH:MM") " : "
      "Load of " user_env[2] " into database " 
      LDBNAME("DICTDB") " was unsuccessful." SKIP 
      " All the changes were backed out..."  SKIP 
      " {&PRO_DISPLAY_NAME} error(s)":U SKIP. 
      do iloop = 1 to poError:NumMessages:
         put unformatted poError:GetMessage(iLoop) at 2 skip.
      end.
      put unformatted skip(1).
      OUTPUT CLOSE.
    end.
    
    /* The loader is only here when called from prodict/dump/_load_df which 
       has a transaction and error handler, so transaction errors would not
       likely end up here, but just in case  */ 
    if valid-object(dictLoader) then
    do:
        dictLoader:AddError(poError).
    end.
                
end procedure.    



/* Callback for errors when saving policies */
PROCEDURE secErrorCallback:
    DEFINE INPUT  PARAMETER pmsg      AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER lContinue AS LOGICAL NO-UNDO.

    /* we always continue to load the policies, unless the user wants to
       stop at the first error.
    */
    IF user_env[4] BEGINS "y":u THEN
        lContinue = NO.
    ELSE
        lContinue = YES.

    RUN Show_Phase2_Error (INPUT pmsg, INPUT "e").
END.

/* Callback for errors when saving object attributes (buffer pool) */
PROCEDURE attrsErrorCallback:
    DEFINE INPUT  PARAMETER pmsg      AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER lContinue AS LOGICAL NO-UNDO.

    /* we always continue to load the settings, unless the user wants to
       stop at the first error.
    */
    IF user_env[4] BEGINS "y":u THEN
        lContinue = NO.
    ELSE
        lContinue = YES.

    RUN Show_Phase2_Error (INPUT pmsg, INPUT "b").
END.

/* Handle errors during encryption policy / buffer pool save phase */
PROCEDURE Show_Phase2_Error:
  DEFINE INPUT PARAMETER p_msg  AS CHAR NO-UNDO.
  DEFINE INPUT PARAMETER p_cStr AS CHAR NO-UNDO.

  IF p_cStr = "e" THEN
      p_cStr = "encryption policy".
  ELSE IF p_cStr = "b" THEN
       p_cStr = "buffer pool".
  ELSE
      p_cStr = "encryption policies/buffer pool settings".

  IF user_env[6] = "f" THEN DO:
     OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.

     IF user_env[6] = "f" THEN DO:  /* output only to file */
        PUT STREAM loaderr UNFORMATTED
                   SKIP(1) "** Error loading " p_cStr " **"  
                   SKIP(1) p_msg {&SKP}.
     END.     /* output only to file */
  END. 
  ELSE IF user_env[6] = "s" THEN DO: /* output only with alert-boxes */
        IF p_msg BEGINS error_text[68] THEN
            MESSAGE p_msg
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        ELSE
            MESSAGE "** Error loading " p_cStr " **"  
                    SKIP(1) p_msg
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  END.     /* output only with alert-boxes */
  ELSE IF user_env[6] = "b" THEN DO:  /* output to both file and alert-boxes */

        OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.
        IF p_msg BEGINS error_text[68] THEN
            MESSAGE p_msg
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        ELSE
            MESSAGE "** Error loading " p_cStr " **"  
                   SKIP(1) p_msg
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.

        PUT STREAM loaderr UNFORMATTED
                   SKIP(1) "** Error loading " p_cStr " **"  
                   SKIP(1) p_msg {&SKP}.

  END.     /* output to both file and alert-boxes */
  
  if valid-object(dictLoader) then
  do: 
      dictLoader:AddPhase2Error("** Error loading " + p_cStr + " **").
      dictLoader:AddPhase2Error(p_msg).
  end.

  ASSIGN xerror = true.

  OUTPUT STREAM loaderr CLOSE.

END PROCEDURE. /* Show_Phase2_Error */ 

/*-----------------------------------------------------
   Load ICU RUles.
   
   Input Parameters:
      ct_version 
      xxxxxxx.
      
_Codepage
    _Cp-Name        Char    name 
    _Cp-Sequence        int     sequential number of codepage in this db.
    _Cp-Db-Recid        Recid       db recid.
    _Cp-Attr        Raw     codepage attributes (now 768 bytes)

Indexes:
    unique index on _Cp-DB-Recid + _Cp-Name
    unique index on _Cp-Sequence
      
      
_Collation
    _Coll-Name      Char    collation name
    _Coll-Sequence  int     sequential number of collation in this db?
                _Coll-cp        Int     _Cp-Sequence for this collation
    _Coll-Tran-Version  Int (byte)
    _Coll-Tran-Subtype  Int (byte)
    _Coll-Segment   Int     segment number
    _Coll-data      Raw     usually 512 bytes, could be multiple segs
    
Indexes:
    unique index on _Coll-cp + _Coll-Name + _Coll-Segment
    unique index on _Coll-Sequence
    
    then wdbs._Db-xl-name = iarg.
          when "COLLATION-NAME"               then wdbs._Db-coll-name = iar
------------------------------------------------------*/

PROCEDURE Load_Icu_Rules:

  DEFINE INPUT-OUTPUT PARAMETER longRules     AS INTEGER NO-UNDO.

  DEFINE VARIABLE lChanged      AS LOGICAL NO-UNDO.
  DEFINE VARIABLE lcRules       AS LONGCHAR NO-UNDO.
  DEFINE VARIABLE iCpSeq        AS INTEGER NO-UNDO.
  DEFINE VARIABLE iCollSeq      AS INTEGER NO-UNDO.
  DEFINE VARIABLE iCollSegment  AS INTEGER init 1 NO-UNDO.
  DEFINE VARIABLE iLen          AS INTEGER NO-UNDO.
  DEFINE VARIABLE iOff          AS INTEGER NO-UNDO.
  DEFINE VARIABLE iShortOff     AS INTEGER init 69 NO-UNDO.
  DEFINE VARIABLE iRem          AS INTEGER NO-UNDO.
  DEFINE VARIABLE iPos          AS INTEGER NO-UNDO.
  DEFINE VARIABLE lpMptr        AS MEMPTR NO-UNDO.
  DEFINE VARIABLE lpToo         AS MEMPTR NO-UNDO.
  DEFINE VARIABLE iLength       AS INTEGER NO-UNDO.
  DEFINE VARIABLE iPosition     AS INTEGER init 1 NO-UNDO.
  DEFINE VARIABLE cInLine       AS CHARACTER NO-UNDO.
  DEFINE VARIABLE iReadPosition AS INTEGER NO-UNDO.

  IF cerror <> "no-convert" AND SESSION:CHARSET <> codepage THEN DO:
  INPUT CLOSE.
  INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.

     REPEAT:
       IMPORT  UNFORMATTED cInLine.
       IF TRIM(cInLine) = "ICU-RULES" THEN LEAVE.
     END. /* repeat */
  END. /* IF cerror ... */

  lcRules = "".
  SET-SIZE(lpMptr) = IF longrules > 0 THEN longrules ELSE 300.
  FIX-CODEPAGE(lcRules) = "UTF-8".
  iPosition = 1.
  REPEAT:
    IMPORT  UNFORMATTED cInLine.
    IF TRIM(cInLine) = "END-RULES" THEN LEAVE.
    iLength = LENGTH(cInLine, "RAW").
    PUT-STRING(lpMptr, iPosition, iLength) = cInLine.
    iPosition = iPosition + iLength.
  END. /* repeat */
   
  IF longrules > 0 THEN
    COPY-LOB lpMptr TO lcRules NO-CONVERT NO-ERROR.
  ELSE DO:
    COPY-LOB lpMptr FOR (iPosition - 1) TO lpToo NO-ERROR.
    COPY-LOB lpToo TO lcRules NO-CONVERT NO-ERROR.
    SET-SIZE(lpToo) = 0.
  END.
    
      
  IF ERROR-STATUS:ERROR THEN DO:
    SET-SIZE(lpMptr) = 0.
    RETURN "Failed".
  END.

/** GIH - Temporarily removing for multiple collations schema changes **
  IF longRules = 0 THEN lcRules = "".
  ELSE DO:
    FIND FIRST _Codepage WHERE _Cp-Name = wdbs._Db-xl-name AND _Cp-dbrecid = drec_db NO-ERROR.
    IF AVAILABLE _Codepage THEN DO:
      iCpSeq = _Codepage._Cp-sequence.
    END.
    ELSE DO:
      FIND LAST _Codepage USE-INDEX _Codepage-seq NO-ERROR.
      IF AVAILABLE _codepage THEN
        iCpSeq = _Codepage._Cp-sequence + 1.
      ELSE
        iCpSeq = 1.
      CREATE _Codepage.
      ASSIGN _Cp-name = wdbs._Db-xl-name
             _Cp-sequence = iCpSeq
             _Cp-dbrecid = drec_db NO-ERROR.

      IF ERROR-STATUS:ERROR THEN DO:
        SET-SIZE(lpMptr) = 0.
        RETURN "Failed".
      END.
    END.
    FIND FIRST _Collation WHERE wdbs._Db-coll-name = _Coll-name AND _Coll-cp = iCpSeq NO-ERROR.
    IF NOT AVAILABLE _Collation THEN DO:
 
      CREATE _Collation.

      ASSIGN _Coll-Name = wdbs._Db-coll-name
             _Coll-cp = iCpSeq
             _Coll-Tran-Version =   GETBYTE(wdbs._Db-collate[5],1) 
             _Coll-Tran-Subtype =  GETBYTE(wdbs._Db-collate[5],2)
             _Coll-Segment = iCollSegment NO-ERROR.
      
      IF ERROR-STATUS:ERROR THEN DO:
        SET-SIZE(lpMptr) = 0.
        RETURN "Failed".
      END.

      _Coll-data = wdbs._Db-collate[1] NO-ERROR.

      IF ERROR-STATUS:ERROR THEN DO:
        SET-SIZE(lpMptr) = 0.
        RETURN "Failed".
      END.

      PUT-BYTES(_Coll-data, 257) = wdbs._Db-collate[2].
 
      IF longRules > 0 THEN DO:
        iOff = 513.
        iRem = 30000 - iOff + 1.
        iLen = LENGTH( lcRules, "RAW" ).
        COPY-LOB lcRules TO lpMptr NO-CONVERT.
        IF iLen > iRem THEN DO:
          iPos = 1.
          DO WHILE iLen > 0 :
            lpToo = GET-BYTES( lpMptr, ipos, IF iLen > irem THEN irem ELSE iLen ).
            PUT-BYTES( _coll-data, IOFF)  = lpToo.
            iPos = iPos + iRem.
            iOff = 1. 
            iLen = iLen - iRem.
            iRem = 30000.
            IF iLen > 0 THEN DO:
              iCollSegment  = iCollSegment + 1.

              CREATE _Collation.
              ASSIGN _Coll-Name = wdbs._Db-coll-name
                     _Coll-cp = iCpSeq
                     _Coll-Tran-Version =  GET-BYTE(wdbs._Db-collate[5],1) 
                     _Coll-Tran-Subtype =  GET-BYTE(wdbs._Db-collate[5],2) 
                     _Coll-Segment = iCollSegment
                     _Coll-data = raw_val NO-ERROR.

              IF ERROR-STATUS:ERROR THEN DO:
                SET-SIZE(lpMptr) = 0.
                SET-SIZE(lpToo) = 0.
                RETURN "Failed".
              END.
            END. /*IF iLen > 0 THEN DO:*/

          END.  /* do while */
        END.  /* IF iLen > iRem */
        ELSE PUT-BYTES(_coll-data, iOff ) = lpMptr.

        SET-SIZE(lpMptr) = 0.
        SET-SIZE(lpToo) = 0.
                    
      END.  /* IF longRules */
    END.
  END.
   
  longRules =  LENGTH(lcRules, "RAW").

** GIH - end Temporarily remove for multiple collation schema work **/

  lcRules = "".
  SET-SIZE(lpMptr) = 0.
   
  ct_changed = ct_changed OR lChanged.
  
  RETURN "".
END PROCEDURE.

/*-----------------------------------------------------
   Load one of the translation or collate tables.
   
   Input Parameter:
      p_Dbfield - the name of the database field to
                               load.
------------------------------------------------------*/
PROCEDURE Load_Tran_Collate_Tbl:

  DEFINE INPUT PARAMETER p_Dbfield AS CHAR NO-UNDO.
  DEFINE INPUT PARAMETER p_index   AS INTEGER NO-UNDO.

  DEFINE VARIABLE changed AS LOGICAL NO-UNDO.
  DEFINE VARIABLE hParam  AS HANDLE NO-UNDO.

   IMPORT ilin.
   ipos = ipos + 1.

   ASSIGN hParam = BUFFER wdbs:HANDLE
          hParam = hParam:BUFFER-FIELD(p_dbfield).

   RUN prodict/dump/_lod_raw.i (INPUT ct_version, INPUT hParam, INPUT p_index, OUTPUT changed) 256.
   ct_changed = ct_changed OR changed.

   ilin[1] = ?.  /* so we do a new import the next time around */
  END.

  
/*-----------------------------------------------------
  Gets the utility set up so we can handle encryption 
  settings.
------------------------------------------------------*/
PROCEDURE checkEPolicy:
    DEFINE BUFFER myDb FOR _Db.

    IF VALID-OBJECT(dictEPolicy) THEN
       RETURN. /* all is well */

    FIND myDb WHERE RECID(myDb) = drec_db NO-LOCK.

    /* encryption only for OpenEdge dbs */
    IF myDb._Db-type NE "PROGRESS" THEN DO:
        ierror = 60.
        RETURN ERROR.
    END.
    ELSE IF skipEPolicy THEN DO:
        /* we will keep displaying the same message, if the user selected to
          ignore all errors 
        */
        ierror = 61.
        RETURN ERROR.
    END.

    /* we come here just once */
    skipEPolicy = YES.

    DO ON ERROR UNDO, LEAVE:
        dictEPolicy = NEW prodict.sec._sec-pol-util().

        CATCH ae AS PROGRESS.Lang.AppError:
            /* this gets set so we display the error message */
            ASSIGN error_text[61] = "Cannot load any encryption definitions." + "~n"
                            + ae:GetMessage(1)
                  ierror = 61.
            DELETE OBJECT ae.

            RETURN ERROR.
        END CATCH.
    END.
END.

/*-----------------------------------------------------
  Gets the utility set up so we can handle buffer pool 
  settings.
------------------------------------------------------*/
PROCEDURE checkObjAttrs:
    DEFINE BUFFER myDb FOR _Db.

    IF VALID-OBJECT(dictObjAttrs) THEN
       RETURN. /* all is well */

    FIND myDb WHERE RECID(myDb) = drec_db NO-LOCK.

    /* buffer-pool only for OpenEdge dbs */
    IF myDb._Db-type NE "PROGRESS" THEN DO:
        ierror = 60.
        RETURN ERROR.
    END.
    ELSE IF skipObjAttrs THEN DO:
        /* we will keep displaying the same message, if the user selected to
          ignore all errors 
        */
        ierror = 70.
        RETURN ERROR.
    END.

    /* we come here just once */
    skipObjAttrs = YES.

    DO ON ERROR UNDO, LEAVE:
        dictObjAttrs = NEW prodict.pro._obj-attrib-util().

        CATCH ae AS PROGRESS.Lang.AppError:
            /* this gets set so we display the error message */
            ASSIGN error_text[70] = "Cannot load any buffer-pool definitions." + "~n"
                            + ae:GetMessage(1)
                  ierror = 70.
            DELETE OBJECT ae.

            RETURN ERROR.
        END CATCH.
    END.
END.

/*-----------------------------------------------------
  save away encryption settings
------------------------------------------------------*/
PROCEDURE addEncryptionSetting.
    DEFINE INPUT PARAMETER objType AS CHAR NO-UNDO.
    DEFINE INPUT PARAMETER cKeywd  AS CHAR NO-UNDO.
    DEFINE INPUT PARAMETER cValue  AS CHAR NO-UNDO.

    DEFINE VARIABLE cObjName AS CHAR    NO-UNDO.
    DEFINE VARIABLE objNum   AS INT     NO-UNDO.
    DEFINE VARIABLE cTmp     AS CHAR    NO-UNDO.
    DEFINE VARIABLE hasPrev  AS LOGICAL NO-UNDO.
    DEFINE BUFFER   b_File   FOR _File.

    IF objType = "table" THEN
        ASSIGN cObjName = wfil._File-name
               objNum = wfil._File-num. /* may be 0 if new table */
    ELSE DO:
        IF objType = "index" THEN DO:
            FIND b_File WHERE drec_file = RECID(b_File).
            ASSIGN cObjName = b_File._File-name + "." + widx._Index-name
                   objNum = widx._Idx-num. /* may be 0 if new indexx */
        END.
        ELSE DO: /* blob or clob */
            FIND b_File WHERE drec_file = RECID(b_File).
            ASSIGN cObjName = b_File._File-name + "." + wfld._Field-name
                   objNum = wfld._fld-stlen. /* may be area number if new field */
        END.
    END.

    IF cKeywd = "ENCRYPTION" OR cKeywd = "ENCRYPT" THEN DO:
       IF cValue = "NO" THEN DO:
           /* if we are changing the value, and there is a previous policy, this will
              not get loaded, so we will raise an error.
           */
           cValue = "".
           hasPrev = dictEPolicy:cacheObjForLoad(INPUT cObjName, INPUT objType,
                                                 INPUT objNum, INPUT-OUTPUT cValue).

           /* hasPrev is yes, if there is a previous policy version, and cipher is ? if the cipher is
             the same of the current policy (in this case, that encryption is already off)
           */
           IF cValue = ? THEN DO:
               ASSIGN ierror = 50
                      iwarn  = 26
                      warn_message = warn_text[26].
           END.
           ELSE IF hasPrev THEN DO:
               ierror = 63.
               RETURN ERROR.
           END.
           ELSE /* remember that there is a change to the policy*/
               ASSIGN hasEncPol = YES.
       END.
       ELSE DO:
           /* mark this so that we know whether they have an invalid .df, where they have
              a cipher without the encrypt keyword.
              Note that for 'encryption no' we can't have a cipher so we only do this
              here.
           */
           ASSIGN encryptOpts[1] = YES.
       END.
    END.
    ELSE DO:

       /* this signals that we found a cipher */
       ASSIGN  encryptOpts[2] = YES
               cValue = TRIM(cValue).

       /* check if it is a valid cipher */
       cTmp = dictEPolicy:CipherNames.
       IF cTmp = "" OR LOOKUP(cValue, cTmp) = 0 THEN DO:
           ierror = 64.
           RETURN ERROR.           
       END.                 

       /* if we are changing the value, and there is a previous policy, this will
          not get loaded, so we will raise an error.
       */
       hasPrev = dictEPolicy:cacheObjForLoad(INPUT cObjName, INPUT objType,
                                             INPUT objNum, INPUT-OUTPUT cValue).

       /* hasPrev is yes, if there is a previous policy version, and cipher is ? if the cipher is
         the same of the current policy.
       */
       IF cValue = ? THEN DO:
           ASSIGN ierror = 50
                  iwarn  = 26
                  warn_message = warn_text[26].
       END.
       ELSE IF hasPrev THEN DO:
           ierror = 63.
           RETURN ERROR.
       END.
       ELSE /* remember that there is a change to the policy*/
            ASSIGN hasEncPol = YES.
    END.
END.

/*-----------------------------------------------------
  save away buffer-pool settings
------------------------------------------------------*/
PROCEDURE addBufferPoolSetting.
    DEFINE INPUT PARAMETER objType AS CHAR NO-UNDO.
    DEFINE INPUT PARAMETER cKeywd  AS CHAR NO-UNDO.
    DEFINE INPUT PARAMETER cValue  AS CHAR NO-UNDO.

    DEFINE VARIABLE cObjName AS CHAR    NO-UNDO.
    DEFINE VARIABLE objNum   AS INT     NO-UNDO.
    DEFINE VARIABLE cTmp     AS CHAR    NO-UNDO.
    DEFINE BUFFER   b_File   FOR _File.

    IF objType = "table" THEN
        ASSIGN cObjName = wfil._File-name
               objNum = wfil._File-num. /* may be 0 if new table */
    ELSE DO:
        IF objType = "index" THEN DO:
            FIND b_File WHERE drec_file = RECID(b_File).
            ASSIGN cObjName = b_File._File-name + "." + widx._Index-name
                   objNum = widx._Idx-num. /* may be 0 if new indexx */
        END.
        ELSE DO: /* blob or clob */
            FIND b_File WHERE drec_file = RECID(b_File).
            ASSIGN cObjName = b_File._File-name + "." + wfld._Field-name
                   objNum = wfld._fld-stlen. /* may be area number if new field */
        END.
    END.

    /* this signals that we found a cipher */
    ASSIGN cValue = TRIM(cValue).

    /* check if it is a valid pool name */
    cTmp = dictObjAttrs:BufferPoolNames.
    IF cTmp = "" OR LOOKUP(cValue, cTmp) = 0 THEN DO:
       ierror = 67.
       RETURN ERROR.           
    END.                 

    dictObjAttrs:cacheObjForLoad(INPUT cObjName, INPUT objType,
                                 INPUT objNum, INPUT-OUTPUT cValue).

    /* remember there is a change */
    ASSIGN hasBufPool = YES.
END.

/*==========================Mainline Code==============================*/

/* dictLoadOptions - could have options only or be a logger/loader or reader/parser  */
if valid-object(dictLoadOptions) then
do:
    /* the code below use valid-object(dictLoader) as flag to not show messages and data */
    dictLoader = dictLoadOptions:Logger.
    if dictLoadOptions:ForceCommit then
        user_env[15] = "yes".
end.

if not valid-object(dictLoader) then
do:
    COLOR DISPLAY MESSAGES
        wdbs._Db-name wfil._File-name wfld._Field-name
        widx._Index-name wseq._Seq-Name
    WITH FRAME working.

    /* Fix problems which resulted when .rcode is run on Japanese DOS/WIN, 640x480
       while the .r-code was compiled/created with US fonts/Progress.ini
       Increase the frame size a little bit. 
    */
    if session:pixels-per-column = 6 AND session:width-pixels = 640 THEN
    DO:
       FRAME working2:WIDTH-CHARS = FRAME working2:WIDTH-CHARS + msg1:column + 2.
       FRAME backout:WIDTH-CHARS = FRAME backout:WIDTH-CHARS + msg2:column + 2.
       FRAME errorlog:WIDTH-CHARS = FRAME errorlog:WIDTH-CHARS + msg3:column + dbload-e:column + msg4:column + 2.
    END.
end.
       
ASSIGN
  cache_dirty = TRUE
  user_dbname = user_env[8]. /* for backwards compatibility with _lodsddl.p */

DO ON ERROR UNDO, LEAVE: 
/* catch all warnings; not correcting indentation */
DO FOR _Db:
  FIND FIRST _Db
    WHERE _Db._Db-name = ( IF user_dbtype = "PROGRESS":u
                             THEN ?
                             ELSE user_dbname
                         )
    NO-ERROR.
  ASSIGN
    drec_db      = RECID(_Db)
    drec_file    = ?
    sav_dbnam    = user_dbname
    sav_dbtyp    = user_dbtype
    sav_drec     = drec_db
    ierror       = 0
    ilin         = ?
    ipos         = 0
    gate_dbtype  = user_dbtype
    gate_proc    = ""
    do-commit    = (IF user_env[15] = "yes" THEN TRUE ELSE FALSE).
END.
 
/* Set up the name of the procedure to call to get stdtype info */
IF gate_dbtype <> "PROGRESS" THEN DO:
  {prodict/dictgate.i 
     &action=query 
     &dbtype=gate_dbtype 
     &dbrec =? 
     &output=scrap
     }
  gate_proc = "prodict/" + ENTRY(9,scrap) + "/_" + ENTRY(9,scrap) + "_typ.p".
END.

/* allow log to be set from loader. Set it back if not set */
if valid-object(dictLoadOptions) then
    dbload-e = dictLoadOptions:ErrorLog.

if dbload-e = "" or dbload-e = ? then
do:
    dbload-e = LDBNAME("DICTDB") + ".e".

    if valid-object(dictLoadOptions) then
        dictLoadOptions:ErrorLog = dbload-e.
end.
    
/* check if this is a 10.1B db at least, so that we complain about int64 and
   int64 values. If the 'Large Keys' feature is not known by this db, then this
   is a pre-101.B db 
*/
is-pre-101b-db = YES.

IF INTEGER(DBVERSION("DICTDB")) >= 10 THEN DO:
    /* use a dyn buffer since v9 db's don't have the feature tbl */
    CREATE BUFFER hBuffer FOR TABLE "DICTDB._Code-feature" NO-ERROR.
    IF VALID-HANDLE(hBuffer) THEN DO:
       hBuffer:FIND-FIRST('where _Codefeature_Name = "Large Keys"',NO-LOCK) NO-ERROR.
       IF hBuffer:AVAILABLE THEN
           is-pre-101b-db = NO.
       DELETE OBJECT hBuffer.
    END.
END.

/* must be before assignment for codepage, since we assign it ourselves and not
  take the one from the trail. We want to check if the .df has settings for
  encryption policies (for encryption) so we can display errors that we can
  catch upfront, instead of waiting until we find the stuff which is at the
  end of the .df.
*/
{prodict/dump/lodtrail.i
  &entries = "IF lvar[i] BEGINS ""encpolicy=""
                 THEN hasEncPol = LOGICAL(SUBSTRING(lvar[i],11,-1,""character"")).
              IF lvar[i] BEGINS ""bufpool=""
                 THEN hasBufPool = LOGICAL(SUBSTRING(lvar[i],9,-1,""character""))."
  &file    = "user_env[2]"
  }  /* read trailer, sets variables: codepage and cerror */

ASSIGN codepage = IF user_env[10] = ""
                    THEN "UNDEFINED"
                    ELSE user_env[10]. /* set in _usrload.p */
IF codepage <> "UNDEFINED" AND SESSION:CHARSET <> ? THEN
   ASSIGN cerror = CODEPAGE-CONVERT("a",SESSION:CHARSET,codepage).
ELSE ASSIGN cerror = "no-convert".

IF cerror = ? THEN 
DO:  /* conversion needed but NOT possible */
  
  RUN adecomm/_setcurs.p ("").
  ASSIGN user_env[4] = "error". /* to signal error to _usrload */

END.     /* conversion needed but NOT possible */

ELSE DO FOR _Db, _file, _Field, _Index, _Index-field TRANSACTION:
          /* conversion not needed OR needed and possible */

  /* if an error happens at the end of the transaction, this will get
     undone (since it's an undo var) and we will know an error happened.
  */
  ASSIGN main_trans_success = YES.

  /* Call _setcurs.p before INPUT is set.  setcurs does a "PROCESS EVENTS"
     which in not legal if the input stream is a file. */
  SESSION:IMMEDIATE-DISPLAY = yes.
  RUN adecomm/_setcurs.p ("WAIT").

  IF cerror = "no-convert"
   THEN INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
   ELSE INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP
              CONVERT SOURCE codepage TARGET SESSION:CHARSET.

/* to cheat scoping mechanism * /
  IF FALSE THEN FIND NEXT _File.
  IF FALSE THEN FIND NEXT _Field.
  IF FALSE THEN FIND NEXT _Index. */
  IF FALSE THEN FIND NEXT wdbs.
  IF FALSE THEN FIND NEXT wfil.
  IF FALSE THEN FIND NEXT wfld.
  IF FALSE THEN FIND NEXT widx.
  IF FALSE THEN FIND NEXT wseq.
  
  FIND FIRST _Db WHERE RECID(_Db) = drec_db.
  
  DO ON STOP UNDO, LEAVE:

    /* skip enc policy and buffer pool stuff  if only parsing for now */ 
    if not valid-object(dictLoader) or not dictLoader:IsReader then
    do:
        /* if the .df is signaled as having encryption policies, we will try to
           get the object for loading the policies now, so that if there are
           any errors (such as encryption not enabled, not security db, 
           not local connection), we error out right away.
         */
        IF hasEncPol THEN DO:
    
           RUN checkEPolicy NO-ERROR.
    
           IF ierror > 0 AND NOT inoerror THEN DO:
             RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
             ASSIGN imod = "sp".
             RUN Show_Error ("curr").
             IF user_env[4] BEGINS "y":u AND NOT ierror = 50
              THEN DO:
               ASSIGN stopped = true.
               UNDO,LEAVE.
             END. 
           END.
    
           /* clear them */
           ASSIGN ierror = 0
                  imod = ?
                  hasEncPol = NO /* this has a new meaning now */.
        END.
    
        /* if the .df is signaled as having buffer-pool settings, we will try to
           get the object for loading the settings now, so that if there are
           any errors, we error out right away.
        */
        IF hasBufPool THEN DO:
    
           RUN checkObjAttrs NO-ERROR.
    
           IF ierror > 0 AND NOT inoerror THEN DO:
             RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
             ASSIGN imod = "sp".
             RUN Show_Error ("curr").
             IF user_env[4] BEGINS "y":u AND NOT ierror = 50
              THEN DO:
               ASSIGN stopped = true.
               UNDO,LEAVE.
             END. 
           END.
    
           /* clear them */
           ASSIGN ierror = 0
                  imod = ?
                  hasBufPool = NO /* this has a new meaning now */.
        END.
    end.
    /* when IMPORT hits the end, it generates ENDKEY.  This is how loop ends */
    load_loop:
    REPEAT ON ERROR UNDO,RETRY ON ENDKEY UNDO, LEAVE:

        /* 20060316-011  - we will not get back here for a retry, if the line we
         are processing is the left over of the previous line (see below where
         we move the tokens based on inum), in which case the client will not
         retry because there was no live io operation in that iteration of the
         block (such as the import statement, which we don't run when moving
         tokens that were left around). By explicitly adding the RETRY function
         here, we are guarantee to always retry when the code calls
         UNDO, RETRY.
      */
      IF RETRY THEN .
      
      IF ierror > 0 AND NOT inoerror THEN DO:
        RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
        RUN Show_Error ("curr").
        IF user_env[4] BEGINS "y":u AND NOT ierror = 50 THEN 
        DO:
          ASSIGN stopped = true.
          UNDO,LEAVE load_loop.
        END. 
      END.
      IF ierror > 0 AND ierror <> 50 THEN
        ASSIGN
          ierror = 0
          imod   = ?
          iobj   = ?.
      ELSE
        ASSIGN ierror = 0.
  
      /* Pop the top token off the top and move all the other tokens up one 
         so that ilin[1] is the next token to process.
      */
      IF ilin[1] <> ? THEN
        ASSIGN
            inum    = inum + (IF CAN-DO("OF,ON":u,ilin[inum + 1]) THEN 2 ELSE 0)
          ilin[1] = ilin[inum + 1]
          ilin[2] = ilin[inum + 2]
          ilin[3] = ilin[inum + 3]
          ilin[4] = ilin[inum + 4]
          ilin[5] = (IF inum + 5 > 9 THEN ? ELSE ilin[inum + 5])
          ilin[6] = (IF inum + 6 > 9 THEN ? ELSE ilin[inum + 6])
          ilin[7] = (IF inum + 7 > 9 THEN ? ELSE ilin[inum + 7])
          ilin[8] = (IF inum + 8 > 9 THEN ? ELSE ilin[inum + 8])
          ilin[9] = ?.

      /* If there's nothing of significant at the top of the array,
         read in the next line.  One token will go into each array element. 
      */
      DO WHILE ilin[1] BEGINS "#":u OR ilin[1] = "" OR ilin[1] = ?:
        ASSIGN
          ipos = ipos + 1
          ilin = ?.       
        IMPORT ilin.
      END.
      inum = 0.
      ASSIGN stopped = true.
      IF CAN-DO(
        "ADD,CREATE,NEW,UPDATE,MODIFY,ALTER,CHANGE,DELETE,DROP,REMOVE,RENAME":u,
        ilin[1]) THEN DO:

        /* This is the start of a command - so copy the buffer values from 
             the last time through the loop into the database.
        */

        IF AVAILABLE wdbs AND imod <> ? THEN DO:
          RUN "prodict/dump/_lod_dbs.p".
          IF imod <> "d" and drec_db <> RECID(_Db) THEN 
            FIND _Db WHERE RECID(_Db) = drec_db.
        END.
            
        IF AVAILABLE wfil AND imod <> ? THEN DO:
	  /*run adecomm/_valname.p (wfil._File-name, INPUT true, OUTPUT okay).
          if NOT okay then
             LEAVE.*/

          IF wfil._For-type = ? AND user_dbtype <> "Progress" THEN DO:

            ASSIGN error_text[30] = substitute(error_text[30],_Db._Db-type)
                   ierror         = 30
                   user_env[4]    = "yes". /* to prevent 2. error-message at end */ 
          
            RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
            RUN Show_Error ("curr").
            
            IF do-commit and not valid-object(dictLoader) then
            do:
                MESSAGE "Unable to commit any updates since there is a type mismatch"
                  VIEW-AS ALERT-BOX WARNING.
                ASSIGN do-commit = FALSE.
            END.
            
            UNDO,LEAVE load_loop. /* no sense to continue */
          END.        /* table of foreign DB: type mismatch */       
          ELSE 
              RUN "prodict/dump/_lod_fil.p".  
  
        END.
         

        IF AVAILABLE wfld AND imod <> ? THEN do:
	    /*run adecomm/_valname.p (wfld._Field-name, INPUT true, OUTPUT okay).
            if NOT okay then
               LEAVE.*/
            RUN "prodict/dump/_lod_fld.p"(INPUT-OUTPUT minimum-index).
        end.
	
        IF AVAILABLE widx AND imod <> ? THEN 
        DO:
            /*run adecomm/_valname.p (widx._Index-name, INPUT true, OUTPUT okay).
            if NOT okay then
               LEAVE.*/
            RUN "prodict/dump/_lod_idx.p"(INPUT-OUTPUT minimum-index).
        END.

        IF AVAILABLE wseq AND imod <> ? THEN
        DO:
            /*run adecomm/_valname.p (wseq._Seq-name, INPUT true, OUTPUT okay).
            if NOT okay then
               LEAVE.*/
            RUN "prodict/dump/_lod_seq.p".
        END. 
        
        IF AVAILABLE wcon AND imod <> ? THEN
        DO:
	    /*run adecomm/_valname.p (wcon._Con-name, INPUT true, OUTPUT okay).
            if NOT okay then
               LEAVE.*/
            RUN "prodict/dump/_lod_con.p"(INPUT-OUTPUT minimum-index).
        END.

        /* make sure we found both encryption and cipher settings (unless it was
          'encryption no', in which case we don't have a cipher).
        */
        IF encryptOpts[1] NE encryptOpts[2] THEN DO:
           ierror = 65.
        END.

        /* Error occurred when trying to save data from last command */
        IF ierror > 0 AND ierror <> 50 THEN DO:
          /* A client error occured and has been shown to the user.  They have
             selected to leave on first error so get out */
          IF ierror = 100 THEN UNDO,LEAVE load_loop.          
          RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
          RUN Show_Error ("prev").
          IF user_env[4] BEGINS "y":u THEN UNDO,LEAVE load_loop. 
          ierror = 0.
        END.
        ELSE IF ierror = 50 THEN DO:
         DO w = 1 TO NUM-ENTRIES(iwarnlst):
           ASSIGN iwarn = INTEGER(ENTRY(w, iwarnlst)).           
           IF iwarn = 23 THEN warn_text[23] = SUBSTITUTE(warn_text[23],wfld._Field-name,iarg).
           ELSE IF iwarn = 24 THEN warn_text[24] = SUBSTITUTE(warn_text[24],wfld._Field-name,iarg).
           ELSE IF iwarn = 25 THEN warn_text[25] = SUBSTITUTE(warn_text[25],wfld._Field-name,iarg).
           ELSE LEAVE.
           RUN Show_error ("prev").
         END.
         ASSIGN ierror = 0.
        END.
  
        /* delete temp file contents to start a new for this command */
        FOR EACH wdbs: DELETE wdbs. END.
        FOR EACH wfil: DELETE wfil. END.
        FOR EACH wfit: DELETE wfit. END.
        FOR EACH wfld: DELETE wfld. END.
        FOR EACH wflt: DELETE wflt. END.
        FOR EACH widx: DELETE widx. END.
        FOR EACH wixf: DELETE wixf. END.
        FOR EACH wseq: DELETE wseq. END.
        FOR EACH wcon: DELETE wcon. END.

        ASSIGN
          /* set to new file if logging/parsing to manage new indexes and fields of new files */ 
          cNewfile = ""
          icomponent = 0
          iprimary   = FALSE
          inoerror   = FALSE
          imod       = ?
          iobj       = ?
          inum       = 3
          encryptOpts = NO.
           /* set the action mode */
        CASE ilin[1]:
          WHEN "ADD":u    OR WHEN "CREATE":u OR WHEN "NEW":u  THEN imod = "a":u.
          WHEN "UPDATE":u OR WHEN "MODIFY":u OR WHEN "ALTER":u OR WHEN "CHANGE":u
                                                            THEN imod = "m":u.
          WHEN "DELETE":u OR WHEN "DROP":u OR WHEN "REMOVE":u THEN imod = "d":u.
          WHEN "RENAME":u                                     THEN imod = "r":u.
        end case.
    
        /* set the object type */
        CASE ilin[2]:
          WHEN "DATABASE":u OR WHEN "CONNECT":u THEN iobj = "d":u.
          WHEN "FILE":u     OR WHEN "TABLE":u   THEN iobj = "t":u.
          WHEN "FIELD":u    OR WHEN "COLUMN":u  THEN iobj = "f":u.
          WHEN "INDEX":u    OR WHEN "KEY":u     THEN iobj = "i":u.
          WHEN "SEQUENCE":u                     THEN iobj = "s":u.
          WHEN "CONSTRAINT":u                   THEN iobj = "c":u.
        end case.

        IF iobj = "t" AND ilin[4] = "TYPE" AND gate_dbtype <> ilin[5] THEN 
        DO:  /* table of foreign DB: type mismatch */
            ASSIGN
              error_text[30] = substitute(error_text[30],_Db._Db-type)
              ierror         = 30
              user_env[4]    = "yes". /* to prevent 2. error-message at end */ 
            CREATE wfil. /* to be used in show-error */
            RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
            RUN Show_Error ("curr").
            UNDO,LEAVE load_loop. /* no sense to continue */
        END.        /* table of foreign DB: type mismatch */
        
       /* OE00176833
          we separate the following in its own sub-transaction because we may have 
          saved the changes for the previous object above, and in case there is an 
          error with the one we are about to process, we don't want to undo the 
          stuff done above. If the user chose to commit on errors, we would've lost
          the changes to that object too, which is not what we want to do.
       */
       ASSIGN got-error = YES.

       start_obj:
       DO ON ERROR UNDO, LEAVE:

        IF iobj = ? THEN DO:
          /* may be ADD [UNIQUE] [PRIMARY] [INACTIVE] INDEX name */
            IF CAN-DO("INDEX,KEY":u,ilin[3]) THEN
            ASSIGN
              iobj    = "i":u
              ilin[3] = ilin[4]  /* set name into slot 3 */
              ilin[4] = ilin[2]. /* move other opt[s] to end */
          ELSE
          IF CAN-DO("INDEX,KEY",ilin[4]) THEN
            ASSIGN
              iobj    = "i"
              ilin[4] = ilin[3]  /* move other opt[s] to end */
              ilin[3] = ilin[5]  /* set name into slot 3 */
              ilin[5] = ilin[2]. /* move other opt[s] to end */
          ELSE
          IF CAN-DO("INDEX,KEY",ilin[5]) THEN
            ASSIGN
              iobj    = "i"
              ilin[5] = ilin[3]  /* move other opt[s] to end */
              ilin[3] = ilin[6]  /* set name into slot 3 */
              ilin[6] = ilin[2]. /* move other opt[s] to end */
          END.
  
        /* complain */
        IF imod = ? THEN ierror = 1.  /* "Unknown action" */
        IF iobj = ? THEN ierror = 2.  /* "Unknown object" */
        IF ierror > 0 AND ierror <> 50 THEN UNDO,LEAVE start_obj.
  
        /* Reinitialize the buffers.  e.g., for add set the name of the
           object.  For modify, copy the existing record into the buffer.
           if working on a field or index, find the corresponding _File
           record as well.
        */    
        IF iobj = "d" THEN CREATE wdbs.
        IF iobj = "t" THEN CREATE wfil.
        IF iobj = "f" THEN CREATE wfld.
        IF iobj = "i" THEN CREATE widx.
        IF iobj = "s" THEN CREATE wseq.
        IF iobj = "c" THEN CREATE wcon.

        IF iobj = "d" THEN DO: /* start database action block */
          IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
            DISPLAY
              (IF ilin[3] = "?" THEN user_dbname ELSE ilin[3]) @ wdbs._Db-name
              "" @ wfil._File-name  "" @ wfld._Field-name
              "" @ widx._Index-name "" @ wseq._Seq-Name
              WITH FRAME working.
          IF imod = "a" THEN
            wdbs._Db-name = ilin[3].
          ELSE DO:
            IF ilin[3] = "?" THEN
              /* Comparing to the string value "?" fails whereas
                   comparing against the unknown value works.
              */
              FIND FIRST _Db WHERE _Db._Db-name = ? NO-ERROR.
            ELSE
              FIND FIRST _Db WHERE _Db._Db-name = ilin[3] NO-ERROR.
            IF NOT AVAILABLE _Db THEN DO:
              ASSIGN  wdbs._Db-name = ilin[3].
              ierror = 3. /* "Try to modify unknown &2" */
              UNDO,LEAVE start_obj.
              END.
              { prodict/dump/copy_dbs.i &from=_Db &to=wdbs }
            END.
          IF AVAILABLE _Db THEN drec_db = RECID(_Db).

        END. /* end database action block */
   
        IF iobj = "s" THEN DO: /* start sequence action block */
          IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
            DISPLAY 
              user_dbname @ wdbs._Db-name
              "" @ wfil._File-name  "" @ wfld._Field-name
              "" @ widx._Index-name ilin[3] @ wseq._Seq-Name
              WITH FRAME working.
          IF imod = "a" THEN DO:
            IF KEYWORD(ilin[3]) <> ? THEN DO:
              ASSIGN wseq._Seq-Name = ilin[3]
                     ierror = 45.
              UNDO, LEAVE start_obj.
            END.
            ELSE
              ASSIGN wseq._Seq-Name = ilin[3].
          END.          
          ELSE DO:
            FIND FIRST _Sequence WHERE _Sequence._Seq-Name = ilin[3] NO-ERROR.
             /* if we are parsing then the renamed table exists in the parser and not in the db  */
            if  imod <> "r" and not available _Sequence and valid-object(dictLoader) and dictLoader:isReader then
            do:
              cRenamed = dictLoader:SequenceOldName(ilin[3]).            
              if cRenamed > "" then
                 FIND FIRST _Sequence WHERE _Sequence._Seq-Name = cRenamed NO-ERROR.    
            end.  
            
            IF NOT AVAILABLE _Sequence THEN DO:    
              ASSIGN wseq._Seq-name = ilin[3].
              ierror = 3. /* "Try to modify unknown &2" */
              UNDO,LEAVE start_obj.             
            END.   
            IF imod = "r" THEN DO:
              IF KEYWORD(ilin[5]) <> ? THEN DO:
                ASSIGN wseq._Seq-Name = ilin[3]
                       ierror = 45.
                UNDO, LEAVE start_obj.
              END.
            END.
            { prodict/dump/copy_seq.i &from=_Sequence &to=wseq }
            END.
        END. /* end sequence action block */
                              
        /* position _file record */
        IF (iobj = "d" OR iobj = "s") OR (imod = "a" AND iobj = "t") THEN .
        ELSE DO:
          scrap = ?.
          IF iobj = "t"                   THEN scrap = ilin[3].
          ELSE IF CAN-DO("OF,ON",ilin[4]) THEN scrap = ilin[5].
          ELSE IF CAN-DO("OF,ON",ilin[5]) THEN scrap = ilin[6].
          ELSE IF CAN-DO("OF,ON",ilin[6]) THEN scrap = ilin[7].
          ELSE IF CAN-DO("OF,ON",ilin[7]) THEN scrap = ilin[8].
             
          IF scrap = ? THEN .
          ELSE
          IF AVAILABLE _Db THEN DO:
            IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
              FIND _File OF _Db WHERE _File._File-name = scrap 
                                  AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
            ELSE 
              FIND _File OF _Db WHERE _File._File-name = scrap NO-ERROR.
          END.
          ELSE DO:
            IF INTEGER(DBVERSION(user_dbname)) > 8 THEN
               FIND FIRST _File WHERE _File._File-name = scrap 
                            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
            ELSE
               FIND FIRST _File WHERE _File._File-name = scrap NO-ERROR.
          END.  
          /* if we are parsing then the renamed table exists in the parser and not in the db  */
          if not (iobj = "t" and imod = "r") and not available _file and valid-object(dictLoader) and dictLoader:isReader then
          do:
              cRenamed = dictLoader:TableOldName(scrap).            
              if cRenamed > "" then
                 find  _File where _File._File-name = cRenamed
                              and (_File._Owner = "PUB" or _File._Owner = "_FOREIGN") no-error.    
          end.  
             
          IF AVAILABLE _File AND NOT AVAILABLE _Db THEN DO:
            FIND _Db OF _File.
            drec_db = RECID(_Db).
          END.
          
          IF scrap <> ? then
          do: 
             if AVAILABLE _File THEN 
                 drec_file = RECID(_File).
                 /* if parsing log the filename. We check if it really is a new file further down 
                    where the file of index and field is validated */
             else if valid-object(dictLoader) and dictLoader:isReader 
             and imod = "a" and (iobj = "f" or iObj = "i") then
                 cNewFile = scrap.      
          end.              
        END.
  
        IF iobj = "t" THEN DO: /* start file action block */
          IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
            DISPLAY user_dbname @ wdbs._Db-name
                    ilin[3] @ wfil._File-name "" @ wfld._Field-name 
                    "" @ widx._Index-name "" @ wseq._Seq-Name
                      WITH FRAME working.
          IF imod = "a" THEN DO:
            IF KEYWORD(ilin[3]) <> ? THEN DO:
                ASSIGN wfil._File-name = ilin[3]
                       ierror = 45.
                UNDO, LEAVE start_obj.
            END.
            ELSE
                ASSIGN wfil._File-name = ilin[3].
          END.
          ELSE DO:
            IF NOT AVAILABLE _File THEN DO:
              ASSIGN wfil._File-name = ilin[3].
              ierror = 3. /* "Try to modify unknown &2" */
              UNDO,LEAVE start_obj.
            END.
            IF imod = "r" THEN DO:
              IF KEYWORD(ilin[5]) <> ? THEN DO:
                ASSIGN wfil._File-name = ilin[3] 
                       ierror = 45.
                UNDO, LEAVE start_obj.
              END.
            END.
            { prodict/dump/copy_fil.i &from=_File &to=wfil &all=true}

            FOR EACH _File-trig OF _File:
              CREATE wfit.
              { prodict/dump/copy_fit.i &from=_File-trig &to=wfit }
            END.
          END.
        END. /* end file action block */
  
        IF iobj = "f" THEN DO: /* start field action block */
          /* only set if dictLoader:Isreader - see above */
          IF cNewFile > "" then 
          do:
                if not dictLoader:IsNewTable(cNewFile) then 
                do:
                    ierror = 5. /* "try to modify index w/o file" */
                    UNDO,LEAVE start_obj.
                end.
                            
                if cNewFile <> ilin[5] then
                    dictLoader:addError("Data Definition Parser does not understand tokens after field " + wfld._Field-name).   
                dictLoader:AddingChildToNewTable = true.  
          end.    
          else do:
             
              IF NOT AVAILABLE _File AND drec_file <> ? THEN
                FIND _File WHERE drec_file = RECID(_File) NO-ERROR.
              IF NOT AVAILABLE _File THEN DO:
                ierror = 5. /* "Try to modify &2 without file" */
                UNDO,LEAVE start_obj.
              END.
              ELSE IF AVAILABLE _File AND _file._File-name <> ilin[5] THEN
              do:  
                  if not (valid-object(dictLoader) and dictLoader:IsReader 
                          and dictLoader:TableOldName(ilin[5]) = _file._File-name) then
                  do: 
                      FIND _file WHERE _file._file-name = ilin[5]
                                      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
                      IF NOT AVAILABLE _File THEN DO:
                        ierror = 5. /* "Try to modify &2 without file" */
                        UNDO,LEAVE start_obj.
                      END.
                  end.
              end.
              
              if valid-object(dictLoader) and dictLoader:IsReader then
                  dictLoader:AddingChildToNewTable = false.  
   
          end.
          IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
            DISPLAY _File._File-name @ wfil._File-name
                    ilin[3] @ wfld._Field-name 
                    "" @ widx._Index-name
            WITH FRAME working.

          IF imod = "a" THEN DO:
            IF KEYWORD(ilin[3]) <> ? THEN DO:
                ASSIGN wfld._Field-name = ilin[3] 
                       ierror = 45.
                UNDO, LEAVE start_obj.
            END.
            ELSE
              ASSIGN wfld._Field-name = ilin[3]    
                     wfld._Initial    = "". /* to be checkable in _lod_fld */
          END.
          ELSE DO:
            FIND _Field OF _File WHERE _Field._Field-name = ilin[3] NO-ERROR.
            if imod <> "r" and not available _Field and valid-object(dictLoader) and dictLoader:isReader then
            do:
              cRenamed = dictLoader:FieldOldName(_File._File-name,ilin[3]).            
              if cRenamed > "" then
                 FIND _Field OF _File WHERE _Field._Field-name = cRenamed NO-ERROR.    
            end.  
            
            
            IF NOT AVAILABLE _Field THEN DO:
              ASSIGN wfld._Field-name = ilin[3].
              ierror = 3. /* "Try to modify unknown &2" */
              UNDO,LEAVE start_obj.
            END.
            IF imod = "r" THEN DO:
              IF KEYWORD(ilin[7]) <> ? THEN DO:
                ASSIGN wfld._Field-name = ilin[3] 
                       ierror = 45.
                UNDO, LEAVE start_obj.
              END.
            END.

            { prodict/dump/copy_fld.i &from=_Field &to=wfld &all=true}

            FOR EACH _Field-trig OF _Field:
              CREATE wflt.
              { prodict/dump/copy_flt.i &from=_Field-trig &to=wflt }
              END.
            END.
          END. /* end field action block */
  
          IF iobj = "i" THEN DO: /* start index action block */
            /* only set if dictLoader:Isreader  - see above */
            IF cNewFile > "" then 
            do:
                if not dictLoader:IsNewTable(cNewFile) then 
                do:
                    ierror = 5. /* "try to modify index w/o file" */
                    UNDO,LEAVE start_obj.
                end.
                DO k = 4 TO 8:
                    /* @TODO fix this */
                  IF ilin[k] = "ON" and ilin[k + 1] <> cNewFile THEN DO:
                      dictLoader:addError("Data Definition Parser does not understand ON " + ilin[k + 1]  ).           
                      k = 8.
                  end. 
                end.  
                dictLoader:AddingChildToNewTable = true.  
            end.    
            else do:
                IF NOT AVAILABLE _File AND drec_file <> ? THEN
                  FIND _File WHERE drec_file = RECID(_File) NO-ERROR.
                IF NOT AVAILABLE _File THEN DO:
                  ierror = 5. /* "try to modify index w/o file" */
                  UNDO,LEAVE start_obj.
                END.
                ELSE IF AVAILABLE _File THEN DO k = 4 TO 8:
                  IF ilin[k] = "ON" THEN DO:
                    IF _File._File-name <> ilin[k + 1] THEN DO:                  
                      if not (valid-object(dictLoader) and dictLoader:IsReader 
                          and dictLoader:TableOldName(ilin[k + 1]) = _file._File-name) then
                      do: 
                        FIND _File WHERE _File._file-name = ilin[k + 1] 
                                    AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
                      end.
                      ASSIGN k = 8.
                    END.
                  END.
                END.
                IF NOT AVAILABLE _File THEN DO:
                  ierror = 5.  /* "Try to modify &2 without file" */
                  UNDO,LEAVE start_obj.
                END.                
                if valid-object(dictLoader) and dictLoader:IsReader then
                    dictLoader:AddingChildToNewTable = false.  
         
            end.
            
            IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
                DISPLAY _File._File-name @ wfil._File-name
                        "" @ wfld._Field-name
                        ilin[3] @ widx._Index-name 
                WITH FRAME working.
             
            IF imod = "a" THEN DO:
              IF KEYWORD(ilin[3]) <> ? THEN DO:
                ASSIGN widx._Index-name = ilin[3]
                       ierror = 45.
                UNDO, LEAVE start_obj.
              END.
              ELSE           
                 ASSIGN widx._Index-name = ilin[3]
                        widx._Unique     = FALSE. /* different from schema default of TRUE */
              
              
              /* zero by default (seems better than 6?) */
              IF cNewFile > "" then 
                   /* @todo 
                 index-area-number = dictLoader:GetAreaForNewTable(cNewFile).  
                     */
                 index-area-number = 0.
             
              /* if it's a multi-tenant table with keep-default off, set area for index to 
                 zero by default
              */
              else do:
                 If _File._File-Attributes[1] = TRUE /*multi-tenant */
                 AND _File._File-Attributes[2] = FALSE /* no default partition*/ THEN 
                 DO:
                     index-area-number = 0.
                 END.
              END.
            END.
            ELSE DO:
              FIND _Index OF _File WHERE _Index._Index-name = ilin[3] NO-ERROR.
              if imod <> "r" and not available _Index and valid-object(dictLoader) and dictLoader:isReader then
              do:
                   cRenamed = dictLoader:IndexOldName(_File._File-name,ilin[3]). 
                      
                   if cRenamed > "" then
                       FIND _Index OF _File WHERE _Index._Index-name = cRenamed NO-ERROR.    
              end. 
              IF NOT AVAILABLE _Index THEN DO:
                ASSIGN widx._Index-name = ilin[3].
                ierror = 3. /* "Try to modify unknown &2" */
                UNDO,LEAVE start_obj.
              END.
             
              IF imod = "r" THEN DO:
                IF KEYWORD(ilin[5]) <> ? THEN DO:
                  ASSIGN widx._Index-name = ilin[3]
                         ierror = 45.
                  UNDO, LEAVE start_obj.
                END.
              END.

             { prodict/dump/copy_idx.i &from=_Index &to=widx }
           
            END.
          END. /* end index action block */
          
          /* OE#00195067 */
          IF iobj = "c" THEN DO:
            IF cNewFile > "" then 
            do:
                if not dictLoader:IsNewTable(cNewFile) then 
                do:
                    ierror = 5. /* "try to modify index w/o file" */
                    UNDO,LEAVE start_obj.
                end.
                DO k = 4 TO 8:
                    /* @TODO fix this */
                  IF ilin[k] = "ON" and ilin[k + 1] <> cNewFile THEN DO:
                      dictLoader:addError("Data Definition Parser does not understand ON " + ilin[k + 1]  ).           
                      k = 8.
                  end. 
                end.  
                dictLoader:AddingChildToNewTable = true.  
            end.    
            else do:
                IF NOT AVAILABLE _File AND drec_file <> ? THEN
                  FIND _File WHERE drec_file = RECID(_File) NO-ERROR.
                IF NOT AVAILABLE _File THEN DO:
                  ierror = 5. /* "try to modify index w/o file" */
                  UNDO,LEAVE start_obj.
                END.
                ELSE IF AVAILABLE _File THEN DO k = 4 TO 8:
                  IF ilin[k] = "ON" THEN DO:
                    IF _File._File-name <> ilin[k + 1] THEN DO:                  
                      if not (valid-object(dictLoader) and dictLoader:IsReader 
                          and dictLoader:TableOldName(ilin[k + 1]) = _file._File-name) then
                      do: 
                        FIND _File WHERE _File._file-name = ilin[k + 1] 
                                    AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
                      end.
                      ASSIGN k = 8.
                    END.
                  END.
                END.
                IF NOT AVAILABLE _File THEN DO:
                  ierror = 5.  /* "Try to modify &2 without file" */
                  UNDO,LEAVE start_obj.
                END.                
                if valid-object(dictLoader) and dictLoader:IsReader then
                    dictLoader:AddingChildToNewTable = false.  
         
            end.
           
           IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
                DISPLAY _File._File-name @ wfil._File-name
                        "" @ wfld._Field-name
                        "" @ widx._Index-name 
                        ilin[3] @ wcon._Con-Name
                WITH FRAME working.
            
            IF imod = "a" THEN DO:
              IF KEYWORD(ilin[3]) <> ? THEN DO:
                ASSIGN wcon._Con-name = ilin[3]
                       ierror = 45.
                UNDO, LEAVE start_obj.
              END.
              ELSE           
              ASSIGN wcon._Con-name = ilin[3].
            
            END.
            ELSE IF imod = "d" OR imod = "m" THEN DO:
              FIND FIRST _Constraint OF _File where _Constraint._Con-name = ilin[3] NO-LOCK NO-ERROR.
              IF NOT AVAILABLE (_Constraint) THEN DO:
                wcon._Con-Name = ilin[3].
                ierror = 3. /* "Try to modify unknown &2" */
                UNDO,LEAVE start_obj.
              END.
              ELSE 
                wcon._Con-Name = ilin[3].
            END.
          END.  /* end constraint action block */
        ASSIGN got-error = NO.
        END.  /* start_obj block */

        IF got-error THEN
           NEXT load_loop.

      END. /* end of block handling action keyword */

    /* inot - is used for logical keywords that have no argument but where
              the keyword indicates the yes/no value of the field.
       inum - is the number of tokens (keyword plus arguments)  It is set to
              3 above when ilin[1] is the action word (e.g., ADD) and not
              one of the field values (e.g., DATA-TYPE Character)
       ikwd - is the keyword.
       iarg - is the field value.
    */
      IF inum <> 3 THEN
        ASSIGN
          ikwd   = ilin[1]
          iarg   = ilin[2]
          inot   = FALSE
          inum   = 2
          inot   = (ikwd BEGINS "NOT-")
          ikwd   = SUBSTRING(ikwd, IF inot THEN 5 ELSE 1, -1, "CHARACTER")
          inum   = (IF ikwd = "NO-ERROR"
                 OR (iobj = "t" AND CAN-DO("FROZEN,HIDDEN",ikwd))
                 OR (iobj = "f" AND CAN-DO("MAND*,NULL,NULL-A*,CASE-SENS*",ikwd))
                 OR (iobj = "i" AND CAN-DO("UNIQUE,INACTIVE,PRIMARY,WORD",ikwd))
                 THEN 1 ELSE 2)
          iarg   = (IF inum = 2 THEN iarg ELSE (IF inot THEN "no" ELSE "yes")).
  
    /* Load the value from the .df file into the appropriate field
       of the object we're working on.
    */
      IF inum = 3 THEN .
      ELSE IF ikwd = "NO-ERROR" THEN inoerror = TRUE.
      ELSE IF imod = "r" AND ilin[1] = "TO" THEN irename = ilin[2].

      ELSE IF iobj = "d" THEN DO: /*------------- DB-CASE ----------------------*/
  
        CASE ikwd:
          WHEN "DBNAME"  OR WHEN "ADDRESS"     THEN wdbs._Db-addr     = iarg.
          WHEN "PARAMS"  OR WHEN "COMM"        THEN wdbs._Db-comm     = iarg.
          WHEN "CONNECT" OR WHEN "DATABASE"    THEN wdbs._Db-name     = iarg.
          WHEN "TYPE"                          THEN wdbs._Db-type     = iarg.
          WHEN "DB-MISC11"                     THEN wdbs._Db-misc1[1] = INTEGER(iarg).
          WHEN "DB-MISC12"                     THEN wdbs._Db-misc1[2] = INTEGER(iarg).
          WHEN "DB-MISC13"                     THEN wdbs._Db-misc1[3] = INTEGER(iarg).
          WHEN "DB-MISC14"                     THEN wdbs._Db-misc1[4] = INTEGER(iarg).
          WHEN "DB-MISC15"                     THEN wdbs._Db-misc1[5] = INTEGER(iarg).
          WHEN "DB-MISC16"                     THEN wdbs._Db-misc1[6] = INTEGER(iarg).
          WHEN "DB-MISC17"                     THEN wdbs._Db-misc1[7] = INTEGER(iarg).
          WHEN "DB-MISC18"                     THEN wdbs._Db-misc1[8] = INTEGER(iarg).
          WHEN "DRIVER-NAME"                   THEN wdbs._Db-misc2[1] = iarg.
          WHEN "DRIVER-VERS"                   THEN wdbs._Db-misc2[2] = iarg.
          WHEN "ESCAPE-CHAR"                   THEN wdbs._Db-misc2[3] = iarg.
          WHEN "DRIVER-CHARS"                  THEN wdbs._Db-misc2[4] = iarg.
          WHEN "DBMS-VERSION"                  THEN wdbs._Db-misc2[5] = iarg.
          WHEN "DSRVR-VERSION"                 THEN wdbs._Db-misc2[6] = iarg.
          WHEN "PROGRESS-VERSION"              THEN wdbs._Db-misc2[7] = iarg.
          WHEN "DSRVR-MISC"                    THEN wdbs._Db-misc2[8] = iarg.
          WHEN "COLLATION-TRANSLATION-VERSION" THEN DO:
            /* Store the first part of the version e.g., 2.0 in collate[5].
               The whole version format is m.n-x
            */
            ASSIGN
                   ct_version = iarg
                   ix         = INDEX(ct_version, "-").
            orig_vers = wdbs._Db-collate[5].
            IF SUBSTR(ct_version, 1, ix - 1, "CHARACTER") >= "6.0" THEN DO:
              user_env[4] = "y". /* stop the load - db will be corrupted. */
              ierror = 27.
            END.
            ASSIGN
                   ix                             = INDEX(ct_version, ".")
                   wdbs._Db-collate[5]            = raw_val /* to replace ?, if there */
                   PUTBYTE(wdbs._Db-collate[5],1) = 
                            INTEGER(SUBSTR(ct_version, 1, ix - 1, "CHARACTER"))
                   ix                             = ix + 1
                   len                            = INDEX(ct_version, "-") - ix
                   PUTBYTE(wdbs._Db-collate[5],2) = 
                            INTEGER(SUBSTR(ct_version, ix, len, "CHARACTER")).
            IF orig_vers <> wdbs._Db-collate[5] THEN ct_changed = yes.
          END.
          WHEN     "TRANSLATION-NAME"   
           OR WHEN "CODEPAGE-NAME"            THEN wdbs._Db-xl-name = iarg.
          WHEN "COLLATION-NAME"               THEN wdbs._Db-coll-name = iarg.
          WHEN "INTERNAL-EXTERNAL-TRAN-TABLE" THEN 
                                           RUN Load_Tran_Collate_Tbl ("_Db-xlate", 1).
          WHEN "EXTERNAL-INTERNAL-TRAN-TABLE" THEN 
                                           RUN Load_Tran_Collate_Tbl ("_Db-xlate",2).
          WHEN "CASE-INSENSITIVE-SORT"        THEN
                                           RUN Load_Tran_Collate_Tbl ("_Db-collate",1).
          WHEN "CASE-SENSITIVE-SORT"          THEN
                                           RUN Load_Tran_Collate_Tbl ("_Db-collate",2).
          WHEN "UPPERCASE-MAP"                THEN 
                                           RUN Load_Tran_Collate_Tbl ("_Db-collate",3).
          WHEN "LOWERCASE-MAP"                THEN 
                                           RUN Load_Tran_Collate_Tbl ("_Db-collate",4).
          WHEN "ICU-RULES"                THEN
            IF SUBSTRING(ct_version,1,2) <> "5." THEN
              ASSIGN ierror = 4.
            ELSE DO:
              j = 0.
              DO i = 29 TO 32:
                j = j * 256 + GET-BYTE(wdbs._DB-collate[1],  i).
              END.
                                               
              RUN Load_Icu_Rules ( INPUT-OUTPUT j ) .
              IF RETURN-VALUE NE "" THEN ierror = 40.
              ELSE DO:
                IF cerror = "no-convert" THEN 
                  INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
                ELSE 
                  INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP
                          CONVERT SOURCE codepage TARGET SESSION:CHARSET.
                REPEAT:
                  IMPORT UNFORMATTED ILIN[1].
                  IF TRIM(ILIN[1]) = "END-RULES" THEN LEAVE.
                END.
                ILIN[1] = ?.
              END.

            END.
 
          OTHERWISE
            ASSIGN ierror = 4. /* "Unknown &2 keyword" */
          END CASE.
  
        END. /*-------------------------------------------------------------------*/
      ELSE IF iobj = "s" THEN DO: /*--------------------------------------------*/
  
        CASE ikwd:
          WHEN "SEQUENCE"       THEN wseq._Seq-Name = iarg.
          /* Supports keyword alone as true */
          WHEN "MULTITENANT"    THEN wseq._Seq-Attributes[1] = if iarg = ? or iarg = "" 
                                                               then true 
                                                               else logical(iarg).
          WHEN "INITIAL"        THEN do:
              /* this is just to catch an integer overflow */
              IF is-pre-101b-db THEN
                 ASSIGN wseq._Seq-Init = INT(IARG) NO-ERROR.
              ELSE
                 ASSIGN wseq._Seq-Init = INT64(IARG) NO-ERROR.

              IF ERROR-STATUS:ERROR THEN
                  ASSIGN ierror = 53.
              ELSE
                 ierror = 0.

          END.
          WHEN "INCREMENT"      THEN DO: 

              /* this is just to catch an integer overflow */
              IF is-pre-101b-db THEN
                 ASSIGN wseq._Seq-Incr = INT(IARG) NO-ERROR.
              ELSE
                 ASSIGN wseq._Seq-Incr = INT64(IARG) NO-ERROR.

              IF ERROR-STATUS:ERROR THEN
                  ASSIGN ierror = 53.
              ELSE
                 ierror = 0.

          END.
          WHEN "CYCLE-ON-LIMIT" THEN wseq._Cycle-Ok = (iarg = "yes").
          WHEN "MIN-VAL"        THEN DO: 
              /* this is just to catch an integer overflow */
              IF is-pre-101b-db THEN
                 ASSIGN wseq._Seq-Min = INT(IARG) NO-ERROR.
              ELSE
                 ASSIGN wseq._Seq-Min = INT64(IARG) NO-ERROR.

              IF ERROR-STATUS:ERROR THEN
                  ASSIGN ierror = 53.
              ELSE
                 ierror = 0.
          END.
          WHEN "MAX-VAL"        THEN DO:
              /* this is just to catch an integer overflow */
              IF is-pre-101b-db THEN
                 ASSIGN wseq._Seq-Max = INT(IARG) NO-ERROR.
              ELSE
                 ASSIGN wseq._Seq-Max = INT64(IARG) NO-ERROR.

              IF ERROR-STATUS:ERROR THEN
                  ASSIGN ierror = 53.
              ELSE
                 ierror = 0.
          END.
          WHEN "FOREIGN-NAME"   THEN wseq._Seq-Misc[1] = iarg.
          WHEN "FOREIGN-OWNER"  THEN wseq._Seq-Misc[2] = iarg.
          /* keywords for seq-misc elements 3-8 */ 
          WHEN "SEQ-MISC3"      THEN wseq._Seq-Misc[3] = iarg.
          WHEN "SEQ-MISC4"      THEN wseq._Seq-Misc[4] = iarg.
          WHEN "SEQ-MISC5"      THEN wseq._Seq-Misc[5] = iarg.
          WHEN "SEQ-MISC6"      THEN wseq._Seq-Misc[6] = iarg.
          WHEN "SEQ-MISC7"      THEN wseq._Seq-Misc[7] = iarg.
          WHEN "SEQ-MISC8"      THEN wseq._Seq-Misc[8] = iarg.

          OTHERWISE ierror = 4. /* "Unknown &2 keyword" */
        END CASE.
  
      END. /*-------------------------------------------------------------------*/
      ELSE IF iobj = "t" THEN DO: /*--------------------------------------------*/ 
        CASE ikwd:
          WHEN    "FILE" OR WHEN "TABLE" THEN 
              wfil._File-name    = iarg.
          WHEN    "MULTITENANT"     THEN DO:
              /* no second parameter means yes  */
              wfil._File-Attributes[1] = if iarg = ? or iarg = "" then true else logical(iarg).
              IF wfil._File-Attributes[1] then
              ASSIGN wfil._File-Attributes[2] = true.    
				
          END.
          WHEN    "NO-DEFAULT-AREA" THEN DO:
              wfil._File-Attributes[2] = false.
              file-area-number = 0. /* make sure previous area is not used */
                      
          END.
          WHEN    "AREA"            THEN DO:
             
             /* area in multitenant is signal that keep default area is true*/
             if wfil._File-Attributes[1] then
                wfil._File-Attributes[2] = true.
             
             ASSIGN iarg = ""
                    j    = 2.
             _areatloop:
             DO WHILE TRUE:
               IF ilin[j] = ? OR ilin[j] = "" THEN DO:
                 ASSIGN iarg = SUBSTRING(iarg, 1, (LENGTH(iarg) - 1))
                        ilin = "".
                 LEAVE _areatloop.
               END.
               ELSE 
                 ASSIGN iarg = iarg + ilin[j] + " "
                        j = j + 1.
             END.           
             FIND _AREA WHERE _Area._Area-name = iarg NO-LOCK NO-ERROR.
             IF AVAILABLE _Area THEN   
                 ASSIGN file-area-number   = _Area._Area-number.
             ELSE
                 ASSIGN ierror = 31.                
          END.           
          WHEN    "CAN-CREATE"
          OR WHEN "CAN-INSERT"     THEN wfil._Can-Create   = iarg.
          WHEN    "CAN-READ"
          OR WHEN "CAN-SELECT"     THEN wfil._Can-Read     = iarg.
          WHEN    "CAN-WRITE"
          OR WHEN "CAN-UPDATE"     THEN wfil._Can-Write    = iarg.
          WHEN    "CAN-DELETE"     THEN wfil._Can-Delete   = iarg.
          WHEN    "CAN-DUMP"       THEN wfil._Can-Dump     = iarg.
          WHEN    "CAN-LOAD"       THEN wfil._Can-Load     = iarg.
          WHEN    "TYPE"           THEN wfil._Db-lang      = LOOKUP(iarg,"SQL").
          WHEN    "LABEL"          THEN wfil._File-Label   = iarg.
          WHEN    "LABEL-SA"       THEN wfil._File-Label-SA = iarg. 
          WHEN    "DESCRIPTION"    THEN wfil._Desc         = iarg.
          WHEN    "VALEXP"         THEN wfil._Valexp       = TRIM(iarg).
          WHEN    "VALMSG"         THEN wfil._Valmsg       = iarg.
          WHEN    "VALMSG-SA"      THEN wfil._Valmsg-SA    = iarg.
          WHEN    "FROZEN"         THEN wfil._Frozen       = (iarg = 'yes').
          WHEN    "HIDDEN"         THEN wfil._Hidden       = (iarg = 'yes').
          WHEN    "DUMP-NAME"      THEN DO:
              /* check that there are no spaces in the dump name */
              IF INDEX(iarg, " ") > 0 THEN
                ASSIGN ierror = 54.
              ELSE
                wfil._Dump-name    = iarg.
          END.
          WHEN    "CATEGORY" THEN wfil._category    = iarg.
          WHEN    "FOREIGN-FLAGS"  THEN wfil._For-Flag     = INTEGER(iarg).
          WHEN    "FOREIGN-FORMAT" THEN wfil._For-Format   = iarg.
          WHEN    "FOREIGN-GLOBAL" THEN wfil._For-Cnt1     = INTEGER(iarg).
          WHEN    "FOREIGN-ID"     THEN wfil._For-Id       = INTEGER(iarg).
          WHEN    "FOREIGN-LEVEL"  THEN wfil._Fil-misc1[4] = INTEGER(iarg).
          WHEN    "FOREIGN-LOCAL"  THEN wfil._For-Cnt2     = INTEGER(iarg).
          WHEN    "FOREIGN-MARK"   THEN wfil._For-Info     = iarg.
          WHEN    "FOREIGN-NAME"   THEN wfil._For-Name     = iarg.
          WHEN    "FOREIGN-NUMBER" THEN wfil._For-number   = INTEGER(iarg).
          WHEN    "FOREIGN-OWNER"  THEN wfil._For-Owner    = iarg.
          WHEN    "FOREIGN-SIZE"   THEN ASSIGN
                                        wfil._For-Size     = INTEGER(iarg).
          WHEN    "PROGRESS-RECID"  
          OR WHEN "FILE-MISC11"    THEN wfil._Fil-misc1[1] = INTEGER(iarg).
          WHEN    "FOREIGN-SPAN"   THEN wfil._Fil-misc1[2] = LOOKUP(iarg,"yes").
          WHEN    "FILE-MISC12"    THEN wfil._Fil-misc1[2] = INTEGER(iarg).
          WHEN    "INDEX-FREE-FLD"  
          OR WHEN "FILE-MISC13"    THEN wfil._Fil-misc1[3] = INTEGER(iarg).
          WHEN    "OVERLOAD-NR"     
          OR WHEN "RECID-COL-NO"     
          OR WHEN "FILE-MISC14"    THEN wfil._Fil-misc1[4] = INTEGER(iarg).
          WHEN    "FILE-MISC15"    THEN wfil._Fil-misc1[5] = INTEGER(iarg).
          WHEN    "FILE-MISC16"    THEN wfil._Fil-misc1[6] = INTEGER(iarg).
          WHEN    "FILE-MISC17"    THEN wfil._Fil-misc1[7] = INTEGER(iarg).
          WHEN    "FILE-MISC18"    THEN wfil._Fil-misc1[8] = INTEGER(iarg).
          WHEN    "FOREIGN-TYPE"   THEN wfil._For-Type     = iarg.
          WHEN    "QUALIFIER"       
          OR WHEN "FILE-MISC21"    THEN wfil._Fil-misc2[1] = iarg.
          WHEN    "HIDDEN-FLDS"     
          OR WHEN "FILE-MISC22"    THEN wfil._Fil-misc2[2] = iarg.
          WHEN    "RECID-FLD-NAME"  
          OR WHEN "FILE-MISC23"    THEN wfil._Fil-misc2[3] = iarg.
          WHEN    "FLD-NAMES-LIST"  
          OR WHEN "FILE-MISC24"    THEN wfil._Fil-misc2[4] = iarg.
          WHEN    "FILE-MISC25"    THEN wfil._Fil-misc2[5] = iarg.
          WHEN    "FILE-MISC26"    THEN wfil._Fil-misc2[6] = iarg.
          WHEN    "FILE-MISC27"    THEN wfil._Fil-misc2[7] = iarg.
          WHEN    "DB-LINK-NAME"    
          OR WHEN "FILE-MISC28"    THEN wfil._Fil-misc2[8] = iarg.
          WHEN    "FILE-TRIGGER"
          OR WHEN "TABLE-TRIGGER"  THEN DO:
                FIND FIRST wfit WHERE wfit._Event = iarg NO-ERROR.
                IF NOT AVAILABLE wfit THEN CREATE wfit.
                wfit._Event = ilin[2].
                CASE ilin[3]:
                  WHEN    "DELETE"
                  OR WHEN "DROP"
                  OR WHEN "REMOVE"      THEN wfit._Proc-Name = "!":u.
                  WHEN    "OVERRIDE"    THEN wfit._Override  = TRUE.
                  WHEN    "NO-OVERRIDE" THEN wfit._Override  = FALSE.
                  end case.
                IF ilin[4] = "PROCEDURE":u THEN wfit._Proc-Name = ilin[5].
                IF ilin[6] = "CRC" THEN wfit._Trig-CRC = 
                  (IF ilin[7] = ? THEN ? ELSE INTEGER(ilin[7])).
                ilin = ?.
                END.
          WHEN    "ENCRYPTION" 
          OR WHEN "ENCRYPT"
          OR WHEN "CIPHER-NAME" THEN DO:
              /* this will raise error if something is wrong */
              RUN checkEPolicy.
              RUN addEncryptionSetting("table", iKwd , iarg).
          END.
          WHEN "BUFFER-POOL" THEN DO:
              /* this will raise error if something is wrong */
              RUN checkObjAttrs.
              RUN addBufferPoolSetting("table", iKwd , iarg).
          END.
          
          OTHERWISE ierror = 4. /* "Unknown &2 keyword" */
        END CASE.  
      END. /*-------------------------------------------------------------------*/
      ELSE IF iobj = "f" THEN DO: /*--------------------------------------------*/
  
        CASE ikwd:
          WHEN    "AS" OR WHEN "TYPE" THEN 
              ASSIGN wfld._Data-type = (IF iarg = "boolean" THEN "logical"
                               ELSE IF iarg = "dbkey"   THEN "recid" 
                               ELSE iarg).                     
          WHEN    "FIELD"     OR WHEN "COLUMN"      THEN wfld._Field-name = iarg.
          WHEN    "DESC"      OR WHEN "DESCRIPTION" THEN wfld._Desc = iarg.
          WHEN    "INITIAL"   OR WHEN "DEFAULT"     THEN DO:
              /* check for integer overflow */
              IF LOOKUP(wfld._Data-Type,"INT,INTEGER") > 0 THEN DO:
                  /* if this is a pre-101b db, just make sure initial
                     value for an integer is not too big. In theory,
                     this could not happen since a field needs to be int64
                     to overflow an integer, and we already prevent int64 from
                     loading into a pre-10.1B db, but just in case the .df
                     was manually changed.
                  */
                  IF is-pre-101b-db THEN DO:
                      /* this is just to catch an integer overflow */
                     ASSIGN ierror = INT(iarg) NO-ERROR.
                     IF ERROR-STATUS:ERROR THEN
                         ASSIGN ierror = 52.
                     ELSE
                         ierror = 0.
                  END.
              END.

              wfld._Initial = iarg.
          END.
          WHEN    "CAN-READ"  OR WHEN "CAN-SELECT"  THEN wfld._Can-Read = iarg.
          WHEN    "CAN-WRITE" OR WHEN "CAN-UPDATE"  THEN wfld._Can-Write = iarg.
          WHEN    "NULL" OR WHEN "NULL-ALLOWED" THEN wfld._Mandatory = (iarg = "no").
          WHEN    "SQL-WIDTH" OR WHEN "MAX-WIDTH" OR WHEN "LOB-BYTES" THEN DO:
             wfld._Width = INTEGER(iarg).
             IF LOOKUP(wfld._Data-Type,"CHARACTER,CHAR,DECIMAL,DEC,RAW") > 0 OR
             wfld._Extent > 0 THEN
                IF INTEGER(iarg) > 31995 THEN
                   ASSIGN ierror = 50
                          iwarn  = {&WARN_MSG_SQLW}
                          warn_message = SUBSTITUTE(warn_text[{&WARN_MSG_SQLW} + 1],wfld._Field-name,iarg).
          END.
          WHEN "LOB-AREA" THEN DO:
            /* Area names can have space*/
            ASSIGN iarg = ""
                    j    = 2.
            _areafloop:
            DO WHILE TRUE:
              IF ilin[j] = ? OR ilin[j] = "" THEN DO:
                ASSIGN iarg = SUBSTRING(iarg, 1, (LENGTH(iarg) - 1))
                       ilin = "".
                LEAVE _areafloop.
              END.
              ELSE 
                ASSIGN iarg = iarg + ilin[j] + " "
                       j = j + 1.
            END.     
            FIND _AREA WHERE _Area._Area-name = iarg NO-LOCK NO-ERROR.
            IF AVAILABLE _Area THEN   
                 ASSIGN wfld._Fld-stlen   = _Area._Area-number.
              ELSE
                 ASSIGN ierror = 31. 
          END.
          WHEN    "CLOB-CODEPAGE"          THEN wfld._Charset = iarg.
          WHEN    "CLOB-COLLATION"         THEN wfld._Collation = iarg.
          WHEN    "CLOB-TYPE"              THEN wfld._Attributes1 = INTEGER(iarg).
          WHEN    "FORMAT"                 THEN wfld._Format = iarg.
          WHEN    "FORMAT-SA"              THEN wfld._Format-SA = iarg.
          WHEN    "LABEL"                  THEN wfld._Label = iarg.
          WHEN    "LABEL-SA"               THEN wfld._Label-SA = iarg.
          WHEN    "COLUMN-LABEL"           THEN wfld._Col-label = iarg.
          WHEN    "COLUMN-LABEL-SA"        THEN wfld._Col-label-SA = iarg.
          WHEN    "INITIAL-SA"             THEN wfld._Initial-SA = iarg.
          WHEN    "POSITION"               THEN wfld._Field-rpos = INTEGER(iarg).
          WHEN    "VALEXP"                 THEN wfld._Valexp = TRIM(iarg).
          WHEN    "VALMSG"                 THEN wfld._Valmsg = iarg.
          WHEN    "VALMSG-SA"              THEN wfld._Valmsg-SA = iarg.
          WHEN    "VIEW-AS"                THEN wfld._View-As = iarg.
          WHEN    "HELP"                   THEN wfld._Help = iarg.
          WHEN    "HELP-SA"                THEN wfld._Help-SA = iarg.
          WHEN    "EXTENT"                 THEN wfld._Extent = INTEGER(iarg).
          WHEN    "DECIMALS"               THEN DO:
              wfld._Decimals      = INTEGER(iarg).

              /*  20041202-001  allow .df to contain DECIMALS ? for any data type 
                 which is the default value for non-decimal fields anyway
              */
              IF wfld._Decimals <> ? AND wfld._Data-type <> "decimal" AND wfld._Data-type <> "dec" THEN
                  ASSIGN ierror = 50
                         iwarn  = 25
                         warn_message = SUBSTITUTE(warn_text[25],wfld._Field-name)
                         wfld._Decimals = ?.
          END.
          WHEN "LENGTH" 
          OR WHEN "SCALE"           THEN
          DO:
                  wfld._Decimals      = INTEGER(iarg).
          END.
          WHEN    "FOREIGN-BITS"           THEN wfld._Decimals      = INTEGER(iarg).
          WHEN    "ORDER"                  THEN wfld._Order         = INTEGER(iarg).
          WHEN    "MANDATORY"              THEN wfld._Mandatory     = (iarg = "yes").
          WHEN    "CASE-SENSITIVE"         THEN wfld._Fld-case      = (iarg = "yes").
          WHEN    "FOREIGN-ALLOCATED"      THEN wfld._For-Allocated = INTEGER(iarg).
          WHEN    "FOREIGN-CODE"           THEN wfld._For-Itype     = INTEGER(iarg).
          WHEN    "FOREIGN-ID"             THEN wfld._For-Id        = INTEGER(iarg).
          WHEN    "FOREIGN-MARK"           THEN . /* unused in V7 */
          WHEN    "FOREIGN-MAXIMUM"        THEN wfld._For-Maxsize   = INTEGER(iarg).
          WHEN    "FOREIGN-NAME"           THEN wfld._For-Name      = iarg.
          WHEN    "FOREIGN-POS"            THEN ASSIGN
                                                wfld._Fld-stoff     = INTEGER(iarg)
                                                l_Fld-stoff         = wfld._Fld-stoff.
          WHEN    "FOREIGN-RETRIEVE"       THEN wfld._For-retrieve  = (iarg = "yes").
          WHEN    "FOREIGN-SCALE"          THEN wfld._For-Scale     = INTEGER(iarg).
          WHEN    "FOREIGN-SEP"            THEN wfld._For-Separator = iarg.
          WHEN    "FOREIGN-SIZE"           THEN ASSIGN
                                                wfld._Fld-stlen     = INTEGER(iarg)
                                                l_Fld-stlen         = wfld._Fld-stlen.
          WHEN    "FOREIGN-SPACING"        THEN wfld._For-Spacing   = INTEGER(iarg).
          WHEN    "FOREIGN-TYPE"           THEN DO:

             IF wfld._Data-type = "character" AND wfld._Initial = ""
                AND (iarg = "time" OR iarg = "timestamp") THEN
                wfld._Initial = ?.
             wfld._For-Type = iarg.
          
             END.

          WHEN    "FOREIGN-XPOS"           THEN wfld._For-Xpos      = INTEGER(iarg).
          WHEN    "DSRVR-PRECISION"         
          OR WHEN "FIELD-MISC11"           THEN wfld._Fld-misc1[1]  = INTEGER(iarg).
          WHEN    "DSRVR-SCALE"                    
          OR WHEN "FIELD-MISC12"           THEN wfld._Fld-misc1[2]  = INTEGER(iarg).
          WHEN    "DSRVR-LENGTH"            
          OR WHEN "FIELD-MISC13"           THEN wfld._Fld-misc1[3]  = INTEGER(iarg).
          WHEN    "DSRVR-FLDMISC"            
          OR WHEN "FIELD-MISC14"           THEN wfld._Fld-misc1[4]  = INTEGER(iarg).
          WHEN    "DSRVR-SHADOW"            
          OR WHEN "FIELD-MISC15"           THEN wfld._Fld-misc1[5]  = INTEGER(iarg).
          WHEN    "FIELD-MISC16"           THEN wfld._Fld-misc1[6]  = INTEGER(iarg).
          WHEN    "FIELD-MISC17"           THEN wfld._Fld-misc1[7]  = INTEGER(iarg).
          WHEN    "FIELD-MISC18"           THEN wfld._Fld-misc1[8]  = INTEGER(iarg).
          WHEN    "FIELD-MISC21"  OR
          WHEN    "LOB-SIZE"              THEN wfld._Fld-misc2[1]  = iarg.
          WHEN    "SHADOW-COL"                    
          OR WHEN "FIELD-MISC22"           THEN wfld._Fld-misc2[2]  = iarg.
          WHEN    "QUOTED-NAME"                    
          OR WHEN "FIELD-MISC23"           THEN wfld._Fld-misc2[3]  = iarg.
          WHEN    "MISC-PROPERTIES"         
          OR WHEN "FIELD-MISC24"           THEN wfld._Fld-misc2[4]  = iarg.
          WHEN    "SHADOW-NAME"                    
          OR WHEN "FIELD-MISC25"           THEN wfld._Fld-misc2[5]  = iarg.
          WHEN    "FIELD-MISC26"           THEN wfld._Fld-misc2[6]  = iarg.
          WHEN    "FIELD-MISC27"           THEN wfld._Fld-misc2[7]  = iarg.
          WHEN    "FIELD-MISC28"           THEN wfld._Fld-misc2[8]  = iarg.
          WHEN    "FIELD-TRIGGER"          THEN DO:
                FIND FIRST wflt WHERE wflt._Event = iarg NO-ERROR.
                IF NOT AVAILABLE wflt THEN CREATE wflt.
                wflt._Event = ilin[2].
                CASE ilin[3]:
                  WHEN "DELETE" OR WHEN "DROP" OR WHEN "REMOVE" THEN
                                                wflt._Proc-Name = "!":u.
                  WHEN "OVERRIDE"    THEN wflt._Override = TRUE.
                  WHEN "NO-OVERRIDE" THEN wflt._Override = FALSE.
                  end case.
                IF ilin[4] = "PROCEDURE" THEN wflt._Proc-Name = ilin[5].
                IF ilin[6] = "CRC" THEN wflt._Trig-CRC = 
                  (IF ilin[7] = ? THEN ? ELSE INTEGER(ilin[7])).
                ilin = ?.
                END.
          WHEN    "ENCRYPTION" 
          OR WHEN "ENCRYPT" 
          OR WHEN "CIPHER-NAME" THEN DO:
              /* this will raise error if something is wrong */
              IF LOOKUP(wfld._Data-Type,"BLOB,CLOB") > 0 THEN DO:
                 RUN checkEPolicy.
                 RUN addEncryptionSetting(wfld._Data-Type, iKwd , iarg).
              END.
              ELSE DO:
                  /* invalid for other field types */
                  ierror = 62.
              END.
          END.
          WHEN "BUFFER-POOL" THEN DO:
              /* this will raise error if something is wrong */
              IF LOOKUP(wfld._Data-Type,"BLOB,CLOB") > 0 THEN DO:
                  RUN checkObjAttrs.
                  RUN addBufferPoolSetting(wfld._Data-Type, iKwd , iarg).
              END.
          END.
          OTHERWISE ierror = 4. /* "Unknown &2 keyword" */

        END CASE.
  
      END. /*-------------------------------------------------------------------*/
      ELSE IF iobj = "i" THEN DO: /*--------------------------------------------*/
  
        CASE ikwd:
          WHEN    "INDEX" OR WHEN "KEY" THEN widx._Index-Name = iarg.
          WHEN    "UNIQUE"              THEN widx._Unique     = (iarg = "yes").
          WHEN    "INACTIVE"            THEN widx._Active     = (iarg = "no").
          WHEN    "PRIMARY"             THEN iprimary         = TRUE.
          WHEN    "WORD"                THEN widx._Wordidx    = LOOKUP(iarg,"yes").
          WHEN    "INDEX-NUM"           THEN widx._Idx-num    = INTEGER(iarg).
          WHEN    "AREA"                THEN DO:
             ASSIGN iarg = ""
                    j    = 2.
             _areailoop:
             DO WHILE TRUE:
               IF ilin[j] = ? OR ilin[j] = "" THEN DO:
                 ASSIGN iarg = SUBSTRING(iarg, 1, (LENGTH(iarg) - 1))
                        ilin = "".
                 LEAVE _areailoop.
               END.
               ELSE 
                 ASSIGN iarg = iarg + ilin[j] + " "
                        j = j + 1.
             END.           
             FIND _AREA WHERE _Area._Area-name = iarg NO-LOCK NO-ERROR.
             IF AVAILABLE _Area THEN   
                 ASSIGN 
                     index-area-number   = _Area._Area-number.
 
             ELSE
                 ASSIGN ierror = 31.                
          END.                    
          WHEN    "FOREIGN-LEVEL"       THEN widx._I-misc1[1] = INTEGER(iarg).
          WHEN    "FOREIGN-NAME"        THEN widx._For-name   = iarg.
          WHEN    "FOREIGN-TYPE"        THEN widx._For-type   = iarg.
          WHEN    "RECID-INDEX"         THEN widx._I-misc2[1] = iarg.
          WHEN    "DESC" 
          OR WHEN "DESCRIPTION"         THEN widx._Desc = iarg.
          WHEN    "INDEX-FIELD"
          OR WHEN "KEY-FIELD"           THEN DO:
            IF ilin[2] = ? OR ilin[2] = "" THEN DO:
               ASSIGN ilin = ?.
               NEXT load_loop.
            END.
            /* don't check field errors if parsing */
            if not valid-object(dictLoader) or not dictLoader:IsReader then
            do:
                FIND _Field WHERE _Field._File-recid = drec_file
                        AND _Field._Field-name = ilin[2] NO-ERROR.
                        
                IF imod <> "a":u THEN ierror = 12.
                  /* "Cannot add index field to existing index" */
                IF NOT AVAILABLE _Field THEN ierror = 13.
                  /* "Cannot find field to index" */
                IF ierror > 0 AND ierror <> 50 THEN UNDO,RETRY load_loop.
            end.
            
            CREATE wixf.
            ASSIGN
                  icomponent        = icomponent + 1
                  wixf._Index-Seq   = icomponent
                  wixf._Field-recid = RECID(_Field)
                  wixf._Ascending   = TRUE.
                IF ilin[3] BEGINS "DESC":u OR ilin[4] BEGINS "DESC":u
                  OR ilin[5] BEGINS "DESC":u THEN wixf._Ascending  = FALSE.
                IF ilin[3] BEGINS "ABBR":u OR ilin[4] BEGINS "ABBR":u
                  OR ilin[5] BEGINS "ABBR":u THEN wixf._Abbreviate = TRUE.
                IF ilin[3] BEGINS "UNSO":u OR ilin[4] BEGINS "UNSO":u
                  OR ilin[5] BEGINS "UNSO":u THEN wixf._Unsorted   = TRUE.
                ilin = ?.
                END.
          WHEN    "ENCRYPTION"
          OR WHEN "ENCRYPT"
          OR WHEN "CIPHER-NAME" THEN DO:
             /* this will raise error if something is wrong */
             RUN checkEPolicy.
             RUN addEncryptionSetting("index", iKwd , iarg).
          END.
          WHEN "BUFFER-POOL" THEN DO:
              /* this will raise error if something is wrong */
              RUN checkObjAttrs.
              RUN addBufferPoolSetting("index", iKwd , iarg).
          END.
          OTHERWISE ierror = 4. /* "Unknown &2 keyword" */
        END CASE.
  
      END. /*-------------------------------------------------------------------*/
            /*OE#00195067 */ 
      ELSE IF iobj = "c" THEN DO:
        CASE ikwd:
          WHEN    "CONSTRAINT"          THEN wcon._Con-Name = iarg.
          WHEN    "PRIMARY"             THEN wcon._Con-Type = "P".
          WHEN    "PRIMARY-CLUSTERED"   THEN wcon._Con-Type = "PC".          
          WHEN    "UNIQUE"              THEN wcon._Con-Type = "U".
          WHEN    "CLUSTERED"           THEN wcon._Con-Type = "M".
          WHEN    "CHECK"               THEN wcon._Con-Type = "C".
          WHEN    "DEFAULT"             THEN wcon._Con-Type = "D".
          WHEN    "FOREIGN-KEY"         THEN wcon._Con-Type = "F".
          WHEN    "CONSTRAINT-EXPR"     THEN wcon._Con-Expr = iarg.
          WHEN    "CONSTRAINT-ACTION"   THEN wcon._Con-Misc2[1] = iarg.
          WHEN    "PARENT-TABLE"        
          THEN DO:
                   ASSIGN parent-table = iarg.
          END.         
          WHEN    "PARENT-INDEX"
          THEN DO:
            FIND FIRST _File WHERE _File._File-Name = parent-table NO-LOCK NO-ERROR.
              FIND FIRST _Constraint WHERE _Constraint._File-Recid = RECID(_File) AND ( _Constraint._Con-Type = "P" OR
                 _Constraint._Con-Type = "PC" OR _Constraint._Con-Type = "MP" OR _Constraint._Con-Type = "U") NO-LOCK NO-ERROR.
                 IF AVAILABLE (_Constraint) THEN 
                  FIND FIRST _Index WHERE _Index._Index-Name = iarg NO-ERROR.
                     wcon._Index-Parent-Recid = RECID(_Index).
          END.
          WHEN    "ACTIVE"              THEN wcon._Con-Active = TRUE.
          WHEN    "INACTIVE"            THEN wcon._Con-Active = FALSE.                  
          WHEN    "CONSTRAINT-INDEX"    
          THEN DO:
            FIND FIRST _Index WHERE _Index._Index-Name = iarg and _Index._File-Recid = drec_file NO-LOCK NO-ERROR.
            IF NOT AVAILABLE(_Index) THEN .
            ELSE wcon._Index-Recid = RECID(_Index).
          END.        
          
          WHEN    "CONSTRAINT-FIELD"  
          THEN DO:
            FIND FIRST _Field WHERE _Field._Field-name = iarg and _Field._File-Recid = drec_file NO-LOCK NO-ERROR.
            IF AVAILABLE (_Field ) THEN 
               wcon._Field-Recid = RECID(_Field).
          END.
        END.  
      END.
      IF ierror > 0 AND ierror <> 50 THEN UNDO,RETRY load_loop.
      
      ASSIGN stopped = false.

    END.  /* end repeat load_loop*/
  END.  /* end stop */
   
  IF stopped THEN
     RUN adecomm/_setcurs.p ("").
  
  ELSE DO:  /* all but last definition-set executed */
    IF do-commit OR (NOT (ierror > 0 AND user_env[4] BEGINS "y":u)) THEN
    finish: 
    DO ON STOP UNDO,LEAVE:

      ASSIGN stopped = TRUE.

      /* Copy any remaining buffer values to the database */
      RUN adecomm/_setcurs.p ("WAIT").

      IF AVAILABLE wdbs AND imod <> ? THEN 
      DO:
         RUN "prodict/dump/_lod_dbs.p".
         IF imod <> "d" and drec_db <> RECID(_Db) THEN 
            FIND _Db WHERE RECID(_Db) = drec_db.
      END.

      IF AVAILABLE wfil AND imod <> ? THEN do:
   	 /* run adecomm/_valname.p (wfil._File-name, INPUT true, OUTPUT okay).
          if NOT okay then
             LEAVE.*/

          RUN "prodict/dump/_lod_fil.p".
      end.

      IF AVAILABLE wfld AND imod <> ? THEN do:
      	  /*run adecomm/_valname.p (wfld._Field-name, INPUT true, OUTPUT okay).
          if NOT okay then
             LEAVE.*/
          RUN "prodict/dump/_lod_fld.p"(INPUT-OUTPUT minimum-index).
      end.

      IF AVAILABLE widx AND imod <> ? THEN do:
      	  /*run adecomm/_valname.p (widx._Index-name, INPUT true, OUTPUT okay).
          if NOT okay then
             LEAVE.*/
          RUN "prodict/dump/_lod_idx.p"(INPUT-OUTPUT minimum-index).
      end.

      IF AVAILABLE wseq AND imod <> ? THEN
      do: 
    	 /*run adecomm/_valname.p (wseq._Seq-name, INPUT true, OUTPUT okay).
         if NOT okay then
            LEAVE.*/
          RUN "prodict/dump/_lod_seq.p".
      end.      
      IF AVAILABLE wcon AND imod <> ? THEN
      DO:
      	    /*run adecomm/_valname.p (wcon._Con-name, INPUT true, OUTPUT okay).
            if NOT okay then
               LEAVE.*/
            RUN "prodict/dump/_lod_con.p"(INPUT-OUTPUT minimum-index).
      END.     
      /* make sure we found both encryption and cipher settings (unless it was
        'encrypt no', in which case we don't have a cipher).
      */
      IF encryptOpts[1] NE encryptOpts[2] THEN DO:
         ierror = 65.
      END.
 
      RUN adecomm/_setcurs.p ("").

      /* Error occurred when trying to save data from last command? */
      IF ierror > 0 AND ierror <> 50 THEN DO:
        RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
        RUN Show_Error ("prev").
        IF user_env[4] BEGINS "y":u THEN LEAVE finish.
      END.
      ELSE IF ierror = 50 THEN DO:
         DO w = 1 TO NUM-ENTRIES(iwarnlst):
           ASSIGN iwarn = INTEGER(ENTRY(w, iwarnlst)).
           IF iwarn = 23 THEN warn_text[23] = SUBSTITUTE(warn_text[23],wfld._Field-name,iarg).
           ELSE IF iwarn = 24 THEN warn_text[24] = SUBSTITUTE(warn_text[24],wfld._Field-name,iarg).
           ELSE LEAVE.
           RUN Show_error ("prev").
         END.          
         ASSIGN ierror = 0.
      END.
      
      IF ct_changed AND NOT xerror THEN 
         MESSAGE "The .df file just loaded contains translation or" SKIP
                 "collation tables that are different from the ones" SKIP
                 "that were already in the database." SKIP(1)
                       "You will not be able to use this database in any" SKIP
                       "way until you rebuild its indices."
               VIEW-AS ALERT-BOX WARNING BUTTONS OK.
       
      RUN adecomm/_setcurs.p ("WAIT").

      RUN "prodict/dump/_lodfini.p".

      ASSIGN stopped = false.
    END.  /* finish: on stop undo,leave*/    
  END.     /* all but last definition-set executed */

  /* Make sure we reset ourselves back to the current database. */
  IF sav_drec <> drec_db
    THEN ASSIGN
       user_dbname = sav_dbnam
       user_dbtype = sav_dbtyp
       drec_db     = sav_drec.

  INPUT CLOSE.
  HIDE MESSAGE NO-PAUSE.

  IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
  DO:  /* TERMINAL <> "" */

    HIDE FRAME working NO-PAUSE.
    IF do-commit AND xerror THEN DO:      
      ASSIGN do-commit = FALSE
             showedCommitMsg = YES.
      MESSAGE "There have been errors encountered in the loading of this df and " SKIP
              "you have selected to commit the transaction anyway. " SKIP(1)
              "Are you sure you want to commit with missing information? " SKIP (1)
            VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE do-commit.
     
      IF NOT do-commit THEN 
        MESSAGE msg2 VIEW-AS ALERT-BOX ERROR.
      ELSE
        ASSIGN xerror = FALSE.
    END.
    ELSE IF NOT (xerror OR stopped OR xwarn) THEN DO:
       if not valid-object(dictLoader) then
       do:
           IF CURRENT-WINDOW:MESSAGE-AREA = yes THEN 
               MESSAGE msg1.
           ELSE DO:
               DISPLAY msg1 WITH FRAME working2.
               pause 10.
           END.
       end.
    END.
    ELSE IF CURRENT-WINDOW:MESSAGE-AREA = yes THEN
      
      IF user_env[19] = "" THEN DO:
          IF xerror OR stopped THEN 
          MESSAGE msg2 VIEW-AS ALERT-BOX ERROR.
          IF user_env[6] = "f" OR user_env[6] = "b" THEN
            MESSAGE msg3 dbload-e msg4 VIEW-AS ALERT-BOX INFORMATION.
      END.
      ELSE
      DO:
          /* 20041202-001
             don't display this if only warnings occurred 
          */
         IF xerror OR STOPPED THEN
            MESSAGE msg2noalert.
         
         MESSAGE msg3 dbload-e msg4.

         PAUSE.
      END.
        
  END.     /* TERMINAL <> "" and not dictloader */
  /* batch or dictloader avoid undo if force commit */ 
  else if do-commit then  
      xerror = false.
  
  /* If stopped = true and iError = 0 a STOP has been raised above   
     (if iError <> 0 then the error is managed and already shown). 
     Throw an AppError to handle the STOP in the CATCH at end of the 
     transaction here or in caller prodict/load_df.p. */
  if stopped and (iError = 0 or iError = 23) then 
  do: 
     oAppError = new Progress.Lang.AppError().
     /* Get the error message - use proc defined in prohelp/msgs.i 
       (_msg(1) has the error since STOP is not affected by the CATCH) */
     if _msg(1) > 0 then
     do:
        run GetMessageDescription(_msg(1),output cStopMessage).    
        oAppError:AddMessage(entry(1,cStopMessage,chr(10)),_msg(1)). 
     end.
     else
        oAppError:AddMessage("Input file is empty or invalid." ,?). 

     undo, throw oAppError.
  end. 
  
  HIDE FRAME backout  NO-PAUSE.
  HIDE FRAME working2 NO-PAUSE.
  HIDE MESSAGE no-pause.
  
  RUN adecomm/_setcurs.p ("").
  
  SESSION:IMMEDIATE-DISPLAY = no.
  IF (xerror OR stopped) THEN
  do: 
/*                                                                           */
/*      message "valid dictloader" valid-object(dictLoader)                  */
/*      view-as alert-box.                                                   */
/*      if valid-object(dictLoader) then                                     */
/*      do on error undo, throw:                                             */
/*          dictLoader:AddError (msg2noalert).                               */
/*          dictLoader:AddError (msg3 + " " + quoter(dbload-e) + " " + msg4).*/
/*      end.                                                                 */
      undo, leave.  
  end.
  
  /* Catch unmanaged errors and the AppError used to wrap STOP errors above
     and show message and/or output to file.  
     Added as fix for OE00196232 (error 997), but should in principle 
     handle any error and replaces the old fix for 20020129-017 (error 151)
     and OE00193991 (_msg issues and STOP error 15262). */
  catch e as Progress.Lang.Error:
      run showLoadError(e).
  end catch.
END.     /* do for ... transaction */

  catch e as Progress.Lang.Error:
      run showLoadError(e).
  end catch.
end. /* end of new DO ON ERROR UNDO LEAVE */

IF (xerror OR NOT main_trans_success) THEN 
DO:
   ASSIGN user_path = "9=h,4=error,_usrload":u.
END.
ELSE IF (VALID-OBJECT(dictEPolicy) AND NOT dictObjAttrCache AND hasEncPol) OR 
        (VALID-OBJECT(dictObjAttrs) AND NOT dictObjAttrCache AND hasBufPool) THEN DO:

    DO TRANSACTION ON ERROR UNDO, LEAVE:

        DEFINE VARIABLE cObjNameErr AS CHAR NO-UNDO.

        /* we only get here if there are policies to be saved and we have a
           valid encryption policy object, and when this isn't called from
           prodict/load_df.p.
        */
        DEFINE BUFFER my_Db FOR DICTDB._Db.
        
        ASSIGN STOPPED = YES
               msg5 = "".
        
        DO ON STOP UNDO, LEAVE:
            /* try to get the schema lock again as soon as possible since we lost it
               when the transaction above ended
            */
            FIND FIRST my_Db WHERE RECID(my_Db) = drec_db.
            
            IF VALID-OBJECT(dictEPolicy) AND hasEncPol THEN DO:
                /* Now we can try to save the policy records if there are any */
                /* We wait until here, so that we can start a new transaction. That is because
                   if there are new tables/blobs/indexes created, their object number won't
                   get assigned by core until the end of the transaction. So we can't
                   create the objects and the policies in the same transaction.
                */
                if not valid-object(dictLoader) then
                do: 
                    ASSIGN msg5 = "Saving encryption policies...".
                    
                    IF CURRENT-WINDOW:MESSAGE-AREA = yes THEN
                        MESSAGE msg5.
                    ELSE
                        DISPLAY msg5 WITH FRAME encryptlog.
            
                    msg5 = "".
                end.
                /* now we should be outside the main transaction. If not, new tables/index/fields
                   will not have been assigned with the object number.
                   We pass the handle of this procedure so that secErrorCallback gets called back
                   when an error happens.
                */
                encryptOpts[1] =  dictEPolicy:cacheSavePolicy(INPUT THIS-PROCEDURE,
                                                              OUTPUT cObjNameErr).
            
                IF NOT encryptOpts[1] THEN DO:
                   RUN Show_Phase2_Error ("Cannot enable encryption for " + cObjNameErr 
                                          + ". Make sure there is no "
                                          + "transaction active when the load process is initiated.",
                                          "e").
                END.
            END.

            /* if all is well so far, ot user selected to commit on error, check for buffer pool
               settings.
            */
            IF (do-commit OR NOT xerror) AND VALID-OBJECT(dictObjAttrs) AND hasBufPool THEN DO:

                if not valid-object(dictLoader) then
                do: 
                    ASSIGN msg5 = "Saving buffer pool settings...".
                    
                    IF CURRENT-WINDOW:MESSAGE-AREA = yes THEN
                        MESSAGE msg5.
                    ELSE
                        DISPLAY msg5 WITH FRAME encryptlog.
            
                    msg5 = "".
                end.
                /* now we should be outside the main transaction. If not, new tables/index/fields 
                   will not have been assigned with the object number.
                   We pass the handle of this procedure so that secErrorCallback gets called back
                   when an error happens.
                */
                IF NOT dictObjAttrs:cacheSaveSettings(INPUT THIS-PROCEDURE,
                                                      OUTPUT cObjNameErr) THEN DO:
                   RUN Show_Phase2_Error ("Cannot set buffer pool for " + cObjNameErr 
                                          + ". Make sure there is no "
                                          + "transaction active when the load process is initiated.",
                                          "b").
                END.
            END.

            STOPPED = NO.
        END. /* do on stop */
    
        IF TERMINAL <> "" and not valid-object(dictLoader) THEN 
        DO:

          IF do-commit AND xerror AND NOT stopped THEN DO:      
            IF NOT showedCommitMsg THEN DO:
                ASSIGN do-commit = FALSE.
                MESSAGE "The schema definitions were committed successfully but there" SKIP
                        "have been errors encountered during the second phase of the load" SKIP
                        "process (for encryption policies and/or buffer pool settings)" SKIP
                        "and you have selected to commit the transaction even with errors. " SKIP(1)
                        "Are you sure you want to commit the second phase with missing information? " SKIP (1)
                      VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE do-commit.
            END.                                                                

            IF NOT do-commit THEN DO:
               RUN Show_Phase2_Error(error_text[68] + CHR(10) + error_text[69],"a").
            END.
            ELSE
              ASSIGN xerror = FALSE.
          END.
          ELSE IF (xerror OR stopped) AND CURRENT-WINDOW:MESSAGE-AREA = yes THEN DO:
            IF user_env[19] = "" THEN DO:
                IF xerror OR stopped THEN DO:
                   RUN Show_Phase2_Error(error_text[68] + CHR(10) + error_text[69],"a").
                END.
                    
                IF user_env[6] = "f" OR user_env[6] = "b" THEN
                   MESSAGE msg3 dbload-e msg4 VIEW-AS ALERT-BOX INFORMATION.
            END.
            ELSE
            DO:
                /* 20041202-001
                   don't display this if only warnings occurred 
                */
               IF xerror OR STOPPED THEN
                  MESSAGE error_text[68] CHR(10) error_text[69].

               MESSAGE msg3 dbload-e msg4.

               PAUSE.
            END.
          END.
        END.     /* TERMINAL <> "" */
          /* terminal = "" or dictloader avoid undo if force commit */ 
        else if do-commit then
            xerror = false.
           
        IF (xerror OR stopped) THEN 
            undo, leave.

        FINALLY: /* DO TRANS */
    
           HIDE FRAME encryptlog NO-PAUSE.
           HIDE MESSAGE no-pause.
    
        END FINALLY.

    END. /* DO TRANS */

    IF (xerror OR stopped) THEN 
        ASSIGN user_path = "9=h,4=error_objattrs,_usrload":u.
END.

/* this only gets instantiated if there is some encryption setting in the .df.
   Unless the load was aborted, we only delete it if dictObjAttrCache is not set,
   which gets set by load_df.p.
*/
IF VALID-OBJECT(dictEPolicy) AND 
    ((xerror OR stopped) OR (NOT dictObjAttrCache))  THEN
  DELETE OBJECT dictEPolicy.

IF VALID-OBJECT(dictObjAttrs) AND 
    ((xerror OR stopped) OR (NOT dictObjAttrCache))  THEN
  DELETE OBJECT dictObjAttrs.

/* ASSIGN ? to all the _db-records, that have interims-value of
 * SESSION:CHARSET ASSIGNed to _db-xl-name, because they had no
 * codepage-name entry in the .df-file
 */
FOR EACH s_ttb_fake-cp:
  FIND FIRST _Db WHERE RECID(_Db) = s_ttb_fake-cp.db-recid.
  ASSIGN
    _db._db-xl-name = ?
    ierror          = 44
    imod            = "cp"
    iobj            = "cp" + _db._db-name.
  RUN Put_Header (INPUT dbload-e, INPUT-OUTPUT hdr).
  RUN Show_Error ("prev").
  delete s_ttb_fake-cp.
END.

RETURN.

/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _lodseqs.p - load _Sequence file from _Seqvals.d and set w/ CURRENT-VALUE 

  History:  D. McMann 08/08/02  Eliminated any sequences whose name begins "$" - Peer Direct
            fernando  05/25/06  Added support for large sequences
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE cerror    AS CHARACTER           NO-UNDO.
DEFINE VARIABLE codepage  AS CHARACTER           NO-UNDO init "UNDEFINED".
DEFINE VARIABLE i         AS INTEGER             NO-UNDO.
DEFINE VARIABLE lvar      AS CHARACTER EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#     AS INTEGER             NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE newAppCtx AS LOGICAL   INIT NO   NO-UNDO.
 
RUN adecomm/_setcurs.p ("WAIT").
RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
OUTPUT TO VALUE(tmpfile) NO-MAP NO-ECHO NO-MAP.

/* NOTE: now we have to check for overflow errors. Since we may be loading
   sequence values into 32-bit and 64-bit sequences, the overflow is different
   for each one of them (int X int64). So now we import and call current-value()
   with the NO-ERROR clause and check for errors.
*/
PUT UNFORMATTED
  'DEFINE VARIABLE seqname   AS CHARACTER NO-UNDO.' SKIP
  'DEFINE VARIABLE seqnumber AS CHARACTER NO-UNDO.' SKIP
  'DEFINE VARIABLE seqvalue  AS INT64     NO-UNDO.' SKIP
  'REPEAT:' SKIP
  '  IMPORT seqnumber seqname seqvalue NO-ERROR.' SKIP
  '  IF ERROR-STATUS:ERROR THEN DO:' SKIP
  '     IF SESSION:WINDOW-SYSTEM NE "TTY" THEN' SKIP
  '        MESSAGE "Error loading value for " seqname ": "' SKIP
  '        ERROR-STATUS:GET-MESSAGE(1) VIEW-AS ALERT-BOX ERROR.' 
  '     ELSE ' SKIP
  '         MESSAGE "Error loading value for " seqname ": "' SKIP
  '         ERROR-STATUS:GET-MESSAGE(1).' 
  '  END.' SKIP
  '  IF INDEX(seqname,".") = 0 THEN seqname = "' LDBNAME(user_dbname)
    '." + seqname.' SKIP
  '  CASE seqname:' SKIP.
FOR EACH _Sequence WHERE _Sequence._Db-recid = drec_db
                     AND NOT _Sequence._Seq-name BEGINS "$" NO-LOCK:
  PUT UNFORMATTED 
    '    WHEN "' LDBNAME(user_dbname) '.' _Sequence._Seq-Name '" THEN DO:' SKIP
    '      CURRENT-VALUE(' _Sequence._Seq-Name ',' LDBNAME(user_dbname)
      ') = seqvalue NO-ERROR.' SKIP
      '     IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 1 THEN DO:' SKIP
      '      IF SESSION:WINDOW-SYSTEM NE "TTY" THEN' SKIP
      '         MESSAGE "Error loading value for ' _Sequence._Seq-Name ': "' SKIP
      '         ERROR-STATUS:GET-MESSAGE(1) VIEW-AS ALERT-BOX ERROR.' 
      '      ELSE ' SKIP
      '         MESSAGE "Error loading value for ' _Sequence._Seq-Name ': "' SKIP
      '         ERROR-STATUS:GET-MESSAGE(1).' 
      '     END.' SKIP
      SKIP
      'END.' SKIP.
END.
PUT UNFORMATTED
  '    OTHERWISE DO:' SKIP
  '      IF SESSION:WINDOW-SYSTEM NE "TTY" THEN' SKIP
  '        MESSAGE "_Seqvals.d had a value of" seqvalue "for" seqname "but no sequence was found with a matching name." VIEW-AS ALERT-BOX ERROR.' SKIP
  '      ELSE DO:' SKIP
  '        MESSAGE "_Seqvals.d had a value of" seqvalue "for" seqname.' SKIP
  '        MESSAGE "but no sequence was found with a matching name.".' SKIP
  '      END.' SKIP
  '    END.' SKIP
  '  END CASE.' SKIP
  'END.' SKIP
  'RETURN.' SKIP.
OUTPUT CLOSE.

/***** Don't need this right now...
{prodict/dump/lodtrail.i
  &file    = "user_env[2]"
  &entries = " " 
  }  /* read trailer, sets variables: codepage and cerror */
*/

/* auditing - start a new application context so that one can report
all the records that are loaded as a group.
*/
IF AUDIT-CONTROL:APPL-CONTEXT-ID = ? THEN DO:
 ASSIGN newAppCtx = YES.
 AUDIT-CONTROL:SET-APPL-CONTEXT("Data Administration", "Load Sequence Current Values", "").
END.

ASSIGN codepage = user_env[10]. /* codepage set in _usrload.p */
IF codepage <> "UNDEFINED" AND SESSION:CHARSET <> ? THEN
   ASSIGN cerror = CODEPAGE-CONVERT("a",SESSION:CHARSET,codepage).
ELSE ASSIGN cerror = "no-convert".

IF cerror = ?
 THEN DO:  /* conversion needed but NOT possible */

  OS-DELETE VALUE(tmpfile).
  run adecomm/_setcurs.p ("").
  MESSAGE "Sequence values NOT loaded." 
       	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK. 

  END.     /* conversion needed but NOT possible */

 ELSE DO:  /* conversion not needed OR needed and possible */

  if cerror = "no-convert"
   then INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
   else INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP
               CONVERT SOURCE codepage TARGET SESSION:CHARSET.

  RUN VALUE(tmpfile).

  INPUT CLOSE.

  OS-DELETE VALUE(tmpfile).
  run adecomm/_setcurs.p ("").

  /* auditing of application data */
  AUDIT-CONTROL:LOG-AUDIT-EVENT(10214, 
                                PDBNAME("dictdb") + "._sequence" /* db-name.table-name */, 
                                "" /* detail */).

  MESSAGE "Load of sequence values completed."
          VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

  END.     /* conversion not needed OR needed and possible */

  /* for auditing - clear the application context, if we have set one */
  IF newAppCtx THEN
     AUDIT-CONTROL:CLEAR-APPL-CONTEXT.

RETURN.
/***********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* loadsylk 

  fernando   06/20/07  Support for large files
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE recs   AS INT64   INITIAL 0. /*UNDO*/
DEFINE NEW SHARED VARIABLE errs   AS INTEGER           NO-UNDO.
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE fil-d  AS CHARACTER         NO-UNDO.

DEFINE            VARIABLE bad-sylk  AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE            VARIABLE i         AS INTEGER               NO-UNDO.
DEFINE		  VARIABLE tmpfile_i AS CHARACTER     	      NO-UNDO.
DEFINE		  VARIABLE tmpfile_o AS CHARACTER     	      NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 8 NO-UNDO INITIAL [
  /*  1*/ "File Not In Standard SYLK Format",
  /*  2*/ "records in SYLK format loaded into",
  /*  3*/ "There was one error encountered during the translation.",
  /*  4*/ "It is listed in the error file",
  /*5,6*/ "There were", "errors encountered during the translation.",
  /*  7*/ "They are listed in the error file",
  /*  8*/ "Can only load SYLK definitions into a {&PRO_DISPLAY_NAME} database."
].

FORM HEADER
   " Importing.  Press " + 
   KBLABEL("STOP") + " to terminate import process. " format "x(60)"
   WITH FRAME importing CENTERED ROW 5 USE-TEXT.


FIND _File WHERE _File._File-name = "sylk" 
             AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
IF AVAILABLE _File THEN
  FIND _Field "x" OF _File WHERE _Extent = 255 NO-ERROR.

bad-sylk = NOT AVAILABLE _File OR NOT AVAILABLE _Field.
IF bad-sylk AND user_dbtype <> "PROGRESS" THEN DO:
  PAUSE 0.
  MESSAGE new_lang[8] /* not PROGRESS database so can't create 'sylk' file */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.
IF bad-sylk THEN DO:
  MESSAGE "The SYLK system table is either missing from the schema" SKIP 
          "of the database, or is incorrect for the current version" SKIP
          "of the dictionary." SKIP
          "Should the proper definitions be loaded in so that the SYLK" SKIP
          "conversion may continue?"
      	  VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE bad-sylk.
  IF NOT bad-sylk THEN DO:
    user_path = "".
    RETURN.
  END.
  run adecomm/_setcurs.p ("WAIT").
  RUN "prodict/_dctsylk.p".
  run adecomm/_setcurs.p ("").
  user_path = "*C,_lodsylk".
  RETURN.
END.
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

RUN "adecomm/_tmpfile.p" (INPUT "i", INPUT ".adm", OUTPUT tmpfile_i).
RUN "adecomm/_tmpfile.p" (INPUT "o", INPUT ".adm", OUTPUT tmpfile_o).
RUN "prodict/misc/osquoter.p" (user_env[4],?,?,tmpfile_i).

/* create PROGRESS readable file */
run adecomm/_setcurs.p ("WAIT").
SESSION:IMMEDIATE-DISPLAY = yes.
PAUSE 0 BEFORE-HIDE.
RUN "prodict/misc/_runsylk.i" (INPUT tmpfile_i, INPUT tmpfile_o).
PAUSE BEFORE-HIDE.

/* create and run import program */
  
/* user_env[1]=filename, 
   user_env[6]=fieldnames, 
   user_env[10]=disable trigger flag
*/
OUTPUT STREAM loaderr TO VALUE(user_env[1] + ".e") NO-ECHO.
INPUT FROM VALUE(tmpfile_o) NO-ECHO NO-MAP.
CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.

VIEW FRAME importing.

DO ON STOP UNDO, LEAVE:
  RUN "prodict/misc/_runload.i" (INPUT user_env[10])
       VALUE(user_env[1]) 100 100 user_env[6] 0.
END.

HIDE frame importing NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
INPUT CLOSE.
OUTPUT STREAM loaderr CLOSE.
run adecomm/_setcurs.p ("").

IF errs = 0 THEN DO:
  MESSAGE recs new_lang[2] user_env[1] /* records loaded */
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  OS-DELETE VALUE(user_env[1] + ".e").
END.
ELSE 
  MESSAGE recs new_lang[2] user_env[1] SKIP /* recs loaded */
      	  new_lang[IF errs = 1 THEN 3 ELSE 5] 
      	  (IF errs = 1 THEN "" ELSE STRING(errs) + " " + new_lang[6]) SKIP
          "***" new_lang[IF errs = 1 THEN 4 ELSE 7] user_env[1] + ".e"
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

OS-DELETE VALUE(tmpfile_i) VALUE(tmpfile_o).
RETURN.

/***********************************************************************
* Copyright (C) 2005-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* _loduser.p - load _User file records */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE cerror    AS CHARACTER           NO-UNDO.
DEFINE VARIABLE codepage  AS CHARACTER           NO-UNDO INIT "UNDEFINED".
DEFINE VARIABLE errbyte   AS INTEGER             NO-UNDO.
DEFINE VARIABLE errline   AS INTEGER             NO-UNDO.
DEFINE VARIABLE errs      AS INTEGER             NO-UNDO.
DEFINE VARIABLE fil-e     AS CHARACTER           NO-UNDO.
DEFINE VARIABLE i         AS INTEGER             NO-UNDO.
DEFINE VARIABLE lvar      AS CHARACTER EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#     AS INTEGER             NO-UNDO.
DEFINE VARIABLE nxtstop   AS INTEGER             NO-UNDO.
DEFINE VARIABLE recs      AS INTEGER.             /*UNDO*/
DEFINE VARIABLE newAppCtx AS LOGICAL   INIT NO   NO-UNDO.

IF NOT user_env[2] MATCHES "*~.d"
 THEN DO:
  MESSAGE "File name containing User information must end in ~".d~"."
      	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
  END.

fil-e = SUBSTRING(user_env[2],1,LENGTH(user_env[2]) - 1) + "e".

RUN adecomm/_setcurs.p ("WAIT").

/***** Don't need this right now...
{prodict/dump/lodtrail.i
  &file    = "user_env[2]"
  &entries = " " 
  }  /* read trailer, sets variables: codepage and cerror */
*/

ASSIGN codepage = user_env[10]. /* codepage set in _usrload.p */
IF codepage <> "UNDEFINED" AND SESSION:CHARSET <> ? THEN
     ASSIGN cerror  = CODEPAGE-CONVERT("a",SESSION:CHARSET,codepage).
ELSE ASSIGN cerror = "no-convert".

IF cerror = ?
 THEN DO:  /* conversion needed but NOT possible */

  OS-DELETE VALUE(fil-e).
  RUN adecomm/_setcurs.p ("").
  MESSAGE "_User information NOT loaded." 
       	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK. 

  END.     /* conversion needed but NOT possible */

 ELSE DO:  /* conversion not needed OR needed and possible */

  /* auditing - start a new application context so that one can report
    all the records that are loaded as a group.
  */
  IF AUDIT-CONTROL:APPL-CONTEXT-ID = ? THEN DO:
     ASSIGN newAppCtx = YES.
     AUDIT-CONTROL:SET-APPL-CONTEXT("Data Administration", "Load User Table Contents", "").
  END.

  OUTPUT TO VALUE(fil-e) NO-ECHO.
  IF cerror = "no-convert"
   THEN INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
   ELSE INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP
               CONVERT SOURCE codepage TARGET SESSION:CHARSET.

  REPEAT FOR DICTDB._User ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    IF RETRY
     THEN DO:
      errs = errs + 1.
      PUT UNFORMATTED
        ">> ERROR READING LINE #" errline " (OFFSET=" errbyte ")" SKIP
        "** Tolerable load error rate is: 0%." SKIP
        "** Loading table _User is aborted." SKIP.
      LEAVE.
      END.

    CREATE _User.

    ASSIGN
      errbyte = SEEK(INPUT)
      errline = errline + 1
      recs    = recs + 1.
    IMPORT _User EXCEPT _User._tenantid.
    
    /* Make sure loaded _User record contains a valid domain */
    IF INTEGER(DBVERSION("DICTDB")) > 10 AND _User._Domain-Name <> "" THEN DO:
        FIND dictdb._sec-authentication-domain 
           WHERE dictdb._sec-authentication-domain._domain-name = _User._Domain-Name 
           NO-ERROR.

        IF NOT AVAILABLE dictdb._sec-authentication-domain 
        THEN DO:
             errs = errs + 1.
             PUT UNFORMATTED
                    "User domain """ _User._Domain-Name """ not found." SKIP
                    ">> ERROR READING LINE #" errline " (OFFSET=" errbyte ")" SKIP.
            END.
        ELSE DO:
            /* Make sure loaded _User record contains a valid tenant id */
            IF dictdb._sec-authentication-domain._Tenant-Name <> ? THEN DO:
                FIND dictdb._Tenant 
                   WHERE dictdb._Tenant._Tenant-Name = dictdb._sec-authentication-domain._Tenant-Name
                   NO-ERROR.

                IF NOT AVAILABLE dictdb._tenant THEN DO:
                    errs = errs + 1.
                    PUT UNFORMATTED
                            "Tenant """ dictdb._sec-authentication-domain._Tenant-Name """ not found." SKIP
                            ">> ERROR READING LINE #" errline " (OFFSET=" errbyte ")" SKIP.
                    END.
                END.
            END.  /* end if valid tenant */
        END.  /* end if valid domain */
    END. /* end repeat */

  INPUT CLOSE.
  OUTPUT CLOSE.
  RUN adecomm/_setcurs.p ("").
  
  /* auditing of application data */
  AUDIT-CONTROL:LOG-AUDIT-EVENT(10214, 
                                PDBNAME("dictdb") + "._user" /* db-name.table-name */, 
                                "" /* detail */).

  /* for auditing - clear the application context, if we have set one */
  IF newAppCtx THEN
     AUDIT-CONTROL:CLEAR-APPL-CONTEXT.

  IF errs = 0
   THEN DO:
    OS-DELETE VALUE(fil-e).
    MESSAGE "User information loaded successfully." SKIP
        	  recs "records read."
        	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    END.
   ELSE DO:
    MESSAGE errs "error(s) in loading User information." SKIP
        	  "Error listing contained in file" fil-e SKIP
          	  recs "records read."
        	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    END.

  END.     /* conversion not needed OR needed and possible */

RETURN.


/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/**** Data dictionary Load data definitions Module 

  fernando   06/20/07  Support for large files
****/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* user_env[2] = name of .df file */
 
DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE errs   AS INTEGER NO-UNDO.
DEFINE NEW SHARED VARIABLE recs   AS INT64. /*UNDO*/
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER NO-UNDO.

DEFINE BUFFER   idx-fld   FOR _Index-field.
DEFINE VARIABLE datatype LIKE _Field._Data-type               NO-UNDO.
DEFINE VARIABLE flag       AS CHARACTER FORMAT "x(25)" NO-UNDO.
DEFINE VARIABLE fname      AS CHARACTER                NO-UNDO.
DEFINE VARIABLE i          AS INTEGER                  NO-UNDO.
DEFINE VARIABLE loadview   AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE no-chgs    AS LOGICAL  INITIAL TRUE    NO-UNDO.
DEFINE VARIABLE x_unique   AS CHARACTER                NO-UNDO. /* ix-nam */
DEFINE VARIABLE y_unique   AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE view-files AS CHARACTER EXTENT 3       NO-UNDO INITIAL [
  "_View", "_View-col", "_View-ref"
].

INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP.
IMPORT flag.
INPUT CLOSE.
IF NOT CAN-DO("NEW-FILE,CHG-FILE,REN-FILE,DEL-FILE,FILE",TRIM(flag))
    THEN RETURN.  /* we found a new format .df */
/* we don's support old format for dictLoadOptions:IsLogger (error suppress and no display) */    
else if valid-object(dictLoadOptions) and dictLoadOptions:IsLogger then
do: 
    undo , throw new Progress.Lang.AppError("Old format not supported " + quoter(flag) + ". Use Data Admin utilitites or prodict/load_df.p instead").
end.
  
INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP.
user_path = "*C,9=h,_usrload".

DISPLAY "Loading data definitions for:"
  WITH FRAME namhdr ROW 3 CENTERED
  NO-ATTR-SPACE NO-BOX.

FORM fname FORMAT "x(32)"
  WITH 12 DOWN FRAME nme ROW 4 CENTERED NO-ATTR-SPACE NO-LABELS.

IF TERMINAL <> "" THEN 
  run adecomm/_setcurs.p ("WAIT").

_all1:
DO ON ERROR UNDO, LEAVE:
  ASSIGN
    cache_dirty = TRUE
    no-chgs     = FALSE.
  _fil1:
  REPEAT FOR _File TRANSACTION ON ERROR UNDO _all1, LEAVE:
    PROMPT-FOR flag _File-Name _Can-Create _Can-Read
      _Can-Write _Can-delete _File._Desc _File._Valexp _File._Valmsg
      _File._Frozen _File._Hidden _File._Db-lang _File._Dump-name
      .
    DISPLAY INPUT _File-Name @ fname WITH FRAME nme.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      HIDE MESSAGE.
    END.
    PAUSE 0.
    DOWN WITH FRAME nme.
    flag = TRIM(INPUT flag).
    IF NOT CAN-DO("NEW-FILE,CHG-FILE,REN-FILE,DEL-FILE,FILE",flag)
      THEN DO:
      MESSAGE "An input record starting with" flag "was read,".
      MESSAGE "but a FILE, REN-FILE, NEW-FILE, CHG-FILE or DEL-FILE".
      MESSAGE "was expected.".
      MESSAGE "Processing terminated".
      UNDO _all1, LEAVE.
    END.

    DO ON ERROR UNDO, RETRY:
      IF RETRY THEN DO:
        MESSAGE "Error for file" INPUT _File-name ", process terminated"
      	        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      	user_path = "".
        UNDO _all1, LEAVE.
      END.
      IF flag = "NEW-FILE" 
        THEN DO:

          CREATE _File.
          assign 
            _File._Db-recid    = drec_db
            _File._ianum       = 6
            _File._File-Number = ?.
      END.
      ELSE  /* change, rename or delete */
        FIND _File WHERE _File-name = INPUT _File-name
                     AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").
      IF _File._frozen THEN DO:
        MESSAGE "A CHG-FILE, REN-FILE or DEL-FILE record was read for file"
          _File-name.
        MESSAGE "But that file is frozen".
        MESSAGE "Processing terminated".
        UNDO _all1, LEAVE.
      END.
      IF flag = "DEL-FILE" THEN DO:
        FOR EACH _Index OF _File:
          FOR EACH _Index-Field OF _Index:
            DELETE _Index-Field.
          END.
          DELETE _Index.
        END.
        FOR EACH _Field OF _File:
          DELETE _Field.
        END.
        DELETE _File.
        NEXT _fil1.
      END.
      ELSE IF flag = "REN-FILE" THEN DO:
        _File-name = INPUT _can-create.
        NEXT _fil1.
      END.
      ELSE IF flag = "NEW-FILE" OR flag = "CHG-FILE" THEN DO:
        ASSIGN _File-name _Can-Create _File._Can-Read _File._Can-Write
          _Can-delete _File._Desc _File._Valexp _File._Valmsg _File._Hidden
          _File._Dump-name.
      END.

      /* To allow reordering of fields, we must temporarily change */
      /* all existing _Field._Order, otherwise we can get duplicates */
      /* during the update-process   */
      REPEAT:
        FIND FIRST _Field OF _File WHERE _Order > 0 NO-ERROR.
        IF NOT AVAILABLE _Field THEN LEAVE.
        _Field._Order = _Field._Order - 10000.
      END.
    END. /* end ON ERROR UNDO, RETRY */

    REPEAT ON ERROR UNDO _all1, LEAVE:  /* Field */
      PROMPT-FOR flag _Field-Name datatype _Decimals
        _Format FORMAT "x(60)" _Initial _Field._Label _Mandatory _Order
        _Field._Can-Read _Field._Can-Write _Extent _Field._Valexp
        _Field._Valmsg _Field._Help _Field._Desc _Col-label _Fld-case
      	.
      flag = TRIM(INPUT flag).
      IF NOT CAN-DO("NEW-FIELD,CHG-FIELD,REN-FIELD,DEL-FIELD",flag)
        THEN DO:
        MESSAGE "An input record starting with" flag "was read,".
        MESSAGE "But a NEW-FIELD, CHG-FIELD, REN-FIELD or DEL-FIELD".
        MESSAGE "record was expected".
        MESSAGE "Processing terminated".
        UNDO _all1, LEAVE.
      END.   /* Wrong record-type  */
      ASSIGN datatype.

      IF datatype = "boolean" THEN datatype = "logical".
      ELSE IF datatype = "dbkey" THEN datatype = "recid".

      IF flag = "NEW-FIELD" THEN DO:
        CREATE _Field.
        _Field._File-recid = RECID(_File).
        _Field-Name        = INPUT _Field-name.
        _data-type         = datatype.
        ASSIGN _extent.
      END.
      ELSE FIND _Field OF _File
        WHERE _Field-Name = INPUT _Field-name NO-ERROR.
      IF flag = "DEL-FIELD" THEN DO:
        FOR EACH _Index-field OF _Field:
          FIND _Index OF _Index-field.
          FOR EACH idx-fld OF _Index:
            DELETE idx-fld.
          END.
          DELETE _Index.
        END.
        DELETE _Field.
      END.
      ELSE IF flag = "REN-FIELD" THEN
        _Field-name = datatype.
      ELSE DO:   /* CHG or NEW */
        IF _Data-type <> datatype OR _Extent <> INPUT _Extent THEN DO:
          MESSAGE "You can not change data-type or extent for field"
            _File-name + "." + _Field-name.
          UNDO _all1, LEAVE.
        END.
        ASSIGN _Decimals _Format
          _Initial _Field._Label _Mandatory _Order _Field._Can-Read
          _Field._Can-Write  _Field._Valexp
          _Field._Valmsg _Field._Help _Field._Desc _Col-label _Fld-case.
      END.
    END.
    _indx1:
    REPEAT ON ERROR UNDO _all1, LEAVE:    /* Index */
      PROMPT-FOR flag _Index-Name x_Unique _Active.
      flag = TRIM(INPUT flag).
      IF NOT CAN-DO("NEW-INDEX,REN-INDEX,CHG-INDEX,DEL-INDEX,INDEX",flag)
        THEN DO:
        MESSAGE "An input record starting with" flag "was read,".
        MESSAGE "But an NEW-INDEX, REN-INDEX, CHG-INDEX or DEL-INDEX".
        MESSAGE "record was expected".
        MESSAGE "Processing terminated".
        UNDO _all1, LEAVE.
      END.

      y_unique = (INPUT x_unique = "yes").

      IF flag = "INDEX" THEN NEXT _indx1.
      ELSE IF flag = "NEW-INDEX" THEN DO:
        CREATE _Index.
        assign 
          _Index._File-recid = RECID(_File) 
          _Index._Idx-num    = ?
          _Index._ianum      = 6.
        ASSIGN _Index-Name _active.
        _unique = y_unique.
      END.
      ELSE
         FIND _Index  OF _File WHERE _Index-name = INPUT _Index-name NO-ERROR.
      IF flag = "DEL-INDEX" THEN DO:
        IF AVAILABLE _Index THEN DO:
          FOR EACH _Index-field OF _Index.
            DELETE _Index-field.
          END.
          DELETE _Index.
        END.
        NEXT _indx1.
      END.
      ELSE IF flag = "REN-INDEX" THEN DO:
        IF AVAILABLE _Index THEN _Index-name = INPUT x_unique.
        NEXT _indx1.
      END.
      ELSE IF flag = "CHG-INDEX" THEN DO:
        IF AVAILABLE _Index THEN DO:
          ASSIGN _active.
          IF _Unique <> y_Unique THEN DO:
            MESSAGE "You can not change uniqueness for index"
              _File-name + "." + _Index-name.
            UNDO _all1, LEAVE.
          END.
        END.
        NEXT _indx1.
      END.

      REPEAT FOR _Index-Field ON ERROR UNDO _all1 , LEAVE:
        PROMPT-FOR flag _Index-Seq _Field-Name _Ascending _Abbreviate.
        flag = TRIM(INPUT flag).
        FIND _Field OF _File WHERE _Field-name = INPUT _Field-name.
        IF flag <> "INDEX-FIELD" THEN DO:
          MESSAGE "An input record starting with" flag "was read,".
          MESSAGE "But an INDEX-FIELD record was expected".
          MESSAGE "Processing terminated".
          UNDO _all1, LEAVE.
        END.
        DO:
          FIND _Index-field OF _Index
            WHERE _Index-field._Field-recid  = RECID(_Field)  NO-ERROR.
          IF NOT AVAILABLE _Index-field THEN CREATE _Index-field.
        END.
        IF NEW(_Index-field) THEN DO:
          _Index-Field._Index-recid = RECID(_Index).
          _Index-Field._Field-recid = RECID(_Field).
          ASSIGN _Index-Seq _Ascending _Abbreviate.
        END.
        ELSE DO:
          IF _Index-seq <> INPUT _Index-seq OR _Ascending <> INPUT _Ascending
            OR _Abbreviate <> INPUT _Abbreviate THEN DO:
            MESSAGE "You can not change anything for index-component"
              _Index-name + "." + _Field-name.
            UNDO _all1, LEAVE.
          END.
        END.
      END.    /* end repeat for _Index-field */
    END.        /* end repeat for _Index */

    REPEAT  ON ERROR UNDO _all1, LEAVE:  /* Primary Index */
      PROMPT-FOR flag _Index-Name.
      flag = TRIM(INPUT flag).
      IF flag <> "PRIMARY" THEN DO:
        MESSAGE "An input record starting with" flag "was read,".
        MESSAGE "But a PRIMARY record was expected".
        MESSAGE "Processing terminated".
        UNDO _all1, LEAVE.
      END.
      FIND _Index OF _File WHERE _Index-Name = INPUT _Index-name.
      _File._Prime-Index = RECID(_Index).
    END.        /* end repeat for _Index */

    /* cleaning up */

    REPEAT:
      FIND FIRST _Field OF _File WHERE _Order < 0 NO-ERROR.
      IF NOT AVAILABLE _Field THEN LEAVE.
      _Field._Order = _Field._Order + 10000.
    END.

    /* must be last to avoid preventing chgs */
    IF INPUT _File._Db-lang = 1 THEN ASSIGN _File._Db-lang.
    ASSIGN _File._Frozen.

  END.    /* repeat for file transaction */

  IF SEARCH("_View.d") = "_View.d" THEN DO:
    MESSAGE "Load view-definitions?" UPDATE loadview.
    IF loadview THEN 
      viewloop:
      DO i = 1 TO 3:
	DISPLAY view-files[i] @ fname WITH FRAME nme.
	DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
	  HIDE MESSAGE.
	END.
	PAUSE 0.
	DOWN WITH FRAME nme.
	/*   message "Loading " + view-files[i] + " ...".   */
	OUTPUT STREAM loaderr TO VALUE(view-files[i] + ".e") NO-ECHO.
	INPUT FROM VALUE(view-files[i] + ".d") NO-ECHO NO-MAP.
	CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(user_dbname) NO-ERROR.
	RUN "prodict/misc/_runload.i" (INPUT "n")
	  VALUE(view-files[i]) 0 100 VALUE(view-files[i]) 0.
	INPUT CLOSE.
	OUTPUT STREAM loaderr CLOSE.
	/* delete temporary files */
	IF errs = 0 THEN OS-DELETE VALUE(view-files[i] + ".e").
	IF RETURN-VALUE = "stopped" THEN LEAVE viewloop.
      END. /* do i = 1 to 3, one for each view-file */
  END. /* if _view.d exists */

  IF TERMINAL <> "" THEN 
    MESSAGE "Phase 1 of Load completed.  Working.  Please wait ...".
  ELSE
    MESSAGE "Load Data Definitions Complete.".
END. /* end _all1 loop */

IF TERMINAL <> "" THEN 
  run adecomm/_setcurs.p ("").

IF no-chgs THEN MESSAGE "No changes were made to the dictionary.".
HIDE FRAME namhdr NO-PAUSE.
HIDE FRAME nme    NO-PAUSE.
HIDE MESSAGE NO-PAUSE.
RETURN.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _lodview.p - load _View, _View-ref and _View-col records */
/*
Views will now be dumped into one file, _View.d.  Previously, we dumped
views into three files (_View.d, _View-ref.d and _View-col.d), one for
each schema file that they occupied.  They are all stored in one physical
file now when dumped, and each section is delimited by a period "." alone
on the line, which PROGRESS interprets as the ENDKEY (end of file).

The View Load procedure bends over backwards, though, to maintain version 5
compatibility.  It first looks for _View-ref.d and _View-col.d in the same
directory as _View.d, and if it finds them it uses the old 3-file reload
format.  Otherwise, it uses the new 1-file format.

To avoid finding the _View.d file in one directory and the _View-ref.d and
_View-col.d files in another directory further up the search path, we do
special file-prefix checking to enforce the SEARCH function so that it only
looks in the same place that the _View.d file was found.
*/
/*
Only the new one-file - all-information _View.d contains a trailer with
the codepage-parameter. So we check for a trailer only with _View.d; also 
we differ between input "no-convert" and "input convert" only with
_View.d   <hutegger> 03/03
*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE cerror    AS CHARACTER            NO-UNDO.
DEFINE VARIABLE codepage  AS CHARACTER            NO-UNDO init "UNDEFINED".
DEFINE VARIABLE errbyte   AS INTEGER              NO-UNDO.
DEFINE VARIABLE errline   AS INTEGER              NO-UNDO.
DEFINE VARIABLE errs      AS INTEGER              NO-UNDO.
DEFINE VARIABLE i         AS INTEGER              NO-UNDO.
DEFINE VARIABLE lvar      AS CHARACTER EXTENT 10  NO-UNDO.
DEFINE VARIABLE lvar#     AS INTEGER              NO-UNDO.
DEFINE VARIABLE fil-e     AS CHARACTER            NO-UNDO.
DEFINE VARIABLE recs      AS INTEGER.              /*UNDO*/
DEFINE VARIABLE recs2     AS INTEGER              NO-UNDO.
DEFINE VARIABLE terrors   AS INTEGER              NO-UNDO.
DEFINE VARIABLE vcol      AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE vmsg      AS CHARACTER            NO-UNDO.
DEFINE VARIABLE vorg      AS CHARACTER            NO-UNDO.
DEFINE VARIABLE vpath     AS CHARACTER            NO-UNDO.
DEFINE VARIABLE vrecs     AS INTEGER              NO-UNDO.
DEFINE VARIABLE vref      AS CHARACTER INITIAL "" NO-UNDO.



ASSIGN
  vorg  = SEARCH(user_env[2])
  vpath = SUBSTRING(vorg,1,LENGTH(vorg) - LENGTH(user_env[2])).

IF NOT user_env[2] MATCHES "*~.d" THEN DO:
  MESSAGE "File name containing View information must end in ~".d~"."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.
fil-e = SUBSTRING(user_env[2],1,LENGTH(user_env[2]) - 1) + "e".

run adecomm/_setcurs.p ("WAIT").


IF user_env[2] MATCHES "*_View~.d" THEN DO:
  ASSIGN
    vcol = SUBSTRING(user_env[2],1,LENGTH(user_env[2]) - 2) + "-col.d"
    vref = SUBSTRING(user_env[2],1,LENGTH(user_env[2]) - 2) + "-ref.d".
  IF SEARCH(vcol) <> vpath + vcol OR SEARCH(vref) <> vpath + vref THEN ASSIGN
    vcol = ""
    vref = "".
END.
/*** Don't need this right now 
{prodict/dump/lodtrail.i
  &file    = "user_env[2]"
  &entries = " " 
  }  /* read trailer, sets variables: codepage and cerror */
*/
/* gfs: The codepage is now set by _usrload.p */
ASSIGN codepage = user_env[10].

IF   codepage        <> "UNDEFINED" 
 AND SESSION:CHARSET <> ?
 then assign cerror = CODEPAGE-CONVERT("a",SESSION:CHARSET,codepage).
 else assign cerror = "no-convert".
 
IF cerror = ?
 THEN DO:  /* conversion needed but NOT possible */

  run adecomm/_setcurs.p ("").
  MESSAGE "View information NOT loaded." 
       	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK. 

  END.     /* conversion needed but NOT possible */

 ELSE DO:  /* conversion not needed OR needed and possible */
 
  OUTPUT TO VALUE(fil-e) NO-ECHO.
  if cerror = "undefined"
   then INPUT FROM VALUE(SEARCH(user_env[2])) NO-ECHO NO-MAP NO-CONVERT.
   else INPUT FROM VALUE(SEARCH(user_env[2])) NO-ECHO NO-MAP
                   CONVERT SOURCE codepage TARGET SESSION:CHARSET.

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  REPEAT FOR DICTDB._View ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    IF RETRY
     THEN DO:
      errs = errs + 1.
      PUT UNFORMATTED
        ">> ERROR READING LINE #" errline " (OFFSET=" errbyte ")" SKIP
        "** Tolerable load error rate is: 0%." SKIP
        "** Loading table _View is aborted." SKIP.
      LEAVE.
      END.
    CREATE _View.
    ASSIGN
      errbyte = SEEK(INPUT)
      errline = errline + 1
      recs    = recs + 1.
    IMPORT _View.
    END. /* end repeat */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  ASSIGN
    vrecs   = recs
    terrors = errs.

  IF errs > 0 THEN PUT UNFORMATTED FILL("-",78) SKIP.

  IF vcol <> ""
   THEN DO:
    INPUT CLOSE.
    INPUT FROM VALUE(vcol) NO-ECHO NO-MAP.
    END.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  REPEAT FOR DICTDB._View-col ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    IF RETRY
     THEN DO:
      errs = errs + 1.
      PUT UNFORMATTED
        ">> ERROR READING LINE #" errline " (OFFSET=" errbyte ")" SKIP
        "** Tolerable load error rate is: 0%." SKIP
        "** Loading table _View-col is aborted." SKIP.
      LEAVE.
      END.
    CREATE _View-col.
    ASSIGN
      errbyte = SEEK(INPUT)
      errline = errline + 1
      recs    = recs + 1.
    IMPORT _View-col.
    END. /* end repeat */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  IF recs = 0 AND vrecs > 0
   THEN DO:
    PUT UNFORMATTED
      "Warning!  Inconsistent load counts between _View and _View-ref" SKIP
      "Not enough _View-ref records read to satisfy _View records"     SKIP.
    errs = errs + 1.
    END.
  ASSIGN
    terrors = terrors + errs
    recs2   = recs.

  IF errs > 0 THEN PUT UNFORMATTED FILL("-",78) SKIP.

  IF vref <> ""
   THEN DO:
    INPUT CLOSE.
    INPUT FROM VALUE(vref) NO-ECHO NO-MAP.
    END.
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  REPEAT FOR DICTDB._View-ref ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    IF RETRY 
     THEN DO:
      errs = errs + 1.
      PUT UNFORMATTED
        ">> ERROR READING LINE #" errline " (OFFSET=" errbyte ")" SKIP
        "** Tolerable load error rate is: 0%." SKIP
        "** Loading table _View-ref is aborted." SKIP.
      LEAVE.
      END.
    CREATE _View-ref.
    ASSIGN
      errbyte = SEEK(INPUT)
      errline = errline + 1
      recs    = recs + 1.
    IMPORT _View-ref.
    END. /* end repeat */
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  IF recs = 0 AND vrecs > 0 
   THEN DO:
    PUT UNFORMATTED
      "Warning!  Inconsistent load counts between _View and _View-col" SKIP
      "Not enough _View-col records read to satisfy _View records"     SKIP.
    errs = errs + 1.
    END.
  ASSIGN
    terrors = terrors + errs
    vmsg    = STRING(vrecs + recs2 + recs).

  INPUT CLOSE.
  OUTPUT CLOSE.

/* in case views loaded from V5 dumps, fix up Auth-id */
  DO TRANSACTION:
    FOR EACH DICTDB._View WHERE DICTDB._View._Auth-id = ?:
      DICTDB._View._Auth-id = ENTRY(1,DICTDB._View._Can-read).
      FOR EACH DICTDB._View-col OF DICTDB._View:
        DICTDB._View-col._Auth-id = DICTDB._View._Auth-id.
        END.
      FOR EACH DICTDB._View-ref OF DICTDB._View:
        DICTDB._View-ref._Auth-id = DICTDB._View._Auth-id.
        END.
      END.
    END.

  run adecomm/_setcurs.p ("").

  IF terrors = 0 
   THEN DO:
    OS-DELETE VALUE(fil-e).
    MESSAGE "View information loaded successfully." SKIP
        	  vmsg "records read."
        	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    END.
   ELSE DO:
    MESSAGE terrors "error(s) in loading View definitions." SKIP
        	  "Error listing contained in file" fil-e SKIP
        	  vmsg "records read." 
        	  VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    END.

  END.     /* conversion not needed OR needed and possible */


RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*------------------------------------------------------------- 

file: prodict/dump/copy_dbs.i

-------------------------------------------------------------*/

ASSIGN
  {&to}._Db-addr       	= {&from}._Db-addr
  {&to}._Db-comm       	= {&from}._Db-comm
  {&to}._Db-local      	= {&from}._Db-local
  {&to}._Db-name       	= {&from}._Db-name
  {&to}._Db-revision   	= {&from}._Db-revision
  {&to}._Db-slave      	= {&from}._Db-slave
  {&to}._Db-type       	= {&from}._Db-type
  {&to}._Db-xlate[1]   	= {&from}._Db-xlate[1]
  {&to}._Db-xlate[2]   	= {&from}._Db-xlate[2]
  {&to}._Db-xl-name    	= {&from}._Db-xl-name
  {&to}._Db-collate[1]	= {&from}._Db-collate[1]
  {&to}._Db-collate[2]	= {&from}._Db-collate[2]
  {&to}._Db-collate[3]	= {&from}._Db-collate[3]
  {&to}._Db-collate[4]	= {&from}._Db-collate[4]
  {&to}._Db-collate[5]	= {&from}._Db-collate[5]
  {&to}._Db-coll-name   = {&from}._Db-coll-name
  
  {&to}._Db-misc2[1]    = {&from}._Db-misc2[1]
  {&to}._Db-misc2[2]    = {&from}._Db-misc2[2]
  {&to}._Db-misc2[3]    = {&from}._Db-misc2[3]
  {&to}._Db-misc2[4]    = {&from}._Db-misc2[4]
  {&to}._Db-misc2[5]    = {&from}._Db-misc2[5]
  {&to}._Db-misc2[6]    = {&from}._Db-misc2[6]
  {&to}._Db-misc2[7]    = {&from}._Db-misc2[7]
  {&to}._Db-misc2[8]    = {&from}._Db-misc2[8]
  
  {&to}._Db-misc1[1]    = {&from}._Db-misc1[1]
  {&to}._Db-misc1[2]    = {&from}._Db-misc1[2]
  {&to}._Db-misc1[3]    = {&from}._Db-misc1[3]
  {&to}._Db-misc1[4]    = {&from}._Db-misc1[4]
  {&to}._Db-misc1[5]    = {&from}._Db-misc1[5]
  {&to}._Db-misc1[6]    = {&from}._Db-misc1[6]
  {&to}._Db-misc1[7]    = {&from}._Db-misc1[7]
  {&to}._Db-misc1[8]    = {&from}._Db-misc1[8].

/*-----------------------------------------------------------*/
/********************************************************************* *
* Copyright (C) 2000,2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*------------------------------------------------------------- 

file: prodict/dump/copy_fil.i

-------------------------------------------------------------*/

IF {&all} THEN
  ASSIGN
    {&to}._CRC          = {&from}._CRC
    {&to}._Cache        = {&from}._Cache
    {&to}._DB-lang      = {&from}._DB-lang
    {&to}._Db-recid     = {&from}._Db-recid
    {&to}._Dump-name    = {&from}._Dump-name
    {&to}._File-Number  = {&from}._File-Number
    {&to}._ianum        = {&from}._ianum
    {&to}._Frozen       = {&from}._Frozen
    {&to}._Last-change  = {&from}._Last-change
    {&to}._Prime-Index  = {&from}._Prime-Index
    {&to}._Template     = {&from}._Template
    {&to}._dft-pk       = {&from}._dft-pk
    {&to}._numfld       = {&from}._numfld
    {&to}._numkcomp     = {&from}._numkcomp
    {&to}._numkey       = {&from}._numkey
    {&to}._numkfld      = {&from}._numkfld
    {&to}._File-Attributes[1] = {&from}._File-Attributes[1]
    {&to}._File-Attributes[2] = {&from}._File-Attributes[2].

ASSIGN
  {&to}._File-Name     = {&from}._File-Name
  {&to}._Can-Create    = {&from}._Can-Create
  {&to}._Can-Delete    = {&from}._Can-Delete
  {&to}._Can-Read      = {&from}._Can-Read
  {&to}._Can-Write     = {&from}._Can-Write
  {&to}._Can-Dump      = {&from}._Can-Dump
  {&to}._Can-Load      = {&from}._Can-Load
  {&to}._Desc	       = {&from}._Desc
  {&to}._File-Label    = {&from}._File-Label
  {&to}._File-Label-SA = {&from}._File-Label-SA
  {&to}._Hidden	       = {&from}._Hidden
  {&to}._Valexp	       = {&from}._Valexp
  {&to}._Valmsg	       = {&from}._Valmsg
  {&to}._Valmsg-SA     = {&from}._Valmsg-SA 
 
  {&to}._For-Cnt1      = {&from}._For-Cnt1
  {&to}._For-Cnt2      = {&from}._For-Cnt2
  {&to}._For-Flag      = {&from}._For-Flag
  {&to}._For-Format    = {&from}._For-Format
  {&to}._For-Id	       = {&from}._For-Id
  {&to}._For-Info      = {&from}._For-Info
  {&to}._For-Name      = {&from}._For-Name
  {&to}._For-Number    = {&from}._For-Number
  {&to}._For-Owner     = {&from}._For-Owner
  {&to}._For-Size      = {&from}._For-Size
  {&to}._For-Type      = {&from}._For-Type
 
  {&to}._Fil-misc1[1]  = {&from}._Fil-misc1[1]
  {&to}._Fil-misc1[2]  = {&from}._Fil-misc1[2]
  {&to}._Fil-misc1[3]  = {&from}._Fil-misc1[3]
  {&to}._Fil-misc1[4]  = {&from}._Fil-misc1[4] 
  {&to}._Fil-misc1[5]  = {&from}._Fil-misc1[5] 
  {&to}._Fil-misc1[6]  = {&from}._Fil-misc1[6]
  {&to}._Fil-misc1[7]  = {&from}._Fil-misc1[7] 
  {&to}._Fil-misc1[8]  = {&from}._Fil-misc1[8]
 
  {&to}._Fil-misc2[1]  = {&from}._Fil-misc2[1]
  {&to}._Fil-misc2[2]  = {&from}._Fil-misc2[2]
  {&to}._Fil-misc2[3]  = {&from}._Fil-misc2[3]
  {&to}._Fil-misc2[4]  = {&from}._Fil-misc2[4] 
  {&to}._Fil-misc2[5]  = {&from}._Fil-misc2[5] 
  {&to}._Fil-misc2[6]  = {&from}._Fil-misc2[6]
  {&to}._Fil-misc2[7]  = {&from}._Fil-misc2[7] 
  {&to}._Fil-misc2[8]  = {&from}._Fil-misc2[8].

/*-----------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

ASSIGN
  {&to}._Event      = {&from}._Event
  {&to}._File-Recid = {&from}._File-Recid
  {&to}._Override   = {&from}._Override
  {&to}._Proc-Name  = {&from}._Proc-Name
  {&to}._Trig-Crc   = {&from}._Trig-Crc.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*------------------------------------------------------------- 

file: prodict/dump/copy_fld.i

-------------------------------------------------------------*/
/* allows not to copy when multi tenancy lob field with keep default no in one of the tables */

&if defined(copyarea) = 0 &then
   &scoped-define copyarea true 
&endif

IF {&all} THEN
  ASSIGN
    {&to}._Field-Name    = {&from}._Field-Name
    {&to}._File-recid    = {&from}._File-recid
    {&to}._Data-Type     = {&from}._Data-Type
    {&to}._dtype         = {&from}._dtype
    {&to}._Format        = {&from}._Format
    {&to}._Initial       = {&from}._Initial
    {&to}._Order         = {&from}._Order
    {&to}._field-rpos    = {&from}._field-rpos
    {&to}._sys-field     = {&from}._sys-field.
    
ASSIGN
  {&to}._Can-Read      = {&from}._Can-Read
  {&to}._Can-Write     = {&from}._Can-Write
  {&to}._Col-label     = {&from}._Col-label
  {&to}._Col-label-SA  = {&from}._Col-label-SA
  {&to}._Decimals      = {&from}._Decimals
  {&to}._Desc          = {&from}._Desc
  {&to}._Extent        = {&from}._Extent
  {&to}._Fld-case      = {&from}._Fld-case
  {&to}._Format-SA     = {&from}._Format-SA
  {&to}._Help          = {&from}._Help
  {&to}._Help-SA       = {&from}._Help-SA
  {&to}._Initial-SA    = {&from}._Initial-SA
  {&to}._Label         = {&from}._Label
  {&to}._Label-SA      = {&from}._Label-SA
  {&to}._Mandatory     = {&from}._Mandatory
  {&to}._Valexp        = {&from}._Valexp
  {&to}._Valmsg        = {&from}._Valmsg
  {&to}._Valmsg-SA     = {&from}._Valmsg-SA
  {&to}._View-As       = {&from}._View-As

  {&to}._Fld-stdtype   = {&from}._Fld-stdtype
 
  {&to}._Fld-stlen     = {&from}._Fld-stlen when {&copyarea} 
 
  {&to}._Fld-stoff     = {&from}._Fld-stoff

  {&to}._For-Allocated = {&from}._For-Allocated
  {&to}._For-Id        = {&from}._For-Id
  {&to}._For-Itype     = {&from}._For-Itype
  {&to}._For-Maxsize   = {&from}._For-Maxsize
  {&to}._For-Name      = {&from}._For-Name
  {&to}._For-Retrieve  = {&from}._For-Retrieve
  {&to}._For-Scale     = {&from}._For-Scale
  {&to}._For-Separator = {&from}._For-Separator
  {&to}._For-Spacing   = {&from}._For-Spacing
  {&to}._For-Type      = {&from}._For-Type
  {&to}._For-Xpos      = {&from}._For-Xpos

  {&to}._Fld-misc1[1]  = {&from}._Fld-misc1[1]
  {&to}._Fld-misc1[2]  = {&from}._Fld-misc1[2]
  {&to}._Fld-misc1[3]  = {&from}._Fld-misc1[3]
  {&to}._Fld-misc1[4]  = {&from}._Fld-misc1[4]
  {&to}._Fld-misc1[5]  = {&from}._Fld-misc1[5]
  {&to}._Fld-misc1[6]  = {&from}._Fld-misc1[6]
  {&to}._Fld-misc1[7]  = {&from}._Fld-misc1[7]
  {&to}._Fld-misc1[8]  = {&from}._Fld-misc1[8]
  
  {&to}._Fld-misc2[1]  = {&from}._Fld-misc2[1]
  {&to}._Fld-misc2[2]  = {&from}._Fld-misc2[2] 
  {&to}._Fld-misc2[3]  = {&from}._Fld-misc2[3]
  {&to}._Fld-misc2[4]  = {&from}._Fld-misc2[4]
  {&to}._Fld-misc2[5]  = {&from}._Fld-misc2[5]
  {&to}._Fld-misc2[6]  = {&from}._Fld-misc2[6]
  {&to}._Fld-misc2[7]  = {&from}._Fld-misc2[7]
  {&to}._Fld-misc2[8]  = {&from}._Fld-misc2[8].

/*-----------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

ASSIGN
  {&to}._Event       = {&from}._Event
  {&to}._Field-Recid = {&from}._Field-Recid
  {&to}._Field-Rpos  = {&from}._Field-Rpos
  {&to}._File-Recid  = {&from}._File-Recid
  {&to}._Override    = {&from}._Override
  {&to}._Proc-Name   = {&from}._Proc-Name
  {&to}._Trig-Crc    = {&from}._Trig-Crc.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*------------------------------------------------------------- 

file: prodict/dump/copy_idx.i

-------------------------------------------------------------*/

ASSIGN
  {&to}._Active     = {&from}._Active
  {&to}._Desc       = {&from}._Desc
  {&to}._File-recid = {&from}._File-recid
  {&to}._Index-Name = {&from}._Index-Name
  {&to}._Unique     = {&from}._Unique
  {&to}._Wordidx    = {&from}._Wordidx
  {&to}._ianum      = {&from}._ianum
  {&to}._idx-num    = {&from}._idx-num
  {&to}._num-comp   = {&from}._num-comp

  {&to}._For-Name   = {&from}._For-Name
  {&to}._For-Type   = {&from}._For-Type

  {&to}._I-misc1[1] = {&from}._I-misc1[1]  
  {&to}._I-misc1[2] = {&from}._I-misc1[2]  
  {&to}._I-misc1[3] = {&from}._I-misc1[3]  
  {&to}._I-misc1[4] = {&from}._I-misc1[4]  
  {&to}._I-misc1[5] = {&from}._I-misc1[5]  
  {&to}._I-misc1[6] = {&from}._I-misc1[6]  
  {&to}._I-misc1[7] = {&from}._I-misc1[7]  
  {&to}._I-misc1[8] = {&from}._I-misc1[8]

  {&to}._I-misc2[1] = {&from}._I-misc2[1]  
  {&to}._I-misc2[2] = {&from}._I-misc2[2]  
  {&to}._I-misc2[3] = {&from}._I-misc2[3]  
  {&to}._I-misc2[4] = {&from}._I-misc2[4]  
  {&to}._I-misc2[5] = {&from}._I-misc2[5]  
  {&to}._I-misc2[6] = {&from}._I-misc2[6]  
  {&to}._I-misc2[7] = {&from}._I-misc2[7]  
  {&to}._I-misc2[8] = {&from}._I-misc2[8]

  {&to}._I-res1[1]  = {&from}._I-res1[1]  
  {&to}._I-res1[2]  = {&from}._I-res1[2]  
  {&to}._I-res1[3]  = {&from}._I-res1[3]  
  {&to}._I-res1[4]  = {&from}._I-res1[4]  
  {&to}._I-res1[5]  = {&from}._I-res1[5]  
  {&to}._I-res1[6]  = {&from}._I-res1[6]  
  {&to}._I-res1[7]  = {&from}._I-res1[7]  
  {&to}._I-res1[8]  = {&from}._I-res1[8]

  {&to}._I-res2[1]  = {&from}._I-res2[1]  
  {&to}._I-res2[2]  = {&from}._I-res2[2]  
  {&to}._I-res2[3]  = {&from}._I-res2[3]  
  {&to}._I-res2[4]  = {&from}._I-res2[4]  
  {&to}._I-res2[5]  = {&from}._I-res2[5]  
  {&to}._I-res2[6]  = {&from}._I-res2[6]  
  {&to}._I-res2[7]  = {&from}._I-res2[7]  
  {&to}._I-res2[8]  = {&from}._I-res2[8].

/*-----------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

ASSIGN
  {&to}._Abbreviate  = {&from}._Abbreviate
  {&to}._Ascending   = {&from}._Ascending
  {&to}._Field-recid = {&from}._Field-recid
  {&to}._Index-Seq   = {&from}._Index-Seq
  {&to}._Index-recid = {&from}._Index-recid
  {&to}._Unsorted    = {&from}._Unsorted.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*------------------------------------------------------------- 

file: prodict/dump/copy_seq.i

-------------------------------------------------------------*/

ASSIGN
  {&to}._Cycle-Ok    = {&from}._Cycle-Ok
  {&to}._Db-recid    = {&from}._Db-recid
  {&to}._Seq-Incr    = {&from}._Seq-Incr
  {&to}._Seq-Init    = {&from}._Seq-Init
  {&to}._Seq-Max     = {&from}._Seq-Max
  {&to}._Seq-Min     = {&from}._Seq-Min
  {&to}._Seq-Name    = {&from}._Seq-Name
  {&to}._Seq-Num     = {&from}._Seq-Num
  {&to}._Seq-Misc[1] = {&from}._Seq-Misc[1]
  {&to}._Seq-Misc[2] = {&from}._Seq-Misc[2]
  {&to}._Seq-Misc[3] = {&from}._Seq-Misc[3]
  {&to}._Seq-Misc[4] = {&from}._Seq-Misc[4]
  {&to}._Seq-Misc[5] = {&from}._Seq-Misc[5]
  {&to}._Seq-Misc[6] = {&from}._Seq-Misc[6]
  {&to}._Seq-Misc[7] = {&from}._Seq-Misc[7]
  {&to}._Seq-Misc[8] = {&from}._Seq-Misc[8].

/*-----------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* dmptrail.i

function:
    appends a trailer with codepage-information 

preconditions:    
    needs the stream to be open, and all data to be output
    user_env[5] contains the value for the codepage-entry
        
text-parameters:
    &entries        ev. additional entries
    &seek-stream    "<stream-name>"        or "OUTPUT"
    &stream         "stream <stream-name>" or ""
    
included in:
  prodict/dump/_dmpdata.p    
  prodict/dump/_dmpsddl.p    
  prodict/dump/_dmpseqs.p    
  prodict/dump/_dmpuser.p    
  prodict/dump/_dmpview.p    
  prodict/dump/_dmpincr.p    
    
history:
    hutegger    94/03/02    creation
    fernando    Jun 19,2007 Support for large files
    
*/
/*------------------ begin Trailer-INFO ------------------*/
  DEFINE VARIABLE i64       AS INT64   NO-UNDO.

  PUT {&stream} UNFORMATTED "." SKIP.
  
  i64 = SEEK({&seek-stream}).
  
  PUT {&stream} UNFORMATTED "PSC" SKIP.
  
  {&entries}
  
  PUT {&stream} UNFORMATTED "cpstream=" 
    ( if user_env[5] = "<internal defaults apply>"
       then "UNDEFINED"
       else user_env[5] 
     ) SKIP.
   
  PUT {&stream} UNFORMATTED
    "." SKIP .

  /* location of trailer */
  IF i64 > 9999999999 THEN
      PUT {&stream} UNFORMATTED STRING(i64) SKIP.
  ELSE
      PUT {&stream} UNFORMATTED STRING(i64,"9999999999") SKIP.


/*------------------ end   Trailer-INFO ------------------*/

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: dtrigchk.i

Description:   
   Check to see if there are any find triggers for this table and
   if so, see if this user has privileges to dump/load with triggers 
   disabled.

Input: The _File buffer has the _File record in it that we want to check.
 
Arguments:
   &OK - Set to true if no FIND trigger is found or user has privileges
      	 to dump load with triggers disabled.  Otherwise, set to false.

Author: Laura Stern

Date Created: 11/23/92 

----------------------------------------------------------------------------*/


find _File-trig of _File where _File-trig._Event = "FIND" NO-ERROR.
if AVAILABLE _File-trig then
   {&OK} = CAN-DO(_File._Can-Dump,USERID(user_dbname)).
else
   {&OK} = yes.

/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/*--------------------------------------------------------------------

File: prodict/dump/dumpname.i

Description:
    checkes and eventually transformes a name into a valid unique 
    dumpname
    
Text-Parameters:
    none

Objects changed:
    nam         INPUT:  dump-name estimation
                OUTPUT: valid, unique dump-name
                    
Included in:
    prodict/dump/_lodname.p
    prodict/dump/_lod_fil.p
    

Author: Tom Hutegger

History:
    hutegger    94/05/23    creation
    Mario B     99/02/12    BUG 98-12-17-030 stop LC() on dumpname.  
    fernando    06/15/06    Expanding Dump-name to 32 characters    
--------------------------------------------------------------------*/
/*h-*/
/*--------------------------------------------------------------------
needs the following variables defined:

DEFINE VARIABLE nam  AS CHARACTER NO-UNDO.
DEFINE VARIABLE pass AS INTEGER   NO-UNDO.
--------------------------------------------------------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
     nam = SUBSTRING(nam,1,32,"character").
 
    IF CAN-FIND(DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                               AND DICTDB._File._Dump-name = nam  
                               AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")) THEN
      ASSIGN pass = 1 /*ABSOLUTE(_File-num)*/
             nam  = SUBSTRING(nam + "-------"
                      ,1
                      ,32 - LENGTH(STRING(pass),"character")
                      ,"character"
                      )
                       + STRING(pass).

    DO pass = 1 TO 9999 WHILE 
        CAN-FIND(DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                                AND DICTDB._File._Dump-name = nam
                                AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")):      
      ASSIGN nam = SUBSTRING(nam + "-------"
                   ,1
                   ,32 - LENGTH(STRING(pass),"character")
                   ,"character"
                   )
                   + STRING(pass).
    END.
  END.
  ELSE DO:
    nam = SUBSTRING(nam,1,8,"character").

    IF CAN-FIND(DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                               AND DICTDB._File._Dump-name = nam) THEN
      ASSIGN pass = 1 /*ABSOLUTE(_File-num)*/
             nam  = SUBSTRING(nam + "-------"
                      ,1
                      ,8 - LENGTH(STRING(pass),"character")
                      ,"character"
                      )
                       + STRING(pass).

    DO pass = 1 TO 9999 WHILE CAN-FIND(DICTDB._File WHERE DICTDB._File._Db-recid = drec_db
                                                      AND DICTDB._File._Dump-name = nam):      
      ASSIGN nam = SUBSTRING(nam + "-------"
                   ,1
                   ,8 - LENGTH(STRING(pass),"character")
                   ,"character"
                   )
                   + STRING(pass).
    END.
  END.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2005,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*---------------------------------------------------------------------------

dumpvars.i - dictionary dump utility shared variables & workfiles

Author: Mario Brunetti

Date Created: 10/04/99

History:  kmcintos 04/29/2005  Added new dump streams for auditing
          kmcintos 04/30/2005  Added second parameter which, when equal to
                               "STREAMS" defines stream information only.
          fernando 11/10/2005  Added streams for _client-session and _db-detail 20051110-020
          fernando 02/27/2007  Handle critical field change - OE00147106
          kmayur   06/21/2011  Added variable for constraint dump OE00195067
-----------------------------------------------------------------------------*/

DEFINE {1} STREAM ddl.
DEFINE {1} STREAM err-log.  
DEFINE {1} STREAM dumpPol.
DEFINE {1} STREAM dumpEvtPol.
DEFINE {1} STREAM dumpFldPol.
DEFINE {1} STREAM dumpFilPol.
DEFINE {1} STREAM dumpAudD.
DEFINE {1} STREAM dumpAudDVal.
DEFINE {1} STREAM dumpCliSess.
DEFINE {1} STREAM dumpDbDet.

&IF "{2}" NE "STREAMS" &THEN
  &GLOBAL-DEFINE errFileName "incrdump.e"
  
  DEFINE {1} WORKFILE missing NO-UNDO
    FIELD name AS CHARACTER INITIAL ""
    FIELD crit AS LOGICAL   INITIAL NO. /* for OE00147106 */

  DEFINE {1} WORKFILE table-list NO-UNDO
    FIELD t1-name AS CHARACTER INITIAL ""
    FIELD t2-name AS CHARACTER INITIAL ?.

  DEFINE {1} WORKFILE field-list NO-UNDO
    FIELD f1-name   AS CHARACTER INITIAL ""
    FIELD f2-name   AS CHARACTER INITIAL ?.

  DEFINE {1} WORKFILE seq-list NO-UNDO
    FIELD s1-name AS CHARACTER INITIAL ""
    FIELD s2-name AS CHARACTER INITIAL ?.

  DEFINE {1} WORKFILE index-list NO-UNDO
    FIELD i1-name AS CHARACTER INITIAL ""
    FIELD i1-comp AS CHARACTER INITIAL ""
    FIELD i2-name AS CHARACTER INITIAL ?
    FIELD i1-i2   AS LOGICAL.
  DEFINE {1} WORKFILE constraint-list NO-UNDO
    FIELD c1-name AS CHARACTER INITIAL ""
    FIELD c1-comp AS CHARACTER INITIAL ""
    FIELD c2-name AS CHARACTER INITIAL ?
    FIELD c1-i2   AS LOGICAL.    

  DEFINE {1} BUFFER index-alt FOR index-list.
  DEFINE {1} BUFFER const-alt FOR constraint-list.
  DEFINE {1} BUFFER old-field FOR DICTDB._Field.
  DEFINE {1} BUFFER new-field FOR DICTDB2._Field.

  DEFINE {1} VARIABLE h_dmputil        AS HANDLE.
  DEFINE {1} VARIABLE s_errorsLogged   AS LOGICAL INIT FALSE.
  DEFINE {1} VARIABLE cnt              AS INT.  
&ENDIF
/***********************************************************************
* Copyright (C) 2000,2006,2008,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/* loaddefs.i - definitions for load .df file

history:
   10/18/99  Mario B.   Create warning mechanisim and add warning for
   SQL-WIDTH.  BUG# 19990825-005.
    D. McMann 04/11/01 Added warning for SQL Table Updates ISSUE 310
   fernando   08/21/06 Fixing load of collation into pre-10.1A db (20060413-001)
   fernando   04/30/08 Adding ttFldOrder temp-table
   kmayur     06/21/11 Added wcon table for constraint dump OE00195067
-----------------------------------------------------------------------------*/

DEFINE {1} SHARED VARIABLE iarg AS CHARACTER NO-UNDO. /* usually = ilin[2] */
DEFINE {1} SHARED VARIABLE ikwd AS CHARACTER NO-UNDO. /* usually = ilin[1] */
DEFINE {1} SHARED VARIABLE imod AS CHARACTER NO-UNDO. /* add/mod/ren/del */
DEFINE {1} SHARED VARIABLE ipos	AS INTEGER   NO-UNDO. /* line# in file */
DEFINE {1} SHARED VARIABLE ilin AS CHARACTER EXTENT 256 NO-UNDO.

DEFINE {1} SHARED VARIABLE iprimary   AS LOGICAL   NO-UNDO. /* is prim idx */
DEFINE {1} SHARED VARIABLE irename    AS CHARACTER NO-UNDO. /* new name */
DEFINE {1} SHARED VARIABLE icomponent AS INTEGER   NO-UNDO. /* idx-fld seq # */

DEFINE {1} SHARED VARIABLE inoerror AS LOGICAL   NO-UNDO. /* no-error seen? */
DEFINE {1} SHARED VARIABLE ierror   AS INTEGER   NO-UNDO. /* error counter */
DEFINE {1} SHARED VARIABLE iwarn    AS INTEGER   NO-UNDO. /* warning counter */
DEFINE {1} SHARED VARIABLE iwarnlst AS CHARACTER NO-UNDO. /* list for warnings */

DEFINE {1} SHARED VARIABLE file-area-number AS INTEGER INITIAL 6 NO-UNDO.

&IF DEFINED(NO_TABLES) EQ 0 &THEN

/* 20060413-001 - making wdbs a temp-table */
DEFINE {1} SHARED TEMP-TABLE wdbs NO-UNDO LIKE _Db.
 
DEFINE {1} SHARED TEMP-TABLE wfil NO-UNDO LIKE _File.
DEFINE {1} SHARED TEMP-TABLE wfit NO-UNDO LIKE _File-trig.
DEFINE {1} SHARED TEMP-TABLE wfld NO-UNDO LIKE _Field.
DEFINE {1} SHARED TEMP-TABLE wflt NO-UNDO LIKE _Field-trig.
DEFINE {1} SHARED TEMP-TABLE widx NO-UNDO LIKE _Index.
DEFINE {1} SHARED TEMP-TABLE wixf NO-UNDO LIKE _Index-field.
DEFINE {1} SHARED TEMP-TABLE wseq NO-UNDO LIKE _Sequence.
DEFINE {1} SHARED TEMP-TABLE wcon NO-UNDO LIKE _Constraint.

DEFINE {1} SHARED TEMP-TABLE ttFldOrder NO-UNDO
    FIELD FILE-NAME  AS CHAR
    FIELD Field-Name AS CHAR
    FIELD Prev-Order AS INT.

&ENDIF

/* gate_xxx - for lookup of _for-type -> _fld-stdtype converions */
DEFINE {1} SHARED VARIABLE gate_dbtype AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE gate_proc   AS CHARACTER NO-UNDO. /* xxx_typ.p */

/* dblangcache - list of sql files - _File._Db-lang -> 1 */
DEFINE {1} SHARED VARIABLE dblangcache AS CHARACTER NO-UNDO.

/* kindexcache - list of index names deleted when fields deleted */
DEFINE {1} SHARED VARIABLE kindexcache AS CHARACTER NO-UNDO.

/* frozencache - list of files to be marked frozen */
DEFINE {1} SHARED VARIABLE frozencache AS CHARACTER NO-UNDO.

/* logical used to check the validity of the area-number in a .df file */

DEFINE VARIABLE is-area AS LOGICAL NO-UNDO.
DEFINE STREAM   constlog.
DEFINE VARIABLE cnstrpt_name       AS CHARACTER   NO-UNDO.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* prodict/dump/loadkill.i - delete a file definition */

FOR EACH {&alias}_Constraint OF {&alias}_File:
  FOR EACH {&alias}_Constraint-Keys WHERE {&alias}_Constraint-Keys._Con-Recid = RECID({&alias}_Constraint):
    DELETE {&alias}_Constraint-Keys.
  END.  
  DELETE {&alias}_Constraint.
END.
FOR EACH {&alias}_Index OF {&alias}_File:
  FOR EACH {&alias}_Index-field OF {&alias}_Index:
    DELETE {&alias}_Index-field.
  END.  
  DELETE {&alias}_Index.
END.
FOR EACH {&alias}_File-trig OF {&alias}_File:
  DELETE {&alias}_File-trig.
END.
FOR EACH {&alias}_Field OF {&alias}_File:
  FOR EACH {&alias}_Field-trig OF {&alias}_Field:
    DELETE {&alias}_Field-trig.
  END.
  DELETE {&alias}_Field.
END.
FOR EACH {&alias}_Partition-Set WHERE {&alias}_Partition-Set._Object-number = {&alias}_File._File-Num:
  FOR EACH {&alias}_Partition-Set-Detail OF {&alias}_Partition-Set:
    DELETE {&alias}_Partition-Set-Detail.
  END.
  DELETE {&alias}_Partition-Set.
END.
DELETE {&alias}_File.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* lodtrail.i

function:
    reads a trailer with codepage-information 
    assigns 
      codepage   "UNDEFINED" or "<codepage according to trailer>"
      cerror     "no-convert" or "<translated 'a'>" or ? (:= conv-error)
      
text-parameters:
    &entries        ev. additional entries
    &file           input-file-name
    
included in:
  prodict/dump/_loddata.p    
  prodict/dump/_lodsddl.p    
  prodict/dump/_lodseqs.p  commented out   
  prodict/dump/_loduser.p  commented out   
  prodict/dump/_lodview.p  commented out    
    
Needs:
  DEF VAR codepage AS CHAR.
  DEF VAR cerror   AS CHAR.
  DEF VAR lvar     AS CHAR EXTENT 10.
  DEF VAR lvar#    AS INT.
  
  NOTE: IF YOU MODIFY THE TRAILER: PLEASE FIX THE BYTECOUNT BELOW in Find_PSC. 
  ALSO, prodict/user/userload.i USES SIMILAR ROUTINES TO THESE. PLEASE CHECK 
  THEM AS WELL.
  
history:
    fernando    06/19/07    Support for large files
    mcmann      98/07/09    Added both cpstream and codepate for check
    gfs         94/07/25    make a better effort to find "PSC" 
    hutegger    94/03/02    creation
    hutegger    94/03/30    94-03-30-012 - changed default-value of 
                            codepage-variable to SESSION:STREAM
    
*/
/*h-*/

/*assign codepage = SESSION:STREAM.*/   /* according to LisaB: 94-03-30-012 */
                                        /* in case no codepage-parameter    */
                                        /* the input ought to be converted  */
                                        /* SESSION:STREAM                   */ 
                                        /*      <hutegger> 94/03            */
ASSIGN codepage = 
  IF user_env[10] = "" THEN
    SESSION:STREAM 
  ELSE user_env[10].  /* set in _usrload */
/*-------------------------------------------------- start of tail read 
  **** THIS IS THE OLD ROUTINE ****
  **** THE code BELOW REPLACE IT **
  
  INPUT FROM VALUE({&file}) NO-ECHO NO-MAP.
  SEEK INPUT TO END.
  SEEK INPUT TO SEEK(INPUT) - 11.
  READKEY PAUSE 0.
  ASSIGN
    lvar# = 0
    lvar  = ""
    i     = 0.
  DO WHILE LASTKEY <> 13 AND i <> ?:
    i = (IF LASTKEY > 47 AND LASTKEY < 58 
          THEN i * 10 + LASTKEY - 48
          ELSE ?).
    READKEY PAUSE 0.
  END.
  IF i > 0 
    THEN _psc: 
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      SEEK INPUT TO i.
      READKEY PAUSE 0. IF LASTKEY <> ASC("P") THEN LEAVE _psc.
      READKEY PAUSE 0. IF LASTKEY <> ASC("S") THEN LEAVE _psc.
      READKEY PAUSE 0. IF LASTKEY <> ASC("C") THEN LEAVE _psc.
      SEEK INPUT TO i.
      SET ^. /* skip end-of-line */
      REPEAT:
        IMPORT lvar[lvar# + 1].
        lvar# = lvar# + 1.
      END.
    END.
    INPUT CLOSE.
    DO i = 1 TO lvar#:
      {&entries}
      /*IF lvar[i] BEGINS "<name>="   THEN <variable>  = SUBSTRING(lvar[i],<l>).*/
      IF lvar[i] BEGINS "cpstream=" OR lvar[i] BEGINS "codepage=" THEN 
        ASSIGN codepage    = SUBSTRING(lvar[i],10).
    END.
---------------------------------------------------- end of tail read */

/**** START OF NEW ROUTINE ****/
RUN read-trailer.

IF codepage        <> "UNDEFINED" AND
   codepage        <> ""          AND
   SESSION:CHARSET <> ?
THEN ASSIGN cerror = CODEPAGE-CONVERT("a",SESSION:CHARSET,codepage).
ELSE ASSIGN cerror = "no-convert".
 
 
/********************* INTERNAL PROCEDURES *****************************/

PROCEDURE read-trailer.
  /* Read trailer of file and find codepage */
  
  DEFINE VARIABLE tempi AS DECIMAL          NO-UNDO.
  DEFINE VARIABLE j     AS INTEGER          NO-UNDO.

  INPUT FROM VALUE({&file}) NO-ECHO NO-MAP.
  SEEK INPUT TO END.

  i = SEEK(INPUT) - 11.
  SEEK INPUT TO i. /* position to possible beginning of last line */

  READKEY PAUSE 0.

  /* Now we need to deal with a large offset, which is a variable size
     value in the trailer, for large values.
     Now go back one character at a time until we find a new line or we have
     gone back too far.
     For the non-large offset format, the previous char will be a
     newline character, so we will  detect that right away and read the
     value as usual. Unless the file has CRLF (Windows), in which case
     we will go back 1 character to read the value properly - to
     account for the extra byte.
     For larger values, we will read as many digits as needed.
     The loop below could stop after 10 digits, but I am letting it go
     up to 50 to try to catch a bad value.
  */
  DO WHILE LASTKEY <> 13 AND j <= 50:
      ASSIGN j = j + 1
             i = i - 1.
      SEEK INPUT TO i.
      READKEY PAUSE 0.
  END.
                   
  /* now we can start reading it */
  IF LASTKEY EQ 13 THEN
     READKEY PAUSE 0. 

  ASSIGN
    lvar# = 0
    lvar  = ""
    i     = 0.

  DO WHILE LASTKEY <> 13 AND i <> ?: /* get byte count (last line) */
      IF LASTKEY > 47 AND LASTKEY < 58 THEN DO:
          /* check if can fit the value into an int64 type. We need
             to manipulate it with a decimal so that we don't get fooled
             by a value that overflows. This is so that we catch a
             bad offset in the file.
           */
          ASSIGN tempi = i /* first move it to a decimal */
                 tempi = tempi * 10 + LASTKEY - 48. /* get new value */
          i = INT64(tempi) NO-ERROR. /* see if it fits into an int64 */
          
          /* check if the value overflows becoming negative or an error happened. 
             If so, something is wrong (too many digits or invalid values),
             so forget this.
          */
          IF  i < 0 OR
              ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
              ASSIGN i = 0.
              LEAVE. /* we are done with this */
          END.

      END.
      ELSE 
          ASSIGN i = ?. /* bad character */
         
    READKEY PAUSE 0.
  END.

  IF i > 0 then run get_psc. /* get it */
  ELSE RUN find_psc. /* look for it */
  INPUT CLOSE.
  DO i = 1 TO lvar#:
    {&entries}
    IF lvar[i] BEGINS "cpstream=" OR lvar[i] BEGINS "codepage="
      THEN codepage = SUBSTRING(lvar[i],10).
  END.
END PROCEDURE.

PROCEDURE get_psc:
  /* using the byte count, we scoot right down there and look for
   * the beginning of the trailer ("PSC"). If we don't find it, we
   * will go and look for it.
   */
   
  DEFINE VARIABLE rc AS LOGICAL INITIAL no.
  _psc:
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    SEEK INPUT TO i. /* skip to beginning of "PSC" in file */
    READKEY PAUSE 0. IF LASTKEY <> ASC("P") THEN LEAVE _psc. /* not there!*/
    READKEY PAUSE 0. IF LASTKEY <> ASC("S") THEN LEAVE _psc.
    READKEY PAUSE 0. IF LASTKEY <> ASC("C") THEN LEAVE _psc.
    ASSIGN rc = yes. /* found it! */
    RUN read_bits (INPUT i). /* read trailer bits */
  END.
  IF NOT rc THEN RUN find_psc. /* look for it */
END PROCEDURE.

PROCEDURE find_psc:
  /* If the bytecount at the end of the file is wrong, we will jump
   * back the maximum number of bytes in a trailer and start looking
   * from there. If we still don't find it then tough luck.
   * NOTE: Variable p holds the number of bytes to roll back. AS of
   * 7/21/94, the max size of a trailer (.d) is 204 bytes, if you add
   * anything to this trailer, you must change this number to reflect
   * the number of bytes you added. I'll use 256 to add a little padding. (gfs)
   */
  DEFINE VARIABLE p AS INT64 INITIAL 256. /* really 204, added extra just in case */
  DEFINE VARIABLE l AS INT64.             /* LAST char position */
  
  SEEK INPUT TO END.
  ASSIGN l = SEEK(INPUT). /* store off EOF */
  SEEK INPUT TO SEEK(INPUT) - MINIMUM(p,l). /* take p, or size of file */
  IF SEEK(INPUT) = ? THEN RETURN.
  _scan:
  REPEAT ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    READKEY PAUSE 0.
    p = SEEK(INPUT). /* save off where we are looking */
    IF LASTKEY = ASC("P") THEN DO:
       READKEY PAUSE 0.
       IF LASTKEY <> ASC("S") THEN NEXT.
       ELSE DO: /* found "PS" */
         READKEY PAUSE 0.
         IF LASTKEY <> ASC("C") THEN NEXT.
         ELSE DO: /* found "PSC"! */
           RUN read_bits (INPUT p - 1).
           LEAVE.
         END. /* IF "C" */
       END. /* IF "S" */    
    END. /* IF "P" */
    ELSE IF p >= l THEN LEAVE _scan. /* at EOF, so give up */
  END. /* repeat */
END.

PROCEDURE read_bits:
  /* reads trailer given a starting position 
   */ 
  DEFINE INPUT PARAMETER pi as INT64. /* "SEEK TO" location */
    
  SEEK INPUT TO pi.
  REPEAT:
    IMPORT lvar[lvar# + 1].
    lvar# = lvar# + 1.
  END.
END PROCEDURE. 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: ltrigchk.i

Description:   
   Check to see if there are any create or write triggers for this table or 
   assign triggers for its fields and if so, see if this user has privileges 
   to dump/load with triggers disabled.

Input: The _File buffer has the _File record in it that we want to check.
 
Arguments:
   &OK - Set to true if either no triggers are found or user has privileges
      	 to dump load with triggers disabled.  Otherwise, set to false.

Author: Laura Stern

Date Created: 11/23/92 

----------------------------------------------------------------------------*/

Define var trig_found as logical NO-UNDO.

trig_found = no.
find _File-trig of _File where 
   _File-trig._Event = "CREATE" OR
   _File-trig._Event = "WRITE" NO-ERROR.
if AVAILABLE _File-trig then
   trig_found = yes.
else do:
   for each _Field of _File while NOT trig_found:
      find first _Field-trig of _Field NO-ERROR. /* ASSIGN is the only event */
      if AVAILABLE _Field-trig then
      	 trig_found = yes.
   end.
end.

if trig_found then
   {&OK} = CAN-DO(_File._Can-Load,USERID(user_dbname)).
else
   {&OK} = yes.


/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */

/*************************************************************/
/*------------------------------------------------------------------------

File        : prodict/dump/_dmpaudp.p
Purpose     : Wrapper procedure for dumping audit policies from the database.
              
Parameters  : INPUT pcMode       - The format of the dump file.  There is 
                                   currently only one mode that policies are 
                                   dumped in, using this utility:
                                  
                                   "x" = XML format (.xml)
              
              INPUT pcPolicyList - List of policy names to dump.
                                  
              INPUT pcDumpFiles  - The File or Directory name to Dump to. 
                                   When dumping xml, the output goes to one
                                   file.  
                                                                     
Syntax      :

Description :

Author(s)   : Kenneth S. McIntosh
Created     : April 25, 2005
Notes       : This routine calls procedures in the $DLC/auditing directory 
              to perform the actual dump.
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

CREATE WIDGET-POOL.

DEFINE INPUT  PARAMETER pcMode       AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcPolicyList AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcDumpFiles  AS CHARACTER   NO-UNDO.

DEFINE VARIABLE cDBName     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPolicyList AS CHARACTER NO-UNDO
                                FORMAT "x(255)".

DEFINE VARIABLE hBuffer     AS HANDLE    NO-UNDO.
DEFINE VARIABLE hQuery      AS HANDLE    NO-UNDO.
DEFINE VARIABLE hField      AS HANDLE    NO-UNDO.

{prodict/sec/sec-func.i}

DEFINE STREAM errStream.

DEFINE VARIABLE gcErrFile     AS CHARACTER   NO-UNDO.

FORM "Policy List:" VIEW-AS TEXT SKIP 
     cPolicyList VIEW-AS EDITOR SIZE 66 BY 3 AT 
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 4
     &ELSE 2 &ENDIF SKIP
     "Database: " VIEW-AS TEXT
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
       AT 10 &ENDIF SPACE(0)
     cDBName VIEW-AS TEXT FORMAT "x(32)" SKIP
     "Dump File:" VIEW-AS TEXT
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
       AT 10
     &ENDIF SPACE(0)
     pcDumpFiles VIEW-AS TEXT FORMAT "x(45)"
   WITH FRAME statFrame CENTERED USE-TEXT 
        ROW &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 4
            &ELSE 2 &ENDIF NO-LABELS 
        TITLE "Dumping Audit Policies"
        &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
          VIEW-AS DIALOG-BOX SIZE 75 BY 7 THREE-D
        &ENDIF.
   
gcErrFile = ENTRY(1,pcDumpFiles,".") + ".e".
cDBName   = LDBNAME("DICTDB").

/* If the user is not an Audit Administrator display a message and return. */
IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN PERM-CHK: DO:
  IF SESSION:BATCH-MODE = FALSE THEN DO:
    OUTPUT STREAM errStream TO VALUE(gcErrFile).
    PUT STREAM errStream UNFORMATTED 
     "You must be an Audit Administrator to access this Dump Option!" CHR(10).
    OUTPUT STREAM errStream CLOSE.

    MESSAGE "You must be an Audit Administrator to access this Dump Option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  END.
  ELSE DO:
    OUTPUT STREAM errStream TO VALUE(gcErrFile).
    PUT STREAM errStream UNFORMATTED 
     "You must be an Audit Administrator to access this Dump Option!" CHR(10).
    OUTPUT STREAM errStream CLOSE.
    
    RETURN.
  END.

  MESSAGE "Errors were written to " + 
          REPLACE(pcDumpFiles,".xml",".e") + "."
      VIEW-AS ALERT-BOX INFO BUTTONS OK.
  RETURN.
END.

IF pcPolicyList NE "~*" THEN
  cPolicyList = pcPolicyList.
ELSE DO:
  CREATE BUFFER hBuffer FOR TABLE "DICTDB._aud-audit-policy".
  CREATE QUERY hQuery.
  
  hQuery:SET-BUFFERS(hBuffer).
  hQuery:QUERY-PREPARE("FOR EACH _aud-audit-policy NO-LOCK").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().
  
  DO WHILE NOT hQuery:QUERY-OFF-END:
    cPolicyList = cPolicyList + (IF cPolicyList NE "" THEN "," ELSE "") +
                  hBuffer::_audit-policy-name.
    hQuery:GET-NEXT().
  END.
END.

RUN dumpAuditPolicyAsXML.

PROCEDURE dumpAuditPolicyAsXML:
  DEFINE VARIABLE cErrorMsg    AS CHARACTER   NO-UNDO.

  DISPLAY cPolicyList cDBName pcDumpFiles WITH FRAME statFrame.
  
  RUN adecomm/_setcurs.p ( INPUT "WAIT" ).
  /* It's the caller's responsibility to check if the file exists and 
     check if it should be overwritten */
  RUN auditing/_exp-policies-db.p 
             ( INPUT pcPolicyList,      /* comma-separated list of policies 
                                           or "*" */
               INPUT pcDumpFiles,       /* xml file name */
               INPUT LDBNAME("DICTDB"), /* logical db name */
               OUTPUT cErrorMsg ).

  IF cErrorMsg NE "":U THEN DO:
    IF (SESSION:BATCH-MODE = FALSE) THEN DO:
      OUTPUT STREAM errStream TO VALUE(gcErrFile).
      PUT STREAM errStream UNFORMATTED cErrorMsg CHR(10).
      OUTPUT STREAM errStream CLOSE.
      
      MESSAGE cErrorMsg VIEW-AS ALERT-BOX ERROR.
    END.
    ELSE DO:
      OUTPUT STREAM errStream TO VALUE(gcErrFile).
      PUT STREAM errStream UNFORMATTED cErrorMsg CHR(10).
      OUTPUT STREAM errStream CLOSE.
    END.
  END.

  RUN adecomm/_setcurs.p ( INPUT "" ).

  IF cErrorMsg <> "" THEN DO: 
    MESSAGE "Errors were written to " + 
            REPLACE(pcDumpFiles,".xml",".e") + "."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
    
    HIDE FRAME statFrame.
    RETURN.
  END.

  IF (SESSION:BATCH-MODE = FALSE) THEN
    MESSAGE "Audit Policy dump successful!"
        VIEW-AS ALERT-BOX INFO BUTTONS OK.

  HIDE FRAME statFrame.
END PROCEDURE.
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* prodict/dump/_exptbln.p */

/*
Purpose: Export procedure responsible for executing the actual 
         EXPORT statement on behalf of the secure dump utility 
         (prodict/dump/_dmpsec.p).

Parameters:
  phBuffer     = Handle to the buffer to be dumped.

  plOmitLob    = Logical telling whether to OMIT LOB values from the output.

Author: Kenneth S. McIntosh
Created: May 2, 2005

History:
  fernando     Nov 02,2005  Split file so that rcode doesn't depend on audit policy
                            tables when loading audit data records - 20051026-060.
  fernando     Nov 10,2005  Adding _db-detail and _client-session   20051110-020                     
*/

/* Define output streams */
{prodict/dump/dumpvars.i "SHARED" "STREAMS"}

DEFINE INPUT  PARAMETER phBuffer  AS HANDLE      NO-UNDO.
DEFINE INPUT  PARAMETER plOmitLob AS LOGICAL     NO-UNDO.

IF NOT phBuffer:AVAILABLE THEN RETURN ERROR.

CASE phBuffer:NAME:
  WHEN "_aud-audit-data-value" THEN DO:
    FIND DICTDB2._aud-audit-data-value 
 
       WHERE ROWID(DICTDB2._aud-audit-data-value) = phBuffer:ROWID
        NO-LOCK NO-ERROR.
    IF plOmitLob THEN
      EXPORT STREAM dumpAudDVal DICTDB2._aud-audit-data-value NO-LOBS.
    ELSE 
      EXPORT STREAM dumpAudDVal DICTDB2._aud-audit-data-value.
  END.
  WHEN "_aud-audit-data" THEN DO:
    FIND DICTDB2._aud-audit-data 
        WHERE ROWID(DICTDB2._aud-audit-data) = phBuffer:ROWID
        NO-LOCK NO-ERROR.
    EXPORT STREAM dumpAudD DICTDB2._aud-audit-data.
  END.
  WHEN "_client-session" THEN DO:
      FIND DICTDB2._client-session 
          WHERE ROWID(DICTDB2._client-session) = phBuffer:ROWID
          NO-LOCK NO-ERROR.
      EXPORT STREAM dumpCliSess DICTDB2._client-session.
  END.
  WHEN "_Db-detail" THEN DO:
      FIND DICTDB2._Db-detail 
          WHERE ROWID(DICTDB2._Db-detail) = phBuffer:ROWID
          NO-LOCK NO-ERROR.
      EXPORT STREAM dumpDbDet DICTDB2._Db-detail.
  END.
END CASE.
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* prodict/dump/_exptbln.p */

/*
Purpose: Export procedure responsible for executing the actual 
         EXPORT statement on behalf of the secure dump utility 
         (prodict/dump/_dmpsec.p).

Parameters:
  phBuffer     = Handle to the buffer to be dumped.

  plOmitLob    = Logical telling whether to OMIT LOB values from the output.

Author: Kenneth S. McIntosh
Created: May 2, 2005

History:

  fernando     Nov 02,2005  Split file from _exptbln.p, audit policy tables only
                            so that rcode doesn't depend on audit data tables - 20051026-060.
*/

/* Define output streams */
{prodict/dump/dumpvars.i "SHARED" "STREAMS"}

DEFINE INPUT  PARAMETER phBuffer  AS HANDLE      NO-UNDO.
DEFINE INPUT  PARAMETER plOmitLob AS LOGICAL     NO-UNDO.

IF NOT phBuffer:AVAILABLE THEN RETURN ERROR.

CASE phBuffer:NAME:
  WHEN "_aud-audit-policy" THEN DO:
    FIND DICTDB2._aud-audit-policy 
        WHERE ROWID(DICTDB2._aud-audit-policy) = phBuffer:ROWID
        NO-LOCK NO-ERROR.
    EXPORT STREAM dumpPol DICTDB2._aud-audit-policy.
  END.
  WHEN "_aud-event-policy" THEN DO:
    FIND DICTDB2._aud-event-policy 
        WHERE ROWID(DICTDB2._aud-event-policy) = phBuffer:ROWID
        NO-LOCK NO-ERROR.
    EXPORT STREAM dumpEvtPol DICTDB2._aud-event-policy.
  END.
  WHEN "_aud-field-policy" THEN DO:
    FIND DICTDB2._aud-field-policy 
        WHERE ROWID(DICTDB2._aud-field-policy) = phBuffer:ROWID
        NO-LOCK NO-ERROR.
    EXPORT STREAM dumpFldPol DICTDB2._aud-field-policy.
  END.
  WHEN "_aud-file-policy" THEN DO:
    FIND DICTDB2._aud-file-policy 
        WHERE ROWID(DICTDB2._aud-file-policy) = phBuffer:ROWID
        NO-LOCK NO-ERROR.
    EXPORT STREAM dumpFilPol DICTDB2._aud-file-policy.
  END.
END CASE.
/*************************************************************/
/* Copyright (c) 1984-2006 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* prodict/dump/_impbln.p */

/*
Purpose: Import procedure responsible for executing the actual 
         IMPORT statement on behalf of the secure load utility 
         (prodict/dump/_lodsec.p). 
         
         This is for audit data tables only - for audit policy
         tables, see adecomm/_impblna.p.

Parameters:
  phBuffer     = Handle to the buffer to be loaded.

  plOmitLob    = Logical telling whether to OMIT LOB values from the input.
  
  isTemp       = buffer is for a temp-table, just for _db-detail and _client-session

Author: Kenneth S. McIntosh
Created: May 11, 2005

History:
   11/02/2005  fernando  Split file - moved audit tables to _impblnap.p so
                         that rcode doesn't depend on audit policy tables - 20051026-060.
   11/10/2005  fernando  Adding _db-detail and _client-session 20051110-020                   
   05/02/2006  fernando  Moved code to internal procedure and call this as a persistent procedure
                         so that a new temp-table is not instantiated everytime for each record
                         imported. (20060503-008)
*/

/* Define input streams */
{prodict/dump/loadvars.i "SHARED"}

DEFINE TEMP-TABLE ttDbDet   LIKE DICTDB2._Db-detail.
DEFINE TEMP-TABLE ttCliSess LIKE DICTDB2._Client-session.


PROCEDURE import-data:

DEFINE INPUT  PARAMETER phBuffer  AS HANDLE      NO-UNDO.
DEFINE INPUT  PARAMETER plOmitLob AS LOGICAL     NO-UNDO.
DEFINE INPUT  PARAMETER isTemp    AS LOGICAL     NO-UNDO.


IF NOT phBuffer:AVAILABLE THEN RETURN ERROR.

CASE phBuffer:NAME:
  WHEN "_aud-audit-data-value" THEN DO:
    FIND DICTDB2._aud-audit-data-value 
       WHERE ROWID(DICTDB2._aud-audit-data-value) = phBuffer:ROWID
        EXCLUSIVE-LOCK NO-ERROR.
    IF plOmitLob THEN
      IMPORT STREAM loadAudDVal DICTDB2._aud-audit-data-value NO-LOBS NO-ERROR.
    ELSE 
      IMPORT STREAM loadAudDVal DICTDB2._aud-audit-data-value NO-ERROR.
  END.
  WHEN "_aud-audit-data" THEN DO:
    FIND DICTDB2._aud-audit-data 
        WHERE ROWID(DICTDB2._aud-audit-data) = phBuffer:ROWID
        EXCLUSIVE-LOCK NO-ERROR.
    IMPORT STREAM loadAudD DICTDB2._aud-audit-data NO-ERROR.
  END.
  WHEN "_client-session" THEN DO:
    IF isTemp THEN DO:
        CREATE ttCliSess.
        IMPORT STREAM loadCliSess ttCliSess NO-ERROR.
        phBuffer:BUFFER-COPY(BUFFER ttCliSess:HANDLE) NO-ERROR.
        DELETE ttCliSess.
    END.
    ELSE DO:
        FIND DICTDB2._client-session 
            WHERE ROWID(DICTDB2._client-session) = phBuffer:ROWID
            EXCLUSIVE-LOCK NO-ERROR.
        IMPORT STREAM loadCliSess DICTDB2._client-session NO-ERROR.
    END.
  END.
  WHEN "_Db-detail" THEN DO:
    IF isTemp THEN DO:
        CREATE ttDbDet.
        IMPORT STREAM loadDbDet ttDbDet NO-ERROR.
        phBuffer:BUFFER-COPY(BUFFER ttDbDet:HANDLE) NO-ERROR.
        DELETE ttDbDet.
    END.
    ELSE DO:
        FIND DICTDB2._Db-detail 
            WHERE ROWID(DICTDB2._Db-detail) = phBuffer:ROWID
            EXCLUSIVE-LOCK NO-ERROR.
        IMPORT STREAM loadDbDet DICTDB2._Db-detail NO-ERROR.
    END.
  END.

END CASE.

/* return an error if we could not load the record */
IF ERROR-STATUS:ERROR THEN
   RETURN ERROR-STATUS:GET-MESSAGE(1).
ELSE
   RETURN "".

END PROCEDURE.
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* prodict/dump/_impblnap.p */

/*
Purpose: Import procedure responsible for executing the actual 
         IMPORT statement on behalf of the secure load utility 
         (prodict/dump/_lodsec.p) - for audit policy tables.

Parameters:
  phBuffer     = Handle to the buffer to be loaded.

  plOmitLob    = Logical telling whether to OMIT LOB values from the input.

Author: Kenneth S. McIntosh
Created: May 11, 2005

History:
    11/02/2005  fernando   Split from _impbln.p so that rcode doesn't depend
                           on audit policy tables when loading audit data - 20051026-060.

*/

/* Define input streams */
{prodict/dump/loadvars.i "SHARED"}

DEFINE INPUT  PARAMETER phBuffer  AS HANDLE      NO-UNDO.
DEFINE INPUT  PARAMETER plOmitLob AS LOGICAL     NO-UNDO.

IF NOT phBuffer:AVAILABLE THEN RETURN ERROR.

CASE phBuffer:NAME:
  WHEN "_aud-audit-policy" THEN DO:
    FIND DICTDB2._aud-audit-policy 
        WHERE ROWID(DICTDB2._aud-audit-policy) = phBuffer:ROWID
        EXCLUSIVE-LOCK NO-ERROR.
    IMPORT STREAM loadPol DICTDB2._aud-audit-policy NO-ERROR.
  END.
  WHEN "_aud-event-policy" THEN DO:
    FIND DICTDB2._aud-event-policy 
        WHERE ROWID(DICTDB2._aud-event-policy) = phBuffer:ROWID
        EXCLUSIVE-LOCK NO-ERROR.
    IMPORT STREAM loadEvtPol DICTDB2._aud-event-policy NO-ERROR.
  END.
  WHEN "_aud-field-policy" THEN DO:
    FIND DICTDB2._aud-field-policy 
        WHERE ROWID(DICTDB2._aud-field-policy) = phBuffer:ROWID
        EXCLUSIVE-LOCK NO-ERROR.
    IMPORT STREAM loadFldPol DICTDB2._aud-field-policy NO-ERROR.
  END.
  WHEN "_aud-file-policy" THEN DO:
    FIND DICTDB2._aud-file-policy 
        WHERE ROWID(DICTDB2._aud-file-policy) = phBuffer:ROWID
        EXCLUSIVE-LOCK NO-ERROR.
    IMPORT STREAM loadFilPol DICTDB2._aud-file-policy NO-ERROR.
  END.
END CASE.

/* return an error if we could not load the record */
IF ERROR-STATUS:ERROR THEN
   RETURN ERROR-STATUS:GET-MESSAGE(1).
ELSE
   RETURN "".
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */

/*************************************************************/
/*------------------------------------------------------------------------

File        : prodict/dump/_lodaudp.p
Purpose     : Wrapper procedure for loading audit policies into the database.
              
Parameters  : INPUT pcMode      - The format of the dump file.  There is 
                                  currently only one mode, supported by 
                                  this utility, for dumping policies:
                                  
                                  "x" = XML format (.xml)
                                                                    
              INPUT pcLoadFiles - The Filename to load from. 
                                  
              INPUT plOverwrite - Indicates whether to automatically overwrite 
                                  duplicate policies found in the db.
                                  
Syntax      :

Description :

Author(s)   : Kenneth S. McIntosh
Created     : April 25, 2005
Notes       : If we're loading from XML this routine calls procedures in 
              the auditing directory to load, otherwise it uses the 
              secure load routine in prodict/dump/_lodsec.p.
History     :
    kmcintos   Aug 18, 2005   Added RETURN to indicate whether policies were 
                              loaded or not 20050629-018.
              

  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER pcMode      AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcLoadFiles AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER plOverwrite AS LOGICAL     NO-UNDO.

{prodict/sec/sec-func.i}

DEFINE STREAM errStream.

DEFINE VARIABLE gcErrFile     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cDBName       AS CHARACTER   NO-UNDO.

DEFINE VARIABLE lSuccess      AS LOGICAL     NO-UNDO.

FORM SKIP(1) "Database: " VIEW-AS TEXT
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
       AT 10 &ENDIF SPACE(0)
     cDBName VIEW-AS TEXT FORMAT "x(32)" SKIP
     "Load File: " VIEW-AS TEXT
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
       AT 10
     &ENDIF SPACE(0)
     pcLoadFiles VIEW-AS TEXT FORMAT "x(45)" SKIP(1)
   WITH FRAME statFrame CENTERED USE-TEXT 
        ROW &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 4
            &ELSE 2 &ENDIF NO-LABELS 
        TITLE "Loading Audit Policies"
        &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
          VIEW-AS DIALOG-BOX SIZE 75 BY 5 THREE-D
        &ENDIF.
        
gcErrFile = ENTRY(1,pcLoadFiles,".") + ".e".
cDBName   = LDBNAME("DICTDB").

/* If the user is not an Audit Administrator display a message and return. */
IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN PERM-CHK: DO:
  IF SESSION:BATCH-MODE = FALSE THEN DO:
    OUTPUT STREAM errStream TO VALUE(gcErrFile).
    PUT STREAM errStream UNFORMATTED 
        "You must be an Audit Administrator to access this Load Option!" 
        CHR(10).
    OUTPUT STREAM errStream CLOSE.

    MESSAGE "You must be an Audit Administrator to access this Load Option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  END.
  ELSE DO:
    OUTPUT STREAM errStream TO VALUE(gcErrFile).
    PUT STREAM errStream UNFORMATTED 
        "You must be an Audit Administrator to access this Load Option!"
        CHR(10).
    OUTPUT STREAM errStream CLOSE.

    RETURN.
  END.

  MESSAGE "Errors were written to " + 
          REPLACE(pcLoadFiles,".xml",".e")
      VIEW-AS ALERT-BOX INFO BUTTONS OK.
  RETURN.
END.

RUN loadAuditPolicyAsXML.

PROCEDURE loadAuditPolicyAsXML:
  DEFINE VARIABLE cErrorMsg    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE hProc        AS HANDLE      NO-UNDO.
  DEFINE VARIABLE cList        AS CHARACTER   NO-UNDO.

  RUN adecomm/_setcurs.p ( INPUT "WAIT" ).

  DISPLAY cDBName pcLoadFiles WITH FRAME statFrame.

  RUN auditing/_imp-policies.p  PERSISTENT SET hProc.
    
  RUN import-xml-db IN hProc ( INPUT  pcLoadFiles,       /* xml file name */
                               INPUT  LDBNAME("DICTDB"), /* logical db name */
                               INPUT  TRUE,              /* wait on lock */
                               INPUT  plOverwrite,       /* override existing policies */
                               OUTPUT cList,             /* list of duplicate policies */
                               OUTPUT cErrorMsg ).
    
  IF cErrorMsg EQ "":U THEN DO:
    IF cList <> "":U THEN DO:
      IF (SESSION:BATCH-MODE = FALSE) THEN DO:
        RUN adecomm/_setcurs.p ( INPUT "" ).
        MESSAGE "The following policies already exist: " SKIP(1) 
                REPLACE(cList,",",CHR(10)) SKIP(1)
                "Do you want to override them?" SKIP
                "(If Yes the listed policies will be deleted and re-imported)" 
            VIEW-AS ALERT-BOX QUESTION 
            BUTTONS YES-NO UPDATE lChoice AS LOGICAL.
        RUN adecomm/_setcurs.p ( INPUT "WAIT" ).
        IF (lChoice = TRUE) THEN DO:
          RUN save-changes-to-db IN hProc ( INPUT  LDBNAME("DICTDB"), /* logical db name */
                                            INPUT  TRUE,              /* wait on lock */
                                            OUTPUT cErrorMsg ).
          IF cErrorMsg <> "" THEN DO:
            OUTPUT STREAM errStream TO VALUE(gcErrFile).
            PUT STREAM errStream UNFORMATTED cErrorMsg CHR(10).
            OUTPUT STREAM errStream CLOSE.

            MESSAGE cErrorMsg VIEW-AS ALERT-BOX ERROR.
          END.
        END.
      END.
      ELSE DO:
        OUTPUT STREAM errStream TO VALUE(gcErrFile).
        PUT STREAM errStream UNFORMATTED 
            "The following policies already exist and you attempted " +
            " to overwrite them:" 
            CHR(10) CHR(10).
        PUT STREAM errStream UNFORMATTED REPLACE(cList,",",CHR(10)) 
            CHR(10) CHR(10).
        OUTPUT STREAM errStream CLOSE.
      END.
    END. /* If cList ne "" */
  END.
  ELSE DO: 
    IF (SESSION:BATCH-MODE = FALSE) THEN DO:
      OUTPUT STREAM errStream TO VALUE(gcErrFile).
      PUT STREAM errStream UNFORMATTED cErrorMsg CHR(10).
      OUTPUT STREAM errStream CLOSE.

      MESSAGE cErrorMsg VIEW-AS ALERT-BOX ERROR.
    END.
    ELSE DO:
      OUTPUT STREAM errStream TO VALUE(gcErrFile).
      PUT STREAM errStream UNFORMATTED cErrorMsg CHR(10).
      OUTPUT STREAM errStream CLOSE.
    END.
  END.

  RUN cleanup IN hProc.
  DELETE PROCEDURE hProc.

  RUN adecomm/_setcurs.p ( INPUT "" ).

  IF cErrorMsg <> "" THEN DO: 
    MESSAGE "Errors were written to " + 
            REPLACE(pcLoadFiles,".xml",".e") + "."
        VIEW-AS ALERT-BOX INFO BUTTONS OK.

    HIDE FRAME statFrame.
    RETURN.
  END.

  IF (SESSION:BATCH-MODE = FALSE) THEN DO:
    IF cList NE "" AND lChoice EQ FALSE THEN DO:
      MESSAGE "No Audit Policies were loaded."
          VIEW-AS ALERT-BOX INFO BUTTONS OK.
      lSuccess = FALSE.
    END.
    ELSE DO:
      MESSAGE "Audit Policy load successful!"
          VIEW-AS ALERT-BOX INFO BUTTONS OK.
      lSuccess = TRUE.
    END.
  END.

  HIDE FRAME statFrame.
  IF lSuccess = FALSE THEN
    RETURN "Failed".
  ELSE RETURN "".

END PROCEDURE.
/*************************************************************/  
/* Copyright (c) 1984-2005,2007 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* dmpsectr.i

Author: Kenneth S. McIntosh

Created: April 28, 2005

Purpose:
    dumps trailer information for secure dump utility

Preconditions:    
    needs the stream to be open, and all data to be output
    
Text Parameters:
    &trailer-info   Formatted PUT UNFORMATTED statement to execute
    &seek-stream    "<stream-name>"        or "OUTPUT"
    &stream         "stream <stream-name>" or ""
    &data-end
    
Included in:
  prodict/dump/_dmpsec.p    
  
History:
   fernando   06/20/07  Support for large files
  
*/
/*------------------ begin Trailer-INFO ------------------*/

  PUT {&stream} UNFORMATTED "." SKIP.
  
  {&data-end} = SEEK({&seek-stream}).
  
  PUT {&stream} UNFORMATTED "PSC" SKIP.
  
  {&trailer-info}
  
  PUT {&stream} UNFORMATTED
    "." SKIP .

  /* location of trailer */
  IF {&data-end} > 9999999999 THEN
      PUT {&stream} UNFORMATTED STRING({&data-end}) SKIP.
  ELSE
      PUT {&stream} UNFORMATTED STRING({&data-end},"9999999999") SKIP.

/*------------------ end   Trailer-INFO ------------------*/
/*************************************************************/  
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* loadvars.i

Author: Kenneth S. McIntosh

Created: May 10, 2005

Purpose:
    Defines common streams/variables for load routines

Preconditions:    

Text Parameters:
    
Included in:
  prodict/dump/_lodsec.p    
  
History:
  fernando    11/10/2005    Adding streams for _db-detail and _client-session 20051110-020
*/

DEFINE {1} STREAM loadPol.
DEFINE {1} STREAM loadEvtPol.
DEFINE {1} STREAM loadFldPol.
DEFINE {1} STREAM loadFilPol.
DEFINE {1} STREAM loadAudD.
DEFINE {1} STREAM loadAudDVal.
DEFINE {1} STREAM loadCliSess.
DEFINE {1} STREAM loadDbDet.

/*************************************************************/  
/* Copyright (c) 1984-2007 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/* lodsectr.i

Author: Kenneth S. McIntosh

Created: May 10, 2005

Purpose:
    Loads trailer information for secure load utility

Preconditions:    
    Needs the stream to be open
    
Text Parameters:
    {1}         Error Variable
    {2}         Input File Name
    {3}         Trailer Location
    {3}         Buffer Handle for loading trailer information
    
Note:  Data items in the input must be named the same as the buffer fields.
    
Included in:
  prodict/dump/_dmpsec.p    
  
History:
  Nov 04, 2005 fernando    Try to find trailer info if byte count is incorrect. 20051104-046
  Mar 05, 2007 fernando    Check if trailer start seems correct - OE00135015
  Jun 20, 2007 fernando    Support for large files
*/

RUN readTrailer.

/********************* INTERNAL PROCEDURES *****************************/

PROCEDURE readTrailer.
  DEFINE VARIABLE iCount   AS INTEGER     NO-UNDO.

  DEFINE VARIABLE cInput   AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hField   AS HANDLE      NO-UNDO.

  DEFINE VARIABLE EndPos   AS INT64       NO-UNDO.
  DEFINE VARIABLE m        AS INT64       NO-UNDO.

  DEFINE VARIABLE j        AS INTEGER     NO-UNDO.

  /* 20051104-046
  
     var p holds the number of bytes to roll back if the bytecound at the end of
     the file is wrong. We will jump back the maximum number of bytes in a trailer
     and start looking from there. 256 is actually a little bigger than the maximum
     size but I am making it 256 just to add a little padding.
  */
  DEFINE VARIABLE p        AS INTEGER     NO-UNDO INITIAL 256.

  INPUT FROM VALUE({2}) NO-ECHO NO-MAP.
  SEEK INPUT TO END.
  ASSIGN EndPos = SEEK(INPUT) /* store odd EOF */
         m = EndPos - 11.

  SEEK INPUT TO m. /* position to possible beginning of last line */

  READKEY PAUSE 0.

  /* Now we need to deal with a large offset, which is a variable size
     value in the trailer, for large values.
     Now go back one character at a time until we find a new line or we have
     gone back too far.
     For the non-large offset format, the previous char will be a
     newline character, so we will  detect that right away and read the
     value as usual. Unless the file has CRLF (Windows), in which case
     we will go back 1 character to read the value properly - to
     account for the extra byte.
     For larger values, we will read as many digits as needed.
     The loop below could stop after 10 digits, but I am letting it go
     up to 50 to try to catch a bad value.
  */
  DO WHILE LASTKEY <> 13 AND j <= 50:
      ASSIGN j = j + 1
             m = m - 1.
      SEEK INPUT TO m.
      READKEY PAUSE 0.
  END.

  IMPORT UNFORMATTED cInput.

  {3} = INT64(CINPUT) NO-ERROR.

  /* If the above failed it could be because the value is too big
     for some reason. This file must be corrupted somehow. But as long as
     the seal info later is correct, that would be fine.
     We will try to find the trailer info in the method below
  */
  IF ERROR-STATUS:NUM-MESSAGES  > 0 THEN
     ASSIGN m = ?.
  ELSE DO:
     SEEK INPUT TO {3}.
     m = SEEK(INPUT).
  END.

  /* OE00135015
     If the location of the trailer seems ok based on the size of the file, still want to
     check if bytecount was incorrect due to carriage return difference between Windows
     and UNIX. If we are not looking at the beginning of the trailer info, set m = ?
     so that we run the code below that will try to find the trailer.
  */
  IF m NE ? AND m < EndPos THEN DO:
      DO ON ENDKEY UNDO, LEAVE:
          IMPORT UNFORMATTED cInput.
          cInput = TRIM(cInput).
      END.
      IF cInput NE "PSC" THEN
          ASSIGN m = ?.
  END.

  /* 20051104-046 
     Check if we can find the trailer info in case the bytecount is incorrect.
     If we can't, we will continue to execute the code below and we will
     set the error code.
  */
  IF m = ? OR m >= EndPos THEN DO:
     SEEK INPUT TO END.
     SEEK INPUT TO SEEK(INPUT) - MINIMUM(p,EndPos).

     REPEAT ON ERROR UNDO, LEAVE ON ENDKEY UNDO,LEAVE:
         IMPORT UNFORMATTED cInput.
         IF cInput = "PSC":U THEN
             LEAVE.
     END.
  END.
  
  REPEAT ON ERROR UNDO, LEAVE:
    {1} = TRUE.
    IMPORT UNFORMATTED cInput.
    cInput = TRIM(cInput).
    IF cInput = "." THEN DO:
      {1} = FALSE.
      LEAVE.
    END.

    IF cInput = "PSC" OR
       NUM-ENTRIES(cInput,"=") < 2 THEN NEXT.

    hField = {4}:BUFFER-FIELD(ENTRY(1,cInput,"=")) NO-ERROR.
    /* Ignore data there is no field for... */
    IF NOT VALID-HANDLE(hField) THEN NEXT.

    hField:BUFFER-VALUE = SUBSTRING(cInput,INDEX(cInput,"=") + 1,-1,"CHARACTER").

    {1} = FALSE.
  END.
  INPUT CLOSE.
  
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2007-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: prodict/dump/_load_df.p

    internal entry point for Admin Tool's "Load .df file" utility
       
Input Parameters:
    pOptions       - class that implements OpenEdge.DataAdmin.IDataDefin.Binding.DataDefinitionOptions
                   - The pOptions class may have a Logger which tells _Load_df.
                     to collect load data and/or errors.
                   - The existance of Logger also tells _load_df.p to 
                     not display and not to show any message 
                     (as long as user_env[6] is set to "f" below).
                   - Errors are collected in Logger:Error 
                    
                                         
Output Parameters:
    none
     
Used/Modified Shared Objects:
    defines several NEW SHARED objects
    
History (from when this was in prodict/load_df):
    Mario B.    99/03/18    Added user_env[19] to signal _lodsddl.p that it is
                            being called by this code.  If so, _lodsddl.p
                            eliminates the display of any "remaining"
                            alert-boxes not dealt with by prior modifications
                            designed to handle this issue.  
    tomn        08/29/95    Added check for codepage spec in .df file
                            trailer; Leaves as UNDEFINED if none specified
    mcmann      07/13/98    Added check for both cpstream and codepage
    mcmann      03/14/01    Added ability to pass in two entries in input parameter
                            to allow user to commit when errors are found.
    mcmann      04/23/02    Added ability to pass in three entries so that the
                            user can do on-line schema adds.
    mcmann      10/17/03    Add NO-LOCK statement to _Db find in support of on-line schema add
    kmcintos    07/28/05    Added check for false alarm in read_bits 
                            20050727-041.
    fernando    06/20/07    Support for large files
    fernando    07/21/08    Support for encryption
    fernando    03/20/09    Additional changes for encryption
    fernando    04/13/09    Changes for alternate buffer pool
    fernando    03/05/10    Fix code that checks rollback error
    hdaniels    03/26/10    Added CATCH in transaction and showLoadError
----------------------------------------------------------------------------*/
/*h-*/

/*==========================  DEFINITIONS ===========================*/
 
define input parameter poptions        as OpenEdge.DataAdmin.Binding.IDataDefinitionOptions no-undo.
 
{ prodict/user/uservar.i NEW }
{ prodict/dictvar.i NEW }

DEFINE VARIABLE save_ab     AS LOGICAL        NO-UNDO.
DEFINE VARIABLE codepage    AS CHARACTER      NO-UNDO FORMAT "X(20)".
DEFINE VARIABLE lvar        AS CHAR EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#       AS INT            NO-UNDO.
DEFINE VARIABLE i           AS INT64          NO-UNDO.
DEFINE VARIABLE old-session AS CHARACTER      NO-UNDO INITIAL ?.
DEFINE VARIABLE validObjs   AS LOGICAL        NO-UNDO.
DEFINE VARIABLE cTmp        AS CHARACTER      NO-UNDO.
DEFINE VARIABLE cMsg        AS CHARACTER      NO-UNDO.
DEFINE VARIABLE stopped     AS LOGICAL        NO-UNDO.
DEFINE VARIABLE xError      AS LOGICAL        NO-UNDO.
DEFINE VARIABLE OK_trans    AS LOGICAL       /*UNDO*/.
define variable dictLoader as OpenEdge.DataAdmin.Binding.IDataDefinitionLoader no-undo.
DEFINE STREAM loaderr.

/*========================= MAINLINE CODE ============================*/

if not valid-object(poptions) then
do:
   Message "Invalid options object passsed to load definitions".
   return.
end.    

/* shared - _lodsddl */
dictLoadOptions = poptions.

/* the code below use valid-object(dictLoader) as flag to not show messages and data */
dictLoader = dictLoadOptions:Logger.
    

/*check runtime create privileges*/
FOR EACH _File
  WHERE _File._File-number >= -4 AND _File._File-number <= -1:
  
  IF CAN-DO(_File._Can-write,USERID("DICTDB"))
  AND CAN-DO(_File._Can-create,USERID("DICTDB")) THEN 
      NEXT.
  
  cMsg = "You do not have permission to load table definitions.".
  if valid-object(dictLoader) then
      dictLoader:AddError(cMsg).
  else    
      MESSAGE cMsg.
  
  RETURN.
END. 

FIND FIRST _Db WHERE _Db._Db-local NO-LOCK.
    
/* only touch schema-change if parameter if not ? - old code often sets this before call */
if dictLoadOptions:SchemaChange <> ? then
do:
    assign
        old-session = SESSION:SCHEMA-CHANGE         
        SESSION:SCHEMA-CHANGE = dictLoadOptions:SchemaChange.
end.    

ASSIGN
  user_env[2]  = dictLoadOptions:FileName
  user_env[15] = if dictLoadOptions:ForceCommit THEN "yes" else ""
  user_dbname = LDBNAME("DICTDB")
  user_dbtype = DBTYPE("DICTDB")
  drec_db     = RECID(_Db)  
  user_env[6] = "f"
  user_env[8] = user_dbname
  user_env[19] = THIS-PROCEDURE:FILE-NAME
  codepage    = ""  
  save_ab = SESSION:APPL-ALERT-BOXES
  SESSION:APPL-ALERT-BOXES = NO.

do on error undo, leave:
    RUN read-cp.  /* get codepage out of the .df file trailer (tomn 8/28/95) */ 
    catch e as Progress.Lang.Error :
        run handleLoadError(e).
        return. 
    end catch.
end.
ASSIGN user_env[10] = CODEPAGE.
     
DO TRANSACTION ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE ON STOP UNDO, LEAVE:

  /* The reason we do this here is so that we cache the settings for encryption policies
     and buffer pool settings and then don't save them in _lodsddl.p. 
     We will wait until we get back here to start a new transaction for adding them.
     The reason is that if the encryption policies are for newly created objects, 
     their object numbers won't get assigned by core until the end of the transaction
     where they are created, so we can't create the objects and the policies in the 
     same transaction.
  */
  ASSIGN dictObjAttrCache = YES.

  user_path = "*".

  /* OE00193991 - this will get backed out if some error happens */
  ASSIGN OK_trans = TRUE.

  RUN "prodict/dump/_lodv5df.p".
  IF user_path = "*" THEN RUN "prodict/dump/_lodsddl.p".
  
  IF user_path = "*R" then UNDO, LEAVE.
  
  /* Catch unmanaged errors and output to error file  
     Added as fix for OE00196232 (error 997), but should in principle 
     handle any error and replaces the old fix for 20020129-017 (error 151)
     and OE00193991 (_msg issues) including the STOP error 15262, which is 
     thrown as AppError from prodict/dump/_lodsddl.p */
  catch e as Progress.Lang.Error :
      run handleLoadError(e).
  end catch. 
END. /* do transaction */

IF OK_trans THEN 
DO:

    /* skip enc policy and buffer pool stuff  if only parsing for now */ 
    if (not valid-object(dictLoader) or not dictLoader:IsReader) 
    /* only process policies or buffer-pool settings if there wasn't an error in the first phase */
    and INDEX(user_path,"4=error") = 0 
    AND (VALID-OBJECT(dictEPolicy) OR VALID-OBJECT(dictObjAttrs)) THEN 
    DO:
        DO TRANSACTION ON ERROR UNDO, LEAVE:
            DEFINE BUFFER my_Db FOR DICTDB._Db.
    
            ASSIGN stopped = YES.
        
            DO ON STOP UNDO, LEAVE:
                /* try to get the schema lock again as soon as possible since we lost it
                   when the transaction above ended
                */
                FIND FIRST my_Db WHERE RECID(my_Db) = drec_db.
        
                IF VALID-OBJECT(dictEPolicy) THEN DO:
                    /* now we should be outside the main transaction. If not, new tables/index/fields will not have
                       been assigned with the object number.
                       We pass this-procedure so that it calls us back to report any errors.
                    */
                    validObjs =  dictEPolicy:cacheSavePolicy(INPUT THIS-PROCEDURE, OUTPUT cTmp).
            
                    IF NOT validObjs THEN DO:
                       RUN Show_Phase2_Error ("Cannot enable encryption for " + cTmp + 
                                              ". Make sure there is no " +
                                              "transaction active when the load process is initiated.").
                    END.
    
                END.

                IF NOT xError AND VALID-OBJECT(dictObjAttrs) THEN DO:

                    /* now we should be outside the main transaction. If not, new tables/index/fields 
                       will not have been assigned with the object number.
                       We pass the handle of this procedure so that secErrorCallback gets called back
                       when an error happens.
                    */
                    IF NOT dictObjAttrs:cacheSaveSettings(INPUT THIS-PROCEDURE,
                                                          OUTPUT cTmp) THEN DO:
                       RUN Show_Phase2_Error ("Cannot set buffer pool for " + cTmp 
                                              + ". Make sure there is no "
                                              + "transaction active when the load process is initiated.",
                                              "b").
                    END.
                END.

                stopped = NO.
            END.
    
            /* if stopped or error, then undo this transactions */
            IF stopped OR xError THEN
                UNDO, LEAVE.
    
            FINALLY:
                IF stopped OR xError THEN DO:
    
                    RUN Show_Phase2_Error (INPUT ?, INPUT ?).
    
                    MESSAGE "Please check" LDBNAME("DICTDB") 
                            ".e for load errors and/or warnings.".
                END.
            END FINALLY.
        END.
    END. 
END. /* ok-trans */

IF VALID-OBJECT(dictEPolicy) THEN
  DELETE OBJECT dictEPolicy.

IF VALID-OBJECT(dictObjAttrs) THEN
  DELETE OBJECT dictObjAttrs.

IF old-session <> ? THEN
  ASSIGN SESSION:SCHEMA-CHANGE = old-session

SESSION:APPL-ALERT-BOXES = save_ab.



/*====================== INTERNAL PROCEDURES =========================*/

PROCEDURE read-cp.
  /* Read trailer of file and find codepage */
  /* (partially stolen from lodtrail.i)     */
  
  INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP.
  
  SEEK INPUT TO END.
  i = SEEK(INPUT) - 12.
  SEEK INPUT TO i. /* position to possible beginning of last line */

  READKEY PAUSE 0.
  IF LASTKEY = 13 THEN /* deal with CRLF on Windows */
      READKEY PAUSE 0.

  ASSIGN
    lvar# = 0
    lvar  = ""
    i     = 0.
  DO WHILE LASTKEY <> 13 AND i <> ?: /* get byte count (last line) */
    i = (IF LASTKEY > 47 AND LASTKEY < 58 
          THEN i * 10 + LASTKEY - 48
          ELSE ?).
    READKEY PAUSE 0.
  END.

  IF i > 0 then run get_psc. /* get it */
  ELSE RUN find_psc. /* look for it */
  INPUT CLOSE.
  DO i = 1 TO lvar#:
    IF lvar[i] BEGINS "cpstream=" OR lvar[i] BEGINS "codepage=" THEN codepage = TRIM(SUBSTRING(lvar[i],10,-1,"character":U)).
  END.
  catch e as Progress.Lang.Error :
  		undo, throw e.
  end catch.
END PROCEDURE.

PROCEDURE get_psc:
  /* using the byte count, we scoot right down there and look for
   * the beginning of the trailer ("PSC"). If we don't find it, we
   * will go and look for it.
   */
  DEFINE VARIABLE rc AS LOGICAL INITIAL no.
  
  _psc:
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    SEEK INPUT TO i. /* skip to beginning of "PSC" in file */
    READKEY PAUSE 0. IF LASTKEY <> ASC("P") THEN LEAVE _psc. /* not there!*/
    READKEY PAUSE 0. IF LASTKEY <> ASC("S") THEN LEAVE _psc.
    READKEY PAUSE 0. IF LASTKEY <> ASC("C") THEN LEAVE _psc.
    ASSIGN rc = yes. /* found it! */
    RUN read_bits (INPUT i). /* read trailer bits */
  END.
  IF NOT rc THEN RUN find_psc. /* look for it */
END PROCEDURE.

PROCEDURE find_psc:
  /* If the bytecount at the end of the file is wrong, we will jump
   * back the maximum number of bytes in a trailer and start looking
   * from there. If we still don't find it then tough luck.
   * NOTE: Variable p holds the number of bytes to roll back. AS of
   * 7/21/94, the max size of a trailer (.d) is 204 bytes, if you add
   * anything to this trailer, you must change this number to reflect
   * the number of bytes you added. I'll use 256 to add a little padding. (gfs)
   */
  DEFINE VARIABLE p AS INT64   INITIAL 256. /* really 204, added extra just in case */
  DEFINE VARIABLE l AS INT64.               /* LAST char position */
  
  SEEK INPUT TO END.
  ASSIGN l = SEEK(INPUT). /* EOF */
  SEEK INPUT TO SEEK(INPUT) - MINIMUM(p,l). /* take p, or size of file */
  IF SEEK(INPUT) = ? THEN RETURN.
  _scan:
  REPEAT ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    READKEY PAUSE 0.
    p = SEEK(INPUT). /* save off where we are looking */
    IF LASTKEY = ASC("P") THEN DO:
       READKEY PAUSE 0.
       IF LASTKEY <> ASC("S") THEN NEXT.
       ELSE DO: /* found "PS" */
         READKEY PAUSE 0.
         IF LASTKEY <> ASC("C") THEN NEXT.
         ELSE DO: /* found "PSC"! */
           RUN read_bits (INPUT p - 1).
           IF RETURN-VALUE EQ "False Alarm" THEN NEXT.
           LEAVE.
         END. /* IF "C" */
       END. /* IF "S" */    
    END. /* IF "P" */
    ELSE IF p >= l THEN LEAVE _scan. /* at EOF, so give up */
  END. /* repeat */
END.

PROCEDURE read_bits:
  /* reads trailer given a starting position 
   */ 
  DEFINE INPUT PARAMETER i as INT64  . /* "SEEK TO" location */

  DEFINE VARIABLE iStartAt   AS INT64       NO-UNDO.
  DEFINE VARIABLE iLinesRead AS INTEGER     NO-UNDO INITIAL 1.
    
  iStartAt = i.

  SEEK INPUT TO i.
  REPEAT:
    IMPORT lvar[lvar# + 1].
    
    /* The entire line must be equal to "PSC" which is a reserved 
       keyword, but if it's part of a string we simply return to 
       where we left off and continue searching for the trailer.
       20050727-041 */
    IF iLinesRead = 1 AND 
       TRIM(lvar[lvar# + 1]) NE "PSC" THEN DO:
      SEEK INPUT TO iStartAt + LENGTH(lvar[lvar# + 1]) + 1.
      RETURN "False Alarm".
    END.

    ASSIGN lvar#      = lvar# + 1
           iLinesRead = iLinesRead + 1.

  END.
  RETURN "".
END PROCEDURE. 

/* Callback for errors when saving policies */
PROCEDURE secErrorCallback:
    DEFINE INPUT  PARAMETER pmsg      AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER lContinue AS LOGICAL NO-UNDO.

    /* we always continue trying to load the policies */
    lContinue = YES.

    RUN Show_Phase2_Error (INPUT pmsg, INPUT "e").
END.

/* Callback for errors when saving object attributes (buffer pool) */
PROCEDURE attrsErrorCallback:
    DEFINE INPUT  PARAMETER pmsg      AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER lContinue AS LOGICAL NO-UNDO.

    /* we always continue trying to load the settings */
    lContinue = YES.

    RUN Show_Phase2_Error (INPUT pmsg, INPUT "b").
END.

/* Handle errors during encryption policy load phase */
PROCEDURE Show_Phase2_Error:
    DEFINE INPUT PARAMETER p_msg  AS CHAR NO-UNDO.
    DEFINE INPUT PARAMETER p_cStr AS CHAR NO-UNDO.

    DEFINE VARIABLE dbload-e AS CHARACTER NO-UNDO.

    ASSIGN dbload-e = LDBNAME("DICTDB") + ".e".

    OUTPUT STREAM loaderr TO VALUE(dbload-e) APPEND.

    IF p_cStr = "e" THEN
       p_cStr = "encryption policy".
    ELSE IF p_cStr = "b" THEN
        p_cStr = "buffer pool".
    
    IF p_msg = ? THEN DO:
        /* special case - the last error message about not loading policies and/or buffer-pool */
        p_msg = "Definitions for policies and attributes are loaded in a separate transaction." +
                " Errors caused that transaction to rollback. Other definitions were committed.".

        PUT STREAM loaderr UNFORMATTED
                   SKIP(1) p_msg SKIP.
    END.
    ELSE DO:
        PUT STREAM loaderr UNFORMATTED
                   SKIP(1) "** Error loading " p_cStr " **"  
                   SKIP(1) p_msg SKIP.
    END.

    ASSIGN xerror = true.

    OUTPUT STREAM loaderr CLOSE.

END.

/* called from catch in transaction */
procedure handleLoadError:
    define input parameter poError as Progress.Lang.Error no-undo.
    define variable iLoop as integer no-undo.
    define variable cErrorFile as character no-undo.
    /* AppError is thrown from prodict/dump/_lodsddl.p and is used to wrap 
       a STOP inside the transaction. The message about load failed is already 
       shown */
       
    if not valid-object(dictLoader) 
    and not type-of(poError,Progress.Lang.AppError) then  
    do iloop = 1 to poError:NumMessages:
        message poError:GetMessage(iLoop).
    end.
    if valid-object(dictLoadOptions) then
        cErrorFile = dictLoadOptions:ErrorLog.
    if cErrorFile = "" or cErrorFile = ? then
        cErrorFile = LDBNAME("DICTDB") + ".e".
    OUTPUT TO VALUE (cErrorFile) APPEND.
    PUT UNFORMATTED TODAY " " STRING(TIME,"HH:MM") " : "
      "Load of " user_env[2] " into database " 
      LDBNAME("DICTDB") " was unsuccessful." SKIP 
      " All the changes were backed out..."  SKIP  
      " {&PRO_DISPLAY_NAME} Recent Message(s):" SKIP.
      do iloop = 1 to poError:NumMessages:
          put unformatted poError:GetMessage(iLoop) at 2 skip.
      end.       
    
    put unformatted skip(1).
    
    OUTPUT CLOSE.
    
    if valid-object(dictLoader) then
    do:
        dictLoader:AddError(poError).
    end.
end procedure.    

/*========================== END OF load_df.p ==========================*/


 
 /*------------------------------------------------------------------------
    File        : _load_options
    Purpose     : Options for prodict/dump/_load_df.p
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Tue Oct 12 15:49:55 EDT 2010
    Notes       : implemented to avoid runtime dependencies of OpenEdge.DataAdmin
                  Known usage
                     prodict/load_df_silent.p.
  ----------------------------------------------------------------------*/

using Progress.Lang.* from propath.
using OpenEdge.DataAdmin.Binding.DataDefinitionLoader from propath.
routine-level on error undo, throw.

class prodict.dump._load_logger inherits DataDefinitionLoader: 
 	constructor public _load_logger (  ):
		super ().
		IsReader = false. /* just to make it clear (this is default)*/		
	end constructor.

end class. 
 /*------------------------------------------------------------------------
    File        : _load_options
    Purpose     : Options for prodict/dump/_load_df.p
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Tue Oct 12 15:49:55 EDT 2010
    Notes       : Known usage 
                    prodict/load_df.p. prodict/load_df_silent.p
  ----------------------------------------------------------------------*/

using Progress.Lang.* from propath.
using prodict.dump._load_logger from propath.
using OpenEdge.DataAdmin.Binding.DataDefinitionOptions from propath.

routine-level on error undo, throw.

class prodict.dump._load_options inherits DataDefinitionOptions: 
     		
	constructor public _load_options (  logger as _load_logger ):
		super (logger).
		/* init ? - important - signal to not touch session:schema-change
		   see notes IDataDefinitionOptions */
		assign
		  AddObjectsOnline = ?
		  SchemaChange = ?.
	end constructor.

	constructor public _load_options (  ):
		this-object(?).	
	end constructor.

end class./*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/ 
/* _lod_con.p  to load constraint data from DF to schema */
/* History
       created kmayur
       
*/
Define input-output parameter minimum-index as integer.

{ prodict/dictvar.i }
{ prodict/dump/loaddefs.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE scrap      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE gotError   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE mandatory  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE numbe      AS INTEGER   NO-UNDO.
DEFINE VARIABLE dbrec      AS INTEGER   NO-UNDO.
DEFINE BUFFER   con        FOR  _Constraint. 

    FIND _File WHERE RECID(_File) = drec_file no-error.
    IF NOT AVAILABLE _File THEN
        RETURN.

   FOR EACH _Constraint:
    IF numbe < _Constraint._Con-num
    THEN numbe = _Constraint._Con-num.    
   END.
   
FIND FIRST wcon.

DO ON ERROR UNDO, LEAVE:

    ASSIGN gotError = YES.
    
  IF imod = "a" 
  THEN DO:  
    FIND FIRST _Constraint WHERE _Constraint._File-Recid = drec_file AND _Constraint._Con-Name = wcon._Con-Name NO-LOCK NO-ERROR.
       IF AVAILABLE (_Constraint) THEN DO:
              ierror = 7. /* "&2 already exists with name &3" */
              RETURN.
       END.    
    
    IF wcon._Con-Type = "P" OR wcon._Con-Type ="PC" OR wcon._Con-Type = "MP"
    THEN DO:
       mandatory = TRUE.
       FIND FIRST _Constraint WHERE _Constraint._File-Recid = drec_file AND (_Constraint._Con-Type = "P" OR _Constraint._Con-Type ="PC"
                 OR _Constraint._Con-Type = "MP") NO-LOCK NO-ERROR.
        IF AVAILABLE (_Constraint) THEN DO:
              ierror = 75. /* "&2 already exists with name &3" */
              RETURN.
        END.    
        FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid = wcon._Index-Recid:
               FIND FIRST DICTDB._Field where DICTDB._index-field._Field-Recid = RECID(DICTDB._Field).
               IF DICTDB._Field._Mandatory = NO THEN ASSIGN mandatory = FALSE.
        END.
        IF mandatory = FALSE THEN DO:
              ierror = 74.
              RETURN.
        END.
    END.
            
    IF wcon._Con-Type = "C" OR wcon._Con-Type = "D" THEN
       IF wcon._Con-Expr = "" THEN DO:
        ierror = 73.
        RETURN.
      END.

    IF wcon._Con-Type = "F" AND (wcon._Index-Parent-Recid = ? OR wcon._Index-Parent-Recid=0)
      THEN DO:
        ierror = 76.
        RETURN.
      END.
        
    CREATE _Constraint.
       ASSIGN numbe                   = numbe + 1
              _Constraint._File-Recid = drec_file
              _Constraint._Con-Name   = wcon._Con-Name
              _Constraint._Con-Type   = wcon._Con-Type
              _Constraint._Con-Status = "N"
              _Constraint._Db-recid   = _File._Db-recid
              _Constraint._Con-Num    = numbe
              _COnstraint._Con-Active = wcon._Con-Active
              _Constraint._For-Name   = wcon._Con-Name               
            _Constraint._Con-Misc2[1] = wcon._Con-Misc2[1] .
       
              IF wcon._Index-Recid <> ? THEN _Constraint._Index-Recid = wcon._Index-Recid.
              IF wcon._Field-Recid <> ? THEN _Constraint._Field-Recid = wcon._Field-Recid.
              if wcon._Index-Parent-Recid <> ? THEN _Constraint._Index-Parent-Recid = wcon._Index-Parent-Recid.
              IF wcon._Con-Expr <> ? THEN _Constraint._Con-Expr = wcon._Con-Expr.

  END.
  ELSE IF imod = "m"
  THEN DO:
       FIND FIRST _Constraint OF _File WHERE _Constraint._Con-Name = wcon._Con-Name NO-ERROR.
       IF NOT AVAILABLE (_Constraint) THEN.      
       ELSE _Constraint._Con-Active = wcon._Con-Active.  
  END.
  ELSE IF imod = "d"
  THEN DO:
       FIND FIRST _Constraint OF _File WHERE _Constraint._Con-Name = wcon._Con-Name NO-ERROR.
       IF NOT AVAILABLE (_Constraint) THEN.
       ELSE DO:
          IF _Constraint._Con-Type <> "PC" AND _Constraint._Con-Type <> "P" AND _Constraint._Con-Type <> "MP" AND _Constraint._Con-Type <> "U"
          THEN DO:
             FOR EACH _Constraint-Keys WHERE _Constraint-Keys._Con-Recid = RECID(_Constraint):
                 DELETE _Constraint-Keys.
             END.                
             DELETE _Constraint.
          END.   
          ELSE DO:
             FIND FIRST con where con._Index-Parent-Recid = _Constraint._Index-Recid NO-LOCK NO-ERROR.
             IF AVAILABLE (con) THEN.
             ELSE DO:
                FOR EACH _Constraint-Keys WHERE _Constraint-Keys._Con-Recid = RECID(_Constraint):
                   DELETE _Constraint-Keys.
                END.  
                DELETE _Constraint.      
             END.   
          END.
       END.   
  END.       
ASSIGN gotError = NO.
END.

IF gotError THEN
   ierror = 56. /* generic error - some client error raised */

RETURN.

/*------------------------------------------------------------------------
    File        : testdump.p
    Purpose     : 

    Syntax      :

    Description : 

    Author(s)   : rkumar
    Created     : Tue Feb 08 10:38:55 EST 2011
    Notes       :
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */



/* ********************  Preprocessor Definitions  ******************** */


/* ***************************  Main Block  *************************** */
Y//+S!+³?3Ä»»kÞ³‰¹kÄÚÁAèq‰?ÍAWWéW9>qåyÔ¡WÔWyA5Úgï¥Ú¤ï#[[­®ëŽRUDÕÀj»ž_'Z©¡‹¬âHJé^ND­†„ÌlÁuZž3¥&wt‡)5XçG”‡ÿÿg0@AêqTiQÈ0is0”È³sÝžžë:Ûyðä³ëÛpÙÀÀ¤ºð¤ÊÀò8ò¤Þ8š¤¤ÊÓÊkrýEkÂäxDC\ß^7‡Õ|*&®Z+³Pc->ûML'©\Ec‹š©.J‚\•³Þ’~±†£>ŒzÐöñ2©Z«¨MÄ3wˆxž9l6+=‹Çñ,Û+&Ïê”Õp0½H¦%ùÚö:ã,;‡]Ht¢+riÀíN¸ÿ”Ö?Ñ‰½¦Ò§Ïw•|ç—ycdçHS7ç‚a‚™ç ¿(ÿ?,µê ¦*ä»Û”½ñPzc¬þ®»É’Ó¬ŒØ9<‰øc¨‰céö,:ÂM7ØöØöàG,®5ýØG¨Õýžà%Õ5Ã®ÕÃ»Ou»Ö±ž±ÖuO®OCqÚb·”=²XnýÚ×ŽÊN‰ËÆX8™tŒwbdn\ÆÒÓ)Ø,Ë,f·•®"–ÿêÝÉÃÔ7iôóWêMÁý·ß»ÜúKSÝCØvPo4~v|¹sï'Ñï¹p8©eÖÊ]É™¾ÞQµ‡Þ—ŠäÞhŠ›[¦úÂõ­ÒXËû=öÖ;ó¢ýðßiØ“ÜEšÃ™‘R#ókËØEïðçè9»b—„qhØo^æÇNä¸S¬Ù{pâ‘é÷¨æwøÒ(Òköú‚¤‘t¢.èÔø]•IîÌ÷àgqÏŽgQãñ@»$	ñÀ‘‘Ü{9ÚH‘§ªªô­Þè‡Ç‰1bï•Îò¦ÄªÄ|Ébx¹È`Œ…(.77¼Zcÿå°d´¿å;3tí´xzÌïÜ”œW<ófª2lžÝbSP9œ9œ†CŠCñ…ÛjÔ†é¿’µ¿wJ¶@e@>@!°ûj+@b	e÷5Á»|ü¬¡l¨¸ò‚+×)—âóó?00BêØæ\o˜Àæ
êêlêê¥ÂL¥í¥œÕ”ÅÊPÆÕ0ŠgØoÆ)‘Ì•Ú<óðù•Ã¨ÔT! ÑCPŠ¤(z³reC+_RT§@Ýâ\\ú¹Ûß—^¾é}œœÛ±|}G}.Ã|¤›||Þm3YîkU?fÕCa¹EÕöÔ–aQ·#BgZ}j·(MÑ?õÅ¡ÕP¥ÉøþåœôkW)$*BÕ	“i4‡~4¸3ô{%agŠ@VM¾<{Õ²òj¹Mºš8}§Œ!5!TÎÎ^˜OÚC^˜† ÐN:ÇÄ˜ÝÑZ(}N|yv®:ú÷Î§…µªÝï‰ò=;m»ú*\À@FF>¼£œu¹ªùÜgî‡’riœÖúÊÏéP‰LëÞÖ:\L\J·2­Õ#Xþ
Ö;õõÎ$X&b›B£ºÓ|µ;Ù5n2¦r>'éO:11ñbcQN^y'cjˆqrvÞzÿ+×ÌØ³÷àNÑ…TK‡¥ÌƒR/4ÈÀÑóÓGÞhúÇÍËsŽ{³³OÄ~C ð’""C8ìì¬„Ü¬ÿÝ¡ÿñ²8gÿñ¥J›€á³ÁìñÄåõš‹R°
[:+Ð&?=°Ð=ý=è=âú‡`/B/`‡lc
›

¥Ë›Ë—nt-¿ÌãÍÆ7ÜÌ©~;Út³‡Ü#p9¡›r¹­}2jÅ$«°M8d*Ù‡r-<,Ñ“r9eÏ©h®Ù<ž¥<µ÷ëì½Úê‚²V4åxë^ù00‹	z[ÇÂõ‹äØÉ2üÇ€?º
:bPAÖ'ZÀ=ôX¡Pü §ÞVNjŒµxû&ãzk½Æôú&”H:ò¾"((ˆ¾ÇbÉ™ÇSb3Š\\ô””¯³”É:ÎbE0Ý-ìú;”’,”v-õ…z8´äÃÈÍß2r§Ù67SâCCžõ}¶P’ú—ô§ ¥V‚KÜtˆú™Ü³qR £·h$zd‹¥t+2\­!‡+ “?öPGk…NÑeÿx/³y¸½
.2«ÿ$¼ìý´øWqD\HuHN'NúÍ¢!äYìC×½¯¿¢÷ç]›¹òºòckDD(G”¿"ûe¦M…ˆYÑb^ôˆ±v0?<¶trk‘ƒ-Tî9É&ÿà :€6Ê:¶¶6æf“6ÍÊµnWµUµnWUÚnÚÏÚÚn+à'thjh¦ª§§&q·ý¨µ·¤×’ÓÒ}«µ«Æ•oCßÒ§Àq*ÿÊ õ:{?ùPîI4lK0nÏ{3®( –-þ.ÄÄúmDxÓ:ÌM7lpiNuJ¹ü‹%ÌWüëâ77œãž,°=tSxš’ŽEmÔ‘Ô‹ƒõƒVÞâ«x8¥DjDK^‰-Q¼F±*rbŒòØè†Îd2Ä·0cæç
Då~*U]mM^_ÕÅÀãKü°ÕV-LvçBo}
è0¹;œÜo;;-–ÿÅY:OhõŠžœÞéÒœ{‘Oøšå^.$Q0´<î÷Nû{Ÿ”¾í{âH¢ð’ X`Wkv¬†gÛf¶ç¸ÿ*Hê‰ƒ3Kˆ•9¼)g?\Ü49L}9ÅvGSß\=,@Å¬TÚ»™º«óù“p”†Äg›Nù+A¡ù››Ñì›V	y]òæåÅÉöàÂÊÏ‚ƒj^èXÛ½ó½Océ‡Æ?ÄÜ"PP±±…Î’¸úÎ—œjT¾hÓ@Õf§&±þ.Ò±ÿLŸ¶6ã§§êYÄÃkçÃnÃkå„Åfïïf,JJf ¨ý¨s‚z˜ÎÙ;0ß©ÆêñÐŠñuÄ4±Öö§ä4<x<G‡`,ýoúk³~
–T–q"[™…pE06Ð!{x¬`H"1ãM¤ÀÒ9@L™Ý7ûôôóüÝJh#Ý›ˆÂÉtª·¬„3SÁ§Òr…9?IÆÊ£ÀÁÂ,'æêÊšÜrŽ÷Vï¬ÇÓÔÎ¢¬SÉºË6b`ž8mC¼FÜÝ~&vÉ¦µÿÙ£ýôIw‹—’ÙNŸn›#âðœØ:Õ3ÂÑÆ[ÛàŽºB †Z5˜A;ó<=†_»L“í›[ð4ëDÖÛ·ÏÊÆK+¯²ƒØ%0àEÌQ-ÎBîV#Á.›pG‡|"0q
$»$¨³$Aµk‹“DF_H”}·IZë¦ð•}XÆ‡EOu¦rNü¦©ÅCÀZWüS.Èúû¯ËsFF¤HŒS•'vŒc“ëvM„Pû¯°C|†b½­v"¨ba2€q†ˆDév`U†ãpbÏ“W[ÁÒÄ6×‡ééB54äÜÖ4pž™z&Ûx×1ÄvªÈ°¹~ÒG¤R;UÎÕÒÒ—ÎªÁŒryþ¢Z±ÿlñeeâª|°wV]lV}¬¸WÖeÈ35ç0Y:0v{ú®þYþNCà0CO1ÍsÍ3ÁE
 µ —yJcPšÙaEÓp84GªÛ³µ‹4:×Œ*µWù©‚¦ež,e¢[*BP¬npÁ
¯PñE@Ï;Ç÷À¡ØÿÇsü³‚Åò—œq”‘ŒV© …Û3­É"ï¸ÉSÏŠŽéÒô®ÈÄÎ¾Âà3ŸÓ¡i}„¬6€Œw|0nubÞ5Å£oÓ,ª°ˆKÓ°˜%‰Iç@ÈÿâWíÐ¿ô–õ*÷Ò}·¼ºSè<!Vba‹,¹øQ½…/Îp*u»“TQ@(yÇ&êœö¿çVwÚÃ-::x%ZÌEOŸ%×ž{wb¼ºï¸jÊu’ÊvMÙVÞ‘©ª¸hPÔÂF hrH‡#UÃZÑÄK©Äi×N(ÁÀ¼*†.Àœ'y–¢Œh'ý¦òboZ;Ljo0R€^<!_A¨E=Ak§™•÷…‘¢•kh,c›«WáÅ_}ü›.MM…O2,›:çù$ûrU¶ÅKùÅb*µ¿å³­ÊY$)1CÑ3Haa9Ý¤)tr[sM·MkNØ»?›š–…†Û\Cá“ŽlÏ’%a^á
5	'¾NLAN±²"G±dù²¼¿ãûÝII¤Ï]¤qtxoŽxëë×LæVÀ¸œâÁJ¼ÜÁ·Ø­ãtÕºé‘uCÇGØs…x’z_Ý+YPç¬:J‚qÍ ¢17ÂãÅ‰óÃ}ÔƒÐºÄ±;¶«pµŒ’›×¯2}ÐpzË
Ý{JÓ™®q:Bp·ÃÎ·ö¶úI '½©ºðôå"ë$Ð‰Ùf°¿‹Ž·³ÖÖöœÆÃò’Ô”ü¿=AZó_™‚ö¾”@GÄž_H5ÓŽûdº‰ò6‡YCª×r·!òR~À5Ï´§;âÝÓ×¶Ç½­åNº…ë“½5PV×7³ÛHKŽÕ•€l†3É‚||°ò·™ß¡€¡ÙÃJòòÃ7÷/0§1BÐ:vœzrt0ÀG[@q»$juPFGÈGÆ%Ü™¢œ“½ãD¦Öx¹‘3Y}ñ“¹¥ÏæT=øÚçÎZÅ4c·;89ZU=zT	i£K½F,¤K—Hñðã£´(Ýd|ì1uät×¢ˆ(„z—W£(°zCeåC+á*uhTùÅ¢= Ð3éËÉïKÊP¦¼úW¹áÓ¡1r•V;ÙÔÓ0V#óMH${ )-ð#u3ï~v`&°Ý³Jºr“ªüÁš.ÞõT.Ô„Ãj)5™ÄnËE8àå—hl>8Ö±±P,MP~'LczM
LÂ¢k#$9GyUU?ÒÑh©ÒÇÅ¦ºâ`t«­2MeO8ú2¬Á•©ôl«b#'/EëºÅ…i«×q†]›®HÊ°ÄFþS37>PñÞ6x-ùüñ=|ÜX[üÃ>:?9/6¼Í6"¨eš¨«'`œEpç…ØJrH†Óœ+9Ð¦éª¶i–lž"}±â¿€dúÕÝÝUùUvT®ñPá—‘TË”­"8ùé‡ô‡ÌB›ÈÜœN‚¹tÿ–'ìÌ{‚ªw2;–¦>ô8©%Æ•×W\3Øk¥Û÷_´s´¢™iªq”þÃÙŒ¢†$IüÙóð3´|J/>&}[V@C÷NzÐÐÈù’üxæÁÈÈû‡ÈÒ˜œL”Š½Ø"Rý¡Lc'cÊFÞ,·CÔü_¿JÜH½ ?ËÀ›PoýÎfŸþm9°+šÑxšg÷øþÿÿ·“¦ønÑtWÛÐR½(B¾¶	}4yJH«W£W†ÊŽþ…^SŸ]ª úÕÙW_´yÉr3Â¡M}Ðek¤ýk,ÝØf{`îÂµªš6.K&fäËòrSìŒÁéÞ_£‘¥ûà×*ÅÕËôÜÕÂ½ô^¶ò‡ºÕšv¿$Té¿\øÐáåéˆ[¢`$`	ÁÜûtÄ22A6UZ«#zMM‹¡~‚}êU02i8ª4:2©5Ãææ[^ÒµŠu´T¯81"•Ÿ ³ D™C·7öù,1Lgã!†?‰Ê ûG=ò’LK!—1åFmW]„*{ÂÄxµ«¼ #= ¾~ã›cßyÐÒ`!f><¥"-5ôJFNG–¡R*pcYü@¦
ÞGÞÇ„ç*~ÛÇÜÙõ÷‡hMôiSE/ëD	A[xêZ–¬iùiÓÅœÙ{õ±
7øØÌø"[‰;‹8[òçŠÌwÙã”¬†Ù}(€áí·ºþšî]ÛõïUYõ¹´ùCAÊˆ€ÌE&ÉUù±±€_&eßÿB“XN›„­ŠÁ…2ä²¢ÃÐ˜LÈµz¯h/ô—½/ÄÝÐÝÙù wãˆœ¼6*Kµvõ¢'ñ¥ÆÉ*:°¡›"€æÐ?Vøê£³ÂáÇaÇ6OJÖßyp…»ïTÒÞê_-0s»6™ß6g‚€œÆLwýCÔ&®Ä>Ð½´WµW_O3 ”@©k²ÔzÅ¬RÕ¾?—´^‹!~â„ÊÚl}ó:`1xn_n•!sHsP‡'(…#×ßìDüÌ3iŽ'p3’#ž©ÇýÎÅí†/ƒî’uþë_h®¹Qrãk±îqÐœÃë~Á†èÓ#„Ÿ1Z±V2ÙòÓU[’š½°µüÿ I9æ¬ím! *(˜[~Ycƒ­Ð‰ R¯G,0œ©1Ž)4Ô[´„D‚7@ýmJC”8â”‡êåSB‰ž¡¸Ñ±N––¤[Ç®¼ôäËÈ]ôi•w¤_üSóZ0ÞŸAr¾‰ä/:rr;	êè÷´ûNÕdõˆœèP‹¤»4Ë½?L©Oƒ¶Au–ïº–gÆÙBTæGv4u‡‡\^¹iÙÎK»¨þêº¢‡ªt²‰[õªTvö—tê‹‚¼a }µÊô¥FAVnô¥}Û03a$È¾i`Kxq·BSAŒÃZJu^—J<Eèìõ%Œo÷R{olÉøtY6Ù ²:[¿cÀ)1ÌÐÍ8)9+±›1Ð1%wä³ÈM#®í„ 	jØ¹	ãKv•"IR&ýÉ¿_d_6[,b•ÔžcÙÑÿïÃ3â@{4¹†L”=YY²™CßÕË°²°=gý
„|.MÜswùC&W@Çu&ßôG”ö b…foaßI.ˆJ«qì‚Á™ ‚Ý$k‚$&ï‰Wïî¤õ¨ö´ÕU;÷îhâÍY¥­•xŸÎ“ö|‚¥žÁcgBßåå|9¤8²Ó¬ÊÛâSú#®»®Ò«¤¤ø#Ï–û®.d,x¸_šU‘úƒIÓéÁÜá:ŽÊXéÊYU\ìnÇ—ˆ‘`t¿¬yÏ)F†>Çw˜ww
¸wSðžÈ>Sª,ù%Å%'6ÉüÙÖ/á˜¯ÝV`úéVÉÏÝeç9ïæ7‹Ó;Êí%£Ãsö¸Òß_ü.ÃpræØâŽÔ’ê µ1Y…Xô*ýK+’+I˜ÃIÒEüý°ùWö™*Ð!¿ªáˆ€ÿá„<‰1L²É€¡ñ÷¡î»]÷ŸËÉOƒŽÝÏfûO³¿¬k{ºaaa{yñárºmšÏi<ÜCUtÕaºgnºRR¡yƒ›ôº˜›ýŒQÐ]_~30¬ý”Â¸ä#'õæXZÚZZ¹?k¦¨¡sòcRK´êÙ$fÖ¸**vÖØÖ¢‹³â‰bÀ÷ÒÌJžtÒ®¤ÈÂÞˆCJÝ"ÝÆ©¤ÇPèFvbÄ­8lO˜Ë†­­]Qòl‘ëa$'6üªü=ŽTTKRM3˜×Ì_žUN)—ñ$ÎÄÄòwšÉÃ™Ld¦z²þ§i•Pfi¬^ºùJAÁÛØêõÀ_d}éºšçÇd,‚YæÃÙ/y¹Kþ¼ç¬-è(GÜ\3|û*k¯o˜¸D(øÎ‡;…¥õ«Íl»¼XH¿cñ5^ÝK‰žyêR×™R™q…Ñq™¥*2¾8­	8Úëôü7tËšÉ‡e)ó:V.äråWååZÖKÇåÇ÷Ö³«–|–ÅOÅ”ï{ÅûÎÿ:zþÇ¼?|¥/¤£jÉi6‡à¾‘¥§òÎÆíù™„ðL ´§,4 "g¡A©@8K«^ÎÂóCuwÑN Ó6ƒ¯!îÉ9+ƒBVKc|ú³T5Órà¢-R±J¹pth¬‘¸>'Ïy/š}DJg-Îˆ[å·94Ø¬óì¼w†)ÎÝÆÛnbÌ­~ÏÝXè|ß7þŠ¿Ñ<t˜æŸ¶ãÝStg³4ggê:h!C(3{DKYs ?*ÛµÔ?d)Òbom©«ÕEðŠ®ú{, '’[.þqXÃ=ÈÇYYæ)æW‚?¤>
]¡`ér7D|Èp[+Î‡¥D{Ùw¡PXo¸Ú«á5.ÀÑÿ$Êà­E%ñ@·%””6æþ; ÜùIùŸI-Ônö¼u¸ÌC-)šœpkc}ZI@Z|c99l©±›àþdƒ»_¡‡·Ö‰[mÌ$ÌÇÔ‹8mGs§`É¾9-"W§Ã¢ÔÃ,ÎZ´çžê<[Ï‰j&œõðëUË>NßšsµøBk?Û‘ÛaÈÈ®ÓÒ­äŠº¹Ü¯HœÚ’»–-Íó+:îï6¨¼2®*Ú¡D°l;Ùt"u¬ëŠ¤ÝøµÑR·W&—ÝN?Š9ŒŠoñŸê‚Šá˜iŽJW @ãRMµ†aÕqÿ¦’²îG"=L¡M·±Øÿè4fëú£÷£õ™÷‰7ßú9Ç…tÎ9Ðôñ ­/³Õ·¦°Ëã”>¥­r¸öê×#k¥Ší`f#uD=ÈlsÐñ.PÀ' è´¤ÏÜDx8‹•‘ÅaÜïÙRƒ1þ„Ü5§ð5×!óX&\6—ÓÌ[r{''q"ãÝ$çôÏ$GùÒÆé§ÇæL¯J?qr&„h¤k{Ðã&Ù”P”®A¼²¾>ÈÃÈ™6añø<·ëÇ“,…\n@´ñoÁcpÀ?Á“¨Sßßâ±Lhh¹ÛÏ()]½’ˆ•¬9ôþLsfs9HÈ-ƒ÷µa­2÷:8Wr¸Ti|”E:ËÎ£û{¥7GC…Cu¦%Z2øÌqIã	85E¼Q˜Pã‚åJ=ÕÁï—<ïyÍâºy—y¹AâÙÏEóBKWcÕnD2K_M©¥Ý!J5Q‰¨ã«o¦ff§ÊÑf2×4¸þ¡Òù2ùâGË–©’‹
â‹Î4Ë~æ!elE:ùýöP
ÒrÑÙûˆ‰¿¨zß×]|þs|•le@m¤+“+ÜNÓw-¢Ó·°Z¨&•Ì¢#Bù²C¶ð¿ìÒ0R8hdÖ}{iiÖ+Ÿ-±*å°ÛÛ¬›q™òÊ?ðq/Þ°ŸÞoJ{¯HÝpÅ~
çáÙÄ²é*ñJ/¿:[õ›´ñÙ—€)72†KxSï=–—ÃÒVH¿Mùc`1^¹(¿Àócë÷?ÊçìúâË'dŠð´m»_¾€ÈéÕÉ’?qÏ]>c·;“2••§cÔœ¼œÁ«Çéü>­ÚÈÁ
rXDŠe¦r¯(ÖÏ)ÒÁõðÆ
FŸQŸ¤Ÿ{Sêœ‹óÔé®½Ž«GwÄÙXJ¸ƒÆ§2É_Œž®ÒÑZ<|ŒÕÿ‚®Q·½u¤l ®&Îæsµèp:Ùf3ÖÁcÿ__„qÐBj,ó¤ƒÀ$â“çÌÑŸ®\þAvl¯¬'".Ó»ü…ézP‘³Õ“¢åÇåÍô­ºÒÇo‡"a7³·ºçàÈ½®Ãß+“=ëâ~&ñciµRJE»_xC³°U/ÙNYãšÈ-…Fs€­Xš r×Ë¹wqšÐÈyÝ!ö_×/#yQ®– ›_mË.¢= çä·A`w¯º¤°¦J†S‡VÃQFDv)ô}ÞS[¦Á[[[Z[øú½8"ƒëÙ¼…ŽnŽ/%˜“qýô‚D\PqDý@F-RI‚k˜~™€åë`ì“NåaFl’oå’ê’nF*=å\½ñ;(ØÐë‰9ç”FþiP1›øz=3•¤àg®®¡JãE×bËxd0É¼¢ibj²)Då	¶ld¶Ý#Ÿýñ'95@%´J(G¿ÕG{]f‚–ŸíÏ…ÏsÃ©«¥§ì7ÈtÒ·7¦êøÖ$OLYJY]æˆô91qUÌ†›t®:®œ,G”šïÁuô	õ9lâ:¹°…)¯+¼Ì+¼\‹’^J>°wÚ'20ê—nÝË>ùëÞÉ³_3 |ú™ä6ZfÕ	¦¯
¼ösÜŸêÜü<q5*L™^.)Í¸k_Jà!Ç¤^Ès¸öA“*“?§(Ä>ÌÁtæŸ¡_°@]ÝùKERÕOóšÚ–Ïç÷‹­3+üP£Ã?"qSBS2W‡Ç&®4é#»ø$Êh‰oŒjxêŸªè¼d™dÞ‰-óf1¤Pl³G2	Ø-èèïÇƒØþp›²œ‰Ü>cõ’á‡ÜÑÅ•`”ù­i }AŠø¨œŽ¸È©fgMnáÉG0™GuÉ––RÒP4(ã
*\®Ú¾wàŒ¸™Û‹ÃÞ×³5Ÿ5X_EPcåC6&ËSSS4­X[Ê[üšüš>+›Ýþ³Õ³½ {ÑÑ9Aæ¬OÇÓÓ×+jÉÑÍ]H‡†WÜJG˜ÁUÌÎˆêÚšÏ“£¯ÕÛ0ojQŒœ@“c™À˜³–±ePs§Ah/9©l);]	 ]Afv.Ióæî4:l3¢AA[¤ªeŒ3EÉArP.ßØÃ½Ù›ÜkŠ°šÔn°•†zPiËäoy|]xR‡4D*ä¬ÿUé6~o9öÄæqC>ÄÓÓA!ˆº¿òû·”ï»Ž4¶—«¢86Ö0»*0,ôÄüÓîÚ§ÖŠr;swÌ/>…Ipð({2Wð‹’ã™Ú«Åüå—44°—_¯
äsuåsËÍ)ëôüx_ÿ}UØú
wcàÚä×ò¤¤fË]øþÿ»ß¹ŸKf6&Ùe@Z,½GÓÝýKBQBý¡«¡¾-¾¡ˆˆ­(’ÉË¬m,çA|ðä{V2=?|['ì+÷^¾äþx¢ò›,¡›Šcœ/ÞáÈÀªùƒk,•YÊkQnyk©NÈG
ÉH”aeTR›¿e±^šÏcß¿¢$&óGyÌÿíÉ¥ã¥„ã#Ü½Ü„RLD„*L*.€¾ç¾°œ¾òï€¾||Á°JíkWW«¿™¡­ì	ßwè™{’$V:ÂBŽ’sð”Ï 
ôƒ9CçºÄB"8•Wz÷¾¡ê+×•<RO”¸Ù¿³	ìöü©lé‹ëü“ÑòèÀÿûUÉ_u /®ÙÈþ 6V·5Íó\(ƒ¾s|o²lžHëžëã©¾){à]{~+Ëw¯¿¹Wíõ¯Ç´‚éhþpœÜG¬ŠÉåû@þ”–A¦™±|ž°lÏ0WŒ•Š¡êqâŠÅùZù³V{Ð€¾[¨êx×«¾Èèå_¥¶:pÜ°¡AC8S³>SC•ñ7:riÇQß2	«ojbZ{|Ë!GÜd¿O³5*òì:ZNš’óéü$ó†;gM¸¸Óh‰ÙÙÉbbÉ^ÙÑÏã:—­ã9ÈpØ±ÍRV5žËÞv‹òF×M3Ï²ÓIk‹í–OËú M¿°Ïý?ýN`³Õ°=o/²½Hÿqoüê«‡°ÈSz0ižÄ•‰—I“…ß :²lH‹}	HÈMTŒI4Vs6#µZ*K::$}:{VVÀïKL°ïÄ¦k•!_ƒZäååàAàâ!‹ÈccvåÅb>m™È`‹Ÿ;&‘CD›¢Å’O²þ»³è•åq#š³”ÉÝ½¯²ÌŸ¡g/·<T%€~»G “bz˜¨“‰zâ‰Dªñº…§ÏðRiõ¤ÅOr-Ð>Œx* ];ÁÜŽëp5Ä
5€…p|ŽppÊ6	6xRTØfvQŸÌø;ûŠhýXPÌc‘ò&jCáéixEâ4ˆ xŽE·xÌØ]€Ž±]Q•BI½Â³¿)„&°.+å¾«ùåâ´	§÷8Ý8™ë#%OÍvg”km5(9‚ôåÍð`Dü(ñà~@Aš7ü_Ï‡|Ž37/j3%IÍÛ‡ÖUÐóPô.~>ÑûH¿~õØg‹‰Üù‹“cÎe™ƒdÿ^·::Ô””aåî”Ü©>]®ð‚CbE†°}e>‰°ÑG5dÂ‹Å‚ÅŸ® iº‡û"K{¶ˆÔŽP¸¸ÇÔ³»ªÔ¢}¸û¬ÛfŸ) 6‹Îƒæbº§pVKCZ¼þ¡	‰W˜ò´	üOŠ‰dñdñÚ :Š¸Šñ¬iÆy~¤ÀÏj*{#Z7Õù6œ.¿ß¾$qÞ¼L²¸[Q@ÂdŠÒ1üMá,a™h?äcä\Sõõäc"&ÙÏ’’=·ÖxâUØaJ6¨@¥ùÌ×Þœa¿Uú<%±>M›¯zˆQ¾>(¾(¾¾¤?Ì]ÈYhQB““ß”!ú:êpVá·ªAmŸJAŠQa1K‘§¯´ Û¦·¡.õâ·Ûg§àg§[g[§¶>	ØnsÝ­gú»‰ôêß{î$3Og:|ac”,3%k%Ua;Á>W×À«V	#	¿ µ]Ù™šüÛÕš¨š9“ú¶(cšøHàž¢ÿÚ^ô ÞD’’-®éhÿ©®+m´bàA		_ÓN¯‡I‹‰I-ó“,§Œ+À@?¬ïÿÉ¬‹]„SVQ‹VÏÏ®nhMQ¿)…ÏÆÄ–#áí” ßq¢òö¨¾¨r3s£=ÂÑŽÃ=Í³³³ß”ÓnÓŽÐö¼¬óq‘{©Itñæ<óê—ÈÅ<@rèžA¶ÀŽ<{s³dþÈ®Àâî4áïp,2c Zn«—Ì˜PdÜP^y[Œ	‘a4oËêÞY½¾ª-mñµÚWIöùùÌÂïà÷a¿ìäD¨Ž†‚_XŒe™]<óÇØœj o«¿Ñ†sxú‡ˆôyõ=‡ÑøË#Ó°ze}SQ2sz)œÔ-ÐïÔî}ü±²=ÔÈ£=84L]»¸&™×R–úYè+8©÷ì´k€ãé™‡úÐ„ð‚)EÑ•_z?í:(ÍI¢ô4óºúV#¿µ4ÝÅ@¾O…D?,:¸‹—'ÕÄ¶
Þj£Tµ%ö¾^Or'¨c·«ïm°½ªfÍøgé{œéþyeÔ8²Æ°ô—W{ 5lô4¸“{¥GúË‰þå• TÇãè´òåìÇ-&²."Öùãcu“hÎ+Z|æü³šÂezKSÐR4‘&X’Q\Ë\ü•çL•dXß±ÁKÆA¼0ZKbi§4ûžþ@Ïoó3~,}hí0ÏsíÒÈp/¾‚ušM<r4”?{Þ1˜6ø»øøÕ))Ùzn¡znƒv=eƒƒÓn%FgC’¾Ñ>UêmŽo£zlÝLOg™¥›hL´ãØ‡Â}Ú¨¶V!b¹
å: V€!Î†b°û*Š:…®õÈÿ:Ó«ú¯†!¬ªiù”Äôü±xbšfNSpX°•->#>>1Zü/újÆA¯²ªù²3:ŸÞ·=©Ð9/þÿ;>qÁ°HÖA¬ªsªº%~ï)ò}%º¥r¥X™÷Ê&…"¥òø‚Ð.‚ò ng9loé³s®IÊxj`±Q`×8;'d¿ü`’ó1¸]	£‡¿ù()îÌuÄ\-‰<¦ª¥b…î»ÊŒ‡G×é¢@€'RÞûÖ„1¡ÉßÇ²2²h†ËˆöÏ)«¨í¿éÜF6Š†9ÞU¾¾Ç½½–eUCCÑYxIWI½I«ÇÞI«ÞÏ6Ï²³°³¶tó®jÙGß+<;Õ”‹°êX¯•ÌnðÂ…¬½N·ÜØZãÀÿdÕ*ÈØ«‰Ÿ}ëŸÿœè·C0«¹Ü¹ð²d3´®Ë‰Ï€“b©Ë°Ž;d<gÏ‡ááÏ~•oo]5ÏÕ~ÕÇ6]ÊÊbú;6ú&…—›"J.™êOR{mdº¨Õf&8@N|)]+ŒÓ|Ì‚8>ÄPŸ7‚ìžñdbzVŽíqžÇÇÅÇiE1Þ“¦[
‹ë8xy=ŸÈx_xeatë9øÛ.Âº›ËŸ¶èëhsŽíÃé°Í/UF`âDŸ¹@¿¿þ°¿ÜÌ½ÜÒ¿‡ýÀRÑü[ƒä¾›‰CËiøê‹ß[ÖôMß°õ'Ïnî¾õ­ýMi'y—˜ÍlÅââ„ëÞ(_ùùÇJOFäåâã|žBK0µ”U?Léjk?L9f‰çqBôBª*ŠÅ°Z—åñÌÞ†ŒÇ‚N-ƒnÎÔ[†E/Í}`w€
^iŒ`iÛIXþÎsŒyá2úç2sµ.qÈ†F5ímK@KZ3'™Çú¹dç…ú>¦ùüŒ*7[9[Îo:9aj+½¼‡¬{ûŠzS¤(*ú.;ú_;ê\L¯_y¯_ê§À˜îyq«“'/~Œ^¾XÂ%±"„ªXÝƒV£ußÄ[³Zýih°êÔ+²Êžžê²ê¼M:ì´N5ë ÷)‰+\ö|ÿ½x˜4lN^]–éÇºï–Xî°ý!ÿ8##såOÆ¯•i8ª&…åx‡ºÎ \Ø›™Xæ–û‡Þ×„z;Zˆ‘}{ì£˜™…E‡`å­ñFÚQ5_Ux²m0Ø5"h;+ Ï0Ý6Md´ÂbY¶¡¼‡óËM‡£X„ÅÅÄU™Ç™*åŠ=P ‰–9-¯XÝÒ~µ°Ü¯°šíÉ«µ¿¹á$«wv:Ò“­,A…EÁÂÎ—ž=*™®ûŒFâ‘–Ò ÀÖ![OM±?½¹–åLœœù§¦ÍV|ˆ—„¼6Ì&ãbK)Xd¢Ýù\ÉJÅìâ/ÅžáÉèÓu1†Ó!q¿d‹u¡@#@àV=3@„33ÉZtE$>AXFæ>ÆêPà‡L0áÀ±;f1»nS˜üÉ™É(ÔŽ;2Õ#ž@òãšÏjá*	¡féšþÕÆ"»âJ÷JòS¡Lölî%L„—h‡{áàJyíïj^QSyPc!ƒÑÍ‘.u:yÐ9á9u¹8RÇ„p’ñ1£1ƒQýÞÜ0††ŽV©î_Êðu¹õ»õý B&õÓrÒRÈ†ý>¯°Ãw!‘âH¨Ôúú8êTxÚV¾^q=œaÄÅ¬ÙPÙÙ¬|?B>À9È19¶š•‰Ž°´çµ+ÜKUÏK¼óæ›î"Ï´Xr]»šnRRïr•-¦Ÿ©Å¬ÑÎ¼¯éø¼ž:Ìæ÷½Ôˆ…í»ogr¬í ½')ìÆt Z=P„ÎzHG6"ÆqÂGœkÚï¾öÙsá–\?ÛËÓ²›¼*ÂoÓË?Ý0Œv«!eÿŠcI@âFRË“$z5¡êÚ¾ÉêÎÃÕÄ–ú-ÓâÛÎåêâÄ€Bš:Ò‘6ÁÁ¹:¢\:\›¢zØ¢ÂÈúÂ9STíº&XËÃˆ4Ž&=sìvñÔÑÖÖ›_—|ˆÌõÆÀš†‡!á!l×½l×!Ål!pýÅÅÅ2Åà53eƒŒó¹evpá5ç~©UMÒT.¹åì{¬u™ØËÚ)ª¢ÈÈßZ¹ò¤ß¹¤òÖJ¢‰š‰ËÖéâÌºì¨Ú¬¢L@'f’T¬ŠÇ¢T1²ù×†“F,sCû`U}È€öÜüçÜÓö¤Ÿ“#üµQí<—1½-FC¦Rü}òøßòPøÖ9‘€
ÕS0-†
q©t‡eAmÿ¾°ØŸ©›×Fj±ÞWóÁÃÙ=»ÿDú˜¾SpŒª?•Kè•Žùâ¨’ú\è†NJŠÍ™ÅÝµw¢3r‹[â/Ébðõ¨±Á=þGgg½X3),,ƒ.Z„(gÇ‡˜â9Ç˜ûrBäÍæñ0—ÖF8)HwÅL§Wõ¶†+!ÍùrKl—·7®,Uvà¨\¨QoÕÝoß(Rž×Ø…¼›Ð[³?§¡k£¸Nè<ÑŒïþËÝNYÿ‹ôRÈ›ã”Ôl˜ø«ÿ,M°Aÿ«&ßúdŽ­9ðÂ»ÑÕ{P²{çNPÖè44ààñ˜…ÿ‘±wµÍp:ÂÂò`;¦UFoåR¾^0ž£\_|¬¬^´ºö³‹ÔîT:o­š¹«îb«bó¶1î2xQÚ~uÐ\ØÄ=Û:Ï¶S…}_T(Ù¤T#Ž&ã}ñ—y£ò-ô†<O;µC¥ì†qè)>ÞÀ¦u+'UÍ¡Í…ø
+/ïm\Eé*­/™ˆ_/Ù:ÂOŽ‡+‚1>ùìbr{š#Õ7ƒÏÚlDýèïáëÿlêèÃè)œì¬óÞJ5‰¿Ÿ‰$‰Š¾´é/z.Ï¾*J4ýG:I£èUð¤Ÿ0ÄNÓEÒÒ•ä.‘gÍÞØîÕ„¸áÞ×î*5Mð4ø“.k£˜@z÷ìFh‘ª½'”9¦ t2"tÛD`¬df¸µ fy²‹N)Ö&"àÊòÅÀ<¥(i`[Fÿm¡‰ý»žx[)†C00;Ñ0ønUìµÞnúõ¼«×¨¤û–Wð£˜¸~÷³®ç`“‰ŸŸ…nåLri}…”kh`²ø‰[ýÎXü’éIïáÎÎ,½5É®ØÍ±[=#7¾ªuÞº;µÄdaâß(5(x‰2;­ž’ËÜmõ˜Æq[´à0N'[4„ò0=þB·.\^Ö·v]_ìñµ‰¦­J$ñò³’›ÄX¦2Ê.Ú[½­.®º[¼Zƒ¾)X\\†œ…@yPE_À#4ÝsŽ¹¨¤ëb”Æõæ®®^çÛZŽVÁuzÀ‘„s´n™½V]/Sì¯ì0T¶¶–ì%†¡»ó’ðÀÉßÂ¨ô¿›ÔØŒãÊ·ÅÅ>ØOÅz(²=t ‹Õíæ„unE1f!=ë'SO8
XM;ˆ«]—¦t€Öþé6…Ñ)åtèÀ•b¨!Šˆlq0R‘Öac1âÈ:þ•ÿE7€§‘ÊâxGÛÉff*´büóE~3ý‹<s
l²_eopp_åä©OiŸ‹ÄZ	ÿtÉ`2vO«ôAqÎ~‰[ºì›ÕùæHÔ¬£;Îõ!º“¶Õ;ä;·z‰(ÒÃ¿_ÂÃ÷£©µÍ•T¿Ã‘ÚäÁÀ¨WÆ’®GÌ²‰ªÄýøúÿ ùåÏâ§BÚNQ.«Í>Æ¸CÂÙM&þKÂükéâéCê¸—±y µÇÙ·†Eïùc2 c;;Ã÷Xb8¯U^˜Ê¤Y–[EbŒ!×Ï…Õpï?…ÜÕÜÊ«"²:‚ó½ÜôÂT×¬„»t 3—Ê<âô71¬N…è’yƒË	n†f’¨2„™möëôxžt¦Ò“äl†™|>UV
>,¬Í/=8ÔÙY—˜ió_ÆÈ0Ú!íãw7Ý5û7oo§§äûû*Ç©Q{Èq‚vd_0"~ïÅá}ÛÞÍíuÀuYjçöÕIy®qû«w¡„ÎûghÞ×éyd§ðùEëc
øxðok+	8†=E‡Ÿ:VþŸõ&,Ÿ~—Ò¶¯CÏÙ<€X]”Ä.
­¢…-J&‡Mö„ÛèT;§ßÎ?•LéànSkè4@M]d)
µ2%F’ñE¾yQÇUÚÚ•,5AEÜÔ¨HjÂ–íTHâ¼„L›·à‰ò3Ôxl™M™$£ÔKÉ›g¨ò8uêGKHûp»] uã?´uÕGûÔ.âûZØ@lÛìímmtÌtm;tmï´ÌÑÑï1qÉ«yÓTtˆHrô:ß— ža° –ä$?¨°#©ò52¯ÔÉ¡~·fŸÑˆê"Ñcµ-ˆ‰‘ˆ’ƒŒG“ø-šÈdÁ@öÍÝ°Á”øÛ…NÔæÆ}ünÒ}úëµƒÁùƒëùs Ë¹pï·÷×Z²û«™³³ó³ƒ-¤ñ×1þµEoö;,¶PÓD=ŒÓÓ¶ba¿³ÑÀÚáèGá*®hÎlÀÿ;¼¿Au*Z-³ýìò_ª[TC„àËì¹M¥FØTSŒ£„^(?ækœ™â"c´³Ãè&oŒ—}žC{Å9ˆýrá—v]ö?•9ÆDÌëÌÕ*Š¿ÐØ¹*Ý"¾$9æ
”F,S—jÌ¸•„Xó\ÂÈBÁ­Z¡Ë·‹½O¾¬«â÷¥#‡¥×¸©òpÈ<˜‹ê·Ia8žƒ‚B-ï¤b–DÍŒœ¨þŽÒqìÁÕù7ÞŽøƒLàQÝÿqt4Ôó2rørvC‹Ì@ïÞ:uü²ŒÁ¥ô¢‹Êåò€¥Q!;O2rX6@z„…!l2-)[ ž¦™B¤€ëÅq=«ÃO¥e¥qŸÝRçf+7P¬‚âˆžÍÕÃ´Oð÷ç&Ô)IN()Ka¿¨l@-~ŒßÞÒ%Ÿdyï;Âqºr–¼}×y>IÆœ>0××w3Æ>Æ·493þŠþÓdÓ;F¶UFÇë‚®»¾3LÂ´><mM€k^uk3ÌykXRlbôE`ŸrFþCbäÇXãëF‰ëQg„#x?Âî„ÒŸ)ÑwâëûÙââ‰¨æà`à	Š‘—iWÌÌ<ú‰_%×©ñMâY`­Z…ìæWÖöÎbä<ùN#åÏ+dåÖV
oræèOâãQßx‹îº­oÊHîÉHeïNüPüÂçuìw|FÍÊŠ¾””¦‚&¿ƒIA¥úÃv‡3·d=gë(Õ)ˆ‰fïÊ+†çÃmÝG½ñyŸ§$Tv–?|Wm£’ô.ç……ÛtÎ=ªž‰‹éå(
emd«!nÌ!ÞÌ!ÌÌ
CµP®^ fTïQx‹ÓÛÆüùxØ‘%““¢‘¢“cGi“HúòtÉ!c‘ÁH~õÞjcà¥d±?újê#48ä*¸ôqéWT>}Ó0Å¼c$7­X\77†\éîµé\Ì—ò6¨ä•Þ[/GƒäL¥ÙÜÁÖÎ€\›‘'a[°§Ôw…C˜¼;–ÄÙï66cÈÈ÷÷È¢‰‹O“vo*bEs¤.žñ†Æ¹à“Ë¸mˆ™$Ÿíä_Úo_oolëm'…_ç¹õºö*¡¦mG¹G¤ÃdjÄ6ÖE',
s¸žå``'ÃÝ`oö8¡í.ž‰µCCˆF4)|…F„#ÿ ÛÐFÂÄý:Œc!yJÎ$è»ÛÆ4ÛÙÁÖ†[ „ýäán¡r ¥2t2~¥®½6ZÜÐ³#5B6?Ê	ÔØ@GÏMI~(	=oÔiiõÕq-T“T)·R®á­ÅZ¹ÝÒÕƒê‡¢m?Áô^–f—WM"sR	U8´4òe£/2Úx	)ê÷$íÚÿm…îk”Ucm”>ƒ_ç¸¶àÞ!ÑXIr	âuIûÖIVùPßÃÕÉP7ù†ÝŒis1`—÷Å—ÉÀk¾¾¿Ç¾ÉKiuQÍvœ£RKÒÐ!£[¸r3‡EV~~ôc±ø#¯õ3Â¬¾Ý»»£s‘õY3(éðp`ÌŠúî z#ëÝw0¹FF@u¿F£êê÷+ÑG½Ü÷7s+&Þ%û2ó ±–4¶¢>÷Ó¿ +¸fŽË­Th_±¡Ì‰Q:šûühÉ@ã««;>Îu)ÇÎÇ8ÖCÂ È &¸=þ7c	6Jc‹exàé‘)É¦Ø7Ep3×èpÑG³E]T4U¸au<–”Äù®©üÑ³D]VÕ?É®k^Ý]óg~As''®fOI]FEj½cYC ¦€aA¦žÏ7éØ
±¼•d`™YáYQK€OéÏ‡?"Š^xL1Îöóû}:?»J´ZÍMp/V+áÜÅWþ;¬MËÆW±cYWÞ$õ$WÞ%ixQÎ_Ù†+‹}(¸“Í"Bz›–'Ç–‘\ñè€0ãK"KXX\D­ûÙ£/P/ò£Úò™‚z/P9‹Ç‚‚‹ uu3F¦å6ZËÄPžkýíá• w^Xm:]M€åå¾'¦I|^'å»ï'Æ24uÆuÌööÕa&&®ÖÝ"þ®›t®ÖI"¨æœ@pzÃ1b`bÕ÷%ƒW3®­ïYžÌoJQ‹z0*	ÓO5C3ÒÅ%#ÓúWW^j¥TÌ6Æ²““·A–ft`j´Ø@†Qþª©‰¹â¨ŒÏÉö¹˜Ý¿„˜mjçö³YGøÒŒ8¥I._§J^qVë:1cžXdhP6ø4=úqM0S¯ÅøŒ›àÇöèýüÞ4Þ’­…ÁZ‚ûYƒ¿€!8²þþ+ÝB<Æ›BJÓ°°…Á€iŒ*V[¯mÓ-T}TN¸—‹\È#ì”ñðÏ#ËTeª [ÉÜÉ~xP!†·+ûˆ0³DÜ"ûÄ-nùìP&l'…'…\T¦5ÈL¦c÷Ì¹U¨-ßAÑ¹fÄAŠÈ{~ }9ØàK…	ð9–¦C£ŠUT/€æE£€÷˜%·ï©l]¾¡îúgb}ìsÏ+s°s'ç£PZëŒ:ý`©Î.+x³çÖaåxõéá—÷¼1šRÒÉ=Ôáã›ÉÉ[sÆê„ß[4¶?.r?—÷{âº¾VÓÈä»‘ÉÚ»\ô·n/zxö91sEûª‹ûûÃ®)ß{>Šw5€fÆtcw¸+=<T:ZúYàýX0}7üm~á®rõ>õ†a†?9w~ûp	
w¨||Wþ•™‡¯=@K`äø I×¨;¤-²ŽÚÒîLvïnƒí–ÇCÚLch-A©ÔL†í:9œÆøaóMåÍ­Ð”:@žú˜Ù_¶ÜJ÷Ùÿ’ƒÖ&ü¦·¾˜¿ã¾¬Ã¤{c³˜¾m‰—9y^bbà™â]oKky$yÖÎ¾‡8‡©´¸”uãŸtØã` y Pÿ—¨½Hzš‘¢"úëÓ¼Ö<¥Ñ)ŠÐJ…Õ›Oz×$™°œ;…°™÷Õ¿ñQYªŒÞ9üÞuÚx!E´kP(<Eùe IÒQ‘ðê: RyÚÔp2|.yð«ã Wõêƒ·€¯üˆ (ÏˆþGf£ãÁÁûŠÜ>åþYl–õŠñ•È.ûÈûHƒfà€NûûHÿ|„ÀÀAÊµÊkdzN”dd”íNÃLèÝ=@ïtðbˆ¬®Ìµ]åRáÿöHLÀN(Ñ†+ÜõoÂ±oeþ‡‡ú^ùìô„œ=™új¨«‚ñ‘ÃêçÊŒ8DðWa?
a$~†ö«@©ÅZæ£¯Ž¹ã44yg;mŒmlôýMJ¸[öLjÂ^+¹ûáÆÃîûÂ²`|<Ü´ul¬Mu²u¨í¥ø¸ˆ'EnÎ°È:+«/¦¢[oØ±ùÍvluµ”’	xƒ	A5ò¬LŸQ‚+šÉÈ¸ß¬)ÒÌŸußˆÛ'‚š‡÷7gá4nåƒfuÍ…¼Êª1•
´®»—;¬iÄOZFàwcølãûˆ(@˜j#j¸#Š#¸M"M’À¢À’ÍVÿMnÕÿVµÍ†â`âEèmˆíâññËÈ%6Ûh¢™û ãŠ_Í½àýÜ­\ƒ:ÆýÏKÁK1&`-”èóKscµ §™Û‰:ªÑ:YÃ‹Ã.ò\»\ðä.„\ëqÙqÂŽ°Ž…„qBãBågGfX\;›Ð1mŽ†rÖ
Ê?ÉÔê¯³~á½¨ºÛ Õÿ&ÕÒ&Ô£—[ånÅjZ…†ibf—g‹_b‚;]ÌKž„E
„˜3é®¹Þ¢Š×§X]ÁÈŒÛ[0Ì:¨"huXÑ`_tÎhCkaÞEHˆF(n{ÊP×U"qYœCPŽŽÜÔeŠã\•“Ëò+Dƒ a v3g»)8uìé.ÌxÏÕ6;ÈÆÓ€­=yy¦yuæyõæõ>ê>þ**MÚ§oÚ9’•ÏôÔˆ™ŒžRD³í=Ó“›&jšõÉJ†ÿ•sÃ+~âÑ>ƒ'6è°}ý>CðqÍ­¿`;Ø×E1$Â‚ýÀ^<˜ððóá›OC^›ŸÈ^½uh›z|Ý¥
bA¬$uHÜLÎÍ¿ã¶ô«1:«çÎhÍ±¨ ôÕNÀjÙ¼_&$uu.{QCUÁð“Ï*lêñX÷íu—ú!ÙyýxxÃn‚ãÃí¨Òõ‡‘>‚›Á%–r@ˆeÔG~*qêêLˆHÆìlØ´wÛ¥ÕV¡lÇ|Ç|¢ŠîgA~ôõ¨Œ”VbYƒ$IºJv†E<Û ‘6\‹µ	ží1ù­¤H¬O*±#1ì6Ø„®øœ)51d®5{g5€\YSeÇXS÷×üxÈSgèèYv¥\Õ  Õ¡–®ÊRù‘‹sâ%Ÿí§!ž:%df\1Ã?<ä³ð›ö¯$3ëWã‘ã‚‘‚æ‘¬¥›¡¤<ÈÑ#Úý÷ÉÚ"¡²<™À!º{8b—OŸsÅÒøQpÙÁD©ŒÂÉ4û3äYykõwìììl†Z‹aDŠ¦ª F6¢šý¶[¢%3¨ŸçYëÜž È
k]£QàUŒóªí²¼üúÏÞLúìîîÝC³VÍÚKBžìFÃý-Äxå†ho˜¥ŒØç³!ÈË“Í_ÄþÑâÒGž;F_m¹mw‘tW&_íaüå"GBwGµ¾¦w$(jUÒ1îÜíyWCX÷²n¤o¾ö¡ýüâUö8=Yàµ5ÑgfÁ3•R_óu˜˜Q
#Uˆç1Zbaç9j,ù±àl:¶N,•tÿÏ,€îþÈ×´àÚR%íý?ìm#‘u¥õød¼S*`|îDê…Ààˆà‰2ÀZ?A1QÍ?½´‘“—?ÓUäc¡Ý±/þ±ò²Íu5NkOe-‚öC/ysC›™-0›[Zv.cÉcZây_ÜÉÜÜè¨ª¤ènën’˜Oä˜\”B/K^MCtÎÛ†ämtÍbÉfÉ³b¶bbÉ„!g¡â—iâ„+Bfs²,’(Fë7ÚÒ1XøKâ”4gIxyä'ÆÖì©UWW©LnNåkÏónå~ß×4Tßß×¸ºY@Yõº¯^V¢á	Õ’ÑÈ/©;{âj¤C+~Écý_ý  Ž=íÕýÁq„¹ÁáénN°q
³ÿ«cÿ²ä@øNc1=þ<t\ý×–3þÆÞ»vÚ‰ ²œtt&p&Z,üüZ
¡‡‚,<ëyÊ‰åGÞèhÙGøP‚—at“Ë1z-
=(»ÿÖž
BOs#Œ7MŒö±ìfé¶â$(ŠÒÒ”W¿gÂeCÙ\8QÖVwcY.ŽÉºûá†Ë}†•a¡ß—ããÒù`²ó	õÏ¶¹³¸`ÖçµÔVµ0Š÷VÔµ¾ŠÍÊÜ/y	½eB6¼RôÞö¡ÜpÁÃß¦ñÁêý´9î6îîªŸ6É&&¬žI`'Âªm.¤¹R°	Z½3»^•ÍRÑKÒ”³ìÒßgIÉ‰~¦ðrÖPØìu¸-»-ˆZ¼-Þ|-ˆPG¼8L"ÙF;V&”~>[¥Y2,-ååk.^a(^8%¯*=e@èî(‡¡‹ììììÌ6à*¡7vÿì(7^é÷òA×Bo—;	=}‡>
ÃéGJÓ¡?öôr9Fñ”Ÿ½ÉÖùÎø1*0Î]øÓÎÕ²==LR¡¥ºï6P0_¿,Óñ÷[Q×Ú5‡Ú×Ýõâó6¶[¶ôc
PrGP˜u?Æ1Z<ÉÈî¬³Éòl2ä¿¿Ðk«¬ÐÎK4ÕX÷\b ˆ>ˆxxÑþÑRææÉÆË06´Ú7
¸vÒ²–ÒÃñ§ÄrïHØßô*sZ.Úu*PãÜBòö–ÜzÿïÜHkL°¨¯ˆ±mª]œ[Aµ–U¼Ñç²¤]Pƒb439|4l¯‚Ìl‚¢çj@ÍÊ5´>œakÔÁ¥S&¤²d[,tç@Ðvš÷35QjYÃÃJÖëšJJ|ë||\\üJÖ‡ÑÔ@>ÑÑ>ü>B[C.6šKvtÀ=%ëMª¥Ø6‹Ÿ}å»ÞHºþ@ÌÑJÃeÕ<“ÇŸpýÔ>±íàpËÄ°p¨ŽÔiàŽ†Sç+†jé+aj²¯¯¯îËB=¿è+“Ý$©-˜Å«ñž¸s-Ø%AA„Aö6¨Ë_žÎWjÎööj"´"3‚53Ùæö¼FÐ¼­kdumsËìc‚=>šûð¨?“dÏJIø¬Ñé}`î:tf¦©­xHÖíÔ!hòÇSÄžk*À=Ùy¯šMTò`È:BÈBÖKÈ¶þéÃÈ=zQ¹`.õ¤|y_V®¼´Þ¸â…ÙÖu¿”ˆß1”ÿ©|ÙhÅ^P_Â‚üµQ–OžO¨OOOÖOe”-OpJ” y~ATáp‘@@Þ³o¨9Ý‡uYNxä{S`Þs||÷YnÌ÷9AÕœ•Ñæïðæÿ?Ù©:)‰„«XCãy‹ï§ªà
Q@Q®ó¬!þ²õûêŒaðWå ³¯vÕ,ñ¹â¤ññ{lÌÛ¶ÎŽ¼KÎÇúm›¦ïú›¿¿¦N)íUøUU¿ÞZU{òøU£±Z¤j±’¦’êB”.4[^/y[Fê«îI ]¬5¬¬w5B-[v††||¥€–||·AàÊ–ßÓàŽªÓßŽ’ßååøøùŽ|åÒ-±0ìy®ŒWùxDS£ÍP;ò*ŸCOÈ*.,»ú^ƒAüúá¨Ï‚u‡Íux±¾ÔÂ@YPPyoN5>+}wj.šr4È8ƒeK«o@ùg/Nt«Y¨íÅFiüî=/UO½LÙÙ¬ÛÞÍ`AŽ8i—{ã_—4-š0;%¾Öª“½‡‡ß‡ôÜV‡ŒÔ‘®ÌkÇð%Q¢%IˆÕ%ˆyÛ¯LJÝ&ÿQf9yg!Zq¯uFâŠåX[èPÅ¥à[h‚Z«^X^¿¿Xe·Ï÷ßzjMŠÃÚ«Wl÷³Ú”õ¶3ïßDÑa(¦@Ñd–idTwÊ¿ËÊmËmËmm¯ÜÈ¯†ùZ5Šsû^1<ƒ@UpYšlã@¤ã¥Ð—l~µ¡}‚â’]³;idrH°¸ŽßDß’§Ã¸ÃýöÞÓÅÏ_æNâCl¥nT½éþö­å"™š09;á­„®ê7éœ§ÉÛOÛ		aÕzþÉ—Ž}aÐŠ;$„a±Ë°íwì°Ïq3yà|ŒuÂZKº|`2”ka^0vx
)xi‡DÛÞºu00}}|U/é…ƒÕÚòÈ"	fJ::J_$¢úì­0ô\Àã­'›½áOk#½U§¶¿#°³¨Ø³ýšÈ7ÃÌ5É§,:¡]1}Õ8?„bÝ.Êˆ•^•,[^¬ÔÍFdÔvAþÔ`;Ôm¹ñ:-š‡ž&œµozÈù—zá7Øº÷ZëÎÙÎ…rB%eÙ¾ˆO€)…¯gMvJ–úg½áJ–@ÝìÐQØäëÄÐÎ®ÈÀ )y¯¹…ôÄÉ^	QaHl?ucO{ÔkÆûòÑÂðÔØ.±¡‹³ˆˆˆêˆ\}X  X ¬\Í§¡™‚ª…O®—ü/ºŸŠé­×¼…yCƒ8ð4×Ä~õ‰Ž5;yj3J¸ii232Oë´î^eRiâ_!ãy!Çhž\fõid>-pXZ?‡VdXt9ÏÃjÒÏhhEElÏmì…05ñäì>´ÕÜÛyy¯1Âòò#%#á4Q)t›Qp0_¥‡*·ªb}²sw/ÖY–²1ýêÁÁÆn»¥g‰µã™ŽGi?Ó“\”Ñ9ú¥ÿ8iXAÃžnW'êí:'‘RhÝq©á»æ‚ühÈù%T#Úw%¯óÜËåš°‰Éê-@€åƒû…_íØ_‰BñÄƒ|€‰øÿ2,“¾ÒÖyCæyå_»V†æÌ4Q#Q¨ŽV®C& Ì¾·’ÖVÛ¹¬üsµH9G¹Ó–ÅwTû
ïÜð½oxHÁe>#kD·¿èÛ7dÞ›eñ!!Cè…¹fá¤Ž“IŠ¿†«îñ¬âÛâ,,WS&†5”mØ72Ö^O½WÔ×_q¿à)„qtß†ˆ¤W°_ä«!__!+Øâ~#‰&!àYÃø„„”À‹ã­äIõ—ñK{-k\¦ÐœLÇA_sÅ2%>Í˜ÉåÍöõœæYõa§aë.	§ëSÿiÕcÕ_Á>wf6®ù£Òxð–>ã¾iÊe¢ØlŸØæwlßŸ	8ßŸ#9xwŸGGA®OŸëÔ:õ·?ô™y÷ÊFbŽ?Ú&ÒÆÖ®ûÅÝuÌCÓ¥UU˜þ÷êÕ¥Þ²¥J€îULAÝòÈ}(¶k~„T”Ñyh­x­®˜—¶M¸ÿ?"Gï1ÍxÌ6ËûÑr¸›ZÖ]]œµ¸:Y‰ˆBBŠ­æ#W­(ñÁ­Ä§XŒ÷ór™“Råf§¥ÔV·¬†k·Åk3Ž5ÅäjjäÅ©,¨,ÀS¼,ïoW?*TjùØ6oE.ÇI×Ëwù¦¿ûidÈ*ù«ÏõÞÙÏì”œS—†ûÑw=¢û=1=†TÑªT+ìžLCGQFªvxlK€‰ÓvºI:ãÀ>’üÐþü&?Að.î8çLƒq‰R`vovŸýýà8®–mª¾fÿÚ‡O±0ú¨pÁÊ&Ïö
â™3fœÀ²)ÎÂô°’up’´{ˆfa”z âìòíàOžŽÓI³¤àÖõJÆ”ß)õK).Qã·®£ÕÖCBæµµ¢AÌóüT’RlqeêTƒ¸Z(@1o˜ifÝ¼©ÈfH]5“…g†Q “¦­·Íô9ÜÑ­§^hÓâí›·äýUéøZÔÔyCµ`7:8Ó°Ó¡ì„H+Äi%D‘ÎB:è<s}–ñQ¦·Y”å#_qp‹-ôs`ÞÁ$`Î8­ù­ùŸ­Þùùã©Ö©â+ +D€§Û˜ƒÛ"¹§ÓøsƒËM>ýr~[Ucmm?:x7â2nðwH«[eås[7»©Ye×·5ÌE5·5’Aß¯iCihÄdÑÄTCdÑ!CÑÁü}°<yíüÂy}µŒ„q<Âqµ2vøå¬Ñt}Ð2úüø5zGGŒnnGGÄsZ‰‰XE«ý¢ Ñp3“…áÑ(è5·53RDèæ·k„„Ž/æmâ¬ŽU!„	@ÔÜÕE„ç›+ÞÙÊL{ÔÙ=‚¥ûM1‹‹¯gÜ}Á‘ò}äŒß«èÕ†j.ÞÎ.¸‡›ˆÎÅh¸‘ú-Ó‹±’ï·LÄ³ùµ•hP:úAIGä«ëµyÔM²¦ŸO›þ*==¸€—`	zê5{Ü«0Ü|âçô(0>>âÚgd>>ògdÓÓò0ª»t0»p#¥ ÞmŸñ!OÄ51ÿÕ¡ˆ?="y¿µ;<ÜÃÄCÉïNÕX+é¥.è
UŽÏ	ÈFÙŽ!)Ÿ3©ñçšyœ¢î**þžZÝÚ&±&§Ì§×PÜ––×®–”·i¯ØNþé\Néû4¡û¶¶Øa××¶×?ÈØ+¢Ä*3_¸ÂÔ+veDôôj{âXšDfp¥æì—Y°%Bë»qÇj%¾y½i°%C#Î¦K>÷ét'2²u¤^(ª ˜ï)c¡²¾]¼Ì>”÷çŒ˜ÒðÞÂŠCÙ–œ³wzž|n›Uƒ}ýe¼ehÝ+}lkz>¬åˆhSIsÉ’]ks,ázg`r$¸³™Iø’’øÉvhýú(m¼2³ŽG£rfù„4AV¿`?……]„è.[Æ¯ëÄÆXX]S2†“Â¢&{“AÑÄuƒð~at†ì\:ñ=˜{³ÃúoPÞ³•>2-ð_À8÷õ~2••&oo__çCÇPî~ÄBRÑ&rŽ?’«O{‰¹…~ÇÓ‚ÇAÜçÇSC^B‚î„ZÚ„ý&AÐýý¹¾Pˆ¤7(š›æzÈä¶Ü€)˜ÔI(ß(}L×—‘„CÅ{'ØÜÍ+Íºý|‘€Ši!¹‡÷5ýó%¿LŸdÖzÊE!½Â1¸ÿïñ‹Œ`Z9Ñs~1!Ž¾4s¯˜Sø×§ç÷õ!ÆÛÌÑß)êÓã7<ÜÙÉ I76I?*òiÝï|²¾P%|¢òã-YMrò™„ÓÌÓ  ºõ9ÿqÌ=î®è\èEæ2U˜Vfý)q#¬éÇ@€ùY—•èCjÈ*Ó[(ÔCæšÞŠ¢£¸©´Êü µfã"ú‘ã¨îë¦©èÎáÑqãµË®P¾1JêµM‰²Vm¥	HL[f#A~fK=zÜZIáh"‘[@B\>qñ¦rl 4Y$sòµ)Î[AXUcôñ*I+”E;ëyT#{1ßp@·é<×•ð4((=¿6ó!ŸH^&ÒfäM:¦´K¨]þÆ’NJ2Q.^h	NŒ@lÙòèeKeëË`9)0O/>’¸Ž™‡•²™P
:y‡Ãž…UGV-±±\~´³6Qê5´Ÿqq|aaªž	¬X	~¿êêùîï¹¡âpãêìdQ¨MPHADËÞ¨þ=oàÒ©!êøóþL'É,ÉO«20c2ñì+ÿô¸_ó½^úlÿæLS@ÃÐv›!º5[›upÒ0Æ;¤¡~ý€–Ýæý‹žÕÑžî¤µ³ÙÚQµï²³#üßÝýÉWœGÅù»^>öÍKÞ\CÂ9ÿÆð» 'bµüŽt8Ž‹‚ý÷Ã×4æñ’ôÆ;ÆÀìÆwuÝ§‹‰ISOæžOBU™´æ™§&0ôSyh3˜…Ri“W«Q%zåmíþKù©»(i(SÅóßf×Ûöqq#	‚Û	„	ñŠûôÍe›ÈÐéÇ.æúñqÂú¡28k=œ‡”6¨«E2 t¹+êÍÂmG³Bj×Ø†.Èððâ³;»£>‘b"|!"_©C¯ØC++ii9ó¤!m£Mu—F´5õõ3;ß;Ê;lþD.a@§Ptä‰äq®(2L°ÚÏÞIp·ùDk±¡ØíözÚöÇ5Ë V«»ìÞv‚›H¼Ê–þÍÝ¯õ]]¾,4döùø¨„AÑJ±lî°#f‘énp{Íœ· MGÃ’Fý:Ü¥áÿaéÂQe´¸@R3á!Û:´ŽÅrÖ!-QúÕ4{9&)Q)"qló7[ŒG¤u¢€~?µ¯ áÚŽ&ÑÒ¦çOO]$ÐôU_@”Ê[toÆ	¢=-¸—ùÖ«²åè„Ä½eYÈÄ—QîQ”ú­œäü¶Þ2ÏÓUÃÌt
¿0†˜ð»Eð]ºG‰ò¨ÿ¸œ
‰$ß,ó7‡¦H9ãº¿¿Ö:gî ÏufÐžlh5B„þ¡¡±•s88î[yy¤Â±8ÂhiV78jÄ{ozE{'BpNÏ™”‘'Ø¦O·›@
Ð¼¦kC·ì|âå]PÒCÊøw@ºGVÚUêR”`ÂM”-ïD%A¤RiEràž3«žEû+ žÎŠ.3]³u8'(”(4B2j]o2¿[^pê¶ý1ZjPncsU’d1
Ö^íí½©CüÇ½è1í>¬pýºÛÁ	â‡‘:±WÈgE8"”'`vk(ŒwA)gÝ(­1•7”æ€ß–¶ý¢Êî4ÊþÿñúkéÐô8>8øÇQ`P‰C‘ùh¬¥©KCJZà‹do5Ý y„ÞüŽ…†®OÊ©QÙ…q—^i£‰œ¦MÃÒÈ™GYæ57BY\Ü.h*wMMZ‘€è†¬RC=¸—Má.`¥±¾Q’î>…ä¯Â©cîÃ»K7mdyö@lç¦Š¦Û¥$YÏ3§—[YÁm+ÈÖeCMÕìvèÅªSZV1E£f¬g†__©«"È¬ÆÉîÐV]«Ÿ‚EˆIÛ«%2KV@/„þèwÜ“Í…×LÂóÍ_„‘oÖäèÚ&ë¬þ‹ÿËÓéØ¾ƒ3x;”..wÞ;8)ADJs6êKÒJ%aµI’CJôe”w)Ø;)/”®ÚKaAar~P$ÎÀ9Ük]ß—oÇˆäXrrrÎÚrQ”ºVÝž˜ŸÝŠ4ß›Õä(žcIöìD<HËæV\ÌõØŠö‡Ø±žìbt&¦óll¨1À¾~Ù=•3‰µ,ì³ö×:î5€h3:ÓQ²Tâd¿]-*šVº_¿Í‰ôl7i"7]Ö¸.'rO<×Æ|îºNY¹^”~ºNNº…juq…G~…qqr&ŽÑ¿9>=ô<ÅnY7]yí¯gÄ\Ä¤Á^å\ïéF3m;ÁvÆÆu?oÕˆÆîÕÆ'o°õ¼,ÓM|ÀŸÀûÍõ7ÓÈŸŸ7R[ER‡55Y‡}BvCÓ§§ìÓ’Ó||µŸŸvÇ@pVµÇÏ2ÕÉêŒ¬ÚÑÎ– ?*#9KuHº:³Ý€Eñ—vöìÂ\niÆZt¡|úßi¡eåò9î-1ò-e9@›bçÓÒCë¶
JãËÅ9ä1ùãä–g¦Ã‘úãºÝ¼ß‡A°|NTŸ|	=ª•‡iTÂi{Âªçêqm@„Jøw+xùÄ$Åº†…aR/§¡ÇÐfdd³m``e™Šqqme€eó  (« 1 MlBöZÃ e	RYáï¥:Vª^‚ZMÌÙW’^›©ê“Íb´DDvD…ùÜû°ß>'õ3»ÅZ“>³|Â^ÎW\ƒº€x/éE‡!÷ær9À(¤kƒ^=YJ^˜™	…x(£ÊæðÎ¦KŽq÷‹¤Kk„ïk¤¤µÌfà•yÀf[X]ô­y=ôØ»¹ç¹Z¢Z]Ó¢ËË7ÆwY[7[3×½Zpr”Pb~cÑ¶cqò³ÔÔ×^ð#;×óiò‰êv*Ü¬±å#äî%âCt^Ç¨Ç”¢­¨ì¢¨”²ìŽŽ“ºÀÀ•Àðƒ¸òØ„‰¤
½ê‡X€Ð{»«ôÒ=ÞD9Øóºª»D¬÷¢É¾ŽçdQ’³¨Ä]˜Np’³CC­m~èäøj`®ÕI`–û¥d‡¶Ô"ñ±®÷.;q	¾©,É4ŸáBÉã¼1°?·=ÒÓ=1=°T_ÝÇcÓ1)ÜÁrØ1ã<×H!!AØªˆôTŽ²sPÀØèx¯ãT£è‹,·¥Á
ÂÁ õ¬?–*§Ÿ1¼Üšž­îÝ'’j}R}1ÃðNJStjƒn0¥6©#qv„†{eB¯’˜äSÉ­‡Ê·C]€ªNÅvÆûÈÓË u2Äpûç—±$ÁÛÀú˜Ôù:½Ùú7î)ÿÿÐ'àµ!º ’¿ ½ciuôì”uC¼ðKà¤k¬>G™Œ›ºF»å²L;(yIß¢P¿E8RYM˜FdE$ë¬ œR^ÌøÆÊD•ÝWÝü±Ì²Œdù‘.¼¼Ý|ÆÙ²±mKØ(´´ü$VÐ\1\Qþ´™Q´ù-\#“³×´ N ³#NOeFò‰ai‹\™úºDÌX‰®"íòÉœÞÅÛã¼Å£Ò¼›¼®Ò8®¹J¦²Ø“UÞU6Þ6ÍzØ»zØ“6‹euÎ©IÈ>˜8œ›º\»ïg*×ÆO%#	&yB}rEEr©HÉ>ÉÇ1ï3ÇÉµ>1>µÌêŒµER®®7>k 3‚raów$Q‡M„úEsu‰d1ÄFây»y«­€Ä0€1‡XVî¸ñßÖŒu|‘·ƒü6?Ã—’q^ÒWò·Us9Þ÷}ï÷ï¦;I«õ=©"­}‘s†Ü ™SÌ‘Ù†ÅGcÉ{3žÚàSÀ{¢M*7n˜-=Ôs14¢hºÞˆ8³‹˜hØ˜ú‹‹Nc ÉØcfØ‡«õ‡«‡!Œææ‡q­‹ª³É†·d²ô¨ÕïõüˆQ‡‡™Ÿ|¸’L Ù[)¬[J›?õp»?ì7B%¹€D‹Ì?¤+D­PÛ–ý”f`}Ñ¥'WwsãóqÔ]mÞ¡¯¹ª­º­““ÞF¹=Ø“¹»“%¹ÌFñ1ñµ„’¥1\¥1XX[[HzAsÅÛœ`nzöìüÜ¡îÃ¼‰áŸç‡÷¿÷ûchL²`€iVL”M$M>oOšºé/(Tž5†c?R?k	lþ!30˜|ìFw
.?˜ 5i¯GFåø¼Jë  S£9LD¼¾é:IyIW¿Ñ“ƒo1:Âó0‡Í6¡ÍütâÕ›þ›ÉâœÃ¬bU¸ÒŠqüoc€°üüŠ‰ò€‡…ë·¥@Ç¤ŸëãÔ ÝÑï?Ä¨Î†?†ãkw!ÿºÎÌÌ
Vã_üïæ‰FLj³³”2©h@½”ñOã˜%5|þ=~íÙÉ†Èøú:ŽtÆýt±qªhÁ€Ö^±kªehï—lìõûººë‰SÑp:s‚Å‚…:À:sÀß v<¹ÜÝ™$²O¸³¯Üò–‘KƒÙÜÿÕø©ÖË°þnYy·†å×A®R„T\QMO]$UÎ
k}k¤byÚË·UòêöÒŒí•f²áÍÎxõJhÛ„¢‰	(W?µU?‰UÍÇÜ§f¸ƒÍ«w3í@"Ã¢'ÐˆÐ';øZ×G„ó¢cÖs^ˆó9ÝÄ´ßc/8äiûŸoäÏA:_Bz‘WkàãéïFö(§²R©¼i¤3‰u¬Ñ[F7ç›¼
€è¦`ZŠ^”
W"hmmÎG²ÀÆ!Û«”ß_J——ñí«–ò†}šˆÃ}èêÇÊ=O†·=i"•–"U°sw?vy+v\|qö‘W¾+ß*poV´2Ð	ÿT&ükü'`@F@¦$’=3ÄX3Ò3D;«"E‚‹!ü©â©ôö»t"‘ö”M=ãê¸»Dmèê¾ÀÛÚÕj;ð;`“	¯\\9ÃÕèJ6¡¼9¸z.£zoéÂÉŽÇo}­ÀîFñE¸}ëÂoáÉÛKm²dñÙËÙËÊGŸ
‡î¾7×xÛoÞx€‰ôqi[…”ÖÜö£M‘’ZÎ$G»M#¾#l9ÄóÇ*w•¾åƒÈRX€+LYÛÃiÒx{z¶—Tå|¼thUwZzp+c`â™IÅ><‹5ölÅ§máF !7'SÊÅPŠsl|€'º£ðª³Wt¤žVtufabKocƒ@,™
ÖNusV€K`– 2s‡SØ…øn<²3ÁW_¤ŒOçGC;Ã€Þ‹‘ó_¯}‚âtHùKÊ%Ë‰£™É®+ùðØ¿ÙmáFY Â~Ó¶[ÿäÊÑüËÞøøË¡’<øÄE˜GËÒË;<OEr­”§”¥ú˜P«Šô½‰«TR6O6íÍ¼Ä]ÙâhíÄ¿í‡ÙÑ¿ûC‘COî¿uaý™Ð˜c}.{¬@"5>QB:ëOÃ:sàîSê=ñîØäêpÁÁ,~å6´Æž5ÇXå¸bqÏñÃðy¶9ÐK»#9÷™Ç€9ü`*à½emfŠ¬¡~Vì…‰U‚>Ê˜,®i©±Ï\nA\à¾UJ„:Grj$ƒkÇ q¡ÁôX›+óáÓï"§ó¤r'»yºo«ooS*çúSÿú-p-`òp¦s}¾€Q9v/z%ùW‚teî,bqä™ðÿt?6—¥çdã ±þ¼·k§»¦ËÕq­/Ø FiFšîêÆ]ˆdÆËÇÅC9]´‹SÏö\¢Êš4ØØ4Ó‡5•4XëšpàWÄ%­9Â3œóÛ¸Ò‹€á>ÎŸDÅ£Öù¥l&d+óOPÅ»ÝJi}±õcWy?É+ïcÃ“!Æ¦XP‹X¥]xóZS¨Äã§Nß¦šOÁR	Pr£r4’cçEuÓÜçáü¬é„U˜âûžûCž0ŽzS>‘•h>²8ýð¹>rµSZWÅ¶Qþ\W‰„dcGò“ì˜šÐÏ¸Í]…âtƒ²Ê½+8àì!›ƒ\¥`’yseò¶ÅýuÌ÷˜Åæ,Åýñ×Àæ–{šœ9SÉë:…)S>ŽrÚvé½±üô‘å.îâd–ÀJD â^ûª.ÿB_~DLE>¢¯z|ÒÆjÔÛ'éÿfÿÎ)ã„5,JYBU_EÚEsÚ7ÚÜèŠŽ7™áÌƒàº0ÞÇaÐ‚£ÃÙ’GÙÆãG÷Í37'„¹j,žò3ÜV|˜P_á1m±JE{WÔ\˜/Jn$¹»Få™ÿ«Ûw™GC¢bÀtXiÿ”Š,«»»¸ÃÑÃÃÁ»Óâ·±?{¬Ã|°µ±éé~9ÉÉÉj:#[¨Ã ¬¢ÞÆÆ,`pþôzÚðòu¡Ô*³ÆœÚDj\ŽJ6†›ÜóÜíÉEæ74rõ9‹d±Â°q~Ý®ebUmp¦d,v?êýý:›ð**›BêEì«¥à-ÆÑì…ÆÊöß0õÿÀv'U4VyÆ.Üë¢k¢rTŽ…/é„zÝ"GD[‘ÈØÊËr¿×Ü¿tiÕT¿Ý¿²2¿¦¹G¡xwBzáé]ÿË°Û°¬hÏÂ¯]Œðó;°äëœjØõ@@r:'©{©¶³ôL9æ^îíí-é•à÷~@˜ÜáÄ÷ó²—$lÔ«mâ™¨tlŽ×!·íleº°qjÚE/·ÞÂÒä2Z'´mD‡G.ëpGFˆ1?¯Ó"Î*dZ4uÞhÊ“óêÈË€©ÊŸÊÊnŸ¨È7F7ÉJŸÕ£»›qÕÊ¼ŠQ´ýc†2v»Ï(Ê²ièü¯Ÿµ£«‰i«¯:VúL²M»ÝfdŒ½«ÄXÔÞ×ìAPãÕ¨ÉÀMÀöÉMä¨`É’Ùü!þ™§Æh<üü´ß“±K‡?œY.†:ayy/Þypj(Þ(]Þy.-SYb‘ÁJbè¯É.;¡‡H;Ø^B&ÇÒížè·‰äðÏxT´—ÉEb!!!À7Ô´kÎæÎæ.`æ‰D&fÅÍ­ÈL‹ŸÂÜØØ™Œ4³ÝÄµŸ3B²Vû™ç°%—Ôn@—~Eš0-E@²%ûû=ìqû)ìÚ‡ûØà³‡Ä0Sž¢®f\ÂÂ3ž¤þ+6ðp^§â\×”¯€¯(€?nðOnKdKœÏ®·õÈKK0¬÷|ŸÕ-}}øRÿ2G4ùÙŸIôø66ÍM<
7%Ó•¯F{’85®¯V\™‚HV5Ãž×K××µžñ`eye{ñAÝ2 ®÷­g*E³ÿbŠ/h7ÈKi"U–‹&ÎEÑCwIR ýÄÇýÛƒzÄÁÁËbgÁÁp6ËŠÀ††_8‹^#®0%£ÉËž›ÎÞÇ»uY¹j*‰˜Ö>* 18ebPeÉCŸCC¤|€G|Šf©©ŸÜÓµ|‘‰VqC(Ü÷èY’¥G|ñù©OG‘ÎhÀFeìÅ¹Õx—ùmþ9=F†ßIIÕ¸>FêM®¾¾ê”&”êñ-²²-;9Dkl¾Ç( Ï»Dvikh-˜ìEþ…à,èàÚhÍÍ%ï¥lè%l2%m0°}n¨+kmè`IÃdMÄåc­ÝóäX\GE>Ž\pNôÿT¤ôp+–´æÙOÏ¸Ù¸hÙ•=Òe¸Ÿ?I6ïq×sÊÒHrZ"¯V©ÂÐíš'‰iF»_e°©IEÌv*ŠÎØÖ—óæ	î‰^JÆU¢OÕŒH‚xLR^ò6¨É¨øøw¨†É† «¡vvvÉædi5G+­/9Y¡#ïæªLSjM:NvÞŸd'ì©¸hVX^á(SPPÎHäSH*ðHð+*-åææ-E-åç	ô::xÞILIÒ?-ÔG³ÌCdyÔgÂ½e*îè"ú¸+½ä%»iÓ6f*¢h?ùNß_œ ùüáI£ÃßúnÊ_ßJøøŸb_`#xƒ#b	üA	Øü6`È7öN©B;×•>d½"aR^é<š£Õ¿Cï‚¯ÝÊ6ôÛ&×ýA¨ßU(Û(°Õ!e¡­Sü½¦ÙÄ¢ó„Bœñðô —QpéaúÅR÷&šyM|%ƒ-¦}áÈôæï?ô“5Æ•žSA‰2HãXo	¢©Õó!fÿr%$ôðâàäµŸ&í“ –d
“œ
J¡¿½j
¦D¾*5ßd1t²7õßfñ·9p|VÛóGŸ1v&9ðñ±Á$îÌvli"†.OIaA0zÇaWaµ_µ<š°T =Ä÷T|Õþj §˜àãˆlcôêJ 1®fùŒ4~çÃ®Zé7Z«@rŒáfid òâMƒd„á‡Ëñ“3'G¾Ý+í	oEâ‰â‹¨¥ÍÝHTàû&|&&ý4Îã%oÛ3¿’úÛû/ÁÛŽ¤Õ›GÕ½Ñ½ýèbËtûÙî¡{Ç{¬=° Xç¹µúé›ÍÃ·ÉÈ§¦¯_¢¼±Èf×¿tÉmço¿/Lêi%Åaj¦e.;ÎÅ¾A/>ÇAp§ÀÔà%öûóÀ4/e”q‘Ë±X¹Úè7ââm›£bûÖû	¶	±Í]Êæ‹Ûeµ¾JBX95æBÇaPw…[qåw;3wÙDìDÃÓH!G7ì^MÖàVí³¦4SæÏléó§6ñ>ƒL›6·ÖÖ^±ï§C‚¦R>Ã‡/“oYÒÆ:èhW=LÇc«)(~N«ÜQAG|zE–dÊ•öQ»@ÝmªhdhKB?=­rŸr±—Ÿ…Ãóú5;Ï„ˆ,Éê°ÑÅ·Ú:Åû´”û²ÅrŸ¨+M­Mèî Öå#bìÞ•ç³ëó…ÁÿYÚ3×Å$~‘ÕÜ¦oTjjÇdiÃëNë‹ýhýh[.¦Û:õõöò1ò%%Û%›7µìHÐüÆø?ËÉ{Ö×IƒÙÇy¾í”ÆG¯ÐBÐýŸPmÈœ¯‚PàeoLîoeLoeÃÁm#+D!Ç6æ,47KwZ	Íÿ;ûïåSzFølÙ#Dúu¼šSSI2¼IËSªªò2Vãq(Â¾iÈãÈQØá§µ¬JD¨¥it9ûæI€?"0Îò¬‘Œ©çOÌ¿ÕÅ›FD%¼˜®ý[Uá‹Œ‹[ˆsaa‹eÆÆ…ÆˆòaÃÿz›%Xzn"r`—ÛzÃl‚ÓŒ&Ë_=}¦]<ï+3ÍÚŽt‡t¤©¬œ	û&	í¸œeœ“	o&“eeo¢æ„Ý›1ë²uMD7çŸ¡Bº~+F·¼hJoà¼¡EÒcüîR–¬#’ýÞÐÏ×:*#A£oAdoé
—oK—ú÷ÖòD7ø×N8» èê™7ß<ÙšÙ¤f¼šöÙfšËââö¤fû¡¡Vé¿šœY¿½½ò9[”oÊQ€|òßì]íÆ¶IM"H‚å	î_'$îJdN½Ôú ÔdÒþ<Ô–;þ'þóv--8·u¾FIæ“þ¡÷'¦ˆç=%<ò2<’žNjßTŸRá_¨¬™²Y^?Û°›ê[õ"’æåÊ\Êƒà2xwìG2?x)Ÿ´Í)))‹cF?çÍú*ø*µ¤íHG&s;¦¾àS!2$¼Ýô£Ó®Eò³°«ho˜ft„a°îÉ7ÖÉ7Ö\ž+‰\ÖOb‰Omžµ•²,b-üµµàMÆ[ü(a®,ª¼8Ðb×¼×:$¼¢¢4¨þjx÷–.îgËv[ätÃ¤NŒn—§˜€´€$žã3@XZè©·¤¢B‘ï´Ì-‘‘ÖáÖAL­AA­èMAMÆp?}{„ZÌ‡WqépÊ–°‰ÉÀÓð6bÍÐ€c47Í&s@6Ò¦È+ÓÑSžÎwØYÀ,8£ßß%%rßqk‚'kWvL#Ç\P^ÔàrY6ªúJà!v”)É)É¾%ÞN}Õ?J+*O:W/ã+&^7Rz@„ÎB:}nç˜„ä.Ûäúœú¾4b×§6ÍÝ6··ž·ž’G©eQŒIZYÊ¥Ÿ"9‹‘¼ïŸÓwB3ùËwB¨¤™šAB’áEøö—å%N™³íò¦ŸPwÊ@‡cÙ¶I÷÷àÂMTÂGmMd! æmx
—ÇE?-<$˜Å9­ï'ÙÛóš—óóòRÍ‡HÃH|5Ãž.°á~l±áÚ©Ðsðð«h›[PÅ§º°Æ:6×§íÅƒîd®¯¿s'´6în¼ÊÖDÜ‹S©f³ãßÀžßÆþr@¬mOŸŠÎŽ›Òcnca§™öˆðÃYð\œSôœSwÜZkä¯Ûµ˜¿}ÞUÆ	`u‡g.,^qÝÐ•í…=gV].¯{ÈRiàè^›@ãú»~K™ÌJU)ÍÉ¨Íå,ÉÜÄ&šâ»pŠ¯Â‘¯Þ	Ç¤v¨Å=µÝ÷3—÷Õù÷ÑºÑÕS#vˆ”×‡Ðv®µ‡ˆÕó/°÷–þ"ÅÑë†cFY§®o¹oÕÃsœ¢û®6Õ*P}ö¬#âiAÎÂ	Ç)‘‰9U°ÙN÷Œ6L ~cŸ)ŸŒ6+Ÿ{<*2ñGož0:Ç5<-F²F‚§½ƒ£P4X4ÙPÙòiÙd§Æó	ÛîFO6—½D—ÊÌýoå0†4tpŸZÇjÈÏàÝâ‚§zÝâöñ¢š[.°jL ²µ˜lµËµË˜*ËË’’¦pv{¢$¾±y¢d±Òä­§´à°4!¿†+E~nÒÔÑÙò‘wÀoÒœÕ‰Ö®‘·Ì²îÌ^Ì^$¿a^ac$¦9õQQ¿/Q¦9úN<øü1R€µ{ŠÖ•þ¬“FG«Œ_ 4£õo™A_Ón_n]ÓŠÊ]™ŠŠÙÙÊg##Šˆ£¶z)W#‹ÂÀkR¡ë¡«5èá‰ ú ¥¥74=¿ôîq•llNMM²•1/Màu§§…i1šiÃBk' >58Ìs9_ná-®$ìW©—dS ºBSŒºW¯13¶>÷þáKÖ³ïþZà³•àïà-éà.ï´M®[¡ÿSTøçëþÿ^®âÊÿ%Þƒ.¥ì=ï‚í &±(Áee±¿lŒÄ„eí-„ÄìÄÂÂ/ô-íïùáäQ`¿-­¤õ®úž}Ã5íÑ=50{¸‡™%OO:¦¹K"k"ù«0””ss5s’ã’7’7…ÐP.…ÂÄ)À@½ÐÑÂRP[a,¿-ÍÚå¡Æ¥ÿwúwwpVD-±w«ù11®ùb«CCù#Ÿ!ÇØžëF×
Þ&§3ÓH@ãtndF8Sò;b›8››×ä2÷D›gg2O*OõÊO™OU^&&C44×ƒjÂªYÇX^¾¡’àHóø“æåìÆ‹ÛÿÓì¯kóZ¾`ZóZ…¤â¡·:³éz÷NFTïž—Xù-Cy`³^6ÙC–™»K’®LKÙ»_LL’33h¶â5Zàqj¿v?·’’ï3À² é	¿³¿Fd¦Mê—ð5È?Œj?i??jÈ"Ô?ÈK??È"¯9"9GÚØÀFlÚ¾Gl”Uxç‹ýýÕ·´î©”ä­Àæ¤ðöR®Ìl.ýwêÆ~‡€k¯Ý1í­ ‚+³Õ´ƒo–a}î„éçý„†FÐ5ÚaÿK˜–KæÉ¡¡È{Ãj‡e{ejÃ‡ÃøÎËêÍ¦Ì¬ú™4õšãö³fk¶®w§˜ûWåVâÎÜ]YØMW³B^’_]ÆÍo[@L¤ ñ.‡øÿ|ÿNqÂ‰{ª›	Dc‚<&"ñJŒüõfùâöÒl;6¡<©Ý_ÊÙ5{§_ÃJ.îò@nÙ¬þ“êœ(-Ð+ŠýxºBŽ˜@©¶Ø†šöÓÓ‹ÿ‰F6%‰FxÃ%“Ef”Bzzl""â3…UZ–ÿøÉü²èÊ”rÐ7*D™1{s,"áSËËË	Â’"BMƒé›Ãjè²÷Æ`ùö·ØÌF Ûµ½±’¼J“ˆÓ± ´®®^_T†˜^v(	òð†d4?ë#¿¹Âò­ ¯Ö	±V—#ó.—$–@f.ÛL·#ÐxxÒDQlp·DZp£p£´>cºhN!
«"¦§$Påª^*_R¹×ÍYcýpp'43ÝOX»XöŽ·uÕúÿÇõû7)ßxx@æSx±ß·Èßß³;Ù&&âãskäJRò«áÔw
ÎèEWÈv©gXH§ü6S–Rÿ/Y˜M!ø1²½QKC§“pÊhRHTšŒÒ_–Û’óÐÂ·K>×•ö°ÝµJs ž†¼ìmú}Õ¨Š•§•eew£¿úÐšŒw<‚×ØÖÁ"¿÷HY#R–#jÃo:pÂéžÓÉpiiÔž£«`Ùy)œ‘’ÔRõí•@3Ö<k/›Û_0{ëªìT 9¨0 ,  ]]X cP^ý–‡7TKZGóY öCý¥°áÅîÞ…_iŽnnêŽCÔiÍ¶Ë™MÍÜ{r…»ÃÄY´æúþç¾Ø¿šÄRXk\ZâÃ¬e?è¾`c|^Dã%Øp[[pXûûìmÌÌÚÌ‰Jí]×??®]ù_­Ñ¨çÝ1œažùLTP1,%Ç½AyÃÍ:ÀÌªÂ†»²óÐOÙË
^±^o©±èâIo^bÂbobUWWQZÆf6x·‰Eª”ŸåìtÞ¼V—sŸ!ÜTJgQgôÖ'®Ý¾»	gÖA|SÝS.ã0ú&m4•M*¹»,×íù«÷Ònd¶üýÏ5öÿDšÿš%Š€V)ÿfÙÌ€õ€“ÌÙÙbÙˆbÏóbú§hÜº^^êÖŽôŒ	Pl(¡Y¤ÊQ²g­ L‘lU×¤TšMóIÜöšöVš&ˆ÷^Czs÷CC\ÛÖ¤ÛeYA‘&Ô™˜$Fiq:ëFCAéú¥æ$eÀKQV}ºHZOU´5iþ¯+óN+á¿>óá©¿wkiÉ4w`iwssÏG­¨ªKRHZYS&Rýü›þªN2Ç"£Àó[d
„yÈ\Ô%ƒ»´a)°r•° 9rr …T…eTe9	ß²Ç#žß²8?’$.]RvÜõÂ,ä{ÂÎÞÅ´ïm~ÃƒïåƒßÃ‚«Ã{ôÃAô«ôA«ßß€‚Ó¯xìÀ\CU¸Uè|iã&ó{ü˜µqaÉ1À ii·(Pä·÷îžÈž¦žbö&fÊfæùÍ°¯ƒ¾~BÂ)ˆñ±~’}œM‹‚ØTŸ¿¶ýË‡ÖÙü™ùñZ“1$
*Qg¾ ÿ‡µ:ð{ûOq\vÎ§ÛŠñvÎ§¸¸!ï“L]”n³ŒnªÜ©¤\6›ËäuÜe3’ðy‘#‹ƒrü«ÄÅ‰b¨àeC?ƒ<Y_ƒvvvvƒvß[£â_DYs__Š|@!7É“®Ì||è“íàÆÕÐø&îÐ0Ñã±¬é©ù ¯¿°YüP{êS|íÐÕÿ•X8>Î;’Ÿ3‰‘Ý3.A¯$òðqM|ršô;ä;ôäôØØ''d;;„Ø–O1C[g6òa2à8(è	TOý,{`¸þòïä®‰gh+hst-#û>¥$øqÖ€ÃÐ^L5T›s„è×1z,()¾|À	`ºlöË§I.ê9KÔt'1
a†gC\é«=hpëüòîO`RHnIYÇa|Õxñð"hÃ£ê‚ìÖò–^ŽÖ:ríÖ¢:^íÇÁr²­‚\ºÒ\­à‚—•Ûtû†‰
í¶};IÖ;#…Ú38p~ù~¹––=ž5×â@Qúÿrð|˜RäOurXá£›·/ªï+exÊêV{¼±|+d·—Þö*bPí‚ë¾Þ·ÛX?ïOrk¢A«iV,q2æd	òË÷~o®œefy1!h“«î3.‚çædn[ª9Y£®CúÓGáBYßBèB«4ÿèªÚ¥¸v×½B—×Y©~dQÃ†/2J:!œI&„····rC„øCp\8%£Hr{Y–uV\nã€¾WÜ&q/ÚŸ,z(	zˆX~x‡¨,ÍÇÉWš£(‡Gí.xS$T`Æ:2¯…É …Œ…‡t,M%–ÄÎšv­BS’œÃ»”ëµ£øOžbæ+•£:::O$NO•sO<wšWa£»Ó56Cå¾º{p4l‰Ç×óö”ùOÃ44§Óe¼ÃÃÓÃÓØ¦q”y·E‚`0œbr•ilqÑÝ©Uéé0¡«é‘t‡twÈÐØ|Â©«‡ºªÃŽ¡û‚ñ¦IÐƒšëƒRƒOÓVRGGÓ\œ¼]×èÎ<Ãbù¬³Ò‘-^¹8§#¦c¡]Y¾PÌ³ª  SS%Íy<§Î6/#žþÜÕŽ[55Æ[6¢rÅóóó6ØËØ£RWiÚb	Üe[._-²¨Ä·þ³“n)êm€.pŽÀÌe®ÆÞIùå•Â¸!g•!ugg““"“uu¤ÌÝÛEûÂÝxäQ?=6¯ÂùÜzAAzù| ¡ÍØ‰tà^ùhNÅ•ŠBÕB•~ÕÕ°œ~Õ‡QQA°Á~§1Á?§ÛcÙ2¼“³ óž¿Â¼aøÒ»š"èÝ¸ýº–Ìñ5Þ†5²:ïÆGèK«³«K]«m#¸h “«Ý##!#ƒ“o ÒÌ„m#¿Å¦QK;ÆÜÒÐv…Æ9„'k&®ÍH$}5µsíH;Š!ÐÜÜMö¶M@öºæÈaÈæÿa7)v* È¦ààÃ ÚÚîµ•A8fu]*þ«(Yû\¶BOì|BH›¹L´¬®%Ë:í›XXUK›¸XRhnhÞhU¸ÂcÂRC6a4+‘£›î…ˆ¾åN°äõÆò%Y.C/Od›8OCs'§gòW±®›'ß;ßCyCC\CP\Ë7CËêí­ïççïÜíÞô¢!÷0%tdA\ð•W!Ù$M•r <n{p<<pñd%{f{Ã‡öñdËÀ°”ji±M/çj.€ÓCiÐHM†Í¼Zé&˜åŒîþ€‡åÄ'¼@PÒåý€€²”º		Æý ”oovÍ.1²fö´|Å€¹µ9Ù§Ú¢u¬)¬rsbKe=¶>‰§YÚðèóÿj€öaþeB”_¹†1*;åkj·kâ‘·,·;óZZ§¡›3ª§3577{äèô_æ»§©õ§V1·aN;{%Y!>´²ÌŽŸÃ(€NÉÔ«QQé&É‘&P«a&&ŸPœˆPˆ˜šÕ²b˜jŠ|ArAdätbÙæˆu`÷¹©Qìþ¼ñ¬è¹kùï†ÞZ™måò½»Hñ.Çñ¡_ç¡ÞÕB(¨êK£K¡ *‘‘ß óZó¤¤ßßssó®­¾1!÷0.-"qo]b£®ŠàÑº¸¯iÉÊ<¼{T¡ª«‰a(Ô‰xwÜ6µK|š%|Útžžüg	úžg•R*
×7ø‰¬$¤7UC(3Ü;_6:yOW¨ róeäó]šƒŸë„óf®áq¼}é;Y[2*<I%]s°ut;‘æÂq¢G;‘;“²4G“8E¯²4÷Î~§~4C"
’Q‡¿¬ üÍñ!<-Ì-“°ù“F ÷¹Åâïé/kL‰¦Lç¤ƒ-¬ÁÉPBwl?pct¦C1ÊX1ôJ–ÃïmÓ1¯X´ §UDëS¾TŸðœ†Òf<aÚsjÈj‚jçœ
QmqsÉdÊ~|~9àq¬á<÷êæ6âýrŸþ¢:Å.6RŠÿÏG¢¢jjåæå‚!Ý9iŽ0ßÖb`ÃfÃW;ÉŽ-V
£Õt`ü€Â¡Û¬éïÛåª¨x`­k••£=—¦Ã¼q–Õ·ŠÆ"è~”.W_Õ£ë~òî‘X©rùñÈxîà«ý¢8ÁQ^n4qË&E%²J7ÈÒÁ¹`T%Zã7ø•%qÿ¨Q›ya°ÅÒº`9+Â’Dr’qÃÃäƒ#V0‚âöÄ‹¥‹IþÏ[ÌÔ‘#—ßÖeV}·}¿5¿¿T–O×gÍ¹òqG™Þ•øÓ)$ì¯éÜï¶hZ%<4èjm]$šŠœ`c‚¦½ÄgË¼þ0-'lðl­wif®	êêùß“tÓæ¼P“:¿<‡àiëOçŽž–('È´±0c%)€Ã¶Xžµ}PÚ¡\^°ŒªÔØ¬Õá¼yS¹×ØÁˆ~¹Áõ±gÏ•Ãõ±Ïgõg"q-qV-Âk85ô÷R1…¬ç6±¯È¦˜í«£Ò“É¸õr”˜µ:ÕÒk<ÿ©::ÕZÛ§Û§ÿÖô1?~ÁÁÖ§œñ×Pñ~Á¿¤ßeƒ’þm½4LÓ‹[Qæ.ÛÆÇuhpýä(ìììì—SìmÆk^]^XkZZZúúÆZZö`' Ê,#ûöyáæŠì=ÒŽÎaNIÆb—ß¿¦šñî-ëFwwwyÁå¬åu)êåê6kii56iÏæ¹ƒƒTÿí$SËßÕ—²=?âÔ¨‘7àù¨‰W‘‹âr
µÜôŽ.FãGŠ§gCGŠ&,„±C77±,‡øø77‡Ãñ¹+îŽô’¢	Q]›Š®ª4´#*Q«'4Öåq8½ÄšÅÅL„ö*ò¿*éÃK2Àò~K~…*~@­…Ã…Iœ+•7ÁðÅ·’ µ&$áb´ZˆhLE(Xœ4orÊgîuªº¹ùœœâ]]Z]Z“ÍZâ9àà¨99¨9‡29¨wU…ÎƒíLŠ€aÂÅÇ¹¤Í”*Ïäð¸ð~>hâ×OÔO÷>¢d1'Ë÷
Ë>¸õvOöÔþ*Ê%!("fŠëüƒî$¢ÑKÃ7³È%sìsÍ×s``'ºíÓíŒ×‘Ó‘þÄÓSíŽ4:c¶,»¿…®
q‚‘/<=JI;u&Yuº7K…YqÐ1æ·F²b”LâÅ®O6¦ô$h’Þs5-5-ôÄó††XXÄ‹F¨‹¨H—UU’Lž}EÎ²ƒÔÜî´çH‹l´ï•÷÷`òõLãÑ¹ûF;ßríM)K@[Ï—>‹”šíåX”åŠîX››Zê.½ZM]>”Ôè¹½‚°>`°MßÎ#þ5œÔèRÑ€r>GdÍ¤ý•Ä'ž„ItÝÖNvŒÈ3·§Õvÿ÷H°Eî©ü¿çÿ¯ˆÏª¢ªÍ3¤ bõiÉœ°Ôd°³w°Ùö77Ùsbzæ~Õù•Ct‘É48²pü;@pA²pXxÓ5¥oÖªfŒñ—	žö!ÇÚã²‹“Ð/dˆö‰w(©†©úAKP©ß•ñÇRãknÑÉ+6‰GEz”	ž)Î°ÄÍ×-ù--n™ý¡
vl$ø;CÖ¼^¤Ä¤h°ïÐî½z½þŒÝ!DZÚ.ZO’HU2UzUÅüHÛ´>Ûün*q`ÉpÀh¶,üuhu\ÍüçgFöÐ+yùÃRÞ
]5ç{…qèè„‡÷YC7ä¨8|áù¯Í‰óTÈ¸x½;¥¤ê‰­§Îq>ÿþ¼ÿnŒ¢ˆløÀo#xŠ`ÿëª8xä_LƒÇ¡òIê¯ØÎ¯AãKý»%%==	¿@†ƒêþ¸Ü3i0.Ðp´|*·ìö”Á©l0R6ŒòÉÞ!ÁT&ÁgœÊ³sîsOÊ±iùÜ¦ØÙ÷›5Û6+D=4t½“*9scD-sccoî'ôÔ}D þoiŒŽ«ÒV\–T,TÞÝ¯cOM7[þÁjNè¯ºŠ$ÐÄS–µ³­åì°É"ð­ÁwðÔqdìåù×i-å2ù¹˜§WP@]·YYäMdyˆ	¶!ìéŒ¦åå	ûÞâÚÚû“¤[©Š¾üP@Fèö’¬½æê¢ª÷¡:€ o}‘ @×2×WÆ×—4ÆÆV—¶‘q°ö‰-ˆ¾.à×ª#°Ð¢¢Z	ˆ‹Å¥€ÄÇi'SKWSKSýWç-$JdF$2­Ÿ‹ßR‚§Ÿ•±Ã€O¨›Z„›-pÃZq¨ÇhÖP`\˜í_Íf\Cfc©~·2>·¸ß±e°;Ýœ„È¦’µ13O#Â“—¶÷W½¾0÷
Cm¶Œ‹å*mCC^¥1^X^*¤ï	ƒígˆ™¤-bŠ¤ø) £ÿÐ0hb^1D5åuá‘Ï¿uÆu–"ZZÏÏõ_§§g_§äÚóæÝîÝÖ ÂÿyýåNJ”ÈOŽ/Ê¶íÉÚš*1ÓÓ=‘„5Ó1175Óö5öjj)ä®äj )¢ÉìY©Láí´Ú"¢•Ë¥ŸGúb-
˜SP3Aúô;Nö¾Nóïjù1ê<5¯ù¯”äÇ×¿óäž´««·¿¥—Í›½½Ï&gúöªÞ‚D`'êjúa`À†W¹ÌÂÃš.£ÎmÁwÒ
óKK¢Ð sLTL{D%DT%“TŠ“{u“wÝ; ÷3G¤*æcŠ††óþÉí½$M^¿­a/ŸsmTŠù$ãæñAÁõ§®§Û1ÁÀU9õû4429’¿4¡Ì·ÎšˆK»£çø0@]bÎFƒCèÏ&ØZãÕ»º™óÝ²wŒ6 ¸æö1Jî]NcV(ÿdH
H(cVd¯\ÜÜëR§¦Ù^ŸúÀAþÿËã«¹KÚ <o4E÷±I°ÂPŠ°PúŠ•}…ÂÐP……ˆP(N$êá©-Á?háo•QLs®3É	+ž ±@ÐŠU+0±ËÁk[-¡ÁËR±üüËjwwjÀ4|¦~2;•­¢0äQNÕz1/LêÍh:yvÏÆ\UM…Lj›:æS|Qº¯”)Ú­’ÐºÑø|„Û»|ÕT¬ŒD:D¦Ò¦y>qfDÜaqSöÜ/tÆÌ¼’’ˆƒÿaƒü[Û40Çƒ	«ÔÒdˆ§eŒzhð–™Î8ý`W’]’dé#ùê¸ê¸W¸Ñ”@m@@êÓ!¿|`Ñë	(	Ž˜ºíÙ%ÿ¼÷ýKþ¿þ¸Ïù‘â–]ûƒ¢çpÉ§`Þ*Jw$qÐ\i]I³)ZKÇ§Qw_ÿT°ë,>¾Ú$<ëëë.×<=<~pÝ!~!™×Ï$»Ì”~ÍesÊZÃ¹ÊUæÓæ•‰¤žÂìn÷(í¹r®g=Å4cù…‚*‹€Xó…š‘2“þTTBt8„9sè/ª7¨nØ™”oÿx
¤#µ[]Ž­¨³¤+NVr=ô¢‹XÜ}â™ˆ˜ÃÀ®áó\ƒcE»ªR ¶¥q[Î­°+¨ 8·i–iÁÉ48iûûû–££û¦£XÖŽÖ<þ‹ÍÙ­ñnÑ™iEá4Æ¬¿ƒÉßƒßÉ°ÞàqJ`tp'¦´"gßû$M~ì[Ú\©Íeß²O¤Ö`œœçÃƒƒƒCJDÁ4¨®ñßÀ´C•mÖ\ý«£C&Ô8'æ–ã$˜CÉá(ÞÞ†àt/Æ¨…?©¥ÇÎšŠvYÍ×‹‚x¾•b÷¢#¢u˜u¢);°™ öŒ”k"×æ¼ÿðM¼òÿaäG¾Xä3{)#gLk—MMË—Ó†w^˜qß›–ŒQþf‘DÀñ“®V`v¸bË½ß`1(Æ¼§“©uÕÀ4Ð¬†¾ÚÜ«ÿ¬‘mt×ÐU +}ûŠÂ¹}«-Or4tn†ðm#j¡(‰60'µú6UMhMø/sEøh'•;±:bÞwe5T,óÎ-;w«0øýMAZOç>@ODD&DZ§DÓž.c†?€fU‡ÕA‰‰/ŸW@[…7šÑà‹{î÷§?àšJ?šJþñ9ž‹Œ3¿«Î9º\bë|òs2UŸ¨®6ëi8ÛÈÛ/¨ùDâéDÓBŠ9n9¥D‘¯çVE&œ”¬ìŸQÈÏÞ€&
0:6Áøwx"Â1‹ÔŠ°ÿEEc¯cq—LE’ö°f- 4µX­ºŽ…¥úÓª¶d2ñÖêâûÍA5‰ÙýIÞÖ;{ØRãÝ&‘³&ÖŒãé®/Nk,(E(ýééh~p––L;ê_L™ðMjjNRžæã’¾¨R¯ºC]Syiå×i×«×ižÄž.u'ë'-idf’bçEòF?Ï f;ñY_Û!h^ó˜´¹žž½ñÖ÷ÐË™k¾œQØ¥,6Ó<»#,ó9p'#eè/¼éBhíºü½|0–ì}cEa¬Z|Ùþ¤Æ½¢wxEÖ©.›qh›ùQ“\vvGGv¸ÓvÓË6nÍd644)c:‹»˜z-’*uº™‚â!<í.*ú·.É!üNêÝçþØ\óœU:óµ¯hœ®¯µ`Ž`Š"ŠŽ`GgÓ"b~Äðî„•3.Œ_ZC3ßþuF[ª}ÝOž²vp«ë!ÜÜGµ“ö.õ¼	xx¼õ·	·x	ËsLÅîÅóººTÛÒqqé²ÄØºÒcn!S–çþ9Ô%áÜÜayÜÎt•[Gúœh¦t"¢úpÛ¢Ûøg}Q1¸	Gžðµ°Œ˜+éë¹N	R“êãPÆ•åá	¶oGVgJToLÉ8L8ê/ó¤P¿kÐ¿®z&>)a^ô?sZ
º£
	1¼	£6sXåZ¨£Æøp?M·ªtÎµëÐ”Â\zÊÍ†c™€ÆKŠ{qò{KXX\Åó\åªå”šåó_óð°ˆý„,Ñ€GF@@Z…}›[œldº¢U„´@+§Xnj”þ`Ìš!fšºsËËš‡‡!¿Ë0I0ïÕ==9JŸ\ïïâ±ÛýZœƒû¶Cû¥â#”ZÛÕà|–€ð­Ã”„ÇÂ±“•a®XŠ4¾wcÌ'cDšœû§Q…Ú•“jŸOÃÏŸÇõÜ{©{õ{’é67''6é/Ááßƒ„ø@Š¬¨a™•¬J´HŸ<°EØ=Â<”¯/ô{c4u\nPJLªõts¯>êß;¿Sš¾ä+_»ŸµVÅ¹·Ö·D&¥¥0Ö±¡KÔÛÜPú…üá×óöå\§ä„30N%i¼ë¡¡õ++~È=+Ï9#cÄ56ûÌÆ5këgNšæi¸Ðü0§ïM³#ãìì\•ìéØâÈ„ûîâ„â—ŠiŠÃ¼ Î¼>T\9U·6²L£OÂuj(Ù­¨­)JÇ¶É{a°Ò« ‰?¯!íLÈÊr‰ÜžÏúµÔ¥¢ˆ,š»5­±ˆZZÚÚ0ºe/­ì’ý>˜7wN£¼ZT!JjJ¢j”>¬Ò¹¹;Ú×Gh@¹«ë€Rh#ùŽþëÙóÁÙ¡¼(üÀk+6S%¯šùB9"3Ù„ÇÜÆ…üðÎ&ÝEMu¢l6lzËFv¤ô¼;î×Ñ‹Êö9?˜åD˜à­8·ÅbÁ­êÏÄÙÜÇìj=‡ÍÜ­^ˆ­C¢óú;™‘ˆ“ZRl%+ÓµzyRU>­»FÂ°·Fâli â  ÔÕ¹ç“gúpšeìÜÁ"§u`j3)Û2"¹'„êÄ?<§EÞ&‘ñ§…ë™ûŸtø¨Nè¨~¨Tf¨fTÐUÅrÌ`sƒ5ºöÆÐÄ£ûîú_,ŠU.»úó'.jêLP£ôJZ«ñƒæTXÕ¶jE‚+ˆRdB‰­Œ“EËø¬:Î-ËG<Ã!ÀJSËÿÓ¿ô²à@ˆƒÎ„ÞçÃ‚ÁÁ½ÐÐÐª¾³Éèw©±¾Ô·¼~lâãZ39âõÈÀAÛyéÌìÜ_õÙ%µ?uD]*RïeOw_%mè‰SiÿWç778+;Ë­¹< P6]ºáWç‰×}|<ÚzÎt»u6‹¢ÿ¾ârÎÓ§jŒh²sæ“.ß‹õl3Ñ‹°d0^ˆÈ~?CBqY¿ƒV6Å ¤X:˜,-àë_GßE°å"öHPÜ±•~P~†@.áâBp Ö¢õ8¤‰Ù¢–å&–å©{ê¹ïÌ…t*±È(W¥ZMe–\Í€Š³Ë2Ë7â2Ûâ³¢Å—cûÑ•—ÒJp†ˆ^pYH"?¼[š›3œ¼ée]Op³®^”—qü•øøÖÖPFVb`]fP¾ý¼:…´Mž¨›Í•{«G­ÂÎÝ[6K_yÈymŽo\ÄÄŸo·¿s[°Äq$6¾c©ˆ¦Z¦\¶6ŸÎ:¶pÍ€¬(ìCÃ·L®À§Ç&ã¯*ôÎ¦f}w¬†™KIÔˆÉÉÀ­¥êÀÕ§8C7+ÐÊƒt=ÕP*›?>ãùÛÈ
»¨ˆ³M[¯D3TŸÂJ~Js^Û(M¼³Ã²°%„}>¥øñÒ…ÁŸŽ6¥ãG\Õ4ÖôrˆÐ+NÀ`»ð¤=@çoÒïþ~C&(/ôÙéú¢ºc¡BÏ ‹exlbâ›({FqG´m6Áçîä9ñùÇ;#»Á©¾DUqŸ¿©a£­æ¸cúØÛåß´ÚWHbEéeÙEýé`ž××žSì),Ö¾¦lYf±½¶¬™à«î½P[‘kÞJ¨;ø?,öávð‚á/I¼Z+v™’%.nv4À{ðbSëðÆé5_@Ì¯¨~øÜîáÜäp[K(ã(…ÓÇ˜ÑÑ¤…;ßðŒX)½ÄÅ§({€PKeÃ}qÁü¼¼KÒ¤q		oâ’áoâñé¥¼ñÒoÐ¼¼»ñ»ìLŒª}\zƒâm{QqëPXìj3qãÝøÕªÜÃ<Épø_iÕøiáppàõ>ÏTõT®nõ\àíL®¡ƒHè#ÁÙ–ÃÞÇ‚AÒÚ{1'èƒ²]”ØNƒJ»ÁZRÊ˜y€hÍôW,ì™w‡WŠÆÍÜ¡âÌ‡Pæº'Ê@ìÜ_›Æ%&WO±’——<sW™÷;$7áW6Í.­‚à%áß›²) —‹i2š¡;Ñ'¤QÒa¹­ÿss1ùÞjz¼ï·EÅwª—Ã8ž]™Ôâ-‰©:öàðh+Þ×w¯¸¸ˆuŠ™†Ò·àP	"ÎßGm5²áDŠvºf×{j¼˜{j£nžaõ`U2p„‚Á>Š1½&ˆ'ð]ù 9»É—ýºàÛ¢àS°pG]ÿÕ¼IXýEOš÷#þÀ×Z9×IkNX€%û”l8Lž(®ÇU‚Qþç;‹Ü^9ÎZÙiº­ƒ,ŽøÌÁ{«cMRsÉ¼¦µêÈ7î-‰¡KJ±1*v–7IØ‡ƒ5ØùBÓæÈªÀbÍ¿:§ˆ ˆgíÌ‰[Ý çÃp’‹fqÝ¶Û''Kú—*É
ÉWžÌ­-k–ñ€üèSG­rå±¨çÃú«™¾…býÃš˜¥è2Ì=²"›•É©¢ssVÅ«U¯STÓŒ½ödNÜò¢¡®ø†ÞÖ¿Mê¼HAúÇ;¶}*Æ1Ö€ŸèoÖ·qÛxÒ[]A…rq‡–ÿÃëÏwÞ£^X±Ae°oÐLMqp?"cb“ýŒ¡	Îßf;™˜™}«8´ýþú™6w¬íªÌÛÂÑ´n²Ðh.oX®mÅi²L_8á0w>àj¤½ +ùÃe
º¨F=Ebä\ñÛgeudsjueF¹™ž‰—ŽAXû¬,Dä¾,¬Ü«ú˜6j¯Š6FEþ0†3šâ’y\SkÍ‹">PÎÞ¬,Ó¡bëÅÿÙÆFµDÿš•ÔˆÃàùÇÅ®t˜3ê÷œô‰Ð4n¤ëæá»Î;Sÿ:Ù;ù¹š5D2Ì‡ä¢tÝ`ø;¸Œu%ØÊu¨{ÒàÏÐ ¼Röß¦¡©6’rX¶D4¶DM4ÔlPîîîYî­­†Â•]Âš•ŠçÂY†eÏjæjjçj–Ÿ¶èéóÝôª§r‘ç­ºû“B'ØVýØðŽð¥¥ð|Km¥eÕkm—NmOvÔÈá••O©á—à”‡)Ô\&ˆ’Y|@õ9–OUr"m	Â	7^}GK$E¥&ªÜãKdGMEÔEžT/Rã
žxžÞ˜†Þ1ìÃCADìEGS}U JŒ¡zž¥ŒÄ¿vYŠºX€)t3¯š<¯ª@gux–PµûžµˆŠ\ŽL¢®¼vyFr.ß’w‘6X#%Ã¯”ó‘­,Å®¶{ÅŽ®SIoå¨Ÿop‚k/{"TÐa‹6OÅçë¨‰?ßOReÛ¸¶–dEÌ'oµ¸Ïšî-æÑƒBñhW‹áBXSŠégœõ’X“\BrY//+S!+³?3Ä»»kÞ³‰¹kÄÚÁAèq‰?ÍAWWéW9>qåyÔ¡WÔWyA5Úgï¥Ú¤ï#[[­®ëŽRUDÕÀj»ž_'Z©¡‹¬âHJäDINöÁ¬­Á¦#¨¥V©a¯5pèZÈESGâönëë¤¥ç‰äeWèÛèÛRÛÛºWOÚOROO••Ž»Žbiôˆ?2&Éb?ô*>0Ô?ô­>?FéoÊû‰%EÿIniÃõ€¼ŠD¿ÙÔœ˜Â™Ñ-¨¡ÙËÁã˜:û·ñ¹íñÏ¯[Ö®f„®4;=øx°‹ùi`¸™#CÑþ5Îè_âöH”¤¹âä	¢L¸æ?~B1VÆ±)ìV özSâÙhùi+åxÃÏrp{ÞYK¦ž£l<väY1ò’ˆ—–¶>>Ó*W,º3ËóLªSüxÐDrdÌ±i›%°È¥ãyÜU9=ƒ¥âcIG5Ìäpm5Éî¦3='Ê:ÎîÎ~¸¸   ::Á¸B‚‚#-#R.ò\V#\$RÿñÇñ$°xdx2
XjUUH5z&/ŸÔò9M"&-¢"ºL½¤hÞ$Ã‚C„¸QÌQ‡¨éi—€Aûq£°¥AGÂ'?ðá”,Xo¶•›SÜ)š§^G¥jÍ~²·~UÔ¥(¬°ïõ3‹¹3;L¹-uö9U ïûr-ûe&¤{¤çmzy
ó|³š&O‡¨ÐosØª/Ã¤ÈÚ[¼šßsR7°Mà.y|³úÞz’‹ÀPÜ×/ëÅP„‰Ù™ÞŸaÈd€-¼)oF<hQÉ¨8vÙQzvÚ0°ÎÑLõC Æ£Ö|ÐÆd«Và„ÖzWb‹ˆ;DaNF%aŸÊþïW­F¼Uá´©ÈÝÛ¥ A1¬àÀ£2QhƒeÉØ2e2bŠ’ÉßÍubGÈbmWWµB8–Ðœïµy"SBL‡Lí69©Ó®½ú·}«ò²$Â–J[6L6smyÔ³K8F·ÛÞÑ¿ž±–>9ý)ƒ´¦Cò%cjªð+è0{vG+ä¢kNœš_ÙÈ˜0¢,%¿©¹¹š¹ŠÉ(Ë†Ä~ÐoÞM*á™‚–í+=I*’ýmj0+O½;/ÈÛ8“cyas7—`QÜtŠGc½¾¯FÈW+ÎWC++ÞíCm8£íóåüåò8Ñó%ó¿*9¿ûzv?‹dEéó|†žsoÃd¦Z¯ÄˆÅ–çEŠ|Ê%‡ö 9W®w‘õ=ç²|bØÝâÖHÎ Æi™¾Ñµ¿¸WA¯Ã]›YžûKW2K,ME€U=}¿ÇÕgx)<¶5V—Š¶°›T¦Y¦¬LÞD¼¾8RÝgŸKÍ‰š …O$&•ÎF”Ft2¦Œ¤Œ×ø3¨‹:•è¾¾K)¢è]OfMÕ‘PP„{â–Œ=Ã/†Ò}|åfv"Â¦òÍ}»}kâ˜â£d¯ª…3ÿžŽÊ3êPXT±‡’þyžNAÓ÷…ƒ·ÓþJ·|)J ˜´ËV1´Vö	öd%î’—)œ
ïWö¼îé’*pZÍ*„˜}Ù[þ0âº8áäºä¹æäé`ËçÅt}Ù^Å±Á^½$½QKˆ½$‡½ úuˆ XˆUž±UÈÃÃˆõõ2áw16ò%·aÍ2—Ôns°Å†çúYV\jíð `k\H›¦q8îŒðÓIäp;åYêN‚°Áì<<D”]]/°<d¬d3ßdã‰‰tlšš}S‹qNc¹í5H*ÀzÅ~z}ûb{}#Ï)¬ù¬î„|²é#š"½Á™ÂÏmñD’¾|\B³žsö—©Å@ÿ$9òõy3Bxs¾6rÈŽqœ™Žy†þÏÌ”ã§÷˜¦äÍ¤Òäcc´M”åO0ú&_»‚Ïë@Í±ÿÔïàï`)´`*¼Ö¹æôjìQ¸õÈB/Ô©O¢ÚM¿ëÒ±ÂŸaòP¶ë<a`fR±9º--{6)ÑÛÿ{ 2g–vôkm0ÌybY°9<ÒóNZÓÚY¸
z@ƒ”›°ÂÓ‡oôÀÔ"¿ê’ tÜjÈhžt$ÏSFZÜã9n@hckðÏPQ½½@²Ý–ÝA4µ{C°PiŠkÆr»yl^B6xÖ6tÈÚL·iªû¶F…ë„>wGþîs@æÒ%*[Îð›|Ø·nþ//zLëLMÛMþÉÉOŸŸÉh V¶,É¶ UGìaR$’ó{~ßœãÏ®?¬2Ÿ¨—E+KWŸ|
ð×Äá±IÃ¯×{ŽÂNjÕÓ¹VGŽáöèL²¹Ta8x,ÆØc&ÐsLÁ{8RÝâ¬£¸9¯T¤êýœokÃl^dê®ýÓù«ßˆ,b§Ë)B(´<b†§Cù)WCÑàÉuÇCà©wÉ3;%ÇÇ3ÇEfÆE¯¥ò¥fw·ï”‘#àë¥(:¼óJ¶[3:´RÁKKñ’ÞUîþÎëƒì¾òç‰áƒá¯¶­‰gÛÎZšËÛC‚uä'¬ñ˜i\,˜ŒWMH,#¥ßZNyÙo·ÕçúQ`›ùGïVÇ*Zá<Û=Šc˜˜ùþøÍ?š*Ÿ:Zî·F—Q„/í$h\ÊNGòÉnççº+uÅÐhÍuÐÐ;<†Vq|ª=g(s{È¡¶«]^|kVöú8+9öo”yâÁ„^W‚v~†ãœ›-´Ÿ„CÞ1¿ÝšÆ“‰÷<Ÿ°ÂvOïÄÂ¬V^½L-]Sr»$ûD|®±íá®`Ì	Y´¬¼u:Ø‡øM8sZ]4VUÀy>Ogu9r_H@L¾k]+=He¼¬s]GõÔŽ0%çÔ%ÖÉPØ£°ã%Ò%ÆJß¥ñ[h	‚†ÉÒƒZÝ´Á¸ÝxÈ8HâÉÄÌäâ=PÍò³C¤GéUåcµØÙ®óÞÍªBÉEPŸ™I+¹ˆBÁök“€…º”nÊ±®óàŒŸT¯°ÎïcR#¾˜åþÂçl¾ÂÉŸq•„ƒ¸…åBå¬Ñ‡^õÎAd‹ãá{â¼³ÈËÅ…Þäz€;Òcžß’–à` f†è+Š´ÎÛ´SybHËÐÛem%“Ï{Ìýó5w‰…r
#rëWÿâøø5pxUÚèàãìséÂ-ˆ°t|åÂ®Ë‹J‰ëX.®´_lÎ˜¯Æ95Uð‹Aqü†þÆ?¦®qV£8W2Ã!y®V–€õ5šra2—ÅÂcRÇê²Ü¼^%?Ê7Æ02ëÑ×("¦pÖ@=!lž„¤©Hž±Œ!žìTT©ãüSÖ'FIÕÐ#BK^c=E^Þ»¡þþÖËÇ‘¤=Ñ®ò&ƒ¬ïÀ0Ññ‹2HÏáàƒRc+óWI×<0SmÊi…·&Í‰{7õöV¶S’Ruë‰õËP¤ƒ¶8‹‹ZNÙgÛêÕöm×
¤O¥¼ *y2ëqûØ­(&cu„Jêmv+uÀTsåõe³Î~©Ø*R(€áb€±<iåH¯ qRå*ŸDr"èñ:òëjùOƒÍDôu*y.$Â¶¿Ã}%}V~'M}à{ç«{Šj¬°²°D|¸¨¾òå 3³ŸÊ£8#³ZðãÝ7¯Ì7ü6¹†½¨‡‚ÍÎùÔj˜|òo)	)ó×¾¤½aîí3ûê´àYñØÕÔû¾s|irzÑ ~Í¹!^ÉcÍ†›á³^mÎwÇZ†{þÂsu?_€Ïó#(ˆ—J¥×ÐQÈaˆ¡r½@‘tÄÜ1&Ÿ@é3aéøŠìÜdÉéþOO¸ d‹!²úóO³ªg«•0<­+”QØ.ëÏ¯ç•ü§î¬ù,£ïýà×NL¸Ž¦èo»à‡ŽëµòòÍ:µK1tÐ÷FÞÍ…Á1_ýœcªÐ;~ÕÕ$ßõZBS-ô1^Hà1óŽ?¢{ŽGaiÒŒ¤Æ˜Û£ã4mn£¾œß÷‹—žÄsOz•!®x³Ï0Ä¿60fjB–-g7–Å“°™=×DÄ\‡Ã§¯±O7Æ`§ý¡ä’Õ]ÿjúp;k™êÎä/þçeÍË¯£¢§y¼ØÃ©çê¦¡Ý‡[ÙäB·áGNÄÒýpjnKó†äýç.O¯¨ÛVÙ¨8é¹O¿ùR¯ë‡å¯K‡!…à Ð´…O¾ÁtzYßx7ãÌ-ÿòeo›ØäoL¼{Ž‘¥‰ñàWië+ëd¥ïÕe’nNlRÝó[xãèm«÷^›´ÎŠHÒÿn"Ì¥­¿ù ÒÝÆ"ø$FÆ¹cØTøšNUAœ+øA@•f–ÁeûkO@öDÙP#\]DÙ
éðÔ«ØÛ¹÷H·]^çâŒT¯—_'´%kð.ÔúÆkÂoÓ)$x`ìï(èkÓ»ìT+ÑXÓXûÙySß\Y/«0Wø¼VßXKÔIº¸…hÀ	¿²ÊþzŒ<¼ŽK•™:WÚ‰Î·NßÜüu³¤¯äPë‚à—ê%©¨ÆC¾.m9l`6{m(ù%Ø oL¶Ø”˜·VÙ5™q¡s«sà|lm‹FÎ[ø8Ûí·rE”{GÀ—ÄU«=6ñQ¦U›DžÅ/¹×˜4ÔË…–åÄSô@Õ©óqçñL¡å!{rh7qz~úúQÊðœDŠ0Ú8;œX©ÖÿÙŒ64W»1rDúPfÂk•Iå8y4ï…Ù#yj<ú}>Íf5¾X±Z2¶›zó7j(›ÄCEÝa_1—æ:tÙÕ>õQûÛPŠþ+2{Õ­Ü²‡MÆmyóó²'ÐÔØ¾i	îŒÜzhDëŸn¤KTœª¸èzq‰¡µÁÛè„êÆåBêSxô¥,?€ºÁ§¿JT8|óÊ0©~G±Kãø‘íýãiäªŠñô.í‹õ–þõ†™ë­õžj÷Jö×š†ƒ¤•P1„X+(¸-l¼åÀËAÕ/êb}7xFuˆ á"U”\×û$¿‚¬°e¯‚úÂoà¢‰>ç¤y_ðÂ®;b_xv§À¨zÚEoäSÜysqùŠNãÙøeNŽèKKøä$²6ñ$)nž&…ŠG!á5è JS°ÚWpàÜõAk#!À“R@l3[4IL½ù×ˆ‹ž@u­A´@ªÿn:‚L×_Í>GXÚÙ‡Ûº<Þ˜Êõû¬8¾G¬q½„ÏYd¬|¬?>	Íü_ØQ*é^¸çŒØ\—È–¸H'F%";L0æèlgÕ¾²ëè¶d
ö	 ª½häô?þõF¯â?F>Û?¦˜4ŸK9˜ 2t½ªt5\eFú²Õ+§U— ñ˜àÏÅ"CôySa¬áÍÞ¼öD‰åNäÝ‡Ý_o¤Êÿ[8ÃÊ€X†¹«AðçLý,ÝY¼krÍ×%KÓËTªr!ÔA¾:AMÁ	¶Ýýzäw8…Š¼B¥Gä8Ÿ–]¯Ù¤;µ&91v/zyr*r#=‘¤9Œ¯ËxÄtvÄIIâ×ŒúñÑå:¾ÈßÞ„­ê[ÃË›?ßÑ«<ñ`Êñ-
YëTdßuÙ®~ÀÏÙ‘B}X~Šû9Ân,\Ó{90É÷‹ÉË£¸ö÷À˜Ÿê‘FëpØÎóêú“Ê–—íŽÌ=Õp±pÏßN¬×§L]Û™Ž9]Ö«QÒL3Òæqõƒ‚Ö2ª>«-õëú…ûLE“É_»åúÆ˜˜ùþZÏEØùðÎÓß£×j˜<²¹¥¢Ùü¥|éÐêí•06‘GÄS›†7Rò`¹‚Jíù	â‘=¥Sãà2¹¸£ÑÜ>ÐäÖc‡û˜kÍë.u@yã§mcX=$öö0ï´¥»»BP‹ P#-Ú£r®½ÂÝãÖhŽzÜj¸´G³’ƒÃ÷ê-=5|½ºË}}ŸlT¿-ñguø”NÌó}òYˆ²9EjÝæ	¹SEÆ7ßw@þííîàÍR’ŒQ¿pY£RY·*YÊj
0)jèég3‡y`@F¦rÕ±CÌ½²IBÛˆŸoÀ¢úb²ï¡wnb8ÕáÊƒæK²gm?^`ñå^ŸÔª®Ãu§L!&Q°DÑÅ/Ê:ÝXq\ÕÞâÖ“ö-$ÅRÀü×î˜¥–F“¢cÁ¢VbpàoS1øCYLëÏI}O-¸Q©“åç	M·V~¾©56Ò÷,"O0¸èUÉ,¼ƒ¿OGÊ¹%¦b©+ÎÁ22´gIºÆuÈº¦kÄØ7>×ên0qßiª×'*yÎø7Û¾§Ð®ÔáìE‹”I´Üì`ï7ã®˜'à´-:Øh>ªµ0w2­výyÖ»<Î;ÌÚ¶(£;†×úÑÉý›¶Oðyj–‰˜˜þ°‰³“<¼ëq’ÕÇÔ¸¸¥sX¨hX{Byð-ñÎ.}Øê—ù¨'¦z”¥36˜ØzÃzÃzÔ$z÷îL{©!ÅÅŸå"{%$F‹ëX®Î™¤mÊ»É–÷ÿ…© GO‡²”ËËhÒôôÌ§}‘µÐ°Ÿ–,ããìÜÜÚ1B%rÕ¾¸è@¸ÌI”k½5ýGÀÔÝ“K»vG“ÏRÁÂÁ®	Ï´ó¯¸Ú~x~¦ºÊGfwýí´‡Û'Þ?ÜJÔ@P©1Å^0ÕOÒ7^ŠßÕñjÎ¢ô¶B’›¥¯–ä½”ªìEc;>ý—˜W5½Ã`=„:’S=-ÏPMW5½,V§ú_5&Ñè4í1µ¼/èùÈÅAÍK.[E® I=;Yô™¦‘¬´&÷#KWh-÷(Í)žêoyï<o¬K##¢(ÏÂÌ1([.~´¢VN¢ÇÊðMÕ\Š‹f›400Í5Ù<Ê„—:	ì\’¬‹/è«)]‡ŒÓÁVÓŒ¯›Á¼Y›¶œ@œ¢úqÓhÕf—ªG~f~ëÃ¥öe«B„Bý6š¹á77«­¢—Ô¹‚2¥fõ|ÌÌÀ®´j-O`½‚ñ÷wi]Ç¿ˆ¹Õ¯ö"µÞÁÌúÂŒïGð&äÀL&öÁƒƒ³¾²ï2Žmˆ‚‘mÍç¬¥´Ýu!©Žå=™€é«Ì>©ßä´ÝÞ+$Z>¤I»©IuÊ/Á<Áe)#oúpht=-.;!æ/ò)ú¿j7»5ç™ÞËZ¥ªò°À‡(žÀ>	ý-åhd2§.²#MNt
jnžRù¸«‚äëº•ÏSˆIÝù6º§‹ãÉ£‹¥ûuõÄ•|AA¼\æTã¦ÙMPòçÚÅT:¾6w—l[HôÏâ'‘:}jjHíV_:ck)ÇaÕØk½kZcDFÒ×SÛ{´¾‰j×‡`ÐQ¤ldñuÓ30-¥¥ÖJö¿_ÁöÝÔýYvv ÷p„ C\©08¢<Q±"q!³¿¬_Þ2±.äàCŠð­…è±©¤ÁÐ€ÏOß¦ŽeÀ<Ü)FÂo¾ŽLÓ®ÃÀB?B;Z˜‘‘ñ[4‚†©œZ•#Ó91Ž)ïÐ€ðáú2oÿÍŸE¦€Õö+@V9iE|¤ýtÚH®X+ÃËÑ{”_üqj@ñÔ@[©h35l]ÁŠ‰¢ç­(†³&%‚–ñ`¯²r¶/qa‡'Æ ­ÓîåäyÖöÞlÎÀ
ÉÂÝ\&XÐ=C„F[èÉEš_M›Â½5,ÞIhqÁîõ¿™ñäüÁàÍÝÌ ã@šÉóòÓŠR+í±ä´âon°‰• ¾éÎŠÍE/cAQ†Ž|]HQÅÈ¬½8gãd·ˆD¸¶èu²ßù:aFDü7Î²—§D7h­µV¥²²ÜRSbùì(ün.@0rWm'\|WÓ#	O]3mGV„ŠÒù˜!ªlì7½Œæµ4>9÷ºëÔZ¤HÁ»^ÇTç˜*ñÊÎ¨êÿÛÐÔˆhÕ„ý€ÉØñhî¨R¶ôã:&y²y¾ÀO7}$ˆ¸˜Ítj!O,CÙôo¿ÞU˜ñø­»jçgÆKàB,¦‚ë‘Â ê~-ÇîÞÀÝ°Äî¾{°óÕêüó~¿¿û‡µ@Õ*‘|Ó4ÉÉ({Ø¾»_*×e­¿`à,½K½%f'j:Æa0£Å«¹•r6æéG~oC<$LAO4•É¼qw˜´µì¿Ñ‰¢yš™èºï¢º«B "ò	Þä#2«ÞAÿ£1$³Tl›+ÅŽ]ît/r…ÍþxNéê¥±Œðx+Àî‘‘–îr)ˆt‘|3RINhÞU®@ßÂ	tNwÚU'¬qIE/Ót½9æ/*þPÎÆþ	b·ÂeþNpåx@OñpÃFõ°Ûÿäá8ì•™}6·XqÚU½:x”sÃÊ×€Dë•´¬s°XãcØ-Áö	ÁÀPÕö£™È7[	y®S˜ïÊ›HvÀ:¦~BuµLÀ¹Ý<]Ðq½×Ó4Cõ1£˜l#'¶w£[BÝgÚúcËK™¶Û¶ýó´´Ï´ÍUõ¡øŠ8#™"c2µ8‘¦|ÎÉ6ô·›üo´a:	¨Ä1Dú³Xº ’5¾pº„üCâUrôÉ–ƒÙhiqw§DC©x4åÁ„4Œ+à$Ôñ+åÄŒò#òû9O|ô¼½Ã·ø.†aá”øcîßšÌ5u²b‰ðÿ»­RXB¥ã6OaI4.õWWHªç:ÄvâLx[éxDÈ=U&Œ!Hóÿ^+ÑŒÝÿ†Xãý³¼°£ÕŽ,d&7Û‚–ÌZðÂ„s‰þð†`ŽŠzÅK¿|ïyïíH×Kq¿,e>a÷†öx¥ÐÚ«,¨ÅpWÎ\ ˜zÝ§¢¯ccÝ	ë:t	5«gòÜ¿tÚq	KîÄ§„ÙºÄ%¨S_<Í=ÜXìá¢„Æ/¥Q!D{wr—Å&éÅüÕ½éÅÖ ÛüÔ²úõkŽ-Œšàqš¢v«–8ù,´%ãyXO·X•âu©M:ŠŠögállš÷÷™òèpî”þL™`÷&‹uiuƒº›£nçCÄ$º³³¥þNþzEzÌ{*+>f{œáDCÏrÿÅó/!_‹|þU»Ú£-G	rCèÃÏÖH“ŒÏÂ†™Œ…Ó„Â•hvCIi¿Ñt›¤È—„D¾ÐD0*
¡p»bµjt4U•Lžz…}{ˆv$!0øaÑº-cÚÓ„Öž:¾Ð˜’Œ‚ÏœSÓ¬•[ð3gáåä*ŽáL$®›Ð´ö´›RÙ^ýœ)ÔÏw7RÃÚ‘‰÷TÃÇLÉIÓÖÈc{ÞE ÉDøÁ‹Ò8Ò‰ÒÎ=¬ÒZIø´£’\ÚûNþ´¸º©ÔËê»e©´þh|bDt~tEšu»ÄbòŠßó®ºŠL¤ù¬/¦3üÇ¡´¥–-=
¡¤ÆŸ{?`\ÌÍBg_¤Ú]á—‰ž­è~£ÞÛl¨x_|v˜F¸
€—ƒÄòBà¼¿éþD9ºxêÈÂPÍIÒµ
ä|þW¶ï|>e·xøü>U(O½`º*TÒSË“û—•ï1“Ö:`°Ñjgj	æC6		°JëëÂp¸¸„pÂ>ÂN¸âöà*àN'„Â¯×{Ý¨C?kiý¿‚Êš˜®-üM_Fà4U!¹“1!÷xš&! äe\“û–·ÓCU+¿«ÿŒxj9
èwc¬ÏBf9Ï‰äòð!ç%Î<%¤‚ß‚Å8múÆn“~›,ecïE³¨ör@è6ÇŸ^Üáåv ö¼½»¼LÊü‘‘Å÷rÜ¹æ|Ì†¯£N\kÞÀU1ºäh×w¹#iœíälàu4ŒË1ˆËËA2¥Ûô\ÖÎM`"H–i#:À}O‚ÀèÉñN¾•iŠúôÀ{¤ÏÄ2”¤|ÖÄÎ4¾xBƒo;Ž0Îóì*þl0žó„%öá¡rÝèî«øn±njZŠ¬Åì…|Á’9˜4›s<ï:ƒ×š›‘ÃÆ6†ì‰GÒDÖÇj²~çsï¦¼¢‰(ë–øÒ×+V}tG–œ´‚µÍºoBœì™´ÖéSIûxµ]šPeý^Dy1Ðþ ¦@ÛŒmJW«³i3þ›£4‡2‘¹Z†4ùu4ÊAÎý™Ì…Í(s.r?hEài•×n'L˜.B-ŽŒ;ÛGuÂçt­®©‰^TCC¯÷ö_¨û«žçG«oÞAG‹R;Å"?Íèï¹ÐWaK8931„Ü3ž¹ž­}ñ°°ƒñâ"
¿z•›àØ}z„vèy€0š4ˆ–WE0ÿFïöAxk¥?IØnBcxÊ³eâh+‹U£ã*ç|¦¦x<Q¿¥ÃÈe0OeÓ+½ð+<Ñnnþ‘m]qpt AÙ¡?†¬¬øÓÜ6¿µ³©õ¯¿Ü¡¸éŽ\ûÛÚÃm±.ëw¡¦EsäeÔkFÛèkŒjÑZùÚ×Ñ2Bá—×úDŸšYß"¯á~pòµÚ:¥1ÿS0ßµÞºß€U`¿túù€ùÊM˜ÈeEÒF#ìó¹â£Ð£©{½CöSù¶>•Ð½8ÈÈ­±ß0Xq<••F}ZÙJd†ðÍ–¾ò„u¬¯\VÃuÐ+Ü£‡¢húýãÿR
ÁùäìYý•ÐßB¸¸BÌþ&¬©›D7ÊOdœ@äÒÝˆ‹¸uÑÜ²ÅTâ’ð
ý1ÕðU0.ï/}ÍBœl&Ràà¥tÌ´OAù‡¡O…Á·_¾~¾ÖT¯¹adçë{Cg†Žo6«vXtù¤“·Ã¥ÞƒÎÂr\/žÐKÕ_ïq‚%:wjã!N`×‹¹7*pÍ'©Í¦\FÇk&Ž¼pˆ†ìIêâ†çe|`|Œó¬y†/‡/Z&.ƒŽBÞ`·=|9(ySlEolÑøL…øŠg¯cy)`³¬¦€ÉÏÀãÉ6„60y4g0g0ö0ÌpysexÍbwŽNÇÆ!BmMöÝVËÓà5Ú÷¢Agº`/ºb&r6…¾/ÜÇ[IG-E	šx÷÷’ó³Hˆã8FÔýœöå‘¾®öz¤ÝÛ“0¤ch¢ÐA¼Øædz¬Ò­×Ù!G’d>ÒdÔ1Kþíþ¢·–àqGqÝšÝÊ˜Ê„ª˜g¶Ã—§/šÅÆ«Ê´|ómæ
Ê¸“¾¿¸£è® “HçØ˜³"Óò?Yt¼F™œÒbÝ½i€Í–Êobµ­=B>cmŒ	t2¶C®í·Ô/‹š·ÔÐ˜‚ËüõýÌPfß£E:·D½HøKq!Ý	by=ß™´½Q8žþËrÕŠarÒ|§¢cËŽ95…€Ñ™s„Ëž¨ú¶ˆ£³¢€í—Á;ËéùYé/cqÔ'/ÿñÆÑ>õîŒªŒþùKüªVÞâøŸcy©þúÚ÷¿ª÷«ù.ÒØ±; j EoñjÃ@‰áGF>Ížâõ€ç€Ðbg@)ýþ|ü'‘_ä…w‡­›½xà•o"8¹þ.r‚•K@ë?ø–œ5ë6K]Zï(3q"I=oaœˆ=Ü[ia†v»]@„¢ 
8@ýfú£%S]wÿcŸ±HËí¿íV~ä@¶é 1o·o¡¬£­d,ÍäuF6Ø|ø˜Z¤b–›%ÈÕ,ý¸<:©Ï{×SéÛZZÖJJa$a®¶~?XŸ:_èÂMó¾€Q O?<®kü9)¢L2yC	9àÅrTeY_Ã÷î:JÐ`"z¿»pQG[ð`:är®-¼¡4GêºFuQ*«xH‚ØÅ¸7¼|	žv±|ˆŒ–œ²F)”.’Î‘Ã5ÌÑý¼.¼5¼`77þBó¶!-z¬ÿ¸¬#KËÿR„„²Ce²CósseÅe	^Deš>ñH“#nR?/YsgzÓMßMM2LMj9&ñ“ÄÐ7ŸçÑª¤ˆµ­íŸ„wà…VÛy©JAPJ’†ŠW4³8¯²KqyMÑ’ÜýÀdQWoõ÷dC#%ºFbòXNJuT©Pìuuô0+ƒõÍžÃ¸ÒÎ¼5³GËg¨Ë™ž¨‰‘¤ì ¨!G Á';#N;H;[g
BáF®sÐÒ\JZÓGŽb·ôù‹„ü’	ÇÇ?ë@ª*LÆt22p>0G²7ð˜?·2sÝÎM¦5Í	}¹’(è8p‡p]óïÙÙ~aÏ¿ŒKáºÜÐ©	oÌÍ4ýÐ¿º¨Ze&^YGRö¨&/B!’ßmMÌK\qwê‰[Òäê™ª2Ðá/fá)Ä¯·Pn©¥c29I¥Sz™¯¬$Z"w~IWï,‰¶×lÒ4Ì’ÚÑµ}•¤hiäH¡_ñWn¼iÑÐ±(˜7ÚýÖŠç*÷É@H©£](Þ¼÷m?¾\íÄ¹öç§VCËö´³ge‡åÝ…%LFû!ãSÜíQfLñLÁ^"ÿFFž³ÅíìRŽ³ã† ƒSøq-|6}LGk[ÖÆ…YÑBn¥¨Bº‹^:R_TØe ìsU:µ˜rŒ;IÜŠjHz”Ï¿ò02k–-¼+//QùR‡+iÝ_‘˜4i|áŒD¡”dþÄÂs”Ö¥¤{¿¥~Ð:|Ñ¼Ê¢×Æ³~o<löÖ9´ÆÆf6ÿ%d¶GÐDŸø“gt¡Ö¬÷îåJ&#¨¡¡¯Û	èVl$d||nQ7Š°7„ÑÅ+!¦ø’m‹³+Ë·~Þ¿Ó¡ÃÓÛõÖføûÑ¬òH]¬º~°¨¹¸ª³A’ÇxÎ¨á·Þ‰I¨éµ?Fó²‹d1G©FHíù=W„‘¥ï[¿ªó`ïMó…{ï	¡1Æà…Ú†7ñ¯8Ê´¤ &oçƒûÌï½Â
_¤ƒN/0KJc2f:WâÁbÊv˜!¨˜²vðÈø•Ü6®ðÅ¨þ/Œ‘Y6Á6óWW-õ2:n;=èYÃìë44Ž[ØH¨ãzMïPg¯©@+SÛô¨ÚÜhÁ¬:–Ë_Š¹f|4®Îb(“}}…ÂÎ‡“‡ÂjÂc‡
#ú âÜŸr§5d‹×l8ùgFóq~¤~ò5’G(IeüŠ@èd	ùR+€9e öe
'¦;ö
›òeäõžaº†Â|ý‹z°ôBß§ªÜwåñ“¡áÆ4ÊûÃ°®´›uöIÎ,bGå«'ú¯ÿäæIi.®°}]8ÿ.«b<âÊ{Âx¼Šk
†ÿè
pŠë=¸aýH/ŒgjPæÜñÄ:~Äl”šñnšd1t<è6m}w'ãõ>+Â	0BwSö
:2³(9”dØW{r¡BDÂûN×sµ‘C‹`ÖÚy¶—«¡4›†ºR–
aå¨^µŒ,Ê(ˆZŽöÆž{éöz	k4r*ŸG²ðk{ÏëŸÁ¹³Ù›Ë÷÷Çœáœ”ú6”ÝB4ô³.™{.ÙbÅ”‘z‚`b%?Á6»_¶¶Ú¿KÜTPJr˜ùGë!ÿÚÑ‘oYFÖm¯¼º»¯®«x¤—G9X,ó`,ºó¼wÐ,óaÊ4‹†)ïÊ-è“£lƒÝ·(«ÍPÀ›èWÀ°~ò¬ $°^¦šºÎ£TÊš…•Ü¥îÙ–ËÌ5ÈBðŒðÞ¸¡¯éÓÐ¤v$«Ëüº“ë¾
ïÕs³r¿¿ÿïõ&Ðû³ËSˆRÐÜûò?ßž&ý`HHÑiÎž'ÎºP–ºCHrCCPÇÎ­ÄïÂé-ÜyŒ—Üp®ÜI½Xb€åfÏ¦*_%„¤92öHïtªV¢
²²{­*æ´ôCÝ°“SñÌâ]MÑeÞu~m/¥s)!®O­	¾¾¶®è7©UG&kª¤:åŸXyÌJm»ˆSÅâ#Ý™=É(b%fn°—¶])@p%Ôîª’WTq´Nfˆ±•ƒ€sÇßYäaÐ’[§N=Œì_÷`¹(ñ
¶ûüìãa˜ÀKÈÁ‚jeŽóc‹˜LbøbDú¿&ÏåDzÍ-Ï`ÒòÓæ¢§ˆµ`#¼èˆÀÃ›¶XÀîó”—iì6äNkËÎÃ§è>”FÒ…/v‘ûFMœÜŸÒ4Ì	Ü–3t§SÆ‰‰–S¹–û	ÛE™ôpf57%9vB.fîfwYiý©r–<T„_»$~»›,ç®ÞÛaxçÞ,i8?3ZÑ¥¿òOÙ)¯òbî–#|€+»g;”ŽÙÑ'??ý ý'ttý®X£nŠ{ÅE3!Îu‚l
t…u<t¥¿‡¼uÜB¿¿S¢ý_aXYR)4x‹,‡ŽŒˆþtwÓ'…Œy´Žn¿€fYLAJU`¦f(†[¢•4pTcƒzL^zƒ@Âþ4¿1Ÿç&S‹§½é.¼¨Ü¦–ÐÎ‘ž½::;èš˜ˆsjÀ±Ÿcï—gÉ?Àk‡qÍ=Ü=wòˆû‰>L{´]{ëÑ–	´{¤¤–ÐëŸ
ô9W½OÜS_<:	0HÝ%‹*GU|0›n~“˜”ÿÌ¡;Ö¡)Ö¡-îÖ•Ÿ€¯¯sãÙðY¸„‡·ó‘ºt³u³*Î|[°ztàýÕzi²…z²ÕÐŽŽiôç¾§¹ø_%ìÓ`Šu‡ÕÝ¢5ˆb”U”Ýž:‡ÔƒÁÍ„DÃ§€ƒ|ßèv‹IÍrK¤NStƒ’sð—š†	Ç´>,ÎÞ£Eià*¢ÿ„1vO¾çuÜÐ‚;wúØ„[:ámzíUqÄ±@«;®=^dD~¢E`ÿÛFœ4#fx5“Â)ù¶õÿSBØ|ãÆß6&¯§’·HX˜Ýûº–¡·ºp	S«ç"ÙÊØ£Ã.Â7èßó¬œq^’‡^e!Š2…2,	SÜ“ƒ…2^ÊtÇ[¾ÏG|ŠÝP\4iyœ&iC33¡•a¹šüO]÷¤èŽV˜IÃ¥ß:ÖÕU`
!ðüzfeff¼rO	Þ,i»òò¬UÐ±~™ŠvÓ«Ÿ²M˜¬íÝ­»$]>;ø9ZøAÆ`Î%‰lGo?9z­cóUògð5àn9êéƒy>dž kÇ«ÔÁØ9€*hmùóŠ±sÕñ´×q´yƒ„À##P½ÀÝaÝP„£vª¿P¸x}ûS®›·4-\%q]ûSjz<ñy_’…’_åÆÉqÂxÕò0–Ï×³y|ÔOP­agü¿üËÍÑ™˜³Êîi©/Ÿ©·èñsÐPÍN‡Ï™™œðsØo<ï 'ÅayDi×c†Nex›Î¹)øðä7˜W0¹"ê	…r	Ó]GYOQ‹J/ÓÂA€¡mÒ"9,ìMÓêÉ
w„à€Ó¾}À¾g}¬°ÈTƒúìv43=ØgÒØ†–AÌã¼ŠòŠšß‚Ð´ØØº»ÇmRüôóêÅÏ§£ã\ =tZS‚M±(u¾ö¯'»ü*IªJIOUXXà(a$ß(U£jW8¥7[ÌmÔ5¼ùÝ\tzïï“Ñ'Ÿþëš®¾ŒáDùáÌv¦•"xBœ{Ülwý.euéAiÈœÇŽS¾Œ€x£”Z­¤ìÄ5qLæ.œ&8ÊlF*ÁB»l­ºz\­›ÀâçTã'Ûòñ-hÃb {Š{Ž§ê¯òæþz¢Ù4Ýàmòì%“ñ8:„E­ÝøÝîÞpmïˆŽ±:7,ÐJŸŸ"ŽíO—ObTR^^¨ì¾ûcyƒ?´ámñXñE1þ’DÉ°DÔèÃVHèþ›óbñÙ…G¨^X d€ÿMh¥›ë•±Fª±e­t¬ì­¬ªcø\„¸ÌZv¡îÍgäÖðhd×¸Sd¿¿¾¿¾d”‘¾SM”+MË+OoÎ¨L}1hÄÂoP¯®VÖ¿ssŒ@Â5”5”ËÂDê”w£ô£»£»·n_'t½»“!Ew»&láSÓÓvÓùæy¨|ÏPjGÃ¿Ë¬¸N‚Ø_'òÇW,šJ5ëöú¹mny˜_¤G†ñ)šh]Ç€)x+èæo/G¥AßÅÇ¡ÎE `zÎ#kTvøSDBrßç¾_ å.nY_É_WË)=²=É+ŒÀ>“.ßmd•a†ÒÇo#ß+ÎäÁe¨¾`õ±puMib¦ñ©¦ËÃ0Ä¶{ä(®{’4—ù]œÍ¤“&ŽÍNÄ)»)‡Gr—†KòòCcifò7†*`‡ ØàÓyI/¾§^_ƒ¤»>V¬›ofœ¿hKL€Õü÷ÆcHŽDí«pÂ	¹ÛÒ~2Ž’èðohàBD‰,”){äJºA®G'VP§«¶ÔRS÷­e`ÍjÛßïãyÁÊÊ0;ÖÖ½¶$;õEiào~Xp$wŽ(ITý~ñfor¨t?ÜGMQ½Î:ÕÒüxÉlv†‚º <YJBt‰ä‰—JU€#S—fŠ’Œ’ŒDýpÄ0#Å™ÉŽÍL>ÕÕLŸL%WZø ßQ~û½+‚›â¹Â…aœXÉöéý;-ë$§J ?<f?‚€ˆÖ¤Íç1ç¶aÉ°@€Qã×`yé¯íëÉCë$³5Lk¬Hs®øÖ%®Y/Ûù6
<G**+~~<Q¼\Q*©4ßÛœÍ±~éóÈò'ý‹*ÊÓµ¿Æ;Æ(=!11-`í=Ús¨TØlWÍzù¾KTUJ=èºH¥W§¾Ñj:¿¾b¾EÐ<Ð®¿¿:UGñ.r3oUa?²4Ä{0-*MxYïHN‚M)ž§}¬)ã8Äh­#•O¥zñ«H	_êYf
²y
9Äs¢ÒgW¹{xpL²¢²•T ¹Õ•²•Í•Û“Û“¦_¦ô_Í_Šööç1˜‡›SASLâ¡¡b‰LxØˆA€ÑMóÂË²‰;á÷Q±"BG*ÒPÑG‰LØÐW	@	@Ð£Ðüv¾@_HXHÀHXÌHÂ*ë—QZBøNðñÌJTð­YËIl·Ûãp¸É†„N%'ßÊ:‹ç’·:–È*’·
SÛó
$ó?˜ÝóÛ²Yc·.¡ÝÝQR
IiM81sßË°šx&ÛQ·ü¸ûQ«õ/zx—áú-â——$Hz—h¼fÐ;2Gô2;üô Û ËÏuu §¥d!7&S:Ü`~û"cBrK±¢°ÎˆÆÕ·Ý‰Ë‡~wT]½©€§_y†-ØË:sÖ£Ì-ÖŠóÆ£&&ÙóÙº\ÏzüRõÙ-ÏÏÿYžÑûí_%w=uå5z-'6[nÚn>(wÄðQÎÚA%Î¤ÀÑÎð›Q%¤‡y`ÉçÉÉÜÉ—™™hÍœ»¶æ¢IÚ;sæsÐ›‹~¡Š~ûú7¡úúú¬\p\ú?sï\\+ÅÆ!^QûãîýËç‰»ø½Ãm¾úWMüÐÌ»•7p2°Ù.IQžI»]R
I
R
Ù][øK!„øøçíôU#Geh¡·BÓÖ”NÙt%Ñ«÷ó›ž›››«˜ºñûÒRŽÇjõŒ–	Ù·…tuÒ“ûõX•^ïp(óïítŽü73ç¬=yð‰#:M"#‡ÒFˆÞœF´ŸN—ÅFš#IX¥ªªÏ‘¦õ˜RD¥yÄáßØL£ð¾´*€F@™”{F:&54¿`HIc¤à`øµ²Á"°Þ"‹·PiCØÈq¾i´ÒW=ÊgC9ÂeIà@õÎX€ßØWåC7?WÃ§”iñò«;ZËÝlÕBÒÈÙlŽ¶`p¤†{ÑÈ¤ñÑÞr=Û¤øããO¥«nÞ¥VKní?
g/ÒEyÔ‘RÖ,Ïmbi¾o°,þ)ÁÀñÊ¬ÿª¿Ü’ôë3»–†D1*ºÿ¶Í4’ön4¶ÍX[ö»[[KKš’Xßçþ½ÇX
Â–ý|ó›#¦#¤kc±½sx
?ÍÅµ’’’Åx1?v¨×vnHÿBT¸£{>wXHTT9í ¨¸q™=D+óPrQ8wÁñW^óEÆ“©k©!!ŒÊe/eó½7ôÍ½¼ÍPTGO“R_&M™âOEö=+³÷Æ›ä“G¬§Áw¯ð¡ùÌÜ.˜ìön™Û‚J¸ü¦š›‚ÛÐZpg³¥‚À))ksŽ)âÀââëë	H	}$æìpFnîD¾cÔo,‰£pÈÛ;r­Ï™ë‰þGÚÎKó÷rÊèÉUèÍžniU5Ú<û¢Ž¢ç[iÕçn•%inã{?ß•Nú•øß{¢ºP¤^úçŠI*½$©KºŒÐ±Ð„„ªžLI8‰8‚-AÎAÃ„÷$°}ÆÿÆûü ûüýýû $%ºñÒýQ£Q%(2›õAÜvñ`2ýoÄ@gðk:Üc|¸&±Dp°p”|JD©pppÁpDÁÁ>|I»p»gm¤â)Õñ½Iež|À]–õœ™iXÜ
ZQ?_Ÿöh"‘0ƒõÀW0Y?WYxWƒWßpÀr²»Åæûööu/d-JÀÂå£]}Ï09ðÀ0ŸhÈ‚–bÛ¸rß"þlEÜÜç®ŒºèAy®ƒ/áyè/Ayãáô.vÞìâŒD}é…c…—…émé…‡m‡‡†ëúíg+º®ÆŠ‚¼P‡û‘²ûÀ× ¥²âNÆÓ'ÈM]!nå%ÿ…¯š”µËK|ž™¯¢Ö ‰ÙòqG—	­¢Õlpd®àyZÀzi^Š“:u ½s¹œ—€vÁjØœIÈvhPžöH^ýô Ð,oô’ÙÉ[’0x“Ø(¾À…ƒü±°IôäOïü£TªD2T$&¢¹÷ä“,Òr¤nlÊ¼¼8)E}uVóí¯l®	­ý¼­lXÁ¸ö?˜IÚ8šúl$ñ!/TôP=_S–â½þ§HjO¬R¨WU[ì`" +€Õ	ïõñíh8ZÊ‡Ëî*aœu=RœwPÔ'ÚþÐEA«È›‚´þœVŽÊãÑDÑ·s„ý·DýV__ý–³g˜Jè‹ègQÒ+m…9±%Þ<'ÒôHLß¸'ßÝ¸ìÝR¹ÝÛ¬
CÜ¹ ø
YêÚ0Ú{{o0{Ú[ƒøô“&"º“æ~Üø"ç*ææa„é‹äÖsÎˆ¡Ó’#¯ž</ŠéddÊ¯>(´}¡bòÒ~}0pQebµ¯MMï&«\ÈÇY¦î\moOŒ+QnhOS+âøŠÒ”¾s×Üî±é»ú°íYMQ×¿)È´™¨Eäàñ´4Ÿ¡5Ž©nww…Üßáèº®7 Â¬º•T7l)úƒadƒ@EŸ(ÀNÓŽ—jþMM éd
T‡–èM"4.44žk4Æ”÷û‚œúthbÀÑÌM†Êoy7Š«ZM8
:ÿ3¡=SsT£Æ_Ó1ñB¤§CƒCÇž©<ÀÑK„8B3c<!1sŒF1JYR‡b[{I¶K\VMDv‰‚XbMÖqXÖHùì8 ï&iêêMõm•š••$³$°Ü"ñ[ƒ;—kvð¬–ÖîNÐàõî,4b˜ObièÔ\=xö€‹ÿ©ÅYÕ''€9ÔÿººêÖzákçç„Éš¾Âµ±í¯¬ÑéÑ‡šö˜Ë¢ðàÖ¤ÎÜ7:ÉO¾ï©¾÷®OÜf·~!·ën(ÖçÖÖîêî!îç·Ö¥øÖþo¤ù/ÿèú°îW
}
è>¯ÇâÕÞÏlc"‰îoCTÀßùŽìñ†¶„S;¢Ý¸@Ý³;`´´j¤jÉvSp-GSG¶b]]¶ÕšŒÕ¶‰OO‘ä‘‰¾ŒÄ‘¨rSÇbrÇªf¥ùª)î?Â6@=‹„—(9‹¾‹=—=E(0+p4õRªžf=”¢F³„wÚŽùb«4?É©À¯E,Ö™
74+Æt¸š¸%.
`ó!bHò2'-º-S-ºø<ÚÍD<Ãq“qD““6ÃúÃ16~66vFF—IIÈƒãW÷¦<7*ÒY¾Ÿ…[05ypªp±ym¤7=R¬÷Âù…æä¥æßèßy°ÜÅtôŽâ…Xƒí–ïctß±æy€”?>*£³AEÚV}’ÑgñâmõÐV\õ½\¼gG½˜w­Aò$ïJ`4Î;kùÊËxX•¯³ëÀµñöÐï7î-"Oƒâƒ}	à«ÃH·?Ž·——¸Ž"ÔmD)?¸?mŒuu2ÌUd¶ÿÆ†4ªrÊUöPöOÌ6¶žÌIÌ575ääž*!å|@gŠ=_ä*ÿBl™…Àç¶ÉDáÇ‚Á’‰Df(Á#Ë¸LŽ0éê	-\¼Ðïù’Œ »ß#¯ÍÛ`¹LŽ'yx2cv2R>
Ü…>ÅÐéË„ŒL>2½´ÃõÞúYXXlíUÚMDU±^LbM±É]žbmûæñÏ~Š:€ƒ#$û¦*—à“©¶¡¨ö©'Þ õ>Éµ¯S³¯ÄÍ÷‚ŽšØUF0IÏ0Y†=	$——_U>(F}.ã»ª£øãB#ãðqà6D¬«Ñ6ÁÔ2ÇzGñðWA)‰?Skå&ä07D UÀN"ì$~9•µ¥ÁØE€¥¼ØP¥¾P·ÚP<°X'È_'7†mU WkU£³šà‡@”£6ÉåaœTÆº#z:H:Nyî‰gyrhÊ¿híõþKÉjL/tî·UÝ„E„Ö=·í‡Žõõ›EõVñé“ÃõÒüâü£pu¡vS¹2åÀ\G‚(ïä“žƒžãhuïìèáÐâ„õ¡óÉ6Ñ‰{ ˆÖª^©µì0^÷sÝ‚ò<‰kbÃ—ÃÚ(òÜ0•¨H‘ý ÞUà—“ã4ê…º1Û¼çþ“Ž!‘ó‘õõlšååË¦67ffÇQÜ¤_#Y¨NÕ¾ZL	þÜ™Í™	ÿ	¶×™™É»Ÿ¡Éª‚©I;=¯|Î)¯sÕÍfŒÿ€eî³ÔŒ¶ŒQäšêÉã’Cùƒû–¡¯î:ÝŠ7*ŸLÝ¨{<o{yL<¯¸ym©LãÛ¢_Ê3+„¸dLÛ”Ûtµžt×Ÿ¡×HE>4×HH#>8#>3=¢¤ÖdîÔõUfUL ÊÐRXaÚd{XÚ{a,"/Ú´[HMç;ä‹IO¥’!ÝASÖÝFèŠæðI3¶t¢ti<Wt</5T‡E¢ŒEÆÿEÛ¦ÿ¬û£!¨å™+ò™ûò€åŽoQí`ªpkqŒl7qº¶OO”7ô¶I¥¥3Ú½ûTSï/¾61«¶ÕmX i¡4ŸŠ8ýC¿Ç<O<„ÆìPPnq¿¿Çµ‹µçgëÇg"gÇ®‘"‘æôèì5`©–‡e& E¡{sTOXtKÿ#†Àl*GIbÖE£³ÂÂµ`Ñ›ÇÎJ­õìJ›ÁH¬ÜcìéÜÜc€ÿ\7XÑqí‚*Vûã=Eîîã²ŒZ.²£Oo£fqæ	Ÿ£k_KßþØ!@@¼{•h/	6&³ˆµÓ±H&¦'­Ô[mgÙâ`ggšºgò	¬pp›—µÆ>5Å5ir›Uü}‘Žií=6èï‚e÷-êB€äFˆ™Šºƒë©}Á¸‹™´ðüÕ÷ÆÉÎ¤‰x¸jççg%¯ÓØ"¡¾"æ|Ãe·Âó‘Y<‹Ló#+ïùþ^‰ÉîÀMa-Í’‰‘Îzÿ'»Å’ž¢›¯«·X­¯çœè[‰YÜŽ»©~/Ë&âËb„Ù¸Ð.»ÛÇ“™asC#Òn# /¿™¥Þ¶žùÑBšÃ€­Œ¶n™i‚(‚ko7·×ÑÑÑ.éÛ•»ÔÔ.õ¼H©ŸÅ-ÒåýåÜþ)ëšÊÉaÊ®&a÷ò~~rp³»¥{pB~e¹êzg£°ß)¤QŠ·™X=¨L‘Ó»~ÇÆñÎ€Î­ÎÍÄm²²²‡°T¸mÒŸš”ä? m$×¨±|#(J½9¸N“»‰ÝY-Tÿn‰]¨’Wq7°¸‰c¡?õb–y‘‚øÿ›@°Çƒž+Ýù<ˆùKp•H g§²Â4¸éœåbøŸÎß“$J$ÏWeÛWÏ:eÍ4¶^îíí4W·ÑÙÇ"*·d¶¯³cŽùÉ“•]=ThBG-NºõCz¸ƒ"Ç@ð"x÷ÂÊ†XÂXX v³l XlÌæ:³	{z¸lø„†%€Ü|æêåÐž¬HdidHå	ºãºûÛãúÔŽ\f™¬P`v	œL.qq.Ê¸	ÊVé$¸|q~ü¿(CzŠªIj.PÏÿŸ¢•²(Õ{J¾.Ì}ÉÑ$°Ÿ4Qv8¯ëfŽô¶mnÌüÉ
}t}Ü…Ÿš:ŽÀ3ö9üè5šþ÷ÈCC5»|`4½Q?ÓäïåUàS	4è·ªþ	ÎÐÎ†’ñ¤95òe}p_Ps–«”ðïƒœªÚ&­«BÄ4`f‹ÓŸAEEB¤®õ‘z>ïZ~Å6}þé>9`óFb|Â»×µzdz‚È„@k*ÙŠ&Ãøæ°‚¹C†¨&:Ã¾03Û°Pøº
VïñòØÍ»^6‰“,íËKmº©'hmWº	ùÏùº#´h;ÙÞ2#Æè=ÖÓ%½"ø`W6qêöOy,Kži‘²>¤Ã_pß]\8xCvíOèz`žýgè7``7Jèú7]g#úH$CÊŽÿ‹2‰Y±B/Ø‘¼“ÕYÕäîã¸—Ø«Ç”¢ËåÇPöÙ \¬Î\{k¬kAAæ%Q†k{½‘øî¼“v¶ÊÑ×ÁØòæ*?Nuu‹~¢uæuu~~˜ÅŽÅ2È„n8rÇ%Š¬K·”ílŸ3ƒ/Þçôàžñú‘¬J[ÈÇAñË»Ÿ¥2AðO”aõðA\w‚°8¹®ÿl_‚âÊÄÑŠŒ‰…I¤í4‚‚ˆË0v1Ëã®Áä]žT˜L0Ù,7ÑæØËjÄÜæ÷C9á2·‡éÒ\ãÕrë’ÝÄãA„Ñ°øQï/™­ÔFØââØIÓIë®ï¦)F^[DH]¢[,©Íì_0-ä@¦Uìp{ö¯(2-öÈ}óâÕÎÄ
ô¾ÅÆ7Ù°íÆÊu®;åÌW W„°^+â{¡+Í¸¦ûØÅ¹{³¦±ÓUÞ4/?Ùpz¶(p»­eÏ5ãŠ*Ž•êeØ<()Ú)/TObˆ’¸>Ã¶hiÿ¡Lz!¤vdµ¥åXfPR`j9Èno ‘ðêÓ'
áFN%¾9|öÓÕÑà¡“ÔÎõ’ÄÌìž8Q%kl\ò¹î‘›fïÇfû–ÛcAéÜ›Ÿó%ðWôJºzAZÃÃ“¡§ßãSbÂÈîždŸWM
ßY98¦'@×¬ªËî
s=Xj·tG‹Ð$5béK<ØÈ?€cæçE8Î+‡50ž:ÅáüÈqŠÖ§ÖÞQzTLÙENm¶J­¿<w~¡Pµii±Fµ` !I7øÝþ0!Ÿ¨Ÿ@ŸƒÖÒ-VP×°k|ÈL Rë£ùYóÄv}e8Æ¸Q¬»˜ïªœ‚2Y/'ññÃ¿òªË×½©ø¹›¹Êú@¬˜Õç<q3õúCÙ:JÒNÓÁÔ«†´Xü~ð™òNÈC³˜ez¡Ê_ïÃ®±þšµ°a¨Û&Y±¹’×1“@$÷sºÔù±•9Å8=xz¬ckååªwqoÍÁ Zþ"eb±±.®üÁIÑ¬›²XWö>T×|YÅ« Ê×äÊ~ßI_™hXŒ7R7›hýR¬wûB»eË+HtéÖ1&æO1ù«Ü©EUÃ¤ù‹U×PùM¯qhÁ’N‹e4ŽXŠ2c½ixŽJ+º?£±u u+ÌŠžévü¤L5Gr¦jE¯çŸj)`Ñ·½/ÚÜ…I–ÀëŽÂþ®ˆ’P 
=5®~x8ç.!6>WZ´±À¼‡°Ë|"¨¥$A7Ë.A%QuÊTwy`UŸ&Ô\×s‘}h0O"y¢u iù2„§­®®¿
;ÓKÆ'ÇØÃåKœÏ?K ;±Î¿­ÔÏræ—Z>ïOªA™DãÒ ýÏ p=ûªý¼ÑÊ`MÚf&’ú˜ÎÏ÷eØ›ÔæKÝVr… ¬Ë35-Y¡Ø`€äZç×c€5ý?,bwdg}(|.sußé¸ñ÷cxµztá-o™‘›NÄ˜D››H—E† ˆ¾õ2˜RÆddlžCÑdmDID(Ù£‹{ÐÝw™3]”Ù‘~zÏ°£ãV¦SyXÝÉày«›®+«’ti~yÛSz±:%\öv5&>Ž\z&…¤Zö+04Y'˜øYìôŠK
T…cŠQÍ…ÈCYAOÃp€É_6EJ‡Ý¤7V;Î5yíºÑë‰P‘Ë:w£Ø*pÖ¤9›¹ÿåÀy©MF
^Ilý¢cml[I4G~ËkqýoŠ„QA1£õ-”æ²ž/J“ñ­Òqñ¼N8ó5:>Áå>±•±·ù6³åªàSÔßyJì°ÞT°ôr¶’Þ·š\´~ \ZW$Á3ÀvÎúØ]6æòØþ ´Ž3Ùt¨ûÖmmÊ¯¦fgÆ¢²ÖÄ«¥OÃþ¡•2ì~úü^Æ¿ÛnÚD+G¦F^Št8öEÈÃ¤}Ã˜——Äöh.û~Šuh´#Ó>å=¦§;³}ÌMºQÝÂWa°åÄÀ_anòÔô±âyVL­JsèDVlxû‘E«žbÒ-k£8{ƒ}bÃ§@uë•N%x|çáGã¸š(&ÌÈDéu”¬œ.¹æ¹XÑ%ÅõR=i¯¥®¯Æ5Š›À”Œûxhäù_žBSP’žÖî·õ710PÐj6oœE®Ú-ýòÇ®ã¬ùz³©Óƒ	
ˆ¤šý5ûdÃÔb,XßÒ³êÜÖg2èÜ.t·i6éKßðÓ=ØúŽÏ~Þ¬y_kpåïÞÞl‹¢Üú¡¦â-ð/þïÉ]ðñ4o0÷yUQÃñ4ŠûòÏå¶®6¶HUF|•4tYtƒWxžßêvÉt
±f|ÜÜ;ÅÛÑOHOIòÔ¤¡Ë_Õ=9,9¯ À-1Æ_Ft§D¹à”w‡±]îJ/*“RºýýÞRÊSÕ0I¡g÷ÂÁbÝžŠÌb	ülÞ‹PÜ}|"Ï®	)ì·ˆ‡öåšú²—€·ÃYñØçò	}÷+3I2G>GÀ9×B×»7˜*E÷5Å«›dµ	;Ó¬Æa÷y.¹÷éºàÃ„ëâ(É…¤Œòè™Åwò-J“7ÅV·Í{ ½
Q*Œ°•P‚ÿÛW ßâß¢Ó˜KU§¢ì~žîF^ÇqfÊÛSÊ{¿­§Ís•˜¿¨³ó7µÐ5ÖØ®iN¾y‡‡ÄÄ-ÖÄ9à%-®s³ÈˆÍ%€¨gÀŸ±
0øzZ%NO6¸­]}©ò.Ã_²3µÎŒ9²;ÇÓ?áÔŸÁ¼•4µ²ls•æbf…XHïCeˆÌpÍ)‘ÝûtãÈx²×2¸uõÔŸi%¬P¡Ym¨(Ñ¿	/Ç?pð2	ÿõ‘4_.½ÉÐ˜‰Œc.GúÊ?-õ: ¤î&ømpZ×Ž³ë‚ìp§¨ã²{¥üc®ÿjçšèàï“øè›/â±*BÂìÃ3Ü¾‹:àÇT"ÿ*p¡–*³äZ}x=€ý©¹½3q+ì<‚ÿ§õ«„Å~µb„ŒOùQ•ÄçÝ¯ûŸ­’Æf„á¯ƒ#ä ‡æ•‡$q`m0iœœP,WÌ— X:ýþSà†î07Xó”î@ò•28R“s’Ñ×Íã[@k¡zjxh:‹Î5Ú`ìiå¹8}è¶%®ÓR„Ó®ìò;×ò×ë8“•íZƒÛá§â€í“ìíÕÐ7ïÔÔ=²wŠý­4°ÿmJZ™‹þW*<X‰…˜åÄÏãùëixäGÊ))Úð•§d{,º,Ì4îTûe~^[}ØJåôdR†ï¤^¦O-:t+…èõ¼¦Mg*ä‰ÐàåŸûÁöë²Ÿì/}¯¥é™5¦%€ô“"ÐóÓùâ7­<?5°ô‚7ÀD<ÕGß<ºð”N>º¨UÆ$.´èRi–N&,_T:ù'9Ò ™EK™"QE™î,½É§÷7:Î':Y¦R;Œ²19Úx+•ý¨ 31¿9ý—²ø—ùå¹e2xx}2ÐCøiÎ§Ai|û"§ÎN²VÐà×•ÖÌOëËüýÉyÿà[³”œèÕÉû½ˆK|¬gÙW‹:üè"üXççüüj	öç¤ÓÛ	ö#ÂúúÆ«¬­GæÎ®Ó"§vÓú«÷ê£
Ó½d½2M5½ddÅ[«ç@;2ÅÕRº2ºýÔÅL`šn<™˜†ÕíŠoEòˆ0DìSD£€µ}h^ùñh~\wã–JVj#æ‰QKK®6Ä8¿„÷®ãVŠëaW\UKFçu'¬¥NaooÞšÊ}˜·¢»ÛóÆßtT=?Ï»c‰zÔ]dˆ[sÁ¥ƒr+Ô	¢Ñ‰Ï¼t®´ØÿìNÝêíúž¿©ï¶ÅÛÊoýž„î¦oýµ.àÇ †ó‹}`È¦¥ðÀË…b2_‘4±/5|NkDë7¹æ™m.oIQüêÞ4OU5§à:1õ’³º9kàõ5Ù-5›[ò`nÄz=WI«›ŽÙóñ¤„ãRž7‹Q5		RöêêáH*-iapEiá££¡8)÷oÊâ#Ã	Ó4ßx­ºî­h+_–_´Žœ_ÿá´ÏŸ\éŸ[«O>7*[.aÒ8¾››¼99,ìî¸gõ"„õ’õ¸Þ¸0„Üuhì!½M$f#wÜÝÄl=spVçÓ|¥y¢ñNÓÜ`µ%,†Ù@ð•ï\A$XÞòEçÄ7|Ú)‚Ò…äí4èðCiiƒð[ÇeÛý!©dê1
·=È]<nÃh{./.Ï1‡óóàòÉáØé–!ðÁÅy¯ø¢Í ä¼0Ÿg”¤¡Vä“–––UÐ^%9LÌUnåÜ¶U(~ä±Ö»C3EÎ&Ÿv2í÷fãøb×ÂxÝó€HÜÚ‰òò>x’•-Üß{í÷ÒÈËåh’ÕþŽú6ÇîQ<PúàÚ´¦	I
w$HëRánLu‡^û¢äìÃQ%z6ÙïbËH@cÂ’ë¶ÖÑ þ]Yé,ä‰k°Cßƒ‰ƒüü²üf•‹ÿïÞ¶î÷Ú¢õ#Tñ„’-„õyMé½ñÉdÀa”t+"+”gÑ}itpÍ“]I0&PõC¶%¢©²ÿ"XaY÷i¿AÓGËÝ¨;Ñ;Ñw‰ß40¾’Dãÿ‘èÓçÎPfØëTPÖžÌ˜A¹KK4å	¹Á€9+9"Á(w"ûQxçà|¦Zp[þ@_ø…•œBÀ›àÍˆ—“c†ÒÀz†uÁd»/\Ép?Ë6O#+k2V*8:ˆæÌ{+{Ì/J©ê½IJ:îÍ£ìÑ“Òf&»÷ÝÒ²dóõû}-Üæ± mÓÇï²1%‘Ÿ¿È¾‘/Ò¾MúÔQLT´¼¥jze]e¤cƒA½ežß@`1Ñ™Ýd` HE¥%Gv2-/bd8˜kçœñyç³Æìà˜¢­“	¶…¤F	!8SŒìG\gÙt¡XàÔ†ãË¸CÎ\)ã3ººi6tè3YäR˜NBS*øòt w>÷ŽøzTÆ…Uö¼À0KýØÃ[{©ÄCWqÂÉ …\$(Tö'¿äÀÀ×¶Ù;yÙžã,†€Ù9ªš|Ek|ÿ®Aª	’ëÐÎêÍ÷?Î#.OÎÉ¤X$¢Eïüh9ø·ã@HÙlDå§ž…ˆ¸¤ÊÓÂ]wMú=Ý8x””8.89ÔÓ
@ð-ÀçñSF4˜'ð{.Šþ š©%œÅ–mîÞ†H==Þí`«Z@@ceâc\ŒzW½KmpfÛ{h××%·0)gÇP³DrÏdG.á-Sèšó‘Ug	¾	ó	¾¶óZ_	ûû££©£k~ú£%g`(È`÷©n1,oa*=g0ax`‘P*X2ï¶ïŒOnh­.<)ÅK¼›§"PÛB"ÙÙŽlLŽLL’BÏ•eg•2eÏ{—§ÅòÕqø†Ç¹ó¶3§k°¯£JµYh'!Wä-ÝM¯y	Ñßyª	Ìy\ÉQy	wB™Ë™÷—Ï—Lg{{*¢wSËT­:Zp}þEˆ´s±iDWIø’YdêŸ7y;@Ed™»Á»´»Ný/™²‰ý<‡´¡ŸC‚ŸTZTŸ*×ãæçfDLà@x%Ôaa®¢®ùùùñYñÖM¢Ú3M3Foi4]êZ}Rì}Èž•ŽD¯!ñ’««É’8…M^Hˆ,6ìÅ¦sQÒ§ôÄAÊïò$àÐ¹ (»DiøJ…ôfÁ•8h›¼žÒØn&ìJñûö—àé!‰}S±*“2™ë±Ô+'/Bœ÷Áux©¢Î rDçør…œÉšþéï«¦¤¶•K:,Ìð“9žµ*‰.!=c,$Ïýýa´$$ªÉž;É‚%%Ú¶ÅôMj÷gpŠ£ÍÁ»Ub³¥r¹œ
¶e±üÞ¡ûT™Iö?ËvŽì]|3šl6^-E3Fvf¦¬èfœ-Nðß_=-S:H*2Àh„hf¢RefLÆÕqœŸ£Hþ‘ß§ÎH•¡÷ 3±VÔM¼…¸Ã£AÌó)Y()GsqTL6{;óŠ¼ôVˆ-Êýý))ù)t®Z89M!”I”^eÚ!oÀ”Û?T`ÓÀBz£öðîùä§Ínæö5¨ñ7ˆ¢Éž®¯iùï¡V£n_Ôé€#±çßœœû'ß	©´©_ýÔ©‰g²ÅmHRî‹Ÿp9‚…ô£Ò„8·˜4¦	4p}—b~Ð(:-¦.°`Êi';#pºÀC—„º¹ù9SŸQUQáÝ¤‰»ÒvoÚsò¸ÄÒÕÒÌÍõö¸^ðíÈ‚žâ™KŸ—óØXÏ"q|ÆÇ‰zíƒÇÇÇu·uåø2
h‚ŽÛ&x*5QL¨¯ý¢ª¼â¾Ô¶³Ã±´&/ú¨ù2f/l=€ñ8Š9ˆ<uïñù)‡P±e¥‡Ô†ÒÓøÓnÎÓ€®•'-t˜ ƒ*N£í‚2ÙÞÏmÛÈ¥ú«µPÀÛÿ¥Á¯)Àî½“¢x]]¬³‹ƒÛ1Ä3ƒÜŽª@?³«qµð²ýÚHy× «ìÛ…
ÎÒý/íõ×—žÊîü~rˆ×†€ž{s–cAM¨åA“9Qßß¿Ù:ß×U9\0ñâƒA²ÏÝäÉØ´¿oQG:<†—Ø&]ŽÖŽóllÌŽÙÌlvÇ3p$—X5Q†´•¸DIœvýÌ–)u‚~qqÐÐîR¼·“é’¹	Û\˜O’Ö\DrkŸÑK+ÄÔé£‹,¤™!‚`‘îõk¨ß]Ý¿ÐÇ"Ú¿úYôéËÿ9Sz¨jÊ:×Ä]Æ:V±-Ë&¥ŽQ“2))ñ‡¦­Ä’>{4“¸a8=ž!ñ&ä¤ÏÚSÖ³èšÅ˜ä;´Å( ¯Ê«ß3ˆˆÃZÜùÒŽÐ¸kgeU£$mzHKÙgÔnLL¶¡ÏÞo£ÌªÏ¿W}ßÜ8æõF™úšuï/Ó8ðPþ'x«[(Ú>'jÀPu.|œ«â¼U¹fÞ…G£ÛjŽ²¥ðß²!{[W'—€ê)ñ2¤ŽüóG"FDIÕ:½N|ŠÐ«‰Û ã¢.u}Û-6{!g+Ì>1ß,tlq«»~²‚Ù¡ó»cÑø‘eÎÃ ÀÅç1cŽÿ¼g l×õoµÚÍ¾±>IÆU;ƒÌ;?;±;.…z´¨k}wz´6Z<ŸÃËÔ?™çZœÍÓXƒ–Ÿs›ÞÕÆ7Î+XÇ„O÷¶73¿Òu„íïCµÜ‰­%û/Í4ÄqþðÀ¥ßb¡¬šî*$7h`Y…ZBWZKKW%ïôš	Q¹®Eéƒ·2Ú¤ÏàNÌÈh‹Ö†9€Y^†\~~ÁÁRÉŠrT‰~„Q:(5Q„IIW!WWW1ya‚Ï!‘+ÈÈ+‡ÈÏÈ[¬Ûê”¶¯´ázÂ¢¨û‚PõP´ü§&ß¿ìUqßläìä;Ôl– vöýCaxq²óiá	%PšI˜z>Ñ¦zšg)[¨A|›I Œ'_Â1-@ëëq1-ƒƒ×2²õ×29ÏËËÏõ‹öË³¦ö‹Ë³ÅÕÅÅÕ;ûÃì&«›¹ÐóäÛd™sOŽ§0zOÕŽµz$Ž#Àð$°²µ0²ÞïgïÊ¤¤
*›M*¯5æ[eâ<À>5÷–&¢Ž¯å«‰Ä×”Ê•‡çð©¯¬ûÔÉ•ed•ËêëÖÉÙ²Ø–¼··¼É"¼½WóîcPómã¬Í
}»ò¥ÎiÜÊ¼GdØ6O9˜ÞàÆ4‹åy©Ïµ+7Òsa6ÑØÙ=p†Óµ~8s 	B1B?%b6,˜Œe‡lŸCÂ`øÔ'ì¿ÞQú¨~S®~7¦õÛžöæ	Ì”xa'Ìª5zyy?y;ˆÃ‚o0?…Ñ!ú®Ž"Ÿín‡y+õï	¡T&¯óyèÃcÎ¤Ä³Éû«™ÎˆÝÚ¥ž"Z±†:÷"†ða±+ê“_ðÙ)tÄœÀÍ]Î6Ðs>Žm	j`DT]’¯E* ¥wÂ–¸sGm	xº)Ìf>? ´”íÕ‹íGÇõò'øi8gúçi³`¨¶çãÍ+8ëÊ¢'˜(Ð"=Ì?Gúm1•¾Æðb`î½Á 7¶OÜ¤µ÷Zyíø÷OìÀ­¢‚3®¸z2Ûÿ”¿‡¶Ì’œ‘g¿Â:¢¼äžg,v}y&	9+Iä=än5µ—N'±¿:|R¾QvŸ¿c™½aáˆNWO%ôáââŽ••”&••	Ë&Ž™g{	šC`Uð5¿Ô2'ä¿¶È çÉH_¨‡·¢§#‘€bH@‘p	’‘WªÍÕNÍØúì›ªß÷}l¹Å+éoXTgÓ
Â
G-ºû:øØ2'ZøÞŸ³\(´–(hÑùdÁ<kËŽ‰Sa~Ï•xv	ûÞuµSZtÉ@ð¿)Ê¸f¨xLw–wî–iB;i'<îO–RÜx9ô0uÈr"Œ#|}ä¤Ã"¯+†Ð’Ãi¨ÎW$|·a>QÀ……ê}|½½Bç‘Æ/íºw‚‚ÅKˆ‰Îš†wœB¨…&É}Ï^']®D^ÛRjç‹”«½aNYÅJÏ;½&½8	,2_cjjúú_NÙ½jøÁuøöZâ(6UÝZQ'Ù²ƒ¡*þ»,õ#åbúýæ„YåØiYâëÌïïkâñmÂS1~Úr¾Ñß?µO
=RB('2	B(B	*·Ld®'Oº%-Ñ{OÑ%ªûubŸéøŸøzŒHxµŸ,oµ`Éµº5Ì|'¸¾ypvt…-z ÄK³¤8|ÊÑ¢oIuÑH«kv3©fwî1`c‚|Yüˆˆ¶$u»È6¡:'íšd-Ÿ£úÁéØëÝoÌ¸Í£¹ÌU­iÑ¿ùÑ{ýMcÊ¿vú5Kðä'X³.Ó
èjGà;ñŒÎ$Oúúúšÿ³˜*Ö’Õf`ù•¸/ë­"»¹¹rŽìà8…oYYY*EYZ~YZ*VÌHÌVHJ›õ»J»>>VŸUd€öh(ÊU°|¦»~ß8¢Àü÷ôJÙPìÞ›§"X›¹“××‰*“¹T“’ž’TFq„„1v’„ÂÂÃ„5Â+ÿÄ‘|&^F^€/	~Ÿ	ŒŒF‰Û	SSŒFŒãDŸ’ãgHŒ©ÇgžV!©æqâîæïÊy<¼)¿5ÓÆÚ€ŽG»žn%YÞ€ÂIièËËéË«åj[”§=Êô/o”Ï¶Ê§qÊ§ÃÍÝ¶² ãîVá)Fñ:'ç€uâä,lj<jnMlœÿœœà/õA=¸”»;›¬ºƒî0ÞfñSŸ==ÿÞù¹Œ¬ŸœVVräŸx¶pvÃòÝ§[úH°Pî-·.Õ?±Ÿ„’#w‡F¡Ð;³UÍêµÛÈ˜Ù®I8†Uoå:€<÷mØùHN·Vù\^	FÒÏ·“Ì5p›Å›RFÇÔ·ïÏÕßjpÌÍ³çZ³o‘3<Ú«™64-ÏûÌmO²$oKNKpDE(O\*Š—6'Ø¹´¼†C(ûì>G¬åüêøÐN:&=f2ÁhÛ0%¹v•“÷Ðð÷´ÍUr53=Ü{uÕR|-œµJYðmêa¸þö¸„° Gc®-l·’ÉÊ" !÷mèË­Qá7É¢ŽèiLóéMÏUÙUUÛ®3­W·;ŒŠÄ#·¯ŸXkÖéýˆÆ[b]Üa"Ù•‘Å¢ÿÉúÖÕìÕ¤üÇü¡T¾L-Þ±,|T±++™¦¹™F|™F›åå#Šœþñ¨#,#²¡F7eF
HwTíkIIÔèSÛjYQý
°R>½]ÿÿý RR]]RÆËbsRû¢ËsûŸvsbÆvcH.sLN•½ÅWÙUpÙX?=z.4FŸTMÄpºonõ‡æ!Ç¹[«Ø7;Y$cÖÏdyuU um·ÃÃtsIÒèQsº0êºDAê³jk^ÂA¿„_9T¨¼$ß3§C©½Íuç§?æù5zIso>Î`n*woIã]YaÅx²3Ô¯Ìp{õÌ<<“ÍmL;Æ™îE&Z#XkF[p MXy—ÊË0Ç;ÇK¿¿Fúl¹æ]%zé>{–t;ˆjkmƒLuðÚz¶¤P)D4Üb<%D3Ž;ågkZÂA¼ÖUJe‚ÂÒÒBm‚w{‡x…{xo/{1þ§ê1×òAÚéÉ„=ÃGéŠAŸoé3TWfV7f÷Á}r¢ÔTŽI·ê6íFÙuñFW3çÏÓGMº¼>q¾qÏû·Õ¾¶³¶Ð$‘!}žþ³ûS#áù8DW$^žJˆÖXÅJxÆæç=L×*ÊøÈ±*ý‰°AÑ›@0¦¬ifV/›@áíçÉ©Á€â÷´œÎ#¸éy‰×ÊÍ¦A¯E¾~5Á6Û¸í¿_C¾ò¾WÇ6ê¦çíÂy‹[¶S”_@ÓT[.$gV—yd@WDõ5È°A|žÖñ	‚gÐeË“,¾óbOÐd×¢Ú×®õñú™¥÷÷4vÆbD%D%¤'%%ú%òzj%'ðò5No#-ÞÜÑŠ,ÍôçÉÄ,U1–!’\a¼C3å*ux0ý»•1•²Ù»¨NÙaA¨•\ˆA{ˆ‚ˆñ´ñ-“—@}Ûû=ì‡0æo>&§;5móE»ìBvÛèd¥î{Ã.kk%.»d.RÜ<O‚mRm%»8‚‚%ñ%AvpÊ»Â-RjáéAM…ËY•]/µÈÃó—(Ä™¶,™,‡ˆ¨ýï~u‡O;­áOOåO²î?”×ü¿nm
‚§ŒRž^˜¡·éæ âÂñéšÈf)ŽÍáì*¥a9 ®!yS5éÌ{s06YqòY!ä$Ú*#û}ò@£²8@XX£@ŒÈ@£ŸXÈw"§¸	t	¸	§€‹&	 ]½Jž¦Æh†Ø+Þ¤	"°×t‘:JA³JÓXA³XX_ßOÒ_OÒXßL°K,îîaaw†am,wCaÈPfwæ£_F›+"@á?®Ý8q²íìíííˆèU?¿ìŒÄm²Õ±ÕVÑŠºT,³NûÂ\U2LýñåÃÍìZÁwâ]­H™fû™œ²ÅÊÉÔÊÔ .ì#k€,ˆcöÊ‰E¸r+ …Zr…æI±­­–iø·ä[FË•uäöyÅ–;&2i¢üëS¥)Än:ôlG›A<+Nì-(@7öœU˜¸a:ZR!
"3÷äý–Ít£M^áª£6™àqzïwp¥(¦ºP!8]‡]°³ÿrºSxŽ› ÚŸ¯Å.¾r|Š}-‰ -ìŠ~rpY"˜T.úzÙD¢<jHgvûe¼kO3i°H&­Ð.©a tfRåÊkËvŒ·ß¨¶¤D\,”³¤ž¢áš1eMÏï¹ºª…*ßÃ6wø¡ ó7‹…í{)ˆËŸÃŠn¶~/‹õ/õû^Ê(õõÅ«]J@n+Ú`òˆpÛ ùf3ÈÚ–ƒãcˆ¡óå,,4ÈIß¸³{üNOèã+þjllÔRÔz¸=71ý0–ýµqÿ–³ëÞnµÊÖ–A×`Œ!›»'•:vçSË]]ýQ¹(öSh[\G\/Àï÷<k<óyœÅå“¹–Ï¹ß#ƒF|ºC•',â¢6'ÃÈ½méñpw„:Ý¾Ž¯†%ÖìêÛ”?P{j£j]`qÄCa‹ŽŽÄR9»þß=0ùÐ®æß!›Ç!‚2˜Júnh:"Ë´¡¤(*k6|¸¼ß´25NßNêÍæ2559´èÞêèèùâo˜˜®\øòïoÞÿaÝo`.®†OÐq',lK
lL·È?UèšªÆoaO–Â¢ÜÎx˜l†^BÎ^l…P¢™˜lÐ¦*õ¦——¶1ÅÁÁ€*~~ŽÅŽ\®k¥¥Ñæ\Ñ*9Ç*æ!üÑsÑv35Ç56vv6ÿÇ„÷;×å¶€2ÿaAç22Ä®sììì%ÈÈ¬sbw;bbÂ]Q†?Ø@Sg+ÿ_ÜV®šäº8ûÄkk8v¬2¬kGGv4¨¥Þc¨ÞƒgŸÎÉÅ§ðç¡¬²2ó+á7Ò#Õe-˜ô‘ŸHç§xàî»)µéßM8’’n£sN"TssJø"ù'qÁÖ4}ºQ{ªu¥bêÌæøêùïø‚ïb	ïÀ‡þéÍò/Ðés·±Ö{EÞv&-f¼RO¤i'î'ÕbÄ¡D
Çdz¼-zÕÉ’hÓÃm%­ *‡§]œÅê<Ø	¦9æJ“ŠZÓ¶YØ„Eñ|GÇÈ»®¡°†Š–Á•šz–*-øÞ\ÏšþØc]“>®°¹ŒÎZ;íMJ5â¶ÄâÔžªÓ èïš3V,±g\PëÅ94MºYÛ=3–†2†40¢Ëm¹„ 5±¦ËYv@ü“?‹ºÓØS!Sµ}ÂOÍ‹íÙÂ28þ+‡rûÃ"Œå¬ØÍy†rØ¨ð±˜æÉ´mç7'’´Œê»¾¦^Ø¦^IN’OL‘…€ÔKL…hÄ~ƒÕMÕ¿,|×**¿…±m6€Óµd0|½n25C¶tÂÂã2	~2o“Âb<e4f×d›AcˆJl¤T˜q®y1ó‚r1Pr}fvkÚ(btOØH|èvJœQ8±æ4;óJ¸"ûÖ,3®ûWHŒÞ©&¸",CŒNÜÜwæìlNwG® Vf`ó»#gJO¤@­©]LI›B-©æƒ˜Ž†ûHˆø¯kÖÃÉôÃˆœkªQ1]89^æ(ô³\Î_réSåý(Y‘«¡6¯‹i£ú}i¶£ªÉ=CèØNä³ËÄG$ŠÅóÚºSÚSllÅX«ž‡ˆÆçz¹ÌéµQ©²ŸX"t)8D|&»+ºçµó¢„]`­@ÁÈëY8´$"mÔ8Ôóš•óxmƒ"¿Xéìás`ªˆ–ø‚ß‹
S_P_o‰ÉÎJ
1êdbfHHùùO	:HÚ2ÚXküÌ¸i4Ññ‚ìèâ…»´”¾HÅ/“–uW–Ç°¼é{_Ë__Çªª\3Û€æu4š±vÂ¦U§Aã­),É¬´ë«#ˆ’¯¬¸´ëä/ä~t|DÙ®r•cÝ‰Áêá3Œƒ¢(~‡€ªçY¿a~_h÷K÷ÂVV•gÔÅÌk†ŸŠ!JV—l,b¢cóLrYÈˆ§ÂIÉco…dë™º[  t«×|z||©ÀÀÈö¡é§	ážé:`€¬ïÐˆ1Þï©©<uï»—=)ùÈ¾ë>ó­ÙÒ÷——¹ZÎÔÝº°è2nMÿMÈa¥Ô¤Xdÿ`|ê‹ü‡(—e+“ß ·$iÿ×’oJzé´Iæå£gï(ÅT6ó'»T>,»æ=Œ¨X‹ÆÖÉ9¨Å¦íÔ¦+dÇ>ûR@‘…+ïÆdÐYiYssm	¹³		Ø]!üwÉ:‘nyÎ`žUšë±kŸŽáŠ´s`„ät#¬$Îø#…]o]MD,XM·Á8â;œqÑRe3ÅÙ0Å¦[<º¤)§¤º·¤½°¨Ú’Ù.õ¡Î;Õ)w¡®<A(¢ç
aåh­¦aHP²ODCùq‹Ô“]£ŒV:œ¬±ë`‡ô‡å8`nùõ.×f‰nËÅ{gl3œ»w»Lû.ÙØÙÒ4‹»Ù2;Ù¡­]‡_Î¬ptâYï3º¶ˆ\eª)JÓ6HJHœ›“ËÎðöÝŸ§]ö ¿
¤G"ÛÄlÂóó[øø+øñª1u[?uœÅì‡D‰æh›¿ÀòÞð–Šñi§;Û¿CÛ¿§ù¯ùE«TßÇJ\>ÅxlÍh|ÓþmÇ|yxmIjÒ–Õ¨%ƒ‘6†C6¨ºšÓÙC Cùüa»!á¡J…bªˆmóÏ—`{DWéõh-¥twÍßˆ_Ú­Õ"¹ðUúqúÕšcÎqcq¼ Ãnj«Ä0›;<>6”›F³+'PáÔÓ‚Û„’ô{¶\þ¾þðð%¾´äÑþäÚâÑ¤â<ñÚâ(¤vv(võ77²U(>¦	gÛÛ1Ë`6fÎ€)9N kŽ³G¸Gt¿|@—â-44@€íÓ@@TH`d’ŸFLvLævF“Ïkv©µµs©Ö)5J‹"˜mÝˆúÈ‘µ#¦¸¯[Q£ì×9ûý=k$-¶&$ÁñkèÁùŽ<þsíž`•Ã­uH¸_:aëë»ýÓäbýÝDæëŠˆ ¥op“ëos—§õnA%ynD†>
AEãf½znJ$îé‡â³Ž•”äâo=Z£<íá¨Ñj¬j¹ŸÎâå¹Ÿ	¹ºö€ÇªIðÒ"Nï¬õ‡ß,¢iþ~´––ß´¸ÌÝÎ–É´øÀ÷0Wh­çY)I&š—¶e%šØ«u[{S
trú	ê\À©	@¸ÄÄ@š†÷æèèÔ‡SGMMþGGæI¹Œ9’IiÍÈLo›lOGK¹©Ûdœú{C›„†5{ü/ÝÚ’÷‚]’ü÷Ô›vü÷èêGlÌÅJ~uüvÖ*ç'¸¯é(ú'àúâË(ÈØ&V&&Èÿž´|£ ¢™ž8wØ1Ff¹òà÷%à]¤»ÙÅe'^ui@þßÿL%Ú%ß§U³UTÇzÎ0Ã•³ÃÇ•yyWWñ¯jeœídÛnU@~¥õºnw’]U‡!dÂûj
Öy7ÈŸ$Õãöð°ä_üðÃ`Øä`ˆ†`ˆ4ÇzwÃ7%z&&ÑôÐÂž½Ïâ©ie¢¥¬Y•O°Ü»‚ƒ2Œÿÿ5Së”–Ž 0ûëfÂ+Ïd1>òÂ+´VVïTxÊ5£+è-Ü'™'Ü-R¼£ÿÝF¬y~«[M¼-]5|û‡æÞ_—¶ÓªJ½ýIG!0ZîLâaÐ
25BhÔÔÄwLóRÄLÄq±`RD¾­œÄ.­×­Ò1F=-¡Et1Ò4ï¡˜¡¡4¬ïŸÅ{ïÓ\P-u÷Î…Åë¢F¨•IÏhb9Ý}K8­=“­mC_CéÔmŒé„à³±³Üß±	9¯TùZç¯¯ëëÊÊ33kœ—33_åå®ÆëÙäï|œ±²+O¨_ÈÐà(ó+Á<n‰¥|Ù¥Z<¤ššd‘ãÔ€ôóx  ßw#?1ð35³Œ*UVëQw²GvB‡ÐìÚí9e¹_ûÐ-í#?ÙxÄ×—mæ«MzÖîBœ•ˆºþ¬'§!úK«ððð½´@‡0ã°†.¼B‘Ô‹$ã ã¬Z8êçÙ]»ñ…ŒÔË(Â"ŸkÊŽ™üŒÖG—»‘Géê&‘ÖÌ`Œ‘gÃfÂ9Ýc÷ eµ(ýRú0y“lë•¶A‚êÇ÷BFKösŸ69¬[5Òøø‡‘ýŠÕ‚ýä€Èu×÷žóX®‡sº‰Ó–üñäýáêÁ`O¥éeìf\jýý¯+£NomÔßEæFmF@æ‘L]Ôa~Ù"*¦	È@a•ûû¶Û¤ÛûÈN—7—qÅ`‰.‰FáEOîÌÔSE	ÆÛ\¸o>c|/ÑbÆçDÍpÉÅÍú¹©€Á|ÝA©¹|Ò9t€ãÑÃ„¢«‚>B1ŒÅB&È1™9ê$)€së˜ÚÙ.gŽT˜`Š&•	•W@”•Œw0­†­ïï­ï7Gnvvn?Ë½½ºmQ'0èo>Ì>>m‚Võ1µ!‚zÐz('‚´8¿/³ (q11®11qÃ"ë ”€Â…J!1Ç§7Ô17§44¶„•2¶O¼„€O•@ÑÑ€iÐAÁÅ5Ñ5*1E{y>È!bÞØm³WÊºß
·ûÐ}ƒ2[zƒ/4õ4Î-PÓƒ<'õ-40„Â0„Ó„4s4Ú§ˆEc¤¦£·6^¦s­ŒF¶’“}¾‚Ó)ÄWÄ98Q}PØcG…Ø‚‹:w2+©°±?Ô?ß±-:ß¼t,4Ñ¼?,G?ò¼ÑÅ"¼//¦M›“î-é/ää-ããèå¥cnŽèScSÉwc9FwÞ2ÞÊ%¢g%")~yÞTÐÞÐuÒl±B""x ˜–˜ M–x­­X–AÝèœ¬÷áUòäƒ¸×í€	Ž`ÄâEÏaâ_®œh]ó×jÉë74ÃÂÂ2ÃÒ?4wÏ³w<ÒðÒÄîîmÍí£h:£ ÍPÖ¡V)"IZU«š‰ÒôtÛ¥Mƒ‹M‹ƒ4³484w0³ü¥0 c Yº@P®w¦ “¾-E´]„ûµì­ÖGJŸMý—Ô
,F“	øú3½rÒ½½Ò¶®5–ÙÀ¶G}~}ˆGRñµ«ßƒHN÷%¦ÖÕ)Å·y—H·Î’pµÎµÌÎÌ¦Åp7¦Ï¦GÓ/7@G‡œÁñEñQñÉnÖß7œÑDBùsnß_Æx¹´a4“ÎÁ½ˆƒ}~°]¦7SZgÝì^X6æM¶ó‚Tnnºš…`–>ìáÏ…Bœž“a¸(‚ncÄ¤ ÊË-ÿÔÖeiÀåƒXe†¨Zžº&–Ê¿Z§fRÇ¸
)b/!ehhnþ
|fe’=~~Ðð¿ç˜8ø§Ð¦P“:±œþ
c«ö
¶•=Ëõ_ˆø×=a¼ÿø9OVÙùã=·ñÙT¶ýÝâùý×1à‚ð!€Ä3ìJØÛmÅj¸°:N‹pÔ/§qÿ;p
q­a>‡K/1Ç¤­!>TîŠEíã*,{)è6dâ¯ô>);Q*%¶¸¢`ðæ`t|Ò
Û¯b&H¶Þ0!rÿÀ&yÀR2Š•92ÇmËm2‰ŸzÒp{ùvéÓ7~sù(·ôÙŠÙ­\Ñ††¬ñà†-ù[§Ê¼yjQò£ñd57ÿOuì›_ðBmÑµ ³…U(éËo}Ó9Š³1›|Õ„~¤@ÅÀ‰XÿŽF„Jî%\ÍX˜8é@‹õä9´#gÑ@qÚÑ/!N‡:#Õû×ŸÓìðä;£	n¿‹(6Îæ…BaŸq®®»_ÐSÄ±:3S_ƒ=µ:½©>+u¤½—èiì?ì­­É«uÜã¤X·NãH½f·sN¦	K]’•É¶“Â–uÜÀŒ ;5 AÉæ5GŠÇ¤gÊø%sgëˆ$Lªb{BìBÎº7¦=x¡-#;DROxž½ÜÊô(º½¢Z»ÈI¦Nè,vU‰ñÌn¦_‘˜XO[6ë5ÑB¢Ë¦ š‘ßð‚¦’q¸qÕ‚’d¾ò9QQòõ„»’³V½ÏTÜŽ>¶@]™Yõ­OOÚÛŸ»ºèéÒ
lRÅàùw°-èSrx§ïb»¸·ÝÖÄÖm ·ƒ‘939+ÆFô¶5+yÝç\Y‚:_‚yÞìË´bƒ¾BÊæ€gZuMâ!ºG^>úO„•O4üOàMBG!²B×lÙ·Sq}w—chÍ¡¨Œ¶¥Ú-pq#týR³í>x¿ˆÿ0™BÖÏlåfºHSbõ†dÖYú¯ˆ¼Óµý#‘JA@£@ màÍo}ùgIWahÆ$y™ëÅ4ª&-¹ˆÈÉ¬Aþ­Ü_¦´ïè3Âœ7ïll;‚^~}ÜèÅ_çBì5“$ƒ’5µ>Lk"ÙvÚ–ÇÌbWX	™{¾°òj¦uÂ´­¢ð!EõHx‚¦‚œÑÃíK¢Íb±­ÙóObî7Î™{ªì¬%{•µÙï´¤ÏÊ‰ž«Ï‚Õ– oÔÞÚ˜æuÄ¨ož‚•’”ÚÓ<ÓrÐ…oreÆÌâcrË»OáÖ
¥í
Ûkïmm1¿Æ17|ÃtüxÉùXUZ÷¾=ßþ¸­°õÑá‘â¨¡3)ª/”.A(ZÑzÏ±µK-Û\Ê±Ì¾ëÆ©éÖÆ²ëxßìà©Óñ|ÑFÒJ÷¸Gýám(GÓtÅP÷¸gsUÔˆïˆAåÏmqU©=!bÜ³´Ê\\q\fÚhc˜kÿ¢Èý{Î  ê­³ÑjîQ””§œŸiO‡Ù¤Vž­vAO=ª)ª¶­KµŸ0È9CLhEÕPQäÑ¥1Î|VÑâ¹‰i…/“OAAxrE#Ž2]G—ì)˜”YÈüD(Ci>mëVåEÂ8Þe½Z‹Jç|ò|T 0EZ3WWpì­{h2…WY"9½ëŒÂ«7FWcT1J9ô¢ÄU–´ÎÞùß—E"9?"pëlf@ê"dR|IÒÐY¸Géoë[XŸçh^â¼¢ù®ê£¦¥:'Ié¥XSÎi›\nH¬3ÝcHˆmmÌßfJˆy€¾ˆˆæ€†€MØAØn\-ÿàh»³ª9Oh0œu/6:•Îƒ2l(£Þ:HäX€EXXççKOüüŸWZØüWKúŸs9£9WVL3’4\<(ÛçCËû¸«¥ðl)$‡=Ê#ËH>u½ÃZ—p¹¼pGÑ¼It<~GÑ€GIUN×NžI 2äå•$T²‚»>R_±ìì_±½ñày»ý8©óeeßàQ©HTF!ã4l»íXûûXXŠËŠCX« .Šó{«ó.V%óVQV·¾¬w`¢èÌvVÝéATX-î8O¼–´ÐÛÔã=U9êñëj~™ÝÞ™\¼e/ óù÷ªí
G×Yå«©SaˆÅþqÅã¤êÁgòxM	@=ÕÒ²b)óGK¥ð"ÅK£_mPµˆæÞ¬'ŸXƒµq*²u¬Ñ‘«m÷GkÀ«û;´k¨J<,¤2J”
tÏ4ÒÕá«¦…Ï±?ç/1?ÑŽ3Ël¤§ÐÁÌÅiæŸþ«&–9Â"à9(:U2ÝÏGÝHT‡•Ê“1RA´vÃç Ë43\&?:¯*†’Mw2	5u`pÈxÈ#ÇÈÎ½®ÎžóU×Ù}~ìv|~µ¯VSmòtCÿèhË‘ýoË‘‘ò€¸ØÆÕ Éº¸¯Ô"Í³ãî˜˜Œïä†ú…5å'Ã“‹![ˆ–‹x‡œ‹x‰‡rxÔÇ>ÇÔp>Y>KVp>ò>ònx&°•ìÕ<=Ôºx…Ô¯ò}{óðFðZt:wpÄ:ÕÇÌÆ²ÆwåÌœÕÇð=¿Iðg%•	%	O—bçŸÎ Ö\Ï“Ü£ÞÜKtù:Ç|’t¥WênbhöÖ÷ò_ÃWþV?¾X÷”‰;éZñ>¹~MzYsÊì0®Û)c=;ˆ9Å©x„ü’bÀ…Ñú P‰²+™³7>¦±,Q«©´gPü—VÄ³Dû»QàÐg|Áù°¸Ó— !>N:: u l|Éà§LAøÅ|¢êp%â?â Ó=êÝ¼#Â8vwþh‰…¸Ñ‰ŒÅÉ¶f4ŒÉw×Ä#pÓcßyŽŠÂ4À¦,Xñ[lí"Ÿ¥oÀr¡K.0ÿ˜/ÙBpU°-\2YA-3Õ†yÄø$ Ä6×y™{úÑÉÏKšYê×`Æ¨d†%¡îão}zlqºI2´¯yˆðLL{†ÒÓ$ür1`LC]=;;ð4¤žàŒ¡™YÕH_gŸ_F^O"ü*%)òl$ -)nPX*P`WCNÖÊ¾rµïÌÂÞÏSU`¡#fq€c\[‹§›ï¦›þ–7…%ÚKƒ_Ö<`õ“\võ{×úJÑÔJ˜@jÌvšý’y$º×«8•jÆ§p3¥ïb8^Q-Wq‡?27÷ÒR[Ü)s€û»Ìy’àª’àPè^êoPÁþxÅéop#¯†¸“uÒ,«¡‰Îµ»°²Æ€||ÁÁÏ®qJî¥ïZUT?¥–{³èKÎ¾ã«ãŽ^‚ŠFrãºº„P	.ÚèßäçöNà]¨ýQ:VÏxdÍ~‹‹ÚR`jEý’­³
¨§k`Ùn0/ûsk»	Av]\ÕŠj€Š´åå÷ë´)ŠŠl}`³¢©TËOrØÉ=½P¢^K€ÓïØ¨Ž	Í##Gå‰#.yMNaåßåN/+—À^Ç¼"H%è&ÊnQDQkP¨ÿäòìê$=n7âB¤Hkì}Ó2®b
¸¦	ô	Å˜ÒŽßO¥ÓÄ‡ˆ:”•?|Ö³O}e+G	l&™`³Û¹]ÏŽ?—>‹+ãê^uv[?\YoVM×EšHQ0üg+ w‘)/ZQr	Æ+¦€+¹§½Ò¡·Ä¢³_L[*|NMÞwÐU×Š?v­Um1èKöbäví…L€ÍÜ«¶
Û+-ÐOK³ö/O“Íò¾¶Ùzn°
¡ü[µ[Ç.5 …’¿Ž;Ù¨@Åút¬ªD°¦]ùÇ¤üÛŽ‘¹2ó——·5%ô½úÔ1¸(q=DôNïTÕ@ÛÔÍ3ÄÕƒó¶þŒ/h«©Œœ–“h±SáSYŽœÐˆ#ýÙÞä=®¼Æº6$)uê~>s=CJŒpoíûÈàäEÊ’ÎæG˜æ½­ÎèÊ½¿wF¿èF±­*Ü±ÜîÜÜÉ±ÜÖLC¢G¥ëñŸ†$–Íá"‡ðÝ™»¹‚™S¹»L¹T^nn¨¨(úL©Ÿ(×~à£H©(¦£
p¦
p˜>pn¿´»¸W³„©L¼œ ¯Þ]gg¯¼™;ï«/y³iðÙ£¾‹BUªÅ&al^É–ÿ77å7E	;½ºYv°5u-VÙÆ¤ÛwÕ¤¬2•¸ûWå[M
Ü?Zž=ññSÜÞ‘”ÇeÔ”Q_‚eæ
‚²õïõª€ÛxCÛm’j)/|8‡“y‡>(ÙÜÕ‡S“¾ÄôGVÒhì¤£,;£½å¾ƒág g8×õmJüYï<Ÿ]XJ~Ž4!gµ~°uíüìˆlÓÅ­ï]‚ìeðÀle<…„ì'ìUßÏ²EòÖ+eÿl2gä¼º¨´öÉüRRg¦1cŒ¦.ZçÎ[¯(r«áW”„zDDRsMR½añØ}âKÉãKÖ~u¬ÖbÒ Ór•ûIauô¼ò¤ÕÜ*·Ø¤zdòçdE’
øázrKïƒ¦ðW6TÖ#Z«<r_N 
¼X…_Ñà‹®Æ~“à‘Š®eÉÃš6œLœ\I4¯ÏípŠ‘šY“Ø·_ÚÚ¤ÚþV>6-?ÛxKþ)ã­V¯2
f0h²^š$5"ÕPµ†¾šäµŠöŠXíó¾ê˜E÷“¨SÃÊÍŸç/‡‡ÀéSnô`éë2ÍÀÙÈZMHS0Ycâxm—í`)Üö83îYÄþ@¬î9Þêšv5eñ:›¤Ml‹C@ðòµ^ÔÚððÏ±/"ªðÚŠÈœì˜	“ªˆîh¾lƒ#îñå÷¡@Í)FÄ@ÐÄ°G£TZªC7Û¦…£k}´ðq¿ºÕ|Õ"_}ÿc»
8l[ù¬;y-ÌÍ¾OŒW'X#¯ÐX»8UüÞX’ÓHÈf+E<,Ážev%;æÃ¹ƒ¥)_ Ùä¦¦êIüºÊAVk4Ÿ5h»¨ÝAØlÎTôßõº¤3Ëèí	™\£Œ9øÐ53©I.Ÿ>îV:(FD;)÷ÄIÛyM/˜£™2]š+Q1ã££½ÏÏØÀ]u\‡«Í2/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gat_atg.p

Description:
    
    To solve the fldpos-problem we delete all triggers and recreate
    them new. Thios gets done by prodict/ism/_ism_trg.p.
    There are some places in the GUI-Dict, where we need to do this
    for all tables of an _Db. That's what this routine does.
    
Input-Parameters:
    p_db-pname      physical db-name
    
Author: Tom Hutegger

History:
    hutegger    94/08/18    creation
    McMann      01/17/03  Add NO-LOCK statement to _Db find in support of on-line schema add
    
--------------------------------------------------------------------*/        
/*h-*/

define INPUT parameter p_db-name   as   CHARACTER.

find first _Db where _Db._Db-name = p_db-name NO-LOCK no-error.

if available _Db
 then for each _File of _Db WHERE (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN"):

  RUN prodict/gate/_gat_trg.p (RECID(_File)).
  
  end.
  
/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

file: prodict/gate/_gat_cmp.p

Description:
    compares PROGRESS objects with the foreign objects, according
    to the available info per DataServer, cretaes a report 
    (-> gate-work.gate-edit), and calls guigget again to let the user
    choose, which objects he wants to re-create or delete
    
    <DS>_get.p gets a list of all pullable objects from the foreign DB
    <DS>_pul.p pulled over the definition from the foreign side
    gat_cmp.p  compared the existing definitions with the pulled info
    gat_cro.p  replaces the existing definitions with the pulled info
               or creates the new object if it didn't already exist

    Create <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Update <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Verify <DS> Schema: <DS>_get.p <DS>_pul.p gat_cmp.p gat_cro.p

    General Idea:
    1. Step: for each foreign object compare it with PROGRESS image
    2. Step: for each object in the PROGRESS-image check for existance
        on the foreign side

    format of created report:
      +---------------------------------------------------------+
      |  Object: <name>          <foreign-specification>        |
      |                                                         |
      |      [ *** ShemaHolder Update recommendet *** ]         |
      |                                                         |
      |  Mismatches:                                            |
      |      {T|S|F|I|IF|T} <name>: <attribute>: <message>      |
      |              SH: <value>     NS: <value>                |
      |  Informations:                                          |
      |      {T|S|F|I|IF|T} <name>: <attribute>: <message>      |
      |              SH: <value>     NS: <value>                |
      +---------------------------------------------------------+
    (foreign-specification:=
        ORACLE  : <user>.<name>{@<link>}
        SYB,ODBC: {<qualifier>.}<user>.<name>
    )

Input:
    &DS_DEBUG   DEBUG to protocol the creation
                ""    to turn off protocol
    gate-work   contains names of all objects to be created/updated
    s_ttb_tbl   Table information from foreign schema
    s_ttb_fld   Field information from foreign schema
    s_ttb_idx   Index information from foreign schema
    s_ttb_idf   Index-Field information from foreign schema

Output:
    gate-work   contains names of all objects to be created/updated
                gate-edit contains report of verify
                gate-flag = YES, if differences found
                gate-flag = NO,  if object doesn't exist anymore
                    on foreign side, or definitions don't differ

Unchanged:
    &DS_DEBUG   DEBUG to protocol the creation
                ""    to turn off protocol
    s_ttb_tbl   Table information from foreign schema
    s_ttb_fld   Field information from foreign schema
    s_ttb_idx   Index information from foreign schema
    s_ttb_idf   Index-Field information from foreign schema

History:
    hutegger    03/95   creation
    D. McMann   04/06/00 Added Unicode datatypes for MSS and a check
                         for Procedures for ODBC so they don't show
                         up as orphan files.
    D. McMann   06/04/02 Added output to file logic
    D. McMann   08/08/02 Eliminated any sequences whose name begins "$" - Peer Direct
    fernando    10/13/06 Use UPPER in the query when comparing owner and foreign name
                         for MSS and ODBC
    fernando    06/11/07 Unicode support for ORACLE
    fernando    04/08/08 Datetime support for ORACLE
    knavneet    08/14/08 OE00170417
    rkumar      12/10/08 OE00178256- iSeries Access ODBC driver
--------------------------------------------------------------------*/

&SCOPED-DEFINE xxDS_DEBUG                   DEBUG
&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

define variable l_canned         as logical   no-undo.
define variable l_crt-msg        as character no-undo. /* critcl diffs */
define variable l_dict-msg       as character no-undo.
define variable l_int-msg        as character no-undo. /* internl diffs */
define variable l_int-msg-txt    as character no-undo. /* title-txt     */
define variable l_min-msg        as character no-undo. /* internl diffs */
define variable l_min-msg-txt    as character no-undo. /* title-txt    */
define variable l_no-diff        as character no-undo initial
          "     No differences were detected.".
define variable l_no-diff1       as character no-undo initial
          "     All objects in {&PRO_DISPLAY_NAME} image exist also on the &1 side.".
define variable l_ret-msg-txt    as character no-undo. /* title-txt    */
DEFINE VARIABLE l_ret-msg        AS CHARACTER NO-UNDO. /* retainables  */
DEFINE VARIABLE l_ret2-msg       AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_reti-msg       AS CHARACTER NO-UNDO.
define variable l_sev-msg-txt    as character no-undo. /* title-txt    */
define variable l_sev-msg        as character no-undo. /* severe diffs */
define variable l_shupd-msg      as character no-undo.
DEFINE VARIABLE dif-found        AS LOGICAL INITIAL FALSE NO-UNDO.

define variable l_seq-msg        as integer   no-undo extent  4 initial
    [ 2,1,1,10 ].
define variable l_tbl-msg        as integer   no-undo extent 12 initial
    [ 3,1,1,1,1,1,1,1,1,1,1,11 ].
define variable l_fld-msg        as integer   no-undo extent 25 initial
    [ 4,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,12,15 ].
define variable l_idx-msg        as integer   no-undo extent 12 initial
    [ 5,1,1,1,1,1,6,7,8,13,14,16 ].
define variable l_idf-msg        as integer   no-undo extent  5 initial
    [ 9,1,1,1,17 ].
define variable l_msg            as character no-undo extent 20 initial
    [
/*        ....,....1....,....2....,....3....,....4....,....5....,....6 */
/*  1 */ "",  /* intentional empty! no additional message needed */
/*  2 */ "This Sequence doesn't exist in the {&PRO_DISPLAY_NAME} image.",
/*  3 */ "This Object doesn't exist in the {&PRO_DISPLAY_NAME} image.",
/*  4 */ "This Field doesn't exist in the {&PRO_DISPLAY_NAME} image.",
/*  5 */ "This Index doesn't exist in the {&PRO_DISPLAY_NAME} image.",
/*  6 */ "There is an index, that would fit better as ROWID index.",
/*  7 */ "(Flags: ""a"": optimal  ""u"": user-selectable """" not usable)",
/*  8 */ "The Primary Index doesn't exist anymore on the &1 side.",
/*  9 */ "This Index-Field doesn't exist in the {&PRO_DISPLAY_NAME} image.",
/* 10 */ "The definition of this Sequence didn't get compared with the &1 DB.",
/* 11 */ "The definition of this Table didn't get compared with the &1 DB.",
/* 12 */ "This Field doesn't exist in the &1 DB anymore.",
/* 13 */ "This Index doesn't exist in the &1 DB anymore.",
/* 14 */ "This Index exists in the {&PRO_DISPLAY_NAME} image, but not in the &1 DB.",
/* 15 */ "There's no {&PRO_DISPLAY_NAME}-Field for the TIME portion of the ORACLE DATE-field.",
/* 16 */ "This index exists only on the {&PRO_DISPLAY_NAME} side.",
/* 17 */ "This field is missing as component of this index.",
/* 18 */ " &1 .",
/* 19 */ " &1 .",
/* 20 */ " &1 ."
/*        ....,....1....,....2....,....3....,....4....,....5....,....6 */
    ]. /* &1 gest substituted with the external name of the DB-type */


define variable batch_mode	 as logical.
define variable edbtyp           as character no-undo. /*db-type ext frmt*/
define variable l_char-types     as character no-undo.
define variable l_chda-types     as character no-undo.
define variable l_date-types     as character no-undo.
define variable l_dcml-types     as character no-undo.
define variable l_deil-types     as character no-undo.
define variable l_dein-types     as character no-undo.
define variable l_header1        as character format "x(78)".
define variable l_header2        as character format "x(78)".
define variable l_intg-types     as character no-undo.
define variable l_logi-types     as character no-undo.
define variable msg              as character no-undo   EXTENT 6.
define variable odbtyp           as character no-undo. /* ODBC db-types */
DEFINE VARIABLE is_as400         AS LOGICAL   NO-UNDO.

define buffer   gate-work1       for gate-work.
define buffer   s_ttb_idx1       for s_ttb_idx.

DEFINE STREAM comp_e.
DEFINE VARIABLE dbcomp_e AS CHARACTER NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/

FORM
                                                    SKIP(1)
  msg[1]   FORMAT "x(29)" LABEL "Table"  colon 8 
    "->"
    msg[2] FORMAT "x(25)" LABEL "Table"             SKIP(1)

  WITH FRAME ds_make ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
  TITLE " Comparing " + edbtyp + " Definition " USE-TEXT 
    VIEW-AS DIALOG-BOX THREE-D.

/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/
      
/*---------------------  Internal Procedures  ----------------------*/

procedure error_handling:

  define INPUT PARAMETER error-nr         as INTEGER.
  define INPUT PARAMETER param1           as CHARACTER.
  define INPUT PARAMETER param2           as CHARACTER.

  if param1 = ? then assign param1 = "".
  if param2 = ? then assign param2 = "".
    
  if s_1st-error = false
   then do:
    assign s_1st-error = true.
    output stream s_stm_errors to ds_upd.e.
    output stream s_stm_errors close.
    end.
  output stream s_stm_errors to ds_upd.e append.
  PUT stream s_stm_errors unformatted
            SUBSTITUTE(l_msg[error-nr],param1,param2)  skip.
  output stream s_stm_errors close.
 
  end PROCEDURE.  /* error_handling */

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/


RUN adecomm/_setcurs.p ("WAIT").

/**/&IF "{&DS_DEBUG}" = "DEBUG"
/**/ &THEN
/**/
/**/ message "gate/_gat_cmp.p." view-as alert-box.
/**/
/**/ run error_handling(18, "*****----- gat_cmp.p!!! -----*****" ,"").
/**/
/**/  if s_1st-error = false
/**/   then do:
/**/    assign s_1st-error = true.
/**/    output stream s_stm_errors to ds_upd.e.
/**/    output stream s_stm_errors close.
/**/    end.
/**/  output stream s_stm_errors to ds_upd.e append.
/**/  for each gate-work no-lock: 
/**/    display stream s_stm_errors
/**/      gate-work.gate-name gate-work.gate-flag
/**/      RECID(gate-work) gate-work.ttb-recid
/**/      with width 140. 
/**/    end.
/**/  for each s_ttb_seq: 
/**/    display stream s_stm_errors
/**/      s_ttb_seq.pro_name s_ttb_seq.ds_name
/**/      RECID(s_ttb_seq) s_ttb_seq.ds_spcl s_ttb_seq.pro_recid
/**/      with width 140. 
/**/    end.
/**/  for each DICTDB._Sequence
/**/    where DICTDB._Sequence._Db-Recid    = drec_db
          AND NOT DICTDB._Sequence._Seq-name BEGINS "$":
/**/    display stream s_stm_errors
/**/      DICTDB._Sequence._Seq-Name 
/**/      DICTDB._Sequence._Seq-misc[8] format "x(20)".
/**/    end.
/**/  for each s_ttb_tbl: 
/**/    display stream s_stm_errors
/**/      s_ttb_tbl.pro_name  s_ttb_tbl.ds_name
/**/      s_ttb_tbl.pro_recid s_ttb_tbl.ds_type
/**/      RECID(s_ttb_tbl) s_ttb_tbl.ds_spcl
/**/      with width 140. 
/**/    end.
/**/  for each s_ttb_fld: 
/**/    display stream s_stm_errors
/**/      s_ttb_fld.pro_name s_ttb_fld.ds_name
/**/      s_ttb_fld.pro_type s_ttb_fld.ds_type
/**/      s_ttb_fld.pro_frmt s_ttb_fld.ds_shdn
/**/      s_ttb_fld.ttb_tbl
/**/      with width 140. 
/**/    end.
/**/  for each s_ttb_idx: display stream s_stm_errors s_ttb_idx with width 140. end.
/**/  for each s_ttb_idf: display stream s_stm_errors s_ttb_idf with width 140. end.
/**/  output stream s_stm_errors close.
/**/
/**/  &ENDIF

assign
  batch_mode    = SESSION:BATCH-MODE
  dbcomp_e      = LDBNAME("DICTDBG") + ".vfy"
  edbtyp        = {adecomm/ds_type.i
                     &direction = "itoe"
                     &from-type = "user_dbtype"
                  }
  odbtyp        = {adecomm/ds_type.i
                     &direction = "ODBC"
                     &from-type = "odbtyp"
                  }
  l_dict-msg    = "          *** Use Dictionary to delete Tables from {&PRO_DISPLAY_NAME} image. ***" 
                + chr(10) + chr(10) + "Orphan-Tables:" + chr(10)
  l_msg[8]      = SUBSTITUTE(l_msg[8],edbtyp)
  l_msg[10]     = SUBSTITUTE(l_msg[10],edbtyp)
  l_msg[11]     = SUBSTITUTE(l_msg[11],edbtyp)
  l_msg[12]     = SUBSTITUTE(l_msg[12],edbtyp)
  l_msg[13]     = SUBSTITUTE(l_msg[13],edbtyp)
  l_msg[14]     = SUBSTITUTE(l_msg[14],edbtyp)
  l_msg[18]     = SUBSTITUTE(l_msg[18],edbtyp)
  l_msg[19]     = SUBSTITUTE(l_msg[19],edbtyp)
  l_msg[20]     = SUBSTITUTE(l_msg[20],edbtyp)
  l_no-diff1    = SUBSTITUTE(l_no-diff1,edbtyp)
  l_shupd-msg   = "          *** Schema-holder update recommended. ***" 
                + chr(10)
  l_int-msg-txt = chr(10)
                + "Differences in internally needed information were detected."
                + chr(10)
  l_min-msg-txt = chr(10)
                + "Minor differences were detected."
                + chr(10)
  l_ret-msg-txt = chr(10)
                + "Differences in retainable information were detected."
                + chr(10)
                + "These values can be modified by the Dictionary."
                + chr(10)
                + "The schema-holder update utility does not change them."
                + chr(10)
                + "Please use the Data Dictionary if you want to adjust them."
                + chr(10)
  l_sev-msg-txt = chr(10)
                + "Severe differences were detected."
                + chr(10).

IF NOT batch_mode then assign SESSION:IMMEDIATE-DISPLAY = yes.

if can-do(odbtyp,user_dbtype)
 then assign
    l_char-types = "LONGVARBINARY,LONGVARCHAR,CHAR,VARCHAR,BINARY,VARBINARY,TIME,NCHAR,NVARCHAR,NTEXT,TEXT,UNIQUEID"
    l_chda-types = "TIMESTAMP"
    l_date-types = "DATE"
    l_dcml-types = ""
    l_dein-types = "DECIMAL,NUMERIC,DOUBLE,FLOAT,REAL,BIGINT"
    l_deil-types = "INTEGER,SMALLINT,TINYINT"
    l_intg-types = ""
    l_logi-types = "BIT".
else if user_dbtype = "ORACLE"
   then assign
    l_char-types = "CHAR,VARCHAR,VARCHAR2,ROWID,LONG,RAW,LONGRAW,NCHAR,NVARCHAR2"
    l_chda-types = "TIMESTAMP,TIMESTAMP_LOCAL,TIMESTAMP_TZ"
    l_date-types = "DATE"
    l_dcml-types = "FLOAT"
    l_dein-types = ""
    l_deil-types = "NUMBER"
    l_intg-types = "TIME"
    l_logi-types = "LOGICAL".
 else assign
    l_char-types = "CHAR,BINARY,IMAGE,SYSNAME,TEXT,TIMESTAMP,VARCHAR,VARBINARY"
    l_chda-types = ""
    l_date-types = "DATETIME,DATETIMEN,DATETIME4"
    l_dcml-types = "MONEY,MONEYN,MONEY4,REAL,FLOAT,FLOATN"
    l_dein-types = ""
    l_deil-types = ""
    l_intg-types = "INT,INTN,SMALLINT,TIME,TIME4,TINYINT"
    l_logi-types = "BIT".


/*------------------------------------------------------------------*/        
/*-------------------- 1.Step: <DS> -> PROGRESS --------------------*/
/*------------------------------------------------------------------*/        

if SESSION:BATCH-MODE and logfile_open
 then put unformatted  "Verifying objects" skip(1).

/*---------------------------- Sequences ---------------------------*/  

for each gate-work where gate-work.gate-slct = TRUE
                     and gate-work.gate-type = "SEQUENCE":

  assign l_min-msg           = ""
         l_int-msg           = ""
         l_ret-msg           = ""
         l_sev-msg           = ""
         gate-work.gate-flag = FALSE.
    
  find first s_ttb_seq where RECID(s_ttb_seq) = gate-work.ttb-recid no-error.
  if not available s_ttb_seq then do:
    if SESSION:BATCH-MODE and logfile_open then 
        PUT UNFORMATTED "SEQUENCE"                at 10
                        gate-work.gate-name       at 25
                        "s_ttb_seq NOT FOUND !!!" at 60 skip.
    run error_handling(14, gate-work.gate-name ,"").
    next.
  end.
  
  if TERMINAL <> "" and NOT batch_mode then 
    DISPLAY s_ttb_seq.ds_name  @ msg[1]
            s_ttb_seq.pro_name @ msg[2]
      WITH FRAME ds_make.
 
  if s_ttb_seq.pro_recid = ? then do:
    if user_dbtype = "ORACLE"
      then find first DICTDB._Sequence
          where DICTDB._Sequence._Db-Recid    = drec_db
            and DICTDB._Sequence._Seq-Name    = s_ttb_seq.pro_name
            and DICTDB._Sequence._Seq-misc[8] = s_ttb_seq.ds_spcl 
          /* OE00170417 - check the foreign name too */
            and DICTDB._Sequence._Seq-misc[1] = s_ttb_seq.ds_name no-error.
    else if can-do(odbtyp,user_dbtype)
      then find first DICTDB._Sequence
        where DICTDB._Sequence._Db-Recid    = drec_db
          and DICTDB._Sequence._Seq-Name    = s_ttb_seq.pro_name
          and DICTDB._Sequence._Seq-misc[8] = s_ttb_seq.ds_spcl no-error.
    
    if available DICTDB._Sequence THEN
      ASSIGN s_ttb_seq.pro_recid = RECID(DICTDB._Sequence).
  end.
  else find first DICTDB._Sequence where RECID(DICTDB._Sequence) = s_ttb_seq.pro_recid
                                     AND NOT DICTDB._Sequence._Seq-name BEGINS "$"
                   no-error.
  if not available DICTDB._Sequence THEN
    ASSIGN
      { prodict/gate/cmp_nav.i
            &object = "SEQUENCE"
            &obj    = "seq"
            &objm   = "seq"
            }
  else do:
      { prodict/gate/cmp_msg.i
            &attrbt = "Name in {&PRO_DISPLAY_NAME}:"
            &msgidx = "l_seq-msg[2]"
            &msgvar = "min"
            &ns     = "s_ttb_seq.pro_name"
            &object = "SEQUENCE"
            &o-name = "s_ttb_seq.ds_name"
            &sh     = "DICTDB._Sequence._Seq-Name"
            }
      if can-do(odbtyp,user_dbtype) THEN
        { prodict/gate/cmp_msg.i
            &attrbt = "Special Name:"
            &msgidx = "l_seq-msg[3]"
            &msgvar = "sev"
            &ns     = "s_ttb_seq.ds_spcl"
            &object = "SEQUENCE"
            &o-name = "s_ttb_seq.ds_name"
            &sh     = "DICTDB._Sequence._Seq-Misc[3]"
            }
  end.
    
   { prodict/gate/cmp_sum.i
      &object = "seq"
      }

end. /* for each gate-work "SEQUENCE" */


/*------------------------------ Tables ----------------------------*/  

for each gate-work where gate-work.gate-slct = TRUE:

  if  gate-work.gate-type = "SEQUENCE"
   or gate-work.gate-type = "PROGRESS" then next.

  assign
    l_min-msg           = ""
    l_int-msg           = ""
    l_ret-msg           = ""
    l_ret2-msg          = ""
    l_reti-msg          = ""
    l_sev-msg           = ""
    gate-work.gate-flag = FALSE
    gate-work.gate-edit = "".
    
  for each s_ttb_tbl
    where recid(gate-work) = s_ttb_tbl.gate-work:
  
  if TERMINAL <> "" and NOT batch_mode
   then DISPLAY 
      s_ttb_tbl.ds_name  @ msg[1]
      s_ttb_tbl.pro_name @ msg[2]
      WITH FRAME ds_make.

  if s_ttb_tbl.pro_recid <> ?
   then find first DICTDB._File
        where RECID(DICTDB._File)        = s_ttb_tbl.pro_recid
        no-error.
  else if user_dbtype = "ORACLE"
   then find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and   DICTDB._File._For-name     = s_ttb_tbl.ds_name
        and   DICTDB._File._For-owner    = s_ttb_tbl.ds_user
        and   DICTDB._File._Fil-misc2[8] = s_ttb_tbl.ds_spcl
        no-error.
  else if can-do(odbtyp,user_dbtype)
   then find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and   UPPER(DICTDB._File._For-name)  = UPPER(s_ttb_tbl.ds_name)
        and   UPPER(DICTDB._File._For-owner) = UPPER(s_ttb_tbl.ds_user)
        and   DICTDB._File._Fil-misc2[1] = s_ttb_tbl.ds_spcl
        no-error.
   else find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and   DICTDB._File._For-name     = s_ttb_tbl.ds_name
        and   DICTDB._File._For-owner    = s_ttb_tbl.ds_user
        no-error.
  
  { prodict/gate/cmp_tbl.i }
      

/*---------------------------- FIELDS ------------------------------*/

  for each s_ttb_fld
    where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):
    IF s_ttb_fld.ds_name BEGINS "SYS_NC" AND user_dbtype = "ORACLE" THEN NEXT.
    find first DICTDB._Field of _File 
      where DICTDB._Field._For-Name = s_ttb_fld.ds_name
      and   DICTDB._Field._For-Type = s_ttb_fld.ds_type
      no-error.
    if not available DICTDB._Field
     then find first DICTDB._Field of _File 
      where DICTDB._Field._For-Name = s_ttb_fld.ds_name
      no-error.

    IF NOT AVAILABLE DICTDB._Field AND user_dbtype NE "ORACLE" THEN DO:
        find first DICTDB._Field of _File 
          where UPPER(DICTDB._Field._For-Name) = UPPER(s_ttb_fld.ds_name)
          and   UPPER(DICTDB._Field._For-Type) = UPPER(s_ttb_fld.ds_type)
          no-error.
        if not available DICTDB._Field
         then find first DICTDB._Field of _File 
          where UPPER(DICTDB._Field._For-Name) = UPPER(s_ttb_fld.ds_name)
          no-error.

    END.


    /* Oracle splits up the foreign date-fields into two PROGRESS-fields
     * one of foreign type DATE and one of foreign type TIME. Protoora
     * however, deletes the TIME field, to make the schemaholder similar
     * to the original PROGRESS-DB.
     * So if we try to find the TIME DICTDB._Field and find the DATE one
     * we give an according message and go-on with the next field
     */
    if   s_ttb_fld.ds_type        = "TIME"
     and user_dbtype              = "ORACLE"
     and available DICTDB._Field
     and (DICTDB._Field._For-Type  = "DATE" OR
          CAN-FIND (first DICTDB._Field of _File WHERE 
                     DICTDB._Field._For-Name = s_ttb_fld.ds_name AND
                     DICTDB._Field._For-Type NE "TIME" AND
                     DICTDB._Field._Data-Type BEGINS "datetime"))
     then do:
        IF DICTDB._Field._For-Type  = "DATE" THEN DO:
            /* if the field type is character or datetime, then it's ok to
               skip this check. So just issue msg when it's date in the schema 
               holder.
            */
            IF DICTDB._Field._Data-Type  = "DATE" THEN
              assign
                l_min-msg = l_min-msg + "    FIELD "
                          + s_ttb_fld.ds_name + ": " + chr(10) + chr(9)
                          + l_msg[l_fld-msg[25]]               + chr(10).
        END.
        ELSE DO:
            /* we must have gotten here because we found a time field,
               but the data type is actually not date on schema holder,
               that is, it's datetime, so can't have time portion.
            */
            assign
              l_sev-msg = l_sev-msg + "    FIELD "
                        + s_ttb_fld.pro_name + ": " + chr(10) + chr(9)
                        + "Time portion found for datetime field in the schema."  + chr(10).
        END.
      end.

     else do:
      { prodict/gate/cmp_fld.i }
      end.
    
    end.     /* for each s_ttb_fld */
  

/*----------------------------- INDEXES ------------------------------*/

  for each s_ttb_idx
    where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl):
    
    if user_dbtype = "SYB"
     then do:
      find first DICTDB._Index of DICTDB._File
        where DICTDB._Index._For-name = s_ttb_idx.ds_name
                                   + STRING(s_ttb_idx.pro_Idx#)
        no-error.
      if not available DICTDB._Index
       then find first DICTDB._Index of DICTDB._File
        where DICTDB._Index._For-name = s_ttb_idx.ds_name
                                   + STRING(DICTDB._Index._idx-num)
        no-error.
      end.
     else find first DICTDB._Index of DICTDB._File
      where DICTDB._Index._For-name = s_ttb_idx.ds_name
      no-error.

     if not available DICTDB._Index AND user_dbtype NE "ORACLE" THEN DO:
        find first DICTDB._Index of DICTDB._File
              where UPPER(DICTDB._Index._For-name) = UPPER(s_ttb_idx.ds_name)
              no-error.
     END.
     
    { prodict/gate/cmp_idx.i }


/*-------------------------- INDEX-FIELDS --------------------------*/

    for each s_ttb_idf
      where s_ttb_idf.ttb_idx = RECID(s_ttb_idx):
     
      find first s_ttb_fld
        where RECID(s_ttb_fld) = s_ttb_idf.ttb_fld.
        
      if s_ttb_fld.fld_recid = ?
       then do:
        IF  user_dbtype = "ORACLE" THEN
            find first DICTDB._Field of DICTDB._File
              where DICTDB._Field._For-name = s_ttb_fld.ds_name
              and   DICTDB._Field._For-Type = s_ttb_fld.ds_type
              no-error.
        ELSE
            find first DICTDB._Field of DICTDB._File
                  where UPPER(DICTDB._Field._For-name) = UPPER(s_ttb_fld.ds_name)
                  and   UPPER(DICTDB._Field._For-Type) = UPPER(s_ttb_fld.ds_type)
                  no-error.

        if not available DICTDB._Field
         THEN DO:
            IF  user_dbtype = "ORACLE" THEN
             find first DICTDB._Field of DICTDB._File
                  where DICTDB._Field._For-name = s_ttb_fld.ds_name
                  no-error.
            ELSE
                find first DICTDB._Field of DICTDB._File
                     where UPPER(DICTDB._Field._For-name) = UPPER(s_ttb_fld.ds_name)
                     no-error.
        END.
        end.
       else find first DICTDB._Field /* of DICTDB._File */
          where RECID(DICTDB._Field) = s_ttb_fld.fld_recid
          no-error.

      if available DICTDB._Field
       then find first DICTDB._Index-field of DICTDB._Index
        where DICTDB._Index-field._Field-recid = RECID(DICTDB._Field)
        no-error.

      if   s_ttb_fld.ds_type        = "TIME"
       and user_dbtype              = "ORACLE"
       and available DICTDB._Field
       and DICTDB._Field._For-Type  = "DATE"
       then assign
        l_min-msg = l_min-msg + "    INDEX-FIELD "
                  + s_ttb_idx.ds_name + "/" 
                  + s_ttb_fld.ds_name + ": " + chr(10) + chr(9)
                  + l_msg[l_idf-msg[5]]                + chr(10).

       else do:
        { prodict/gate/cmp_idf.i }
        end.


      end.   /* for each s_ttb_idf */
    
    end.   /* for each s_ttb_idx */


/*---------------- CHECK INDEXES IN OTHER DIRECTION ----------------*/

  for each DICTDB._Index of DICTDB._File:
    IF DICTDB._File._For-type = "VIEW" THEN NEXT.
    if   DICTDB._Index._For-name <> ? and DICTDB._Index._For-name <> "" then do:
      find first s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl) no-error.
    
       if not available s_ttb_idx THEN     
         IF INDEX("_V##", DICTDB._Index._For-name) = 0 THEN    
           ASSIGN l_min-msg = l_min-msg + "    INDEX "
                  + DICTDB._Index._index-name + ": " + chr(10) + chr(9)
                  + l_msg[l_idx-msg[12]]             + chr(10).
     
    end.
  end.
    
/*------------------------- PRIMARY-INDEX --------------------------*/

  find first DICTDB._Index of DICTDB._File
    where RECID(DICTDB._Index) = DICTDB._File._Prime-Index
    no-lock no-error.
  if available DICTDB._Index then do:
    if user_dbtype = "SYB" then do:
      find first s_ttb_idx
        where s_ttb_idx.ttb_tbl        = RECID(s_ttb_tbl)
        and   s_ttb_idx.ds_name
          + STRING(s_ttb_idx.pro_Idx#) = DICTDB._Index._For-name
        no-error.
      if not available s_ttb_idx
       then find first s_ttb_idx
        where s_ttb_idx.ttb_tbl            = RECID(s_ttb_tbl)
        and   s_ttb_idx.ds_name 
          + STRING(DICTDB._Index._idx-num) = DICTDB._Index._For-name
        no-error.
    end.
    else find first s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
               and s_ttb_idx.ds_name = DICTDB._Index._For-name no-error.

    IF user_dbtype NE "ORACLE" THEN DO:
        find first s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
               and UPPER(s_ttb_idx.ds_name) = UPPER(DICTDB._Index._For-name) no-error.
    END.

    if not available s_ttb_idx AND DICTDB._File._For-type <> "VIEW"
     then assign  /* primary index doesn't exist anymore */
       l_sev-msg = l_sev-msg + "    INDEX "
                 + DICTDB._Index._For-name + ": " + chr(10)
                 + chr(9) +  l_msg[l_idx-msg[9]]  + chr(10).

    end.

  { prodict/gate/cmp_sum.i
    &object = "tbl"
    }
   

    end.  /* for each s_ttb_tbl of gate-work */
    

  end. /* for each gate-work */


/*------------------------------------------------------------------*/        
/*-------------------- 2.Step: PROGRESS -> <DS> --------------------*/
/*------------------------------------------------------------------*/        

/* If the user selected all objects to be compared, we add a agte-work
 * record with type = "PROGRESS", to indicate, that all foreign objects
 * are contained in the s_ttb-tables. So all objects in the PROGRESS-
 * image, for which we can't find a counterpart in the foreign schema
 * we generate a warning
 */

for each gate-work
  where gate-work.gate-slct = TRUE
  and   gate-work.gate-type = "PROGRESS":
  
  assign
    l_min-msg = ""
    l_int-msg = ""
    l_ret-msg = ""
    l_ret2-msg = ""
    l_reti-msg = ""
    l_sev-msg = "".
    
  for each DICTDB._File
    where DICTDB._File._Db-Recid = drec_db
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"):
    
  /*------- skip the objects the user didn't want to compare -------*/
    if user_dbtype = "ORACLE"
     then do:  /* ORACLE */

      /* 0. skip system-tables */
      if  DICTDB._File._File-name begins "oracle7_"
       or DICTDB._File._File-name begins "oracle6_"
       or lookup(DICTDB._File._File-name,{prodict/ora/ora_sys.i}) <> 0
       then next.

      /* 1. skip non-selected links */
      find first s_ttb_link
        where s_ttb_link.master 
            + s_ttb_link.name = ( if DICTDB._File._Fil-misc2[8] = ?
                                    then ""
                                    else DICTDB._File._Fil-misc2[8]
                                )
        and   s_ttb_link.slctd                    = FALSE
        no-error.

      if available s_ttb_link then next. /* user chose to not check this link */

      /* 2. skip non-pre-selected objects */
      find first s_ttb_link
        where s_ttb_link.master 
            + s_ttb_link.name = ( if DICTDB._File._Fil-misc2[8] = ?
                                    then ""
                                    else DICTDB._File._Fil-misc2[8]
                                )
        and   s_ttb_link.slctd                    = TRUE
        no-error.

      if NOT ( available s_ttb_link
       and DICTDB._File._For-name  matches s_ttb_link.presel-n
       and DICTDB._File._For-type  matches s_ttb_link.presel-t
       and ( LC(DICTDB._File._For-owner) matches LC(s_ttb_link.presel-o)
          or    DICTDB._File._For-owner     =    ""
           )
             )
       then next. /* object not within preselection criteria */

      /* 3. skip non-selected objects */
      if DICTDB._File._For-Owner = ""
       then find first gate-work1 
        where gate-work1.gate-edit matches "*:" + DICTDB._File._For-name
                                          + ":" + DICTDB._File._For-Type
        no-error.  
       else find first gate-work1
        where gate-work1.gate-name = DICTDB._File._For-name
        and   gate-work1.gate-type = DICTDB._File._For-Type
        and   gate-work1.gate-user = DICTDB._File._For-Owner
        and   gate-work1.gate-qual = DICTDB._File._Fil-misc2[8]
        no-error.  

      end.     /* ORACLE */

    else if can-do(odbtyp,user_dbtype)
     then do:  /* ODBC */

      /* 0. skip system-tables */
      if  lookup(DICTDB._File._File-name,{prodict/odb/odb_sys.i}) <> 0
       then next.

      IF DICTDB._File._For-type = "PROCEDURE" THEN NEXT.

      /* 1. skip non-pre-selected objects */
      if NOT ( DICTDB._File._For-name     matches s_name
           and DICTDB._File._For-type     matches s_type
           and DICTDB._File._For-owner    matches s_owner
           and DICTDB._File._Fil-misc2[1] matches s_qual
             )
       then next. /* object not within preselection criteria */
       
      /* 2. skip non-selected objects */
      find first gate-work1
        where gate-work1.gate-name = DICTDB._File._For-name
        and   gate-work1.gate-type = DICTDB._File._For-Type
        and   gate-work1.gate-user = DICTDB._File._For-Owner
        and   gate-work1.gate-qual = ( if DICTDB._File._Fil-misc2[1] = ?
                                        then ""
                                        else DICTDB._File._Fil-misc2[1]
                                     )
        no-error.  

      end.     /* ODBC */

     else do:  /* SYBASE */

      /* 1. skip non-pre-selected objects */
      if NOT ( DICTDB._File._For-name     matches s_name
           and DICTDB._File._For-type     matches s_type
           and DICTDB._File._For-owner    matches s_owner
             )
       then next. /* object not within preselection criteria */
       
      /* 2. skip non-selected objects */
      find first gate-work1
        where gate-work1.gate-name = DICTDB._File._For-name
        and   gate-work1.gate-type = DICTDB._File._For-Type
        and   gate-work1.gate-user = DICTDB._File._For-Owner
        no-error.  

      end.     /* SYBASE */

    if available gate-work1
     and gate-work1.gate-flg2 = false
     and gate-work1.gate-edit = ""
     then next.     /* user chose to not compare this object */

  /*--------- skip all system-tables, pseudo-objects, ... ----------*/
    if  ( can-do(odbtyp,user_dbtype) 
       and ( LOOKUP(DICTDB._File._For-type,"GENERIC-BUFFER,STABLE") <> 0
         or  DICTDB._File._File-name begins "SQL"
         or  LOOKUP(DICTDB._File._File-name,"CloseAllProcs,GetFieldIds,"
                   + "GetFieldIds_buffer,GetInfo,GetInfo_Buffer,"
                   + "DS-Close-Cursor,SEND-SQL-STATEMENT,SendInfo")      <> 0
        )  )
     or ( user_dbtype = "ORACLE"
       and ( LOOKUP(DICTDB._File._File-Name,"PROC-TEXT-BUFFER,"
                   + "SEND-SQL-STATEMENT," + "DS-Close-Cursor" )    <> 0
         or  DICTDB._File._File-name begins "oracle"
        )  )
     then next.  /* system-table or pseudo-object */
     
  /*--------- check for existence of object on foreign side --------*/

  /* a) does object exist on the foreign side */
    if user_dbtype = "ORACLE"
     then find first s_ttb_tbl
      where s_ttb_tbl.ds_name = DICTDB._File._For-name
      and   s_ttb_tbl.ds_user = DICTDB._File._For-owner
      and   s_ttb_tbl.ds_spcl = DICTDB._File._Fil-misc2[8]
      no-error.
     else find first s_ttb_tbl
      where s_ttb_tbl.ds_name = DICTDB._File._For-name
      and   s_ttb_tbl.ds_user = DICTDB._File._For-owner
      and   s_ttb_tbl.ds_spcl = DICTDB._File._Fil-misc2[1]
      no-error.
    if not available s_ttb_tbl
     then assign
       l_sev-msg = l_sev-msg                + chr(9)
                 + string(DICTDB._File._File-name,"x(20)")
                 + ": "                     + chr(9)
                 + l_msg[l_tbl-msg[12]]     + chr(10).

     else do:  /* object exists */

  /* b) do all its fields exist on the foreign side */
      for each DICTDB._Field of DICTDB._File
        where DICTDB._Field._For-name > ""
        no-lock:
        find first s_ttb_fld
          where s_ttb_fld.ds_name = DICTDB._Field._For-Name
          and   s_ttb_fld.ds_type = DICTDB._Field._For-Type
          no-error.
        if not available s_ttb_fld
         then assign
           l_min-msg = l_min-msg + chr(9) + "Field "
                     + DICTDB._Field._For-name + ": " + chr(10)
                     + chr(9) + chr(9)
                     + l_msg[l_fld-msg[24]]           + chr(10).
        end.  /* for each DICTDB._Field */
    
  /* c) do all its Indexes exist on the foreign side */
      for each DICTDB._Index of DICTDB._File
        where DICTDB._Index._For-name > ""
        no-lock:

        if user_dbtype = "SYB" then do:
          find first s_ttb_idx
            where s_ttb_idx.ttb_tbl       =  RECID(s_ttb_tbl)
            and   s_ttb_idx.ds_name
             + STRING(s_ttb_idx.pro_Idx#) =  DICTDB._Index._For-name
            no-error.
          if not available s_ttb_idx
           then find first s_ttb_idx
            where s_ttb_idx.ttb_tbl           =  RECID(s_ttb_tbl)
            and   s_ttb_idx.ds_name
             + STRING(DICTDB._Index._idx-num) = DICTDB._Index._For-name
            no-error.
         end.
         else find first s_ttb_idx
          where s_ttb_idx.ttb_tbl =  RECID(s_ttb_tbl)
          and   s_ttb_idx.ds_name =  DICTDB._Index._For-name
          no-error.
     
        if not available s_ttb_idx
         then assign
           l_min-msg = l_min-msg + chr(9) + "Index "
                     + DICTDB._Index._For-name + ": " + chr(10)
                     + chr(9) + chr(9)
                     + l_msg[l_idx-msg[10]]      + chr(10).
        end.  /* for each DICTDB._Index */
    
      end.     /* object exists */

    end.  /* for each DICTDB._File */

  if   l_sev-msg = "" and l_crt-msg = "" and l_min-msg = "" then 
    ASSIGN gate-work.gate-edit = gate-work.gate-name + " " 
                                 + gate-work.gate-user + gate-work.gate-type 
                                 + gate-work.gate-qual + chr(10) + chr(10)
                                 + l_no-diff1
           gate-work.gate-flag = FALSE.
  else do:

     IF NOT s_outf THEN
       assign gate-work.gate-edit = ( if l_sev-msg <> ""
                                then l_dict-msg + l_sev-msg
                                else ""
                              )
                            + ( if l_crt-msg <> ""
                                then "  Orphan Fields/Indexes:" + chr(10) + l_crt-msg
                                else ""
                              )
                            + ( if l_min-msg <> ""
                                then "  Orphan Fields/Indexes:" + chr(10) + l_min-msg
                                else ""
                              )
             gate-work.gate-flag = TRUE.
      ELSE DO:
        OUTPUT STREAM comp_e TO VALUE(dbcomp_e) APPEND.
        IF l_sev-msg <> "" THEN DO:
          PUT STREAM comp_e UNFORMATTED l_dict-msg l_sev-msg SKIP.
          ASSIGN dif-found = TRUE.
        END.
        IF l_crt-msg <> "" THEN DO:
          PUT STREAM comp_e UNFORMATTED "  Orphan Fields/Indexes: " SKIP l_crt-msg SKIP.
          ASSIGN dif-found = TRUE.
        END.
        IF l_min-msg <> "" THEN DO:
          PUT STREAM comp_e UNFORMATTED "  Orphan Fields/Indexes:" SKIP l_min-msg SKIP.
          ASSIGN dif-found = TRUE.
        END.
        OUTPUT STREAM comp_e CLOSE.
        ASSIGN gate-work.gate-flag = TRUE.                         
      END.
   END.
  end. /* for each gate-work "PROGRESS" */


/*------------------------------------------------------------------*/        
/*---------------------- 3. Step: UI clean up ----------------------*/
/*------------------------------------------------------------------*/        

if NOT batch_mode
 then SESSION:IMMEDIATE-DISPLAY = no.

RUN adecomm/_setcurs.p ("").

if NOT batch_mode
 then HIDE FRAME ds_make NO-PAUSE.


/*------------------------------------------------------------------*/        
/*-------------------- 4. Step: tell user diffs --------------------*/
/*------------------------------------------------------------------*/        

if user_env[25] begins "AUTO" 
 then do:   /*========= automatically select all possible tables =======*/

    assign
      l_header1 = fill(" ",integer(5 - length(edbtyp,"character") / 2))
                + "Results of comparison of the {&PRO_DISPLAY_NAME} image with the " 
                + edbtyp + " DB's schema"
      l_header2 = ( if user_dbtype = "ORACLE"
                      then "" /*ORACLE-DB transparent -> no info avlbl*/
                      else "SH-Name="     + SDBNAME("DICTDBG")   + " "
                         + "Image-Name="  + LDBNAME("DICTDBG")   + " "
                         + "DSQUERY="     + OS-GETENV("DSQUERY") + " "
                         + "Physcl-Name=" + PDBNAME("DICTDBG")
                  )
      l_header2 = fill(" ",integer(38 - length(l_header2,"character") / 2))
                + l_header2.

    run prodict/misc/_prt_rpt.p
      ( INPUT "prodict/gate/_gat_rpt.p",
        INPUT l_header1,
        INPUT l_header2,
        INPUT "guigget",
        INPUT "s"
      ).
  end.      /*========= automatically select all possible tables =======*/

 else do:   /*=========== let user select the tables he wants ==========*/
  IF s_outf = FALSE THEN DO:

    IF user_dbtype = "ODBC" THEN DO:
        FIND FIRST DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-ERROR.
        IF AVAILABLE DICTDB._Db THEN
            is_as400 = INDEX(DICTDB._Db._Db-misc2[5],"AS/400") > 0 OR 
	               INDEX(DICTDB._Db._Db-misc2[5],"DB2/400") > 0 .
    END.

    RUN "prodict/gui/_guigge1.p" (INPUT edbtyp, INPUT "Compare", is_as400).
    assign l_canned = (if RETURN-VALUE = "cancel" then yes else no).
  END.
  ELSE DO:
    IF dif-found THEN
      MESSAGE "A report of differences has been created in your working directory.  " SKIP
              "See file  " dbcomp_e "  for results." SKIP 
              VIEW-AS ALERT-BOX TITLE "Verify Table Results".
    ELSE
      MESSAGE l_no-diff VIEW-AS ALERT-BOX TITLE "Verify Table Results".
    l_canned = YES.
  END.
 end.     /*=========== let user select the tables he wants ==========*/

if l_canned 
 then assign
   user_path = ( if user_dbtype = "ORACLE"
                  then "_ora_lkx"
                  else ""
               ).
for each gate-work
  where gate-work.gate-flag = FALSE
  or    l_canned = TRUE:
  assign gate-work.gate-slct = FALSE.
  end.

/* clear out variable in case user does again */
ASSIGN s_outf = FALSE.

RETURN.

/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2000,2009 by Progress Software Corporation. All      *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _gat_con.p - connect to Oracle, Rdb or Sybase using -U & -P */
/*
in:  user_env[1] = userid
     user_env[2] = password

out: no environment variables changed
D. McMann 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
Rohit     02/20/09 Call dictgate.i with user_dbtype instead of user_dbname- OE00128393
*/


{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE phynam AS CHARACTER NO-UNDO.
DEFINE VARIABLE c      AS CHARACTER NO-UNDO.

phynam = user_dbname.
{ prodict/dictgate.i &action=query &dbtype=user_dbtype &dbrec=? &output=c }
IF ENTRY(5,c) MATCHES "*p*" THEN DO: /* physical name applies */
  FIND _Db WHERE RECID(_Db) = drec_db NO-LOCK.
  phynam = (IF _Db-addr = "" OR _Db-addr = ? THEN user_dbname ELSE _Db-addr).
  /* Connect w' physical dbname if avail, otherwise assume logical dbname */
END.

IF user_env[1] <> "" OR NOT CONNECTED(user_dbname)
  THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    MESSAGE
      'Connecting to "' + user_dbname + '"'
      (IF user_env[1] = "" THEN "" ELSE 'as user "' + user_env[1] + '"').
    run adecomm/_setcurs.p ("WAIT").
    IF CONNECTED(user_dbname) THEN DISCONNECT VALUE(user_dbname).
    CONNECT
      VALUE(phynam)
      -ld VALUE(user_dbname)
      VALUE(IF user_env[1] = "" THEN "" ELSE "-U " + user_env[1])
      VALUE(IF user_env[2] = "" THEN "" ELSE "-P " + user_env[2])
      -dt VALUE(user_dbtype) NO-ERROR.
  END.

{ prodict/user/usercon.i }

PAUSE 1 NO-MESSAGE.  /* to avoid having the message flash to fast */
run adecomm/_setcurs.p ("").
HIDE MESSAGE NO-PAUSE.

IF NOT CONNECTED(user_dbname)
 THEN DO:
  MESSAGE
    'Could not connect to "' + user_dbname + '"' 
    (IF user_env[1] = "" THEN "" ELSE 'as user "' + user_env[1] + '"') SKIP
    ERROR-STATUS:GET-MESSAGE(1)
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
END.
ELSE
  CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(user_dbname) NO-ERROR.

RETURN.




/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gat_cp.p

Description:
    
    Asks for the code page, chacks it's validity and 
            
Input-Parameters:
    none

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    user_env[5]     code page if new-value
    user_path       set to ""                           if canceled 
                        or user_path + <reconnect>      if db connected
                        or no new value
    
Author: Tom Hutegger

History:
    D. McMann   10/17/03    Add NO-LOCK statement to _Db find in support of on-line schema add
    D. McMann   99/03/16    Added running _ora_crt.p to verify that 
                            oracle_tablespace file is included in schema holder
    gfs         94/07/25    Insert correct help context
    gfs         94/07/07    fixed text in alert boxes. The lines were
                            too wide for Windows VGA. 94-06-21-037    
    hutegger    94/04/12    creation

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
/*
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }
*/

define variable l_frozen     as   logical         initial false.
define variable not-canned   as   logical no-undo initial false.
define variable cp1          as   character       initial ?.
define variable cp2          as   character       initial ?.
define variable i            as   integer.
define variable modified     as   logical         initial true.

FORM                                                SKIP({&TFM_WID})
  " "
  user_env[5] {&STDPH_FILL} FORMAT "x(80)" COLON 13 
         VIEW-AS FILL-IN SIZE 40 BY 1
	 LABEL "Code Page"
  {prodict/user/userbtns.i}
  WITH FRAME codepage 
  SIDE-LABELS ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Change Code Page of Non-{&PRO_DISPLAY_NAME} DB ".

/*---------------------------  TRIGGERS  ---------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
/* This is the only frame used in the GUI environment */
on HELP of frame codepage
   or CHOOSE of btn_Help in frame codepage
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Change_Code_Page_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF

ON CHOOSE OF btn_cancel IN FRAME codepage
   APPLY "ENDKEY" to FRAME codepage.

ON  WINDOW-CLOSE         OF FRAME codepage
   APPLY "END-ERROR" TO FRAME codepage.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in ---*/
{prodict/gate/gat_cpvl.i
  &frame    = "codepage"
  &variable = "user_env[5]"
  &adbtype  = "_Db._Db-type"
  }  /* checks if user_env[5] contains convertable code page */
  
/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

     {adecomm/okrun.i  
	&FRAME  = "FRAME codepage" 
	&BOX    = "rect_Btns"
	&OK     = "btn_OK" 
	{&CAN_BTN}
	{&HLP_BTN}
     }

find _Db
  where _Db._Db-name = user_dbname
  NO-LOCK no-error.
/* If this is a converted V8 - V9 database we need to verify that 
   oracle_tablespace is included in schema holder   */  
IF AVAILABLE _DB AND _Db._Db-type = "ORACLE" THEN DO:
  RUN "prodict/ora/_ora_crt.p" (RECID(_DB)).  
END.
  
if available _Db 
 then do on error  undo,retry 
         on endkey undo, leave:
  
  assign not-canned = false.
  if dict_rog 
   then message
      "The database is in read-only mode - alterations not allowed."
      view-as alert-box.
   else do:  /* not read-only mode */  
    find _File where _File._File-name = "_Field" 
                 and _File._Owner = "PUB" no-lock.
    if not can-do(_File._Can-Write,userid("DICTDB"))
     then message
       "You do not have permission to use this option."
       view-as alert-box.
     else do:  /* not read-only mode and write-permission*/
      assign l_frozen = false. 
      for each _file of _db where (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
        no-lock
        while not l_frozen: 
        if _file._frozen then assign l_frozen = true. 
        end.
      if l_frozen 
       then message
         "The definitions of one or more tables are frozen! No changes can be made."
         view-as alert-box.
       else not-canned = true.    
      end.     /* not read-only mode and write-permission*/
    end.     /* not read-only mode */      
    
  if not-canned
   then do:
    assign not-canned = false.
    IF connected(user_dbname)
     then message
      "Changing the code page will not convert data"   skip
      "already in the database.  If you have been"     skip
      "writing data to the database using a different" skip
      "code page, changing the code page can corrupt"  skip
      "your data. Refer to the DataServer manual"      skip
      "for additional details."                        skip(1)
      "If you change the code page, the non-"          skip
      "{&PRO_DISPLAY_NAME} database will be disconnected."        skip
      "After the change, you will be prompted"         skip
      "to reconnect it."
      view-as alert-box warning 
      buttons ok-cancel update not-canned.
     else message
      "Changing the code page will not convert data"   skip
      "already in the database.  If you have been"     skip
      "writing data to the database using a different" skip
      "code page, changing the code page can corrupt"  skip
      "your data. Refer to the DataServer manual"      skip
      "for additional details."                        skip(1)
      view-as alert-box warning 
      buttons ok-cancel update not-canned.
    end.

  if not-canned = ?
      then not-canned = false. 

  if not-canned then do:  
      if _DB._Db-type = "SYB10" or _DB._Db-type = "MSSQLSRV" then do:
         if _DB._Db-misc2[8] <> ? then
              assign user_env[5] = _DB._DB-xl-name + "/" + _DB._Db-misc2[8]. 
         else assign user_env[5] = _DB._DB-xl-name + "/".
         end. /* _DB._Db-type = "SYB10" */ 
      else
         assign user_env[5] = _DB._DB-xl-name.

    assign not-canned = FALSE. 

    update
        user_env[5]
        btn_OK 
        btn_Cancel
        {&HLP_BTN_NAME}
        with frame codepage.
  
    assign not-canned = TRUE.
 
    end.     /* not canned yet*/
  
  end.     /* _Db available: on error ... on endkey ...  */
     
hide message        no-pause.
hide frame codepage no-pause.

if user_env[5] = "<internal defaults apply>" then assign user_env[5] = ?.

if not-canned = false 
 then assign user_path = ""
             modified = false.
else if ( _DB._Db-type = "SYB10" or _DB._Db-type = "MSSQLSRV")
 then do:
    i = INDEX (user_env[5], "/").
    if i = 0 then
       assign cp1 = user_env[5]
              cp2 = ?.
    else 
      assign cp1 = SUBSTRING (user_env[5], 1, i - 1)
             cp2 = SUBSTRING (user_env[5], i + 1). 
      if cp2 = "" then cp2 = ?.       
    if cp1 = _DB._DB-xl-name and cp2 = _Db._Db-misc2[8] then
      assign user_path = ""
             modified = false.
  end.
else if user_env[5] = _DB._DB-xl-name
 then assign user_path = ""
             modified  = false.

if modified = true and connected(user_dbname)
 then do:
  disconnect value(user_dbname).
  if "{&WINDOWS-SYSTEM}" = "TTY"
   then assign user_path =  user_path + ",1=usr,_usrscon,1=new,_usrsget,*N".
   else assign user_path =  user_path + ",1=usr,_usrscon,1=new,_guisget,*N".
  end.
  
RETURN.









/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gat_cp1.i

Description:
    
    assignes the new code-page to the _Db-record; and, to ensure
    the changes in the initial-values, assigns "" to them in every
    field 
            
Input-Parameters:
    none

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    user_env[5]     code-page                            if new-value
    
Author: Tom Hutegger

History:
    hutegger    94/04/21    creation
    mcmann      00/03/00    Changed frame definition and added pause 2 for
                            use to be able to see message.
    
--------------------------------------------------------------------*/        
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

form
  " Applying the changes to the schema holder. " skip
  "                            Please wait ... "
  with overlay centered row 5
  frame msg VIEW-AS DIALOG-BOX THREE-D.
  
/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

find _Db
  where _Db._Db-name = user_dbname
  no-error.
if not available _Db 
 then do:  /* */
  /* should actually never be */
  end.     /* */

 else do:  /* _db available */
  
  run adecomm/_setcurs.p ("WAIT").
  assign SESSION:IMMEDIATE-DISPLAY = yes.
  view frame msg.

  if ( _DB._Db-type = "SYB10" or _DB._Db-type = "MSSQLSRV")
    then do:
        { prodict/gate/gat_cp1a.i 
              &incpname = "user_env[5]" }
    end.
  else assign _Db._Db-xl-name = user_env[5].

  if  _Db._Db-xl-name =  ?
   or _Db._Db-xl-name = "?"
   then do:
    find first _File of _Db 
      WHERE (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") no-error.
    if available _File
     then find first _Field of _File no-error.
    if available _Field
     then assign _Field._Initial = _Field._Initial + "".
    end.
   else for each _File of _Db:
    for each _Field of _File:
      assign _Field._initial = _Field._initial + "".
      end.
    end.
  PAUSE 2 NO-MESSAGE.  
  hide frame msg no-pause.
  run adecomm/_setcurs.p ("").
  
  end.     /* _db available */
      
/*------------------------------------------------------------------*/













/*********************************************************************
* Copyright (C) 2006-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

file: prodict/gate/_gat_cro.p

Description:
    creates PROGRESS object according to the foreign info contained
    in the temp-tables, ev. deleting the object first, if it already
    exists, while retaining the PROGRESS-only info of the object to
    use if when re-creating it
    
    <DS>_get.p gets a list of all pullable objects from the foreign DB
    <DS>_pul.p pulled over the definition from the foreign side
    gat_cmp.p  compared the existing definitions with the pulled info
    gat_cro.p  replaces the existing definitions with the pulled info
               or creates the new object if it didn't already exist

    Create <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Update <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Verify <DS> Schema: <DS>_get.p <DS>_pul.p gat_cmp.p gat_cro.p

Input:
    gate-work   contains names of all objects to be created/updated
    s_ttb_tbl   Table information from foreign schema
    s_ttb_fld   Field information from foreign schema
    s_ttb_idx   Index information from foreign schema
    s_ttb_idf   Index-Field information from foreign schema

Output:
    gate-work   contains names of all objects to be created/updated
                gate-edit contains report of verify
                gate-flag = YES, if differences found
                gate-flag = NO,  if object doesn't exist anymore
                    on foreign side, or definitions don't differ

Unchanged:
    s_ttb_tbl   Table information from foreign schema
    s_ttb_fld   Field information from foreign schema
    s_ttb_idx   Index information from foreign schema
    s_ttb_idf   Index-Field information from foreign schema

History:
    hutegger    03/95   creation (derived from ds_vrf.p)
    mcmann      11/24/97 Added stream logfile to put statements
    mcmann      02/22/99 Added check for unique index for primary
    mcmann      06/10/99 Added assignment of _Fld-Misc2[2] for nullable
    mcmann      01/26/00 Fixed error message that was being displayed
                         when reassigning field triggers.
    mcmann      04/04/00 Added check for user_env[34] to see if s_1st-eror was set earlier.
    mcmann      05/26/00 Added check for MSS for nullable capable.
    mcmann      07/13/00 Added check for gate-work.gate-edit being empty
    mcmann      06/12/01 Added assignment of Format and Initial values from w_field if available.
    mcmann      06/18/01 Added check of _db-misc1[1] for case
    mcmann      07/08/02 DESC index fixes 20020702013,20020703006, 20020622001
    mcmann      07/10/02 Added check for _index record with no _index-fields - function indexes
    mcmann      10/10/02 Added logic to see data type change.
    mcmann      06/02/03 Removed CLOB and CFILE as valid data type
    mcmann      11/06/03 Swap assignment of Primary index 20031105-020
    slutz       08/10/05 Added s_ttb_fld.ds_msc26 20050531-001
    fernando    04/19/06 Fixing output of message
    fernando    05/26/06 Added support for int64
    fernando    06/11/07 Unicode and clob support   
    fernando    02/14/08 Support for datetime 
    fernando    08/18/08 Check foreign dtype when updating field - OE00168850
    knavneet    08/19/08 Quoting object names if it has special chars - OE00170417
    fernando    05/29/09 MSS support for blob
    kmayur      06/21/11 Support for constraint migration- OE00190567
    sdash       10/11/12 _File-Label added to left Table Label intact - OE00225208
--------------------------------------------------------------------*/


/*    &DS_DEBUG   DEBUG to protocol the creation    */
/*                ""    to turn off protocol        */
&SCOPED-DEFINE xxDS_DEBUG                   DEBUG

&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

define variable batch_mode	 as logical.
define variable edbtyp           as character no-undo. /* db-type external format */
define variable has_id_ix        as logical   no-undo.
define variable i                as integer   no-undo.
define variable indn             as integer   no-undo.
define variable l_char-types     as character no-undo.
define variable l_chda-types     as character no-undo.
define variable l_date-types     as character no-undo.
define variable l_dcml-types     as character no-undo.
define variable l_deil-types     as character no-undo.
define variable l_dein-types     as character no-undo.
define variable l_ds_recid       as integer   no-undo.
define variable l_extnt-char     as character no-undo initial "##".
define variable l_intg-types     as character no-undo.
define variable l_logi-types     as character no-undo.
define variable l_order-max      as integer   no-undo.
define variable l_pro_recid      as integer   no-undo.
define variable msg              as character no-undo   EXTENT 6.
define variable odbtyp           as character no-undo. /* ODBC db-types */
define variable oldf  	         as logical   no-undo. /* old file definition */
define variable scrap            as logical   no-undo.
define variable def-ianum        as integer initial 6 no-undo.
DEFINE VARIABLE fld-dif          AS LOGICAL   NO-UNDO.
DEFINE VARIABLE for_name         AS CHARACTER NO-UNDO. /* OE00170417 */
DEFINE VARIABLE other-seq-name   AS CHARACTER NO-UNDO.
DEFINE VARIABLE is_as400db       AS LOGICAL NO-UNDO.
DEFINE VARIABLE num              AS INTEGER NO-UNDO.
DEFINE VARIABLE const_name1   AS CHARACTER NO-UNDO.

/*------------------------------------------------------------------*/
/* These variables/workfile are so we can save the Progress-only
   portion of the DataServer definitions when rebuilding. */
   
define variable idx_Desc         as character no-undo. /*_Desc   */
define variable tab_Can-Crea     as character no-undo. /*_Can-Create */
define variable tab_Can-Dele     as character no-undo. /*_Can-Delete */
define variable tab_Can-Read     as character no-undo. /*_Can-Read */
define variable tab_Can-Writ     as character no-undo. /*_Can-Write */
define variable tab_Desc         as character no-undo. /*_Desc        */
define variable tab_Dump-nam     as character no-undo. /*_Dump-name */
define variable tab_Hidden       as logical   no-undo. /*_Hidden */
define variable tab_PIForNum     as integer   no-undo. /*_Prime-Index */
define variable tab_PrimeIdx     as character no-undo. /*_Prime-Index */
define variable tab_recidNew     as character no-undo. /*_Recid-Index */
define variable tab_recidOld     as character no-undo. /*_Recid-Index */
define variable tab_RIfstoff     as integer   no-undo. /*_Recid-Index */
define variable tab_RIidx#       as integer   no-undo. /*_Recid-Index */
define variable tab_RILevel      as integer   no-undo. /*_Recid-Index */
define variable tab_RImsc23      as character no-undo. /*_Recid-Index */
define variable tab_Valexp       as character no-undo. /*_Valexp */
define variable tab_Valmsg       as character no-undo. /*_Valmsg */
define variable tab_File-Label   as character no-undo. /*_File-Label */

define TEMP-TABLE w_field no-undo
            field ds_name             as character case-sensitive
            field ds_type             as character
            field pro_Can-Read        as character
            field pro_Can-Writ        as character
            field pro_Col-lbl         as character
            field pro_Decimals        as integer
            field pro_Desc            as character
            field pro_Fld-case        as logical
            field pro_Format          as character
            field pro_Help            as character
            field pro_Initial         as character
            field pro_Label           as character
            field pro_Mandatory       as logical
            field pro_Name            as character
            field pro_Order           as integer
            field pro_type            as character
            field pro_Valexp          as character
            field pro_Valmsg          as character
            index upi        IS UNIQUE PRIMARY ds_name ds_type
            index order      is unique         pro_order.

define temp-table w_index NO-UNDO
            field     pro_Active       like DICTDB._index._Active        
            field     pro_Desc         like DICTDB._index._Desc        
            field     pro_For-Name     like DICTDB._index._For-Name         
            field     pro_idx-num      like DICTDB._index._idx-num     
            field     pro_Index-Name   like DICTDB._index._Index-Name  
            field     pro_Unique       like DICTDB._index._Unique      
            field     pro_Wordidx      like DICTDB._index._Wordidx     
            INDEX upi        IS UNIQUE PRIMARY pro_idx-num
            INDEX for-name                     pro_For-Name.

define temp-table w_index-field NO-UNDO
        field     pro_Abbreviate   like DICTDB._index-field._Abbreviate  
        field     pro_Ascending    like DICTDB._index-field._Ascending   
        field     pro_For-name     like DICTDB._field._For-name 
        field     pro_For-type     like DICTDB._field._For-type      
        field     pro_idx-num      like DICTDB._index._idx-num 
        field     pro_Index-Seq    like DICTDB._index-field._Index-Seq   
        field     pro_Unsorted     like DICTDB._index-field._Unsorted 
        INDEX upi        IS UNIQUE PRIMARY pro_idx-num
                                           pro_For-name
                                           pro_For-type.   

define temp-table y_Tmp-File-Trig
        field     y_Event          like DICTDB._File-Trig._Event
        field     y_Proc-name      like DICTDB._File-Trig._Proc-Name
        field     y_Override       like DICTDB._File-Trig._Override
        field     y_Trig-Crc       like DICTDB._File-Trig._Trig-Crc.
        
define temp-table y_Tmp-Field-Trig
        field     y_Event          like DICTDB._Field-Trig._Event
        field     y_Proc-name      like DICTDB._Field-Trig._Proc-Name
        field     y_Override       like DICTDB._Field-Trig._Override
        field     y_Trig-Crc       like DICTDB._Field-Trig._Trig-Crc
        field     y_Field-Name     like DICTDB._Field._field-Name.
        
define buffer   l_ttb_idx        FOR  s_ttb_idx.


/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/

define variable err-msg     as character format "x(40)" extent 19
      initial [
/*  1 */ "WARNING: Column &1 is hidden; it cannot be an index component",
/*  2 */ "WARNING: No index for the RECID &1 field",
/*  3 */ "WARNING: No possible RECID-Index found for table &1 (Owner: &2)",
/*  4 */ "WARNING: The Driver sends wrong data about indexes, they cant be build automatically",
/*  5 */ "WARNING: The previously selected index for ROWID functionality for table",
/*  6 */ "WARNING: &1 might be not the optimal index for ROWID functionality.",
/*  7 */ "Use Dictionary to check correctness.",
/*  8 */ "ERROR: TempTable-record for &1 not found.",
/*  9 */ "&1 ",  /* un-used - except debugging messages /**/ */
/* 10 */ "WARNING: The table &1 is frozen. It did not get updated.",
/* 11 */ "DETACHED FILE-TRIGGER   :",
/* 12 */ "DETACHED FIELD-TRIGGER  :",
/* 13 */ "REASSIGNED FILE-TRIGGER :",
/* 14 */ "REASSIGNED FIELD-TRIGGER:",
/* 15 */ "doesn't exist anymore! Trigger cannot be reassigned!",
/* 16 */ "Please check errors, warnings and messages in the file ""ds_upd.e""!",
/* 17 */ "WARNING: Index name changed from &1 to &2!",
/* 18 */ "WARNING: Index &1 changed from UNIQUE to NON-UNIQUE - change not reflected!",
/* 19 */ "Wait, or press any key to continue ..."
              ].     

FORM
                                                    SKIP(1)
  msg[1]   FORMAT "x(29)" LABEL "Object" colon 8 
    "->"
    msg[2] FORMAT "x(25)" LABEL "Object"            SKIP(1)
/** /
  msg[3]   FORMAT "x(29)" LABEL "Column" colon 8 
    "->"
    msg[4] FORMAT "x(25)" LABEL "Field"             SKIP
  msg[5]   FORMAT "x(29)" LABEL "Key"    colon 8 
    "->"
    msg[6] FORMAT "x(25)" LABEL "Index"             SKIP (1)
/ **/
  WITH FRAME ds_make ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED VIEW-AS DIALOG-BOX THREE-D
  TITLE " Transferring " + edbtyp + " Definition " USE-TEXT.

/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/
      
/*---------------------  Internal Procedures  ----------------------*/
PROCEDURE delete-file.

/* in case there is no field in the first table */
  if s_1st-error = false
   then do:        
    find first DICTDB._File-Trig  of DICTDB._File no-lock no-error.
    find first DICTDB._Field-Trig of DICTDB._File no-lock no-error.
    if  available DICTDB._File-Trig
     or available DICTDB._Field-Trig
     then do:  /* delete ev. old error.files & set "errors = occured" */
      assign s_1st-error = true.
      output stream s_stm_errors to ds_upd.e.
      output stream s_stm_errors close.
      end.
    end.
                 
  for each DICTDB._File-Trig of DICTDB._File exclusive-lock:

    output stream s_stm_errors to ds_upd.e append.
    put stream s_stm_errors 
      err-msg[11]              format "x(26)"
      DICTDB._File._File-Name  format "x(64)"
      DICTDB._File-Trig._Event format "x(15)" 
      DICTDB._File-Trig._Proc-Name skip.
    output stream s_stm_errors close.

    create y_Tmp-File-Trig.
    assign
      y_Tmp-File-Trig.y_Event     = DICTDB._File-Trig._Event
      y_Tmp-File-Trig.y_Proc-name = DICTDB._File-Trig._Proc-Name
      y_Tmp-File-Trig.y_Override  = DICTDB._File-Trig._Override
      y_Tmp-File-Trig.y_Trig-Crc  = DICTDB._File-Trig._Trig-Crc.
    delete DICTDB._File-Trig.

    end.

  delete DICTDB._File.

  end PROCEDURE.  /* delete-file */

/*------------------------------------------------------------------*/        
      
PROCEDURE delete-field.

/* on delete of DICTDB._Field do:*/

  if s_1st-error = false
   then do:        
    find first DICTDB._File-Trig  of DICTDB._File no-lock no-error.
    find first DICTDB._Field-Trig of DICTDB._File no-lock no-error.
    if  available DICTDB._File-Trig
     or available DICTDB._Field-Trig
     then do:  /* delete ev. old error.files & set "errors = occured" */
      assign s_1st-error = true.
      output stream s_stm_errors to ds_upd.e.
      output stream s_stm_errors close.
      end.
    end.
                 
  for each DICTDB._Field-Trig of DICTDB._Field exclusive-lock:

    output stream s_stm_errors to ds_upd.e append.
    put stream s_stm_errors 
      err-msg[12]               format "x(26)" 
      DICTDB._File._File-Name 
      DICTDB._Field._Field-Name 
      DICTDB._Field-Trig._Event format "x(15)" 
      DICTDB._Field-Trig._Proc-Name skip.
    output stream s_stm_errors close.

    create y_Tmp-Field-Trig.
    assign
      y_Tmp-Field-Trig.y_Event      = DICTDB._Field-Trig._Event
      y_Tmp-Field-Trig.y_Proc-name  = DICTDB._Field-Trig._Proc-Name
      y_Tmp-Field-Trig.y_Override   = DICTDB._Field-Trig._Override
      y_Tmp-Field-Trig.y_Trig-Crc   = DICTDB._Field-Trig._Trig-Crc
      y_Tmp-Field-Trig.y_Field-name = DICTDB._Field._Field-Name.

    delete DICTDB._Field-Trig.

    end.

  delete DICTDB._Field.

  end PROCEDURE.  /* delete-field */

/*------------------------------------------------------------------*/        
      
PROCEDURE create-file.

  define input parameter p_table-name as character.
  
  create DICTDB._File.
  
  for each y_Tmp-File-Trig:     

    output stream s_stm_errors to ds_upd.e append.
    put stream s_stm_errors 
      err-msg[13]           format "x(26)" 
      p_table-name          format "x(64)"
      y_Tmp-File-Trig.y_Event format "x(15)" 
      y_Tmp-File-Trig.y_Proc-Name skip.
    output stream s_stm_errors close.

    create DICTDB._File-Trig.
    assign 
      DICTDB._File-Trig._File-Recid  = RECID(_File)
      DICTDB._File-Trig._Event       = y_Tmp-File-Trig.y_Event
      DICTDB._File-Trig._Proc-Name   = y_Tmp-File-Trig.y_Proc-name 
      DICTDB._File-Trig._Override    = y_Tmp-File-Trig.y_Override  
      DICTDB._File-Trig._Trig-Crc    = ?
                                    /* y_Tmp-File-Trig.y_Trig-Crc */ 
      .
    delete y_Tmp-File-Trig.

    end.        /* create all file-triggers for this file */

  end PROCEDURE.  /* create-file */

      
/*------------------------------------------------------------------*/        
      
Procedure Field-Triggers:

  if CAN-FIND(first y_Tmp-Field-Trig)
   then do:     /* there are field-triggers */
    
    for each y_Tmp-Field-Trig:
      
      find first DICTDB._Field of DICTDB._File
        where DICTDB._Field._Field-Name = y_Tmp-Field-Trig.y_Field-Name
        no-lock no-error.
        
      if not available DICTDB._Field    /* in case a field got dropped or */
       then do:                         /* its name got changed */

        output stream s_stm_errors to ds_upd.e append.
        put stream s_stm_errors 
          err-msg[15]                    format "x(26)" 
          DICTDB._File._File-Name 
          y_Tmp-Field-Trig.y_Field-Name  
          y_Tmp-Field-Trig.y_Event       format "x(15)" 
          y_Tmp-Field-Trig.y_Proc-Name skip.
        output stream s_stm_errors close.

        end.
       else do:  /* found field to reconnect trigger */ 

        output stream s_stm_errors to ds_upd.e append.
        put stream s_stm_errors 
          err-msg[14]                    format "x(26)" 
          DICTDB._File._File-Name 
          y_Tmp-Field-Trig.y_Field-Name 
          y_Tmp-Field-Trig.y_Event      format "x(15)" 
          y_Tmp-Field-Trig.y_Proc-Name skip.
        output stream s_stm_errors close.

        create DICTDB._Field-Trig.
        assign 
          DICTDB._Field-Trig._Field-Recid = RECID(_Field)
          DICTDB._Field-Trig._File-Recid  = RECID(_File)
          DICTDB._Field-Trig._Event       = y_Tmp-Field-Trig.y_Event
          DICTDB._Field-Trig._Proc-Name   = y_Tmp-Field-Trig.y_Proc-name 
          DICTDB._Field-Trig._Override    = y_Tmp-Field-Trig.y_Override  
          DICTDB._Field-Trig._Trig-Crc    = ?
                                         /* y_Tmp-Field-Trig.y_Trig-Crc */
          . 

        end.    /* found field to reconnect trigger */

      delete y_Tmp-Field-Trig.
            
      end.      /* create all field-triggers for this file */
      
    end.        /* there are field-triggers */
  
  end PROCEDURE.  /* Field-Triggers */

/*------------------------------------------------------------------*/        

procedure error_handling:

  define INPUT PARAMETER error-nr         as INTEGER.
  define INPUT PARAMETER param1           as CHARACTER.
  define INPUT PARAMETER param2           as CHARACTER.

  if param1 = ? then assign param1 = "".
  if param2 = ? then assign param2 = "".

  if s_1st-error = false
   then do:
    assign s_1st-error = true.
    output stream s_stm_errors to ds_upd.e.
    output stream s_stm_errors close.
    end.
  output stream s_stm_errors to ds_upd.e append.
  PUT stream s_stm_errors unformatted
            SUBSTITUTE(err-msg[error-nr],param1,param2)  skip.
  output stream s_stm_errors close.
 
  end PROCEDURE.  /* error_handling */

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

/* Having problems with ds_upd.e being overwritten when set below this leverl */
IF user_env[34] = "true" THEN ASSIGN s_1st-error = TRUE.

FIND DICTDB._Db WHERE RECID(_Db) = drec_db NO-LOCK.

assign
  batch_mode = SESSION:BATCH-MODE
  cache_dirty = TRUE
  edbtyp     = {adecomm/ds_type.i
                 &direction = "itoe"
                 &from-type = "user_dbtype"
                 }
  odbtyp      = {adecomm/ds_type.i
                    &direction = "ODBC"
                    &from-type = "odbtyp"
                }
  .
  
ASSIGN is_as400db = INDEX(DICTDB._Db._Db-misc2[5],"AS/400") > 0 OR
                  INDEX(DICTDB._Db._Db-misc2[5],"DB2/400") > 0.

IF NOT batch_mode then assign SESSION:IMMEDIATE-DISPLAY = yes.

RUN adecomm/_setcurs.p ("WAIT").

if can-do(odbtyp,user_dbtype)
 then assign
    l_char-types = "LONGVARBINARY,LONGVARCHAR,CHAR,VARCHAR,BINARY,VARBINARY,TIME,NVARCHAR,NCHAR,ROWGUID"
    l_chda-types = "TIMESTAMP"
    l_date-types = "DATE"
    l_dcml-types = ""
    l_dein-types = "DECIMAL,NUMERIC,DOUBLE,FLOAT,REAL,BIGINT"
    l_deil-types = "INTEGER,SMALLINT,TINYINT"
    l_intg-types = ""
    l_logi-types = "BIT".
else if user_dbtype = "ORACLE"
   then assign
    l_char-types = "CHAR,VARCHAR,VARCHAR2,ROWID,LONG,RAW,LONGRAW,BLOB,BFILE,NCHAR,NVARCHAR2,CLOB,NCLOB"
    l_chda-types = "DATE,TIMESTAMP,TIMESTAMP_LOCAL,TIMESTAMP_TZ"
    l_date-types = ""
    l_dcml-types = "FLOAT"
    l_dein-types = ""
    l_deil-types = "NUMBER"
    l_intg-types = "TIME"
    l_logi-types = "LOGICAL".
 else assign
    l_char-types = "CHAR,BINARY,IMAGE,SYSNAME,TEXT,TIMESTAMP,VARCHAR,VARBINARY"
    l_chda-types = ""
    l_date-types = "DATETIME,DATETIMEN,DATETIME4"
    l_dcml-types = "MONEY,MONEYN,MONEY4,REAL,FLOAT,FLOATN"
    l_dein-types = ""
    l_deil-types = ""
    l_intg-types = "INT,INTN,SMALLINT,TIME,TIME4,TINYINT"
    l_logi-types = "BIT".

/*------------------------------------------------------------------*/  
/*---------------------------- MAIN-LOOP ---------------------------*/
/*------------------------------------------------------------------*/  

/*---------------------------- Sequences ---------------------------*/  

for each gate-work
  where gate-work.gate-slct = TRUE:
  if not
   (    gate-work.gate-type = "SEQUENCE"
   or ( gate-work.gate-type = "SYNONYM"
        and gate-work.gate-edit <> ""
        and  entry(3,gate-work.gate-edit,":") = "SEQUENCE"
   )  )
   then next.  /* neither sequence nor synonym for a sequence */

  find first s_ttb_seq
    where RECID(s_ttb_seq) = gate-work.ttb-recid
    no-error.
  if not available s_ttb_seq
   then do:
    if SESSION:BATCH-MODE and logfile_open
     then put stream logfile unformatted
       "SEQUENCE"               at 10
       gate-work.gate-name      at 25
       "NO s_ttb_seq FOUND !!!" at 60 skip.
    run error_handling(8, gate-work.gate-name ,"").
    next.
    end.
  
  if TERMINAL <> "" and NOT batch_mode
   then DISPLAY 
      s_ttb_seq.ds_name  @ msg[1]
      s_ttb_seq.pro_name @ msg[2]
      WITH FRAME ds_make.


  if SESSION:BATCH-MODE and logfile_open
   then put stream logfile unformatted  "SEQUENCE" at 15 (s_ttb_seq.ds_user + "." + s_ttb_seq.ds_name) at 30.

  if s_ttb_seq.pro_recid = ?
   then do:  /* s_ttb_seq.pro_recid = ? */

    if user_dbtype = "ORACLE" then
      DO:
      ASSIGN for_name = s_ttb_seq.ds_name.
      IF for_name begins '"' then /* OE00170417: string may be quoted */
        ASSIGN for_name = TRIM(s_ttb_seq.ds_name,'"').
      find first DICTDB._Sequence
      where DICTDB._Sequence._Db-Recid    = drec_db
      and ( DICTDB._Sequence._Seq-Misc[1] = s_ttb_seq.ds_name 
           OR DICTDB._Sequence._Seq-Misc[1]  = for_name) /* OE00170417: string may be quoted */
      and   DICTDB._Sequence._Seq-Misc[2] = s_ttb_seq.ds_user
      and   DICTDB._Sequence._Seq-misc[8] = s_ttb_seq.ds_spcl
      no-error.
     END.
    else if can-do(odbtyp,user_dbtype) then DO:
      find first DICTDB._Sequence
        where DICTDB._Sequence._Db-Recid    = drec_db
        and   DICTDB._Sequence._Seq-Misc[1] = s_ttb_seq.ds_name
        and   DICTDB._Sequence._Seq-Misc[2] = s_ttb_seq.ds_user
        no-error.
      /* OE00170189- code executed only for MSS dbtype */
      if user_dbtype = "MSS" THEN DO:
        if not available DICTDB._Sequence then DO:
          assign other-seq-name = "".
	  IF (s_ttb_seq.ds_name BEGINS "_SEQT_REV_" and s_ttb_seq.ds_name NE "_SEQT_REV_SEQTMGR" )
		   THEN assign other-seq-name = "_SEQT_" + SUBSTRING(s_ttb_seq.ds_name,11,-1,"character").
	  ELSE IF (s_ttb_seq.ds_name BEGINS "_SEQT_") 
		   THEN assign other-seq-name = "_SEQT_REV_" + SUBSTRING(s_ttb_seq.ds_name,7,-1,"character"). 
	  find first DICTDB._Sequence
            where DICTDB._Sequence._Db-recid     = drec_db
	    and   DICTDB._Sequence._Seq-Misc[1]  = other-seq-name 
            and   DICTDB._Sequence._Seq-misc[2]  = s_ttb_seq.ds_user
            no-error.
        end. 
      end.
    end.

    if not available DICTDB._Sequence
     then find first DICTDB._Sequence
      where DICTDB._Sequence._Seq-name     = s_ttb_seq.pro_name
      and   DICTDB._Sequence._Db-recid     = drec_db
      and   DICTDB._Sequence._Seq-misc[2]  = "%TEMPORARY%"
      no-error.

    end.     /* s_ttb_seq.pro_recid = ? */

   else find first DICTDB._Sequence
    where RECID(DICTDB._Sequence) = s_ttb_seq.pro_recid
    no-error.

  if not available DICTDB._Sequence
   then do:  
    if SESSION:BATCH-MODE and logfile_open
     then put stream logfile unformatted  "NEW" at 60 skip.

    create DICTDB._Sequence.
    assign
      DICTDB._Sequence._Db-Recid    = drec_db
      DICTDB._Sequence._Seq-Name    = s_ttb_seq.pro_name.
    end.
   else if SESSION:BATCH-MODE and logfile_open
     then put stream logfile unformatted skip.
  
   assign
     DICTDB._Sequence._Seq-Incr    = s_ttb_seq.ds_incr
     DICTDB._Sequence._Seq-Init    = s_ttb_seq.ds_min
     DICTDB._Sequence._Seq-Max     = s_ttb_seq.ds_max
     DICTDB._Sequence._Seq-Min     = s_ttb_seq.ds_min
     DICTDB._Sequence._Cycle-ok    = s_ttb_seq.ds_cycle
     DICTDB._Sequence._Seq-Misc[1] = s_ttb_seq.ds_name
     DICTDB._Sequence._Seq-Misc[2] = s_ttb_seq.ds_user
     DICTDB._Sequence._Seq-misc[3] = ( if can-do(odbtyp,user_dbtype)
                                        then s_ttb_seq.ds_spcl
                                        else DICTDB._Sequence._Seq-misc[3]
                                     )
     DICTDB._Sequence._Seq-misc[8] = ( if user_dbtype = "ORACLE"
                                        then s_ttb_seq.ds_spcl
                                        else DICTDB._Sequence._Seq-misc[8]
                                     ).
END.

/*------------------------------ Tables ----------------------------*/  

for each gate-work
  where gate-work.gate-slct = TRUE:

  if  gate-work.gate-type = "SEQUENCE" 
   or gate-work.gate-type = "PROGRESS" then next.
  
  for each s_ttb_tbl
    where recid(gate-work) = s_ttb_tbl.gate-work:

    /* just in case some garbage left over */
    for each w_field:       delete w_field.         end.
    for each w_index:       delete w_index.         end.
    for each w_index-field: delete w_index-field.   end.

    if TERMINAL <> "" and NOT batch_mode
     then DISPLAY 
        s_ttb_tbl.ds_name  @ msg[1]
        s_ttb_tbl.pro_name @ msg[2]
        WITH FRAME ds_make.

    if SESSION:BATCH-MODE and logfile_open
     then put stream logfile unformatted
       s_ttb_tbl.ds_type at 15 
       (s_ttb_tbl.ds_user + "." + s_ttb_tbl.ds_name) at 30.

    if s_ttb_tbl.pro_recid <> ?
     then find first DICTDB._File
        where RECID(DICTDB._File)        = s_ttb_tbl.pro_recid
        no-error.
    else if user_dbtype = "ORACLE"
     and s_ttb_tbl.ds_msc21 <> ?
     and s_ttb_tbl.ds_msc21 <> "" then
      DO:
        ASSIGN for_name = s_ttb_tbl.ds_name.
        IF for_name begins '"' then /* OE00170417: string may be quoted */
           ASSIGN for_name = TRIM(s_ttb_tbl.ds_name,'"').
        find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and ( DICTDB._File._For-name     = s_ttb_tbl.ds_name
              OR DICTDB._File._For-name  = for_name )/* OE00170417:string may be quoted*/
        and   DICTDB._File._For-owner    = s_ttb_tbl.ds_user
        and   DICTDB._File._Fil-misc2[8] = s_ttb_tbl.ds_spcl
        and   DICTDB._File._Fil-misc2[1] = s_ttb_tbl.ds_msc21
        no-error.
     END.
    else if user_dbtype = "ORACLE" then
     DO:
        ASSIGN for_name = s_ttb_tbl.ds_name.
        IF for_name begins '"' then /* OE00170417: string may be quoted */
           ASSIGN for_name = TRIM(s_ttb_tbl.ds_name,'"').
        find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and ( DICTDB._File._For-name     = s_ttb_tbl.ds_name
              OR DICTDB._File._For-name  = for_name )/* OE00170417:string may be quoted*/
        and   DICTDB._File._For-owner    = s_ttb_tbl.ds_user
        and   DICTDB._File._Fil-misc2[8] = s_ttb_tbl.ds_spcl
        no-error.
     END.
    else if can-do(odbtyp,user_dbtype)
     then find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and   DICTDB._File._For-name     = s_ttb_tbl.ds_name
        and   DICTDB._File._For-owner    = s_ttb_tbl.ds_user
        and   DICTDB._File._Fil-misc2[1] = s_ttb_tbl.ds_spcl
        no-error.
     else find first DICTDB._File
        where DICTDB._File._Db-Recid     = drec_db
        and   DICTDB._File._For-name     = s_ttb_tbl.ds_name
        and   DICTDB._File._For-owner    = s_ttb_tbl.ds_user
        no-error.
    assign
      oldf         = available DICTDB._File
      tab_recidNew = ""
      tab_recidOld = "".

  
    assign tab_PrimeIdx = ?.


/*---------------------- SAVE CURRENT VALUES -----------------------*/

    if oldf
     then do:  /* retain all file, index and field-information */

      if DICTDB._File._Frozen = TRUE
       then do:
        run error_handling(10, DICTDB._File._File-name, "").
        next.
        end.
    
      for each DICTDB._Constraint of  DICTDB._File:
         for each DICTDB._Constraint-Keys WHERE DICTDB._Constraint-Keys._Con-Recid  = RECID(DICTDB._constraint):
           delete DICTDB._Constraint-Keys.
         end.  
         delete DICTDB._Constraint.
      end.

      for each DICTDB._Index of DICTDB._File:     /*---- Indexes -----*/
      
        for each DICTDB._Index-field of DICTDB._Index:
          find first DICTDB._Field of DICTDB._Index-field.
          create w_index-field.
          assign
            w_index-field.pro_Abbreviate = DICTDB._index-field._Abbreviate
            w_index-field.pro_Ascending  = DICTDB._index-field._Ascending
            w_index-field.pro_For-name   = DICTDB._field._For-name
            w_index-field.pro_For-type   = DICTDB._field._For-type
            w_index-field.pro_idx-num    = DICTDB._index._idx-num   
            w_index-field.pro_Index-Seq  = DICTDB._index-field._Index-Seq
            w_index-field.pro_Unsorted   = DICTDB._index-field._Unsorted.
          delete DICTDB._Index-field.
          end.  /* for each DICTDB._Index-Field */
          
        if DICTDB._File._Prime-Index = RECID(DICTDB._Index) 
         then assign
          tab_PrimeIdx = DICTDB._Index._Index-name
          tab_PIForNum = DICTDB._index._idx-num.
        create w_index.
        assign
          w_index.pro_active     = DICTDB._index._active  
          w_index.pro_Desc       = DICTDB._index._Desc  
          w_index.pro_For-Name   = DICTDB._index._For-Name  
          w_index.pro_idx-num    = DICTDB._index._idx-num  
          w_index.pro_Index-Name = DICTDB._index._Index-Name  
          w_index.pro_WordIdx    = DICTDB._index._WordIdx  
          w_index.pro_Unique     = DICTDB._index._Unique
          tab_recidOld           = ( if DICTDB._index._I-misc2[1] begins "r"
                                      then DICTDB._index._For-Name
                                    else tab_recidOld
                                 ). 
        delete DICTDB._Index.
        
        end.  /* for each DICTDB._Index */
   
      for each DICTDB._Field OF DICTDB._File:     /*----- fields -----*/
          ASSIGN fld-dif = FALSE.
          CREATE w_field.
          assign
            w_field.ds_Name      = DICTDB._Field._For-name
            w_field.ds_Type      = DICTDB._Field._For-type
            w_field.pro_Can-Read = DICTDB._Field._Can-Read
            w_field.pro_Can-Writ = DICTDB._Field._Can-Write
            w_field.pro_Col-lbl  = DICTDB._Field._Col-label
            w_field.pro_Decimals = DICTDB._Field._Decimals
            w_field.pro_Desc     = DICTDB._Field._Desc
            w_field.pro_type     = DICTDB._Field._Data-type
            w_field.pro_fld-case = DICTDB._Field._Fld-case
            w_field.pro_Format   = DICTDB._Field._Format
            w_field.pro_Help     = DICTDB._Field._Help
            w_field.pro_Initial  = DICTDB._Field._Initial
            w_field.pro_Label    = DICTDB._Field._Label
            w_field.pro_Name     = DICTDB._Field._Field-name
            w_field.pro_Order    = DICTDB._Field._Order
            w_field.pro_Valexp   = DICTDB._Field._Valexp
            w_field.pro_Valmsg   = DICTDB._Field._Valmsg.

        RUN delete-field.
        end.   /* for each DICTDB._Field OF DICTDB._File */
      
      assign
/*      tab_name     = DICTDB._File._File-name  */
        tab_Can-Crea = DICTDB._File._Can-Create
        tab_Can-Dele = DICTDB._File._Can-Delete
        tab_Can-Read = DICTDB._File._Can-Read
        tab_Can-Writ = DICTDB._File._Can-Write
        tab_Desc     = DICTDB._File._Desc
        tab_Dump-nam = DICTDB._File._Dump-name
        tab_Hidden   = DICTDB._File._Hidden
        tab_Valexp   = DICTDB._File._Valexp
        tab_Valmsg   = DICTDB._File._Valmsg
        tab_File-Label = DICTDB._File._File-Label.
	
      RUN delete-file.

      end.     /* retain all file, index and field-information */

/*--------------------------- CREATION -----------------------------*/

    RUN create-file (INPUT s_ttb_tbl.pro_name).
/*                                                      ORA    others
 *                                                     pro/ds  pro/ds
 * s_ttb_tbl.ds_recid > 0 -> progress_recid             # / ?   # / ?
 *                    = 0 -> use nativ rowid            ? /-#   # / ?
 *                    < 0 -> normal column for recid    ? /-#   # / ?
 */
 
    assign
      l_pro_recid                = ( if     user_dbtype         = "ORACLE"
                                        and s_ttb_tbl.ds_recid <= 0
                                        then ? /* no progress_recid */
                                        else s_ttb_tbl.ds_recid
                                   )
      l_ds_recid                 = ( if l_pro_recid = ?
                                        then s_ttb_tbl.ds_recid * -1
                                        else ?
                                   )
      DICTDB._File._File-Name    = s_ttb_tbl.pro_name
      DICTDB._File._Desc         = s_ttb_tbl.pro_desc
      DICTDB._File._Db-recid     = drec_db
      DICTDB._File._ianum        = def-ianum
      DICTDB._File._Fil-misc1[1] = l_pro_recid /* might change */
      DICTDB._File._Fil-misc1[2] = s_ttb_tbl.ds_rowid /* might change */
      DICTDB._File._Fil-misc1[3] = s_ttb_tbl.ds_msc13
      DICTDB._File._Fil-misc1[4] = l_ds_recid
      DICTDB._File._Fil-misc2[1] = ( if can-do(odbtyp,user_dbtype)
                                      then s_ttb_tbl.ds_spcl /* qualifier */
                                      else s_ttb_tbl.ds_msc21
                                   )
      DICTDB._File._Fil-misc2[2] = s_ttb_tbl.ds_msc22
      DICTDB._File._Fil-misc2[3] = s_ttb_tbl.ds_msc23 /* might change */
      DICTDB._File._Fil-misc2[4] = s_ttb_tbl.ds_msc24
      DICTDB._File._Fil-misc2[5] = s_ttb_tbl.ds_msc25 /* FORCESEEK */
      DICTDB._File._Fil-misc2[8] = ( if can-do("ORACLE",user_dbtype)
                                      then s_ttb_tbl.ds_spcl /* db-link */
                                      else DICTDB._File._Fil-misc2[8]
                                   )
      DICTDB._File._For-type     = s_ttb_tbl.ds_type
      DICTDB._File._For-owner    = s_ttb_tbl.ds_user
      DICTDB._File._For-name     = s_ttb_tbl.ds_name.
      DICTDB._File._Fil-misc1[5] = s_ttb_tbl.ds_msc15.
      DICTDB._File._Fil-misc1[6] = s_ttb_tbl.ds_msc16. /* RECID Indicator */
    if oldf
     then assign
      DICTDB._File._Can-Create   = tab_Can-Crea
      DICTDB._File._Can-Read     = tab_Can-Read
      DICTDB._File._Can-Write    = tab_Can-Writ
      DICTDB._File._Can-Delete   = tab_Can-Dele
      DICTDB._File._Desc         = ( if   tab_Desc <> ""
                                      and tab_Desc <> ?
                                      then tab_Desc
                                      else DICTDB._File._Desc
                                   )
      DICTDB._File._Valexp       = tab_Valexp
      DICTDB._File._Valmsg       = tab_Valmsg
      DICTDB._File._Hidden       = tab_Hidden
      DICTDB._File._Dump-name    = tab_Dump-nam
      DICTDB._File._File-Label   = tab_File-Label.
      


/*---------------------------- FIELDS ------------------------------*/
    
    find last w_field where w_field.pro_order > 0 no-error.
    if available w_field
     then assign l_order-max = w_field.pro_order + 10.
     else assign l_order-max = 0.

    for each s_ttb_fld where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):
      IF s_ttb_fld.ds_name BEGINS "SYS_NC" THEN NEXT.
      /* if the main-part of date-field is of type character we don't
       * need the time-part, so we skip it... Same for datetime/tz.
       */
      IF lookup(s_ttb_fld.ds_type,l_chda-types) <> 0
           and s_ttb_fld.pro_type  =  "integer"
           and can-find( w_field where w_field.ds_name  = s_ttb_fld.ds_name
                                   and (w_field.pro_type = "character"  OR
                                        w_field.pro_type BEGINS "datetime"))
       then next.

      /* we need to find the w_field by name PLUS type because of
       * date-time fields....
       */
      if lookup(s_ttb_fld.ds_type,l_chda-types) <> 0
       then find first w_field where w_field.ds_name = s_ttb_fld.ds_name
                                 and lookup(w_field.ds_type,"character,date,datetime,datetime-tz") <> 0 no-error.
      else find first w_field where w_field.ds_name = s_ttb_fld.ds_name
                                and w_field.ds_type = s_ttb_fld.ds_type no-error.
      if not available w_field then 
        find first w_field where w_field.ds_name = s_ttb_fld.ds_name no-error.

      /* OE00170417: name may be quoted for ORACLE */
      if not available w_field and user_dbtype = "ORACLE" and s_ttb_fld.ds_name begins '"' then 
         find first w_field where w_field.ds_name = TRIM(s_ttb_fld.ds_name,'"') no-error.

      if available w_field and w_field.ds_type begins "date"
                           and s_ttb_fld.pro_type = "integer" THEN DO:
         IF w_field.pro_type = "date" THEN
            release w_field.
         ELSE IF w_field.pro_type BEGINS "datetime" THEN
             /* don't need time portion if mapping to datetime/tz */
             NEXT.
      END.

      IF AVAILABLE w_field  THEN do:
          IF w_field.pro_type = "character" AND w_Field.pro_type <> s_ttb_fld.pro_type THEN
          DO:
              /* for MSS, character/blob are supported mappings for varbinary */
              IF user_dbtype NE "MSS" OR s_ttb_fld.pro_type NE "BLOB" THEN
                 ASSIGN fld-dif = TRUE.
          END.
          ELSE IF s_ttb_fld.pro_type = "character" AND w_Field.pro_type <> s_ttb_fld.pro_type THEN DO:
              /* for MSS, character/blob are supported mappings for varbinary */
              IF user_dbtype NE "MSS" OR w_Field.pro_type NE "BLOB" THEN
                 ASSIGN fld-dif = TRUE.
          END.
          /* OE00168850 - check for foreign type change for timestamp */
          ELSE IF (LOOKUP(w_field.ds_type,"date,timestamp") <> 0 OR
                   LOOKUP(s_ttb_fld.ds_type,"date,timestamp") <> 0)
                   AND s_ttb_fld.ds_type <> w_field.ds_Type THEN
               ASSIGN fld-dif = TRUE.

      END.
          
      IF NOT AVAILABLE w_field AND s_ttb_fld.pro_type = "date" then
          ASSIGN s_ttb_fld.pro_frmt = "99/99/99".

      CREATE DICTDB._Field.
      ASSIGN DICTDB._Field._Desc   = ( if available w_field
                                          and w_field.pro_desc <> ""
                                          and w_field.pro_desc <> ?
                                          then w_field.pro_desc
                                          else s_ttb_fld.pro_desc
                                      )
        DICTDB._Field._Data-type   = ( IF AVAILABLE w_field AND NOT fld-dif THEN w_field.pro_type
                                        ELSE s_ttb_fld.pro_type
                                      )
        DICTDB._Field._Extent       = s_ttb_fld.pro_extnt
        DICTDB._Field._Field-Name   = ( if available w_field
                                          then w_field.pro_name
                                          else s_ttb_fld.pro_name
                                      )
        DICTDB._Field._File-recid   = RECID(DICTDB._File)
        DICTDB._Field._Fld-Case     = s_ttb_fld.pro_case
        DICTDB._Field._Fld-misc1[1] = s_ttb_fld.ds_prec
        DICTDB._Field._Fld-misc1[2] = s_ttb_fld.ds_scale
        DICTDB._Field._Fld-misc1[3] = s_ttb_fld.ds_lngth
        DICTDB._Field._Fld-misc1[4] = s_ttb_fld.ds_radix
        DICTDB._Field._Fld-misc1[5] = s_ttb_fld.ds_shd#
        DICTDB._Field._Fld-misc1[7] = s_ttb_fld.ds_msc17
        DICTDB._Field._Fld-misc2[2] = ( if user_dbtype = "ORACLE"
                                        then s_ttb_fld.ds_shdn
                                        else DICTDB._Field._Fld-misc2[2]
                                      )
        DICTDB._Field._Fld-misc2[3] = s_ttb_fld.ds_msc23
        DICTDB._Field._Fld-misc2[4] = s_ttb_fld.ds_msc24
        DICTDB._Field._Fld-misc2[5] = ( if can-do(odbtyp,user_dbtype)
                                        then s_ttb_fld.ds_shdn
                                        else IF user_dbtype = "ORACLE" 
                                            THEN s_ttb_fld.ds_msc25 
                                            ELSE DICTDB._Field._Fld-misc2[5]
                                      )
        DICTDB._Field._Fld-misc2[6] = s_ttb_fld.ds_msc26
        DICTDB._Field._Fld-stoff    = s_ttb_fld.ds_stoff
        DICTDB._Field._Fld-stdtype  = s_ttb_fld.ds_stdtype
        DICTDB._Field._For-Itype    = s_ttb_fld.ds_Itype
        DICTDB._Field._For-Name     = s_ttb_fld.ds_name
        DICTDB._Field._For-type     = s_ttb_fld.ds_type
        DICTDB._Field._For-Allocated = ( if user_dbtype = "ORACLE"
                                         THEN s_ttb_fld.ds_allocated
                                         ELSE DICTDB._Field._For-Allocated
                                       )
        DICTDB._Field._Mandatory    = s_ttb_fld.pro_mand
        DICTDB._Field._Decimals     = s_ttb_fld.pro_dcml
        DICTDB._Field._Order        = ( if available w_field
                                         then w_field.pro_order
                                         else l_order-max 
                                            + s_ttb_fld.pro_order
                                      )       
        DICTDB._Field._Format       = ( IF AVAILABLE w_field AND NOT fld-dif THEN w_field.pro_format 
                                        ELSE s_ttb_fld.pro_frmt
                                      )
        DICTDB._Field._Initial      = ( IF DICTDB._Field._Data-type = "CLOB" THEN ? /* TEMPORARY */
                                        ELSE IF AVAILABLE w_field AND NOT fld-dif THEN w_field.pro_init
                                        ELSE s_ttb_fld.pro_init
                                      )
        s_ttb_fld.fld_recid         = RECID(DICTDB._Field).
     
      IF user_dbtype = "ODBC" OR user_dbtype = "MSS" THEN DO:
        IF DICTDB._Field._Mandatory THEN
          ASSIGN DICTDB._Field._Fld-Misc2[2] = "N".
        ELSE
          ASSIGN DICTDB._Field._Fld-Misc2[2] = "Y".
      END.

      if (user_dbtype = "ODBC" AND is_as400db) THEN
       ASSIGN
        DICTDB._Field._Label   = ( if available w_field
                                          and w_field.pro_Label <> ""
                                          and w_field.pro_Label <> ?
                                          then w_field.pro_Label
                                          else s_ttb_fld.pro_desc
                                      )
        DICTDB._Field._Col-Label   = ( if available w_field
                                          and w_field.pro_Col-lbl <> ""
                                          and w_field.pro_Col-lbl <> ?
                                          then w_field.pro_Col-lbl
                                          else s_ttb_fld.pro_desc
                                      ).

      IF user_dbtype = "MSS" AND DICTDB._Db._Db-misc1[1] = 1 
                             AND DICTDB._Field._Data-type = "character" THEN
        ASSIGN DICTDB._Field._Fld-Case  = FALSE.
                                                        
      IF user_dbtype = "ORACLE" THEN DO:
        CASE DICTDB._Field._Data-type:
          WHEN "CHARACTER" THEN DO:
            IF DICTDB._Field._For-type = "ROWID" THEN
               DO:
                 ASSIGN DICTDB._Field._Can-Write = ""
                        DICTDB._Field._For-Maxsize = 18.
               END.
            IF DICTDB._Field._For-type = "Char" OR
               DICTDB._Field._For-type = "VarChar" OR
               DICTDB._Field._For-type = "VarChar2" 
                OR DICTDB._Field._For-type = "NChar" 
                 OR DICTDB._Field._For-type = "NVarChar2"  THEN
                 ASSIGN DICTDB._Field._For-Maxsize = DICTDB._Field._Fld-Misc1[3].
          END.
          WHEN "INTEGER" OR WHEN "LOGICAL" THEN DO:
            IF DICTDB._Field._For-type = "NUMBER" OR
               DICTDB._Field._For-type = "LOGICAL" THEN
                 ASSIGN DICTDB._Field._For-Maxsize = 10.
          END.       
          WHEN "DECIMAL" THEN DO:
            IF DICTDB._Field._For-type = "DECIMAL" THEN DO:
              IF DICTDB._Field._Fld-misc1[2] <> 0 OR DICTDB._Field._Fld-misc1[2] <> ?
                THEN ASSIGN DICTDB._Field._For-Maxsize = DICTDB._Field._Fld-misc1[1] + 1.
            END.
            ELSE
                ASSIGN DICTDB._Field._For-Maxsize = DICTDB._Field._Fld-misc1[1].
          END.
          WHEN "INT64" THEN DO:
              IF DICTDB._Field._For-type = "NUMBER" THEN
                 ASSIGN DICTDB._Field._For-Maxsize = 19.
          END.
          WHEN "RAW" THEN 
            IF DICTDB._Field._For-type = "RAW" THEN
              ASSIGN DICTDB._Field._For-Maxsize = DICTDB._Field._Fld-misc1[1].
          WHEN "CLOB" THEN DO:
                ASSIGN DICTDB._Field._Charset = DICTDB._Db._Db-xl-name
                    DICTDB._Field._Collation = (IF DICTDB._DB._Db-coll-name <> ? THEN DICTDB._DB._Db-coll-name
                                                ELSE SESSION:CPCOLL)
                    DICTDB._Field._Attributes1 = 1. /* should always be 1 (i.e dbcodepage) */
            END.
        END CASE.      
      END.

      if available w_field then do:            
        if (
         (   can-do(l_char-types + "," + l_chda-types               ,s_ttb_fld.ds_type)
         AND can-do("character"              ,w_field.pro_type) )
         OR
         (   can-do(l_chda-types                                    ,s_ttb_fld.ds_type) 
         AND can-do("character,date,datetime,datetime-tz",w_field.pro_type) )
         OR
         (   can-do(l_chda-types + "," + l_date-types               ,s_ttb_fld.ds_type) 
         AND can-do("date"                   ,w_field.pro_type) )
         OR
         (   can-do(l_dcml-types + "," + l_deil-types + "," + l_dein-types,s_ttb_fld.ds_type) 
         AND can-do("decimal"                ,w_field.pro_type) )
         OR
         (   can-do(l_deil-types                                    ,s_ttb_fld.ds_type) 
         AND can-do("decimal,integer,logical",w_field.pro_type) )
         OR
         (   can-do(l_deil-types + "," + l_dein-types               ,s_ttb_fld.ds_type) 
         AND can-do("decimal,integer"        ,w_field.pro_type) )
         OR
         (   can-do(l_deil-types + "," + l_dein-types + "," + l_intg-types,s_ttb_fld.ds_type) 
         AND can-do("integer"                ,w_field.pro_type) )
         OR
         (   can-do(l_deil-types + "," + l_logi-types               ,s_ttb_fld.ds_type) 
         AND can-do("logical"                ,w_field.pro_type) )
            )
         then ASSIGN DICTDB._Field._Decimals  = w_field.pro_decimals.

        assign
          DICTDB._Field._Can-Read  = w_field.pro_Can-Read
          DICTDB._Field._Can-Write = w_field.pro_Can-Writ
          DICTDB._Field._Col-label = w_field.pro_Col-lbl
          DICTDB._Field._Fld-case  = DICTDB._Field._Fld-case
                                  or ( DICTDB._Field._Data-type = "character" 
                                         AND w_field.pro_Fld-case )
                  /* could change lateron!
                   * In case there's a shadow-column for this field
                   * _Fld-case will get set to FALSE in _odb_mak.p
                   */
          DICTDB._Field._Help      = w_field.pro_Help
          DICTDB._Field._Label     = w_field.pro_Label
          DICTDB._Field._Mandatory = ( DICTDB._Field._Mandatory
                                         OR w_field.pro_Mandatory )
          DICTDB._Field._Valexp    = w_field.pro_Valexp
          DICTDB._Field._Valmsg    = w_field.pro_Valmsg.
      
        end.  /* available w_field */

      end.  /* for each s_ttb_fld */

/* since we keep adding fields to the end of the file, the order-numbers
 * will increase pretty high, so we reorder the new added fields in a
 * way that garanties to have just 10 as spacing
 */
    find last DICTDB._Field of DICTDB._File
      where DICTDB._Field._Order >= l_order-max
      no-lock no-error.
    if available DICTDB._Field
     and l_order-max > 0
     then do:  /* renumber new fields */

      /* calculate the number to shift new fields back */
      assign
        i    = DICTDB._Field._Order + 10 - l_order-max
        indn = 10.
      for each DICTDB._Field of DICTDB._File
        where DICTDB._Field._Order >= l_order-max:
        assign indn = indn + 10.
        end.
      assign i = max(i, indn).

      if indn > 20
       then do:  /* more than one new fields */

        /* move new-fields back, to generate enough free space */
        for each DICTDB._Field of DICTDB._File
          where DICTDB._Field._Order >= l_order-max
          and   DICTDB._Field._Order < i + l_order-max:
          assign
            DICTDB._Field._Order = i + DICTDB._Field._Order.
          end.

        /* move new-fields forward, giving them their new, real number */
        assign indn = 0.
        for each DICTDB._Field of DICTDB._File
          where DICTDB._Field._Order > i + l_order-max:
          assign
            DICTDB._Field._Order = l_order-max + indn
            indn                 = indn + 10.
          end.

        end.     /* more than one new fields */

       else do:  /* only one new fields */
        find first DICTDB._Field of DICTDB._File
          where DICTDB._Field._Order >= l_order-max.
        assign
          DICTDB._Field._Order = l_order-max + 10.
        end.     /* only one new fields */
        
      end.     /* renumber new fields */


/*----------------------------- INDEXES ------------------------------*/

    for each s_ttb_idx
      where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
      by    s_ttb_idx.ds_name:

      IF (user_dbtype = "MSS" OR user_dbtype = "ODBC") AND
        ds_name MATCHES "*progress_recid*"  THEN
       NEXT.

      if user_dbtype = "SYB"
       then do:
        find first w_index
          where w_index.pro_for-name = s_ttb_idx.ds_name
                                     + STRING(s_ttb_idx.pro_Idx#)
          no-error.
        if not available w_index
         then find first w_index
          where w_index.pro_for-name = s_ttb_idx.ds_name
                                     + STRING(w_index.pro_idx-num)
          no-error.
        end.
       else find first w_index
        where w_index.pro_for-name = s_ttb_idx.ds_name
        no-error.

      /* OE00170417 name may be quoted for ORACLE */
      if not available w_index and user_dbtype = "ORACLE" and s_ttb_idx.ds_name begins '"' then 
          find first w_index  where w_index.pro_for-name = TRIM(s_ttb_idx.ds_name,'"')  no-error.

    /* We have two index-lists with each unique names within itself.
     * However, these two list are connected by foreign-name and not by 
     * PROGRESS-name!
     * When creating the indexes we go thru all s_ttb-idx but give the 
     * index the name of the w_index (we want to retain as much as
     * possible).
     * There are two possible problem-cases:
     * a) we don't find a corresponding w_index record, however
     *    there is another one with this progress-name
     * b) we do find the corresponding w_index record, but another
     *    s_ttb_idx uses the w_index's progress name
     * in both cases we have to switch the names
     */
      if not available w_index
       then do:  /* check if s_ttb_idx.pro_name is used in other w_index */
     
        assign i = 1.
        find first w_index
          where w_index.pro_index-name = s_ttb_idx.pro_name
          no-error.
        repeat while available w_index:  /* potential problem */

        /* find corresponding l_ttb_idx */
          if user_dbtype = "SYB"
           then do:
            find first l_ttb_idx
              where l_ttb_idx.ds_name 
                  + STRING(s_ttb_idx.pro_Idx#) = w_index.pro_for-name
              no-error.
            if not available l_ttb_idx
             then find first l_ttb_idx
              where l_ttb_idx.ds_name 
                  + STRING(w_index.pro_idx-num) = w_index.pro_for-name
              no-error.
            end.
           else find first l_ttb_idx
              where l_ttb_idx.ds_name  = w_index.pro_for-name
              no-error.

        /* ev. switch progress-names */
          if available l_ttb_idx
           then do:  /* switch names */
            assign
              user_env[1]        = l_ttb_idx.pro_name
              /* w_index.pro_index-name := s_ttb_idx.pro_name */
              s_ttb_idx.pro_name = ? 
              l_ttb_idx.pro_name = w_index.pro_index-name
              s_ttb_idx.pro_name = user_env[1].
          /* another potential names-collision? */
            find first w_index
              where w_index.pro_index-name = s_ttb_idx.pro_name
              no-error.
            end.     /* switch names */

          else if w_index.pro_For-name = ?
           then do:  /* user-defined index exists -> change name */
            assign
             s_ttb_idx.pro_name = ( if i > 9
                                     then substring
                                      (s_ttb_idx.pro_name
                                      ,1
                                      ,length(s_ttb_idx.pro_name
                                             ,"character"
                                             ) - 3
                                      ,"character"
                                      ) + string(0 - i,"-99")
                                    else if i > 1
                                     then substring
                                      (s_ttb_idx.pro_name
                                      ,1
                                      ,length(s_ttb_idx.pro_name
                                             ,"character"
                                             ) - 2
                                      ,"character"
                                      ) + string(0 - i,"-9")
                                     else s_ttb_idx.pro_name
                                        + string(0 - i,"-9")
                                    )
             i = i + 1.
          /* another potential names-collision? */
            find first w_index
              where w_index.pro_index-name = s_ttb_idx.pro_name
              no-error.
            end.     /* user-defined index exists -> change name */

           else release w_index.

          end.     /* repeat while available w_index:  potential problem */
        
        end.     /* check if s_ttb_idx.pro_name is used in other w_index */

       else do:  /* check if w_index' name gets used by another s_ttb_idx */

        find first l_ttb_idx
          where l_ttb_idx.ttb_tbl  = RECID(s_ttb_tbl)
          and   l_ttb_idx.pro_name = w_index.pro_index-name
          and   RECID(l_ttb_idx)  <> RECID(s_ttb_idx)
          no-error.

        if available l_ttb_idx
         then assign 
           user_env[1]        = s_ttb_idx.pro_name
           /* w_index.pro_index-name := l_ttb_idx.pro_name */
           l_ttb_idx.pro_name = ? 
           s_ttb_idx.pro_name = w_index.pro_index-name
           l_ttb_idx.pro_name = user_env[1].

        end.     /* check if w_index' name gets used by another s_ttb_idx */

      create DICTDB._Index.
      assign
        DICTDB._Index._Index-Name = ( if available w_index
                                       then w_index.pro_index-name
                                       else s_ttb_idx.pro_name
                                    )
        DICTDB._Index._File-recid = RECID(DICTDB._File)
        DICTDB._Index._ianum      = def-ianum
        DICTDB._Index._Unique     = ( s_ttb_idx.pro_uniq
                                       or  ( AVAILABLE w_index 
                                       and   w_index.pro_unique )
                                    )
        DICTDB._Index._For-name   = s_ttb_idx.ds_name 
                                  + ( if user_dbtype = "SYB"
                                        then string(s_ttb_idx.pro_Idx#)
                                        else ""
                                    )
        DICTDB._Index._Idx-num    = s_ttb_idx.pro_idx#
        DICTDB._Index._Active     = s_ttb_idx.pro_actv
        DICTDB._Index._Desc       = ( if available w_index
                                       then w_index.pro_Desc
                                       else ""
                                    )
        DICTDB._Index._I-misc2[1] = s_ttb_idx.ds_msc21.

      if s_ttb_idx.ds_msc21 begins "r" then do:
       assign  tab_recidNew = s_ttb_idx.ds_name.
         /* OE00170417: name may be quoted for ORACLE */
         if user_dbtype = "ORACLE" and tab_recidNew begins '"' then do:
            if QUOTER(tab_recidOld) = tab_recidNew then
              tab_recidOld = QUOTER(tab_recidOld).
         end.
      end.



      if available w_index
       then do:  /* available w_index */
        
        /* give warning if name changed or uniqueness weirdness */
        if DICTDB._Index._Index-name <> w_index.pro_index-name
         then run error_handling
                ( INPUT 17,
                  INPUT DICTDB._Index._Index-name,
                  INPUT w_index.pro_index-name
                  ).
        if w_index.pro_unique       /* index used to be unique but is */
         and not s_ttb_idx.pro_uniq /* in foreign schema not anymore  */
         then do:
          run error_handling
                ( INPUT 18,
                  INPUT DICTDB._Index._Index-name,
                  INPUT string(w_index.pro_unique)
                  ).
          run error_handling(7, "", "").
          end.
        
        /* save index specifications */
        if w_index.pro_for-name = tab_recidOld
         then assign
           tab_RILevel  = s_ttb_idx.hlp_level
           tab_RIfstoff = s_ttb_idx.hlp_fstoff
           tab_RIidx#   = s_ttb_idx.pro_idx#
           tab_RImsc23  = s_ttb_idx.hlp_msc23.
        
        /* delete this w_index record */
        for each w_index-field
          where  w_index-field.pro_idx-num = w_index.pro_idx-num:
          DELETE w_index-field.
          end.
        DELETE w_index.  
        end.     /* available w_index */
 
/*-------------------------- INDEX-FIELDS --------------------------*/

      for each s_ttb_idf
        where s_ttb_idf.ttb_idx = RECID(s_ttb_idx):
      
        find first s_ttb_fld
          where RECID(s_ttb_fld) = s_ttb_idf.ttb_fld NO-ERROR.
        find first DICTDB._Field
          where RECID(DICTDB._Field) = s_ttb_fld.fld_recid NO-ERROR.
        IF NOT AVAILABLE DICTDB._Field AND s_ttb_fld.ds_name BEGINS "SYS_NC" THEN DO:

          FIND FIRST DICTDB._Field WHERE DICTDB._Field._File-recid = DICTDB._Index._File-recid
                                     AND DICTDB._Field._Field-name = s_ttb_fld.defaultname NO-ERROR.
        END.
        
        IF AVAILABLE DICTDB._Field THEN DO:
          CREATE DICTDB._Index-field.
          assign
            DICTDB._Index-Field._Ascending   = s_ttb_idf.pro_asc
            DICTDB._Index-Field._Abbreviate  = s_ttb_idf.pro_abbr
            DICTDB._Index-Field._Field-recid = RECID(DICTDB._Field)
            DICTDB._Index-Field._Index-recid = RECID(DICTDB._Index)
            DICTDB._Index-Field._Index-Seq   = s_ttb_idf.pro_order.
        END.
       end.   /* for each s_ttb_idf */

      end.   /* for each s_ttb_idx */
  

/*--------------------------- RECID-INDEX ----------------------------*/

    if  ( DICTDB._File._Fil-misc1[1] <= 0
     or   DICTDB._File._Fil-misc1[1]  = ? )
     and NOT can-do("PROCEDURE,BUFFER",DICTDB._File._For-Type)
     then do:  /* no progress_recid & RECID-Index needed
                *     -> check indexes for ROWID usability
                */   
    /* if there was a previously selected index, we reselect it. However
     * the foreign schema might have changed, so we give a warning, if
     * there is another index, which might fit better (i.e. has a lower
     * value in s_ttb_idx.level)
     */
    
      if tab_recidOld <> ""
       then do:  /* there was a previously selected index */

        if tab_recidOld <> tab_recidNew
         then do:  /* deselect new index, re-select old one */ 

          find first DICTDB._Index of DICTDB._File
            where DICTDB._Index._I-misc2[1] begins "r"
            no-error.
          if available DICTDB._Index
           then assign
            DICTDB._Index._I-misc2[1] = substring
                                        (DICTDB._Index._I-misc2[1]
                                        ,2
                                        ,-1
                                        ,"character"
                                        ).

          find first DICTDB._Index of DICTDB._File
            where DICTDB._Index._For-name = tab_recidOld
            no-error.
          if available DICTDB._Index
           then assign
            DICTDB._Index._I-misc2[1]  = "r" + DICTDB._Index._I-misc2[1]
            DICTDB._File._Fil-misc1[1] = tab_RIfstoff
            DICTDB._File._Fil-misc1[2] = tab_RIidx#
            DICTDB._File._Fil-misc2[3] = tab_RImsc23
            tab_recidNew               = tab_recidOld.

          end.     /* deselect new index, re-select old one */ 

        end.     /* there was a previously selected index */

      if  tab_recidNew <> ""
       then do:  /* found index to be selected */
        find first s_ttb_idx
          where s_ttb_idx.ttb_tbl   = RECID(s_ttb_tbl)
          and   s_ttb_idx.hlp_level < tab_RILevel
          and   s_ttb_idx.ds_name  <> tab_recidNew
          no-error.
        if available s_ttb_idx
         then do:  /* ev. message if prev. selected idx <> optimal */
          RUN error_handling(5, "", "").
          RUN error_handling(6, s_ttb_tbl.pro_name, "").
          end.     /* ev. message if prev. selected idx <> optimal */
        end.     /* found index to be selected */
      
       else do:  /* found no index to be selected */

        RUN error_handling
          ( INPUT 3,
            INPUT DICTDB._File._File-name,
            INPUT DICTDB._File._For-Owner
          ).
        end.    /* found no index to be selected */
          
      end.     /* no progress_recid  & RECID-Index needed
                *     -> check indexes for ROWID usability
                */
               

  /* message if no recid-index found */
    if has_id_ix /* PROGRESS-RECID-field -> reset recid-info of all indexes */
     then for each DICTDB._Index of DICTDB._File:
        assign DICTDB._Index._I-misc2[1] = ?.
        end.         /* PROGRESS-RECID-field -> reset recid-info of all indexes */
    
    /* now attempt to set primary index to same index it used to use */   
    if oldf and tab_PrimeIdx <> ? then do:
      find first DICTDB._Index OF DICTDB._File
        where DICTDB._Index._Index-name = tab_PrimeIdx no-error.
      if available DICTDB._Index then
        DICTDB._File._Prime-Index = RECID(DICTDB._Index).
    end.
    run Field-Triggers. /* reassign field-triggers */


  /* delete all left-over, old, "foreign" indexes */
    for each w_index
      where w_index.pro_for-name <> ""
      AND   w_index.pro_for-name <> ?:
      for each w_index-field
        where  w_index-field.pro_idx-num = w_index.pro_idx-num:
        DELETE w_index-field.
        end.
      DELETE w_index.  
      end.


/*----------------------- USER-DEFINED-INDEX -------------------------*/

  /* find last used index-number */
    find last DICTDB._Index
      where DICTDB._Index._Idx-num > 0
      no-error.
    assign indn = ( if available DICTDB._Index
                      then DICTDB._Index._idx-num + 1
                      else 1
                  ).
                
  /* try to recreate all old, "USER-defined" indexes */
    for each w_index:

      assign scrap = true.
      for each w_index-field
        where  w_index-field.pro_idx-num = w_index.pro_idx-num
        while scrap = true:
        find first DICTDB._field of DICTDB._File
          where DICTDB._field._for-name = w_index-field.pro_for-name
          and   DICTDB._field._for-type = w_index-field.pro_for-type
          no-lock no-error.
        if not available DICTDB._field then assign scrap = false.
        end.
      
      if NOT scrap  
       then for each w_index-field  /* index not valid anymore */
        where  w_index-field.pro_idx-num = w_index.pro_idx-num: 
        delete w_index-field.
        end.

       else do:  /* retain index */

        assign user_env[1] = w_index.pro_index-name.
      RUN "prodict/gate/_gat_xlt.p"
            (FALSE,RECID(DICTDB._File),INPUT-OUTPUT user_env[1]).

        if user_env[1] <> w_index.pro_index-name
         then do:

          if s_1st-error = false
           then do:
            assign s_1st-error = true.
            output stream s_stm_errors to ds_upd.e.
            output stream s_stm_errors close.
            end.

          output stream s_stm_errors to ds_upd.e append.
          put stream s_stm_errors unformatted
            "Index name changed from " 
            w_index.pro_index-name " to " user_env[1]   skip.
          output stream s_stm_errors close.

          end.                            
         
        create DICTDB._Index.
        assign
          DICTDB._Index._Index-Name = user_env[1]
          DICTDB._Index._File-recid = RECID(DICTDB._File)
          DICTDB._Index._Unique     = w_index.pro_unique
          DICTDB._Index._For-name   = ""
          DICTDB._Index._Idx-num    = indn
          DICTDB._Index._Active     = w_index.pro_active
          DICTDB._Index._WordIdx    = w_index.pro_WordIdx
          DICTDB._Index._Desc       = w_index.pro_Desc
          indn                      = indn + 1
          i                         = 1.

        if tab_PIForNum = w_index.pro_idx-num
          then assign DICTDB._File._Prime-Index = RECID(DICTDB._Index).
     
        for each w_index-field  
          where  w_index-field.pro_idx-num = w_index.pro_idx-num: 
        
          find first DICTDB._field of DICTDB._File
            where DICTDB._field._for-name = w_index-field.pro_for-name
            and   DICTDB._field._for-type = w_index-field.pro_for-type
            no-lock no-error.
          create DICTDB._Index-field.
          assign
            DICTDB._Index-Field._Index-recid = RECID(DICTDB._Index)
            DICTDB._Index-Field._Index-Seq   = i
            DICTDB._Index-Field._Field-recid = RECID(DICTDB._Field)
            DICTDB._Index-Field._Ascending   = w_index-field.pro_Ascending
            DICTDB._Index-Field._Abbreviate  = w_index-field.pro_Abbreviate
            DICTDB._Index-Field._Unsorted    = w_index-field.pro_Unsorted
            i                            = i + 1.
          delete w_index-field.

          end.     /* for each w_index-field */
       
        end.     /* retain index */
       
      delete w_index.  
    
     end.  /* for each w_index */
        
     if user_dbtype = "ORACLE" THEN DO:
      /* if we get any errors on function index and no fields are created delete index */
       FOR EACH DICTDB._Index WHERE DICTDB._Index._File-recid = RECID(DICTDB._File):
         IF CAN-FIND(FIRST DICTDB._Index-field OF DICTDB._Index) THEN NEXT.
         ELSE
           DELETE DICTDB._Index.
       END.
     END.
      /* Make sure primary is unique if possible. */

    IF NOT oldf THEN DO:
      IF DICTDB._File._Prime-Index <> ? THEN 
        FIND DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._File._Prime-Index NO-ERROR.        
      IF AVAILABLE DICTDB._Index AND DICTDB._Index._Unique = FALSE THEN DO:      
        FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Unique = TRUE NO-ERROR.
        IF AVAILABLE DICTDB._Index THEN
          ASSIGN DICTDB._File._Prime-Index = RECID(DICTDB._Index).
      END.
    END.    
  end.  /* for each s_ttb_tbl of gate-work */
    
end. /* for each gate-work */

if NOT batch_mode
 then SESSION:IMMEDIATE-DISPLAY = no.

RUN adecomm/_setcurs.p ("").

find first DICTDB._File
  where DICTDB._File._Dump-name      =     ?
  and   NOT DICTDB._File._File-name BEGINS "_"
  no-error.
if available DICTDB._File then RUN "prodict/dump/_lodname.p".

if NOT batch_mode
 then HIDE FRAME ds_make NO-PAUSE.

if s_1st-error = true
 then do:   /* there are warnings or messages */
       
    if NOT batch_mode THEN DO:
    
        &IF "{&WINDOW-SYSTEM}" = "TTY" 
         &THEN 
          message err-msg[16]. 
         &ELSE
          message err-msg[16] view-as alert-box warning buttons ok.
         &ENDIF         
    END.
    ELSE IF logfile_open THEN
        PUT STREAM logfile UNFORMATTED " " SKIP err-msg[16] SKIP(2).

  end.      /* there are warnings or messages */

/* to make sure the next update starts a new ds_upd.e-file, reset flag 
assign s_1st-error = false.
*/

/*----------------------- CONSTRAINT -------------------------*/
/* OE00195067 BEGIN */
DEFINE BUFFER   CON_DICTDB         FOR DICTDB._Constraint.
DEFINE BUFFER   FIL_DICTDB         FOR DICTDB._File.
IF user_dbtype = "MSS" OR user_dbtype = "ORACLE" THEN DO:
num = 0.
FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Db-Recid = drec_db:
    IF DICTDB._Constraint._Con-Num > num 
     THEN ASSIGN num = DICTDB._Constraint._Con-Num. 
END.
 FOR EACH DICTDB._FIle WHERE DICTDB._FIle._Db-Recid = drec_db:
   FOR EACH s_ttb_con WHERE tab_name = DICTDB._File._File-Name:
   IF user_dbtype = "MSS" AND
        (const_name MATCHES "*progress_recid*"  OR const_name MATCHES "*DF__*") THEN
       NEXT.
     
      num = num + 1.
      IF cons_type = "D" OR cons_type = "C"
      THEN DO:
        FIND FIRST DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-Name = col_name NO-LOCK NO-ERROR.  
        CREATE DICTDB._constraint.
        ASSIGN        
        DICTDB._constraint._db-recid    = drec_db
        DICTDB._constraint._con-name    = const_name
        DICTDB._constraint._for-name    = const_name
        DICTDB._constraint._con-expr    = expre
        DICTDB._constraint._con-num     = num
        DICTDB._constraint._Field-Recid = RECID(DICTDB._Field)
        DICTDB._constraint._File-Recid  = RECID(DICTDB._FIle).
        
        IF cons_type = "D" THEN
          ASSIGN DICTDB._constraint._con-type = "D".
        ELSE IF cons_type = "C" THEN
          ASSIGN DICTDB._constraint._con-type = "C".
      END.
      ELSE IF cons_type = "PRIMARY KEY"
      THEN DO:
        IF oldf THEN DO:
             FIND FIRST DICTDB._Index OF DICTDB._File
                     WHERE DICTDB._Index._Index-Name = const_name NO-LOCK NO-ERROR.
             IF NOT AVAILABLE (DICTDB._Index) THEN DO:
                 const_name1  =  replace(const_name,"_","-") .
             END.
             ELSE DO:
               const_name1  = const_name.
             END.
         END.
         ELSE DO:
           const_name1  = const_name.
         END.
      
        IF NOT CAN-FIND (FIRST DICTDB._constraint OF DICTDB._File WHERE DICTDB._constraint._Con-Type = "P")
        THEN DO:
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = index_name NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (DICTDB._Index) THEN
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = "z" + const_name1 NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (DICTDB._Index) THEN 
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = const_name1 NO-LOCK NO-ERROR.
          
          CREATE DICTDB._constraint.
          ASSIGN        
          DICTDB._constraint._db-recid    = drec_db       
          DICTDB._constraint._con-name    = const_name1
          DICTDB._constraint._for-name    = const_name1
          DICTDB._constraint._Index-Recid = RECID(DICTDB._Index)
          DICTDB._constraint._File-Recid  = RECID(DICTDB._FIle)
          DICTDB._constraint._con-num     = num
          DICTDB._constraint._con-type    = "P".
        END.
      END.
      ELSE IF cons_type = "CLUSTERED"
      THEN DO:
        IF oldf THEN DO:
             FIND FIRST DICTDB._Index OF DICTDB._File
                     WHERE DICTDB._Index._Index-Name = const_name NO-LOCK NO-ERROR.
             IF NOT AVAILABLE (DICTDB._Index) THEN DO:
                 const_name1  =  replace(const_name,"_","-") .
             END.
             ELSE DO:
               const_name1  = const_name.
             END.
         END.
         ELSE DO:
           const_name1  = const_name.
         END.
      
        IF NOT CAN-FIND (FIRST DICTDB._constraint OF DICTDB._File WHERE DICTDB._constraint._Con-Type = "M")
        THEN DO:
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = "z" + const_name1 NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (DICTDB._Index) then FIND FIRST DICTDB._Index OF DICTDB._File
                                                         WHERE DICTDB._Index._Index-Name = const_name1 NO-LOCK NO-ERROR.
          CREATE DICTDB._constraint.
          ASSIGN        
          DICTDB._constraint._db-recid    = drec_db       
          DICTDB._constraint._con-name    = const_name1
          DICTDB._constraint._for-name    = const_name1
          DICTDB._constraint._Index-Recid = RECID(DICTDB._Index)
          DICTDB._constraint._File-Recid  = RECID(DICTDB._FIle)
          DICTDB._constraint._con-num     = num
          DICTDB._constraint._con-type    = "M".
        END.
      END.
      ELSE IF cons_type = "UNIQUE"
      THEN DO:
        IF NOT CAN-FIND (FIRST DICTDB._constraint OF DICTDB._File WHERE (DICTDB._constraint._Con-Type = "U" 
                                             AND DICTDB._constraint._Con-Name =const_name))
        THEN DO:
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = index_name NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (DICTDB._Index) THEN
             FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = "z" + const_name NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (DICTDB._Index) THEN
             FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = const_name NO-LOCK NO-ERROR.
          CREATE DICTDB._constraint.
          ASSIGN       
          DICTDB._constraint._db-recid   = drec_db        
          DICTDB._constraint._con-name   = const_name
          DICTDB._constraint._for-name   = const_name
          DICTDB._constraint._Index-Recid = RECID(DICTDB._Index)
          DICTDB._constraint._File-Recid  = RECID(DICTDB._FIle)
          DICTDB._constraint._con-num    = num
          DICTDB._constraint._con-type = "U".
        END.
      END.
   END.        
    
    FOR EACH DICTDB._constraint OF DICTDB._File WHERE DICTDB._constraint._con-type = "P":
      FIND FIRST CON_DICTDB OF DICTDB._File WHERE CON_DICTDB._con-type = "M" 
                                              AND CON_DICTDB._Con-Name = DICTDB._constraint._Con-Name EXCLUSIVE-LOCK NO-ERROR.
        IF AVAILABLE (CON_DICTDB)
        THEN DO:
           ASSIGN DICTDB._constraint._con-type = "PC".
           DELETE CON_DICTDB.
        END.   
    END.
  END.   /* FOR EACH DICTDB._FIle */

  FOR EACH DICTDB._FIle WHERE DICTDB._FIle._Db-Recid = drec_db:
     FOR EACH s_ttb_con WHERE tab_name = DICTDB._File._File-Name AND cons_type = "FOREIGN KEY":
      IF NOT CAN-FIND (FIRST DICTDB._constraint OF DICTDB._File WHERE (DICTDB._constraint._Con-Type = "F" 
                                            AND DICTDB._constraint._Con-Name =const_name))
        THEN DO:                                    
          num = num + 1.
          FIND FIRST CON_DICTDB WHERE CON_DICTDB._con-name= par_key AND CON_DICTDB._Db-Recid = drec_db NO-LOCK NO-ERROR.
          IF AVAILABLE(CON_DICTDB)
          THEN DO:            
             CREATE DICTDB._constraint.
             ASSIGN       
             DICTDB._constraint._db-recid   = drec_db 
             DICTDB._constraint._con-type   = "F"
             DICTDB._constraint._con-name   = const_name
             DICTDB._constraint._for-name   = const_name
             DICTDB._constraint._File-Recid = RECID(DICTDB._FIle)
             DICTDB._constraint._con-num    = num
             DICTDB._constraint._Index-Parent-Recid = CON_DICTDB._Index-Recid.
         END.
         ELSE DO:
           FIND FIRST FIL_DICTDB WHERE FIL_DICTDB._File-Name = par_tab AND FIL_DICTDB._Db-Recid = drec_db NO-LOCK NO-ERROR.
            IF AVAILABLE(FIL_DICTDB) THEN DO:
              FIND FIRST DICTDB._Index OF FIL_DICTDB WHERE DICTDB._Index._Index-Name = par_key NO-LOCK NO-ERROR.
              IF AVAILABLE(DICTDB._Index) 
              THEN DO:
               CREATE DICTDB._constraint.              
                 ASSIGN       
                 DICTDB._constraint._db-recid   = drec_db 
                 DICTDB._constraint._con-type   = "F"
                 DICTDB._constraint._con-name   = const_name
                 DICTDB._constraint._for-name   = const_name
                 DICTDB._constraint._File-Recid = RECID(DICTDB._FIle)
                 DICTDB._constraint._con-num    = num
                 DICTDB._constraint._Index-Parent-Recid = RECID(DICTDB._Index).
              END. 
            END.              
         END.
       END.  
    END.  /* FOR EACH s_ttb_con  */   
   FOR EACH DICTDB._constraint OF DICTDB._File WHERE DICTDB._constraint._con-type = "F":
      FOR EACH s_ttb_con WHERE tab_name = DICTDB._File._File-Name:
         
         IF const_name = DICTDB._constraint._con-name AND DICTDB._constraint._Index-Recid = 0
         THEN DO:  
         FIND FIRST DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-Name = col_name NO-LOCK NO-ERROR.
         IF NOT AVAILABLE (DICTDB._Field) THEN  
                          FIND FIRST DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._For-Name = col_name.
         CREATE DICTDB._constraint-Keys.
         ASSIGN                   
               DICTDB._constraint-Keys._Con-Recid   = RECID(DICTDB._constraint)
               DICTDB._constraint-Keys._Field-Recid = RECID(DICTDB._Field).
         END.
       END.
    END.
  END.  
END.    /* IF user_dbtype ="MSS" */
RETURN.

/*------------------------------------------------------------------*/        



/*********************************************************************
* Copyright (C) 2000,2009 by Progress Software Corporation. All      *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* This procedure will be used to connect to either an ODBC or MSS database to
   get driver information that is needed for the pull.
   
   prodict/gate/_gat_drv.p
   
   History:  D. McMann 09/05/01  Added support for versioning of SQL Server
             Rohit     02/20/09  OE00128393- Call dictgate.i with user_dbtype
				 instead of user_dbname
*/   

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE phynam AS CHARACTER NO-UNDO.
DEFINE VARIABLE c      AS CHARACTER NO-UNDO.

phynam = user_dbname.
{ prodict/dictgate.i &action=query &dbtype=user_dbtype &dbrec=? &output=c }
IF ENTRY(5,c) MATCHES "*p*" THEN DO: /* physical name applies */
  FIND _Db WHERE RECID(_Db) = drec_db NO-LOCK.
  phynam = (IF _Db-addr = "" OR _Db-addr = ? THEN user_dbname ELSE _Db-addr).
  /* Connect w' physical dbname if avail, otherwise assume logical dbname */
END.

IF user_env[1] <> "" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    run adecomm/_setcurs.p ("WAIT").
    CONNECT
      VALUE(phynam)
      -ld VALUE(user_dbname)
      VALUE(IF user_env[1] = "" THEN "" ELSE "-U " + user_env[1])
      VALUE(IF user_env[2] = "" THEN "" ELSE "-P " + user_env[2])
      VALUE(IF _Db._Db-comm = "" OR _Db._Db-comm = ? THEN "" ELSE _Db._Db-comm)
      -dt VALUE(user_dbtype) NO-ERROR.
END.
ELSE
  CONNECT 
    VALUE(phynam) -ld VALUE(user_dbname) -dt VALUE(user_dbtype) 
    VALUE(_Db._Db-comm) NO-ERROR.

run adecomm/_setcurs.p ("").
HIDE MESSAGE NO-PAUSE.
RELEASE _Db.

IF NOT CONNECTED(user_dbname) THEN DO:
  MESSAGE
    'Could not connect to "' + user_dbname + '"' 
    (IF user_env[1] = "" THEN "" ELSE 'as user "' + user_env[1] + '"') SKIP
    ERROR-STATUS:GET-MESSAGE(1)
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  
  /* "wrg-ver" being used not because it is the wrong version but because it is
      alreday implemented for _usrsdel so I am re-using here also */
  ASSIGN user_env[35] = "wrg-ver".

  IF user_dbtype = "MSS" THEN 
    ASSIGN user_path = "_usrsdel,*C,1=add,3=MSS,_usrschg,_gat_ini,*C,_gat_drv,*C,_gat_con,_mss_get,mss/procbfrpul,_mss_pul,_gat_cro".
 
  ELSE /* ODBC */
    ASSIGN user_path = "_usrsdel,*C,1=add,3=ODBC,_usrschg,_gat_ini,*C,_gat_drv,*C,_gat_con,_odb_get,_odb_pul,_gat_cro".
 
  RETURN.
END.
ELSE
  CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(user_dbname) NO-ERROR.

IF user_dbtype = "MSS" THEN
  RUN prodict/mss/_mss_sdb.p.
ELSE
  RUN prodict/odb/_odb_sdb.p.

IF RETURN-VALUE = "wrg-ver" THEN DO:
  IF user_dbtype = "MSS" THEN DO:
    MESSAGE "The DataServer for MS SQL Server was designed to work with Versions 7 " SKIP
            "and above.  You have tried to connect to a prior version of MS SQL Server. " SKIP
            "The DataServer for ODBC supports that version and must be used to perform " SKIP
            "this function. " SKIP(1)
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ASSIGN user_path = "35=wrg-ver,_usrsdel,*C,1=add,3=MSS,_usrschg,_gat_ini,*C,_gat_drv,*C,_gat_con,_mss_get,mss/procbfrpul,_mss_pul,_gat_cro".
    RETURN.
  END.
  ELSE IF user_dbtype = "ODBC" THEN DO:
      MESSAGE "The DataServer for ODBC was designed to work with MS SQL Server 6 and " SKIP
            "below.  You have tried to connect to a later version. " SKIP
            "Use the DataServer for MS SQL Server to perform this function. " SKIP(1)       
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      ASSIGN user_path = "35=wrg-ver,_usrsdel,*C,1=add,3=ODBC,_usrschg,_gat_ini,*C,_gat_drv,*C,_gat_con,_odb_get,_odb_pul,_gat_cro".
    RETURN.
  END.
END.
DISCONNECT VALUE(user_dbname).

RETURN.





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

file: gate/_gat_fnm.p 

description:
    find unique name for foreign object

input:
    p_object    {"SEQUENCE"|"TABLE"|"FIELD"|"INDEX"}
    p_offile    recid of the s_ttb_tbl-record parenting this field
    
Output:
    p_obj-name  unique and purified for PROGRESS-use p_obj-name

called by:
    gate/gat_pul.i

history:
    95/06   hutegger    assimilated gat_xlt.p
    95/04   hutegger    created (derived from gat_nam.p)
    98/11   mcmann      Added check for length of name not greater than 32
    
--------------------------------------------------------------------*/
/*h-*/

define input        parameter p_object    as character no-undo.
define input        parameter p_offile    as recid     no-undo.
define input-output parameter p_obj-name  as character no-undo.

define variable c       as character no-undo.
define variable i       as integer   no-undo.
define variable ind     as integer   no-undo.
define variable endlp   as logical   no-undo.
define variable s       as character no-undo.
define variable ch      as character no-undo.
define variable l_abc   as character no-undo init
    "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz".

&SCOPED-DEFINE xxDS_DEBUG                   DEBUG
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/gate/gatework.i  
    &new        = "  "
    &selvartype = "variable l"
    &options    = "initial ""*"" "
    }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

/* this translates a foreign field name into a native field name which
   is guaranteed not to be currently in use in this file */

/*------------------------------------------------------------------*/

/**/&IF "{&DS_DEBUG}" = "DEBUG"
/**/ &THEN
/**/ message "_gat_fnm.p: creating dbug-output" view-as alert-box.
/**/ output to gat_fnm.lst append.
/**/ display "*************************************************" no-label
/**/   p_object p_offile p_obj-name with side-labels.
/**/ for each s_ttb_tbl:
/**/   display s_ttb_tbl.pro_name format "x(20)" 
/**/     s_ttb_tbl.ds_name        format "x(20)" 
/**/     s_ttb_tbl.ds_msc21       format "x(20)".
/**/   end.
/**/ for each DICTDB._File where DICTDB._File._db-recid  = p_offile
                             AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"):
/**/   display DICTDB._File._File-name  format "x(20)" 
/**/     DICTDB._File._For-name         format "x(20)" 
/**/     DICTDB._File._Fil-misc2[1]     format "x(20)".
/**/   end.
/**/ for each DICTDB._View:
/**/   display DICTDB._View._View-name.
/**/   end.
/**/ for each s_ttb_fld:
/**/   display s_ttb_fld.ttb_tbl s_ttb_fld.ds_name s_ttb_fld.pro_name.
/**/   end.
/**/ for each s_ttb_idx:
/**/   display s_ttb_idx.ttb_tbl s_ttb_idx.ds_name s_ttb_idx.pro_name.
/**/   end.
/**/ output close.
/**/ &ENDIF

assign 
  c     = p_obj-name
  endlp = no
  ind   = 1.

/* get rid of <qual>. from <qual>.<owner>.<object>
 * or <owner> from <owner>.<object>
 */

/* Object is never qualified. 
if ( p_object = "SEQUENCE"
 or  p_object = "TABLE"
 or  p_object = "INDEX"
   )
 and index(c,".") <> 0
 then assign
  c = substring(c,index(c,".") + 1, -1, "character").
*/

/* get rid of <owner>. from <qual>.<owner>.<object>
 * no-op for <owner>.<object>
 */

/* Object is never qualified. 
if ( p_object = "SEQUENCE"
 or  p_object = "TABLE"
 or  p_object = "INDEX"
   )
 and index(c,".") <> 0
 then assign
  c = substring(c,index(c,".") + 1, -1, "character").
*/

/* get rid of prefix of index-names (usually <table>##<index>)
 */
if p_object = "INDEX"
 and index(c,"##") <> 0
 then assign
  c = substring(c,index(c,"##") + 2, -1, "character").


/* make sure 1. character of name is correct */
/* old version; replaced because of asian names which endup as ""
 * do while INDEX(l_abc,SUBSTRING(c,1,1, "character")) = 0 
 *   and c <> "":
 *   assign c = SUBSTRING(c,2,-1,"character").
 *   end.
 */
if INDEX(l_abc,SUBSTRING(c,1,1, "character")) = 0 
 then assign c = "z" + c.


/* make sure rest of name is correct */
do while NOT endlp:
  
  assign ch = SUBSTRING(c, ind, 1, "character").
  
  IF LENGTH(ch, "character") = 0 OR ch = ?
   then do:
    endlp = yes.
    NEXT.
    end. 
  
  IF INDEX("#$%&-_0123456789" + l_abc, ch) <= 0
   then SUBSTRING(c, ind, 1, "character") = "_".

  assign ind = ind + 1.
  
  end.

/* make sure name is not "" */
assign
  c = (IF c = "" then "noname" else c) /* avoid 0-len names */
  s = c.
 
/* Progress limitation is 32 characters so make sure name is no longer */  
IF LENGTH(c) > 32 THEN
  ASSIGN c = SUBSTRING(c,1,32).
  
/* make sure we didn't endup with a keyword.
 * We do this though this doesn't work with runtime-licenses...
 */
IF KEYWORD(c) <> ?
 then assign SUBSTRING(c,MINIMUM(32,LENGTH(c,"character") + 1),-1,"character") = "_".


/* now the  name is purified to be usable for PROGRESS
 * last step: make it a unique name
 */
 
/* The unique index for _Sequence doesn't contain _Db-recid as component,
 * which makes it necessary to have a unique name across ALL schemas of
 * SchemaHolder. Since we plan to change this, I just comment out the
 * db-reference
 */
/* With V8 we have a unique-index on Sequenxces with _Db-reference. So
 * I decommented the _db-reference from the where-clause. (hutegger 95/08)
 */ 
if      p_object = "SEQUENCE"
 then do i = 1 TO 9999
  while can-find(FIRST s_ttb_seq
                 where s_ttb_seq.pro_name = c)
  or    can-find(first DICTDB._Sequence
                 where DICTDB._Sequence._db-recid = p_offile 
                 and   DICTDB._Sequence._Seq-name = c):
  c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
    + STRING(- i).
  end.
if      p_object = "TABLE"
 then do i = 1 TO 9999
  while can-find(FIRST s_ttb_tbl
                 where s_ttb_tbl.pro_name = c)
  or    can-find(first DICTDB._File
                 where DICTDB._File._db-recid  = p_offile 
                 and   DICTDB._File._File-name = c
                 and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"))
  or    can-find(first DICTDB._View
                 where /*DICTDB._View._db-recid  = p_offile 
                 and  */ DICTDB._View._View-name = c):
  c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
    + STRING(- i).
  end.
else if p_object = "INDEX"
 then do i = 1 TO 9999
  while can-find(FIRST s_ttb_idx
                 where s_ttb_idx.ttb_tbl  = p_offile 
                 and   s_ttb_idx.pro_name = c):
  c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
    + STRING(- i).
  end.
else if p_object = "FIELD"
 then do i = 1 TO 9999
  while can-find(FIRST s_ttb_fld
                 where s_ttb_fld.ttb_tbl  = p_offile 
                 and   s_ttb_fld.pro_name = c):
  c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
    + STRING(- i).
  end.

assign p_obj-name = c.

/**/&IF "{&DS_DEBUG}" = "DEBUG"
/**/ &THEN
/**/ output to gat_fnm.lst append.
/**/ display p_object p_offile p_obj-name
/**/   "*****************************" no-label
/**/   with side-labels.
/**/ output close.
/**/ message "_gat_fnm.p: creating dbug-output done" view-as alert-box.
/**/ &ENDIF

/*------------------------------------------------------------------*/

/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* gate_ini - involved in attaching foreign db and misc initialization */

/*
in:  user_env[1]  = "add" or "upd"
     user_env[2]  = dbname to add/update
     user_env[3]  = dbtype (if user_env[1] = "add") (internal format)
     user_env[25] = "AUTO": return-error if not connected
                    ""    : ask user for confirmation 

out: (if successful)
     user_env[1] = userid   or "" to continue with current connection
     user_env[2] = password or "" to continue with current connection
     user_env[3] = dbtype (internal format)
     no other environment variables changed

out: (if unsuccessful)
     user_env[3] = dbtype (internal format)
     no other environment variables changed
     
History:  D. McMann 10/23/02 Replaced BLANK with PASSWORD-FIELD     
          D. McMann 10/17.03 Add NO-LOCK statement to _Db find in support of on-line schema add
*/


{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }
{ prodict/odb/odbvar.i  }


DEFINE VARIABLE adding  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE answer  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE c       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE edbtyp  AS CHARACTER  NO-UNDO. /* db-type external format */
DEFINE VARIABLE i       AS INTEGER    NO-UNDO.
DEFINE VARIABLE j       AS INTEGER    NO-UNDO.
DEFINE VARIABLE lo      AS INTEGER    NO-UNDO.
DEFINE VARIABLE msg     AS CHARACTER  NO-UNDO EXTENT 6.
DEFINE VARIABLE po      AS INTEGER    NO-UNDO.
DEFINE VARIABLE uidpwd  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE canned  AS LOGICAL    NO-UNDO INIT TRUE.

FORM
  SKIP ({&TFM_WID})
  msg[1] AT 8 FORMAT "x(64)" NO-LABEL VIEW-AS TEXT
  msg[2] AT 8 FORMAT "x(64)" NO-LABEL VIEW-AS TEXT
  msg[3] AT 8 FORMAT "x(64)" NO-LABEL VIEW-AS TEXT
  msg[4] AT 8 FORMAT "x(64)" NO-LABEL VIEW-AS TEXT
  msg[5] AT 8 FORMAT "x(64)" NO-LABEL VIEW-AS TEXT
  msg[6] AT 8 FORMAT "x(64)" NO-LABEL VIEW-AS TEXT
  SKIP ({&VM_WIDG})
  user_env[1] COLON 11 LABEL "User ID"   FORMAT "x(60)" {&STDPH_FILL}
  SKIP ({&VM_WID})
  user_env[2] COLON 11 LABEL "Password"  FORMAT "x(60)" PASSWORD-FIELD {&STDPH_FILL}
  {prodict/user/userbtns.i}
  WITH SIDE-LABELS ATTR-SPACE FRAME msg ROW 3 CENTERED 
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX TITLE "User ID and Password".

/*================================Triggers=================================*/

/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME msg
   APPLY "END-ERROR" TO FRAME msg.


/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME msg OR CHOOSE of btn_Help IN FRAME msg
DO:
  RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
         	       	    INPUT {&User_ID_Dlg_Box},
      	       	     	    INPUT ?).
END.
&ENDIF

/*=============================Mainline Code===============================*/

ASSIGN 
  adding      = ( user_env[1] = "add" )
  user_env[3] = ( IF adding 
                    THEN user_env[3] 
                    ELSE user_dbtype
                )
  edbtyp      = {adecomm/ds_type.i
                  &direction = "itoe"
                  &from-type = "user_env[3]"
                  }.

IF dict_rog THEN DO:
  MESSAGE "The dictionary is in read-only mode - alterations not allowed." SKIP
      VIEW-AS ALERT-BOX WARNING BUTTONS OK.
  ASSIGN user_path = "".  
  RETURN.    
END.

RUN "prodict/_dctsget.p".
DO i = 1 TO cache_db#:
  IF cache_db_t[i] = user_env[3] THEN ASSIGN po = i  lo = lo + 1.
END.

IF adding THEN DO:
  FIND DICTDB._Db WHERE DICTDB._Db._Db-name = user_env[2] NO-LOCK.
  ASSIGN
    user_dbname   = user_env[2]
    user_dbtype   = user_env[3]
    cache_dirty   = TRUE
    user_filename = ""
    drec_file     = ?
    drec_db       = RECID(DICTDB._Db).

END.
ELSE
IF user_dbtype <> user_env[3] THEN DO:
  IF lo = 0 THEN DO:
    ASSIGN
      answer = TRUE
      c      = SUBSTITUTE('You have no &1 schema-holder {&PRO_DISPLAY_NAME} databases '
               + 'connected.  Would you like to make the current database '
               + '"&2" a schema-holder for &1?',edbtyp,user_dbname).
    RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT answer,?,?,c).
    user_path = (IF answer THEN "1=add,_usrschg,_gat_ini," + user_path ELSE "").
    RETURN.
  END.
  ELSE
  IF lo = 1 THEN DO:
    ASSIGN
      answer = TRUE
      c      = SUBSTITUTE('Your current database type is not &1.  Would you '
               + 'like to switch to &1 database "&2" and continue?',
               edbtyp,cache_db_l[po]).
    RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT answer,?,?,c).
    IF NOT answer THEN DO:
      user_path = "".
      RETURN.
    END.
    DO TRANSACTION:
      CREATE ALIAS "DICTDB"  FOR DATABASE VALUE(cache_db_s[po]) NO-ERROR.
      CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(cache_db_l[po]) NO-ERROR.
      ASSIGN
        user_dbname   = cache_db_l[po]
        user_dbtype   = user_env[3]
        cache_dirty   = TRUE
        user_path     = "*C," + user_path
        user_filename = ""
        drec_file     = ?.
      RUN "prodict/_dctsset.p" (user_dbname).
    END.
  END.
  ELSE DO:
    ASSIGN
      c = SUBSTITUTE("You are not currently in a &1 database.  There are "
        + "more than one &1 schema-holder databases connected.  "
        + "Please select the appropriate one and then choose this "
        + "option again.",edbtyp).
    RUN "prodict/user/_usrebox.p" (c).
    user_path = "".
    RETURN.
  END.
END.

{ prodict/user/usercon.i }

{ prodict/dictgate.i 
  &action=query 
  &dbtype=user_env[3] 
  &dbrec=? 
  &output=c 
  }
uidpwd = ENTRY(1,c) MATCHES "*u*". /* userid/passwd needed */

IF uidpwd AND CONNECTED(user_dbname) THEN
  msg[1] = 'You are currently connected to &1 database "&2" with user ID '
         + '"&4". Does this user ID have the appropriate privileges? '
         + '(For example, select access is needed on some system tables.)  If so, '
         + 'press [&3] or OK. Otherwise, enter a new user ID and password '
         + 'below, and you will be disconnected and reconnected with the '
         + 'new user ID.'.
ELSE IF NOT uidpwd AND CONNECTED(user_dbname) THEN
  msg[1] = 'You are currently connected to &1 database "&2".'.
ELSE IF uidpwd AND NOT CONNECTED(user_dbname) THEN
  msg[1] = 'You have selected, but are not currently connected to, &1 '
         + 'database "&2".  Please enter a user ID and password to use to '
         + 'connect.  The user ID must have the appropriate privileges. '
         + '(For example, select access is needed on some system tables.)'.
ELSE /* NOT uidpwd AND NOT CONNECTED(user_dbname) THEN */
  msg[1] = 'You have selected, but are not currently connected to, &1 '
         + 'database "&2".'.

ASSIGN
  msg[1]      = SUBSTITUTE(msg[1],
                     edbtyp,user_dbname,KBLABEL("GO"),
                     USERID(user_dbname),ENTRY(8,c))
  user_env[1] = ""
  user_env[2] = "".

{adecomm/okrun.i  
  &FRAME  = "FRAME msg" 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  {&CAN_BTN}
  {&HLP_BTN}
}

{ prodict/dictsplt.i &src=msg[1] &dst=msg &num=6 &len=63 &chr=" " }
DISPLAY msg[1 FOR 6] WITH FRAME msg.

DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  IF NOT user_env[25] begins "AUTO"
    THEN UPDATE user_env[1 FOR 2] when uidpwd
      	 btn_OK 
      	 btn_Cancel 
      	 {&HLP_BTN_NAME} 
      	 WITH FRAME msg.
    ELSE IF NOT CONNECTED(user_dbname)
      THEN RETURN ERROR. /* leave it up to the calling routine to  */  	 
  canned = FALSE.                      /* handle the error itself! */
END.

HIDE FRAME msg NO-PAUSE.
IF canned AND adding THEN DO:
  MESSAGE "You have selected to cancel the Create DataServer Schema option. " SKIP
          "The information you have entered will be deleted. " SKIP
          VIEW-AS ALERT-BOX WARNING.
  /* "wrg-ver" being used not because it is the wrong version but because it is
        alreday implemented for _usrsdel so I am re-using here also */
  ASSIGN user_env[35] = "wrg-ver".
  IF "{&WINDOW-SYSTEM}" = "TTY" THEN
    ASSIGN user_path = "_usrsdel,*N,1=sys,_usrsget".
  ELSE
    ASSIGN user_path = "_usrsdel,*N,1=sys,_guisget".
END.
ELSE IF canned THEN user_path = "".
IF user_env[1] <> "" THEN
  ASSIGN odb_username = user_env[1].
ELSE
  ASSIGN odb_username = "&4".
RETURN.
/*********************************************************************
* Copyright (C) 2000,2007,2012 by Progress Software Corporation. All *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
File:    prodict/gate/_gat_md9.i

Description:
    loads in all data in all (apropriate) tables

Text-Parameters:
    &db-type        "ora", "odb" or "syb"
    &tmp-name       "osh", "odb" or "ssh"
    
Included in:
  prodict/odb/_odb_md9.p
  prodict/ora/_ora_md9.p
  prodict/syb/_syb_md9.p
  
History:
    94/08/09    hutegger    inserted sys.p-support and
                            extented where-clause for each _File
                            plus contracted ora- odb- & syb_md9.p to use
                            this include  
    94/02/11    hutegger    changed input-parameter of runload.i to "y"
    98/07/13    D. McMann   added _Owner to _file finds
    99/02/11    Mario B     bug 98-10-26-014, clean up empty .e files  
    99/02/24    D. McMann   Removed fix for 98-10-26-014
    99/03/05    Mario B     bug 98-10-26-014, clean up empty .e files revised
    00/05/31    D. McMann   Added check for MSS to use correct name for alias
    10/17/03    D. McMann   Add NO-LOCK statement to _Db find in support of on-line schema add
    06/20/07    fernando    Support for large files
    
*/

{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i }
{ prodict/{&db-type}/{&db-type}var.i }

DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE errs   AS INTEGER INITIAL 0 NO-UNDO.
DEFINE NEW SHARED VARIABLE recs   AS INT64 INITIAL 0. /*UNDO*/
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE fil-d  AS CHARACTER NO-UNDO.
DEFINE            VARIABLE noload AS CHARACTER NO-UNDO.
DEFINE            VARIABLE wtype  AS CHARACTER NO-UNDO.
DEFINE            VARIABLE l_debug      AS logical   NO-UNDO INIT FALSE.
DEFINE            VARIABLE db_dbname   AS CHARACTER.

IF NOT SESSION:BATCH-MODE THEN
    OUTPUT TO VALUE ({&tmp-name}_dbname + "out.tmp") NO-MAP.
ASSIGN wtype = "{&db-type}".
IF wtype = "mss" THEN DO:
  CREATE ALIAS "DICTDB2" FOR DATABASE VALUE({&db-type}_pdbname).
  ASSIGN db_dbname = {&db-type}_pdbname.
  FIND DICTDB._Db WHERE DICTDB._Db._Db-name = {&db-type}_pdbname NO-LOCK.
END.
ELSE DO:
  CREATE ALIAS "DICTDB2" FOR DATABASE VALUE({&db-type}_dbname).
  ASSIGN db_dbname = {&db-type}_dbname.
  FIND DICTDB._Db WHERE DICTDB._Db._Db-name = {&db-type}_dbname NO-LOCK.
END.
assign noload = "u".
{ prodict/dictgate.i
    &action = "undumpload"
    &dbtype = "_Db._Db-type"
    &dbrec  = "RECID(_Db)"
    &output = "noload"
    }
                
FOR EACH DICTDB._File OF DICTDB._Db
  WHERE NOT DICTDB._File._Hidden
  AND   _file._File-number > 0
  AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
  AND   (noload = "" OR NOT CAN-DO(noload,_File._For-type)) 
  BY DICTDB._File._File-name:

  OUTPUT STREAM loaderr TO VALUE(_Dump-name + ".e") NO-ECHO.
  INPUT FROM VALUE(_Dump-name + ".d") NO-ECHO NO-MAP.
  RUN prodict/misc/_runload.i (INPUT "y") _File-name 0 100 _File-name 0.
  INPUT  CLOSE.
  OUTPUT STREAM loaderr CLOSE.  
  IF errs < 1 THEN OS-DELETE VALUE(_Dump-name + ".e"). 

END.
IF wtype = "mss" OR wtype = "ora" THEN DO:
RUN "prodict/gate/_snd_sql.p"
      ( INPUT user_env[31],
        INPUT l_debug,
        INPUT db_dbname,
        INPUT user_dbtype,
        INPUT user_env[5],
        INPUT user_env[26],
        INPUT "enable.sql"
      ).
END.      
IF NOT SESSION:BATCH-MODE THEN
    OUTPUT CLOSE.

RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* OLD VERSION!!!! CHECK GATE/_GAT_FNM.P !!!!!   (hutegger 95/04) */
/* gate_nam - find unique field name for gateway field extraction */

DEFINE INPUT        PARAMETER offile    AS RECID     NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER fieldname AS CHARACTER NO-UNDO.

DEFINE VARIABLE c       AS CHARACTER NO-UNDO.
DEFINE VARIABLE i       AS INTEGER   NO-UNDO.
DEFINE VARIABLE ind     AS INTEGER   NO-UNDO.
DEFINE VARIABLE endlp   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE s       AS CHARACTER NO-UNDO.
DEFINE VARIABLE ch      AS CHARACTER NO-UNDO.

/* this translates a foreign field name into a native field name which
   is guaranteed not to be currently in use in this file */

c = fieldname.
DO WHILE INDEX("ABCDEFGHIJKLMNOPQRSTUVWXYZ",SUBSTRING(c,1,1)) = 0 AND c <> "":
  c = SUBSTRING(c,2).
END.

endlp = no.
ind = 1.
DO WHILE NOT endlp:
  ch = SUBSTRING(c, ind, 1).
  IF LENGTH(ch) = 0 OR ch = ? THEN DO:
      endlp = yes.
      NEXT.
  END. 
  
  IF INDEX("#$%&-_0123456789ETAONRISHDLFCMUGYPWBVKXJQZ", ch) <= 0 THEN
    SUBSTRING(c, ind, 1) = "_".

  ind = ind + 1.
END.

ASSIGN
  c = (IF c = "" THEN "noname" ELSE c) /* avoid 0-len names */
  s = "".

IF KEYWORD(c) <> ? THEN SUBSTRING(c,MINIMUM(32,LENGTH(c) + 1)) = "_".
s = c.

DO i = 1 TO 9999
  WHILE CAN-FIND(FIRST _Field WHERE _File-recid = offile AND _Field-name = c):
  c = SUBSTRING(s,1,32 - LENGTH(STRING(- i))) + STRING(- i).
END.

assign
  fieldname = c.
  
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gat_prt.p

Description:
    
    creating the report to be printed

        
Input:
    p_param     code of what to output: {a | l | r + recid(gate-work)}

Output:
    none
    
Called from:
    gui/guiget.i (via misc/_prt_rpt.p)

History:
    hutegger    95/03   creation
    
--------------------------------------------------------------------*/        
/*h-*/

&SCOPED-DEFINE DATASERVER                 YES
{ prodict/dictvar.i }
&UNDEFINE DATASERVER

define input parameter     p_param      as character.

/*
define            variable l_line       as character.
define            variable l_tmp-file   as character.
*/
define            variable l_txt        as character.

define     shared stream   rpt.
define            stream   l_stm_tmp.


/*---------------------  Internal Procedures  ----------------------*/

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

/* paged-output ignores chr(10) embedded in the text, so we output line
 * by line, and not the whole text at once
 */

for each gate-work
  where gate-work.gate-slct = TRUE:
  
  if p_param = "s" and gate-work.gate-flag = FALSE then next.
  if p_param = "d" and gate-work.gate-flg2 = FALSE then next.
  
  assign
    l_txt = gate-work.gate-edit.
  repeat while index(l_txt,chr(10)) > 0:
    if index(l_txt,chr(10)) > 1
     then put stream rpt unformatted
      substring(l_txt,1,index(l_txt,chr(10)) - 1, "character") skip.
     else put stream rpt skip(1).
    assign
      l_txt = substring(l_txt,index(l_txt,chr(10)) + 1,-1,"character").
    end.   /* repeat */
  put stream rpt unformatted
    l_txt        skip(1)
    fill("-",77) skip(1).  
  
  end.  /* for each gate-work */
  
/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*----------------------------------------------------------------------------

File: prodict/gate/_gat_row.p

    displays all ROWID possibilities and ev. lets user select one among 
    them

    criterias in the browse:
        1   index-unique
        2   all fields mandatory
        3   prec <= 9 & ( scale <= 0 | scale = ? )
        4   selectability
        5   compatibility with V7.3
        6   number of fields in index
        7   no component is of type "float"

Input-Parameters:
    p_file-recid    recid of file to be worked on
    
Output-Parameters:
    none
    
Used/Modified Shared Objects:
    none
    
History:
    nordhougen  08/23/95    Added variable ora_rid_det to display detail info
                            for Oracle "native rowid" object
    nordhougen  08/10/95    Added trap to prevent access and display message
                            when there are no objects to select (empty browse)
    nordhougen  08/04/95    Added adjustments for l_brs_idx browser on MSW to
                            make v_comp column values completely visible
    hutegger    95/07/27    Changed UI and ODBC level-calculation; added 
                            prec/scale criteria to temp-table
    nordhougen  07/17/95    Fixed logic so that END-ERROR key will not
                            cause focused row to be selected when warning
                            message is displayed 
    nordhougen  07/14/95    Added trigger to allow RETURN key to select an
                            object from the "ROWID Choices" screen in GUI
                            mode
    nordhougen  07/14/95    Added trigger to allow RETURN key to exit from
                            the "Detail Info" screen in GUI mode
    nordhougen  07/12/95    Made ROWID Candidate Detail Information editor
                            widget READ-ONLY 
    hutegger    95/02/28    Creation; support for ORACLE and ODBC
    mcmann      97/11/13    Added view-as dialog box for non tty clients
    mcmann      00/08/10    Help was not working because topics in wrong file
                            20000810034
    
--------------------------------------------------------------------*/
/*h-*/

/*==========================  DEFINITIONS ===========================*/

&GLOBAL-DEFINE NOTTCACHE 1

{prodict/dictvar.i}
{prodict/user/uservar.i}
    
DEFINE input parameter p_db-type        as character.
define input parameter p_file-recid     as recid.

&IF "{&WINDOW-SYSTEM}" begins "MS-WIN"
 &THEN
   &Global-define chr10  ""
   &Global-define skp   
 &ELSE
   &Global-define chr10  chr(10)
   &Global-define skp    skip   
 &ENDIF

define temp-table l_ttb_idx
        field name      as character format "x(22)"    label "Name"
        field detail    as character
        field dttype    as logical /*format "   ok/"   label "Prec/Scale"*/
        field fld#      as integer /*format "z9"       label "#Comp"*/
        field mand      as logical   format "   ok/"   label "Mandatory"
        field slctbl    as logical   format "auto/user" label "Selectable"
        field slctd     as logical   format "current/" label "Selected"
        field uniq      as logical   format "  ok/"    label "Unique"
        field v_comp    as logical   format "7.3/"    
          &IF "{&WINDOW-SYSTEM}" begins "MS-WIN" &THEN  label "Comp   "
                                                &ELSE  label "Comp"  &ENDIF
          /* extra spaces in label needed on MSW to get correct column width */
        index upi       is unique primary 
                        uniq desc mand desc name asc.

define query  l_qry_idx for l_ttb_idx.

define browse l_brs_idx
        query l_qry_idx
      display l_ttb_idx.name   
              l_ttb_idx.uniq   l_ttb_idx.mand    
              l_ttb_idx.v_comp l_ttb_idx.slctd
         with 5 down.

define variable l_detail    as character no-undo.
define variable l_dttype    as logical   no-undo.
define variable l_fld#      as integer   no-undo.
define variable l_mand      as logical   no-undo.
define variable l_matrix    as character no-undo initial
                    "okok0,okok1,okok2,okok3,crap2,crap3,okok4,crap4".
define variable l_new-rowid as character no-undo.
define variable l_old-rowid as character no-undo.
define variable l_result    as logical   no-undo.
define variable l_slctbl    as logical   no-undo.
define variable l_usblt     as character no-undo.
define variable l_v_comp    as logical   no-undo.
define variable odbtyp      as character no-undo.

define variable ora_rid_det as character no-undo init
"The native ROWID returns the address of a row in an Oracle database.  It typically provides the fastest access to a record.  However, the native ROWID does not support the {&PRO_DISPLAY_NAME} FIND PREV/LAST statement or cursor repositioning.  FIND FIRST/NEXT statements for tables that use the native ROWID as a row identifier have unpredictable results.  You can use native ROWID with a view only if there is a one-to-one correspondence between the rows in the view and the rows in a single underlying table.  You cannot use ROWID for a view that performs a join, uses ""distinct,"" ""group by,"" aggregate functions, unions, etc.".

define variable l_msg         as character extent 16 initial [
 /* 1*/ "This index is NOT Unique. ",
 /* 2*/ "This index contains field(s) that are NOT Mandatory. ",
 /* 3*/ "The precision or scale of that field allows ",
 /* 4*/ "values incorrect for ROWID Index. ",
 /* 5*/ "Your application has to take care of that. ",
 /* 6*/ "If this index gets selected the schema is no longer V7.3 compatible.",
 /* 7*/ "This index contains more than one field. ",
 /* 8*/ "This table contains the column ""progress_recid"".  It is the ",
 /* 9*/ "optimal field/index to be used for ROWID functionality. ",
 /*10*/ "No other object can be selected.",
 /*11*/ "Please select one object to be used for ROWID functionality.",
 /*12*/ "You selected an object to be used for ROWID functionality ",
 /*13*/ "that has one or more components of datatype ""Float"". ",
 /*14*/ "It might not always be possible to retrieve a specific record.",
 /*15*/ "This DataServer doesn't support ROWID functionality.",
 /*16*/ "There are no objects to select."
    ].

/* To make the best possible selection for ROWID indexes in ODBC, we use
 * a list of values which symbolize the usability of that index.
 * The best is an index that would meet V7.3 criteria for "automatically
 * selectable", the next best is V7.3 "user selectable", ...
 * l_matrix:    format:   {okok|crap}{01234}
 *      okok  := number of fields of index = 1
 *      crap  := number of fields in index > 1
 *      0     := all fields = integer
               & all fields = mandatory
               & index = unique
 *      1     :=  all fields = integer
               & ( !all field = mandatory 
               |   index <> unique )
 *      2     := all fields <> "date,float"
 *      3     := all fields <> "float"
               & one or more fields = "date"
 *      4     := one or more fields = "float"
 */

form
  "Please select one of the following objects to be used for {&PRO_DISPLAY_NAME}" 
                                       view-as text at 2  skip
  "ROWID functionality. "              view-as text at 2
  &IF "{&WINDOW-SYSTEM}" = "TTY"
   &THEN
    "Cursor-right for detailed info."
   &ELSE
    "Double-click for detailed info."
   &ENDIF
                                       view-as text       skip({&VM_WIDG})
  l_brs_idx                                         at 4  skip({&VM_WIDG})
/*  "Usability: level 1 = best, level 8 = worst" */ 
/*  "Usability: level 1 to level 8 (level 1 = best)"
                                       view-as text at 2  skip({&VM_WIDG})
  */ 
  {prodict/user/userbtns.i}
  with title "  ROWID Choices  "
       default-button btn_ok
       cancel-button btn_cancel
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box 
          three-d &ENDIF 
       frame l_frm_idx.

form
  l_ttb_idx.detail at 2 view-as editor SCROLLBAR-V SCROLLBAR-H
    &IF "{&WINDOW-SYSTEM}" = "TTY"
     &THEN size 70 by 13
    &ELSEIF "{&WINDOW-SYSTEM}" begins "MS-WIN"
     &THEN inner-chars 71 inner-lines 13 /*scrollbar-h large*/
     &ELSE inner-chars 67 inner-lines 13 /*scrollbar-h*/
     &ENDIF
    font 0 no-label /* fixed font */
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
      {adecomm/okform.i
         &BOX    = rect_btns
         &STATUS = no
         &OK     = btn_OK
         &CANCEL = " "
         &OTHER  = " "
         &HELP   = btn_Help
      }
     &ELSE
      {adecomm/okform.i
         &STATUS = no
         &OK     = btn_OK
         &CANCEL = "  "
         &OTHER  = "  "
      }
     &ENDIF
  with title " Detail Information "
       default-button btn_ok
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF 
       frame l_frm_dtl 
       &IF "{&WINDOW-SYSTEM}" begins "MS-WIN"
         &THEN width 110
         &ENDIF
       .
       
/*======================  WIDGET ATTRIBUTES ==========================*/

ASSIGN
  l_ttb_idx.detail:read-only = yes.
       
/*============================  TRIGGERS  ============================*/

/*-------------- HELP or CHOOSE of HELP BUTTON --------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  on HELP of frame l_frm_idx OR CHOOSE of btn_Help in frame l_frm_idx
  RUN "adecomm/_adehelp.p" (INPUT "dict", INPUT "CONTEXT",
                               INPUT {&RowID_Idx_Dlg_Box}, 
                               INPUT ?).
  on HELP of frame l_frm_dtl OR CHOOSE of btn_Help in frame l_frm_dtl
     RUN "adecomm/_adehelp.p" (INPUT "dict", INPUT "CONTEXT", 
                               INPUT {&RowID_Idx_Dtl_Dlg_Box},
                               INPUT ?).
  &ENDIF


/*----- default-action of browse l_brs_idx or l_btn_dtl -----*/

&IF "{&WINDOW-SYSTEM}" = "TTY"
 &THEN
  ON DEFAULT-ACTION OF l_brs_idx IN FRAME l_frm_idx 
 &ELSE
  ON RETURN OF l_brs_idx IN FRAME l_frm_idx
&ENDIF  
    APPLY "GO" TO FRAME l_frm_idx.


/*----- return of editor l_ttb_idx.detail -----*/

ON RETURN OF l_ttb_idx.detail IN FRAME l_frm_dtl
  APPLY "CHOOSE" TO btn_ok.


/*----- return of browse l_brs_idx -----*/

ON RETURN OF l_brs_idx IN FRAME l_frm_idx
  APPLY "CHOOSE" TO btn_ok.


/*--------------- invoke "detail info" dialog ----------------*/

&IF "{&WINDOW-SYSTEM}" = "TTY"
 &THEN
  on cursor-right of l_brs_idx in frame l_frm_idx do:
 &ELSE
  on mouse-select-dblclick of l_brs_idx in frame l_frm_idx do:
&ENDIF

    assign
      l_result    = l_brs_idx:select-focused-row().
/*
      l_result    = l_brs_idx:fetch-selected-row(1) in frame l_frm_idx.
*/
    
    display l_ttb_idx.detail with frame l_frm_dtl.
    enable 
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
      l_ttb_idx.detail
     &ENDIF
      btn_OK 
      {&HLP_BTN_NAME}
      with frame l_frm_dtl.
 
    do on error undo, leave on endkey undo, leave:
      wait-for choose of btn_OK in frame l_frm_dtl
        or go,return,mouse-select-dblclick of frame l_frm_dtl.
    end.

    disable
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
      l_ttb_idx.detail
     &ENDIF
      btn_OK 
      {&HLP_BTN_NAME}
      with frame l_frm_dtl.

    hide frame l_frm_dtl.
    
  end.    /* invoke "detail info" dialog */

 
/*----------- GO or CHOOSE of OK BUTTON -----------*/

on GO of frame l_frm_idx  /* or OK because of auto-go */ do:
 do with frame l_frm_idx:
  
  define variable l_message as character no-undo.
  
  if l_old-rowid <> "<progress_recid>" then do:
  
    if l_brs_idx:num-selected-rows = 0 then do:
      message l_msg[11] view-as alert-box error buttons ok.
      RETURN NO-APPLY.
    end.

    assign
      l_result    = l_brs_idx:fetch-selected-row(1) in frame l_frm_idx
      l_new-rowid = l_ttb_idx.name.
                  
    if l_old-rowid <> l_new-rowid then
      case p_db-type:

        when "ORACLE" then do:

            /* display warnings and ask user to confirm */
            assign
              l_message   = ( if l_ttb_idx.uniq = FALSE
                                then l_msg[1] + {&chr10}
                                else ""
                            ) 
                          + ( if l_ttb_idx.mand = FALSE
                                then l_msg[2] + {&chr10}
                                else ""
                            )
                          + ( if l_ttb_idx.dttype = FALSE
                                then l_msg[3] + {&chr10} + l_msg[4] + {&chr10}
                                else ""
                            ).
            if l_message <> "" then do:
              assign l_result = FALSE.
              message l_message + l_msg[5]
                view-as alert-box warning 
                buttons ok-cancel update l_result.
              if not l_result or l_result = ? then RETURN NO-APPLY.
            end.
            
            /* de-select OLD index */
            if l_old-rowid <> "<native ROWID>" then do:
              find first DICTDB._Index of DICTDB._File
                where DICTDB._Index._Index-name = l_old-rowid no-error.
              if available DICTDB._Index
               then assign DICTDB._Index._I-misc2[1] = 
                        substring( DICTDB._Index._I-misc2[1]
                                 , 2
                                 , -1
                                 , "character"
                                 ).
            end.

            /* select NEW index */
            if l_new-rowid = "<native ROWID>" then
              assign DICTDB._File._Fil-misc1[4] = 0.
            else do:
              find first DICTDB._Index of DICTDB._File
                where DICTDB._Index._Index-name = l_new-rowid no-error.
              find first DICTDB._Index-Field of DICTDB._Index.
              find first DICTDB._Field of DICTDB._Index-Field.
              assign
                DICTDB._File._Fil-misc1[4] = DICTDB._Field._Fld-stoff
                DICTDB._Index._I-misc2[1]  = "r" + DICTDB._Index._I-misc2[1].
            end.
                    
          end.  /* when "ORACLE" */


          when odbtyp then do:

            /* display warnings and ask user to confirm */
            if l_ttb_idx.slctbl = FALSE
             then assign  /* user-definable */
              l_message   = ( if l_ttb_idx.uniq = FALSE
                                then l_msg[1] + {&chr10}
                                else ""
                            ) 
                          + ( if l_ttb_idx.mand = FALSE
                                then l_msg[2] + {&chr10}
                                else ""
                            )
              l_message   = ( if l_message <> ""
                                then l_message + l_msg[5]
                                else l_message
                            ).
            else assign  /* automatically selectable */
              l_message   = ( if l_ttb_idx.v_comp = FALSE
                                then l_msg[6] + {&chr10}
                                else ""
                            ) 
                          + ( if  l_ttb_idx.dttype = FALSE
                                then l_msg[12] + {&chr10}
                                   + l_msg[13] + {&chr10}
                                   + l_msg[14] + {&chr10}
                                else ""
                            ).
            if l_message <> "" then do:
              assign l_result = FALSE.
              message l_message
                view-as alert-box warning 
                buttons ok-cancel update l_result.
              if not l_result or l_result = ? then RETURN NO-APPLY.
            end.


            /* de-select OLD index */
            find first DICTDB._Index of DICTDB._File
              where DICTDB._Index._Index-name = l_old-rowid no-error.
            if available DICTDB._Index
             then assign DICTDB._Index._I-misc2[1] = 
                        substring( DICTDB._Index._I-misc2[1]
                                 , 2
                                 , -1
                                 , "character"
                                 ).
                   
            /* select NEW index */
            find first DICTDB._Index of DICTDB._File
              where DICTDB._Index._Index-name = l_new-rowid no-error.
            find first DICTDB._Index-Field of DICTDB._Index.
            find first DICTDB._Field of DICTDB._Index-Field.

            if l_ttb_idx.v_comp = TRUE
             then assign  /* schema remains V7.3 compatible */
              DICTDB._File._Fil-misc1[1] = DICTDB._Field._Fld-stoff * -1
              DICTDB._File._Fil-misc1[2] = DICTDB._Index._Idx-num
              DICTDB._File._Fil-misc2[3] = IF DICTDB._Field._Fld-misc2[3] <> ?
                                                THEN DICTDB._Field._Fld-misc2[3]
                                                ELSE DICTDB._Field._For-name
              DICTDB._Index._I-misc2[1]  = "r" + DICTDB._Index._I-misc2[1].

            else do:  /* schema is not V7.3 compatible anymore */
              assign
                DICTDB._File._Fil-misc1[1] = ?
                DICTDB._File._Fil-misc1[2] = DICTDB._Index._Idx-num
                DICTDB._File._Fil-misc2[3] = ?
                DICTDB._Index._I-misc2[1]  = "r"
                                     + ( if DICTDB._Index._I-misc2[1] = ?
                                          then "u"
                                          else DICTDB._Index._I-misc2[1]
                                       ).
            end.
                  
          end.  /* when odbtyp */

          otherwise
            message l_msg[15] view-as alert-box information buttons ok.

      end case.
      
    end.     /* old-rowid <> <progress_recid> */

    else if l_new-rowid <> "<progress_recid>"
      then message
        l_msg[8] {&skp}
        l_msg[9] {&skp}
        l_msg[10]
        view-as alert-box information buttons ok.

 end.  /* do with frame l_frm_idx */
end. /* on GO of frame l_frm_idx */
   
   
/*---------- WINDOW-CLOSE -> close dialog ----------*/

on window-close of frame l_frm_idx
   apply "END-ERROR" to frame l_frm_idx.

on window-close of frame l_frm_dtl
   apply "END-ERROR" to frame l_frm_dtl.


/*======================  INTERNAL PROCEDURES  ======================*/


/*==========================  MAIN CODE  ===========================-*/


/*------------ general initializations ------------*/

{adecomm/okrun.i  
    &FRAME  = "FRAME l_frm_idx" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
    }

{adecomm/okrun.i  
    &FRAME  = "FRAME l_frm_dtl" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    &CANCEL = " "
    {&HLP_BTN}
    }

find first DICTDB._File where RECID(_File) = p_file-recid.
if   DICTDB._File._Fil-misc1[1] <> ?
 AND DICTDB._File._Fil-misc1[1]  > 0
  then assign l_old-rowid = "<progress_recid>".

assign
  odbtyp     = {adecomm/ds_type.i
                 &direction = "odbc"
                 &from-type = "p_db-type"
                 }.
  odbtyp     = ( if can-do(odbtyp,p_db-type)
                    then p_db-type
                    else "NO-ODBC-TYPE"
               ).


/*-------- kick them out when progress_recid --------*/

if DICTDB._File._Fil-misc1[1] > 0
 and DICTDB._File._Fil-misc1[1] <> ?
 then do:  /* progress-Recid */
  message 
    l_msg[8] {&skp}
    l_msg[9] {&skp}
    l_msg[10]
    view-as alert-box information buttons ok.
  RETURN.
  end.     /* progress-Recid */


/*-------- generate temp-table records --------*/

create l_ttb_idx.

case p_db-type:
  when "ORACLE" then do:
  
             assign
               l_ttb_idx.name    = "<native ROWID>"
               l_ttb_idx.uniq    = TRUE
               l_ttb_idx.mand    = TRUE
               l_ttb_idx.dttype  = TRUE
               l_ttb_idx.slctbl  = FALSE
               l_ttb_idx.v_comp  = TRUE
               l_ttb_idx.fld#    = 1
               l_ttb_idx.detail  = ora_rid_det
               l_ttb_idx.slctd   = (  DICTDB._File._Fil-misc1[4] = 0
                                   or DICTDB._File._Fil-misc1[4] = ? 
                                   ).
             if l_ttb_idx.slctd
              then assign l_old-rowid = l_ttb_idx.name.

             end.  /* when "ORACLE" */

  otherwise  delete l_ttb_idx.

  end case.
 
  
/* browse: criterias:
 *       1   index-unique
 *       2   all fields mandatory
 *       3   prec <= 9 & ( scale <= 0 | scale = ? )
 *       4   selectability
 *       5   compatibility with V7.3
 *       6   number of fields in index
 *       7   no component is of type "float"
 */
 
/* index._I-misc2[1] can have the following characters:
 *   previous version
 *      a   automatically selectable index
 *      r   selected rowid-index
 *      u   user selectable index
 *   new version
 *      a   automatically selectable index
 *      r   selected rowid-index
 *      u   user selectable index
 *      x   non V7.3 compatible
 */
 
 
for each DICTDB._Index of DICTDB._File:

  if p_db-type = "ORACLE"
   then do:  /* p_db-type = "ORACLE" */
    if      can-do("a,ra",DICTDB._index._I-misc2[1])
     then assign
        l_dttype = TRUE
        l_fld#   = 0
        l_mand   = TRUE
        l_slctbl = TRUE
        l_v_comp = TRUE.
    else if can-do("ru,u",DICTDB._index._I-misc2[1])
     then do:  /* user-selectable */
      find first DICTDB._Index-Field of DICTDB._Index.
      find DICTDB._Field of DICTDB._Index-Field.
      assign
        l_dttype = NOT (DICTDB._Field._Fld-misc1[1] <= 9
                    AND DICTDB._Field._Fld-misc1[2] <= 0
                       )
        l_fld#   = 0
        l_mand   = DICTDB._Field._Mandatory
        l_slctbl = FALSE
        l_v_comp = TRUE.
      end.  /* user-selectable */
     else next.
    
    /* generate the details-report */
    assign l_detail = chr(10) + " Index: "
               + string(DICTDB._Index._Index-name,"x(28)") + " "
               + string(DICTDB._Index._Unique,"UNIQUE/Non-Unique") + "  "
               + ( if DICTDB._Index._I-misc2[1] begins "r"
                     then "crrntly slctd"
                     else ""
                  )
               + chr(10) + chr(10) + " "
               + string("Field"       ,"x(32)") + " " 
               + string("Mand"        ,"x(4)" ) + " "
               + string("Foreign Type","x(16)") + " "
               + string("Prec"        ,"x(4)")  + " "
               + string("Scale"       ,"x(5)")  + " "
               + chr(10) + " "
               + string(fill("-",40),"x(32)") + " "
               + string(fill("-", 6),"x(4)" ) + " "
               + string(fill("-",40),"x(16)") + " "
               + string(fill("-",10),"x(4)" ) + " "
               + string(fill("-",10),"x(5)" ) + " ".

    for each DICTDB._Index-Field of DICTDB._Index:
      find DICTDB._Field of DICTDB._Index-Field.
      assign
        l_detail = l_detail + chr(10) + " "
                 + string(DICTDB._Field._Field-name,"x(32)")   + " "
                 + string(DICTDB._Field._Mandatory,"Mand/Opt") + " "
                 + string(DICTDB._Field._For-Type,"x(16)")     + " "
                 + ( if DICTDB._Field._Fld-misc1[1] = ?
                      then "   ?"
                     else if LOOKUP(DICTDB._Field._data-type
                                ,"integer,character,decimal") <> 0
                      then string(DICTDB._Field._Fld-misc1[1],"zzz9")
                      else "    "
                   )  + " "
                 + ( if DICTDB._Field._Fld-misc1[2] = ?
                      then "   ?"
                     else if LOOKUP(DICTDB._Field._data-type
                                ,"integer,decimal") <> 0
                      then string(DICTDB._Field._Fld-misc1[2],"zz9-")
                      else "    "
                   )  + " "
             l_fld#   = l_fld# + 1.
      end.  /* for each DICTDB._Index-Field of DICTDB._Index */

    end.  /* p_db-type = "ORACLE" */
    
   else do:  /* p_db-type <> "ORACLE" */
    assign
      l_dttype = TRUE
      l_fld#   = 0
      l_mand   = TRUE
      l_slctbl = TRUE
      l_v_comp = TRUE.

    /* generate the details-report */
    assign l_detail = chr(10) + " Index: "
               + string(DICTDB._Index._Index-name,"x(28)") + " "
               + string(DICTDB._Index._Unique,"UNIQUE/Non-Unique") + " "
               + ( if DICTDB._Index._I-misc2[1] begins "r"
                     then "crrntly slctd"
                     else ""
                  )
               + chr(10) + chr(10) + " "
               + string("Field"       ,"x(32)") + " " 
               + string("Mand"        ,"x(4)" ) + " "
               + string("Foreign Type","x(16)") + " "
               + string("Lngth"       ,"x(5)")  + " "
               + string("Scale"       ,"x(5)")  + " "
               + chr(10) + " "
               + string(fill("-",40),"x(32)") + " "
               + string(fill("-", 6),"x(4)" ) + " "
               + string(fill("-",40),"x(16)") + " "
               + string(fill("-",10),"x(5)" ) + " "
               + string(fill("-",10),"x(5)" ) + " ".

    for each DICTDB._Index-Field of DICTDB._Index:
      find DICTDB._Field of DICTDB._Index-Field.
      assign 
        l_dttype   = l_dttype and DICTDB._Field._For-type <> "float"
        l_fld#     = l_fld# + 1
        l_v_comp   = ( l_v_comp
                        and   DICTDB._Field._For-type      = "integer"
              /*
                        and ( DICTDB._Field._Fld-misc1[1] <= 9
                           or DICTDB._Field._Fld-misc1[1]  = ? )
                        and ( DICTDB._Field._Fld-misc1[2] <= 0
                           or DICTDB._Field._Fld-misc1[2]  = ? )
              */
                     )
        l_mand     = l_mand  and DICTDB._Field._Mandatory
        l_detail   = l_detail + chr(10) + " "
                   + string(DICTDB._Field._Field-name,"x(32)")   + " "
                   + string(DICTDB._Field._Mandatory,"Mand/Opt") + " "
                   + string(DICTDB._Field._For-Type,"x(16)")     + " "
                 + ( if   DICTDB._Field._Fld-misc1[1] = ?
                      then "   ?"
                     else if LOOKUP(DICTDB._Field._data-type
                                   ,"integer,character,decimal") <> 0
                      then string(DICTDB._Field._Fld-misc1[1],"zzz9")
                      else "    "
                   )  + " "
                 + ( if DICTDB._Field._Fld-misc1[2] = ?
                      then "   ?"
                     else if LOOKUP(DICTDB._Field._data-type
                                   ,"integer,decimal") <> 0
                      then string(DICTDB._Field._Fld-misc1[2],"zz9-")
                      else "    "
                   )  + " ".
      end.  /* for each DICTDB._Index-field */

  end.  /* p_db-type <> "ORACLE" */
   
  if p_db-type = "ORACLE" and l_fld# > 1 then next.

  create l_ttb_idx.

  assign
    l_ttb_idx.name   = DICTDB._Index._Index-name
    l_ttb_idx.mand   = l_mand
    l_ttb_idx.dttype = l_dttype         
    l_ttb_idx.slctbl = l_slctbl and l_mand and DICTDB._Index._Unique
    l_ttb_idx.slctd  = ( if DICTDB._Index._I-misc2[1] <> ?
                           then DICTDB._Index._I-misc2[1] begins "r"
                           else FALSE
                       )
    l_ttb_idx.uniq   = DICTDB._Index._Unique
    l_ttb_idx.v_comp = l_v_comp
    l_ttb_idx.detail = l_detail.
    
  if l_ttb_idx.slctd then assign l_old-rowid = l_ttb_idx.name.
  
end.  /* for each DICTDB._Index of DICTDB._File */


/*------------ main transaction ------------*/

do transaction on error undo, leave on endkey undo, leave:

/*  if l_brs_idx:set-repositioned-row(1,"conditional") then. */ /* see comment
                                                                   below    */  
  open query l_qry_idx preselect each l_ttb_idx.
  
  if num-results("l_qry_idx") = 0
   then do:
     message l_msg[16] view-as alert-box information buttons ok.
     return.
     end.  /* no objects to select from */
  
  assign
    l_brs_idx:max-data-guess in frame l_frm_idx = num-results("l_qry_idx")
    l_new-rowid                                 = l_old-rowid.

  if l_old-rowid = "<progress_recid>"
   then message 
     l_msg[8] {&skp}
     l_msg[9] {&skp}
     l_msg[10]
     view-as alert-box information buttons ok.
     
  enable
    l_brs_idx
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    with frame l_frm_idx.

  find first l_ttb_idx where l_ttb_idx.name = l_old-rowid no-error.
  if available l_ttb_idx
   then do:
/*     reposition l_qry_idx to rowid(rowid(l_ttb_idx)). */ /* uncomment after
                                                              core problem 
                                                              fixed         */                                                            
     l_ttb_idx.slctd = yes.
     end.
        
  l_result = l_brs_idx:select-focused-row().   
       
  wait-for choose of btn_OK in frame l_frm_idx
        or go               of frame l_frm_idx.

  disable
    l_brs_idx
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    with frame l_frm_idx.
  
  end.  /* do transaction */
  
if l_old-rowid <> l_new-rowid
 then do:
   return "MOD".
   end.
 else return "NOT MODIFIED".
 
/*====================================================================*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gat_trg.p

Description:
    
    To solve the fldpos-problem we delete all triggers and recreate
    them new

    
Author: Tom Hutegger

History:
    hutegger    95/02/23    moved from ism_trg.p to gat_trg.i
    hutegger    94/08/18    creation
    
--------------------------------------------------------------------*/        
/*h-*/

define INPUT parameter p_frecid    as   RECID.

define temp-table y_Field-Trig
        field     y_Event          like DICTDB._Field-Trig._Event
        field     y_Proc-name      like DICTDB._Field-Trig._Proc-Name
        field     y_Override       like DICTDB._Field-Trig._Override
        field     y_Trig-Crc       like DICTDB._Field-Trig._Trig-Crc
        field     y_Field-Recid    like DICTDB._Field-Trig._Field-Recid.
        

for each DICTDB._Field-trig
  where DICTDB._Field-Trig._file-recid = p_frecid:

  create y_Field-Trig.
  assign
    y_Field-Trig.y_Event       = DICTDB._Field-Trig._Event
    y_Field-Trig.y_Proc-name   = DICTDB._Field-Trig._Proc-Name
    y_Field-Trig.y_Override    = DICTDB._Field-Trig._Override
    y_Field-Trig.y_Trig-Crc    = DICTDB._Field-Trig._Trig-Crc
    y_Field-Trig.y_Field-Recid = DICTDB._Field-Trig._Field-Recid.

  delete DICTDB._Field-Trig.

  end.

for each y_Field-trig:
  
  create DICTDB._Field-Trig.
  assign
    DICTDB._Field-Trig._Field-Recid = y_Field-Trig.y_Field-Recid
    DICTDB._Field-Trig._File-Recid  = p_frecid
    DICTDB._Field-Trig._Event       = y_Field-Trig.y_Event
    DICTDB._Field-Trig._Proc-name   = y_Field-Trig.y_Proc-Name
    DICTDB._Field-Trig._Override    = y_Field-Trig.y_Override
    DICTDB._Field-Trig._Trig-Crc    = y_Field-Trig.y_Trig-Crc.
  
  delete y_Field-Trig.

  end.
  
/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* file: gate/_gat_xlt.p */

/* generic name conversion code taken from: */
/* ora_fil - File manager for ORACLE databases */
/* ora_idx - Index manager for ORACLE databases */

/*
old version, new version is file prodict/gate/_gat_fnm.p

Modified: 07/13/98 Added _Owner to _file finds

*/
/*h-*/

DEFINE INPUT        PARAMETER file-index AS LOGICAL   NO-UNDO.
DEFINE INPUT        PARAMETER obj_parent AS RECID     NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER obj_name   AS CHARACTER NO-UNDO.

/*
DEFINE VARIABLE c AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER   NO-UNDO.
DEFINE VARIABLE r AS RECID     NO-UNDO.
DEFINE VARIABLE s AS CHARACTER NO-UNDO.
*/

if file-index = TRUE
 then run prodict/gate/_gat_fnm.p
  ( INPUT        "TABLE",
    INPUT        obj_parent,
    INPUT-OUTPUT obj_name
  ).
else 
if file-index = FALSE
 then run prodict/gate/_gat_fnm.p
  ( INPUT        "INDEX",
    INPUT        obj_parent,
    INPUT-OUTPUT obj_name
  ).
 else run prodict/gate/_gat_fnm.p
  ( INPUT        "SEQUENCE",
    INPUT        obj_parent,
    INPUT-OUTPUT obj_name
  ).

/*
IF file-index = TRUE THEN DO TRANSACTION: /*--*/ /* translate file name */
  /* this translates a foreign file name into a native file name which is
     guaranteed not to be currently in use in this database */
  ASSIGN
    c = SUBSTRING(obj_name,INDEX(obj_name,".") + 1,-1,"character")
    c = SUBSTRING(c,IF c BEGINS "_" THEN 2 ELSE 1,32,"character").
  DO i = 1 to LENGTH(c,"character"): 
    IF INDEX("#$%&-_0123456789ETAONRISHDLFCMUGYPWBVKXJQZ", SUBSTRING(c, i, 1,"character")) <= 0 THEN
      ASSIGN SUBSTRING(c, i, 1,"character") = "_".
  END.
  ASSIGN    
    c = c + (IF KEYWORD(c) = ? THEN "" ELSE "_")
    s = c.
  DO i = 1 TO 9999
    WHILE CAN-FIND(FIRST _File
      WHERE _File._Db-recid = obj_parent AND _File._File-name = c
        AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")):
    c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") + STRING(- i).
  END.
  obj_name = c.
END.

ELSE IF file-index = FALSE THEN DO TRANSACTION: /* translate index name */
  /* this translates a foreign index name into a native index name which
     is guaranteed not to be currently in use in this file */
  FIND _File WHERE RECID(_File) = obj_parent.
  ASSIGN
    c = obj_name
    s = _File._For-Name
    s = SUBSTRING(s,INDEX(s,".") + 1,-1,"character").
  IF c BEGINS s + "##" THEN c = SUBSTRING(c,LENGTH(s,"character") + 3,-1,"character").
  c = SUBSTRING(c,IF c BEGINS "_" THEN 2 ELSE 1,32,"character").
  DO i = 1 to LENGTH(c,"character"): 
    IF INDEX("#$%&-_0123456789ETAONRISHDLFCMUGYPWBVKXJQZ", SUBSTRING(c, i, 1,"character")) <= 0 THEN
      ASSIGN SUBSTRING(c, i, 1, "character") = "_".
  END.
  IF KEYWORD(c) <> ? THEN SUBSTRING(c,MINIMUM(32,LENGTH(c,"character") + 1),-1,"character") = "_".
  s = c.
  DO i = 1 TO 9999
    WHILE CAN-FIND(FIRST _Index OF _File
      WHERE _Index._Index-name = c):
    c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") + STRING(- i).
  END.
  obj_name = c.
END.

ELSE DO TRANSACTION: /*-------------------*/ /* translate sequence name */
  /* this translates a foreign sequence name into a native sequence name which
     is guaranteed not to be currently in use in this file */
  ASSIGN
    c = SUBSTRING(obj_name,INDEX(obj_name,".") + 1,-1,"character")
    c = SUBSTRING(c,IF c BEGINS "_" THEN 2 ELSE 1,32,"character").
  DO i = 1 to LENGTH(c,"character"): 
    IF INDEX("#$%&-_0123456789ETAONRISHDLFCMUGYPWBVKXJQZ", SUBSTRING(c, i, 1,"character")) <= 0 THEN
      ASSIGN SUBSTRING(c, i, 1,"character") = "_".
  END.
  ASSIGN    
    c = c + (IF KEYWORD(c) = ? THEN "" ELSE "_")
    s = c.
  DO i = 1 TO 9999
    WHILE CAN-FIND(FIRST _Sequence
      WHERE /* _Sequence._Db-recid = obj_parent 
      AND   */ _Sequence._Seq-name = c):
    c = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") + STRING(- i).
  END.
  obj_name = c.
END.
*/

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gatxnum.p

Description:
    Some DataServers don't supply a index-number, so we have to 
    generate one.
    
Input-Parameters:
    p_file-recid    RECID of file the indes gets defined for
    
Output-Parameters:
    p_index-num     Index-number to be used
    
    
History:
    hutegger    94/07/01    creation
    
--------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_file_recid AS RECID NO-UNDO.
DEFINE OUTPUT PARAMETER p_index-num  AS INTEGER NO-UNDO.

/*------------------------------------------------------------------*/

ASSIGN p_index-num = 0.

FOR EACH DICTDB._Index 
  WHERE DICTDB._Index._File-recid = p_file_recid 
  NO-LOCK:
  IF DICTDB._Index._idx-num <> ? 
    AND DICTDB._Index._idx-num > p_index-num 
    THEN ASSIGN p_index-num = DICTDB._Index._idx-num.
  END.

ASSIGN p_index-num = p_index-num + 1.

RETURN.


/*------------------------------------------------------------------*/
/************************************************************************
* Copyright (C) 2000,2008,2009 by Progress Software Corporation. All    *
* rights reserved. Prior versions of this work may contain portions     *
* contributed by participants of Possenet.                              *
*                                                                       *
************************************************************************/

/*--------------------------------------------------------------------

file: _snd_sql.i - Send.SQL to foreign DB to create db-objects
 
Author:     Rob Adams

Component:  Protoxxx   (progress to foreign datamanager)

Purpose:    Read in SQL from a file created by _wrktgen.p
            and use SEND-SQL-STATEMENT stored procedure
            to perform each command inside foreign data manager. 

            NOTE: The output of this file can be adjusted 
                 by using the local environment variables 
                 and the dataserver dependent section at 
                 begining of the code.

Text Parameters:
    &DEBUG          "DEBUG" or ""  for  want debugging output or not 

Input Parameters:
    p_cmmnt-chr     character-string to indicate a comment line
    p_debug         debugging output wanted or not
    p_db-name       name of 
    p_eosttmnt      end of statement ("go" or ";")
    p_owner         only used for oracle
    p_sql-file      name of sql-file to apply
    
Output Parameters:
    none

Used/Changed Shared Objects:
    logfile         Logfile for errors and/or debugging-messages
                    if we're in batchmode, need to output something but
                    it's not yet open (i.e. logfile_open = false),
                    we open it to the file p_sql-file (with ".sql"
                    replaced by ".log")
    logfile_open    gets set to true:
                    if there is an error and we're in batchmode and 
                    logfile_open = false.
                    
History:    
    31 March 2000 D. McMann Added MSS DataServer

    21 Sep 1995  Hutegger Made program batch-runnable by allowing output
                          being sent to file; in the process moved all 
                          output to internal routine (error_handling) and
                          added a couple of comments to end statments to 
                          make program easier to read...
                          replaced &DEBUG preprocessor variable with
                          parameter p_debug
     2 Aug 1995  Hutegger Moved code from _snd_sql.i to _snd_sql.p and
                          generalized this routine to be useable standalone
                          too (UI: prodict/send_sql.p)
    22 Jun 1995  DAN      Debugging. code get debug output just set 
                          debuggin var to yes.
    19 Jul 1995  RLA      Add rejection of object type = 10 to oracle drop 
                          logic.
     6 Sep 1994  RLA      Add Oracle drop logic. 
                          Add batch mode output functions
                          Add switching from chained to unchained mode.
                          Add object failure notification. 
     6 Jul 1994  RLA      add some output to let user know we're working
     7 Jun 1994  davidn   Added informix specific dependencies.

                          Added comit1_per_stmt  to the local
                          environment.  With the idea that some
                          dataserver do not like to have a comit
                          after every statement.(like informix) 
                        
                          NOTE: The clear_buffers flage is part 
                          of a work around for a bug in running 
                          stored procs.  If there is no output to 
                          retrieve from the dataserver after the 
                          sql statement has been sent, some data
                          servers send back an error message that 
                          progress does not yet no how to handle.
                          Udi is currently working on this, and it
                          should be fixed soon. When the fix goes in,
                          we should be able to get rid of the clear_
                          buffers flag
                          -----davidn 7 Jun 1994 
     2 Jun 1994  RLA      Make generic for all datamanagers. 
    19 May 1994  RLA      Creation.
    3  Mar 1996  aluk     Added support for ODBC in general.
    11/24/97     DLM      Added view-as dialog-box in non TTY clients
    03/08/99     DLM      Added check for statement terminator of go
    03/23/99     DLM      Added check for ; for oracle is really end of statement
    04/22/99     DLM      Changed check for dropping to see if 1 or more objects
                          exists with name.
    03/13/00     DLM      Added change for Oracle to determine what version so the
                          proper field name is used type or type# 20000320022
    11/19/01     DLM      Changed check for sqlnet connection string parsing
    08/11/08     ashukla  LDAP support (CR#OE00172458)
    10/13/09     rkumar   Sybase DataServer OE00164101- Set comit1_per_stmtm to TRUE

/* 
 * TODO: Add error handling to deal w/ errors returned 
 * from the various dataservers. For now we will only 
 * print them to the screen if debugging is turned on 
 */ 
--------------------------------------------------------------------*/
/*h-*/

define input parameter p_cmmnt-chr  as character.
define input parameter p_db-name    as character.
define input parameter p_debug      as logical.
define input parameter p_eosttmnt   as character.
define input parameter p_owner      as character.
define input parameter p_sql-file   as character.

define shared variable logfile_open as logical no-undo.
define shared stream   logfile.

define variable add_cr          as logical initial TRUE.
define variable batch_mode      as logical.
define variable change_chained_mode    as logical initial FALSE. 
define variable check_for_drop  as logical.
define variable clear_buffers   as logical   initial true. 
define variable closeall        as logical   initial TRUE.
define variable create_line     as character.
define variable creating        as character extent 2 no-undo.
define variable comit1_per_stmt AS logical   initial TRUE. 
define variable drop_indicator  as character. 
define variable drop_line       as character.
define variable drop_terminator as logical   initial FALSE.
define variable dropit          as logical.
define variable function_performed     as logical.
define variable h               as integer   no-undo init ?. 
define variable i               as integer. 
define variable j               as integer.
define variable l_edbtyp        as character format "x(10)".
define variable l_i             as integer.
define variable l_logfile       as character.
define variable line            as character format "x(320)".
define variable oracle_drop     as logical   initial false.
define variable owner_name      as character. 
define variable ret_ok          as logical   no-undo init yes. 
define variable separate_drop   as logical   initial false.
define variable separate_term   as logical   initial false.
define variable skip_use_clause as logical   initial false. 
define variable sql_stream      as character.
define variable title_string    as character no-undo format "x(60)".
define variable tmp_line        as character format "x(320)".
define variable word            as character extent 4 no-undo.
DEFINE VARIABLE ldaph1          AS INTEGER   NO-UNDO. /*ldap cn#OE00172458 */


define stream sql_lines.


FORM 
                                                    skip(1)
    creating[1] FORMAT "x(30)" LABEL "Name" colon 8 
    creating[2] FORMAT "x(20)" LABEL "Type" colon 8
    WITH row 4 centered &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box 
    three-d &ENDIF ATTR-SPACE overlay side-labels
    TITLE title_string USE-TEXT
    width 58 /* to produce enough room for DBE */
    frame sql_frame.


      
/*---------------------  Internal Procedures  ----------------------*/

procedure error_handling:

  define INPUT PARAMETER p_error-nr         as INTEGER.
  define INPUT PARAMETER p_param1           as CHARACTER.
  define INPUT PARAMETER p_param2           as CHARACTER.
  define INPUT PARAMETER p_type             as CHARACTER.

  define variable err-msg     as character format "x(70)" extent 19
      initial [
  /*  1 */ "Cannot find database &1.",
  /*  2 */ "Database &1 is not connected.",
  /*  3 */ "Comment-String was """"; It got set to ?",
  /*  4 */ "SEND-SQL FAILED SENDING: &1",
  /*  5 */ "Creating objects - Name: &1     Type: &2",
  /*  6 */ "  : &1",
  /*  7 */ "***** WARNING Object Name: &1 - Type: &2 not created!",
  /*  8 */ "Proc-Text-Buffer: &1",
  /*  9 */ "",
  /* 10 */ "commit1_per_stmt: &1",
  /* 11 */ "dropit: &1",
  /* 12 */ "SENDING SQL: &1",
  /* 13 */ "Return OK: &1",
  /* 14 */ "ERROR-STATUS: &1",
  /* 15 */ "-- Creating objects in &1 database.",
  /* 16 */ "",
  /* 19 */ ""
              ].     


  if p_param1 = ? then assign p_param1 = "".
  if p_param2 = ? then assign p_param2 = "".
    
  if logfile_open
   then case p_type:
    when "debug" then do:
            if p_debug
             then put stream logfile unformatted
                "DEBUGGING _snd_sql.i: "
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2) skip.
            end. /* debug */
            
    when "error"     then put stream logfile unformatted
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2) skip.

    when "paragraph" then put stream logfile unformatted
                "-- ++"                                           skip
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2) skip
                "-- --"                                           skip(1).

    otherwise             put stream logfile unformatted
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2) skip.
    end case.

   else case p_type:

    when "debug"     then do:
            if p_debug
             then message
                "DEBUGGING _snd_sql.i: "
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2)
                view-as alert-box.
            end. /* debug */

    when "error"     then message
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2)
                view-as alert-box error.

    when "paragraph" then /* no paragraph info needed on screen */.

    otherwise             message
                SUBSTITUTE(err-msg[p_error-nr],p_param1,p_param2)
                view-as alert-box.
    end case.

  end PROCEDURE.  /* error_handling */

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

  

assign
  batch_mode     = SESSION:BATCH-MODE.

if batch_mode and not logfile_open then do: /* we need to open the output to the log-file */
  assign
    l_i          = length(p_sql-file,"character") - 3
    l_logfile    = ( if substring(p_sql-file
                                 ,l_i
                                 ,-1
                                 ,"character"
                                 )             =    ".sql"
                      then substring(p_sql-file,1,l_i - 1, "character")
                      else p_sql-file
                   ) + ".log"
    logfile_open = true.
  output stream logfile to value(l_logfile).
  end. /* we need to open the output to the log-file */

find first DICTDB._Db
  where DICTDB._Db._Db-name = p_db-name
  no-lock no-error.
if not available DICTDB._Db
 then do:
  run error_handling(1,p_db-name,"","error").
  leave.
  end.
  

if LDBNAME("DICTDBG") = ?
 or not connected("DICTDBG")
 then do:
  run error_handling(2,p_db-name,"","error").
  leave.
  end.

assign
  l_edbtyp       = {adecomm/ds_type.i
                     &direction = "itoe"
                     &from-type = "DICTDB._Db._Db-type"
                   }
  title_string   = "Creating " + l_edbtyp + " Objects".



if NOT logfile_open
 then assign SESSION:IMMEDIATE-DISPLAY = yes.

if p_cmmnt-chr = ""
 then do:
  assign p_cmmnt-chr = ?.
  run error_handling(3,"","","info").
  end.

/*-----begin data server dependent settings */ 

/* Not completly generic, but at least all  */
/* of the dependencies are in one place.    */
 
case l_edbtyp: 
  when "ODBC" then assign
    separate_term   = (IF p_eosttmnt = "go" THEN TRUE ELSE FALSE) 
    separate_drop   = false
    change_chained_mode = false
    skip_use_clause = true
    add_cr          = false
    comit1_per_stmt = (IF (INDEX(DICTDB._Db._Db-misc2[5], "SQL Server") <> 0) THEN TRUE ELSE FALSE )
    drop_terminator = (IF p_eosttmnt = "go" THEN FALSE ELSE true)
    clear_buffers   = false . 

  when "MSS" then assign
    separate_term   = (IF p_eosttmnt = "go" THEN TRUE ELSE FALSE) 
    separate_drop   = false
    change_chained_mode = false
    skip_use_clause = true
    add_cr          = false
    comit1_per_stmt = false
    drop_terminator = (IF p_eosttmnt = "go" THEN FALSE ELSE true)
    clear_buffers   = false .

  when "ORACLE"    then assign
    clear_buffers   = TRUE
    closeall        = FALSE 
    comit1_per_stmt = FALSE
    oracle_drop     = true
    add_cr          = false
    drop_indicator  = "1"          /* this is a 1 because if the       */
                                   /* table exists there can be only 1 */
    drop_terminator = TRUE. 
  end case.
   
/*-----End data server dependent settings */

run error_handling(15,l_edbtyp,"","paragraph").
run error_handling(10,string(comit1_per_stmt),"","debug").
run error_handling(11,string(dropit),"","debug").


/*
** If this is Oracle we may have to strip the user name of excess jazz 
** like the sql*net connect parameters etc. 
** 
** The name could be in three formats:
**
**      user (i = 0 j = 0)
**      user@connection_string (i = 0 j = #)
**      user/password@connection_string (i = # j = # i < j)
**
*/
if l_edbtyp = "ORACLE" then do:
  ASSIGN owner_name = CAPS(p_owner)
         i = index(owner_name,'/')
         j = index(owner_name,'@').

  if i <> 0 THEN
    ASSIGN owner_name = substr(owner_name, 1, i - 1, "character"). 
      
  ELSE IF j <> 0 THEN
    ASSIGN owner_name = substr(owner_name, 1, j - 1, "character"). 

/* In case l_owner is null, we are using external authentication 
 * Get user name from database 
   CR#OE00172458.Begin 
 */
IF  owner_name EQ "" OR owner_name EQ ? THEN
DO:
   RUN STORED-PROC DICTDBG.send-sql-statement 
       ldaph1 = PROC-HANDLE NO-ERROR 
       ("SELECT USER FROM DUAL").

   IF NOT ERROR-STATUS:ERROR AND ldaph1 <> ? THEN DO: 
     FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = ldaph1:
           owner_name = TRIM(proc-text).
     END.
     CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = ldaph1.
   END.
END.
/*   CR#OE00172458.End */ 
end.

if change_chained_mode then do:
  
    RUN STORED-PROC DICTDBG.send-sql-statement
      h = PROC-HANDLE NO-ERROR ("set chained off").

    /* grab return status from send sql */      
    ret_ok  = NOT ERROR-STATUS:ERROR.

    if ret_ok then do:          

      if clear_buffers
       then for each DICTDBG.proc-text-buffer 
        where PROC-HANDLE = h:
        run error_handling(8,DICTDBG.proc-text-buffer.proc-text,"","debug").
        end.     /* clear_buffers */

      CLOSE STORED-PROC DICTDBG.send-sql-statement 
        where PROC-HANDLE = h . 

      end.  /* ret_ok = TRUE */

     else run error_handling(4,"set chanied off","","error").

    assign h = ? .            /* set handle to null */

  end.  /* if changed_chained_mode */



/* 
 * get all the sql statements from 
 * the file created by _wrktgen.p
 */
input stream sql_lines FROM VALUE(p_sql-file).

REPEAT ON STOP UNDO, LEAVE:  /* repeat reading lines from sql-file */
    
    assign
      line           = ""
      check_for_drop = false.

    /*
     * get each line from file to form commands to send.
     */
    REPEAT:  /* get an entire sql statement */
      
      IMPORT STREAM sql_lines UNFORMATTED tmp_line.
   
      /* 
       * Skip empty lines
       */
      if tmp_line = "" then next. 
   
      /* 
       * Skip empty sql-commands
       */
      if tmp_line = p_eosttmnt and line = "" then next.

      /* 
       * If the line begins with a comment, skip it.
       */
      if   p_cmmnt-chr <>   ?
       and tmp_line  begins p_cmmnt-chr
       then next. 

      /* 
       * leave this loop at end of statements (go) or end of 
       * file (exit).
       */
      tmp_line = trim(tmp_line).
      if tmp_line = "exit" then leave.
      
      if separate_term and tmp_line = p_eosttmnt then leave.

      /*
       * If we are to drop a table or procedure which had some
       * set of statements proceding us, then tag the 
       * line with a note to ourselves so we'll know to commit 
       * a drop after the inquiry. 
       */
      if (tmp_line begins "drop ")
       and (line <> "") 
       and (separate_drop = TRUE)
       then do:
        assign
          check_for_drop = true
          drop_line      = tmp_line
          line           = line           + "select '"
                         + drop_indicator + ": " 
                         + drop_line      + "'"
                         + CHR(12).
      end. 
      else if (oracle_drop = TRUE) AND (tmp_line begins "drop ") then do:
        assign
          i              = index(tmp_line," ") + 1
          word[1]        = substr(tmp_line, i, -1, "character")
          i              = index(word[1], " ") + 1
          word[1]        = substr(word[1], i, -1, "character")
          j              = index(word[1], p_eosttmnt) - 1
          word[1]        = CAPS(substr(word[1], 1, j, "character"))
          check_for_drop = true
          j              = index(tmp_line, p_eosttmnt) - 1
          drop_line      = substr(tmp_line, 1, j, "character").

        /* 
         * Filtering objects with the same name that we own 
         * and that are not "pending delete" ojects (type = 10) 
         * to see if we can safely drop the object. 
        */ 
        IF _Db._Db-misc1[3] = 7 THEN
          assign line = "select count(*) from sys.obj$ "
                    + "where name = '" + word[1] + "'"
                    + " and type != 10 "               
                    + " and owner# = (select user# from sys.user$ "
                    + " where name = '" + owner_name + "')".
        ELSE
          assign line = "select count(*) from sys.obj$ "
                    + "where name = '" + word[1] + "'"
                    + " and type# != 10 "               
                    + " and owner# = (select user# from sys.user$ "
                    + " where name = '" + owner_name + "')".

      end.
      else do:
        assign line = line + " "
                    + ( if add_cr
                          then tmp_line + chr(12)
                          else tmp_line
                      ).
        if  tmp_line begins "CREATE "
         or tmp_line begins "sp_primarykey"
         then assign
           create_line = tmp_line.
        end. 
      /* 
       * If the this is the end of a statement (p_eosttmnt is the 
       * terminator of a sql statement) then leave the loop and 
       * process the statement. 
       */
       
      IF l_edbtyp = "ORACLE" AND INDEX(tmp_line,p_eosttmnt) = LENGTH(tmp_line) THEN
        LEAVE.
     
      if   (not separate_term)
       and (INDEX(tmp_line,p_eosttmnt) <> 0)
       then leave. 

      end.   /* get an entire sql statement */

    /* 
     * Skip empty lines
     */
    if line = "" then leave.


    /* 
     * Don't bother with a use, the dataserver does that for us.
     */
    if line begins "use" and skip_use_clause then next. 


    /* 
     * The END of the file is marked by an "exit" statement.
     */
    if tmp_line = "exit" then leave. 
    
    if drop_terminator
      then assign
       i    = LENGTH(line) - 1 
       j    = INDEX(line,p_eosttmnt) - 1.
    /* Oracle allows semi-colons in quoted strings */
    if ( (l_edbtyp = "ORACLE") and  (j > 0) and (i > j)) then j = i.
    if drop_terminator
      then assign
       line = ( if ( l_edbtyp <> "ORACLE"
                 or  index(CAPS(line),"BEGIN") = 0
                 or  index(CAPS(line),"END;") = 0 )
                 then SUBSTR(line, 1, j, "character")
                 else line
              ). 

    
    /* 
     * Display the SQL that we are going to send to the foreign datamanager.
     */
    if create_line <> ""
     then do:  /* create_line <> "" */
      DO i = 1 to 4:
        assign
          j = INDEX(create_line," ") - 1.
          word[i] = TRIM(substr(create_line, 1, j, "character")).
          j = j + 2. 
          create_line = TRIM(substr(create_line, j, -1, "character")).
        end.  

      case word[2]:
        when "unique"    then assign
                         word[2] = "Unique Index"
                         word[3] = word[4].
        when "table"     then assign
                         word[2] = "Table". 
        when "SEQUENCE"  then assign
                         word[2] = "Sequence".
        when "trigger"   then  assign
                         word[2] = "Trigger".
        when "procedure" then  assign
                         word[2] = "Procedure".
        when "index"     then  assign
                         word[2] = "Index".
        end case.

      if not batch_mode
       then display
         word[3] @ creating[1]
         word[2] @ creating[2]
         WITH FRAME sql_frame. 
       else run error_handling(5,word[3],word[2],"info").      

      end.     /* create_line <> "" */
     
     
  /*   
   * Send the SQL off and check the return value.
   * If "Note to Myself" comes back, we know we have a pending
   * drop to perform.   "Note to Myself" won't come back unless 
   * the object is "droppable".
   */
  function_performed = false. 

  do on stop undo, leave:

    /* if debugging then output sqlline to the screen
     * before  we send it
     */

    run error_handling(10,string(comit1_per_stmt),"","debug").
    run error_handling(11,string(dropit),"","debug").
    run error_handling(12,line,"","debug").

    RUN STORED-PROC DICTDBG.send-sql-statement 
          h = PROC-HANDLE NO-ERROR (line).

    ret_ok  = ( NOT ERROR-STATUS:ERROR
                or line = ""
              ).
    if ret_ok
     then do:  /* outer ret_ok */

      if clear_buffers then for each DICTDBG.proc-text-buffer where PROC-HANDLE = h:
        if check_for_drop then 
          assign check_for_drop = false
                 dropit         = (IF INTEGER(DICTDBG.proc-text-buffer.proc-text) > 0 THEN TRUE
                                      ELSE FALSE).                                                      
        else run error_handling
                        (8,DICTDBG.proc-text-buffer.proc-text,"","debug").
      end.     /* clear_buffers */
   
      if h <> ?
       then CLOSE STORED-PROC DICTDBG.send-sql-statement
          where PROC-HANDLE = h. 
      assign h = ?.


      /* 
       * Only commit if the previous send-sql  
       * was succesful
       */
      if comit1_per_stmt
       then do:  /* comit1_per_stmt */

        RUN STORED-PROC  DICTDBG.send-sql-statement
              h = PROC-HANDLE NO-ERROR ("commit").

        assign ret_ok  = NOT ERROR-STATUS:ERROR.
        
        if ret_ok
         then do: /* inner ret_ok */

          if clear_buffers
           then for each DICTDBG.proc-text-buffer
            where PROC-HANDLE = h:
            run error_handling
                        (8,DICTDBG.proc-text-buffer.proc-text,"","debug").
            end.     /* clear_buffers */

          CLOSE STORED-PROC DICTDBG.send-sql-statement
                  where PROC-HANDLE = h. 
          assign h = ?.

          end.

         else do:  /* inner ret_ok = FALSE */
          run error_handling(4,"commit","","error").
          DO l_i = 1 TO ERROR-STATUS:NUM-MESSAGES:
            run error_handling(6,ERROR-STATUS:GET-MESSAGE(l_i),"","error").
            run error_handling(6,string(ERROR-STATUS:GET-NUMBER(l_i)),"","error").
            end. 
          end.     /* inner ret_ok = FALSE */

        end.     /* comit1_per_stmt */

      end.     /* outer ret_ok */

     else do:  /* outer ret_ok = FALSE */
      run error_handling(4,line,"","error").
      DO l_i = 1 TO ERROR-STATUS:NUM-MESSAGES:
        run error_handling(6,ERROR-STATUS:GET-MESSAGE(l_i),"","error").
        run error_handling(6,string(ERROR-STATUS:GET-NUMBER(l_i)),"","error").
        end. 
      end.     /* outer ret_ok = FALSE */



    /* 
     * If we have a pending drop, use the original drop line
     * and then commit the transaction.
     */

    if dropit
     then do:  /* dropit */

      RUN STORED-PROC DICTDBG.send-sql-statement
          h = PROC-HANDLE NO-ERROR (drop_line).

      assign ret_ok  = NOT ERROR-STATUS:ERROR.

      run error_handling(12,drop_line,"","debug").
      run error_handling(13,string(ret_ok),"","debug").
      run error_handling(14,string(ERROR-STATUS:ERROR),"","debug").

      if ret_ok
       then do:   /* outer ret_ok */

        if clear_buffers
         then for each DICTDBG.proc-text-buffer
            where PROC-HANDLE = h :
            run error_handling
                        (8,DICTDBG.proc-text-buffer.proc-text,"","debug").
          end.     /* clear_buffers */

        CLOSE STORED-PROC DICTDBG.send-sql-statement
          where PROC-HANDLE = h. 
        assign h = ? .

        if comit1_per_stmt
         then do:  /* comit1_per_stmt */

          RUN STORED-PROC  DICTDBG.send-sql-statement
              h = PROC-HANDLE NO-ERROR ("commit").

          assign ret_ok  = NOT ERROR-STATUS:ERROR.
        
          if ret_ok
           then do: /* inner ret_ok */

            if clear_buffers
             then for each DICTDBG.proc-text-buffer
              where PROC-HANDLE = h:
              run error_handling
                        (8,DICTDBG.proc-text-buffer.proc-text,"","debug").
              end.     /* clear_buffers */

            CLOSE STORED-PROC DICTDBG.send-sql-statement
                  where PROC-HANDLE = h. 
            assign h = ? .

            end.

           else do:  /* inner ret_ok = FALSE */
            run error_handling(4,"commit","","error").
            DO l_i = 1 TO ERROR-STATUS:NUM-MESSAGES:
              run error_handling(6,ERROR-STATUS:GET-MESSAGE(l_i),"","error").
              run error_handling(6,string(ERROR-STATUS:GET-NUMBER(l_i)),"","error").
              end. 
            end.     /* inner ret_ok = FALSE */

          end.     /* comit1_per_stmt */

        end.     /* outer ret_ok */

       else do:  /* outer ret_ok = FALSE */
        run error_handling(4,line,"","error").
        DO l_i = 1 TO ERROR-STATUS:NUM-MESSAGES:
          run error_handling(6,ERROR-STATUS:GET-MESSAGE(l_i),"","error").
          run error_handling(6,string(ERROR-STATUS:GET-NUMBER(l_i)),"","error").
          end. 
        end.     /* outer ret_ok = FALSE */

      assign dropit = false. 

      end.     /* dropit */

    assign function_performed = true. 

    end.  /* do on stop undo, leave */

  if not function_performed
   and create_line <> ""
   then run error_handling(7,word[3],word[2],"error").

  assign create_line = "". /* clear out create line for next create. */

  end.   /* repeat reading lines from sql-file */

input stream sql_lines CLOSE.


if change_chained_mode
 then do:  /* change_chained_mode */
  
  RUN STORED-PROC DICTDBG.send-sql-statement
      h = PROC-HANDLE NO-ERROR ("set chained on").

  /* grab return status from send sql */      
  assign ret_ok  = NOT ERROR-STATUS:ERROR.

  if ret_ok
   then do:  /* ret_ok */

    if clear_buffers
     then for each DICTDBG.proc-text-buffer 
      where PROC-HANDLE = h:
      run error_handling(8,DICTDBG.proc-text-buffer.proc-text,"","debug").
      end.

    CLOSE STORED-PROC DICTDBG.send-sql-statement 
      where PROC-HANDLE = h . 

    end.  /* ret_ok */
    
   else run error_handling(4,"set chanied off","","error").

  assign h = ? .            /* set handle to null */

  end.  /* changed_chained_mode */


if not logfile_open
 then do:
  SESSION:IMMEDIATE-DISPLAY = no.
  HIDE FRAME sql_frame NO-PAUSE.
  end.
 
/*------------------------------------------------------------------*/


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File:
    prodict/gate/_snd_sql.p
 
Description:
    call the db-type specifique _snd_sql.p routine

Input Parameters:
    p_cmmnt-chr     character-string to indicate a comment line
    p_debug         debugging output wanted or not
    p_db-name       name of 
    p_db-type       db-type of foreign db
    p_eosttmnt      end of statement ("go" or ";")
    p_owner         only used for oracle
    p_sql-file      name of sql-file to apply

Output Parameters:
    none
        
History:    
    95/09   hutegger    replaced &DEBUG preprocessor variable with
                        parameter p_debug
    95/08   hutegger    swithced .i and .p fiels around to get 
                        _snd_sql.p to have defined input-parameters
                        instead of user_env-variables
    00/03/31 D. McMann Added MSS for database type.

--------------------------------------------------------------------*/
/*h-*/

define input parameter p_cmmnt-chr  as character.
define input parameter p_debug      as logical.
define input parameter p_db-name    as character.
define input parameter p_db-type    as character.
define input parameter p_eosttmnt   as character.
define input parameter p_owner      as character.
define input parameter p_sql-file   as character.

define variable odbtyp   as character.
      
/*---------------------  INTERNAL PROCEDURES  ----------------------*/

/*---------------------------  TRIGGERS  ---------------------------*/

/*-----------------------  INITIALIZATIONS  ------------------------*/

assign
  odbtyp = {adecomm/ds_type.i
             &direction = "odbc"
             &from-type = "odbtyp"
             }.

/*---------------------------  MAIN-CODE  --------------------------*/

if p_db-type = "ORACLE"
 then RUN prodict/ora/_snd_sql.p
        ( INPUT p_cmmnt-chr,
          INPUT p_db-name,
          INPUT p_debug,
          INPUT p_eosttmnt,
          INPUT p_owner,
          INPUT p_sql-file
        ).
ELSE IF p_db-type = "MSS" THEN
  RUN prodict/mss/_snd_sql.p
        ( INPUT p_cmmnt-chr,
          INPUT p_db-name,
          INPUT p_debug,
          INPUT p_eosttmnt,
          INPUT p_owner,
          INPUT p_sql-file
        ).
else if LOOKUP(p_db-type,odbtyp) <> 0
 then RUN prodict/odb/_snd_sql.p
        ( INPUT p_cmmnt-chr,
          INPUT p_db-name,
          INPUT p_debug,
          INPUT p_eosttmnt,
          INPUT p_owner,
          INPUT p_sql-file
        ).

/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/


/*--------------------------------------------------------------------

File: prodict/gate/beauty.i

Description:
    wrapper to ora/_ora_fix.p and odb/_odb_fix.p, which fix-up a SI
    to match an original PROGRESS-DB
    

Textual-Parameter:
    &edb-type   { ORACLE | **ODBC** | SYBASE-10 | MS SQL Server }

Output-Parameters:
    none
    
History:
    09/12/06   fernando   help id
    11/26/02   D. McMann  Added OS-DELETE for x.p
    04/13/00   D. McMann  Added long path name support
    12/13/1999 D. McMann  Added message for not being connected
    97/11      DMcMann    Added view-as dialog-box
    96/07      kkelley    Changed Field Labels and added title
    95/08      hutegger   created

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define variable l_file          as character  NO-UNDO.
define variable l_for-db        as character format "x(12)" NO-UNDO.
define variable l_pro-db        as character format "x(12)" NO-UNDO.
define variable l_db-type       as character format "x(20)" NO-UNDO.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }


                /*## UI-Part ##*/
form
  SKIP ({&TFM_WID})
  l_pro-db      colon 22 label "Original {&PRO_DISPLAY_NAME} DB" FORMAT "x({&PATH_WIDG})"
    VIEW-AS FILL-IN SIZE 40 BY 1
    help "Name of the original {&PRO_DISPLAY_NAME} DB"  {&STDPH_FILL}  SKIP ({&VM_WID})
  l_for-db      colon 22 label "Schema Image"
    help "Name of the SI to fix-up to match the {&PRO_DISPLAY_NAME} DB"
       {&STDPH_FILL}  SKIP ({&VM_WID})

   &if "{&edb-type}" = " "
            &then
      l_db-type     colon 22 label "DB Type"
        view-as radio-set horizontal radio-buttons 
    "MS SQL Server","MS SQL Server","ORACLE","ORACLE","SYBASE-10","SYBASE-10"
/*
        &elseif "{&edb-type}" = "**ODBC**"
            &then
  l_db-type     colon 21 label "DB Type"
    view-as radio-set horizontal radio-buttons 
    "MS SQL Server","MS SQL Server","SYBASE-10","SYBASE-10"
*/
            &endif
  "Files To Compare:" at 2
  l_file        at     2 no-label {&STDPH_EDITOR}
    view-as editor 
     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      	 SIZE 65 BY 4 BUFFER-LINES 4
      &ELSE 
      	 SIZE 65 BY 3 SCROLLBAR-VERTICAL
      &ENDIF     help "**all**  or   <table>,...~;<sequence>,...~;<view>,..."
  SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME l_frm_beauty ROW 5 CENTERED SIDE-LABELS
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX title "Adjust Schema".
                /*## UI-Part ##*/

/*===============================Triggers==================================*/
 
  /*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  on HELP of frame l_frm_beauty OR CHOOSE of btn_Help in frame l_frm_beauty
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                 	     	     INPUT {&Adjust_Schema_dialog_box},
        	       	     	     INPUT ?).
&ENDIF

ON WINDOW-CLOSE OF FRAME l_frm_beauty
DO:
    APPLY "END-ERROR" TO FRAME l_frm_beauty.
END.
 
/*------------------------  INT.-PROCEDURES  -----------------------*/

/*------------------------  INITIALIZATIONS  -----------------------*/

/* format of l_file:
 *  { **all** 
 *  | { <comma-separated list of tables> | **all** } ; 
 *    { <comma-separated list of sequences> | **all** } ;
 *    { <comma-separated list of views> | **all** } 
 *  }
 */

assign
  l_file    = "**all**"
        &if "{&edb-type}" = "**ODBC**"
            &then
  l_db-type = entry(lookup(user_env[22],"mss,s10")
                   ,"MS SQL Server,SYBASE-10")
            &else
  l_db-type = "{&edb-type}"
            &endif
  l_for-db  = user_dbname
  l_pro-db  = ( if   ldbname("DICTDB2") <> ?
                 and dbtype ("DICTDB2") =  "PROGRESS"
                  then ldbname("DICTDB2")
                  else ?
              )
  .

/*---------------------------  MAIN-CODE  --------------------------*/
{adecomm/okrun.i  
  &FRAME  = "FRAME l_frm_beauty " 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  {&CAN_BTN}
  {&HLP_BTN}
}
                /*## UI-Part ##*/
update
  l_pro-db
  l_for-db
        &if "{&edb-type}" = " "
            &then
  l_db-type
            &endif
  l_file
  btn_OK
  btn_Cancel
   {&HLP_BTN_NAME}
  with frame l_frm_beauty.
                /*## UI-Part ##*/

if LDBNAME("DICTDB2") <> l_pro-db
 then do:
  create alias DICTDB2 for database value(l_pro-db) no-error.
  end.

if LDBNAME("DICTDB") <> SDBNAME(l_for-db)
 then do:
  create alias DICTDB for database value(sdbname(l_for-db)) no-error.
  end.

if LDBNAME("DICTDB2") = ?
 or ldbname("DICTDB") = ?
 then do:
    MESSAGE "You must be connected to both the Original {&PRO_DISPLAY_NAME} Database" SKIP
            "and the Schema Holder before running adjust schema." SKIP
    VIEW-AS ALERT-BOX.
    leave.
END.
if LDBNAME("DICTDB2") = LDBNAME("DICTDB")
then do:
   message "The Original {&PRO_DISPLAY_NAME} DB cannot be the same as" skip
           "the Schema Image DB."
           view-as alert-box.
   undo,retry.
end.

/* This routine returns the recid of the foreign database.  We do not want to
   reference the database directly here because the schema will be cached and
   we will not see the modifications that have been made the the adjust
   schema routine.
*/
run prodict/gate/beauty1.p(input l_for-db, output drec_db).

assign
  user_env[25] = l_file.

case l_db-type:
  when "ORACLE" then RUN prodict/ora/_ora_fix.p.
  WHEN "MSS"    THEN RUN prodict/mss/_mss_fix.p (l_db-type).
  OTHERWISE          RUN prodict/odb/_odb_fix.p (l_db-type).
END CASE.

/* in order to get the schema-chache recreated we switch the alias */
create alias DICTDB for database value(l_pro-db).
/* if this is not enough, we need to actually call some routine
 * that uses the alias?
 */
/**/
 output to x.p.
 put "for each DICTDB._File: end.".
 output close.
 run x.p.
/**/
create alias DICTDB for database value(sdbname(l_for-db)).
run x.p.

OS-DELETE x.p. 
/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/beauty1.p

Description:  This routine is called bu gate/beauty.i.  The reason this code is
              not part of beauty.i is because we do not want to reference the
              database directly because this will cause the schema to get 
              cached.  Schema adjustments would not be seen.

Textual-Parameter:

Output-Parameters:
    none
    
History:
    96/07   kkelley     Routine was written because we do not want to 
                        reference DICTDB directly in gate/beauty.i
            
--------------------------------------------------------------------*/
/*h-*/
define  input parameter  o_for-db    as character    no-undo.
define output parameter  o_drec_db   as recid        no-undo.

/*----------------------------- Main Code --------------------------*/

FIND DICTDB._Db WHERE DICTDB._Db._Db-name = o_for-db no-lock no-error.
if not available DICTDB._Db
 then FIND DICTDB._Db WHERE DICTDB._Db._Db-name = ? no-lock.

assign o_drec_db = RECID(DICTDB._DB).
/***********************************************************************
* Copyright (C) 2000,2006-2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_fld.i

Description:
    
    compares all attributes of a field

    ( only reason for extracting this part from gat_cmp.p is to make
      the code easier to find things )

        
Text-Parameters:
    none

Output-Parameters:
    none
    
Included in:
    gate/_gat_cmp.p

History:
    hutegger    95/03   creation
    mcmann    08/21/01  Removed check on ORDER
    mcmann   06/04/02   Added output to file logic
    fernando 02/14/08   Support for datetime
--------------------------------------------------------------------*/        
/*h-*/

    if not available DICTDB._Field
     then assign
       { prodict/gate/cmp_nav.i
              &object = "FIELD"
              &obj    = "fld"
              &objm   = "fld"
              }

     else do:  /* compare this field */

     /* SEVERE Differences
      *     Extent, shadow-column-name
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Extent:"
              &msgidx = "l_fld-msg[4]"
              &msgvar = "sev"
              &ns     = "s_ttb_fld.pro_extnt"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Extent"
              }
      if can-do(odbtyp,user_dbtype)
       then do:
        { prodict/gate/cmp_msg.i
              &attrbt = "Shadow-column name:"
              &msgidx = "l_fld-msg[14]"
              &msgvar = "sev"
              &ns     = "s_ttb_fld.ds_shdn"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc2[5]"
              }
        end.
       else { prodict/gate/cmp_msg.i
              &attrbt = "Shadow-column name:"
              &msgidx = "l_fld-msg[15]"
              &msgvar = "sev"
              &ns     = "s_ttb_fld.ds_shdn"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc2[2]"
              }
      
     /* severe Differences in INTERNAL info
      *     offset, precision, scale, length, shadow-column-number,
      *     quoted-name, misc properties
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Foreign offset:"
              &msgidx = "l_fld-msg[7]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_stoff"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-stoff"
              }
      if can-do(odbtyp + ",ORACLE",user_dbtype)
       then { prodict/gate/cmp_msg.i
              &attrbt = "Precision:"
              &msgidx = "l_fld-msg[9]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_prec"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc1[1]"
              }
      if can-do(odbtyp + ",ORACLE",user_dbtype)
       then { prodict/gate/cmp_msg.i
              &attrbt = "Scale:"
              &msgidx = "l_fld-msg[10]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_scale"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc1[2]"
              }
      if can-do(odbtyp + ",ORACLE",user_dbtype)
       then { prodict/gate/cmp_msg.i
              &attrbt = "Length:"
              &msgidx = "l_fld-msg[11]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_lngth"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc1[3]"
              }
      if can-do(odbtyp + ",ORACLE",user_dbtype)
       then { prodict/gate/cmp_msg.i
              &attrbt = "Radix:"
              &msgidx = "l_fld-msg[12]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_radix"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc1[4]"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Shadow-column number:"
              &msgidx = "l_fld-msg[13]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_shd#"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc1[5]"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Quoted name:"
              &msgidx = "l_fld-msg[16]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_msc23"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc2[3]"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Misc Properties:"
              &msgidx = "l_fld-msg[17]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_msc24"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-misc2[4]"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Foreign data-type:"
              &msgidx = "l_fld-msg[5]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_type"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._For-Type"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Foreign data-type number:"
              &msgidx = "l_fld-msg[6]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_stdtype"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-stdtype"
              }
      if can-do(odbtyp + ",ORACLE",user_dbtype)
       then { prodict/gate/cmp_msg.i
              &attrbt = "Foreign data-type integer:"
              &msgidx = "l_fld-msg[6]"
              &msgvar = "int"
              &ns     = "s_ttb_fld.ds_itype"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._For-Itype"
              }
     

     /* Differences in RETAINABLE info
      *     Case, Mandatory, description, progress-name
      *     PROGRESS data-type, initial-value, decimals and format
      */
     if s_ttb_fld.pro_case = TRUE
       then { prodict/gate/cmp_msg.i
              &attrbt = "Case-Sensitivity:"
              &msgidx = "l_fld-msg[2]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_case"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Fld-Case" 
              }
      if s_ttb_fld.pro_mand = TRUE
       then { prodict/gate/cmp_msg.i
              &attrbt = "Mandatory:"
              &msgidx = "l_fld-msg[3]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_mand"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Mandatory"
              }
 
      { prodict/gate/cmp_msg.i
              &attrbt = "Name in {&PRO_DISPLAY_NAME}:"
              &msgidx = "l_fld-msg[22]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_name"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Field-Name"
              } 
     IF NOT user_dbtype = "MSS" THEN
     { prodict/gate/cmp_msg.i
              &attrbt = "Description:"
              &msgidx = "l_fld-msg[23]"
              &msgvar = "ret2"
              &ns     = "s_ttb_fld.pro_desc"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Desc" 
              } 

    if NOT (
       (   can-do(l_char-types + l_chda-types               ,s_ttb_fld.ds_type)  
       AND can-do("character"              ,DICTDB._Field._Data-type) )
       OR
       (   can-do(l_chda-types                              ,s_ttb_fld.ds_type) 
       AND can-do("character,date,datetime",DICTDB._Field._Data-type) )
       OR
       (   can-do(l_chda-types + "," + l_date-types               ,s_ttb_fld.ds_type) 
       AND can-do("date"                   ,DICTDB._Field._Data-type) )
       OR
       (   can-do(l_dcml-types + "," + l_deil-types + "," + l_dein-types,s_ttb_fld.ds_type) 
       AND can-do("decimal"                ,DICTDB._Field._Data-type) )
       OR
       (   can-do(l_deil-types                              ,s_ttb_fld.ds_type) 
       AND can-do("decimal,integer,logical",DICTDB._Field._Data-type) )
       OR
       (   can-do(l_deil-types + "," + l_dein-types               ,s_ttb_fld.ds_type) 
       AND can-do("decimal,integer"        ,DICTDB._Field._Data-type) )
       OR
       (   can-do(l_deil-types + "," + l_dein-types + "," + l_intg-types,s_ttb_fld.ds_type) 
       AND can-do("integer"                ,DICTDB._Field._Data-type) )
       OR
       (   can-do(l_deil-types + "," + l_logi-types               ,s_ttb_fld.ds_type) 
       AND can-do("logical"                ,DICTDB._Field._Data-type) )
         )
       then do:  /* new data-type not compatible with old one */
        { prodict/gate/cmp_msg.i
              &attrbt = "{&PRO_DISPLAY_NAME} Data-type:"
              &msgidx = "l_fld-msg[18]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_type"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Data-Type"
              }
        { prodict/gate/cmp_msg.i
              &attrbt = "Initial-value:"
              &msgidx = "l_fld-msg[19]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_init"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Initial"
              }
        { prodict/gate/cmp_msg.i
              &attrbt = "Decimals:"
              &msgidx = "l_fld-msg[20]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_dcml"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Decimal"
              }
        if s_ttb_fld.pro_frmt <> ""
         then { prodict/gate/cmp_msg.i
              &attrbt = "{&PRO_DISPLAY_NAME} Format:"
              &msgidx = "l_fld-msg[21]"
              &msgvar = "ret"
              &ns     = "s_ttb_fld.pro_frmt"
              &object = "FIELD"
              &o-name = "s_ttb_fld.ds_name"
              &sh     = "DICTDB._Field._Format"
              } 
        end.  /* new data-type not compatible with old one */ 

      end.     /* compare this field */


/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_idf.i

Description:
    
    compares all attributes of an index-Field

    ( only reason for extracting this part from gat_cmp.p is to make
      the code easier to find things )

        
Text-Parameters:
    none

Output-Parameters:
    none
    
Included in:
    gate/_gat_cmp.p

History:
    hutegger    95/03   creation
    
--------------------------------------------------------------------*/        
/*h-*/

    if not available DICTDB._Index-Field
     then assign
       { prodict/gate/cmp_nav.i
              &object = "INDEX-FIELD"
              &obj    = "idx"
              &objm   = "idf"
              &plus   = " + ""/"" + s_ttb_fld.ds_name"
              }

     else do:  /* compare this Index-Field */

     /* SEVERE Differences
      *     Ascending, Order
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Ascending:"
              &msgidx = "l_idf-msg[2]"
              &msgvar = "sev"
              &ns     = "s_ttb_idf.pro_asc"
              &object = "INDEX-FIELD"
              &o-name = "s_ttb_idx.ds_name + ""/"" + s_ttb_fld.ds_name"
              &sh     = "DICTDB._Index-Field._Ascending"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Order:"
              &msgidx = "l_idf-msg[3]"
              &msgvar = "sev"
              &ns     = "s_ttb_idf.pro_order"
              &object = "INDEX-FIELD"
              &o-name = "s_ttb_idx.ds_name + ""/"" + s_ttb_fld.ds_name"
              &sh     = "DICTDB._Index-Field._Index-Seq"
              }

     /* MINOR Differences
      *   Abbreviated
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Abbreviated:"
              &msgidx = "l_idf-msg[4]"
              &msgvar = "min"
              &ns     = "s_ttb_idf.pro_abbr"
              &object = "INDEX-FIELD"
              &o-name = "s_ttb_idx.ds_name + ""/"" + s_ttb_fld.ds_name"
              &sh     = "DICTDB._Index-Field._Abbreviate"
              }

      end.     /* compare this Index-Field */


/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_idx.i

Description:
    
    compares all attributes of an index

    ( only reason for extracting this part from gat_cmp.p is to make
      the code easier to find things )

        
Text-Parameters:
    none

Output-Parameters:
    none
    
Included in:
    gate/_gat_cmp.p

History:
    hutegger    95/03   creation
    mcmann   06/04/02   Added output to file logic
--------------------------------------------------------------------*/        
/*h-*/

    if not available DICTDB._Index
     then assign
       { prodict/gate/cmp_nav.i
              &object = "INDEX"
              &obj    = "idx"
              &objm   = "idx"
              }

     else do:  /* compare this Index */

     /* severe Differences in INTERNAL info
      *     index-number
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Index number:"
              &msgidx = "l_idx-msg[2]"
              &msgvar = "int"
              &ns     = "s_ttb_idx.pro_idx#"
              &object = "INDEX"
              &o-name = "s_ttb_idx.ds_name"
              &sh     = "DICTDB._Index._Idx-num"
              }

     /* Differences in RETAINABLE info
      *   PROGRESS name, unique, desription
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Name in {&PRO_DISPLAY_NAME}:"
              &msgidx = "l_idx-msg[4]"
              &msgvar = "reti"
              &ns     = "s_ttb_idx.pro_name"
              &object = "INDEX"
              &o-name = "s_ttb_idx.ds_name"
              &sh     = "DICTDB._Index._Index-Name"
              }
      { prodict/gate/cmp_msg.i
              &attrbt = "Unique:"
              &msgidx = "l_idx-msg[5]"
              &msgvar = "reti"
              &ns     = "s_ttb_idx.pro_uniq"
              &object = "INDEX"
              &o-name = "s_ttb_idx.ds_name"
              &sh     = "DICTDB._Index._Unique"
              }
     IF NOT user_dbtype = "MSS" THEN
      { prodict/gate/cmp_msg.i
              &attrbt = "Description:"
              &msgidx = "l_idx-msg[6]"
              &msgvar = "reti"
              &ns     = "s_ttb_idx.pro_desc"
              &object = "INDEX"
              &o-name = "s_ttb_idx.ds_name"
              &sh     = "DICTDB._Index._Desc"
              }

     /* MINOR Differences
      *     active, RECID-Usability
      */
      { prodict/gate/cmp_msg.i
              &attrbt = "Activ:"
              &msgidx = "l_idx-msg[3]"
              &msgvar = "min"
              &ns     = "s_ttb_idx.pro_actv"
              &object = "INDEX"
              &o-name = "s_ttb_idx.ds_name"
              &sh     = "DICTDB._Index._Active"
              }
      if DICTDB._index._I-misc2[1] begins "r"
       then do:
        if can-find(s_ttb_idx1
              where s_ttb_idx1.ttb_tbl   =  s_ttb_idx.ttb_tbl
              and   s_ttb_idx1.hlp_level <  s_ttb_idx.hlp_level)
         then assign
              l_min-msg = l_min-msg + "    INDEX "
                 + s_ttb_idx.ds_name + ": Usability for ROWID index:" 
                 + chr(10) + chr(9)
                 + l_msg[l_idx-msg[7]] + chr(10).
        end.
       else { prodict/gate/cmp_msg.i
              &attrbt = "Usability for ROWID index:"
              &msgidx = "l_idx-msg[8]"
              &msgvar = "min"
              &ns     = "s_ttb_idx.ds_msc21"
              &object = "INDEX"
              &o-name = "s_ttb_idx.ds_name"
              &sh     = "DICTDB._Index._I-misc2[1]"
              }

      end.     /* compare this Index */
 

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_msg.i

Description:
    
    compares an attribute, and ev. creates and add an adequate message

        
Text-Parameters:
    &object    {Sequence|Table|Field|Index|Index-Field}  
    &o-name    foreign name of the object
    &attrbt    Label of attribute
    &msgidx    index of message
    &msgvar    message-variable
    &sh        value in the PROGRESS-schemaholder
    &ns        value in the nativ foreign schema

Output-Parameters:
    none
    
Included in:
    gate/_gat_cmp.p

History:
    hutegger    95/03   creation
    mcmann     08/21/01 D. McMann Added check for &sh being set to ? to stop comparing ? to ""
                        which was causing the variable to exceed 32K.
    
--------------------------------------------------------------------*/        
/*h-*/

if ({&sh} <> {&ns}) AND {&sh} <> ? 
 then assign 
    l_{&msgvar}-msg = l_{&msgvar}-msg + "    " + "{&object} "
                    + {&o-name} + ": " + "{&attrbt}"
                    + ( if length(l_msg[{&msgidx}],"character") > 10
                            then chr(10) + chr(9)
                            else ""
                      )
                    + l_msg[{&msgidx}] + chr(10)
                    + chr(9) + "SH: " 
                    + ( if {&sh} = ?
                            then "?" 
                            else string({&sh})
                      )
                    + ( if length(string({&sh}) + string({&ns})
                                 ,"character"                  ) > 30
                            then chr(10)
                            else ""
                      )
                    + chr(9) + "NS: "
                    + ( if {&ns} = ?
                            then "?" 
                            else string({&ns})
                      )
                    + chr(10).

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_nav.i

Description:
    
    generates message for "onject not available"

        
Text-Parameters:
    &nr        Index-Number for error-array (can be ommited)
    &object    {Sequence|Table|Field|Index|Index-Field}  
    &obj       {seq|tbl|fld|idx|idf} for s_ttb_{&obj}
    &objm      {seq|tbl|fld|idx|idf} for l_{&objm}-msg

Output-Parameters:
    none
    
Included in:
    gate/_gat_cmp.p
    gate/_gat_fld.i
    gate/_gat_idf.i
    gate/_gat_idx.i
    gate/_gat_tbl.i

History:
    hutegger    95/03   creation
    
--------------------------------------------------------------------*/        
/*h-*/

       l_sev-msg = l_sev-msg + "    {&object} "
                 + s_ttb_{&obj}.ds_name {&plus} + ": " + chr(10) + chr(9)
                 + l_msg[l_{&objm}-msg[1{&nr}]]        + chr(10).

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000,2008 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_sum.i

Description:
    generates the report and puts it into gate-work.gate-edit. If there
    were severe differences (l_sev-msg <> "") then it also initializes 
    gate-work.gate-flag with YES

        
Text-Parameters:
    &object    s_ttb_{seq|tbl}  

Included in:
    gate/_gat_cmp.p

History:
    hutegger    95/03   creation
    mcmann   06/04/02   Added output to file logic
    fernando 02/22/08   Output internal retained info mismatch
    
--------------------------------------------------------------------*/        
/*h-*/

  IF l_sev-msg = "" and l_int-msg = "" and l_ret-msg = "" AND l_ret2-msg = "" and l_reti-msg = "" AND l_min-msg = "" THEN DO:
    IF NOT s_outf THEN
      ASSIGN gate-work.gate-edit = gate-work.gate-edit 
                                 + "Object: " + s_ttb_{&object}.pro_name
                                 + chr(9) + "(" + s_ttb_{&object}.ds_type + " - "
                                 + ( if    edbtyp <> "ORACLE"
                                     and  s_ttb_{&object}.ds_spcl <> ""
                                     and  s_ttb_{&object}.ds_spcl <> ?
                                     then s_ttb_{&object}.ds_spcl + "."
                                     else "" )
                                 + s_ttb_{&object}.ds_user + "."  
                                 + s_ttb_{&object}.ds_name
                                 + ( if   edbtyp = "ORACLE"
                                      and s_ttb_{&object}.ds_spcl <> ""
                                      and s_ttb_{&object}.ds_spcl <> ?
                                      then "@" + s_ttb_{&object}.ds_spcl
                                      else "" )
                                 + ")" + chr(10) + chr(10) 
                                 + l_no-diff.
    ELSE DO:
      OUTPUT STREAM comp_e TO VALUE(dbcomp_e) APPEND.
      PUT STREAM comp_e UNFORMATTED substring(l_no-diff,6) SKIP.
      PUT STREAM comp_e UNFORMATTED "  Object: "  s_ttb_{&object}.pro_name "(" s_ttb_{&object}.ds_type " ".
      IF edbtyp <> "ORACLE" THEN DO:
        IF s_ttb_{&object}.ds_spcl <> "" and  s_ttb_{&object}.ds_spcl <> ? THEN
          PUT STREAM comp_e UNFORMATTED  s_ttb_{&object}.ds_spcl  "." s_ttb_{&object}.ds_user "." s_ttb_{&object}.ds_name ")" SKIP(1). 
        ELSE
          PUT STREAM comp_e UNFORMATTED s_ttb_{&object}.ds_user "." s_ttb_{&object}.ds_name ")" SKIP(1).
      END.
      ELSE DO:   
        IF s_ttb_{&object}.ds_spcl <> "" and s_ttb_{&object}.ds_spcl <> ? then     
          PUT STREAM comp_e UNFORMATTED s_ttb_{&object}.ds_user "." s_ttb_{&object}.ds_name 
                                           "@" s_ttb_{&object}.ds_spcl ")" SKIP(1).
        ELSE
          PUT STREAM comp_e UNFORMATTED s_ttb_{&object}.ds_user "." s_ttb_{&object}.ds_name ")" SKIP (1).   
      END.
      OUTPUT STREAM comp_e CLOSE.    
    END.
  END.
  ELSE DO: 
    IF NOT s_outf THEN DO:
      ASSIGN gate-work.gate-edit = "Object: " + s_ttb_{&object}.pro_name
                 + chr(9) + "(" + s_ttb_{&object}.ds_type + " - "
                 + ( if    edbtyp <> "ORACLE"
                     and  s_ttb_{&object}.ds_spcl <> ""
                     and  s_ttb_{&object}.ds_spcl <> ?
                     then s_ttb_{&object}.ds_spcl + "."
                     else "")
                 + s_ttb_{&object}.ds_user + "."  
                 + s_ttb_{&object}.ds_name
                 + ( if   edbtyp = "ORACLE"
                    and s_ttb_{&object}.ds_spcl <> ""
                    and s_ttb_{&object}.ds_spcl <> ?
                    then "@" + s_ttb_{&object}.ds_spcl
                    else "")
                 + ")" + chr(10) + chr(10)
                 + ( if  l_sev-msg <> ""
                     or l_int-msg <> ""
                     then l_shupd-msg
                     else "")
                 + ( if l_sev-msg <> ""
                     then l_sev-msg-txt + chr(10) + l_sev-msg + chr(10)
                     else "")
                 + ( if l_int-msg <> ""
                     then l_int-msg-txt + chr(10) + l_int-msg + chr(10)
                      else "").

      IF l_ret-msg <> "" OR l_ret2-msg <> "" OR l_reti-msg <> "" THEN 
        ASSIGN gate-work.gate-edit = gate-work.gate-edit + l_ret-msg-txt + CHR(10) 
                 + ( if l_ret-msg <> ""
                     then  l_ret-msg + chr(10)
                     else "")
                 + ( IF l_ret2-msg <> ""
                     THEN  l_ret2-msg + chr(10)
                     else "")
                 + ( IF l_reti-msg <> ""
                     THEN  l_reti-msg + chr(10)
                     else "").
      ASSIGN gate-work.gate-edit = gate-work.gate-edit
                 + ( if l_min-msg <> ""
                     then l_min-msg-txt + chr(10) + l_min-msg + chr(10)
                     else "")
                 + chr(10)
            
             gate-work.gate-flag = ( l_sev-msg <> ""
                                    or l_int-msg <> "" )
             gate-work.gate-flg2 = ( l_sev-msg <> ""
                                    or l_int-msg <> ""
                                    or l_ret-msg <> "" 
                                    OR l_ret2-msg <> ""
                                    OR l_reti-msg <> "").
      

    END.
    ELSE DO:   
      OUTPUT STREAM comp_e TO VALUE(dbcomp_e) APPEND.
       
      PUT STREAM comp_e UNFORMATTED "Object: "  s_ttb_{&object}.pro_name  " ("  s_ttb_{&object}.ds_type.
      IF edbtyp <> "ORACLE" and  s_ttb_{&object}.ds_spcl <> ""
                            and  s_ttb_{&object}.ds_spcl <> ? THEN 
        PUT STREAM comp_e UNFORMATTED   " - " s_ttb_{&object}.ds_spcl  "." s_ttb_{&object}.ds_user  "."  s_ttb_{&object}.ds_name.
      IF edbtyp = "ORACLE" and  s_ttb_{&object}.ds_spcl <> ""
                           and  s_ttb_{&object}.ds_spcl <> ? THEN
        PUT STREAM comp_e UNFORMATTED   " - " "@"  s_ttb_{&object}.ds_spcl.
      PUT STREAM comp_e UNFORMATTED ")" SKIP(1).
      IF  l_sev-msg <> "" or l_int-msg <> "" then 
        PUT STREAM comp_e UNFORMATTED l_shupd-msg SKIP.
      IF l_sev-msg <> "" THEN DO:
        PUT STREAM comp_e UNFORMATTED l_sev-msg-txt SKIP.
        PUT STREAM comp_e UNFORMATTED l_sev-msg SKIP.
      END.
      IF l_int-msg <> "" THEN 
        PUT STREAM comp_e UNFORMATTED l_int-msg-txt SKIP.
      IF l_ret-msg <> "" OR l_ret2-msg <> "" OR l_reti-msg <> "" THEN DO:
        PUT STREAM comp_e UNFORMATTED  l_ret-msg-txt SKIP.
        IF l_ret-msg <> "" THEN
          PUT STREAM comp_e UNFORMATTED l_ret-msg SKIP.
        IF l_ret2-msg <> "" THEN          
          PUT STREAM comp_e UNFORMATTED l_ret2-msg SKIP.
        IF l_reti-msg <> "" THEN 
          PUT STREAM comp_e UNFORMATTED l_reti-msg SKIP.
      END.
      IF l_min-msg <> "" THEN DO: 
        PUT STREAM comp_e UNFORMATTED l_min-msg-txt SKIP.
        PUT STREAM comp_e UNFORMATTED l_min-msg SKIP(1).
      END.
      PUT STREAM comp_e UNFORMATTED "( SH = Schema Holder  NS = Native Schema )" SKIP(2).
      ASSIGN dif-found = TRUE.
      OUTPUT STREAM comp_e CLOSE.
    END.
  END.

/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/cmp_tbl.i

Description:
    
    compares all attributes of a table

    ( only reason for extracting this part from gat_cmp.p is to make
      the code easier to find things )

        
Text-Parameters:
    none

Output-Parameters:
    none
    
Included in:
    gate/_gat_cmp.p

History:
    hutegger    95/03   creation
    
--------------------------------------------------------------------*/        
/*h-*/

  if not available DICTDB._File
   then do:
    assign
      { prodict/gate/cmp_nav.i
              &object = "TABLE"
              &obj    = "tbl"
              &objm   = "tbl"
              }
    { prodict/gate/cmp_sum.i
        &object = "tbl"
        }
    NEXT.
    end.

   else do:  /* compare this File */
     /* SEVERE Differences
      *     Foreign Type, Package-Name
      */
    { prodict/gate/cmp_msg.i
            &attrbt = "Foreign Type:"
            &msgidx = "l_tbl-msg[3]"
            &msgvar = "sev"
            &ns     = "s_ttb_tbl.ds_type"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._For-Type"
            }
    if user_dbtype = "ORACLE"
     then { prodict/gate/cmp_msg.i
            &attrbt = "Package Name:"
            &msgidx = "l_tbl-msg[4]"
            &msgvar = "sev"
            &ns     = "s_ttb_tbl.ds_msc21"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc2[1]"
            }
     /* severe Differences in INTERNAL info
      *     Hidden fields, Field-names list, Index-free field, 
      *     RECID-Field-name
      */
    { prodict/gate/cmp_msg.i
            &attrbt = "Hidden fields:"
            &msgidx = "l_tbl-msg[5]"
            &msgvar = "int"
            &ns     = "s_ttb_tbl.ds_msc22"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc2[2]"
            }
    { prodict/gate/cmp_msg.i
            &attrbt = "Field-names list:"
            &msgidx = "l_tbl-msg[6]"
            &msgvar = "int"
            &ns     = "s_ttb_tbl.ds_msc24"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc2[4]"
            }
    { prodict/gate/cmp_msg.i
            &attrbt = "Index-free field:"
            &msgidx = "l_tbl-msg[7]"
            &msgvar = "int"
            &ns     = "s_ttb_tbl.ds_msc13"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[3]"
            }
    { prodict/gate/cmp_msg.i
            &attrbt = "RECID-field-name:"
            &msgidx = "l_tbl-msg[10]"
            &msgvar = "int"
            &ns     = "s_ttb_tbl.ds_msc23"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc2[3]"
            }

     /* Differences in RETAINABLE info
      *     PROGRESS Name, ROWID-Index, Description
      */
    { prodict/gate/cmp_msg.i
            &attrbt = "Name in {&PRO_DISPLAY_NAME}:"
            &msgidx = "l_tbl-msg[2]"
            &msgvar = "ret"
            &ns     = "s_ttb_tbl.pro_name"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._File-Name"
            }
    /*                                                      ORA    others
     *                                                     [1]/[4] [1]/[4]
     * s_ttb_tbl.ds_recid > 0 -> progress_recid             # / ?   # / ?
     *                    = 0 -> use nativ rowid            ? /-#   # / ?
     *                    < 0 -> normal column for recid    ? /-#   # / ?
     */
    if user_dbtype = "ORACLE"
     then do:
      if s_ttb_tbl.ds_recid <= 0
       then do:
        { prodict/gate/cmp_msg.i
            &attrbt = "Progress_Recid:"
            &msgidx = "l_tbl-msg[8]"
            &msgvar = "ret"
            &ns     = "integer(?)"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[1]"
            }
        { prodict/gate/cmp_msg.i
            &attrbt = "RECID-index:"
            &msgidx = "l_tbl-msg[8]"
            &msgvar = "ret"
            &ns     = "(0 - s_ttb_tbl.ds_recid)"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[4]"
            }
        end.
       else do:
        { prodict/gate/cmp_msg.i
            &attrbt = "Progress_Recid:"
            &msgidx = "l_tbl-msg[8]"
            &msgvar = "ret"
            &ns     = "s_ttb_tbl.ds_recid"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[1]"
            }
        { prodict/gate/cmp_msg.i
            &attrbt = "RECID-index:"
            &msgidx = "l_tbl-msg[8]"
            &msgvar = "ret"
            &ns     = "integer(?)"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[4]"
            }
        end.
      end.
     else do:
      { prodict/gate/cmp_msg.i
            &attrbt = "RECID-index:"
            &msgidx = "l_tbl-msg[8]"
            &msgvar = "ret"
            &ns     = "s_ttb_tbl.ds_recid"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[1]"
            }
      end.
    { prodict/gate/cmp_msg.i
            &attrbt = "ROWID-index:"
            &msgidx = "l_tbl-msg[9]"
            &msgvar = "ret"
            &ns     = "s_ttb_tbl.ds_rowid"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Fil-Misc1[2]"
            }
    IF NOT user_dbtype = "MSS" THEN
    { prodict/gate/cmp_msg.i
            &attrbt = "Description:"
            &msgidx = "l_tbl-msg[11]"
            &msgvar = "ret"
            &ns     = "s_ttb_tbl.pro_desc"
            &object = "TABLE"
            &o-name = "s_ttb_tbl.ds_name"
            &sh     = "DICTDB._File._Desc"
            }

    end.     /* compare this File */
      

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat-trgm.i

Description:
    
    the variable trig-reass gets set in the delete-triggers (see:
    prodict/gate/gat-trig.i).
    
    If its value is true we display a message here.
            
Text-Parameters:
    none

    
Included in:
    odb/_odb_mak.p
    ora/_ora6mak.p
    ora/_ora7mak.p
    rdb/_rdb_mak.p
    syb/_syb_mak.p
    
Author: Tom Hutegger

History:
    hutegger    94/02/09    creation
    
--------------------------------------------------------------------*/        
/*h-*/

if trig-reass = true
 then do:   /* there are warnings or messages */
       
        &IF "{&WINDOW-SYSTEM}" = "TTY" 
         &THEN 
          message err-msg[6]. 
         &ELSE
          message err-msg[6] view-as alert-box warning buttons ok.
         &ENDIF         
  
  end.      /* there are warnings or messages */

/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat-trig.i

Description:
    
    To Update a DICTDB._File-definition, _<gatway>_mak.p deletes the
    original DICTDB._File-record and creates a new one.
    A DICTDB._File-record can only be deleted, if there is no trigger
    assigned to it.
    
    The same way DICTDB._Fields are handled.
    
    This include-file contains internal procedures for: 
      delete DICTDB._File
      delete DICTDB._Field
      create DICTDB._File              plus
    the definitions for the temp-tables  
    
    delete DICTDB._File:  save file-trigger information in local temp-table
    delete DICTDB._Field: save field-trigger-information in local temp-table
    create DICTDB._File:  create DICTDB._File-Trig-record and 
                    DICTDB._Field-Trig-records according to the 
                    temp-table-entries.
          
    A file (name: ds_upd.e) gets created, with all the effected triggers
    listed.
     
    NOTE: the CRC gets set to ?
        
    NOTE: the value of the variable trig-reass gets used in 
    prodict/gate/gat-trgm.i
        
Text-Parameters:
    &table-name      name of the table to be created (used for error-msg)

Output-Parameters:
    none
    
Included in:
    odb/_odb_mak.p
    ora/_ora_fun.p
    ora/_ora6mak.p
    ora/ora_lkm.i   (_ora_lkm.p, _ora7mak.p)
    rdb/_rdb_mak.p
    syb/syb_makp.i  (_syb_mak.p, _syb_m10.p)
    
Author: Tom Hutegger

History:
    hutegger    95/01/26    changed schmea-triggers to internal procs
    hutegger    94/02/04    creation
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define variable   trig-reass  as   logical initial false.


define variable   idx_Desc     AS CHARACTER NO-UNDO. /*_Desc   */

define temp-table w_index NO-UNDO
        field     pro_Active       like DICTDB._index._Active        
        field     pro_Desc         like DICTDB._index._Desc        
     /* field     pro_File-recid   like DICTDB._index._File-recid  */
        field     pro_For-Name     like DICTDB._index._For-Name    
     /* field     pro_For-Type     like DICTDB._index._For-Type    */
     /* field     pro_I-misc1      like DICTDB._index._I-misc1     */
     /* field     pro_I-misc2      like DICTDB._index._I-misc2     */
     /* field     pro_I-res1       like DICTDB._index._I-res1      */
     /* field     pro_I-res2       like DICTDB._index._I-res2      */
        field     pro_idx-num      like DICTDB._index._idx-num     
        field     pro_Index-Name   like DICTDB._index._Index-Name  
     /* field     pro_num-comp     like DICTDB._index._num-comp    */
        field     pro_Unique       like DICTDB._index._Unique      
        field     pro_Wordidx      like DICTDB._index._Wordidx     
        INDEX upi        IS UNIQUE PRIMARY pro_idx-num
        INDEX for-name                     pro_For-Name.
define temp-table w_index-field NO-UNDO
        field     pro_Abbreviate   like DICTDB._index-field._Abbreviate  
        field     pro_Ascending    like DICTDB._index-field._Ascending   
        field     pro_For-name     like DICTDB._field._For-name 
     /* field     pro_If-misc1     like DICTDB._index-field._If-misc1  */
     /* field     pro_If-misc2     like DICTDB._index-field._If-misc2  */
     /* field     pro_If-res1      like DICTDB._index-field._If-res1   */
     /* field     pro_If-res2      like DICTDB._index-field._If-res2   */
        field     pro_idx-num      like DICTDB._index._idx-num 
        field     pro_Index-Seq    like DICTDB._index-field._Index-Seq   
        field     pro_Unsorted     like DICTDB._index-field._Unsorted 
        INDEX upi        IS UNIQUE PRIMARY pro_idx-num
                                           pro_For-name.   

define temp-table y_Tmp-File-Trig
        field     y_Event          like DICTDB._File-Trig._Event
        field     y_Proc-name      like DICTDB._File-Trig._Proc-Name
        field     y_Override       like DICTDB._File-Trig._Override
        field     y_Trig-Crc       like DICTDB._File-Trig._Trig-Crc.
        
define temp-table y_Tmp-Field-Trig
        field     y_Event          like DICTDB._Field-Trig._Event
        field     y_Proc-name      like DICTDB._Field-Trig._Proc-Name
        field     y_Override       like DICTDB._Field-Trig._Override
        field     y_Trig-Crc       like DICTDB._Field-Trig._Trig-Crc
        field     y_Field-Name     like DICTDB._Field._field-Name.
        
define stream     stm_errors.

/*-------------------  LANGUAGE DEPENDENCIES  ----------------------*/        
define variable err-msg     as character format "x(40)" extent 9
      initial [
/*  1 */ "DETACHED FILE-TRIGGER   :",
/*  2 */ "DETACHED FIELD-TRIGGER  :",
/*  3 */ "REASSIGNED FILE-TRIGGER :",
/*  4 */ "REASSIGNED FIELD-TRIGGER:",
/*  5 */ "doesn't exist anymore! Trigger cannot be reassigned!",
/*  6 */ "Please check warnings and messages in the file ""ds_upd.e""!",
/*  7 */ "",
/*  8 */ "",
/*  9 */ "Wait, or press any key to continue ..."
              ].     

/*-----------------  LANGUAGE DEPENDENCIES END  --------------------*/        
      
/*---------------------------  TRIGGERS  ---------------------------*/
PROCEDURE delete-file.

/* on delete of DICTDB._File do: */

/* in case there is no field in the first table */
  if trig-reass = false
   then do:        
    find first DICTDB._File-Trig  of DICTDB._File no-lock no-error.
    find first DICTDB._Field-Trig of DICTDB._File no-lock no-error.
    if  available DICTDB._File-Trig
     or available DICTDB._Field-Trig
     then do:  /* delete ev. old error.files & set "errors = occured" */
      assign trig-reass = true.
      output stream stm_errors to ds_upd.e.
      output stream stm_errors close.
      end.
    end.
                 
  for each DICTDB._File-Trig of DICTDB._File exclusive-lock:

    output stream stm_errors to ds_upd.e append.
    put stream stm_errors 
      err-msg[1]               format "x(26)"
      DICTDB._File._File-Name  format "x(64)"
      DICTDB._File-Trig._Event format "x(15)" 
      DICTDB._File-Trig._Proc-Name skip.
    output stream stm_errors close.

    create y_Tmp-File-Trig.
    assign
      y_Tmp-File-Trig.y_Event     = DICTDB._File-Trig._Event
      y_Tmp-File-Trig.y_Proc-name = DICTDB._File-Trig._Proc-Name
      y_Tmp-File-Trig.y_Override  = DICTDB._File-Trig._Override
      y_Tmp-File-Trig.y_Trig-Crc  = DICTDB._File-Trig._Trig-Crc.
    delete DICTDB._File-Trig.

    end.

/**/ delete DICTDB._File.

  end. /*   "delete DICTDB._File" - Trigger */

/*------------------------------------------------------------------*/        
      
PROCEDURE delete-field.

/* on delete of DICTDB._Field do:*/

  if trig-reass = false
   then do:        
    find first DICTDB._File-Trig  of DICTDB._File no-lock no-error.
    find first DICTDB._Field-Trig of DICTDB._File no-lock no-error.
    if  available DICTDB._File-Trig
     or available DICTDB._Field-Trig
     then do:  /* delete ev. old error.files & set "errors = occured" */
      assign trig-reass = true.
      output stream stm_errors to ds_upd.e.
      output stream stm_errors close.
      end.
    end.
                 
  for each DICTDB._Field-Trig of DICTDB._Field exclusive-lock:

    output stream stm_errors to ds_upd.e append.
    put stream stm_errors 
      err-msg[2]                format "x(26)" 
      DICTDB._File._File-Name 
      DICTDB._Field._Field-Name 
      DICTDB._Field-Trig._Event format "x(15)" 
      DICTDB._Field-Trig._Proc-Name skip.
    output stream stm_errors close.

    create y_Tmp-Field-Trig.
    assign
      y_Tmp-Field-Trig.y_Event      = DICTDB._Field-Trig._Event
      y_Tmp-Field-Trig.y_Proc-name  = DICTDB._Field-Trig._Proc-Name
      y_Tmp-Field-Trig.y_Override   = DICTDB._Field-Trig._Override
      y_Tmp-Field-Trig.y_Trig-Crc   = DICTDB._Field-Trig._Trig-Crc
      y_Tmp-Field-Trig.y_Field-name = DICTDB._Field._Field-Name.

    delete DICTDB._Field-Trig.

    end.

/**/ delete DICTDB._Field.

  end. /*   "delete DICTDB._Field" - Trigger */

/*------------------------------------------------------------------*/        
      
PROCEDURE create-file.

/* on create of DICTDB._File do: */
  
/**/  create DICTDB._File.
  
  for each y_Tmp-File-Trig:     

    output stream stm_errors to ds_upd.e append.
    put stream stm_errors 
      err-msg[3]            format "x(26)" 
      {&table-name}         format "x(64)"
      y_Tmp-File-Trig.y_Event format "x(15)" 
      y_Tmp-File-Trig.y_Proc-Name skip.
    output stream stm_errors close.

    create DICTDB._File-Trig.
    assign 
      DICTDB._File-Trig._File-Recid  = RECID(_File)
      DICTDB._File-Trig._Event       = y_Tmp-File-Trig.y_Event
      DICTDB._File-Trig._Proc-Name   = y_Tmp-File-Trig.y_Proc-name 
      DICTDB._File-Trig._Override    = y_Tmp-File-Trig.y_Override  
      DICTDB._File-Trig._Trig-Crc    = ?
                                    /* y_Tmp-File-Trig.y_Trig-Crc */ 
      .
    delete y_Tmp-File-Trig.

    end.        /* create all file-triggers for this file */

  end.  /* "create DICTDB._File" - Trigger */

      
/*------------------------------------------------------------------*/        
      
Procedure _Field-Triggers:

  if CAN-FIND(first y_Tmp-Field-Trig)
   then do:     /* there are field-triggers */
    
    for each y_Tmp-Field-Trig:
      
      find first DICTDB._Field of DICTDB._File
        where DICTDB._Field._Field-Name = y_Tmp-Field-Trig.y_Field-Name
        no-lock no-error.
        
      if not available DICTDB._Field    /* in case a field got dropped or */
       then do:                         /* its name got changed */

        output stream stm_errors to ds_upd.e append.
        put stream stm_errors 
          err-msg[5]                     format "x(26)" 
          DICTDB._File._File-Name 
          y_Tmp-Field-Trig.y_Field-Name  
          y_Tmp-Field-Trig.y_Event       format "x(15)" 
          y_Tmp-Field-Trig.y_Proc-Name skip.
        output stream stm_errors close.

        end.
       else do:  /* found field to reconnect trigger */ 

        output stream stm_errors to ds_upd.e append.
        put stream stm_errors 
          err-msg[4]                    format "x(26)" 
          DICTDB._File._File-Name 
          y_Tmp-Field-Trig.y_Field-Name 
          y_Tmp-Field-Trig.y_Event      format "x(15)" 
          y_Tmp-Field-Trig.y_Proc-Name skip.
        output stream stm_errors close.

        create DICTDB._Field-Trig.
        assign 
          DICTDB._Field-Trig._Field-Recid = RECID(_Field)
          DICTDB._Field-Trig._File-Recid  = RECID(_File)
          DICTDB._Field-Trig._Event       = y_Tmp-Field-Trig.y_Event
          DICTDB._Field-Trig._Proc-Name   = y_Tmp-Field-Trig.y_Proc-name 
          DICTDB._Field-Trig._Override    = y_Tmp-Field-Trig.y_Override  
          DICTDB._Field-Trig._Trig-Crc    = ?
                                         /* y_Tmp-Field-Trig.y_Trig-Crc */
          . 

        end.    /* found field to reconnect trigger */

      delete y_Tmp-Field-Trig.
            
      end.      /* create all field-triggers for this file */
      
    end.        /* there are field-triggers */
  
  end.        /* procedure _Field-Triggers */

/*------------------------------------------------------------------*/        
      
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat_cp1a.i

Description:
    
    Used for syb10; (in the future could be used for any DataServer type
    that allows setting of foreign db code page)
     
    Assigns the code-page to the _DB record and assigns the foreign name 
    of the code page to _DB-misc2[8]. 
     
Text-Parameters:
       {&incpname}   name if input code page        

Included-in
    _gat_cp1.p
    _usrschg.p

Author: Christine Semeniuk

History:
    Semeniuk    94/08/19    creation
    
--------------------------------------------------------------------*/        
        if {&incpname} = ? or {&incpname} = "<internal defaults apply>" then
        assign _Db._Db-xl-name = ?
               _Db._Db-misc2[8] = ?.
        else 
           if INDEX ({&incpname}, "/") > 0 then do: 
              assign _Db._Db-xl-name = SUBSTRING ({&incpname}, 1,
                              (INDEX ({&incpname}, "/") - 1))
                    _Db._Db-misc2[8] =  SUBSTRING ({&incpname},  
                              INDEX ({&incpname}, "/") + 1).
              if _Db._Db-misc2[8] = "" then _Db._Db-misc2[8] = ?.     
           end.  /* INDEX ({&incpname}, "/") > 0 */ 
        else
           assign _Db._Db-xl-name = {&incpname}
                  _Db._Db-misc2[8] = ?.      
      
/*------------------------------------------------------------------*/





/***********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* gat_cpvl.i   

function:
     on leave - trigger for field user_env[5] (code-page)
   
text-parameters:
    &frame          frame containing the field
    &variable       name of the field
    &adbtype        dbtype

included in:
  prodict/gate/_gat_cp.p
  prodict/user/_usrschg.p    
    
history:
    semeniuk    94/08/18    creation
    moloney     07/03/21    Unicode support for MSS
    fernando    06/18/07    Unicode support for ORACLE
    
*/

DEFINE BUFFER m_Db for _Db.

/*------------------ begin Trailer-INFO ------------------*/

ON LEAVE OF {&variable} in frame {&frame} do:    

  if {&variable}:screen-value in frame {&frame} = "?" 
   then assign {&variable}:screen-value in frame {&frame} = "<internal defaults apply>".

   else do:
    assign
      {&variable} = TRIM({&variable}:screen-value in frame {&frame})
      {&variable}:screen-value in frame {&frame} = {&variable}.

    if ( UPPER(TRIM( {&variable} ) ) = "UTF-8" AND 
         ({&adbtype} = "MSS" OR {&adbtype} = "ORACLE")) 
      then do:
        /* use a differet buffer so that we don't mess up with the currently available _db rec */
        FIND FIRST m_Db WHERE m_Db._Db-local AND m_Db._Db-type = "PROGRESS".
        IF ( AVAILABLE(m_Db) AND UPPER( m_Db._Db-xl-name ) <> UPPER(TRIM( {&variable} ) ) ) 
          THEN DO:

            MESSAGE "Logical DataServer schema and physical schema holder " skip
                    "codepages must both be 'utf-8'." VIEW-AS ALERT-BOX ERROR BUTTONS OK.

            RETURN NO-APPLY.
          END.
      END.  /* {&adbtype} = "MSS" */

    if ( {&adbtype} = "SYB10" or {&adbtype} = "MSSQLSRV")
      then do:
        if INDEX ({&variable}, "/") > 0 and 
             substring ({&variable}, INDEX ({&variable}, "/") + 1) = "" then
          {&variable} = 
             substring ({&variable}, 1, INDEX ({&variable}, "/") - 1).
        if INDEX ({&variable}, "/") = 0
          then do:
            /*  complete the name */
            if {&variable} = "undefined" then  {&variable} = 
                     {&variable}  + "/" + "undefined".
            else if {&variable} = "iso8859-1" then {&variable} =
                     {&variable}  + "/" + "iso_1".
            else if {&variable} = "ibm850" then {&variable} =
                     {&variable}  + "/" + "cp850".
            else do:
                assign 
                  {&variable} = {&variable}  + "/" 
                  {&variable}:screen-value in frame {&frame} = {&variable}.  
                message "Please supply" {&adbtype} "code page name "
                     view-as alert-box error.
                RETURN NO-APPLY.
              end.  /*  {&variable} <> known value  */
            {&variable}:screen-value in frame {&frame} = {&variable}.
          end.  /* INDEX ({&variable}, "/")  = 0 */ 
        if INDEX ({&variable}, "/") > 0 
          then do:
            /*  code page name consists of <cp name>/<foreigndb cp name>  */
            if codepage-convert("a", SUBSTRING({&variable}, 1, 
                    INDEX ({&variable}, "/") - 1), SESSION:CHARSET) = ?
            then RETURN NO-APPLY. /* conversion not possible */    
          end.  /* INDEX ({&variable}, "/") > 0 */
      end.  /* {&adbtype} = "SYB10" */
    else
      if codepage-convert("a", {&variable}, SESSION:CHARSET) = ?
      then RETURN NO-APPLY. /* conversion not possible */
    end.      /* {&variable} <> ? */

   end.         /* leave of {&variable} in frame {&frame} */

/*--------------------------------------------------------*/





/*********************************************************************
* Copyright (C) 2000,2008 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat_get.i

Description:
    
    last part of the get-routines:
    - message if no object met preselection criteria
    - auto-select or call guigget or ttygget
    - if not canceled: generate unique names for selected objects
      if     canceled: delete gate-works and set user_path = ""
        
Text-Parameters:
    &block     label of block to leave if canceled or no obj found  
    &clean-up  clean-up routines for user_path  
    &end       "end." if repeat for get-process started in _xxx_get.p
               "" otherwise
    &gate-flag value or expression for gate-flag   
    &special1  some DS-specific action to be done BEFORE calling 
               of _guigget.p  
    &special2  some DS-specific action to be done AFTER calling 
               of _guigget.p  
    &as400-flag yes if ODBC for AS/400
    &where     where-phrase to exclude system-objects from auto-select  


Included in:
    syb/syb_getp.i
    odb/_odb_get.p
    ora/_ora_lks.p

History:
    mcmann      98/07/13 Added _Owner to _File finds
    hutegger    95/08   included {&end} parameter
    hutegger    95/04   creation
    
--------------------------------------------------------------------*/        
/*h-*/

/*----------------------------------------------------------------------*/

&GLOBAL-DEFINE xxDS_DEBUG DEBUG

{prodict/gate/nogatwrk.i
  &block    = "{&block} "
  &end      = "{&end} "
  &clean-up = {&clean-up}
  } /* message and leave */


/* The compare algorithm needs an extra gate-work record to allow to
 * check all progress-objects, if there is a corresponding object on
 * the <DS>-side.
 * Update and create don't need this record
 */
if  user_env[25] begins "AUTO-COMPARE"
 or user_env[25] begins "COMPARE"
 then do:
  create gate-work.
  assign
    gate-work.gate-name = " ***                 Check in"
    gate-work.gate-user = edbtyp + " for "
    gate-work.gate-type = "PROGRESS"
    gate-work.gate-qual = " orphans           *** " /*string used again!*/
    gate-work.gate-prog = "Pseudo-Entry".
  end.

  
/* the following statment is a workaround to the problem that the last
 * temp-table -entry gets lost
 */
find FIRST gate-work no-error.

if user_env[25] begins "AUTO"
 then do:   /*========= automatically select all possible tables =======*/
  for each gate-work    /*===== but exclude system-tables =====*/
    where {&where}:
    assign gate-flag = {&gate-flag}.
    end.
  end.      /*========= automatically select all possible tables =======*/

 else do:   /*=========== let user select the tables he wants ==========*/
  
  {&special1}  /* oracle: gate-qual = ? -> "<Local DB>" */
   
  /* input to _xxxgget.p: gate-slct = TRUE, gate-flag = FALSE */    

  RUN prodict/gui/_guigget.p
    ( INPUT edbtyp,
      INPUT "Pull",
      &IF DEFINED(as400-flag) &THEN {&as400-flag} &ELSE NO &ENDIF
    ).

  assign canned = (if RETURN-VALUE = "cancel" then yes else no).

  /* output from _xxxgget.p: gate-slct = TRUE, gate-flag = <selected> */    

  {&special2}  /* oracle: gate-qual = ? -> "<Local DB>" */
   
  end.     /*=========== let user select the tables he wants ==========*/

/*----------------------------------------------------------------------*/
/*                 check names and ev. prepare next link                */
/*----------------------------------------------------------------------*/

if NOT canned
 then do TRANSACTION:

  SESSION:IMMEDIATE-DISPLAY = YES.
  RUN adecomm/_setcurs.p ("WAIT").

  for each gate-work:
    assign gate-work.gate-slct = gate-work.gate-flag.
    end.
  
  /* Explanation for the following "strange"-appearing  code-duplication:
   * With Oracle's distributed Databases, the local-db has ? in 
   * gate-work.gate-link, which gets sorted higher than any other value.
   * The result was, that if there were tables with the same name in 
   * the local-db and a linked-db, the one in the linked got the same
   * name on the progress-side as on the foreign side, and the one in
   * the local-db got a "-1" appended. Since this is rather unexpected
   * (local-db stuff gets pulled first), we need to run through the
   * gate-work's of the local db first and then through the others.
   */

  /* 1.a Step: find unique names for all _Sequence gate-work's
   * (... of local-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "SEQUENCE"
      &local     = "true"
      &sequence  = "true"
      }

  /* 1.b Step: find unique names for all _Sequence Synonym gate-work's
   * (... of remote-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "SYNONYM"
      &local     = "true"
      &sequence  = "true"
      }

  /* 2.a Step: find unique names for all _Sequence gate-work's
   * (... of remote-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "SEQUENCE"
      &local     = "false"
      &sequence  = "true"
      }

  /* 2.b Step: find unique names for all _Sequence Synonym gate-work's
   * (... of local-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "SYNONYM"
      &local     = "false"
      &sequence  = "true"
      }

  /* delete temporary sequences, in case the user doesn't select it, 
   * it's not left-over...
   * /
/**/ message "before delete" view-as alert-box.
  for each DICTDB._Sequence 
    where DICTDB._Sequence._Db-recid    = drec_db 
    and   DICTDB._Sequence._Seq-misc[2] = "%TEMPORARY%":
    delete DICTDB._Sequence.
    end.
/**/ message "after delete" view-as alert-box.
/ **/



  /* 3.a Step: find unique names for all _File gate-work's
   * (... of local-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "x"
      &local     = "true"
      &sequence  = "false"
      }

  /* 3.b Step: find unique names for all _File Synonym gate-work's
   * (... of remote-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "SYNONYM"
      &local     = "true"
      &sequence  = "false"
      }

  /* 4.a Step: find unique names for all _File gate-work's
   * (... of remote-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "x"
      &local     = "false"
      &sequence  = "false"
      }

  /* 4.b Step: find unique names for all _File Synonym gate-work's
   * (... of local-db if oracle ...)
   */
  { prodict/gate/gat_getd.i
      &gate-type = "SYNONYM"
      &local     = "false"
      &sequence  = "false"
      }

  /* delete temporary files, in case the user doesn't select it, it's not
   * left-over...
   */
  for each DICTDB._File 
    where DICTDB._File._Db-recid = drec_db 
    and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
    and   DICTDB._File._For-type = "TEMPORARY":
    delete DICTDB._File.
    end.



  if edbtyp = "ORACLE"
   then do:

/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to s_ttb_link.d.
/**/    for each s_ttb_link:
/**/      display
/**/        slctd srchd level
/**/        "*" + master + "*" + s_ttb_link.name + "*" format "x(20)"
/**/        with side-labels frame a.
/**/      for each gate-work
/**/        where gate-work.gate-qual = ( if s_ttb_link.master + s_ttb_link.name = ""
/**/                            then ?
/**/                            else s_ttb_link.master + s_ttb_link.name
/**/                                    ):
/**/        display
/**/          gate-slct label "slct"
/**/          gate-flag label "flg"
/**/          gate-name format "x(20)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-type format "x(9)"
/**/          gate-user format "x(9)"
/**/          with down frame b width 100.
/**/        end.  /* for each gate-work */
/**/      end.  /* for each s_ttb_link */
/**/    output close.
/**/   &ENDIF

    /* if for a link there is no object's definition to be pulled, we
     * delete the link (saves time - one less re-connect and recursion)
     */
    for each s_ttb_link:

/* we can't do that this way, because the distributed dbs need to be 
 * checked when orphans is selected. Also we have no clue to which 
 * db the synonyms are pointing...
 * 
 *    if s_ttb_link.master + s_ttb_link.name = ""
 *     then find first gate-work
 *      where gate-work.gate-slct = TRUE
 *      and ( gate-work.gate-qual = ?
 *      or    gate-work.gate-qual = " orphans           *** "
 *          )
 *      no-lock no-error.
 *     else find first gate-work
 *      where gate-work.gate-slct = TRUE
 *      and   gate-work.gate-qual = s_ttb_link.master + s_ttb_link.name
 *      no-lock no-error.
 *    if not available gate-work
 *     then assign
 *      s_ttb_link.slctd = FALSE
 *      s_ttb_link.srchd = FALSE.
 *     else assign
 *      s_ttb_link.slctd = TRUE
 *      s_ttb_link.srchd = FALSE.
 */
      assign 
        s_ttb_link.srchd = FALSE.
      end.

    
/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to s_ttb_link.d2.
/**/    for each s_ttb_link:
/**/      display
/**/        slctd srchd level
/**/        "*" + master + "*" + s_ttb_link.name + "*" format "x(20)"
/**/        with side-labels frame a2.
/**/      for each gate-work
/**/        where gate-work.gate-qual = ( if s_ttb_link.master + s_ttb_link.name = ""
/**/                            then ?
/**/                            else s_ttb_link.master + s_ttb_link.name
/**/                                    ):
/**/        display
/**/          gate-slct label "slct"
/**/          gate-flag label "flg"
/**/          gate-name format "x(20)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-type format "x(9)"
/**/          gate-user format "x(9)"
/**/          with down frame b2 width 100.
/**/        end.  /* for each gate-work */
/**/      end.  /* for each s_ttb_link */
/**/    output close.
/**/   &ENDIF

    find first s_ttb_link
      where s_ttb_link.slctd  = TRUE
      and   s_ttb_link.srchd  = FALSE
      no-lock no-error.
    if available s_ttb_link
     then do:
      assign
        user_path = "*C,_ora_lkc,_ora_pul"  /* pull objects */
        s_level   = s_ttb_link.level
        s_master  = s_ttb_link.master
        s_lnkname = s_ttb_link.name.
      if  s_ldbname = "tmp00000"
       and connected(s_ldbname)
       then disconnect value(s_ldbname) /*no-error*/.
      find first DICTDB._Db
        where DICTDB._Db._Db-name = s_ldbname
        and   DICTDB._Db._Db-type = "ORACLE"
        no-error.
      if available DICTDB._Db
       then assign DICTDB._Db._Db-misc2[8] = s_master + s_lnkname.
      end.

     else assign
        user_path = "*C,_ora_lkx". /* clean up */
      
    end.

  end.     /* TRANSACTION */

 else do:  /* user canceled out */

  if edbtyp = "ORACLE"
   then assign user_path = "*C,_ora_lkx". /* clean-up */

   else do:  /* SYBASE and ODBC */
   
    for each gate-work:
      delete gate-work.
      end.
    assign
      user_path = "".
    RUN adecomm/_setcurs.p ("").
   
    end.     /* SYBASE and ODBC */
    
  end.  /* user canceled out */

/*------------------------------------------------------------------*/


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat_getd.i

Description:
    
    generate unique names for new objects in gate-work
        
Text-Parameters:
    &gate-type  "synonym" | "sequence" | ""
    &local      "true"    | "false"
    &sequence   "true"    | "false"


Included in:
    gate/gat_get.i

History:
    hutegger    96/04   creation
    D. McMann 04/23/03  Added check for session:schema-change
    D. McMann 06/02/03  Removed creating temporary records for MSS and ODBC
    
--------------------------------------------------------------------*/        
/*h-*/

/*----------------------------------------------------------------------*/

&if "{&sequence}" = "true" &then
  for each gate-work where gate-work.gate-slct = TRUE
                       and   gate-work.gate-type = "{&gate-type}"
            &if "{&local}" = "true" &then
                       and   gate-work.gate-prog = ?
                       and ( gate-work.gate-qual = ?
                       or    user_dbtype <> "ORACLE"):
             &else
                      and   gate-work.gate-prog = ? :
&endif

&if "{&gate-type}" = "synonym" &then
   if num-entries(gate-work.gate-edit,":") < 2
     or entry(3,gate-work.gate-edit,":")   <> "SEQUENCE"
    then next.
&endif

    assign gate-work.gate-prog = gate-work.gate-name.

    /* In order to keep from assigning duplicate default names in
     * the event identical foreign names (for different userids) exist,
     * create dummy _file records long enough to assign all necessary
     * Progress names.  Yes, this is a hack.
     */
    
    RUN prodict/gate/_gat_fnm.p
      ( INPUT        "SEQUENCE"
      , INPUT        drec_db
      , INPUT-OUTPUT gate-work.gate-prog
      ).

    /* If user has set the session parameter to do on line adds we
       can't create a temporary sequence and then delete it */

    IF SESSION:SCHEMA-CHANGE = "" AND edbtyp = "ORACLE" THEN DO:
      CREATE DICTDB._Sequence.
      ASSIGN DICTDB._Sequence._Seq-name     = gate-work.gate-prog
             DICTDB._Sequence._Db-recid     = drec_db
             DICTDB._Sequence._Seq-misc[2]  = "%TEMPORARY%".
    END.    
  END.    /* for each gate-work "_Sequence" */

             &else

  for each gate-work
    where gate-work.gate-slct = TRUE
            &if "{&local}" = "true"
             &then
    and   gate-work.gate-prog = ?
    and ( gate-work.gate-qual = ?
    or    user_dbtype <> "ORACLE"):
             &else
    and   gate-work.gate-prog = ? :
             &endif

            &if "{&gate-type}" = "synonym"
             &then
    if num-entries(gate-work.gate-edit,":") < 2
     or entry(3,gate-work.gate-edit,":")    = "SEQUENCE"
     then next.
             &endif

    assign gate-work.gate-prog = gate-work.gate-name.

    RUN prodict/gate/_gat_fnm.p
      ( INPUT        "TABLE"
      , INPUT        drec_db
      , INPUT-OUTPUT gate-work.gate-prog
      ).

    create DICTDB._File.
    assign
      DICTDB._File._File-name = gate-work.gate-prog
      DICTDB._File._Db-recid  = drec_db
      DICTDB._File._For-type  = "TEMPORARY".

    end.    /* for each gate-work "_File" */

&endif

/*------------------------------------------------------------------*/


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat-mdi1.i

Description:
    
    saves the index-information in the temptables w_index & w_index-field
        
Text-Parameters:
    none

Output-Parameters:
    none
    
Included in:
    odb/_odb_mak.p
    ora/_ora6mak.p
    ora/_ora7mak.p
    rdb/_rdb_mak.p
    syb/_syb_mak.p
    
Author: Tom Hutegger

History:
    hutegger    94/07/20    creation
    
--------------------------------------------------------------------*/        
/*h-*/

    FOR EACH DICTDB._Index OF DICTDB._File:
      FOR EACH DICTDB._Index-field OF DICTDB._Index:
        FIND FIRST DICTDB._Field of DICTDB._Index-field.
        CREATE w_index-field.
        ASSIGN
          w_index-field.pro_Abbreviate = DICTDB._index-field._Abbreviate
          w_index-field.pro_Ascending  = DICTDB._index-field._Ascending
          w_index-field.pro_For-name   = DICTDB._field._For-name
          w_index-field.pro_idx-num    = DICTDB._index._idx-num   
          w_index-field.pro_Index-Seq  = DICTDB._index-field._Index-Seq
          w_index-field.pro_Unsorted   = DICTDB._index-field._Unsorted.
        DELETE DICTDB._Index-field.
      END.
      IF DICTDB._File._Prime-Index = RECID(DICTDB._Index) 
        THEN ASSIGN
          tab_PrimeIdx = DICTDB._Index._Index-name
          tab_PIForNum = DICTDB._index._idx-num.
      CREATE w_index.
      ASSIGN
        w_index.pro_active     = DICTDB._index._active  
        w_index.pro_Desc       = DICTDB._index._Desc  
        w_index.pro_For-Name   = DICTDB._index._For-Name  
        w_index.pro_idx-num    = DICTDB._index._idx-num  
        w_index.pro_Index-Name = DICTDB._index._Index-Name  
        w_index.pro_WordIdx    = DICTDB._index._WordIdx  
        w_index.pro_Unique     = DICTDB._index._Unique
        tab_RecidIdx           = ( IF DICTDB._index._I-misc2[1] begins "r"
                                    THEN DICTDB._index._For-Name
                                    ELSE tab_RecidIdx
                                 )
        tab_RIType             = ( IF DICTDB._index._I-misc2[1] begins "r"
                                    THEN DICTDB._index._I-misc2[1]
                                    ELSE tab_RIType
                                 ). 
      DELETE DICTDB._Index.
    END.

/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat-mdi2.i

Description:
    
    tries to use saved index-information for the currently created index
        
Text-Parameters:
    &for-idx-name    name of the name-field (for example:
                     sybase_objects.name + STRING(indn))
    &for-idx-nam2    ev. 2 possible name of the name-field (for example:
                     sybase_objects.name + STRING(w_index.pro_idx-num))
    &for-obj-name    name of the name-field (sybase_objects.name, ...)
    &idx-uniq-cond   condition to make this index unique
                     for example: "(DICTDBG.Syabse_keys.type = 1)"
    &frame           name of the display-frame (for example: syb_mak, ...)

Output-Parameters:
    none
    
Included in:
    odb/_odb_mak.p
    ora/_ora6mak.p
    ora/_ora7mak.p
    rdb/_rdb_mak.p
    syb/_syb_mak.p
    
Author: Tom Hutegger

History:
    hutegger    94/07/20    creation
    
--------------------------------------------------------------------*/        
/*h-*/

    find first w_index
      where w_index.pro_for-name = TRIM(DICTDBG.{&for-idx-name})
      NO-ERROR.
    IF NOT AVAILABLE w_index
      THEN find first w_index
        where w_index.pro_for-name = TRIM(DICTDBG.{&for-idx-nam2})
        NO-ERROR.
    IF AVAILABLE w_index
     THEN DO:
      ASSIGN 
        idx_desc    = w_index.pro_Desc
        user_env[1] = w_index.pro_index-name.
      FOR EACH w_index-field 
        WHERE  w_index-field.pro_idx-num = w_index.pro_idx-num:
        DELETE w_index-field.
        END.
      END.
     ELSE ASSIGN
      idx_desc    = ""
      user_env[1] = TRIM(DICTDBG.{&for-idx-name}).
    
    RUN "prodict/gate/_gat_xlt.p"
          (FALSE,RECID(DICTDB._File),INPUT-OUTPUT user_env[1]).

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN DISPLAY
      DICTDBG.{&for-obj-name}   @ msg[5]
      user_env[1]               @ msg[6] WITH FRAME {&frame}.
      
    CREATE DICTDB._Index.
    ASSIGN
      DICTDB._Index._Index-Name = user_env[1]
      DICTDB._Index._File-recid = RECID(DICTDB._File)
      DICTDB._Index._Unique     = ( {&idx-uniq-cond} 
                                OR  ( AVAILABLE w_index 
                                AND   w_index.pro_unique ) )
      DICTDB._Index._For-name   = TRIM(DICTDBG.{&for-idx-name})
      DICTDB._Index._Idx-num    = indn
      DICTDB._Index._Active     = TRUE
      DICTDB._Index._Desc       = idx_Desc
      DICTDB._Index._I-misc2[1] = ( IF tab_RecidIdx = TRIM(DICTDBG.{&for-idx-name})
                                     THEN "x" + tab_RIType
                                     ELSE DICTDB._Index._I-misc2[1]
                                  )
      indn                      = indn + 1.

    IF    unique-prime = NO
      AND ( indn       = 2
      OR    {&idx-uniq-cond} 
      OR    ( AVAILABLE w_index 
      AND     ( w_index.pro_idx-num = tab_PIForNum
      OR        w_index.pro_unique ) ) )
      THEN ASSIGN 
        DICTDB._File._Prime-Index = RECID(DICTDB._Index)
        unique-prime              = ( {&idx-uniq-cond} 
                                  OR  ( AVAILABLE w_index
                                  AND   tab_PIForNum = w_index.pro_idx-num
                                      )
                                    ).

    IF AVAILABLE w_index
     THEN DO:  /* w_index available */
      IF  DICTDB._Index._Index-Name <> w_index.pro_index-name
       OR {&idx-uniq-cond}          <> w_index.pro_unique
       THEN DO:  /* index-name changed */
        IF trig-reass = false
         THEN DO:
          assign trig-reass = true.
          output stream stm_errors to ds_upd.e.
          output stream stm_errors close.
          END. 
        output stream stm_errors to ds_upd.e append.
        IF DICTDB._Index._Index-Name <> w_index.pro_index-name
         THEN put stream stm_errors unformatted
          "Index name changed from "
          w_index.pro_index-name " to " user_env[1] skip.
        IF {&idx-uniq-cond}          <> w_index.pro_unique
         THEN put stream stm_errors unformatted
          "Index changed from " STRING(w_index.pro_unique,"UNIQUE/NON-UNIQUE")
          " to " STRING({&idx-uniq-cond},"UNIQUE/NON-UNIQUE") skip.
        output stream stm_errors close.       
        END.     /* index-name changed */  
      delete w_index.
      END.     /* w_index available */
      

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat-mdi3.i

Description:
    
    tries to recreate the indexes which were entered by the user using
    PROGRESS-DataDictionary and also gets rid of "left-over", old,
    "foreign" indexes
        
Text-Parameters:
    &for-obj-name    name of the name-field (sybase_objects.name, ...)

Output-Parameters:
    none
    
Included in:
    odb/_odb_mak.p
    ora/_ora6mak.p
    ora/_ora7mak.p
    rdb/_rdb_mak.p
    syb/_syb_mak.p
    
Author: Tom Hutegger

History:
    hutegger    94/07/20    creation
    
--------------------------------------------------------------------*/        
/*h-*/

  /* delete all left-over, old, "foreign" indexes */
  FOR EACH w_index
    WHERE w_index.pro_for-name <> ""
    AND   w_index.pro_for-name <> ?:
    FOR EACH w_index-field
      WHERE  w_index-field.pro_idx-num = w_index.pro_idx-num:
      DELETE w_index-field.
      END.
    DELETE w_index.  
    END.

 /* try to recreate all old, "USER-defined" indexes */
  FOR EACH w_index:

    ASSIGN scrap = true.
    FOR EACH w_index-field
      WHERE  w_index-field.pro_idx-num = w_index.pro_idx-num
      WHILE scrap = true:
      FIND FIRST DICTDB._field of DICTDB._File
        WHERE DICTDB._field._for-name = w_index-field.pro_for-name
        NO-LOCK NO-ERROR.
      IF NOT AVAILABLE DICTDB._field THEN ASSIGN scrap = false.
      END.
      
    IF NOT scrap  
     THEN FOR EACH w_index-field  /* index not valid anymore */
      WHERE  w_index-field.pro_idx-num = w_index.pro_idx-num: 
      DELETE w_index-field.
      END.

     ELSE DO:  /* retain index */

      ASSIGN user_env[1] = w_index.pro_index-name.
      RUN "prodict/gate/_gat_xlt.p"
          (FALSE,RECID(DICTDB._File),INPUT-OUTPUT user_env[1]).

      IF user_env[1] <> w_index.pro_index-name
       THEN DO:

        IF trig-reass = false
         THEN DO:
          assign trig-reass = true.
          output stream stm_errors to ds_upd.e.
          output stream stm_errors close.
          END.

        output stream stm_errors to ds_upd.e append.
        PUT stream stm_errors unformatted
          "Index name changed from " 
          w_index.pro_index-name " to " user_env[1]   skip.
        output stream stm_errors close.

        END.                            
         
      CREATE DICTDB._Index.
      ASSIGN
        DICTDB._Index._Index-Name = user_env[1]
        DICTDB._Index._File-recid = RECID(DICTDB._File)
        DICTDB._Index._Unique     = w_index.pro_unique
        DICTDB._Index._For-name   = ""
        DICTDB._Index._Idx-num    = indn
        DICTDB._Index._Active     = w_index.pro_active
        DICTDB._Index._WordIdx    = w_index.pro_WordIdx
        DICTDB._Index._Desc       = w_index.pro_Desc
        indn                      = indn + 1
        keycp                     = 1.

      IF tab_PIForNum = w_index.pro_idx-num
        THEN ASSIGN DICTDB._File._Prime-Index = RECID(DICTDB._Index).
     
      FOR EACH w_index-field  
        WHERE  w_index-field.pro_idx-num = w_index.pro_idx-num: 
        
        FIND FIRST DICTDB._field of DICTDB._File
          WHERE DICTDB._field._for-name = w_index-field.pro_for-name
          NO-LOCK NO-ERROR.
        CREATE DICTDB._Index-field.
        ASSIGN
          DICTDB._Index-Field._Index-recid = RECID(DICTDB._Index)
          DICTDB._Index-Field._Index-Seq   = keycp
          DICTDB._Index-Field._Field-recid = RECID(DICTDB._Field)
          DICTDB._Index-Field._Ascending   = w_index-field.pro_Ascending
          DICTDB._Index-Field._Abbreviate  = w_index-field.pro_Abbreviate
          DICTDB._Index-Field._Unsorted    = w_index-field.pro_Unsorted
          keycp                            = keycp + 1.
        DELETE w_index-field.

        END.     /* for each w_index-field */
       
      END.     /* retain index */
       
    DELETE w_index.  
    
    END.  /* for each w_index */

/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

file: prodict/gate/gat_pul.i

description:
    pulls schemainfo of all objects contained in gate-work into
    the temp-tables

    <DS>_get.p gets a list of all pullable objects from the foreign DB
    <DS>_pul.p pulled over the definition from the foreign side
    gat_cmp.p  compared the existing definitions with the pulled info
    gat_cro.p  replaces the existing definitions with the pulled info
               or creates the new object if it didn't already exist

    create <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Update <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Verify <DS> Schema: <DS>_get.p <DS>_pul.p gat_cmp.p gat_cro.p

Text-Parameters:
    &buffer
    &col-fields     additional fields for the fields-phrase for
                    ds_columns
    &colid          ds-field containing the Column-Id
    &comment        ds-field containing the comment-text
    &dbtyp          {"ora"|"syb"}
    &db-type        {"oracle"|"sybase"}
    &ds_recid       phrase for the ds_recid field (db-field, constant,
                    variable ...)
    &for-idx-name   name of the name-field (for example:
                    sybase_objects.name + STRING(indn))
    &for-idx-nam2   ev. 2 possible name of the name-field (for example:
                    sybase_objects.name + STRING(w_index.pro_idx-num))
    &for-obj-name   name of the name-field (sybase_objects.name, ...)
    &idx-fields     additional fields for the fields-phrase for
                    ds_indexes
    &idx-tbl-break  break by phrase for ds_objects of ds_indexes
    &idx-uniq-cond  condition for uniqueness of an index 
    &idx-where      condition for ds_indexes 
    &idxid          ds-field containing the Index-Id
    &init           phrase for initial field
    &length         ds-field containing the length
    &mand           condition for mandatory-field
    &msc23          "{&msc23}"
    &name           ds-field containing the name
    &objid          ds-field containing the Object-Id
    &precision      ds-field containing the Precision
    &radix          ds-field containing the Radix
    &scale          ds-field containing the Scale
    &type           ds-field containing the type
    &typvar         type-name if NOT buffer
    &typvar-b       type-name if buffer
    &usrid          ds-field containing the user-id 
    &usrid-t        ds_objects-field containing the user-id
    
Input:
    &DS_DEBUG   DEBUG to protocol the creation
                ""    to turn off protocol
    gate-work   shared temp-table that contains all the objects to pull

Output:
    s_ttb_tbl   table-information of all objects
    s_ttb_fld   field-information of all objects
    s_ttb_idx   index-information of all objects
    s_ttb_idf   index-field-information of all objects
    s_ttb_seq   sequence-information of all objects

Included in:
    ora/_ora_pul.p
    syb/syb_getp.i

History:
    hutegger    95/03   created out of ora67mak.i and syb_makp.i
    mcmann      02/22/99  Added check for progress recid 
    mcmann      11/15/99  Removed adding of time to index and checking for
                          progress recid index name = table name
    mcmann      03/20/01  Added decending index support for 8i Oracle
    mcmann      04/11/01  Added closed stored proc for send sql 
    mcmann      07/05/01  Added DICTDBG on stored proc finds
    mcmann      07/08/02  DESC index fixes 20020702013,20020703006, 20020622001
    mcmann      07/10/02  Support for UPPER function indexes
    mcmann      07/18/02  20020718-043 shadow col fields being marked sensitive
    mcmann      09/30/02  Added logic for synonmyns of procedures in packages
    mcmann      05/13/03  Removed CLOB and CFILE from Oracle information
    mcmann      11/05/03  Removed check on index name = table name 20031105-020
    fernando    06/12/06  Support for large sequences
    fernando    06/11/07  Unicode and clob support
    fernando    04/07/08  Datetime support for ORACLE
    ashukla     07/08/08  LDAP support (CR#OE00172458)
    knavneet    08/14/08  OE00170417 - Quoting object names if it has special chars.
    kmayur      06/21/11  Added support for Oracle constraint pull - OE00195067
*/

/*
relevant header-comments from syb_mak.p:
----------------------------------------

History
    hutegger    95/01/26    changed schmea-triggers to internal procs
    hutegger    94/11/02    creation
*/
/*h-*/

/*    &DS_DEBUG   DEBUG to protocol the creation    */
/*                ""    to turn off protocol        */
&SCOPED-DEFINE DS_DEBUG   XXDEBUG

&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/{&dbtyp}/{&dbtyp}_ctl.i 7 }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

&IF "{&db-type}" = "sybase"
 &THEN 
&GLOBAL-DEFINE shdw-prefix U##
  define variable l_keycp       as integer   no-undo. 
  define variable l_keyid       as integer   no-undo. 
  define variable typevar       as character no-undo.
&ELSEIF "{&db-type}" = "oracle"
 &THEN 
&GLOBAL-DEFINE shdw-prefix U##
  define variable typevar       as integer   no-undo.

DEFINE TEMP-TABLE ds-field-attributes
       FIELD f_name AS CHAR
       FIELD f_length AS INT
       INDEX f_name f_name.

DEFINE VARIABLE tth         AS HANDLE NO-UNDO.

 &ELSE  /* ODBC */ 
&GLOBAL-DEFINE shdw-prefix _S#_
 &ENDIF
define variable array_name      as character no-undo. 
define variable batch-mode      as logical   no-undo initial false. 
define variable dtyp            as integer   no-undo.
define variable fnam            as character no-undo.
define variable i               as integer   no-undo.
define variable indn            as integer   no-undo.
define variable l_char-types    as character no-undo.
define variable l_chrw-types    as character no-undo.
define variable l_date-types    as character no-undo.
define variable l_dcml          as integer   no-undo.
define variable l_dcml-types    as character no-undo.
define variable l_dt            as character no-undo.
define variable l_fld-descr     as character no-undo.
define variable l_fld-msc24     as character no-undo init ?.
define variable l_fld-pos       as integer   no-undo.
define variable l_floa-types    as character no-undo.
define variable l_frmt          as character no-undo.
define variable l_i#dl-types    as character no-undo.
define variable l_i##d-types    as character no-undo.
define variable l_i##l-types    as character no-undo.
define variable l_i###-types    as character no-undo.
define variable l_init          as character no-undo. 
define variable l_link          as character no-undo.
define variable l_logi-types    as character no-undo.
define variable l_prec          as integer   no-undo.
define variable l_scale         as integer   no-undo.
define variable l_time-types    as character no-undo.
define variable l_tmst-types    as character no-undo.
define variable m1              as integer   no-undo.
define variable m2              as integer   no-undo. 
define variable msg             as character no-undo   EXTENT 8.
define variable namevar         as character no-undo {&case-sensitive}.
define variable namevar-s       as character no-undo. /* synonym */
define variable ntyp            as character no-undo.
define variable onum            as integer   no-undo.
define variable pnam            as character no-undo.
define variable progvar         as character no-undo.
DEFINE VARIABLE s               AS CHARACTER NO-UNDO.
DEFINE VARIABLE tdbtype         AS CHARACTER NO-UNDO.
DEFINE VARIABLE oraversion      AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_tmp           AS CHARACTER NO-UNDO INIT ?.

/*define variable shadow_col    as character no-undo.*/
define variable spclvar         as character no-undo.
define variable typevar-s       as character no-undo. /* synonym */
define variable unique-prime    as logical   no-undo. /* upi already found */
define variable uservar         as character no-undo.


/* define variables for getting real field for function indexes*/
DEFINE VARIABLE didx-name       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE didx-pos        AS INTEGER FORMAT "99999" NO-UNDO.
DEFINE VARIABLE didx-col#       AS INTEGER                NO-UNDO.
DEFINE VARIABLE col-num         AS INTEGER                NO-UNDO.
DEFINE VARIABLE dsname          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE isasc           AS LOGICAL                NO-UNDO.
DEFINE VARIABLE upperfld        AS LOGICAL                NO-UNDO.
DEFINE VARIABLE col-property	AS INTEGER                NO-UNDO.
DEFINE VARIABLE nls_upp         AS CHARACTER              NO-UNDO.

/* OE00170417 */
FUNCTION scanSplCharacter RETURN INTEGER (INPUT name as CHARACTER)  FORWARD.
/*------------------------------------------------------------------*/

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/

form
                                                        skip(1)
  msg[1]        format "x(25)" label "Table"    colon 11 
        "->"
        msg[2]  format "x(25)" label "Table"            skip
  msg[3]        format "x(25)" label "Column"   colon 11 
        "->"
        msg[4]  format "x(25)" label "Field"            skip
  msg[5]        format "x(25)" label "Key"      colon 11 
        "->"
        msg[6]  format "x(25)" label "Index"            skip
  msg[7]        format "x(25)" label "Sequence" colon 11 
        "->"
        msg[8]  format "x(25)" label "Sequence"         skip
  skip(1)
 with row 4 centered THREE-D
  overlay side-labels attr-space
&IF "{&db-type}" = "sybase"
 &THEN 
  title " Loading SYBASE Definitions " use-text
 &ELSE 
  title " Loading ORACLE Definitions " + l_link use-text
 &ENDIF
  frame ds_make.
  
/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/


/*------------------------------------------------------------------*/
procedure error_handling:

define INPUT PARAMETER error-nr         as INTEGER.
define INPUT PARAMETER param1           as cHARACTER.
define INPUT PARAMETER param2           as cHARACTER.

define       variable  err-msg as character extent 5 initial [
/*  1 */ "WARNING: Field not found for Index-Field (Object#: &1 Field#: &2).",
/*  2 */ "ERROR: Table &1 has unsupported data types.",
/*  3 */ "       Skipping this table...",
/*  4 */ "WARNING: Index &1 has too many components; Accepting only first 16.",
/*  5 */ " &1 &2 " /* intentionally left blank for div. error-messages */
    ].
    
    if param1 = ? then assign param1 = "".
    if param2 = ? then assign param2 = "".
    
    if s_1st-error = false
     then do:
      assign s_1st-error = true.
      output stream s_stm_errors to ds_upd.e.
      output stream s_stm_errors close.
      end.
    output stream s_stm_errors to ds_upd.e append.
    PUT stream s_stm_errors unformatted
              SUBSTITUTE(err-msg[error-nr],param1,param2)  skip.
    output stream s_stm_errors close.
  
    end.  /* error_handling */


/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

/*------------------------ INITIALIZATIONS -------------------------*/

RUN adecomm/_setcurs.p ("WAIT").

/** / message "gat_pul.i DS_DEBUG {&DS_DEBUG} " view-as alert-box. / **/

/**/ &IF "{&DS_DEBUG} " = "DEBUG"
/**/ &THEN
/**/  message "gat_pul.i" view-as alert-box.
/**/  run error_handling(5, "*****----- BEGIN gat_pul.i!!! -----*****" ,"").
/**/
/**/  output stream s_stm_errors to gate-work.d.
/**/  for each gate-work no-lock: 
/**/    display stream s_stm_errors gate-work with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/    output to s_ttb_link.d3.
/**/    for each s_ttb_link:
/**/      display
/**/        slctd srchd level
/**/        "*" + master + "*" + s_ttb_link.name + "*" format "x(20)"
/**/        with side-labels frame a.
/**/      for each gate-work
/**/        where gate-work.gate-qual = ( if s_ttb_link.master + s_ttb_link.name = ""
/**/                            then ?
/**/                            else s_ttb_link.master + s_ttb_link.name
/**/                                    ):
/**/        display
/**/          gate-slct label "slct"
/**/          gate-flag label "flg"
/**/          gate-name format "x(20)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-type format "x(9)"
/**/          gate-user format "x(9)"
/**/          with down frame b width 100.
/**/        end.  /* for each gate-work */
/**/      end.  /* for each s_ttb_link */
/**/    output close.
/**/ &ENDIF
/**/

&IF "{&db-type}" = "oracle"
 &THEN 
  
  find first s_ttb_link
    where s_ttb_link.slctd  = TRUE /*actually redundant, but what the heck...*/
    and   s_ttb_link.level  = s_level
    and   s_ttb_link.master = s_master
    and   s_ttb_link.name   = s_lnkname
    no-error.
  if not available s_ttb_link
   then do:  /* should actually never happen */
    assign user_path = "*C,_ora_lkx". /* clean-up */
    leave.
    end.     /* should actually never happen */

    find first DICTDB._Db
      where DICTDB._Db._Db-name = LDBNAME("DICTDBG")
      and   DICTDB._Db._Db-type = "ORACLE".
    ASSIGN oraversion = INTEGER(DICTDB._Db._Db-misc1[3]). 

    /* just make sure the info in the schema holder isn't invalid */
    IF oraversion > 8 THEN DO:
       RUN prodict/ora/_get_oraver.p (OUTPUT oraversion).
       /* if something went wrong that we could not get the version, just keep the value
          from the schema holder
       */
       IF oraversion = 0 THEN
           oraversion = INTEGER(DICTDB._Db._Db-misc1[3]). 
    END.
 &ENDIF
  
assign
  cache_dirty      = TRUE
  l_dt             = ?
  batch-mode       = SESSION:BATCH-MODE
&IF "{&db-type}" = "sybase"
 &THEN
  l_char-types     = "CHAR,BINARY,IMAGE,SYSNAME,TEXT,TIMESTAMP,VARCHAR,VARBINARY"
  l_chrw-types     = " "
  l_date-types     = "DATETIME,DATETIMEN,DATETIME4"
  l_dcml-types     = "MONEY,MONEYN,MONEY4,REAL,FLOAT,FLOATN"
  l_floa-types     = ""
  l_i#dl-types     = ""
  l_i##d-types     = ""
  l_i##l-types     = ""
  l_i###-types     = "INT,INTN,SMALLINT,TIME,TIME4,TINYINT"
  l_logi-types     = "BIT"
/*l_time-types     = "" */
  l_tmst-types     = ""
  user_env         = "". /* yes this is destructive, but we need the -l space */
&ELSEIF "{&db-type}" = "oracle"
 &THEN 
  l_char-types     = "CHAR,VARCHAR,VARCHAR2,ROWID,NVARCHAR2,NCHAR"
  l_chrw-types     = "LONG,RAW,LONGRAW,BLOB,BFILE,CLOB,NCLOB"
  l_date-types     = "DATE"
  l_dcml-types     = "NUMBER"
  l_floa-types     = "FLOAT"
  l_i#dl-types     = ""
  l_i##d-types     = ""
  l_i##l-types     = ""
  l_i###-types     = "TIME"
  l_logi-types     = "LOGICAL"
  l_tmst-types     = "TIMESTAMP,TIMESTAMP_LOCAL,TIMESTAMP_TZ"
  l_link           = user_env[25]
  user_env         = "" /* yes this is destructive, but we need the -l space */
  user_env[25]     = l_link
  l_link           = s_ttb_link.master + s_ttb_link.name
  tdbtype          = "ora"
  s_ttb_link.srchd = TRUE.
 &ENDIF
  

if NOT batch-mode 
 then do:
  assign SESSION:IMMEDIATE-DISPLAY = yes.
  view frame ds_make.
  end.

&IF "{&db-type}" = "oracle" &THEN
  /* this is for supporting datetime as default for an ORACLE date field */
  ASSIGN l_tmp  = (if s_datetime then "datetime_default" else ?).
&ENDIF

RUN prodict/{&dbtyp}/_{&dbtyp}_typ.p
  ( INPUT-OUTPUT i,
    INPUT-OUTPUT i,
    INPUT-OUTPUT l_tmp,
    INPUT-OUTPUT l_dt,
    OUTPUT       l_dt
    ). /* fills user_env[11..17] with datatype-info */



/*---------------------------- MAIN-LOOP ---------------------------*/
_crtloop:
for each gate-work
  where gate-work.gate-slct = TRUE:
 
  /* Skip pseudo-entry, which is needed to signal, if user wants to 
   * compare not just <DS> -> PROGRESS, but also the other direction
   */
  if gate-work.gate-type = "PROGRESS" then next.

  &if "{&db-type}" = "oracle" &then
  /* skip ORACLE-entries for remote-db if current db is the local one
   * and vice versa
   */
    assign
      spclvar = ( if gate-work.gate-type = "SYNONYM"
                  and num-entries(gate-work.gate-edit,":") = 4
                  then entry(4,gate-work.gate-edit,":")
                else if gate-work.gate-qual <> ?
                  then gate-work.gate-qual
                  else  ""
              ).
    if l_link <> spclvar
     then next.
  &endif

  assign
    namevar   = ( if gate-work.gate-type = "SYNONYM"
                   then entry(2,gate-work.gate-edit,":")
                   else gate-work.gate-name
                )
    namevar   = TRIM( if gate-work.gate-type = "BUFFER"
                   then {&buffer} + gate-work.gate-type
                      + "_"       + namevar
                   else             namevar
                )
    namevar-s = ( if gate-work.gate-type = "SYNONYM"
                   then gate-work.gate-name
                   else namevar
                )                   /* name of the synonym */
    typevar-s = ( if gate-work.gate-type = "SYNONYM"
                   then entry(3,gate-work.gate-edit,":")
                   else gate-work.gate-type
                )
    typevar   = ( if typevar-s = "BUFFER"
                   then {&typvar-b}
                        /*       "VIEW"                             |
                         *       LOOKUP("VIEW" ,oobjects) - 1       */
                   else {&typvar}
                        /* ENTRY(LOOKUP(typevar-s,pobjects),sobjects) |
                         *       LOOKUP(typevar-s,oobjects) - 1       */
                )
    uservar   = ( if gate-work.gate-type = "SYNONYM"
                   then entry(1,gate-work.gate-edit,":")
                   else gate-work.gate-user
                )
    progvar   = gate-work.gate-prog
    spclvar   = gate-work.gate-qual
    .

  if SESSION:BATCH-MODE and logfile_open
   then put STREAM logfile unformatted
    gate-work.gate-type at 16
    gate-work.gate-user at 32
    gate-work.gate-name at 45 skip.

  FOR first ds_users
    where ds_users.name = uservar
    no-lock.
    /* to leave the record in scope after leaving this block */
    LEAVE.
  END.

  case typevar-s:

/*-------------------------- SEQUENCES -----------------------------*/

    when    "SEQUENCE" then do:

      if TERMINAL <> "" and NOT batch-mode
       then DISPLAY 
          ""      @ msg[1]   ""       @ msg[5]
          ""      @ msg[2]   ""       @ msg[6]
          ""      @ msg[3]   namevar  @ msg[7]
          ""      @ msg[4]   progvar  @ msg[8]
          with frame ds_make.

      ASSIGN s = progvar.
      IF SESSION:SCHEMA-CHANGE = "new objects"  THEN 
      DO i = 1 TO 9999 WHILE can-find(FIRST s_ttb_seq
                       where s_ttb_seq.pro_name = progvar)
                       OR CAN-FIND(FIRST DICTDB._Sequence
                       WHERE DICTDB._Sequence._db-recid = drec_db
                         AND DICTDB._Sequence._Seq-name = progvar
                         AND DICTDB._Sequence._Seq-misc[2] <> uservar ) :
        progvar = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
                  + STRING(- i).
      end.
     
       create s_ttb_seq.

      &if "{&db-type}" = "oracle" &then
        for each ds_objects where ds_objects.name = namevar
                              and ds_objects.{&usrid-t}  = ds_users.{&usrid}
                              no-lock:
            if ds_objects.type = typevar then leave.
        end.

        if not available ds_objects then next.

        FIND first ds_sequences where ds_sequences.obj#  = ds_objects.obj#
          NO-LOCK.
  

        assign
          s_ttb_seq.ds_incr  =   ds_sequences.increment$
          s_ttb_seq.ds_max   = ( if ds_sequences.maxvalue > (IF is-pre-101b-db THEN 2147483647 ELSE 9223372036854775807)
                                    then ?
                                    else ds_sequences.maxvalue
                               )
          s_ttb_seq.ds_min   =   ds_sequences.minvalue
          s_ttb_seq.ds_cycle = ( ds_sequences.increment$ = 1 )
          .
      &endif

      if gate-work.gate-type = "SYNONYM"
       then assign
        gate-work.ttb-recid = RECID(s_ttb_seq)
        s_ttb_seq.ds_name   = namevar-s
        s_ttb_seq.ds_user   = ""
        s_ttb_seq.ds_spcl   = spclvar
        s_ttb_seq.gate-work = RECID(gate-work)
        s_ttb_seq.pro_name  = progvar.
       else assign
        gate-work.ttb-recid = RECID(s_ttb_seq)
        s_ttb_seq.ds_name   = namevar /* used to be progvar, but:
                                       * progvar could be <> namevar
                                       * in case of name-collisions */
        s_ttb_seq.ds_user   = uservar
        s_ttb_seq.ds_spcl   = spclvar
        s_ttb_seq.gate-work = RECID(gate-work)
        s_ttb_seq.pro_name  = progvar.

      NEXT.
    end.

/*--------------------------- PROCEDURES ---------------------------*/

    when    "PROCEDURE"
    or when "FUNCTION"
    or when "PACKAGE" then do:
      if user_dbtype = "ORACLE"
       then do:
        RUN prodict/ora/_ora_prc.p
          (INPUT  typevar,
           INPUT  namevar,
           INPUT  namevar-s,
           INPUT  uservar,
           INPUT  progvar,
           INPUT  spclvar,
           INPUT  RECID(gate-work),
           OUTPUT gate-work.ttb-recid
          ).
        /* synonym    : namevar   = name of base-object
         *              namevar-s = name of synonym
         * non-synonym: namevar   = namevar-s = name of object
         */
        if   gate-work.gate-type = "SYNONYM"
         then do:  /* adjust synonym-object(s) */

          if gate-work.ttb-recid = ?
           then do:  /* package */
            for each s_ttb_tbl
              where s_ttb_tbl.ds_msc21 = namevar:
              assign
                s_ttb_tbl.ds_msc21 = namevar-s
                s_ttb_tbl.ds_user  = "".
              end.     /* for each s_ttb_tbl */
            end.     /* package */
           ELSE IF typevar = 9 THEN DO: /* synonym for package but a procedure */
             find first s_ttb_tbl
              where recid(s_ttb_tbl) = gate-work.ttb-recid
              no-error.
             if available s_ttb_tbl then 
                 ASSIGN s_ttb_tbl.ds_msc21 = namevar-s 
                        s_ttb_tbl.ds_user = "".              
           END.
           else do:  /* procedure or function */
            find first s_ttb_tbl
              where recid(s_ttb_tbl) = gate-work.ttb-recid
              no-error.
           if available s_ttb_tbl
             then assign
              s_ttb_tbl.ds_name = namevar-s
              s_ttb_tbl.ds_user = "".
            end.     /* procedure of function */

          end.     /* adjust synonym-object */

        NEXT.
        end.
      else if user_dbtype <> "SYBASE"
       then NEXT.
    end.

  end case.
    

/*----------------------------- TABLES -----------------------------*/

  /* remaining typevars values: "TABLE", "VIEW", "BUFFER" */

  if TERMINAL <> "" and NOT batch-mode
   then DISPLAY
      namevar @ msg[1]  "" @ msg[5]
      progvar @ msg[2]  "" @ msg[6]
      ""      @ msg[3]  "" @ msg[7]
      ""      @ msg[4]  "" @ msg[8]
      with frame ds_make.

  for each ds_objects
    where ds_objects.name        = namevar
  /*  and   ds_objects.type        = typevar */
    and   ds_objects.{&usrid-t}  = ds_users.{&usrid}
    no-lock:
    
    if ds_objects.type = typevar then leave.
  end.  

  if not available ds_objects
   then next.

  assign
    onum = ds_objects.{&objid}.

  find first ds_comments
    where ds_comments.{&objid} = onum
    and   ds_comments.{&colid} = {&colid-t-cmnt}
    no-lock no-error.

  create s_ttb_tbl.

  assign
    gate-work.ttb-recid = RECID(s_ttb_tbl)
    s_ttb_tbl.ds_name   = namevar
    s_ttb_tbl.ds_recid  = 0
    s_ttb_tbl.ds_spcl   = spclvar
    s_ttb_tbl.ds_type   = typevar-s
    s_ttb_tbl.ds_user   = uservar
    s_ttb_tbl.gate-work = RECID(gate-work)
    s_ttb_tbl.pro_desc  = ( if available ds_comments
                             then ds_comments.{&comment}
                             else s_ttb_tbl.pro_desc
                          )                               
    s_ttb_tbl.pro_name  = progvar.
    
  /*s_ttb_tbl._Dump-name fields all assigned at end of procedure*/
  /*s_ttb_tbl._Prime-Index*/ /* this field is assigned later */


/*---------------------------- FIELDS ------------------------------*/

  assign
 /* shadow_col = "" */
    array_name = "".

  &IF "{&db-type}" = "oracle"
   &THEN
      /* this is only used for ORACLE */
      EMPTY TEMP-TABLE ds-field-attributes NO-ERROR.
      /* reset this since we use inside the loop below to know when run stored-proc */
      ASSIGN tth = ?.
  &ENDIF

  for each ds_columns
    fields ({&objid} {&colid} name {&type} {&col-fields})
    where ds_columns.{&objid} = onum
    no-lock
    by    ds_columns.{&colid}:

  if (NOT ds_columns.name begins "PROGRESS_RECID_UNIQUE" ) AND
       (ds_columns.name begins "PROGRESS_RECID" OR 
        ds_columns.name begins "_PROGRESS_RECID" OR
        ds_columns.name begins "_PROGRESS_ROWID" ) then do:
      IF s_ttb_tbl.ds_recid = 0 THEN 
        assign s_ttb_tbl.ds_recid = ds_columns.{&colid}.
      NEXT.
    end.
  
    if   length(array_name,"character")  >   0
     and ds_columns.name BEGINS array_name
     then NEXT.

    if ds_columns.name BEGINS "U##"
     then do:
/*      assign shadow_col = string(ds_columns.{&colid}). */
      NEXT.
    end.

  &IF "{&db-type}" = "sybase"
   &THEN
    if ds_columns.name <> "timestamp"
     then do:
   &ENDIF
    
      { prodict/{&dbtyp}/{&dbtyp}_typ.i }
      assign m1 = 0.

  
  &IF "{&db-type}" = "oracle"
   &THEN

      IF oraversion < 9 THEN DO:
          /* NCHAR and NVARCHAR2 (Unicode Types) are only supported as such
             with Oracle 9 and up, otherwise, they will be treated as character.
            NCLOB continues to be unsupported in pre-Oracle 9.
          */
          IF (l_dt = "NVARCHAR2" OR l_dt = "NCHAR" OR l_dt = "NCLOB") THEN DO:
              IF l_dt = "NCLOB" THEN
                 l_dt = "UNDEFINED".
              ELSE 
                  l_dt = (IF l_dt = "NVARCHAR2" THEN "VARCHAR2" ELSE "CHAR").
          END.
      END.
      ELSE DO:
        IF tth = ? AND INDEX(l_dt,"CHAR") > 0 THEN DO:

            /* instead of adding a new table to the metaschema, let's just get the info we want for
            character fields. If this somehow fails, we just won't get it and that's fine
            since the RUN below has no-error. 
            */
            ASSIGN tth = TEMP-TABLE ds-field-attributes:HANDLE.

            RUN STORED-PROC DICTDBG.send-sql-statement LOAD-RESULT-INTO tth NO-ERROR
                            ("select name,nvl(spare3,0) from sys.col$ where obj# = "
                              + string(onum)).
        END.

      END.

      find first ds_comments
        where ds_comments.{&objid} = onum
        and   ds_comments.{&colid} = ds_columns.{&colid}
        no-lock no-error.
    
      assign l_fld-descr = ( if available ds_comments 
                                then ds_comments.{&comment}
                                else ""
                           ).

      if ds_columns.name MATCHES "*##1"
       then do:  /* collect array elements & determine extent */

        assign
          m1          = 1
          i           = length(ds_columns.name,"character") - 1
          array_name  = substring(ds_columns.name, 1, i,"character").

        for each ds_columns-2
          fields(name)
          where ds_columns-2.{&objid} = onum
          no-lock
          by    ds_columns-2.{&colid}:

  	     if NOT ds_columns-2.name BEGINS array_name
  	     then NEXT.  /* can't do in where */
	               /* since array_name may have an '_' in it. */

	    assign
	      m2 = INTEGER(substr(ds_columns-2.name,i + 1,-1,"character"))
	      m1 = ( if m2 > m1
	            then m2
	            else m1
	         ).

        end. /* for each ds_columns-2 */

      end.     /* collect array elements & determine extent */
  &ENDIF

  assign
        l_fld-pos = ( IF (ds_columns.{&colid} > 0 AND NOT ( "{&db-type}" = "oracle" AND 
                                                 ds_columns.NAME BEGINS "SYS_NC" )) THEN
                          ds_columns.{&colid}
                      ELSE (INTEGER(SUBSTRING(ds_columns.NAME, 7, 5))) * -1) .


      { prodict/gate/gat_pulf.i 
        &extent       = "m1"
        &init         = "{&init}"
        &length       = "{&Length}"
        &mand         = "{&mand}"
        &msc23        = "{&msc23}"
        &name         = "{&name}"
        &order-offset = "0"
        &precision    = "{&Precision}"
        &radix        = "{&Radix}"
        &scale        = "{&Scale}"
        }

   /*   if gate-work.gate-type = "BUFFER"
       then 
    */   
       ASSIGN s_ttb_fld.ds_itype = ds_columns.{&type}.

      &IF "{&db-type}" = "oracle" &THEN
          /* for ORACLE 9 and above, ds_msc25 will be "1" if this is a column
             of Unicode data type 
          */
          IF oraversion > 8 THEN
             ASSIGN s_ttb_fld.ds_msc25 = (IF ds_columns.charsetform = 2 THEN '1' ELSE ?).

          /* let's try to fix format for field that may gave been defined with character semantics */
          IF s_ttb_fld.pro_type = "character" THEN DO:
              FIND ds-field-attributes WHERE ds-field-attributes.f_name = ds_columns.name NO-ERROR.
              IF AVAILABLE ds-field-attributes AND
                 ds-field-attributes.f_length > 0 AND {&Length} NE ds-field-attributes.f_length THEN DO:
                 ASSIGN s_ttb_fld.pro_frmt  = "x(" + STRING(min(320,max(1,ds-field-attributes.f_length))) + ")"
                        /* we save away the character semantics size of the field */
                        s_ttb_fld.ds_allocated = ds-field-attributes.f_length.
              END.
          END.
      &ENDIF

      FOR first ds_columns-2
        where ds_columns-2.{&objid} = onum
        and   ds_columns-2.name  = "{&shdw-prefix}" + ds_columns.name
        no-lock.
      END.
      if available ds_columns-2
       then assign
        s_ttb_fld.ds_shd#  = ds_columns-2.{&colid}
        s_ttb_fld.ds_shdn  = string(s_ttb_fld.ds_shd#)
        s_ttb_fld.pro_case = FALSE
        .

  &IF "{&db-type}" = "sybase"
   &THEN 

      end.   /* each ds_columns */
    end.   /* each ds_columns */

  for each ds_columns 
    where  ds_columns.id = onum
    and   (ds_columns.type = 61
    or     ds_columns.type = 111
    or     ds_columns.type = 58)
    no-lock:
    assign
      l_fld-pos = ds_columns.{&colid}
      l_dt      = ( if    ds_columns.type = 58 
                     or ( ds_columns.type = 111
                     and  ds_columns.syb_length = 4 )
                     then "TIME4" 
                     else "TIME"
                   ).
    { prodict/gate/gat_pulf.i 
        &extent       = "m1"
        &init         = "{&init}"
        &length       = "{&Length}"
        &mand         = "{&mand}"
        &msc23        = "{&msc23}"
        &name         = "{&name}"
        &order-offset = "5"
        &precision    = "{&Precision}"
        &radix        = "{&Radix}"
        &scale        = "{&Scale}"
        }

  &ELSEIF "{&db-type}" = "oracle"
   &THEN 

    /* if not verify and defaulting to datetime, skip this */
    if l_dt = "DATE" AND (s_vrfy OR NOT s_datetime)
     then do:  /* Add time fields */
      assign l_dt = "TIME".
      { prodict/gate/gat_pulf.i 
        &extent       = "m1"
        &init         = "{&init}"
        &length       = "{&Length}"
        &mand         = "{&mand}"
        &msc23        = "{&msc23}"
        &name         = "{&name}"
        &order-offset = "5"
        &precision    = "{&Precision}"
        &radix        = "{&Radix}"
        &scale        = "{&Scale}"
        }
      end.     /* Add time fields */
   &ENDIF
   
    end.   /* each ds_columns */
   
/*---------------------------- CONSTRAINTS -----------------------------*/

   FOR EACH ds_cons WHERE ds_cons.OBJ# = onum:
     FIND FIRST ds_constraint WHERE ds_constraint.CON# = ds_cons.CON# no-lock no-error. 
    
     FOR EACH ds_cons-fld WHERE ds_cons-fld.CON# = ds_cons.CON#:
      
       FOR EACH ds_columns
       WHERE ds_columns.{&objid} = onum AND ds_columns.{&colid} = ds_cons-fld.COL#:
    
       CREATE s_ttb_con.
       ASSIGN tab_name   = namevar
           col_name   = ds_columns.NAME
           const_name = ds_constraint.name
           par_key_num= ds_cons.RCON#
           expre      = ds_cons.condition
           index_num  = ds_cons.enabled.
       IF ds_cons.TYPE# = 1 
           THEN cons_type = "C".
       ELSE IF ds_cons.TYPE# = 2
           THEN cons_type = "PRIMARY KEY".         
       ELSE IF ds_cons.TYPE# = 3
           THEN cons_type = "UNIQUE".
       ELSE IF ds_cons.TYPE# = 4
           THEN cons_type = "FOREIGN KEY".    
       IF par_key_num <> ? THEN
           FIND FIRST ds_constraint-2 WHERE ds_constraint-2.CON# = par_key_num NO-LOCK NO-ERROR.
             IF AVAILABLE ds_constraint-2 THEN ASSIGN par_key = ds_constraint-2.NAME.
           FIND FIRST ds_objects WHERE ds_objects.OBJ# = index_num NO-LOCK NO-ERROR.
             IF AVAILABLE ds_objects 
             THEN DO:  
             assign user_env[1] = TRIM(ds_objects.NAME).
             IF INDEX(user_env[1],"##") > 0 THEN
                  ASSIGN i = INDEX(user_env[1], "##") + 2.
             ELSE IF INDEX(user_env[1],"__") > 0 THEN
                  ASSIGN i = INDEX(user_env[1], "__") + 2.  
             ELSE
                  i = 1.   
    
             user_env[1]        = substring(user_env[1],i,-1,"character").
             ASSIGN index_name = user_env[1].
             END.     
       END.
     END.   
   END.  
   
/*---------------------------- INDEXES -----------------------------*/

  assign 
    indn         = 1
    unique-prime = no.

  for each ds_indexes
      fields({&idx-fields})
      where ds_indexes.{&idxid} = onum
      {&idx-where} NO-LOCK:
    FOR each ds_objects-2
      fields({&objid} name)
      where ds_objects-2.{&objid} = ds_indexes.{&objid}     
      NO-LOCK {&idx-tbl-break}:
  
    /* skip PROGRESS_RECID index */
      if ds_objects-2.name MATCHES "*##progress_recid" OR
         ds_objects-2.name MATCHES "*##_PROGRESS_RECID" OR
         ds_objects-2.name MATCHES "*##_PROGRESS_ROWID" 
         then NEXT.

      /* OE00210415: Modified the code to remove the restriction of pulling index object name begins with "SYS_" for oracle dataserver */
       if ds_objects-2.NAME BEGINS "SYS_" AND NOT "{&db-type}" = "oracle"  THEN NEXT. 


      {prodict/gate/gat_puli.i
        &for-idx-name = "{&for-idx-name}"
        &for-idx-nam2 = "{&for-idx-nam2}"
        &for-obj-name = "{&for-obj-name}"
        &frame        = "ds_make"
        &idx-uniq-cond = "{&idx-uniq-cond}"
      }                                  /* try to recreate index */



/*-------------------------- INDEX-FIELDS --------------------------*/

      &IF "{&db-type}" = "sybase" &THEN 
        repeat l_keycp = 1 to 8:

          if l_keycp = 1 THEN l_keyid = ds_indexes.key1.
          else if l_keycp = 2 THEN l_keyid = ds_indexes.key2.
          else if l_keycp = 3 THEN l_keyid = ds_indexes.key3.
          else if l_keycp = 4 THEN l_keyid = ds_indexes.key4.
          else if l_keycp = 5 THEN l_keyid = ds_indexes.key5.
          else if l_keycp = 6 THEN l_keyid = ds_indexes.key6.
          else if l_keycp = 7 THEN l_keyid = ds_indexes.key7.
          else if l_keycp = 8 THEN l_keyid = ds_indexes.key8.

          if l_keyid <> ? then do: /* index-component */
            find first s_ttb_fld where s_ttb_fld.ttb_tbl  = RECID(s_ttb_tbl)
                                   and s_ttb_fld.ds_stoff = l_keyid
                                   no-error.

            if not available s_ttb_fld then do:  /* was PROGRESS_RECID or shadow column */
                   /* Try to find 'real' column           */
              find first s_ttb_fld where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
                                     and s_ttb_fld.ds_shd# = l_keyid
                                     no-error.
              if not available s_ttb_fld then next.
            end.     /* was PROGRESS_RECID or shadow column */
                   /* Try to find 'real' column           */
                   
            create s_ttb_idf.
            ASSIGN s_ttb_idf.pro_abbr  = FALSE
                   s_ttb_idf.pro_asc   = TRUE
                   s_ttb_idf.pro_order = l_keycp
                   s_ttb_idf.ttb_fld   = RECID(s_ttb_fld)
                   s_ttb_idf.ttb_idx   = RECID(s_ttb_idx).

          end.     /* index-component */
        
        end.     /* repeat l_keycp = 1 to 8 */
    
      &ELSEIF "{&db-type}" = "oracle" &THEN 
        assign nls_upp = user_env[40].
        assign i = 0.   /* i := number of date-time fields */
        for each ds_idx-cols fields({&objid} {&colid} pos#)
           where ds_idx-cols.{&objid} = ds_indexes.{&objid}
           no-lock
           by ds_idx-cols.pos# /*{&colid}*//**/:

          if i + ds_idx-cols.pos# > 16 then do:  /* too many index-fields */
            run error_handling(4, 
                               string(s_ttb_idx.ds_name), 
                               string(ds_idx-cols.{&colid})
                              ).
            next.
          end.     /* too many index-fields */    

          if s_ttb_tbl.ds_recid = ds_idx-cols.{&colid} AND
             s_ttb_tbl.ds_recid <> 0  then next.  /* progress_recid */

          IF ds_idx-cols.{&colid} = 0 THEN DO: 
            RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE
                ( "select pos#, intcol# from sys.icol$ where obj# = " + string(ds_indexes.{&objid}) ).
            FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = h1:
              ASSIGN didx-pos =  INTEGER(SUBSTRING(proc-text, 1 ,25)) .
              IF didx-pos = ds_idx-cols.pos# THEN DO:
                ASSIGN didx-col# = INTEGER(SUBSTRING(proc-text, 26 ,25))
                       col-num = didx-col#.
                find first s_ttb_fld where s_ttb_fld.ttb_tbl =  RECID(s_ttb_tbl)
                                 and s_ttb_fld.ds_stoff =  (didx-col# * -1)
                                 and s_ttb_fld.ds_stdtype <> 7 * 4096 /* not of type TIME */
                                 no-error.

                IF AVAILABLE s_ttb_fld THEN DO:
                  ASSIGN dsname = s_ttb_fld.defaultname.
                  FIND FIRST DICTDBG.oracle_columns WHERE DICTDBG.oracle_columns.obj# = onum
                                                     AND DICTDBG.oracle_columns.NAME = s_ttb_fld.ds_name NO-ERROR.
                  IF AVAILABLE DICTDBG.oracle_columns  and nls_upp = "y" THEN
		     ASSIGN upperfld = (IF DICTDBG.oracle_columns.default$  BEGINS "NLS_UPPER" THEN TRUE
                                       ELSE FALSE).        
		  ELSE
		      ASSIGN upperfld = (IF DICTDBG.oracle_columns.default$  BEGINS "UPPER" THEN TRUE
                                       ELSE FALSE).

                  find first s_ttb_fld where s_ttb_fld.ttb_tbl =  RECID(s_ttb_tbl)
                                 and s_ttb_fld.ds_name =  dsname
                                 and s_ttb_fld.ds_stdtype <> 7 * 4096 /* not of type TIME */
                                 no-error.
                  IF AVAILABLE s_ttb_fld THEN 
                    ASSIGN didx-col# = s_ttb_fld.ds_stoff.      

                END.
                LEAVE.
              END.
            END.
            CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h1.

            RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE
              ( "select property from sys.col$ where obj# = " + STRING(onum) + " and intcol# = " + STRING(col-num) ).
            FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = h1:
              col-property = INTEGER(TRIM(proc-text)).
              IF col-property = ? THEN
                col-property = 0.
              IF col-property >= 131072 AND GET-BITS(col-property, 18, 1) = 1 THEN
                ASSIGN isasc = FALSE.
              ELSE
                ASSIGN isasc = TRUE.
            END.
            CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h1.
          END.
          ELSE
            ASSIGN didx-col# = ds_idx-cols.{&colid}
                  isasc = TRUE
                  upperfld = FALSE.

          find first s_ttb_fld where s_ttb_fld.ttb_tbl =  RECID(s_ttb_tbl)
                                 and s_ttb_fld.ds_stoff =  didx-col#
                                 and s_ttb_fld.ds_stdtype <> 7 * 4096 /* not of type TIME */
                                 no-error.

          if not available s_ttb_fld then 
            find first s_ttb_fld where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
                                   and s_ttb_fld.ds_stoff = didx-col#
                                   no-error.
          if not available s_ttb_fld then 
            find first s_ttb_fld /* shadow-col */
                where s_ttb_fld.ttb_tbl    =  RECID(s_ttb_tbl)
                  and s_ttb_fld.ds_shd#    =  didx-col#
                  no-error.

          if not available s_ttb_fld then do:
            run error_handling(1, 
                               string(s_ttb_idx.ds_name), 
                               string(ds_idx-cols.{&colid})
                               ).
            next.
          end.

          create s_ttb_idf.
          ASSIGN s_ttb_idf.pro_abbr  = FALSE
                 s_ttb_idf.pro_asc   =isasc
                 s_ttb_idf.pro_order = ds_idx-cols.pos# + i
                 s_ttb_idf.ttb_fld   = RECID(s_ttb_fld)
                 s_ttb_idf.ttb_idx   = RECID(s_ttb_idx).

          IF s_ttb_fld.pro_type = "character" THEN
                 s_ttb_fld.pro_case  = (IF s_ttb_fld.pro_case THEN NOT upperfld
                                        ELSE s_ttb_fld.pro_case).   

        end.   /* for each ds_idx-cols */
    
        /* 20050203-022 - if we got here and the index has no fields, this could be the
           progress_recid index. If the table name is longer than 14 characters, upon
           migration, we define the table name as the index name (we don't add the
           ##progress_recid suffix). Therefore, if the index name matches the table name,
           delete it now just in case the user defined an index named the table name,
           so we don't screw up when running the adjust schema, by assigning the wrong
           foreign index name.
        */
        FIND FIRST s_ttb_idf WHERE s_ttb_idf.ttb_idx = RECID(s_ttb_idx) NO-ERROR.
        IF NOT AVAILABLE s_ttb_idf THEN DO:
            /* if the table name matches the index, and the index had no real fields,
               just delete it now
            */
            IF s_ttb_idx.ds_name = s_ttb_tbl.ds_name THEN DO:
                DELETE s_ttb_idx.
            END.
        END.    
      &ENDIF
  
    end. /* for ech ds_objects-2*/
  END.  /* for each ds_indexes */

&IF "{&db-type}" = "sybase"
 &THEN 

/*--------------- MANDATORY OF UNIQUE-INDEX COMPONENTS ---------------*/

/* check if all fields, part of unique-index, are mandatory and
 * eventually set mandatory to true
 */
  for each s_ttb_idx
    where s_ttb_idx.ttb_tbl  = RECID(s_ttb_tbl)
    and   s_ttb_idx.pro_uniq = TRUE:
    for each s_ttb_idf
      where s_ttb_idf.ttb_idx = RECID(s_ttb_idx):
      find first s_ttb_fld
        where /* s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
        and   */ RECID(s_ttb_fld)  = s_ttb_idf.ttb_fld
        no-error.
      if available s_ttb_fld
       and s_ttb_fld.pro_mand = FALSE
       then assign s_ttb_fld.pro_mand = TRUE.
      end.     /* for each s_ttb_idf */
    end.     /* for each s_ttb_idx */

&ELSEIF "{&db-type}" = "oracle"
 &THEN 

/*--------------------------- RECID-INDEX ----------------------------*/

/* We are looking for a mandatory integer-field with an unique index.
 * if the field isn't mandatory and/or its precision, scale is out of
 * range and/or the index isn't unique, then the field/index is only
 * user-selectable (= Level 2). That means, he ahs to make sure, that
 * his application provides the adaquate checks for what ever the schema
 * isn't restrictive enough.
 * Otherwise the field/index is automatically selectable (= Level 1).
 */
 
  if  s_ttb_tbl.ds_recid <= 0
   or s_ttb_tbl.ds_recid  = ?
   then do:  /* no progress_recid -> check indexes for ROWID usability */
    
    /* check all indexes and calculate their usability-level */
    for each s_ttb_idx
      where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
   /* and   s_ttb_idx.ds_name <> ""*/ :
    
      find first s_ttb_idf 
        where s_ttb_idf.ttb_idx = RECID(s_ttb_idx)
        no-error.
      if not available s_ttb_idf then NEXT.

      find first s_ttb_fld 
        where RECID(s_ttb_fld) = s_ttb_idf.ttb_fld.
      find next s_ttb_idf 
        where s_ttb_idf.ttb_idx = RECID(s_ttb_idx)
        no-error.
      if not available s_ttb_fld            /* no components at all   */
       or available s_ttb_idf               /* more than 1 components */
       or s_ttb_fld.ds_type <> "NUMBER" then NEXT. /* wrong data-type */
       
      /* index has for-name & only one numeric field -> user-selectable */
      assign
        s_ttb_idx.ds_msc21   = "u"
        s_ttb_idx.hlp_fstoff = s_ttb_fld.ds_stoff.

      if  s_ttb_idx.pro_uniq = FALSE
       or s_ttb_fld.pro_mand = FALSE then NEXT.
      
      find first ds_columns
        where ds_columns.{&objid} = onum
        and   ds_columns.name     = s_ttb_fld.ds_name
        no-lock no-error.
      if   NOT AVAILABLE ds_columns
       or  {&precision} >= 10
       or  {&scale}     >   0
       then NEXT.  /* not automatically selectable */
      
      /* index is automatically selectable */
      assign s_ttb_idx.ds_msc21 = "a".

      end. /* for each s_ttb_idx */

    /* select first "a" index */
    find first s_ttb_idx
      where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
      and s_ttb_idx.ds_msc21 = "a"
      no-error.
    if available s_ttb_idx
     then assign
        s_ttb_idx.ds_msc21 = "ra" 
        s_ttb_tbl.ds_recid = s_ttb_idx.hlp_fstoff * -1
        s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
     else assign
        s_ttb_tbl.ds_recid = ?
        s_ttb_tbl.ds_rowid = ?.
     
    end.     /* no progress_recid -> check indexes for ROWID usability */

  /* PROGRESS-RECID-field -> reset recid-info of all indexes */
   else for each s_ttb_idx
      where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl):
      assign s_ttb_idx.ds_msc21 = ?.
      end.

 &ENDIF


/* as last step we have to replace the synonyms' names and users */ 
  if gate-work.gate-type = "SYNONYM"
   then assign
     s_ttb_tbl.ds_name = namevar-s
     s_ttb_tbl.ds_user = "".


  end. /* for each gate-work */


&IF "{&db-type}" = "oracle"
 &THEN 

/* OE00170417:Quoting objects when they have special character *
 * CR#OE00170689: Quoting user when they have special char slash *
*/
for each s_ttb_tbl:
   if scanSplCharacter(s_ttb_tbl.ds_name) = 1 then
      s_ttb_tbl.ds_name = QUOTER(s_ttb_tbl.ds_name).
   if (INDEX(s_ttb_tbl.ds_user,'~\') > 0) then
      s_ttb_tbl.ds_user = QUOTER(s_ttb_tbl.ds_user).

   if s_ttb_tbl.ds_msc21 ne "" AND s_ttb_tbl.ds_msc21 ne ? and 
     LOOKUP(s_ttb_tbl.ds_msc21,"PROCEDURE,FUNCTION,PACKAGE") > 0 THEN DO:
           if scanSplCharacter(s_ttb_tbl.ds_msc21) = 1 then 
               s_ttb_tbl.ds_msc21 =QUOTER(s_ttb_tbl.ds_name).
           if (INDEX(s_ttb_tbl.ds_user,'~\') > 0) then
               s_ttb_tbl.ds_user =QUOTER(s_ttb_tbl.ds_user).
   end.
end.
 
for each s_ttb_fld:
   if scanSplCharacter(s_ttb_fld.ds_name) = 1 then
      s_ttb_fld.ds_name = QUOTER(s_ttb_fld.ds_name).
end.
 
for each s_ttb_idx:
   if scanSplCharacter(s_ttb_idx.ds_name) = 1 then
      s_ttb_idx.ds_name = QUOTER(s_ttb_idx.ds_name).
end.

for each s_ttb_seq:
   if scanSplCharacter(s_ttb_seq.ds_name) = 1 then
      s_ttb_seq.ds_name = QUOTER(s_ttb_seq.ds_name).
   if (INDEX(s_ttb_seq.ds_user,'~\') > 0) then
      s_ttb_seq.ds_user = QUOTER(s_ttb_seq.ds_user).
end.
/* END of Quoting code for OE00170417 / CR#OE00170689 */

/*--------------------- PREPARE FOR NEXT LINK  ---------------------*/

/* we are done with this link, lets do the next one (srchd = false)
 * if there aren't anymore, we continue to the next step, wich is pulling the
 * object-names into the gate-work temp-table
 */

find first s_ttb_link
  where s_ttb_link.slctd  = TRUE
  and   s_ttb_link.srchd  = FALSE
  no-lock no-error.
if not available s_ttb_link
 then      /* done with pulling objects             */
           /*   -> ev. compare and/or transfer them */
  assign user_path = "*C,"
                   + ( if user_env[25] = "compare"
                         then "_gat_cmp,"
                         else ""
                     )
                   + "_gat_cro,_ora_lkx". /* clean-up */

 else do:  /* pull objects from next selected link */

  assign
    s_level   = s_ttb_link.level
    s_master  = s_ttb_link.master
    s_lnkname = s_ttb_link.name.

  if connected(s_ldbname)
   then disconnect value(s_ldbname) /*no-error*/.

  do transaction:
    find first DICTDB._Db
      where DICTDB._Db._Db-name = s_ldbname
      and   DICTDB._Db._Db-type = "ORACLE".
    assign DICTDB._Db._Db-misc2[8] = s_master + s_ttb_link.name.
    end.     /* transaction */

  assign  user_path = "*C,_ora_lkc,_ora_pul".

  end.     /* pull objects from next selected link */
&ENDIF

  
/**/&IF "{&DS_DEBUG}" = "DEBUG"
/**/ &THEN
/**/
/**/ message "gat_pul.i:  &ds_debug: {&DS_DEBUG}" view-as alert-box.
/**/
/**/ run error_handling(5, "*****----- END gat_pul.i!!! -----*****" ,"").
/**/
/**/  output stream s_stm_errors to gate-work.d.
/**/  for each gate-work no-lock: 
/**/    display stream s_stm_errors gate-work with stream-io width 255.
/**/    display  stream s_stm_errors gate-work.gate-edit format "x(30)".
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_tbl.d.
/**/  for each s_ttb_tbl no-lock: 
/**/    display stream s_stm_errors  
/**/      s_ttb_tbl.ds_msc13      format "zzzz9-"
/**/      s_ttb_tbl.ds_msc21      format "x(15)"
/**/      s_ttb_tbl.ds_msc22      format "x(15)"
/**/      s_ttb_tbl.ds_msc23      format "x(15)"
/**/      s_ttb_tbl.ds_msc24      format "x(15)"
/**/      s_ttb_tbl.ds_name       format "x(15)" skip
/**/      s_ttb_tbl.ds_recid      format "zzzz9-"
/**/      s_ttb_tbl.ds_rowid      format "zzzz9-"
/**/      s_ttb_tbl.ds_spcl       format "x(15)"
/**/      s_ttb_tbl.ds_type       format "x(15)"
/**/      s_ttb_tbl.ds_user       format "x(15)"
/**/      s_ttb_tbl.gate-work     format "zzzz9-"
/**/      s_ttb_tbl.pro_desc      format "x(15)" skip
/**/      s_ttb_tbl.pro_name      format "x(15)"
/**/      s_ttb_tbl.pro_prime-idx format "x(15)"
/**/      s_ttb_tbl.pro_recid     format "zzzz9-"
/**/      with stream-io width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_fld.d.
/**/  for each s_ttb_fld no-lock: 
/**/    display stream s_stm_errors 
/**/     RECID(s_ttb_fld) format "zzzzzz9" label "RECID"
/**/     s_ttb_fld.pro_name s_ttb_fld.ttb_tbl  s_ttb_fld.pro_type
/**/     s_ttb_fld.ds_prec  format "zzz9-" label "m11"
/**/     s_ttb_fld.ds_scale format "zzz9-" label "m12"
/**/     s_ttb_fld.ds_lngth format "zzz9-" label "m13"
/**/     s_ttb_fld.ds_radix format "zzz9-" label "m14"
/**/     s_ttb_fld.ds_msc23 s_ttb_fld.ds_msc24
/**/     s_ttb_fld.ds_shdn  s_ttb_fld.ds_shd# format "zzz9-" label "sh#"
/**/     s_ttb_fld.ds_name  s_ttb_fld.ds_stoff s_ttb_fld.ds_type
/**/     s_ttb_fld.ds_stdtype format "zzzz9-" label "std"
/**/     with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_fl1.d.
/**/  for each s_ttb_fld no-lock: 
/**/    display stream s_stm_errors 
/**/     RECID(s_ttb_fld) format "zzzzzz9" label "RECID"
/**/     s_ttb_fld.pro_name  s_ttb_fld.ttb_tbl   s_ttb_fld.pro_case
/**/     s_ttb_fld.pro_dcml  s_ttb_fld.pro_desc  s_ttb_fld.pro_extnt
/**/     s_ttb_fld.pro_frmt  s_ttb_fld.pro_init  s_ttb_fld.pro_mand
/**/     s_ttb_fld.pro_order s_ttb_fld.pro_type
/**/     with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_idx.d.
/**/  for each s_ttb_idx no-lock: 
/**/    display stream s_stm_errors 
/**/     RECID(s_ttb_idx)     format "zzzzzz9" label "RECID"
/**/     s_ttb_idx.pro_name s_ttb_idx.ttb_tbl 
/**/     s_ttb_idx.pro_prim s_ttb_idx.pro_actv 
/**/     s_ttb_idx.pro_uniq    
/**/     s_ttb_idx.pro_idx#   format "zzz9-"    label "ix#"
/**/     s_ttb_idx.ds_name    s_ttb_idx.ds_msc21
/**/     s_ttb_idx.hlp_dtype  format "zzzz9-"  label "dty#"
/**/     s_ttb_idx.hlp_fld#   format "zzz9-"    label "fld#"
/**/     s_ttb_idx.hlp_fstoff format "zzz9-"    label "fst#"
/**/     s_ttb_idx.hlp_level  format "9"       label "L"
/**/     s_ttb_idx.hlp_mand   s_ttb_idx.hlp_msc23  
/**/     with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_idf.d.
/**/  for each s_ttb_idf no-lock: 
/**/    display stream s_stm_errors s_ttb_idf. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_seq.d.
/**/  for each s_ttb_seq no-lock: 
/**/    display stream s_stm_errors s_ttb_seq except s_ttb_seq.ds_max. 
/**/    display stream s_stm_errors s_ttb_seq.ds_max format "-z,zzz,zzz,zz9". 
/**/    end.
/**/  output stream s_stm_errors close.
/**/
/**/ message "gat_pul.i: end of debug-output" skip "wait"
/**/    view-as alert-box.
/** / assign
/**/   user_path = ""
/**/   s_1st-error = FALSE.
/ **/
/**/  &ENDIF

if NOT batch-mode
 then SESSION:IMMEDIATE-DISPLAY = no.

RUN adecomm/_setcurs.p ("").

if NOT batch-mode
 then HIDE FRAME ds_make NO-PAUSE.

 &SCOPED-DEFINE SPL_CHAR_SUPPORTED 32
/* Function : scanSplCharacter
   Purpose  : Scan if there is any special character
   Input    : string to be scanned
   RETURN   : 1 if there is a special character found else 0 */
/* OE00170417 */
/* NOTE: In oracle if an object name has to have a character that's not
alpha-numeric, underscore, # or $ then we need to quote it while creating
it in Oracle and also quote it while referring to such objects in any SQL.
On the contrary if an object name is created without quotes in Oracle 
(like most names that are alpha-numeric ) then quoting them will give error */

FUNCTION scanSplCharacter RETURN INTEGER
 (INPUT name as CHARACTER):
DEFINE VARIABLE splchar AS CHARACTER EXTENT {&SPL_CHAR_SUPPORTED} INIT [
    '/',      /* 1  */
    '~\',     /* 2  */
    ' ',      /* 3  */
    '	',    /* 4  */ /* tab character*/
    '!',      /* 5  */
    '@',      /* 6  */
    '%',      /* 7  */
    '&',      /* 8  */
    '*',      /* 9  */
    '(',      /* 10 */
    ')',      /* 11 */
    '-',      /* 12 */
    '+',      /* 13 */
    '=',      /* 14 */
    '~{',     /* 15 */
    '~}',     /* 16 */
    '~[',     /* 17 */
    '~]',     /* 18 */
    '|',      /* 19 */
    ':',      /* 20 */
    ';',      /* 21 */
    '~"',     /* 22 */
    '~'',     /* 23 */
    '<',      /* 24 */
    ',',      /* 25 */
    '>',      /* 26 */
    '.',      /* 27 */
    '?',      /* 28 */
    '`',      /* 29 */
    '~~',     /* 30 */
    '^'       /* 31 */
/* Last element is a LINE FEED */
    ].
splchar[{&SPL_CHAR_SUPPORTED}] = STRING(CHR(10)). /*LINE FEED */

  DEFINE VARIABLE i AS INTEGER NO-UNDO INIT 0.
  REPEAT i = 1 TO {&SPL_CHAR_SUPPORTED}:
    IF INDEX(name, splchar[i]) > 0 THEN
     RETURN 1.
  END.
  RETURN 0.
END FUNCTION.


RETURN.

/*------------------------------------------------------------------*/

/**********************************************************************
* Copyright (C) 2000,2007-2009 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat_pul2.i

Description:
    calculates formats and decimals of fields
    
interface:
    l_char-types    -> character, decimals = length
    l_chrw-types    -> character, decimals = ? (raw-data-types)
    l_date-types    -> date
    l_dcml-types    -> fixed point decimal
    l_floa-types    -> floating point decimal
    l_logi-types    -> logical
    l_time-types    -> time
    l_tmst-types    -> time-stamp
    
Included in:            
    prodict/odb/odb_pul.i
    prodict/ora/_ora_prc.p
    prodict/gate/gat_pul.i
    prodict/mss/mss_pul.i
    
History:
    hutegger    95/03   combined from odb, ora and syb4
    mcmann    04/13/99  Added check for intial value in integers and decimals
    mcmann    04/05/00  Modified for MSS database type.
    mcmann    07/10/02  Changed how integer's format are calculated
    mcmann    01/08/03  Added check for initial value of TODAY for Dates
    mcmann    04/09/03  Changed parameters for error message 2 to just table name
    fernando  06/12/06  Support for int64
    fernando  02/14/08  Support for datetime
    fernando  06/19/09  Support for datetime-tz

--------------------------------------------------------------------*/
if      CAN-DO(l_char-types,s_ttb_fld.ds_type)    /**** CHARACTERS ****/
 then assign
         l_dcml = s_ttb_fld.ds_lngth
         l_frmt    = ( if ENTRY(dtyp,user_env[17],"|") <> "c"
                      then ENTRY(dtyp,user_env[17],"|")
                      else "x(" + STRING(min(320,max(1,l_dcml))) + ")" 
                   ).

else if CAN-DO(l_chrw-types,s_ttb_fld.ds_type)          /**** RAWS ****/
     then assign
         l_dcml  = (if s_ttb_fld.ds_lngth = 0
                     then 8
                     else s_ttb_fld.ds_lngth
                   )
         l_frmt    = ( if ENTRY(dtyp,user_env[17],"|") <> "c"
                      then ENTRY(dtyp,user_env[17],"|")
                      else "x(" + STRING(min(320,max(1,l_dcml))) + ")" 
                   )
         l_dcml = ?.

else if CAN-DO(l_date-types,s_ttb_fld.ds_type)         /**** DATES ****/
     then do :
      assign l_dcml = ?.

      CASE ENTRY(dtyp,user_env[17],"|"):
          WHEN "d"  THEN l_frmt = "99/99/99".
          WHEN "dt" THEN l_frmt = "99/99/9999 HH:MM:SS.SSS".
          WHEN "dtz" THEN l_frmt = "99/99/9999 HH:MM:SS.SSS+HH:MM".
          OTHERWISE      l_frmt   =  ENTRY(dtyp,user_env[17],"|").
      END CASE.
end.
else if CAN-DO(l_dcml-types,s_ttb_fld.ds_type)      /**** DECIMALS ****/
     then DO:
       assign
         l_prec  = ( if s_ttb_fld.ds_radix = 2
                       then 0.30103
                       else 1
                   )
         l_dcml  = min(10,integer(s_ttb_fld.ds_scale * l_prec))
         l_prec  = integer(s_ttb_fld.ds_prec * l_prec)
         l_frmt  = ( if      ENTRY(dtyp,user_env[17],"|") = "i"
                      then "->>>>>>>>9"
                      else ENTRY(dtyp,user_env[17],"|")
                   )
         l_dcml  = ( if      ENTRY(dtyp,user_env[17],"|") = "#"
                      then l_dcml
                     else if ENTRY(dtyp,user_env[17],"|") = "i"
                      or     INDEX(l_frmt,".")            =  0
                      then 0
                      else LENGTH(l_frmt, "character") - INDEX(l_frmt,".")
                   ).

       /* description of l_prec and l_dcml; (l_prec: sign does, decimal 
        *   point doesn't count). Example:   l_prec = 18; l_dcml = 8
        *          l_prec
        *   |---------x-------|
        *   ->>>>>>>>9.99999999          [->(8)9.9(8)
        *              |------| 
        *               l_dcml
        * Maximum length of format is 30 characters (dec-point counts)
        */
       if ENTRY(dtyp,user_env[17],"|") = "#"
        then do:  /* format to generate out of ora-info */
         if l_dcml = ? then assign l_dcml = 0.
         if  l_prec = ?
          then assign    /*  ?,?  =>  ->>>>>>>>9  */
           ntyp    = ( if user_dbtype = "ORACLE"
                        then "integer"
                        else "decimal"
                     )
           l_dcml  = 0
           l_frmt  = "-"
                   + FILL(">",MINIMUM(8,s_ttb_fld.ds_lngth - 2))
                   + "9".
         else if l_prec = 1
          and    l_dcml = 0
          then assign   /* 1,0 =>  yes/no  */
           ntyp    = ( if user_dbtype = "ORACLE"
                        then "logical"
                        else "decimal"
                     )
           l_dcml  = 0
           l_frmt  = ( if user_dbtype = "ORACLE"
                        then "yes/no"
                        else "9"
                     ).
         else if l_prec <= 9
          and    l_dcml <= 0
          then assign   /* 6,-2 =>  ->>999 [->(2)9(3)] */
           i       = 1 - l_dcml
           ntyp    = ( if user_dbtype = "ORACLE"
                        then "integer"
                        else "decimal"
                     )
           l_dcml  = 0
           l_frmt  = "-"
                   + (IF i = 1 THEN FILL(">",l_prec - i)
                       ELSE FILL(">",l_prec - i - 1))
                   + FILL("9",i).
         else if l_dcml <= 0
          then assign    /* 15,-2 =>  ->>>>>>>>>>>999 [->(11)9(3)] */ 
           ntyp    = ( if user_dbtype = "ORACLE" AND l_prec <= 18
                        then "int64"
                        else "decimal"
                     )
           i       = MINIMUM(29,1 - l_dcml)
           l_dcml  = 0
           l_frmt  = "-"
                   + FILL(">",MINIMUM(29,l_prec) - i - 1)
                   + FILL("9",i).
          else assign    /* 15,2  =>  ->>>>>>>>>>>>9.99 [->(12)9.9(2)] */
           l_frmt = "-"
                  + FILL(">",MINIMUM(29,l_prec) - l_dcml - 1) 
                  + "9." 
                  + FILL("9",l_dcml).
         end.     /* format to generate out of ora-info */
       end.

else if CAN-DO(l_floa-types,s_ttb_fld.ds_type)        /**** FLOATS ****/
     then DO:
       assign
        l_prec = ( if s_ttb_fld.ds_radix = 2
                    then INTEGER(s_ttb_fld.ds_prec * 0.30103)
                    else s_ttb_fld.ds_prec
                 ).
       if      ENTRY(dtyp,user_env[17],"|")  = "i"
        then assign /* new data-type and format for INTEGER */
             l_frmt    = "->>>>>>>>9"
             l_dcml = 0.
       else if ENTRY(dtyp,user_env[17],"|") <> "#"
        then assign /* new data-type and format from _ora_typ.p */
         l_frmt    = ENTRY(dtyp,user_env[17],"|")
         l_dcml = ( if INDEX(l_frmt,".") = 0
                      then 0
                      else LENGTH(l_frmt, "character") - INDEX(l_frmt,".")
                   ).
       else if l_prec = ?
        then assign    /* ? (:=30) =>  ->>>>>>>>>>>>>>>>>>9.9<<<<<<<<< */
         l_dcml = 10
         l_frmt    = "-"
                 + FILL(">",17)
                 + "9.9" 
                 + FILL("<",l_dcml - 1).
       else if l_prec <= 22
        then assign    /* 12    =>  ->>>>>9.9<<<< */
         l_dcml = 1 + integer(l_prec / 2 - 1.6)
         l_frmt    = "-"
                 + FILL(">",l_prec - l_dcml - 2)
                 + "9.9" 
                 + FILL("<",l_dcml - 1).
        else assign    /* 26    =>  ->>>>>>>>>>>>>9.9<<<<<<<<<< */
         l_dcml = 1 + MINIMUM(9,integer(l_prec / 2 - 1.6))
         l_frmt    = "-"
                 + FILL(">",MINIMUM(17,l_prec - l_dcml - 2))
                 + "9.9" 
                 + FILL("<",l_dcml - 1).
       end.

else if CAN-DO(l_i#dl-types,s_ttb_fld.ds_type)      /**** INTEGERS ****/
     then assign
      l_frmt   = ( if    ENTRY(dtyp,user_env[17],"|") = "i"
                    then "->>>>>>>>9"
                   else if ENTRY(dtyp,user_env[17],"|") = "l"
                    then "yes/no"
                   else if ENTRY(dtyp,user_env[17],"|") = "#"
                    then "->>>>>>>>>>>>>>9"  /* ->(14)9 */
                    else ENTRY(dtyp,user_env[17],"|")
                 ).

else if CAN-DO(l_i##d-types,s_ttb_fld.ds_type)      /**** INTEGERS ****/
     then assign
      l_frmt   = ( if    ENTRY(dtyp,user_env[17],"|") = "i"
                    then "->>>>>>>>9"        /* ->(8)9 */
                   else if ENTRY(dtyp,user_env[17],"|") = "#"
                    then "->>>>>>>>>>>>>>9"  /* ->(14)9 */
                    else ENTRY(dtyp,user_env[17],"|")
                 ).

else if CAN-DO(l_i###-types,s_ttb_fld.ds_type)      /**** INTEGERS ****/
     then assign
      l_frmt   = ( if      ENTRY(dtyp,user_env[17],"|") = "i"
                    then "->>>>>>>>9"        /* ->(8)9 */
                    else ENTRY(dtyp,user_env[17],"|")
                 ).

else if CAN-DO(l_logi-types,s_ttb_fld.ds_type)      /**** LOGICALS ****/
     then assign
      l_frmt   = ( if ENTRY(dtyp,user_env[17],"|") = "l"
                    then "yes/no"
                    else ENTRY(dtyp,user_env[17],"|")
                 ).


else if CAN-DO(l_tmst-types,s_ttb_fld.ds_type)   /**** TIME-STAMPS ****/
     then do:
     assign
         l_dcml = ?.

      CASE ENTRY(dtyp,user_env[17],"|"):
          WHEN "c"  THEN l_frmt = "x(26)".
          WHEN "d"  THEN l_frmt = "99/99/99".
          WHEN "dt" THEN l_frmt = "99/99/9999 HH:MM:SS.SSS".
          WHEN "dtz" THEN l_frmt = "99/99/9999 HH:MM:SS.SSS+HH:MM".
          OTHERWISE      l_frmt   =  ENTRY(dtyp,user_env[17],"|").
      END CASE.
end.
    else do:                                    /**** OTHERWISE ****/
      run error_handling
        ( 2, 
          s_ttb_tbl.ds_name, "" 
        ).
      run error_handling ( 3, "", "" ).
      if tdbtype = "ora" THEN DO:
        FOR EACH s_ttb_fld WHERE s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):
            DELETE s_ttb_fld.
        END.
        DELETE s_ttb_tbl.
        DELETE gate-work.
        UNDO _crtloop, NEXT.
      END.
      else
       UNDO, NEXT.  /* check */         
    end.


/*------------------------------------------------------------------*/

assign
  s_ttb_fld.pro_type    = ntyp
  s_ttb_fld.pro_dcml    = l_dcml
  s_ttb_fld.pro_case    = (ntyp = "character") /* changes if shadow exists*/
  s_ttb_fld.ds_stdtype  = INTEGER(ENTRY(dtyp,user_env[14]))
  s_ttb_fld.pro_frmt    = ( if l_frmt = "?"
                             then s_ttb_fld.pro_frmt
                             else l_frmt
                          )
  s_ttb_fld.pro_init    = ( if (l_init = "?" or l_init = ?)
                             then ?
                            else if ntyp = "logical"
                             then string(l_init = "0")
                             else l_init
                          ).
  
  IF s_ttb_fld.pro_type = "INTEGER" OR s_ttb_fld.pro_type = "DECIMAL" 
    OR s_ttb_fld.pro_type = "DATE" OR s_ttb_fld.pro_type BEGINS "DATETIME" THEN 
  _init:
  DO:
    IF s_ttb_fld.pro_init = ? THEN LEAVE _init.
    ELSE IF s_ttb_fld.pro_init = "TODAY" AND s_ttb_fld.pro_type = "DATE" THEN LEAVE _init.
    ELSE IF s_ttb_fld.pro_init = "NOW" AND s_ttb_fld.pro_type BEGINS "DATETIME" THEN LEAVE _init.
    ELSE DO i = 1 to LENGTH(s_ttb_fld.pro_init):
      IF INDEX("abcdefghijklmnopqrstuvwxyz", substring(s_ttb_fld.pro_init,i,1)) > 0 THEN DO:          
        ASSIGN s_ttb_fld.pro_init = ?.
        LEAVE _init.
      END.
    END.
  END.     
/*------------------------------------------------------------------*/


/*********************************************************************
* Copyright (C) 2012 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gat/gat_pulf.i

Description:
    creates the _field-definitions out of the oraC-definitions
    
Text-Parameters:
    &length         ds-field containing the length
    &mand           condition for mandatory-field
    &msc23          "{&msc23}"
    &name           ds-field containing the name
    &order-offset   {0|5} to be added to the l_fld-pos
    &precision      ds-field containing the Precision
    &radix          ds-field containing the Radix
    &scale          ds-field containing the Scale
    &extent         in the range of 0 to n
    
Included in:            
    prodict/gate/gat_pul.i
    
History:
    hutegger    95/03   abstracted from prodict/ora/ora_mak.i
    mcmann    03/20/01  Added assignment of default$ on fields
    mcmann    06/19/01  Check for ending quote in Oracle V8 for defaults
    mcmann    07/03/01  Verify that initial value starts with '"' or "'"
                        20010531-003
    mcmann    08/21/01  Added check for initial value length being > 1.
    fernando  04/19/06  Unicode support
    fernando  09/29/06  Handle default values surrounded by parenthesis.
                        20060928-048
    sgarg     04/13/12  Handle indexed datetime-tz field

--------------------------------------------------------------------*/

/* this code gets executed only for the first element of array-field   */
/* so extent-code of field is always ##1 (even with real extent >= 10) */
assign
  pnam = TRIM(DICTDBG.{&name})
  pnam = ( if {&extent} > 0 AND LENGTH (pnam, "character") > 3 /* Drop the "##1" */
             then SUBSTRING (pnam, 1, LENGTH (pnam, "character") - 3, "character")
             else pnam )
  fnam = pnam
  pnam = ( if lookup(s_ttb_tbl.ds_type,"PROCEDURE,FUNCTION,PACKAGE") <> 0
            and lookup(SUBSTRING(pnam,1,1,"character"),"@,&,#") <> 0
            then substring(pnam,2,-1,"character")
            else pnam
         ).

RUN prodict/gate/_gat_fnm.p 
    ( INPUT        "FIELD",
      INPUT        RECID(s_ttb_tbl),
      INPUT-OUTPUT pnam
    ).

if NOT SESSION:BATCH-MODE
 then DISPLAY
   TRIM(DICTDBG.{&name}) @ msg[3]
   pnam                  @ msg[4]
   WITH FRAME ds_make.

assign
  dtyp    = LOOKUP(l_dt,user_env[12])
  l_init  = ?
  ntyp    = ( if dtyp = 0 OR ENTRY(dtyp,user_env[15]) = "undefined"
                then "undefined"
                else ENTRY(dtyp,user_env[15])
            )
  l_dcml  = 0.

CREATE s_ttb_fld.

assign
  s_ttb_fld.pro_Desc    = l_fld-descr
  s_ttb_fld.pro_Extnt   = {&extent}
  s_ttb_fld.pro_name    = pnam
  s_ttb_fld.ttb_tbl     = RECID(s_ttb_tbl)
  s_ttb_fld.tmpfld_recid  = RECID(s_ttb_fld)
  s_ttb_fld.ds_prec     = {&Precision}
  s_ttb_fld.ds_scale    = {&Scale}
  s_ttb_fld.ds_lngth    = {&Length}
  s_ttb_fld.ds_radix    = {&Radix}
  s_ttb_fld.ds_msc23    = {&msc23}
  s_ttb_fld.ds_msc24    = l_fld-msc24
  s_ttb_fld.ds_stoff    = l_fld-pos
  s_ttb_fld.ds_name     = fnam
  s_ttb_fld.ds_type     = l_dt
  s_ttb_fld.pro_order   = l_fld-pos * 10 + 1000 
                              + {&order-offset}
  s_ttb_fld.pro_mand    = {&mand}
  l_init                = TRIM({&init}).

IF l_init <> ? AND LENGTH(l_init) >= 3 THEN DO:
  IF l_init BEGINS '"U##' THEN 
      ASSIGN l_init = SUBSTRING(l_init, 5, (LENGTH(l_init) - 5)).
  ELSE IF l_init BEGINS 'UPPER(' THEN
      ASSIGN l_init = SUBSTRING(l_init,8, (LENGTH(l_init) - 9)).
  ELSE IF l_init BEGINS 'NLS_UPPER(' THEN DO:
      ASSIGN l_init = ENTRY(1,l_init).
      ASSIGN l_init = SUBSTRING(l_init,12, (LENGTH(l_init) - 12)).
      END.
      /*
  ELSE IF l_init BEGINS 'NLS_UPPER(' THEN
      ASSIGN l_init = ENTRY(1,l_init).
      */
   /* OE00216717: Oracle creates a function based index on "timestamp with 
    * timezone" column. Internally it uses SYS_EXTRACT_UTC function to create
    * function based index, that normarlizes the key value to UTC. 
    * A unique index on this coulmn would raise a unique index violation if two 
    * datetime-tz values in different time zone but at the same instance 
    * are inserted in the table.
    */
  ELSE IF l_init BEGINS 'SYS_EXTRACT_UTC(' THEN
      ASSIGN l_init = SUBSTRING(l_init,18, (LENGTH(l_init) - 19)).
 
  ELSE IF l_init BEGINS '(' THEN
      ASSIGN l_init = SUBSTRING(l_init, 2, (LENGTH(l_init) - 2)).

  /* 20060928-048 - check parenthesis above and then check for
     quotes here regardless.
  */
  IF l_init BEGINS '"' OR l_init BEGINS "'"  THEN
      ASSIGN l_init = SUBSTRING(l_init, 2, (LENGTH(l_init) - 2)).

END.
 
IF LENGTH(l_init) > 1 AND (SUBSTRING(l_init, (LENGTH(l_init) - 1), 1) = '"' OR
   SUBSTRING(l_init, (LENGTH(l_init) - 1), 1) = "'")  THEN
  ASSIGN l_init = SUBSTRING(l_init, 1,(LENGTH(l_init) - 1) ).


IF s_ttb_Fld.ds_name BEGINS "SYS_NC" THEN 
  ASSIGN s_ttb_Fld.defaultname = l_init
         l_init = ?.

/* ODBC:                                                      */
/*   If the field is not updatable (l_fld-msc24 contains "N") */ 
/*   then the field cannot be mandatory.                      */
/* ORA, SYB:                                                  */
/*   l_fld-msc24 = ?                                          */

{prodict/gate/gat_pul2.i
  &undo = "next"
  }


/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/gat_puli.i

Description:
    
    creates new s_ttb_idx record
        
Text-Parameters:
    &for-idx-name    name of the name-field (for example:
                     sybase_objects.name + STRING(indn))
    &for-idx-nam2    ev. 2 possible name of the name-field (for example:
                     sybase_objects.name + STRING(w_index.pro_idx-num))
    &for-obj-name    name of the name-field (sybase_objects.name, ...)
    &idx-uniq-cond   condition to make this index unique
                     for example: "(DICTDBG.Syabse_keys.type = 1)"
    &frame           name of the display-frame (for example: syb_mak, ...)

Output-Parameters:
    none
    
Included in:
    odb/_odb_pul.p
    ora/_ora_pul.p
    syb/syb_pulp.i

History:
    hutegger    95/03   creation (derived from gate/gat_mdi2.i)
    mcmann  06/30/99 Change how to determine what index name should be.
    
--------------------------------------------------------------------*/        
/*h-*/

    assign user_env[1] = TRIM({&for-idx-name}).
    IF INDEX(user_env[1],"##") > 0 THEN
     ASSIGN i = INDEX(user_env[1], "##") + 2.
    ELSE IF INDEX(user_env[1],"__") > 0 THEN
     ASSIGN i = INDEX(user_env[1], "__") + 2.  
    ELSE
      i = 1.   
    
    user_env[1]        = substring(user_env[1],i,-1,"character").

    RUN prodict/gate/_gat_fnm.p
          (INPUT        "INDEX",
           INPUT        RECID(s_ttb_tbl),
           INPUT-OUTPUT user_env[1]
          ).

    if TERMINAL <> "" and NOT batch-mode
     then DISPLAY
        TRIM({&for-idx-name})   @ msg[5]
        user_env[1]             @ msg[6]
        with frame ds_make.

    create s_ttb_idx.

    assign
      s_ttb_idx.pro_name = user_env[1]
      s_ttb_idx.ttb_tbl  = RECID(s_ttb_tbl)
      s_ttb_idx.idx_recid  = RECID(s_ttb_idx)
      s_ttb_idx.pro_uniq = ( {&idx-uniq-cond} )
      s_ttb_idx.ds_name  = TRIM({&for-idx-name})
      s_ttb_idx.pro_idx# = indn
      s_ttb_idx.pro_actv = TRUE
      indn               = indn + 1.

    if    unique-prime = FALSE
      and ( indn       = 2
      or    {&idx-uniq-cond} )
      then assign 
        s_ttb_idx.pro_prim = TRUE
        unique-prime       = ( {&idx-uniq-cond} ).

/*------------------------------------------------------------------*/


/****************************************************************************
* Copyright (C) 2006,2008-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions               *
* contributed by participants of Possenet.                                  *
*****************************************************************************/
                                                                           /*
file:   gate/gatework.i

description:
    Define a shared workfile for use in prompting the user to
    pick the gateway objects to add, verify or modify

included in:
    prodict/dictvar.i
    prodict/gui/_guigget.p
    prodict/odb/_odb_get.p
    prodict/odb/_odb_mak.p
    prodict/odb/_odb_md3.p
    prodict/ora/_ora_get.p
    prodict/ora/_ora_lk0.p
    prodict/ora/_ora6md3.p
    prodict/ora/_ora7md3.p
    prodict/ora/ora67get.i
    prodict/rdb/_rdb_get.p
    prodict/syb/syb_getp.i
    prodict/user/_usr_gsl.p

Note: ORACLE: Synonyms: 
      gate-work.gate-edit contains <owner>.<name>,<type> of the 
      object the synonym is pointing to


History:
    hutegger    96/02   added gate-obj# for ora-synonym support
    hutegger    95/03   addoption for new verify-routines
    mcmann     03/20/01 Added defaultname for descending index support
    mcmann     05/21/02 Added new {&selVarType} variable.
    slutz      08/10/05 Added s_ttb_fld.ds_msc26 20050531-001
    fernando   06/26/06 Added support for large sequences
    fernando   02/25/08 Added parameter for datetime
    rohit      04/30/08 Added new field gate-seqpre to gate-work
    knavneet   04/28/09 BLOB support for MSS (OE00178319)
    sgarg      04/28/09 Added s_ttb_fld.ds_msc17. (OE00193877)
    kmayur     06/21/11 Added s_ttb_con for constraint pull OE00195067    
*/

DEFINE {&new} SHARED TEMP-TABLE gate-work NO-UNDO
  field gate-edit AS CHARACTER             /* report-editor */
  field gate-flag AS LOGICAL INITIAL FALSE /* do me? y/n */
  field gate-flg2 AS LOGICAL INITIAL FALSE /* do me the other thing? y/n */
  field gate-name AS CHARACTER case-sensitive /* foreign name */
  field gate-obj# AS INTEGER               /* oracle type-number */
  field gate-prog AS CHARACTER             /* progress name */
  field gate-qual AS CHARACTER		   /* db-qualifier */
  field gate-slct AS LOGICAL INITIAL FALSE /* user selected me? y/n */
  field gate-type AS CHARACTER             /* type (our name) */
  field gate-seqpre AS CHARACTER           /* sequence prefix- either _SEQT_ or _SEQT_REV_ */
  field gate-user AS CHARACTER             /* userid */
  field ttb-recid AS RECID                 /* RECID(s_ttb_{seq|tbl}) */
       /* don't use it for packages with 1 gate-work = n s_ttb_tbl!! */
  INDEX upi       IS PRIMARY UNIQUE 
            gate-slct DESCENDING gate-flg2 DESCENDING 
            gate-name ASCENDING  gate-type gate-user gate-qual
  INDEX istp    /*IS         UNIQUE*/ 
            gate-slct DESCENDING 
            gate-type ASCENDING  gate-prog
  INDEX gate_idx  IS         UNIQUE 
            gate-slct DESCENDING 
            gate-name ASCENDING  gate-type gate-user gate-qual
  INDEX uiflag    IS         UNIQUE
            gate-slct DESCENDING 
            gate-flag ASCENDING  gate-flg2 gate-name gate-type gate-user gate-qual.

DEFINE {&selVarType}_name       AS character no-undo {&options}.
DEFINE {&selVarType}_owner      AS character no-undo {&options}.
DEFINE {&selVarType}_qual       AS character no-undo {&options}.
DEFINE {&selVarType}_type       AS character no-undo {&options}.
DEFINE {&selVarType}_vrfy       AS logical   no-undo.
DEFINE {&selVarType}_outf       AS logical   no-undo.
DEFINE {&selVarType}_datetime   AS logical   no-undo.
DEFINE {&selVarType}_lob        AS logical   no-undo.
DEFINE {&selVarType}_clobtype   AS logical   no-undo initial TRUE.
DEFINE {&selVarType}_blobtype   AS logical   no-undo initial TRUE.
DEFINE {&selVarType}_primary    AS logical   no-undo.
DEFINE {&selVarType}_best       AS integer   no-undo initial 1.
DEFINE {&selVarType}_recidcompat AS logical  no-undo.
DEFINE {&selVarType}_wildcard   AS logical   no-undo initial TRUE.
DEFINE {&new} SHARED variable proc_obj	 as logical. /* OE00195067 */

/* NOTES:
 * + if an object exists on the PROGRESS-Side but doesn't exist on the
 *   foreign side, the fields gate-type, gate-user and gate-qual are ""
 * + when verifying an object, we use gate-flg2 to signal wether we found
 *   differences or not
 */

&IF "{&FOREIGN_SCHEMA_TEMP_TABLES}" = "INCLUDE"
 &THEN

  /* notes about the temp-tables and their connectability among themself
   * and to Schema-tables:
   *
   * s_ttb_tbl:     foreign Info for PROGRESS-Tables
   *    unique Indexes  : (pro-name)
   *                      (ds_type ds_name ds_user ds_spcl)
   *    <-> _File       : pro_recid
   *    <-> gate-work   : RECID(gate-work)  = s_ttb_tbl.gate-work
   *    <-> s_ttb_fld   : s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
   *    <-> s_ttb_idx   : s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
   *
   * s_ttb_seq:     foreign Info for PROGRESS-Sequences
   *    unique Indexes  : (pro-name)
   *                      (ds_name ds_user ds_spcl)
   *    <-> gate-work   : RECID(gate-work)  = s_ttb_seq.gate-work
   *    <-> _Sequence   : pro_recid
   *
   * s_ttb_fld:     foreign Info for PROGRESS-Fields
   *    unique Indexes  : (ttb_tbl pro_name)
   *                      (ttb_tbl ds_name ds_type)
   *                      (ttb_tbl pro_order)
   *    ~unique Indexes : (ttb_tbl ds_stoff) /* arrays: n flds 1 stoff */
   *    <-> w_field     : pro_name
   *    <-> _Field      : ds_name [ ds_type ]
   *    <-> s_ttb_tbl   : RECID(s_ttb_tbl)  = s_ttb_fld.ttb_tbl
   *    <-> s_ttb_idf   : s_ttb_idf.ttb_fld = RECID(s_ttb_fld)
   *
   * s_ttb_idx:     foreign Info for PROGRESS-Indexes
   *    unique Indexes  : (ttb_tbl pro_name)
   *    <-> _Index      : ???
   *    <-> s_ttb_tbl   : RECID(s_ttb_tbl)  = s_ttb_idx.ttb_tbl
   *    <-> s_ttb_idf   : s_ttb_idf.ttb_idx = RECID(s_ttb_idx)
   *
   * s_ttb_idf:     foreign Info for PROGRESS-Index-Fields
   *    unique Indexes  : (ttb_idx pro_order)
   *                      (ttb_fld ttb_idx)
   *    <-> _Index-Field: ???
   *    <-> s_ttb_tbl   : RECID(s_ttb_tbl)  = s_ttb_fld.ttb_tbl
   *    <-> s_ttb_idf   : s_ttb_idf.ttb_fld = RECID(s_ttb_fld)
   *
   */
   
  define {&new} shared variable   s_1st-error as logical initial FALSE NO-UNDO.
  define {&new} shared stream     s_stm_errors.
  
  define {&new} shared TEMP-TABLE s_ttb_seq
          field ds_name          as character /* foreign name */
          field ds_spcl          as character initial ? 
                                              /* ODB: FullName [3] */
                                              /* ORA: LinkName [8]*/
          field ds_type          as character /* foreign type */
          field ds_user          as character /* foreing owner */
          field ds_incr          as INT64     /* FOREIGN increment */
          field ds_max           as INT64     /* FOREIGN max-value */
          field ds_min           as INT64     /* FOREIGN min-value */
          field ds_cycle         as logical   /* foreign cycle yes/no */
          field gate-work        as recid
          field pro_name         as character /* PROGRESS name */
          field pro_recid        as recid     initial ?
          index upi              is unique primary
                                     pro_name
          index uids             is unique
                                    ds_name ds_user ds_spcl.
                                    
  define {&new} shared TEMP-TABLE s_ttb_tbl
          field ds_msc13         as integer   initial ? 
                                              /*    misc1[3]           */
          field ds_msc21         as character initial ? 
                                              /*    misc2[1]           */
                                              /* ORA: Package-Name     */
          field ds_msc22         as character initial ? 
                                              /*    misc2[2]           */
                                              /* ODB: Hidden-fields    */
          field ds_msc23         as character initial ?
                                              /*    misc2[3]           */
                                              /* ODB: RECID-field-name */
          field ds_msc24         as character initial ?
                                              /*    misc2[4]           */
                                              /* ODB: proc-param-names */
                                              /* ORA: ?                */
                                              /* SYB: ?                */
          field ds_msc25         as character initial ?
                                              /*    misc2[5]           */
                                              /* ODB: ROWID index name */
                                              /* ORA: ?                */
                                              /* SYB: ?                */
          field ds_msc15         as integer   initial ?
                                              /*    misc1[5]    */
                                              /* ODB & MSS: RECID type */
                                              /* 1=32 bits & 2=64bits  */
          field ds_msc16         as integer   initial ?
                                              /*    misc1[6]           */
                                              /* MSS: RECID Fn Compat  */
                                              /* 1= exclusion criteria */
          field ds_name          as character case-sensitive
                                              /* foreign name          */
          field ds_recid         as integer   initial ?
                                              /*    misc1[1]           */
                                              /* recid-field-nr        */
          field ds_rowid         as integer   initial ? 
                                              /*    misc1[2]           */
                                              /* ODB: misc1[2]         */
          field ds_spcl          as character initial ? 
                                              /* ODB: Qualifier        */
                                              /* ORA: LinkName         */
          field ds_type          as character /* foreing type          */
          field ds_user          as character /* foreing owner         */
          field gate-work        as recid
          field pro_desc         as character 
     /*   field pro_dump-name    as character   */
          field pro_name         as character 
          field pro_prime-idx    as character
          field pro_recid        as recid     initial ?
          field tmp_recid        as recid     initial ?
          field pk_idx_recid     as recid     initial ?
          field rank_desc        as character initial ""
          index upi              as unique primary 
                                     pro_name
          index uids             is unique
                                    ds_type ds_name ds_user ds_spcl.

  define {&new} shared TEMP-TABLE s_ttb_fld
          field ds_prec          as integer   initial ?
                                              /*    misc1[1]    */
                                              /* ODB: precision */
          field ds_scale         as integer   initial ?
                                              /*    misc1[2]    */
                                              /* ODB: scale     */
          field ds_lngth         as integer   initial ?
                                              /*    misc1[3]    */
                                              /* ODB: length    */
          field ds_radix         as integer   initial ?
                                              /*    misc1[4]    */
                                              /* ODB: radix     */
          field ds_msc17         as integer   initial ?
                                              /*    misc1[7]    */
                                              /* ODB: "EXTATTR" or ?  */
          field ds_msc23         as character initial ?
                                              /*    misc2[3]    */
                                              /* ODB: "<name>" or ?  */
          field ds_msc24         as character initial ?
                                              /*    misc2[4]    */
                                              /* ODB: fld-properties */
          field ds_msc25         as character initial ?
                                              /*    misc2[5]    */
                                              /* ORA: ? or 1 for Unicode data type */
                                              /* ODB: ? - note that misc2[5] is used for ODB - see ds_shdn below */
          field ds_msc26         as character initial ?
                                              /*    misc2[6]    */
                                              /* ODB: Extent char "_" or "#" */
          field ds_shdn          as character initial ?
                                              /*    shadow-column    */
                                              /* ODB: misc2[5]       */
                                              /* ORA: misc2[2]       */
          field ds_shd#          as integer   initial ?
                                              /*    misc1[5]         */
                                              /* ODB: shadow-column  */
          field ds_name          as character case-sensitive
          field ds_itype         as integer   initial ?
          field ds_stdtype       as integer
          field ds_stoff         as integer
          field ds_type          as character
          field ds_allocated     AS INTEGER   INITIAL ?
          field fld_recid        as recid     initial ?
          field tmpfld_recid     as recid     initial ?
          field pro_case         as logical   initial FALSE
          field pro_dcml         as integer   initial ?
          field pro_desc         as character
          field pro_extnt        as integer   initial ?
          field pro_frmt         as character
          field pro_init         as character initial ?
          field pro_mand         as logical   initial FALSE
          field pro_name         as character
          field pro_order        as integer   initial ?
          field pro_type         as character
          field ttb_tbl          as recid
          FIELD defaultname      AS CHARACTER
          FIELD fld_size         AS INTEGER   initial ?
          index upi              is unique primary
                                    ttb_tbl pro_name
          index uidsname         is unique
                                    ttb_tbl ds_name ds_type ds_stoff
          index uifldrecid       is unique
                                    ttb_tbl fld_recid
          index uiorder          is unique
                                    ttb_tbl pro_order
          index istoff        /* is NON-unique */
                                    ttb_tbl ds_stoff.
                                    
  define {&new} shared TEMP-TABLE s_ttb_idx
          field ds_name          as character case-sensitive
          field ds_msc21         as character initial ?
                                              /*    misc2[1]    */
                                              /* ODB: "{a,u,?}" */
                                              /* ORA: "{a,u,?}" */
          field ds_idx_typ       as integer   initial 0
                                              /* 1 indicates Clustered idx */
          field hlp_dtype#       as integer   initial 0
          field hlp_fld#         as integer   initial 0
          field hlp_fstoff       as integer   initial ?
          field hlp_level        as integer   initial 9
          field hlp_mand         as logical   initial TRUE
          field hlp_msc23        as character initial ?
          field pro_actv         as logical   initial TRUE
          field pro_desc         as character
          field pro_idx#         as integer
          field pro_name         as character
          field pro_prim         as logical   initial FALSE
          field pro_uniq         as logical   initial FALSE
          field ds_uniq          as logical   initial FALSE
          field ttb_tbl          as recid
          field idx_recid        as recid
          field hlp_slctd        as logical
          field pro_uniq_bkp     as logical   initial FALSE
          field hlp_idxsize#     as integer   initial 0
          field key_wt#          as integer   initial 0
          index upi              is unique primary
                                    ttb_tbl pro_name
          index idsname       /* is NON-unique */
                                    ttb_tbl ds_name  
          index pick          /* is NON-unique */
                                    hlp_dtype# hlp_fld#  
          index pick2         /* is NON-unique */
                                    hlp_slctd hlp_level.   

  define {&new} shared TEMP-TABLE s_ttb_idf
          field pro_abbr         as logical   initial FALSE
          field pro_asc          as logical
          field pro_order        as integer
          field ttb_fld          as recid
          field ttb_idx          as recid
          index upi              is unique primary
                                    ttb_idx pro_order
          index ifld             is unique
                                    ttb_fld ttb_idx.
  /* OE00195067 BEGIN */

  DEFINE {&new} shared TEMP-TABLE s_ttb_con

          field tab_name AS CHAR
          field col_name AS CHAR
          field const_name AS CHAR
          field cons_type AS CHAR
          field expre AS CHAR
          field par_key AS CHAR
          field par_key_num AS INTEGER
          field index_num AS INTEGER
          field index_name AS CHAR
          field par_tab AS CHAR.
  
  
  /* OE00195067 END */
  DEFINE {&new} shared TEMP-TABLE s_ttb_splfld        
          field name AS CHAR.
  &ENDIF
 
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/nogatwrk.i

Description:
    
    if there is no gate-work available then there are no tables
    selectable for updating or creating a schemaholder, so we leave
            
Text-Parameters:
    &block     label of block to leave if canceled or no obj found  
    &clean-up  expression that holds db-type (external name)  
    &end       "end." if repeat for get-process started in _xxx_get.p
               "" otherwise

    
Included in:
    odb/_odb_get.p
    ora/_ora6get.p
    ora/_ora7get.p
    rdb/_rdb_get.p
    syb/syb_getp.i
    
History:
    hutegger    94/07/29    creation
    
--------------------------------------------------------------------*/        
/*h-*/

find first gate-work no-error. 

if not available gate-work
 then do:   /* there are no tables selectable */

  if SESSION:BATCH-MODE = false
   then message
        "There are no objects in the " edbtyp " database that" skip
        "satisfy the selected criteria."                       skip
        "(Remember: some data sources are case sensitive.)"    skip(1)
        "Reenter preselection criteria?"     
        view-as alert-box information buttons yes-no update l_rep-presel.
   else assign l_rep-presel = FALSE.

  if l_rep-presel = FALSE
   then do:
    assign user_path = "{&clean-up}".
    RUN adecomm/_setcurs.p ("").
    LEAVE {&block}.
    end.
  
  end.      /* there have been triggers effected */

 else assign l_rep-presel = FALSE.

  {&end}  /* for the repeat in the _get.p routines */

find first gate-work no-error. 

if not available gate-work
 then leave.

/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2005,2006,2008,2009,2010,2011 by Progress Software Corporation.*
* All rights reserved.  Prior versions of this work may contain      *
* portions contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* odb_ctl.i - Odbc schema control settings */
/*
Note 'ODBALLOWED':
  This is a list of object types that the gateway supports.  Currently,
  "VIEW" "TABLE" "SYSTEM TABLE" and "PROCEDURE" are allowed.

Note 'SOBJECTS' 'POBJECTS':
  sobjects contains a list of Odbc objects as they described in the
  SQLTables API call. pobjects is their PROGRESS name.
 
This file has been moved from odb to gate because it will be used by both
the ODBC DataServer and the MSS DataServer  DLM  6/19/00

Schema holder version number introduced  DJM  10/27/05
  
*/

DEFINE VARIABLE datetime             AS LOGICAL   NO-UNDO.
DEFINE VARIABLE odballowed           AS CHARACTER NO-UNDO.
DEFINE VARIABLE pobjects             AS CHARACTER NO-UNDO.
DEFINE VARIABLE sobjects             AS CHARACTER NO-UNDO.
/* dictionary version format changed to ###.##, (same as dataserver client / server format) */
/* default dictionary version, continues to be "2.000.0000" ONLY */
DEFINE VARIABLE odbc-dict-ver        AS CHARACTER NO-UNDO INIT "2.000.000".
/* New dictionary version is "103.00", this will be set when new features are used */
/* For 10.2B in MSSDS, if PROGRESS_RECID uses computed column then New dictionary version is set*/
/* in $RDLRH/dtcomm.h, #define DATA_SRVR_VERS105  10300 */
DEFINE VARIABLE odbc-dict-ver-new    AS CHARACTER NO-UNDO INIT "103.00".

/* Normally we would track schema holder changes with a version change to
 * Schema holder but for legacy reasons, we need to use dictionary version.
 * odbc-dict-ver should have changed to 2 in 101B but was not discovered until
 * all service pack releases. Therefore the change will be applied to 101b tfix
 * branch, 101C & 102A and above */

/**********************************************************************************************

  The value of "prgrs_clnt" input to _Db._Db-misc2[7] changes from 
    "<vers>" 
     to 
    "<vers>:sh_min=<minvers>,sh_max=<maxvers>."
      where <vers> is the Progress Client Version number
        and <minvers> is the minimum schema holder version compatible with this Progress client
        and <maxvers> is the maximum schema holder version compatible with this Progress client
        <minvers> and <maxvers> are maintained by the Progress client connected to the schema
        holder.

   Db._Db-misc2[6] changes to 
     "Dictionary Ver#: <dict-vers>" + "Client Ver#: <clnt-vers>" + "Server Ver# <srvr-vers>" +
       "Schema Holder Ver# <sch-hldr-vers>" 
      where <sch-hldr-vers> is the current version of the schema holder
      <sch-hldr-vers> is set initially to <minvers> but is maintained by the Dictionary as
        version features are added to the schema holder.

   ** NOTE: There are change requirements in _odb_get.p if these formats are further changed. **

   The schema holder version number is being introduced in Progress client
   and dictionaries in  versions 9.1E03, 10.0B04, and 10.1A.  The progress 
   client version for all these versions will be set to "101".  But the maximum
   compatible schema holder version will only be set to "2" for 10.1A and 10.0B04.
   9.1E03 will have a maximum schema holder version number of "1" meaning 
   incompatibilities with Version 2 schema holder features will exist.

   Since the Progress client and Dictionary are mutually responsible for the content 
   in the schema holder, they should apply the schema holder version in coordinated
   fashion.  The Progress Client passes the schema holder minumum version number to 
   the Dictionary through the GetInfo_buffer.  The minimum value is applied to a newly
   built schema holder unless the Dictionary has a valid reason to override or update 
   that value.  The Dictionary may upgrade the schema holder version number either 
   automatically, because of features inherent in this version of the Dictionary, or 
   conditionally, because of features associated with a newer schema holder version 
   that are enacted in this schema holder through the use of dictionary utilities.  
   NOTE:  It is possible, but unlikely, that a schema holder version number will be
   applied by the dictionary that is  greater than the schema holder version range 
   declared by the client to be supported.  Since the client and dictionary are shipped 
   together, it is not likely that a version of the Dictionary that is incompatible with 
   the current version of the client will be used to maintain the schema holder.
   But the dictionary should test for this possibility just in case the utilities 
   used to build or upgrade a schema holder happen to be incompatible with the current
   client version that uses it.

   Ultimately, the schema holder version number should reflect the level of features 
   implemented in the schema holder through the dictionary and/or Progress client.

   With these changes, Progress clients that are incompatible with new dictionary features,
   or old dictionaries that are incompatible with newer clients can be identified and 
   conveyed to customer.

   Schema Holder Version Change Log:
    --------------------------------
    1 - Is the baseline for everything before OpenEdge Version 10.1A, 10.0B04
        and 9.1E03.
    2 - Introduces an "_" suffix identifier, instead of "#" for array field suffixes
         used against a DB2 database.  The presence of these entries are determined 
         by the dictionary which will conditionally and automatically upgrade the 
         version number in the schema holder's _Db record.

    # - Introduces .... 
    # - Introduces .... 
*/

&GLOBAL-DEFINE ODBC_SCH_VER1 1
&GLOBAL-DEFINE ODBC_SCH_VER2 2

/* List of certified drivers. Warning is issued for non certified drivers. */
DEFINE VARIABLE odbc-certify-list AS CHARACTER NO-UNDO.
/*
 Each odbc-bug-list[N] variable includes a list of ODBC drivers which have 
 the bug. "ALL" suggests that all the drivers has the bug. Each            
 odbc-bug-excld[N] variable include a list of ODBC drivers which DON'T have
 the bug (useful if you want to exclude specific drivers where ALL was     
 specified.                                                                 

 BUG-1 is the inability to use Search Patterns in a Catalog function  
       for qualifiers.                                                
 BUG-2 is an occasional corrupt of prepared statements at the end of  
       a transaction.                                                 
 BUG-3 is the inconsistency of the sort order of NULL values.         
 BUG-4 is the description of all the components of an index in one row
       concatenating the fields: "fld1+fld2+fld3..."                  
 BUG-5 the support of only one statement per connection.                
 BUG-6 Multiple connection can block each other.                        
 BUG-7 Quoting an identifier does not work.                                
 BUG-8 is the inability to use Search Patterns in a Catalog function  
       for owners.                                                            
 BUG-9 is wrong type values returned from SQLColumnAttributes. To work
       around it, we skip runtime schema comparison.                       
 BUG-10 is not being able to handle WHERE 1 = 2 clauses.              
 BUG-11 NULL is sorted to be the lowest value. Turn BUG-3 off !!        
 BUG-12 Do SELECT <key> not SELECT <flds> - More compatible but slow. 
 BUG-13 Lock/transaction mode 1 support by driver:                          
            Exclusive-lock & Lock Upgrade.                               
              No shared-lock support,                                        
              One connection.                                                
              async mode.                                                
              only scrolling cursors.                                        
          Lock/transaction mode 0 by driver, which is the default:        
              No lock control.                                               
              Use the dbmgr isolation level for concurrency control.        
              By default - One connection only.                               
              no async mode.                                               
              might use non scrolling cursors.                               
 BUG-14 Does not follow the ODBC protocol for the LIKE where clause   
        operator. Wants the type of the value to match the type of    
           the field instead of being specified as SQL_VARCHAR.                
 BUG-15 The db has a "timestamp" field which get updated with each row
           update.                                                        
 BUG-16 We use SQLColumns, at runtime, to get schema info, instead of 
          SQLColumnsAttributes - to prevent waiting on a lock.                
        To avoid a full table scan by not issuing SQL statement        
        "select * from table where 1=2" for Access2 driver             
        ODBCJT16.DLL per bug #95-09-01-043.                           
 BUG-17 UPPER function for the WHERE clause is not supported.                
 BUG-18 This driver needs the hint system.                                
 BUG-19 This driver gives the wrong index uniqueness info.                
 BUG-20 This bug used to only apply to the Informix driver.  It has   
        been revamped to be switched on for all drivers in which the  
        record lock wait state needs to be modified from its          
        data source default.  If the driver doesn't do it, we must.   
 BUG-21 The driver cannot handle FLD LIKE ? phrase. We put                
           FLD LIKE <literal> instead.                                        
 BUG-22 Driver sends wrong data about indexes - don't build indexes   
          automatically.                                                
 BUG-23 The driver has some problems in qualifying object in SQLTab().
        We will qualify, on the client side, the objects for schema   
          import.                                                        
 BUG-24 The driver has some problems with wild cards in SQLTables().  
        We will qualify, on the client side, the objects for schema   
          import if wild cards are used. Note that BUG-23 implies       
          BUG-24.                                                        
 BUG-25 The driver supports WHERE char_fld = <value> even if <value>  
          is longer then what char_fld can hold. We would allow that    
          expression for those drivers.                                        
 BUG-26 The driver has problems with re-using prepared statements -   
        we don't reuse them.                                                
 BUG-27 The driver has problems with join by sql db - do it by client.
 BUG-28 Don't create OWNER.TABLE names, since "OWNER." is added by    
        the Driver.                                                   
 BUG-29 The driver has proprietary ODBC extensions for BLOB/CLOB      
            support. Specifically, the driver uses -98/-99 for these      
        large objects. Progress will translate these to LongVarBinary 
        datatype.                                                     
 BUG-30 The driver supports setting transaction isolation level on        
            a statement basis. I.e., PODBC can change it within a         
            transaction, not just before a transaction begins. Note that  
        per-statement isolation is NOT ODBC V2.0 conformant, but is        
            very useful for Progress.                                                         
 BUG-31 The driver supports the use of % and _ in LIKE string by      
        using brackets around the characters.  Driver doesn't support 
        the escape clause.                                            
 BUG-32 Driver does not support the ESCAPE clause.  There is no known 
        mechanism to use % and _ characters in the LIKE string.          
 BUG-33 Driver does NOT support ASYNC as PODBC prefers, so PODBC will 
        not issue ASYNC_ENABLE  call to driver. Crucial rule that        
        driver must follow is to support polling for call completion        
        by call with truncated parameter list (see dtserror.c).           
        Thus, if this flag on, PODBC will NOT request driver to do    
        ASYNC at Connect time. If flag off, PODBC will request ASYNC. 
 BUG-34 Driver expects databases of the format dbname:owner.table     
        as opposed to dbamae.owner.table.  If the flag is on, then    
          change the format of the full table name to use a :, not dot.      
 BUG-35 This switch indicates that dynamic cursors need to be added   
        to enable the use of server-side cursors in MSSQL.  This      
        indirectly removes the restriction that a cursor be closed    
        before another statement can be executed.                     
 BUG-36 This switch indicates that firehose cursors need to be   
        enabled for MSSQL.
 BUG-37 This switch indicates that transactions need to be disabled
        for tdriver tests.
 BUG-38 SQLColumns returns Type-name as "text" for varchar(max) and
        "image" for varbinary(max).
 
 Modified by    : Anders Luk 2/7/96 Adding new 32-bit drivers for certification                
                        Informix5 - Intersolv IVINF508.DLL                
                        Dbase 5.5 - Intersolv IVDBF08.DLL                
                        Access 7.0 - MS ODBCJT32.DLL                        
                       Paradox 7.0 - MS ODBCJT32.DLL ?   
                                            
                  SLK 2/20/97 Fix s/e 135 More than 4096 chars in single statement  
                                                                      
                  DJM 10/26/99 Resolve problem with Microsoft driver cursor limitations  
                  
                  DJM 11/19/99 Added Intersolv 3.5 and Progress-branded drivers to the list for 
                               Informix, MSSQL, and Oracle.  
                       Informix7 - Intersolv IVINF14.DLL,P1INF14.DLL  
                       Oracle7&8 - Intersolv IVOR714.DLL,IVOR814.DLL  
                       SQL Srvr - Intersolv IVMSSS14.DLL,P1MSSS14.DLL IVMSSS15.DLL              
                       
                  DLM 06/19/00 Moved from prodict/odb to prodict/gate   
                  
                  DLM 10/25/00 Removed bug flag 7 from MSS              
                  
                  Savitha Rajiv 01/31/2001  Added Merant 3.7and Progress-branded drivers 
                                           to the list for Informix, MSSQL, and DB2.  					
                       Informix7 - Merant IVINF16, P1INF16.DLL, IVINF18.DLL, P1INF18.DLL  	
                       DB2 - Merant IVUDB16.DLL, P1UDB16.DLL,		
			 	                    P1DB216.DLL, IVDB216.DLL  		
                       SQL Srvr - Merant  IVMSSS16.DLL,P1MSSS16.DLL   
                                  IVSS616.DLL, P1SS616.DLL	     
                                  
                 DLM 09/08/03 Added Data Direct 4.2 drivers 10.0A
                 DCS 04/08/04 Added BUG-36 for firehose cursors
                 DCS 04/26/04 Added BUG-37 for FFO cursor testing
                 rkumar 08/28/07 Added DataDirect 5.3 drivers 10.1C
		 rkumar 06/26/08 Added DataDirect 5.3 64-bit drivers for 10.2A release
		 rkumar 03/20/09 Added DataDirect 6.0 32-bit and 64-bit drivers 
				 for 10.2B release
                 musingh 08/09/11 Added ODBC Wire Protocol driver for DB2 in BUG-33
				 
                 Mahesh Anem 30/09/2011 Removing the Data Direct 6.0 DLL entries from the list of Bug[26].
                 musingh 03/30/11 Added BUG-38 for SQLColumns
                 musingh 01/29/13 Added SNAC11 driver (SQLNCLI11.DLL).
*/ 
DEFINE VARIABLE odbc-bug-list AS CHARACTER EXTENT 80 NO-UNDO.
DEFINE VARIABLE odbc-bug-excld AS CHARACTER EXTENT 80 NO-UNDO.

ASSIGN
odbc-certify-list = "PROGODBC.DLL,ODBCJT16.DLL,SIMBA.DLL,DB2CLIW.DLL,"
        + "PODBC_Sybase_Driver,PODBC_Allbase_Driver,PODBC_DB2_Driver,"
        + "QEINF04.DLL,QEINF05.DLL,QEINF06.DLL,QEPDX04.DLL,QEPDX05.DLL,"
        + "QEPDX06.DLL,QEPDX07.DLL,QEDBF03.DLL,QEDBF04.DLL,QEDBF05.DLL,"
        + "QEDBF06.DLL,QEDBF07.DLL,QEINF503.DLL,QEINF504.DLL,"
        + "QEINF505.DLL,QEINF506.DLL,QEINF507.DLL,PODBC_M/S_SQL_Server_Driver"
odbc-bug-list[1] = "ODBCJT32.DLL,ODBCJT16.DLL,SIMBA.DLL,QEDBF,QEPDX,QEGUP,IVDBF"
odbc-bug-list[2] = "SIMBA.DLL,QEDBF,QEPDX,IVDBF"
odbc-bug-list[3] = "ALL"
odbc-bug-list[4] = "QEDBF,QEPDX,IVDBF"
odbc-bug-list[5] = "PODBCSYB,PODBC_Sybase_Driver,PODBC_M/S_SQL_Server_Driver"
odbc-bug-list[6] = "PODBC_Sybase_Driver,PODBC_M/S_SQL_Server_Driver" 
odbc-bug-list[7] = "QEGUP,DB2CLIW.DLL,PODBC_M/S_SQL_Server_Driver,"
                    + "DB2CLI.DLL,IVOR709.DLL,IVOR714.DLL,IVOR814.DLL,IVDB214.DLL,P1DB214.DLL,"
                    + "IVUDB16.DLL,P1UDB16.DLL,P1DB218.DLL,IVDB218.DLL,P1DB219.DLL,IVDB219.DLL,"
                    + "P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL,"
                    + "P1DB223.DLL,IVDB223.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,CWBODBC.DLL,"
		    + "P1DB224.DLL,IVDB224.DLL,P2DB224.DLL,DDDB224.DLL,"
                    + "PGDB226.DLL,IVDB226.DLL,PGDB226.DLL,DDDB226.DLL,"
		    + "P1DB227.DLL,IVDB227.DLL,P2DB227.DLL,DDDB227.DLL"
odbc-bug-list[8] = "SIMBA.DLL,QEDBF,QEPDX,IVDBF"
odbc-bug-list[9] = "QEGUP"
odbc-bug-list[10] = "PODBC_Sybase_Driver,QEINF,QEINF5,PODBC_Allbase_Driver,"
                    + "PODBC_M/S_SQL_Server_Driver,IVINF508.DLL,IVINF709.DLL,IVINF16.DLL,"
                    + "P1INF16.DLL,IVINF14.DLL,P1INF14.DLL,P1IFCL18.DLL,IVIFCL18.DLL,"
                    + "IVINF18.DLL,P1INF18.DLL,P1IFCL19.DLL,IVIFCL19.DLL,IVINF19.DLL,P1INF19.DLL"
odbc-bug-list[11] = "PODBC_Sybase_Driver,QEINF,QEINF5,IVINF508.DLL,IVINF709.DLL,"
                    + "IVINF16.DLL,P1INF16.DLL,IVINF14.DLL,P1INF14.DLL,P1IFCL18.DLL,"
                    + "IVIFCL18.DLL,ODBC_M/S_SQL_Server_Driver,IVINF18.DLL,P1INF18.DLL,"
                    + "P1IFCL19.DLL,IVIFCL19.DLL,IVINF19.DLL,P1INF19.DLL,"
                    + "IVMSSS23.DLL,P1MSSS23.DLL,DDMSSS23.DLL,P2MSSS23.DLL," 
                    + "SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,"
		    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL"
odbc-bug-list[12] = "PODBC_Sybase_Driver,PODBC_M/S_SQL_Server_Driver"
odbc-bug-list[13] = "PODBC_Sybase_Driver,PODBC_Allbase_Driver,DB2CLIW.DLL,"
                    + "PODBC_DB2_Driver,PODBC_M/S_SQL_Server_Driver,SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,"
                    + "IVUDB16.DLL,P1UDB16.DLL,IVMSSS16.DLL,IVSS616.DLL,P1MSSS16.DLL,IVMSSS16.DLL,"
                    + "DB2CLI.DLL,IVOR709.DLL,IVINF16.DLL,P1IFCL18.DLL,IVIFCL18.DLL,"
                    + "IVDB214.DLL,P1DB214.DLL,IVSS614.DLL,P1SS614.DLL,P1DB218.DLL,IVDB218.DLL,"
                    + "P1SS616.DLL,P1INF16.DLL,IVINF14.DLL,P1INF14.DLL,IVMSSS14.DLL,P1MSSS14.DLL,"
                    + "P1MSSS18.DLL,IVMSSS18.DLL,P1SS618.DLL,IVSS618.DLL,IVINF18.DLL,P1INF18.DLL,"
                    + "IVINF19.DLL,P1INF19.DLL,P1MSSS19.DLL,IVMSSS19.DLL,P1SS619.DLL,IVSS619.DLL,P1MSSS21.DLL,IVMSSS21.DLL,"
                    + "P1IFCL19.DLL,IVIFCL19.DLL,P1DB219.DLL,IVDB219.DLL,P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL," 
                    + "P1DB223.DLL,IVDB223.DLL,P1MSSS23.DLL,IVMSSS23.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,P2MSSS23.DLL,DDMSSS23.DLL,CWBODBC.DLL,"
		    + "P1DB224.DLL,IVDB224.DLL,P2DB224.DLL,DDDB224.DLL,"
		    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "PGDB226.DLL,IVDB226.DLL,PGDB226.DLL,DDDB226.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL,"
		    + "P1DB227.DLL,IVDB227.DLL,P2DB227.DLL,DDDB227.DLL"
odbc-bug-list[14] = "PODBC_DB2_Driver,DB2CLIW.DLL,SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,IVMSSS16.DLL,IVSS616.DLL,"
                    + "P1MSSS16.DLL,P1SS616.DLL,DB2CLI.DLL,IVOR709.DLL,IVOR714.DLL,IVOR814.DLL,"
                    + "IVUDB16.DLL,P1UDB16.DLL,IVMSSS14.DLL,ODBCJT32.DLL,P1DB218.DLL,IVDB218.DLL,"
                    + "P1MSSS14.DLL,IVDB214.DLL,P1DB214.DLL,IVSS614.DLL,P1SS614.DLL,P1SS618.DLL,"
                    + "IVSS618.DLL,P1MSSS18.DLL,IVMSSS18.DLL,P1DB219.DLL,IVDB219.DLL,P1SS619.DLL,"
                    + "IVSS619.DLL,P1MSSS19.DLL,IVMSSS19.DLL,P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL,P1MSSS21.DLL,IVMSSS21.DLL,"
                    + "P1DB223.DLL,IVDB223.DLL,P1MSSS23.DLL,IVMSSS23.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,P2MSSS23.DLL,DDMSSS23.DLL,CWBODBC.DLL,"
		    + "P1DB224.DLL,IVDB224.DLL,P2DB224.DLL,DDDB224.DLL,"
                    + "PGDB226.DLL,IVDB226.DLL,PGDB226.DLL,DDDB226.DLL,"
		    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL,"
		    + "P1DB227.DLL,IVDB227.DLL,P2DB227.DLL,DDDB227.DLL"
odbc-bug-list[15] = "PODBC_Sybase_Driver,PODBC_M/S_SQL_Server_Driver"
odbc-bug-list[16] = "PODBC_Sybase_Driver,ODBCJT16.DLL,ODBCJT32.DLL,IVUDB16.DLL,P1UDB16.DLL,"
                    + "P1DB218.DLL,IVDB218.DLL,P1DB219.DLL,IVDB219.DLL,P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL,"
                    + "P1DB223.DLL,IVDB223.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,CWBODBC.DLL,"
		    + "P1DB224.DLL,IVDB224.DLL,P2DB224.DLL,DDDB224.DLL,"
                    + "PGDB226.DLL,IVDB226.DLL,PGDB226.DLL,DDDB226.DLL,"
		    + "P1DB227.DLL,IVDB227.DLL,P2DB227.DLL,DDDB227.DLL"
odbc-bug-list[17] = "PODBC_Allbase_Driver,QEINF,QEINF5,IVINF508.DLL,"
                    + "IVINF709.DLL,IVINF16.DLL,P1INF16.DLL,IVINF14.DLL,P1INF14.DLL,"
                    + "IVUDB16.DLL,P1UDB16.DLL,IVDB214.DLL,P1DB214.DLL,ODBCJT32.DLL,"
                    + "IVSS614.DLL,"
                    + "P1SS614.DLL,IVSS616.DLL,P1SS616.DLL,DB2CLI.DLL,"
                    + "P1IFCL18.DLL,IVIFCL18.DLL,P1DB218.DLL,IVDB218.DLL,"
                    + "P1SS618.DLL,IVSS618.DLL,IVINF18.DLL,P1INF18.DLL,"
                    + "P1IFCL19.DLL,IVIFCL19.DLL,P1DB219.DLL,IVDB219.DLL,"
                    + "P1SS619.DLL,IVSS619.DLL,IVINF19.DLL,P1INF19.DLL,"
                    + "P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL,"
                    + "P1DB223.DLL,IVDB223.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,CWBODBC.DLL,"
		    + "P1DB224.DLL,IVDB224.DLL,P2DB224.DLL,DDDB224.DLL,"
                    + "PGDB226.DLL,IVDB226.DLL,PGDB226.DLL,DDDB226.DLL,"
                    + "P1DB227.DLL,IVDB227.DLL,P2DB227.DLL,DDDB227.DLL,"
		    + "P1SQLS25.DLL,DDSQLS25.DLL,DDMSSS25.DLL,"
                    + "DDMSSS26.DLL,"
                    + "DDMSSS27.DLL"
odbc-bug-list[18] = "PODBC_Allbase_Driver"
odbc-bug-list[19] = "".

ASSIGN
odbc-bug-list[20] = "QEINF,QEINF5,IVINF508.DLL,IVINF709.DLL,IVINF16.DLL,P1SS616.DLL,"
                    + "P1INF16.DLL,SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,IVMSSS16.DLL,IVSS616.DLL,P1MSSS16.DLL,"
                    + "IVINF14.DLL,P1INF14.DLL,IVMSSS14.DLL,P1MSSS14.DLL,IVSS614.DLL,P1SS614.DLL," 
                    + "P1IFCL18.DLL,IVIFCL18.DLL,P1MSSS18.DLL,IVMSSS18.DLL,P1SS618.DLL,IVSS618.DLL,"
                    + "IVINF18.DLL,P1INF18.DLL,P1IFCL19.DLL,IVIFCL19.DLL,P1MSSS19.DLL,IVMSSS19.DLL,P1MSSS21.DLL,IVMSSS21.DLL,"
                    + "P1SS619.DLL,IVSS619.DLL,IVINF19.DLL,P1INF19.DLL,"
                    + "P1MSSS23.DLL,IVMSSS23.DLL,"
		    + "P2MSSS23.DLL,DDMSSS23.DLL,"
		    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL"
odbc-bug-list[21] = ""
odbc-bug-list[22] = ""
odbc-bug-list[23] = "ALL"
odbc-bug-list[24] = ""
odbc-bug-list[25] = "PODBC_Sybase_Driver,PODBC_M/S_SQL_Server_Driver"
odbc-bug-list[26] = "QEINF,QEINF5,ODBCJT16.DLL,ODBCJT32.DLL,DB2CLIW.DLL,"
                    + "IVINF508.DLL,IVINF709.DLL,IVINF16.DLL,P1INF16.DLL,DB2CLI.DLL,"
                    + "IVUDB16.DLL,P1UDB16.DLL,P1IFCL18.DLL,IVIFCL18.DLL,P1DB218.DLL,"
                    + "IVINF14.DLL,P1INF14.DLL,IVDB214.DLL,P1DB214.DLL,IVDB218.DLL,"
                    + "IVINF18.DLL,P1INF18.DLL,P1IFCL19.DLL,IVIFCL19.DLL,P1DB219.DLL,"
                    + "IVDB219.DLL,IVINF19.DLL,P1INF19.DLL,P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL,"
                    + "P1DB223.DLL,IVDB223.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,CWBODBC.DLL"
odbc-bug-list[27] = "ODBCJT16.DLL,ODBCJT32.DLL"
odbc-bug-list[28] = ""
odbc-bug-list[29] = "DB2CLIW.DLL,DB2CLI.DLL,IVUDB16.DLL,P1UDB16.DLL,P1DB218.DLL,IVDB218.DLL,"
                    + "IVDB214.DLL,P1DB214.DLL,P1DB219.DLL,IVDB219.DLL,P1DB220.DLL,IVDB220.DLL,P1DB221.DLL,IVDB221.DLL,"
                    + "P1DB223.DLL,IVDB223.DLL,"
		    + "P2DB223.DLL,DDDB223.DLL,CWBODBC.DLL,"
		    + "P1DB224.DLL,IVDB224.DLL,P2DB224.DLL,DDDB224.DLL,"
                    + "PGDB226.DLL,IVDB226.DLL,PGDB226.DLL,DDDB226.DLL,"
                    + "P1DB227.DLL,IVDB227.DLL,P2DB227.DLL,DDDB227.DLL,"
odbc-bug-list[30] = "PODBC_M/S_SQL_Server_Driver,PODBC_Sybase_Driver"
odbc-bug-list[31] = "PODBC_M/S_SQL_Server_Driver"
odbc-bug-list[32] = "ODBCJT16.DLL,ODBCJT32.DLL,IVDBF08.DLL"
odbc-bug-list[33] = "SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,IVMSSS16.DLL,IVMSSS15.DLL,P1MSSS16.DLL,DB2CLIW.DLL,"
                    + "DB2CLI.DLL,IVOR709.DLL,IVOR714.DLL,IVOR814.DLL,IVMSSS14.DLL,"
                    + "P1MSSS14.DLL,IVSS616.DLL,P1SS616.DLL,IVSS614.DLL,P1SS614.DLL,"
                    + "IVDB214.DLL,P1DB214.DLL,IVUDB16.DLL,P1UDB16.DLL,IVASE16.DLL,P1ASE16.DLL,"
                    + "P1DB218.DLL,IVDB218.DLL,P1MSSS18.DLL,IVMSSS18.DLL,P1SS618.DLL,IVSS618.DLL,"
                    + "P1DB219.DLL,IVDB219.DLL,P1MSSS19.DLL,IVMSSS19.DLL,P1SS619.DLL,IVSS619.DLL,"
                    + "P1ASE18.DLL,IVASE18.DLL,P1ASE19.DLL,IVASE19.DLL,P1MSSS21.DLL,IVMSSS21.DLL,P1ASE21.DLL,IVASE21.DLL," 
                    + "P1DB223.DLL,P1ASE23.DLL,IVASE23.DLL,P1MSSS23.DLL,IVMSSS23.DLL,"
		    + "P2DB223.DLL,P2ASE23.DLL,DDASE23.DLL,P2MSSS23.DLL,DDMSSS23.DLL,"
		    + "P1DB224.DLL,P1ASE24.DLL,IVASE24.DLL,P2ASE24.DLL,DDASE24.DLL,"
                    + "PGDB226.DLL,PGASE26.DLL,IVASE26.DLL,PGASE26.DLL,DDASE26.DLL,"
		    + "P2DB224.DLL,P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "PGDB226.DLL,P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL,"
		    + "P1DB227.DLL,P2DB227.DLL,P1ASE27.DLL,IVASE27.DLL,P2ASE27.DLL,DDASE27.DLL,"

odbc-bug-list[34] = "IVINF508.DLL,IVINF709.DLL,IVINF16.DLL,P1INF16.DLL,"
                    + "IVINF14.DLL,P1INF14.DLL,P1IFCL18.DLL,IVIFCL18.DLL,IVINF18.DLL,P1INF18.DLL," 
                    + "P1IFCL19.DLL,IVIFCL19.DLL,IVINF19.DLL,P1INF19.DLL"
odbc-bug-list[35] = "SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,IVMSSS16.DLL,IVSS616.DLL,P1SS616.DLL,P1MSSS16.DLL,P1MSSS18.DLL,"
                    + "IVMSSS14.DLL,P1MSSS14.DLL,IVSS614.DLL,P1SS614.DLL,IVMSSS18.DLL,P1SS618.DLL,"
                    + "IVSS618.DLL,P1MSSS19.DLL,IVMSSS19.DLL,P1SS619.DLL,IVSS619.DLL,P1MSSS21.DLL,IVMSSS21.DLL,"
                    + "P1MSSS23.DLL,IVMSSS23.DLL,"
		    + "P2MSSS23.DLL,DDMSSS23.DLL,"
		    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL"
odbc-bug-list[36] = "SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL,IVMSSS16.DLL,IVSS616.DLL,P1SS616.DLL,P1MSSS16.DLL,P1MSSS18.DLL,"
                    + "IVMSSS14.DLL,P1MSSS14.DLL,IVSS614.DLL,P1SS614.DLL,IVMSSS18.DLL,P1SS618.DLL,"
                    + "IVSS618.DLL,P1MSSS19.DLL,IVMSSS19.DLL,P1SS619.DLL,IVSS619.DLL,P1MSSS21.DLL,IVMSSS21.DLL,"
                    + "P1MSSS23.DLL,IVMSSS23.DLL,"
		    + "P2MSSS23.DLL,DDMSSS23.DLL,"
		    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL"
odbc-bug-list[37] = ""
odbc-bug-list[38] = "SQLSRV32.DLL,P1MSSS23.DLL,P2MSSS23.DLL,IVMSSS23.DLL,DDMSSS23.DLL,"
                    + "P1MSSS24.DLL,P2MSSS24.DLL,IVMSSS24.DLL,DDMSSS24.DLL,"
                    + "P1MSSS25.DLL,P2MSSS25.DLL,IVMSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL".

ASSIGN
odbc-bug-excld[1] = "" 
odbc-bug-excld[2] = "" 
odbc-bug-excld[3] = "PODBC_Sybase_Driver,QEINF,QEINF5,PODBC_DB2_Driver,"
                    + "DB2CLIW.DLL,PODBC_M/S_SQL_Server_Driver,IVINF508.DLL,"
                    + "IVINF709.DLL,IVUDB16.DLL,P1UDB16.DLL,"
                    + "DB2CLI.DLL,IVDB214.DLL,P1DB214.DLL," 
                    + "IVMSSS23.DLL,P1MSSS23.DLL,DDMSSS23.DLL,P2MSSS23.DLL," 
                    + "SQLSRV32.DLL,SQLNCLI.DLL,SQLNCLI10.DLL,SQLNCLI11.DLL," 
                    + "P1MSSS24.DLL,IVMSSS24.DLL,P2MSSS24.DLL,DDMSSS24.DLL,"
                    + "P1SQLS25.DLL,IVSQLS25.DLL,P1MSSS25.DLL,IVMSSS25.DLL,P2SQLS25.DLL,DDSQLS25.DLL,P2MSSS25.DLL,DDMSSS25.DLL,"
                    + "PGMSSS26.DLL,IVMSSS26.DLL,PGMSSS26.DLL,DDMSSS26.DLL,"
                    + "P1MSSS27.DLL,IVMSSS27.DLL,P2MSSS27.DLL,DDMSSS27.DLL"
odbc-bug-excld[4] = "" 
odbc-bug-excld[5] = "" 
odbc-bug-excld[6] = "" 
odbc-bug-excld[7] = ""
odbc-bug-excld[8] = ""
odbc-bug-excld[9] = ""
odbc-bug-excld[10] = ""
odbc-bug-excld[11] = ""
odbc-bug-excld[12] = ""
odbc-bug-excld[13] = ""
odbc-bug-excld[14] = ""
odbc-bug-excld[15] = ""
odbc-bug-excld[16] = ""
odbc-bug-excld[17] = ""
odbc-bug-excld[18] = ""
odbc-bug-excld[19] = ""
odbc-bug-excld[20] = ""
odbc-bug-excld[21] = ""
odbc-bug-excld[22] = ""
odbc-bug-excld[23] = "PODBC_Sybase_Driver,PODBC_DB2_Driver,"
                     + "PODBC_M/S_SQL_Server_Driver"
odbc-bug-excld[24] = ""
odbc-bug-excld[25] = ""
odbc-bug-excld[26] = ""
odbc-bug-excld[27] = ""
odbc-bug-excld[28] = ""
odbc-bug-excld[29] = ""
odbc-bug-excld[30] = ""
odbc-bug-excld[31] = ""
odbc-bug-excld[32] = ""
odbc-bug-excld[33] = ""
odbc-bug-excld[34] = ""
odbc-bug-excld[35] = ""
odbc-bug-excld[36] = "".
odbc-bug-excld[37] = "".

ASSIGN
pobjects = "TABLE,STABLE,VIEW,LOG,PROCEDURE,RULE,DEFAULT,TRIGGER,BUFFER,ALIAS,SYNONYM,SEQUENCE"
sobjects = "TABLE,SYSTEM TABLE,VIEW,LOG,PROCEDURE,RULE,DEFAULT,TRIGGER,BUFFER,ALIAS,SYNONYM,SEQUENCE"
odballowed = "TABLE,SYSTEM TABLE,VIEW,ALIAS,SYNONYM,PROCEDURE,BUFFER,SEQUENCE".
/***********************************************************************
* Copyright (C) 2007-2011 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
************************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/presel.i

Description:
    
    extracts initial-values for name,owner, type and qualifier out of
    user_env[25], and, if user_env[25] not begins with "AUTO", calls 
    the dialog-box-program for the preselection-criterias.
            
Text-Parameters:
    &block     label of block to leave if canceled or no obj found  
    &frame     name of preselection-frame ("frm_ntoq" or "frm_nto")

    
Included in:
    odb/_odb_get.p
    ora/_ora_lk1.p
    ora/ora_get.i
    syb/syb_getp.i
    
History:
    hutegger    94/07/29    creation
    mcmann      05/21/2002  Added new input-output parameter
    knavneet    08/12/2007  if as400, s_owner is not assigned to *
    fernando    02/25/2008  Added new input-output parameter for datetime
    knavneet    04/28/2009  BLOB support for MSS (OE00178319)
--------------------------------------------------------------------*/        
/*h-*/

if NUM-ENTRIES(user_env[25]) = 5
 then assign
  s_name  = ENTRY(2,user_env[25])
  s_owner = ENTRY(3,user_env[25])
  s_type  = ENTRY(4,user_env[25])
  s_qual  = ENTRY(5,user_env[25]).
 else if NUM-ENTRIES(user_env[25]) = 12
 then assign
  s_name  = ENTRY(2,user_env[25])
  s_owner = ENTRY(3,user_env[25])
  s_type  = ENTRY(4,user_env[25])
  s_qual  = ENTRY(5,user_env[25]). 
 else if user_dbtype <> "ORACLE" 
 then assign /* oracle-routine inits these values by itself */
  s_name  = "*"
  s_owner = (IF "{&frame}" = "frm_as400" THEN s_owner ELSE "*")
  s_type  = "*"
  s_qual  = "*".

assign
  s_vrfy  = (user_env[25] begins "COMPARE"
          or user_env[25] begins "auto-compare").

if NOT user_env[25] begins "AUTO"
 then do:  /* allow user to update preselection-criterias */
   
  RUN prodict/user/_usr_gsl.p
    ( INPUT-OUTPUT s_name,
      INPUT-OUTPUT s_owner,
      INPUT-OUTPUT s_qual,
      INPUT-OUTPUT s_type,
      INPUT-OUTPUT s_vrfy,
      INPUT-OUTPUT s_outf,
      INPUT-OUTPUT s_datetime,
      INPUT-OUTPUT s_lob,
      INPUT-OUTPUT s_clobtype,
      INPUT-OUTPUT s_blobtype,
      INPUT-OUTPUT s_primary,
      INPUT-OUTPUT s_best,
      INPUT-OUTPUT s_recidcompat,
      INPUT-OUTPUT s_wildcard,
      INPUT        "{&frame}",
      INPUT        {&link},
      INPUT        {&master}
      
    ).

  assign user_env[37] = "IP". /* This is an independent Pull */
  IF RETURN-VALUE = "cancel"
   then do:
    &IF "{&block}" <> ""
     &THEN
      assign l_rep-presel = FALSE.
     &ENDIF
    assign user_path = "".
    LEAVE {&block}.
    end.

  end.     /* allow user to update preselection-citerias */


/*------------------------------------------------------------------*/        
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/sndsqui.i

Description:
    UI-wrapper to  _snd_sql.i to allow users to send an sql-file to 
    a foreign db
    

Textual-Parameters:
    &edb-type   { ORACLE | **ODBC** | SYBASE-10 | MS SQL Server }
    
History:
    96/07   kkelley     Changed field labels and added title
    95/08   hutegger    created

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define variable l_cmmnt-chr     as character format "xxxxx" init ?.
define variable l_db-name       as character format "x(32)".
define variable l_db-type       as character format "x(20)".
define variable l_debug         as logical   format "on/off".
define variable l_eosttmnt      as character format "xxxx".
define variable l_owner         as character format "x(32)".
define variable l_sql-file      as character format "x(32)".

&SCOPED-DEFINE DATASERVER YES
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER
{ prodict/odb/odbvar.i NEW }

                /*## UI-Part ##*/
form
  l_db-name     colon 20 label "DB Name"
    help "Logical name of Schema Image"
        &if "{&edb-type}" = "ORACLE"
            &then
  l_owner       colon 20 label "Owner" 
    help "Owner name to verify object can safely be dropped"
            &endif
  l_sql-file    colon 20 label "SQL File"
    help "Name and relative path of file containing SQL"
  l_cmmnt-chr   colon 20 label "Comment Chars"
    help "Character string put at beginning of comment-line"
        &if "{&edb-type}" = " "
            &then
  l_db-type     colon 18 label "DB Type"
    view-as radio-set horizontal radio-buttons 
    "MS SQL Server","MS SQL Server","ORACLE","ORACLE","SYBASE-10","SYBASE-10"
/*
        &elseif "{&edb-type}" = "**ODBC**"
            &then
  l_db-type     colon 18 label "DB Type"
    view-as radio-set horizontal radio-buttons 
    "MS SQL Server","MS SQL Server","SYBASE-10","SYBASE-10"
*/
            &endif
  l_debug       colon 20 label "Debugging Mode"  /* on/off */
    help "Off: only errors  On: errors plus debugging-messages"
  with side-labels centered row 5 title "Send DDL"
  frame frm_snd_sql.
                /*## UI-Part ##*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*------------------------  INITIALIZATIONS  -----------------------*/

assign
  l_db-name  = ldbname("DICTDBG")
  l_sql-file = ""
        &if "{&edb-type}" = "**ODBC**"
            &then
  l_db-type  = entry(lookup(user_env[22],"mss,s10")
                    ,"MS SQL Server,SYBASE-10")
            &else
  l_db-type  = "{&edb-type}"
            &endif
  l_owner    = ""
  l_debug    = FALSE.

/*---------------------------  MAIN-CODE  --------------------------*/

/*--------------------------------------------------------------------*/

                /*## UI-Part ##*/
update 
  l_db-name
        &if "{&edb-type}" = "ORACLE"
            &then
  l_owner
            &endif
  l_sql-file
  l_cmmnt-chr
        &if "{&edb-type}" = " "
            &then
  l_db-type
            &endif
  l_debug
  with frame frm_snd_sql.
                /*## UI-Part ##*/

case l_db-type:
  when "MS SQL Server" then assign
                             l_eosttmnt = "go"
                             l_db-type  = "mssqlsrv".
  when "ORACLE"        then assign
                             l_eosttmnt = ";".
  when "SYBASE-10"     then assign
                             l_eosttmnt = "go"
                             l_db-type  = "SYB10".
  end case.


if LDBNAME("DICTDBG") <> l_db-name
 then do:
  create alias DICTDBG for database value(l_db-name) no-error.
  end.

if LDBNAME("DICTDBG") = ? then leave.

if LDBNAME("DICTDB") = ?
 then do:
  create alias DICTDB for database value(SDBNAME("DICTDBG")) no-error.
  end.

if LDBNAME("DICTDB") = ? then leave.

run prodict/gate/_snd_sql.p 
  ( INPUT l_cmmnt-chr,
    INPUT l_debug,
    INPUT l_db-name,
    INPUT l_db-type,
    INPUT l_eosttmnt,
    INPUT l_owner,
    INPUT l_sql-file
  ).

/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/ttygget.i

Description:
    
    User-Interface for _xxx_get.p-programs
    
    Displays all gate-work-records and lets user select and deselect
            
Text-Parameters:
    &autocond   condition for NOT automatically select gate-work
    &db-type    internal db-type variable ("oracle", edbtyp, ...)
    &gq         "gate-qual" or ""
    
Included in:
    odb/_odb_get.p
    ora/ora_get.i
    syb/syb_getp.i
    
History:
    hutegger    94/08/03    created out of syb-, ora- and odb_get.p
    McMann      98/07/13    Added _Owner to _File finds
    
--------------------------------------------------------------------*/        
/*h-*/



SESSION:IMMEDIATE-display = no.
hide frame gate_wait no-pause.


{prodict/gate/nogatwrk.i
  &block    = "{&block} "
  &end      = "{&end} "
  &clean-up = {&clean-up}
  } /* message and leave */
assign inc_qual = (IF gate-qual = "" THEN no else yes).


/*----------------------------------------------------------------------*/
/*                          table selection                             */
/*----------------------------------------------------------------------*/

if user_env[25] begins "AUTO"
 then do:   /*========= automatically select all possible tables =======*/
  for each gate-work    /*===== but exclude system-tables =====*/
    {&autocond}: 
    assign gate-flag = yes.
    end.
  end.      /*========= automatically select all possible tables =======*/

 else do:   /*=========== let user select the tables he wants ==========*/
   
  &IF "{&WINDOW-SYSTEM}" <> "TTY" 
   &THEN
     RUN "prodict/gui/_guigget.p" (INPUT {&db-type}).
     canned = (if RETURN-VALUE = "cancel" then yes else no).
   &ELSE     /*----------------TTY only---------------------------------*/
    display
      "[" + KBLABEL("RETURN") + "].  " + new_lang[2] + " [" + KBLABEL("GO") + "] "
        + new_lang[3] + " [" + KBLABEL("END-ERROR") + "] " + new_lang[4] + "."
        @ hint
      "[" + KBLABEL("GET") + "] " + new_lang[5] + " [" + KBLABEL("PUT") + "] "
        + new_lang[6] + "."
        @ c
      with frame gate_not.

    if "{&gq}" <> "" AND inc_qual = TRUE
     then assign lab-qual = "Qualifier:".

    pause 0.
    VIEW frame gate_tbl.

    do with frame gate_tbl:

      find first gate-work no-error.

      do while TRUE:

        if redraw
         then do:
          assign
            rpos1 = (if available gate-work then gate-name  else ?)
            rpos2 = (if available gate-work then gate-user  else ?)
            rpos3 = (if available gate-work then gate-qual  else ?)
            j     = (if frame-line = 0 then 1  else frame-line).
          up j - 1.
          if j > 1 then do i = 2 TO j while available gate-work:
            find prev gate-work no-error.
            end.
          if NOT available gate-work
           then do:
            find first gate-work no-error.
            j = 1.
            end.
          do i = 1 to frame-down:
            COLOR display NORMAL
              gate-flag gate-user gate-name gate-type {&gq}.
            if available gate-work
             then display gate-flag gate-user gate-name gate-type {&gq}.
             else clear no-pause.
            down.
            if available gate-work then find next gate-work no-error.
            end.
          if rpos1 <> ?
           then find first gate-work 
              where gate-name = rpos1
              and   gate-user = rpos2
              and   gate-qual = rpos3.
          up frame-down - j + 1.
          assign
            xld    = 0
            redraw = FALSE.
          end.

        if xld <> frame-line and xld <> 0
         then do:
          j = frame-line.
          up frame-line - xld.
          COLOR display NORMAL 
            gate-flag gate-user gate-name gate-type {&gq}.
          up frame-line - j.
          end.
        if xld <> frame-line
         then COLOR display MESSAGES 
            gate-flag gate-user gate-name gate-type {&gq}.
        READKEY.
        pause 0.
        xld = frame-line.

        if  can-do("GO,END-ERROR",keyfunction(lastkey))
         or CHR(lastKEY) = "."
         then LEAVE.
        if NOT available gate-work
         then next.

        if CHR(lastKEY) > " "
         then do:
          assign
            rpos1 = (if available gate-work then gate-name  else ?)
            rpos2 = (if available gate-work then gate-user  else ?)
            rpos3 = (if available gate-work then gate-qual  else ?).
          find first gate-work
            where gate-name BEGINS hint + CHR(lastKEY)
            no-error.
          if available gate-work
           then hint = hint + CHR(lastKEY).
           else do:
            hint = CHR(lastKEY).
            find first gate-work
              where gate-name BEGINS hint
              no-error.
            end.
          if available gate-work
           then do:  /* frame repaint optimization is here */
            down frame-down - frame-line.
            do while frame-line > 1:
              if   INPUT gate-name = gate-name
               and INPUT gate-user = gate-user
               and INPUT gate-type = gate-type
               and INPUT gate-qual = gate-qual
               then LEAVE.
              up.
              end.
            redraw = ( INPUT gate-name <> gate-name 
                    or INPUT gate-user <> gate-user
                    or INPUT gate-type <> gate-type
                    or INPUT gate-qual <> gate-qual
                     ).
            end.     /* frame repaint optimization is here */
           else find first gate-work 
              where gate-name = rpos1
              and   gate-user = rpos2
              and   gate-qual = rpos3
              no-error.
          end.

        else if can-do("RETURN,CURSOR-DOWN,TAB, ",keyfunction(lastkey))
         then do:
          if   keyfunction(lastkey) = "RETURN"
           and available gate-work
           then do:
            gate-flag = NOT gate-flag.
            display gate-flag.
            end.
          find next gate-work no-error.
          if available gate-work
           then do:
            COLOR display NORMAL
              gate-flag gate-user gate-name gate-type {&gq}.
            if frame-line = frame-down
             then SCROLL up.
             else down.
            COLOR display MESSAGES
              gate-flag gate-user gate-name gate-type {&gq}.
            display gate-flag gate-user gate-name gate-type {&gq}.
            xld = frame-line.
            end.
           else
            find last gate-work no-error.
          end.

        else if can-do("CURSOR-UP,BACK-TAB,BACKSPACE",keyfunction(lastkey))
         then do:
          find prev gate-work no-error.
          if available gate-work
           then do:
            COLOR display NORMAL
              gate-flag gate-user gate-name gate-type {&gq}.
            if frame-line = 1
             then SCROLL down.
             else up.
            COLOR display MESSAGES
              gate-flag gate-user gate-name gate-type {&gq}.
            display gate-flag gate-user gate-name gate-type {&gq}.
            xld = frame-line.
            end.
           else find first gate-work no-error.
          end.

        else if keyfunction(lastkey) = "PAGE-DOWN"
         then do:
          do i = 1 to frame-down while available gate-work:
            find next gate-work no-error.
            end.
          if NOT available gate-work
           then do:
            find last gate-work no-error.
            down frame-down - frame-line.
            end.
          redraw = TRUE.
          end.

        else if keyfunction(lastkey) = "PAGE-UP"
         then do:
          do i = 1 to frame-down while available gate-work:
            find prev gate-work no-error.
            end.
          if NOT available gate-work then do:
            find first gate-work no-error.
            up frame-line - 1.
            end.
          redraw = TRUE.
          end.
        
        else if can-do("MOVE,HOME,END",keyfunction(lastkey))
         then do:
          assign
            rpos1 = (if available gate-work then gate-name  else ?)
            rpos2 = (if available gate-work then gate-user  else ?)
            rpos3 = (if available gate-work then gate-qual  else ?).
          up frame-line - 1.
          find first gate-work no-error.
          if   gate-name = rpos1
           and gate-user = rpos2
           and gate-qual = rpos3
           then do:
            find last gate-work no-error.
            down frame-down - frame-line.
            end.
          redraw = TRUE.
          end.
        
        else if can-do("GET,PUT",keyfunction(lastkey))
         then do with frame gate_match:
          assign
            l        = keyfunction(lastkey) = "GET"
            pat-name = "*"
            pat-qual = "*".
 
          if pat-user = ""
           then do:
            assign  
              pat-user = USERID(user_dbname) 
              i        = INDEX(pat-user,"@").
        /* sqlnet-usernames are <userid>@<drive-machine...>         */
        /*   if @ contained in userid and we can-find a table with  */
        /*   the cut userid we use the cut userid as default-value  */
            if i > 0 and can-find(first gate-work 
                   where gate-user matches substring(pat-user, 1, i - 1))
              then assign pat-user = substring(pat-user, 1, i - 1).
            end.  

          pause 0.
          display l lab-qual.
          do ON ERROR undo, leave ON ENDKEY undo, leave:
            if "{&gq}" = ""
             or not inc_qual
             then update pat-name pat-user.
             else update pat-name pat-user pat-qual.
            end.
          redraw = keyfunction(lastkey) <> "END-ERROR".
          if redraw then for each gate-buff
            where can-do(pat-name,gate-name) 
            and   can-do(pat-user,gate-user)
            and   gate-qual matches (if "{&gq}" <> ""
                                        and inc_qual 
                                        then pat-qual
                                        else ""):
            gate-flag = l.
            end.
          hide frame gate_match no-pause.
          end.

        end.
      end.
    canned = ( if keyfunction(lastkey) = "GO"
                then no
                else yes
             ).
    &ENDIF /*----------------TTY only---------------------------------*/

  end.     /*=========== let user select the tables he wants ==========*/

/*----------------------------------------------------------------------*/
/*                           create user_env[1..4]                      */
/*----------------------------------------------------------------------*/

if NOT canned
 then do TRANSACTION:

  for each gate-work
    where gate-work.gate-flag = TRUE
    and   gate-work.gate-prog = ?:
    gate-work.gate-prog = gate-work.gate-name.
    RUN "prodict/gate/_gat_xlt.p"
      (TRUE,drec_db,INPUT-OUTPUT gate-work.gate-prog).
    /* In order to keep from assigning duplicate default names in
    the event identical foreign names (for different userids) exist,
    create dummy _file records long enough to assign all necessary
    Progress names.  Yes, this is a hack. */
    create _File.
    assign
      _File._File-name = gate-work.gate-prog
      _File._Db-recid  = drec_db
      _File._For-type  = "TEMPORARY".
    end.

  for each _File 
    where _Db-recid = drec_db
      and (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") 
    and   _For-type = "TEMPORARY":
    delete _File.
    end.

  assign
    user_env[1] = ""
    user_env[2] = ""
    user_env[3] = ""
    user_env[4] = ""
    user_env[5] = "".
  for each gate-work
    where gate-work.gate-flag
    by    gate-work.gate-name DESCENDING:
    assign
      user_env[1] = gate-name + "," + user_env[1]
      user_env[2] = gate-type + "," + user_env[2]
      user_env[3] = gate-user + "," + user_env[3]
      user_env[4] = gate-prog + "," + user_env[4]
      user_env[5] = gate-qual + "," + user_env[5].
    end.

  end.     /* TRANSACTION */

if canned then assign user_path = "".

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   hide frame gate_not no-pause.
   hide frame gate_tbl no-pause.
&ENDIF

RUN adecomm/_setcurs.p ("").

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _closqlw.p

Description:
   Clean up after the closing of the _guisqlw.p program.  This is necessary
   so that the temp-table is deleted and certain tracking variables used in
   the program (GUI version only) are re-set.  
   
Author: Mario Brunetti

Date Created: 05/28/99 
-----------------------------------------------------------------------------*/

/* We're just sharing what we need, because sharing the frames and all was  *
 * causing a problem of certain variables not being available, etc.   */
 
DEF SHARED TEMP-TABLE t_Field LIKE _Field. 

DEF SHARED BUFFER w_Field FOR t_Field.

DEF SHARED VAR qry-width-hdl    AS WIDGET-HANDLE NO-UNDO.
DEF SHARED VAR s_PreviousTbl    AS CHAR          NO-UNDO.

DO ON ERROR UNDO, LEAVE
   ON STOP UNDO, LEAVE:

      qry-width-hdl:QUERY-CLOSE.

      DELETE WIDGET qry-width-hdl.

      FOR EACH w_Field:
         DELETE w_Field.
      END.

      s_PreviousTbl = ?.
END.      
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*------------------------------------------------------------------
   _guiauto.p - Editor for auto-connect progress databases.

   Author: Tony Lavinio, Laura Stern

HISTORY:
07/13/00 by dlm - Added format x(12) to lname 20000627004
04/12/00 by dlm - Added support for long db path name
07/14/98 by dlm - Added _Owner for _file finds
06/01/95 by gfs - 94-06-29-042
07/22/94 by gfs - Added mneumonics to buttons.
07/13/94 by gfs - 94-06-28-062
07/12/94 by gfs - 94-06-28-098, 94-06-29-035, 94-06-29-076.
06/23/94 by gfs - 94-06-16-109 Disallow adding of db already connected.
-------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE BUFFER xdb FOR DICTDB._Db.
DEFINE BUFFER Dbb FOR DICTDB._Db.

/* Form variables */
DEFINE VARIABLE dblist AS CHAR NO-UNDO INITIAL ""
   VIEW-AS SELECTION-LIST SINGLE INNER-CHARS 20 INNER-LINES 6 SCROLLBAR-V.
DEFINE VARIABLE args   AS CHAR NO-UNDO.
DEFINE VARIABLE dbaddr AS CHARACTER NO-UNDO.
DEFINE VARIABLE lname  AS CHARACTER FORMAT "x(12)" NO-UNDO.

DEFINE BUTTON btn_add LABEL "&Add..."    SIZE 13 BY 1.
DEFINE BUTTON btn_mod LABEL "&Modify..." SIZE 13 BY 1.
DEFINE BUTTON btn_del LABEL "&Delete..." SIZE 13 BY 1.
{prodict/misc/filesbtn.i}

/* Miscellaneous */
DEFINE VARIABLE answer   AS LOGICAL          NO-UNDO.
DEFINE VARIABLE changed  AS LOGICAL INIT NO  NO-UNDO.
DEFINE VARIABLE stat  	 AS LOGICAL    	     NO-UNDO.
DEFINE VARIABLE can_do   AS LOGICAL EXTENT 3 NO-UNDO. /* can add/modify/write */
DEFINE VARIABLE num      AS INTEGER          NO-UNDO.
DEFINE VARIABLE ldummy   AS LOGICAL          NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  /* 1*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 2*/ "You do not have permission to use this option.",
  /* 3*/ "Add Auto-Connect Record", 
  /* 4*/ "Modify Auto-Connect Record",
  /* 5*/ "Are you sure that you want to remove the connect record for",
  /* 6*/ "Undo all changes made in this dialog box?",
  /* 7*/ "", /* reserved */
  /* 8*/ "You cannot delete an autoconnect record for a connected database.",
  /* 9*/ "This name is already used for a sub-schema or auto-connect record.",
  /*10*/ "Logical name may not be left blank or unknown.",
  /*11*/ "You cannot use the same logical name as the currently selected database.",
  /*12*/ "Physical name may not be left blank or unknown."
].

&GLOBAL-DEFINE COL1 17
&GLOBAL-DEFINE COL2 53
&GLOBAL-DEFINE EDCHRS 51 
&GLOBAL-DEFINE FILLCH 51
&IF "{&OPSYS}" <> "MSDOS" and "{&OPSYS}" <> "WIN32" &THEN
    &SCOPED-DEFINE SLASH /
&ELSE
    &SCOPED-DEFINE SLASH ~~~\
&ENDIF

FORM
   SKIP({&TFM_WID})
   "{&PRO_DISPLAY_NAME}"        AT 2 VIEW-AS TEXT 
   dblist            AT {&COL1}        	                 SKIP({&VM_WIDG})        
   dbaddr      AT 17 FORMAT "x({&PATH_WIDG})" 
	       	     VIEW-AS EDITOR INNER-CHARS 51 INNER-LINES 3 MAX-CHARS 255 SCROLLBAR-VERTICAL 
                 SKIP({&VM_WIDG})
   "CONNECT-"        AT  2 VIEW-AS TEXT 	     
   args              AT 17 VIEW-AS EDITOR 
                     INNER-LINES 3 INNER-CHARS {&EDCHRS} SCROLLBAR-VERTICAL
                     SKIP({&VM_WIDG})
   "NOTE:"           AT  2 VIEW-AS TEXT 
   "For Non-{&PRO_DISPLAY_NAME} databases, use the DataServer      " 
                     AT 17 VIEW-AS TEXT                  SKIP({&VM_WID})
    "utility: Edit Connection Information.      "
                     AT 17 VIEW-AS TEXT                  SKIP({&VM_WID})
   {prodict/user/userbtns.i}

   btn_add     	     AT ROW-OF dblist + 0.5 COLUMN    {&COL2} SKIP({&VM_WID})
   btn_mod     	     AT                               {&COL2} SKIP({&VM_WID})
   btn_del     	     AT                               {&COL2} SKIP({&VM_WID})

   "Databases:"	     AT ROW-OF dblist + 0.7  COLUMN 2  VIEW-AS TEXT

   "Statement"	     AT ROW-OF args   + 0.7  COLUMN 2  VIEW-AS TEXT SKIP({&VM_WID})
   "Parameters:"     AT 2  VIEW-AS TEXT
   "Physical Name:"  AT ROW-OF dbaddr + 0.2  COLUMN 2 VIEW-AS TEXT

   WITH FRAME dbauto 
   CENTERED NO-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   VIEW-AS DIALOG-BOX TITLE "Edit Auto-Connect List".


FORM
   SKIP({&TFM_WID})
   "Logical Name:":t35   AT 2 VIEW-AS TEXT 	  SKIP({&VM_WID})
   lname       	     AT 2 {&STDPH_FILL}   SKIP({&VM_WIDG})
   "Physical Name:":t35  AT 2 VIEW-AS TEXT 	  SKIP({&VM_WID})
   Dbb._Db-addr      AT 2 {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
	       	          VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 
   btn_File    	     	      	       	  SKIP({&VM_WIDG})
   "CONNECT-Statement Parameters:":t35  
      	       	     AT 2 VIEW-AS TEXT 	  SKIP({&VM_WID})
   Dbb._Db-comm      AT 2 VIEW-AS EDITOR 
                          SIZE 55 BY 3 SCROLLBAR-VERTICAL
   {prodict/user/userbtns.i}
   WITH FRAME db_mod
   CENTERED NO-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   VIEW-AS DIALOG-BOX.


/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/*========================Internal Procedures=============================*/

/*--------------------------------------------------------------------
   Show information on the database selected in the information area.

   Input Parameter:
      p_Name = If ? - We've already go the record, display values 
      	       else - Get the record with this db name and 
      	       	      display the values (it may be "" if no dbs).
---------------------------------------------------------------------*/
PROCEDURE Show_Db:

   DEFINE INPUT PARAMETER p_Name AS CHAR NO-UNDO.

   /* Find db record unless we've got it already */
   IF p_Name <> ? THEN   
      FIND Dbb WHERE Dbb._Db-name = p_Name AND 
      	       	     Dbb._Db-type = "PROGRESS" AND 
      	       	     NOT Dbb._Db-local NO-ERROR.

   IF AVAILABLE Dbb THEN 
     ASSIGN dbaddr = Dbb._Db-addr
            lname  = Dbb._Db-name
            args   = Dbb._Db-comm.
   ELSE 
     ASSIGN dbaddr = ""
            lname  = ""
            args   = "".
   ENABLE dbaddr args WITH FRAME dbauto.
   ASSIGN dbaddr:READ-ONLY IN FRAME dbauto = TRUE
          args:READ-ONLY IN FRAME dbauto = TRUE.
   DISPLAY 
	     dbaddr
      	 args
	 WITH FRAME dbauto.  
   
END.


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
/*----- HELP -----*/
on HELP of frame dbauto
   or CHOOSE of btn_Help in frame dbauto
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Edit_Auto_Connect_List_Dlg_Box},
      	       	     	     INPUT ?).
on HELP of frame db_mod
   or CHOOSE of btn_Help in frame db_mod
do: 
   IF FRAME db_mod:TITLE = new_lang[3] then
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Add_Auto_Connect_Dlg_Box},
      	       	     	     INPUT ?).
   else
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Modify_Auto_Connect_Dlg_Box},
      	       	     	     INPUT ?).
end.
&ENDIF


/*----- GO or OK in ADD/MODIFY FRAME -----*/
ON GO OF FRAME db_mod
DO:
   DEFINE VAR scr_val AS CHAR               NO-UNDO.
   DEFINE VAR i       AS INT                NO-UNDO. /* counter */
   DEFINE VAR rc      AS LOGICAL INITIAL no NO-UNDO. /* result code */
   DEFINE VAR choice  AS LOGICAL INITIAL no NO-UNDO.

   IF Dbb._Db-addr:SCREEN-VALUE = "" OR
      Dbb._Db-addr:SCREEN-VALUE = ?  THEN DO:
        MESSAGE new_lang[12] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        APPLY "ENTRY" TO Dbb._Db-addr IN FRAME db_mod.
        RETURN NO-APPLY.
   END.
   FILE-INFO:FILE-NAME = (IF SUBSTRING(Dbb._Db-addr:SCREEN-VALUE,LENGTH(Dbb._Db-addr:SCREEN-VALUE) - 2,-1,"CHARACTER":U) NE ".db" THEN 
                          Dbb._Db-addr:SCREEN-VALUE + ".db" ELSE Dbb._Db-addr:SCREEN-VALUE).
   IF FILE-INFO:FULL-PATHNAME EQ ? THEN DO:
     MESSAGE "Database:" Dbb._Db-addr:SCREEN-VALUE "was not found." skip
             "Do you want to add it anyway?" VIEW-AS ALERT-BOX QUESTION
             BUTTONS YES-NO UPDATE choice.
     IF NOT choice THEN DO:
       APPLY "ENTRY" TO Dbb._Db-addr.
       RETURN NO-APPLY.
     END.
   END.
   ASSIGN Dbb._Db-addr:SCREEN-VALUE = REPLACE(Dbb._Db-addr:SCREEN-VALUE, ".db", "")
          dbaddr = Dbb._Db-addr
          scr_val = lname:SCREEN-VALUE IN FRAME db_mod.
   IF scr_val = "" OR scr_val = "?" THEN DO:
      MESSAGE new_lang[10] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      APPLY "ENTRY" TO lname IN FRAME db_mod.
      RETURN NO-APPLY.
   END.
   IF LDBNAME(user_dbname) = lname:SCREEN-VALUE THEN DO:
      MESSAGE new_lang[11] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      APPLY "ENTRY" to lname IN FRAME db_mod.
      RETURN NO-APPLY.
   END.
END.


/*----- ON HIT of CANCEL BUTTON or ENDKEY -----*/
ON CHOOSE OF btn_Cancel IN FRAME dbauto OR ENDKEY OF FRAME dbauto
DO:
   IF NOT changed THEN RETURN.  

   answer = yes.
   MESSAGE new_lang[6] /* Are you sure */
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
   IF NOT answer THEN
      RETURN NO-APPLY.
   ELSE
      changed = no.  /* reset */
END.


/*----- VALUE-CHANGED OF DB LIST -----*/
ON VALUE-CHANGED OF dblist IN FRAME dbauto
   RUN Show_Db (INPUT SELF:SCREEN-VALUE).


/*----- DEFAULT-ACTION (DBL-CLICK) OF DB LIST -----*/
ON DEFAULT-ACTION OF dblist IN FRAME dbauto
   APPLY "CHOOSE" TO btn_mod IN FRAME dbauto.


/*----- LEAVE of LOGICAL NAME IN ADD/MODIFY FRAME -----*/
ON LEAVE OF lname IN FRAME db_mod
DO:
   /* Make sure logical name is valid */
   RUN "adecomm/_valname.p" (INPUT SELF:SCREEN-VALUE, INPUT yes, OUTPUT answer).
   IF NOT answer THEN 
      RETURN NO-APPLY.

   /* Make sure it's unique */
   FIND FIRST xdb WHERE xdb._Db-name = SELF:SCREEN-VALUE
   	       	     	AND RECID(xdb) <> RECID(Dbb) NO-ERROR.
   IF AVAILABLE xdb THEN DO:
      MESSAGE new_lang[9] /* already used */
   	      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN NO-APPLY.
   END.
END.


/*----- LEAVE of UNIX PARMS IN ADD/MODIFY FRAME -----*/
ON LEAVE OF Dbb._Db-comm IN FRAME db_mod
DO:
   IF TRIM(SELF:SCREEN-VALUE) = "?" THEN SELF:SCREEN-VALUE = "".
END.


/*----- HIT OF ADD BUTTON -----*/
ON CHOOSE OF btn_add IN FRAME dbauto 
DO:
   FRAME db_mod:TITLE = new_lang[3].
   DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
      CREATE Dbb.

      Dbb._Db-Comm = "".
      lname = "".
      Dbb._Db-addr = "".
      UPDATE lname Dbb._Db-addr 
             btn_File Dbb._Db-Comm
      	     btn_OK btn_Cancel {&HLP_BTN_NAME}
      	     WITH FRAME db_mod.

      ASSIGN
      	 /* Remove any line feeds (which we get on WINDOWS) */
      	 Dbb._Db-Comm = replace (Dbb._Db-Comm, CHR(13), "")
      	 Dbb._Db-type = "PROGRESS"
      	 Dbb._Db-slave = FALSE
      	 Dbb._Db-name = lname
      	 changed = yes.
   
      /* Add new Db to list and show db info */
      stat = dblist:ADD-LAST(Dbb._Db-name) IN FRAME dbauto.
      dblist:SCREEN-VALUE IN FRAME dbauto = Dbb._Db-name.
      RUN Show_Db (INPUT ?).

      ASSIGN
      	 num = num + 1
      	 btn_mod:sensitive IN FRAME dbauto = yes
      	 btn_del:sensitive IN FRAME dbauto = yes.
   END.
END.


/*----- HIT OF MODIFY BUTTON -----*/
ON CHOOSE OF btn_mod IN FRAME dbauto 
DO:
   FRAME db_mod:TITLE = new_lang[4].
   DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
      UPDATE lname Dbb._Db-addr btn_File Dbb._Db-comm
      	     btn_OK btn_Cancel {&HLP_BTN_NAME}
      	     WITH FRAME db_mod.

      ASSIGN
      	 /* Remove any line feeds (which we get on WINDOWS) */
      	 Dbb._Db-Comm = replace (Dbb._Db-Comm, CHR(13), "")
	 Dbb._Db-name = lname.
      	 changed = yes.

      /* Update display */
      IF lname ENTERED THEN DO:
      	 stat = dblist:REPLACE(Dbb._Db-name, 
			       dblist:SCREEN-VALUE IN FRAME dbauto).
      	 dblist:SCREEN-VALUE IN FRAME dbauto = Dbb._Db-name.  /* reset choose */
      END.
      Run Show_Db (INPUT ?).
   END.
END.


/*----- HIT OF DELETE BUTTON -----*/
ON CHOOSE OF btn_del IN FRAME dbauto 
DO:
   DEFINE VAR del_name AS CHAR     NO-UNDO. /* Name deleted */

   IF CONNECTED(dblist:screen-value) THEN DO:
      MESSAGE new_lang[8] /* can't delete connected db */
      	 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN NO-APPLY.
   END.

   DO ON ERROR UNDO,LEAVE:
      MESSAGE new_lang[5] + ' "' + dblist:screen-value + '"?'
      	 VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
      IF answer THEN DO:
      	 ASSIGN del_name = dblist:screen-value.
         IF del_name = dbb._db-name THEN 
            ASSIGN user_dbname = "".
           
         DELETE Dbb.
      	 changed = yes.
   
      	 /* Reset choose to item above one just deleted */
      	 RUN "adecomm/_delitem.p" (INPUT dblist:HANDLE IN FRAME dbauto,
      	       	     	      	  INPUT del_name,
      	       	     	      	  OUTPUT num).
      	 IF num > 0 THEN
      	    RUN Show_Db (INPUT dblist:SCREEN-VALUE IN FRAME dbauto).
      	 ELSE DO:
      	    ASSIGN
      	       btn_mod:sensitive IN FRAME dbauto = no
      	       btn_del:sensitive IN FRAME dbauto = no.
      	    RUN Show_Db (INPUT "").
      	 END.
      END.
   END.
END.

/*----- CHOOSE of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame db_mod DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT Dbb._Db-addr:handle in frame db_mod /*Fillin*/,
        INPUT "Find Database File"  /*Title*/,
        INPUT "*.db"                /*Filter*/,
        INPUT no                    /*Must exist*/).
   Dbb._Db-addr:SCREEN-VALUE = REPLACE(Dbb._Db-addr:SCREEN-VALUE, ".db", "").
   IF lname:SCREEN-VALUE = ? OR lname:SCREEN-VALUE = "" THEN DO:
     IF R-INDEX(Dbb._Db-addr:SCREEN-VALUE,"{&SLASH}") > 0 THEN
       lname:SCREEN-VALUE = SUBSTRING(Dbb._Db-addr:SCREEN-VALUE, R-INDEX(Dbb._Db-addr:SCREEN-VALUE,"{&SLASH}") + 1, -1, "CHARACTER":U).
     ELSE lname = Dbb._Db-addr:SCREEN-VALUE.
   END.
END.


/*----- LEAVE of PHYSICAL NAME -----*/
ON LEAVE OF Dbb._Db-addr in frame db_mod DO:
   SELF:screen-value = TRIM(SELF:screen-value).
   SELF:screen-value = REPLACE(SELF:screen-value, ".db", "").
END.

/*----- WINDOW CLOSE -----*/
ON WINDOW-CLOSE OF FRAME dbauto
   APPLY "END-ERROR" to FRAME dbauto.
ON WINDOW-CLOSE OF FRAME db_mod
   APPLY "END-ERROR" to FRAME db_mod.


/*============================Mainline code===============================*/

DO FOR DICTDB._File:
   FIND _File WHERE _File._File-name = "_Db"
                AND _File._Owner = "PUB" NO-LOCK.
   IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
      MESSAGE new_lang[2] VIEW-AS ALERT-BOX ERROR BUTTONS OK. /* no permis. */
      user_path = "".
      RETURN.
   END.
  
   can_do[1] = CAN-DO(_Can-create,USERID("DICTDB")).
   can_do[2] = CAN-DO(_Can-write,USERID("DICTDB")).
   can_do[3] = CAN-DO(_Can-delete,USERID("DICTDB")).
END.

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME dbauto" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME db_mod" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}

/* Fill the list of databases and remember the first to set selection.
   Don't count current db (local).
*/
num = 0.
FOR EACH Dbb WHERE Dbb._Db-type = "PROGRESS" AND NOT Dbb._Db-local:
   stat = dblist:ADD-LAST(Dbb._Db-name) IN FRAME dbauto.
   num = num + 1.
END.
FIND FIRST Dbb WHERE Dbb._Db-type = "PROGRESS" AND NOT Dbb._Db-local NO-ERROR.
IF AVAILABLE Dbb THEN 
   dblist = Dbb._Db-name.

IF dblist <> "" THEN DO:
   DISPLAY dblist WITH FRAME dbauto.
   RUN Show_Db (dblist).
END.

DO TRANSACTION ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   ENABLE
      dblist
      btn_add when can_do[1]
      btn_mod when can_do[2] AND num > 0
      btn_del when can_do[3] AND num > 0
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
      WITH FRAME dbauto.

   ASSIGN
      ldummy = btn_mod:MOVE-AFTER-TAB-ITEM(btn_add:HANDLE IN FRAME dbauto).
      ldummy = btn_del:MOVE-AFTER-TAB-ITEM(btn_mod:HANDLE IN FRAME dbauto).
   WAIT-FOR CHOOSE OF btn_OK IN FRAME dbauto OR
      GO OF FRAME dbauto
      FOCUS dblist.
END.

HIDE FRAME dbauto NO-PAUSE.
RETURN.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
   This shows a list of fields and allows the user to specify the start 
   and end column for each field.  It does NOT work on TTY.
   
   pik_count  - number of elements in list (was pik_chextent)
   pik_list   - list of elements           (was pik_chlist)
   pik_lower  - lower values (start column) for each list element
   pik_upper  - upper values (end column) for each list element
   
   HISTORY:
   
   Modified on 07/08/94 by gfs      Fixed bug 94-06-24-018
                           gfs      Fixed title spelling
               01/07/98 by Mario B  BUG 98-10-21-035 widen frame so start and
	                            end values can be seen.
*/

{prodict/user/uservar.i}


/*input:*/
DEFINE SHARED VARIABLE pik_count AS INTEGER               NO-UNDO.
DEFINE SHARED VARIABLE pik_list  AS CHARACTER EXTENT 2000 NO-UNDO.

/*output:*/
DEFINE SHARED VARIABLE pik_lower AS INTEGER   EXTENT 2000 NO-UNDO.
DEFINE SHARED VARIABLE pik_upper AS INTEGER   EXTENT 2000 NO-UNDO.

&global-define NUM1_COL        34
&global-define NUM2_COL 41
&global-define LIST_WID 66
&global-define LBL_WID  68
&IF "{&WINDOW-SYSTEM}" begins "MS-WIN" &THEN 
   &global-define LBL_COL  2.5
&ELSE
   &global-define LBL_COL  3
&ENDIF

/* Form Variables*/
DEFINE VARIABLE sel_list  AS CHAR                               NO-UNDO 
   VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-V
   INNER-CHARS {&LIST_WID} INNER-LINES 10.

DEFINE VARIABLE start_col AS INTEGER FORMAT ">>>>>" NO-UNDO .
DEFINE VARIABLE end_col   AS INTEGER FORMAT ">>>>>" NO-UNDO.

DEFINE VARIABLE lst_label1 AS CHAR NO-UNDO.
DEFINE VARIABLE lst_label2 AS CHAR NO-UNDO.

DEFINE BUTTON btn_Next LABEL "&Next" {&STDPH_OKBTN}.

/* Miscellaneous */
DEFINE VARIABLE ix        AS INTEGER NO-UNDO.
DEFINE VARIABLE stat      AS LOGICAL NO-UNDO.
DEFINE VARIABLE item      AS CHAR    NO-UNDO.
DEFINE VARIABLE new_item  AS CHAR    NO-UNDO.
DEFINE VARIABLE num1      AS INTEGER NO-UNDO.
DEFINE VARIABLE num2      AS INTEGER NO-UNDO.
DEFINE VARIABLE lst_val   AS CHAR    NO-UNDO.

FORM
  SKIP({&TFM_WID})
  "Use RETURN from End Column for continuous data" 
                              AT 2 VIEW-AS TEXT                           SKIP
  "entry."       AT 2 VIEW-AS TEXT               SKIP({&VM_WIDG})

  start_col      AT {&LBL_COL} 
                                   LABEL "&Start Column"            SPACE({&HM_WIDG})
  end_col             LABEL "&End Column"        SKIP({&VM_WIDG})
  lst_label1     AT {&LBL_COL} NO-LABEL VIEW-AS TEXT 
                              FORMAT "x({&LBL_WID})" FONT fixed_font   SKIP
  lst_label2     AT {&LBL_COL} NO-LABEL VIEW-AS TEXT  
                              FORMAT "x({&LBL_WID})" FONT fixed_font   SKIP({&VM_WID})

  sel_list              AT 2  NO-LABEL FONT fixed_font

  {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      &OTHER  = "SPACE({&HM_DBTNG}) btn_Next"
      {&HLP_BTN}
   }

  WITH FRAME fixd 
  ROW 3 CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Fixed-Length Field Columns".


/*=========================Internal Procedures============================*/

/*--------------------------------------------------
   Outputs: new_item - the new value of the 
                  selection list item after the end col
                  value has been incorporated into it.
---------------------------------------------------*/
PROCEDURE Show_End_Col:
   item = lst_val.
   new_item = SUBSTR(item,1,{&NUM2_COL} - 1) + 
                    STRING(INTEGER(end_col:SCREEN-VALUE IN FRAME fixd),">>>>>").
   stat = sel_list:REPLACE(new_item, item) IN FRAME fixd.
   lst_val = new_item.
END.

/*===============================Triggers=================================*/

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
on HELP of frame fixd OR choose of btn_Help in frame fixd
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Fixed_Length_Field_Columns_Dlg_Box},
                                               INPUT ?).
&ENDIF


/*-----WINDOW-CLOSE-----*/
on window-close of frame fixd
   apply "END-ERROR" to frame fixd.


/*----- VALUE CHANGED of SELECT LIST -----*/
ON VALUE-CHANGED OF sel_list IN FRAME fixd
DO:
   IF (end_col:SCREEN-VALUE = "" AND start_col:SCREEN-VALUE <> "") OR
      (INT(end_col:SCREEN-VALUE) < INT(start_col:SCREEN-VALUE))    THEN 
   DO:
            MESSAGE "You must enter a valid value for the ending column."
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            APPLY "ENTRY" TO end_col.
            RETURN NO-APPLY.
   END.
   assign
     /* This is needed because on Windows, if we are in one of the
        column fill-in fields and click on the select list, when we get
        the leave event, the select list value has already been 
        changed so we would end up setting the column value for the wrong 
        list entry.  So lst_val represents the current select list value 
        more acurately than sel_list:screen-value.
     */
     lst_val = SELF:SCREEN-VALUE
     new_item = lst_val

     /* Show the start/end columns for the selected field */
     start_col = INTEGER(SUBSTR(lst_val,{&NUM1_COL},5))
     end_col   = INTEGER(SUBSTR(lst_val,{&NUM2_COL},5))
     .
   DISPLAY start_col end_col WITH FRAME fixd.
END.

/*----- LEAVE of START COLUMN -----*/
ON LEAVE OF start_col IN FRAME fixd
DO:
   /* Reflect the new value in the select list */
   
   IF INT(end_col:SCREEN-VALUE) > 0 THEN 
        IF start_col:SCREEN-VALUE = "" /*OR 
        INT(start_col:SCREEN-VALUE) > INT(end_col:SCREEN-VALUE)*/ THEN 
        DO:
          MESSAGE "You must enter a valid starting column." 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          RETURN NO-APPLY.
        END.
   IF LAST-EVENT:FUNCTION = "GO" THEN
        IF start_col:SCREEN-VALUE <> "" AND
             end_col:SCREEN-VALUE = "" THEN 
           DO:
             MESSAGE "You must enter a valid ending column."
                VIEW-AS ALERT-BOX BUTTONS OK.
             RETURN NO-APPLY.
           END.
   item     = sel_list:SCREEN-VALUE.
   new_item = SUBSTR(item,1,{&NUM1_COL} - 1) + 
                    STRING(INTEGER(SELF:SCREEN-VALUE),">>>>>") +
                    SUBSTR(item,{&NUM2_COL} - 2).
   stat    = sel_list:REPLACE(new_item, item) IN FRAME fixd.
   lst_val = new_item.

   /* REPLACE function removes selection.  Value will be ? unless
      the leave trigger was caused by clicking on select list.
      If it is ?, restore selection.
   */
   IF sel_list:SCREEN-VALUE IN FRAME fixd = ? THEN
      sel_list:SCREEN-VALUE IN FRAME fixd = new_item. 
END.

/*----- ENTRY of END COLUMN -----*/
ON ENTRY OF end_col IN FRAME fixd
   FRAME fixd:DEFAULT-BUTTON = btn_Next:HANDLE IN FRAME fixd.


/*----- LEAVE of END COLUMN -----*/
ON LEAVE OF end_col IN FRAME fixd
DO:
   IF (start_col:SCREEN-VALUE = "" OR start_col:SCREEN-VALUE = ?) AND
     (SELF:SCREEN-VALUE NE "" AND SELF:SCREEN-VALUE NE ?) THEN DO:
     MESSAGE "You must enter a valid starting column." VIEW-AS ALERT-BOX ERROR.
     APPLY "ENTRY" TO start_col.
     RETURN NO-APPLY.
   END.
   IF INT(start_col:SCREEN-VALUE) > INT(end_col:SCREEN-VALUE) THEN
   DO:
        MESSAGE "The starting column cannot be larger than the ending column."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        ASSIGN sel_list:SCREEN-VALUE = new_item.
        APPLY "ENTRY" TO start_col.
        RETURN NO-APPLY.
   END.
   /* Reflect the new value in the select list */
   RUN Show_End_Col.
   
   /* REPLACE function removes selection.  Value will be ? unless
      the leave trigger was caused by clicking on select list.
      If it is ?, restore selection.
   */
   IF sel_list:SCREEN-VALUE IN FRAME fixd = ? THEN
     sel_list:SCREEN-VALUE IN FRAME fixd = new_item. 

   FRAME fixd:DEFAULT-BUTTON = btn_OK:HANDLE IN FRAME fixd.
END.

/*----- CHOOSE of NEXT BUTTON -----*/
ON CHOOSE of btn_Next IN FRAME fixd
DO:
   /* Reflect the new value in the select list. This will have happened
      already if user clicks on Next.  But if they "push" next by hitting
      RETURN (default button), the leave trigger doesn't fire.
   */

   IF (end_col:SCREEN-VALUE = "" AND start_col:SCREEN-VALUE <> "") OR
      (INT(end_col:SCREEN-VALUE) < INT(start_col:SCREEN-VALUE))    THEN 
   DO:
            MESSAGE "You must enter a valid ending column."
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            APPLY "ENTRY" TO end_col.
            RETURN NO-APPLY.
   END.
   
   IF SELF:HANDLE <> FOCUS:HANDLE THEN
   RUN Show_End_Col. 
   /* move the selection down 1 */
   ix = sel_list:LOOKUP(new_item) IN FRAME fixd.
   IF ix < sel_list:NUM-ITEMS THEN
      ix = ix + 1.
   sel_list:SCREEN-VALUE IN FRAME fixd  = sel_list:ENTRY(ix) IN FRAME fixd.

   /* Reflect values of new selection in fill-ins */
   APPLY "VALUE-CHANGED" TO sel_list IN FRAME fixd.

   /* Set up to modify for next field by putting cursor in start col. */ 
   APPLY "ENTRY" TO start_col IN FRAME fixd.
END.


/*============================Mainline code===============================*/

/* Store the list of fields in the select list */
DO ix = 1 TO pik_count:
   stat = sel_list:ADD-LAST(STRING(pik_list[ix],"x({&LIST_WID})")) 
      IN FRAME fixd.
END.

/* Compose the two list label strings */
ASSIGN
   num1 = {&NUM1_COL} - 1
   num2 = {&NUM2_COL} - {&NUM1_COL}
   lst_label1 = STRING(" ", SUBSTITUTE("x(&1)", num1)) + 
                      STRING("Start", SUBSTITUTE("x(&1)", num2)) +
                      "End"
   lst_label2 = STRING("Field Name", SUBSTITUTE("x(&1)", num1)) + 
                      STRING("Column", SUBSTITUTE("x(&1)", num2)) +
                      "Column".

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
   &FRAME = "frame fixd" 
   &BOX   = "rect_Btns"
   &OK    = "btn_OK" 
   {&HLP_BTN}
}

display lst_label1 lst_label2 with frame fixd.

/* initialize 1st selection */
sel_list = STRING(pik_list[1],"x({&LIST_WID})").
lst_val = sel_list.  

DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
   UPDATE start_col 
                end_col 
                sel_list
          btn_OK 
                btn_Cancel
          btn_Next
                {&HLP_BTN_NAME}
          WITH FRAME fixd.
   
   /* Set output values */
   DO ix = 1 TO pik_count:
      ASSIGN
               pik_lower[ix] = 
                  INTEGER(SUBSTR(sel_list:ENTRY(ix) IN FRAME fixd,{&NUM1_COL},5))
               pik_upper[ix] = 
                  INTEGER(SUBSTR(sel_list:ENTRY(ix) IN FRAME fixd,{&NUM2_COL},5)).
   END.
END.  

HIDE FRAME fixd NO-PAUSE.
RETURN.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------

File: _guigge1.p

Description:   
    Select one or more objects from the list of records in the gatework
    temp-table. 
    This routnine gets called when the field gate-work.gate-flg2 should
    be part of the browse-widget's display.

Input: 
    Workfile gate-work contains info on all the gateway objects.
    p_Gate      Name of the gateway, e.g., "Oracle".
    p_sel-type  "Create"        when creating new schema
                "Differences"   to browse differences
                "Update"        when plain updating schema

Output:
    gatework.gate-flag = "yes"  object to be created/updated/deleted
 
Returns:
    "ok"     if 1 or more tables were chosen.
    "cancel" if user cancelled out.

Author: Laura Stern

Date Created : 07/28/93 

History:
    hutegger    95/03   extented functionality to get used for create, 
                        update and browse differences and browse differences and extracted
                        body of program into .i-file
    gfs         94/07   Install correct help contexts
    gfs         94/05   Changed Selection-List to Browse

----------------------------------------------------------------------*/

&SCOPED-DEFINE GATE_FLG2 YES
{ prodict/gui/guigget.i }
&UNDEFINE GATE_FLG2
  
/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------

File: _guigget.p

Description:   
    Select one or more objects from the list of records in the gatework
    temp-table. 
    This routnine gets called when the field gate-work.gate-flg2 should
    NOT be part of the browse-widget's display.

Input: 
    Workfile gate-work contains info on all the gateway objects.
    p_Gate      Name of the gateway, e.g., "Oracle".
    p_sel-type  "Create"        when creating new schema
                "Differences"   to browse differences
                "Update"        when plain updating schema

Output:
    gatework.gate-flag = "yes"  object to be created/updated/deleted
 
Returns:
    "ok"     if 1 or more tables were chosen.
    "cancel" if user cancelled out.

Author: Laura Stern

Date Created : 07/28/93 

History:
    hutegger    95/03   extented functionality to get used for create, 
                        update and browse differences and extracted
                        body of program into .i-file
    gfs         94/07   Install correct help contexts
    gfs         94/05   Changed Selection-List to Browse

----------------------------------------------------------------------*/

&SCOPED-DEFINE GATE_FLG2 NO
{ prodict/gui/guigget.i }
&UNDEFINE GATE_FLG2
  
/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*------------------------------------------------------------------
   Parameter file Editor

   Output Parameter:
      canned - Return YES if user cancels out, NO otherwise.

   Author: Laura Stern
-------------------------------------------------------------------*/

{prodict/user/uservar.i}
/* arg_nam   - (By the time we get here:) Array of arg name/description 
      	       pairs (e.g., -B   Buffers)
   arg_lst   - All parm names (-B) strung out in a comma delimited list
   arg_typ   - Array of argument data types (l, c, n)
   arg_val   - Array of values
   args#     - Number of arguments 
   arg_comm  - Array of comment lines 
   arg_comm# - # of non-blank comment lines
   pf_file   - The parameter file to edit.
*/
{prodict/user/userpfed.i}

DEFINE OUTPUT PARAMETER p_canned AS LOGICAL NO-UNDO.

/* Form Variables */
DEFINE VARIABLE plist AS CHAR NO-UNDO FONT 0 /* fixed pitch so cols line up */
   VIEW-AS SELECTION-LIST SINGLE SCROLLBAR-V 
   /*Make it roughly same size as editor for comments*/
   INNER-CHARS {&COMM_LEN} INNER-LINES {&COMM#}.

DEFINE VARIABLE arg_chr AS CHAR     FORMAT "x({&VAL_CHARS})"  NO-UNDO.
DEFINE VARIABLE arg_int AS INTEGER  FORMAT ">>>,>>>,>>9"    NO-UNDO.
DEFINE VARIABLE arg_log AS LOGICAL  FORMAT "yes/no"         NO-UNDO.

DEFINE VARIABLE comment AS CHAR     NO-UNDO
   VIEW-AS EDITOR INNER-CHARS {&COMM_LEN} INNER-LINES {&COMM#}
   {&STDPH_EDITOR}.

/* Miscellaneous */
DEFINE VARIABLE ix   	 AS INTEGER    	  NO-UNDO.  /* looping variable */
DEFINE VARIABLE stat 	 AS LOGICAL    	  NO-UNDO.
DEFINE VARIABLE tru_txt	 AS CHARACTER     NO-UNDO.
DEFINE VARIABLE prev_ix  AS INTEGER    	  NO-UNDO.
DEFINE VARIABLE labelstr AS CHAR NO-UNDO FONT 0 /*fixed pitch so cols line up*/.
DEFINE VARIABLE ldummy   AS LOGICAL       NO-UNDO.

/* This is needed because on Windows, if we are in one of the
   argument fields and click on the select list, when we get
   the leave event, the select list value has already been 
   changed so we would end up saving the argument for the wrong 
   parameter.  So lst_val represents the current select list value 
   more acurately than plist:screen-value.
*/
DEFINE VARIABLE lst_val  as CHAR          NO-UNDO.


FORM
   SKIP({&TFM_WID})
   labelstr    AT 2  NO-LABEL       VIEW-AS TEXT SKIP({&VM_WID})
   plist       AT 2  NO-LABEL       SKIP({&VM_WIDG})
   arg_chr     AT 2  {&STDPH_FILL} LABEL "&Character Value" 
	       SKIP({&VM_WIDG})
   arg_int     AT ROW-OF arg_chr COL 2 {&STDPH_FILL} 
	       LABEL "&Integer Value" SKIP({&VM_WIDG})
   arg_log     AT ROW-OF arg_chr COL 2 {&STDPH_FILL} 
	       LABEL "&Logical Value" SKIP({&VM_WIDG})
   "Co&mments: (up to {&COMM#} lines)     "  
      	       AT 2  VIEW-AS TEXT     	     SKIP({&VM_WID})
   comment     AT 2  NO-LABEL
   {prodict/user/userbtns.i}
   WITH FRAME pfedit
   CENTERED ATTR-SPACE SIDE-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel SCROLLABLE
   VIEW-AS DIALOG-BOX TITLE ' Edit Parameter File "' + pf_file + '" '.


/*========================Internal Procedures=============================*/

/*---------------------------------------------------
   Save the new value the user just entered for
   a parameter and reflect the value in the choose
   list.  If it didn't change don't do anything.  
   prev_ix is the index of the parameter that the 
   new value corresponds to.

   Input Parameter: 
      p_item - select list entry correpsonding
      	       to this parameter.
---------------------------------------------------*/
PROCEDURE Save_Value:
   DEFINE INPUT PARAMETER p_item AS CHAR NO-UNDO.

   DEFINE VAR val      AS CHAR 	  NO-UNDO.
   DEFINE VAR new_item AS CHAR 	  NO-UNDO.

   /* Get the value from the appropriate input variable */
   IF arg_typ[prev_ix] = "c" THEN 
      val = arg_chr:SCREEN-VALUE IN FRAME pfedit.
   ELSE IF arg_typ[prev_ix] = "n" THEN DO:
      val = STRING(INPUT FRAME pfedit arg_int). /* this strips format chars */
      IF val = ? THEN val = "".
   END.
   ELSE  /* arg_typ[prev_ix] = "l" */
      val = arg_log:SCREEN-VALUE IN FRAME pfedit.

   /* only update if changed, to avoid wasted time and flashing */
   IF val <> arg_val[prev_ix] THEN DO:
      ASSIGN   
	 arg_val[prev_ix] = val
	 new_item = p_item
	 SUBSTR(new_item,{&VAL_START},{&VAL_CHARS}) = val
	 stat = plist:REPLACE(new_item, p_item) IN FRAME pfedit
      	 lst_val = new_item.

      /* REPLACE function removes selection.  Select list value will 
      	 be ? unless this leave trigger was caused by clicking on select 
      	 list.  If it is ?, restore selection.
      */
      if plist:SCREEN-VALUE IN FRAME pfedit = ? THEN
      	 plist:SCREEN-VALUE IN FRAME pfedit = new_item.
   END.
END.


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame pfedit
   or CHOOSE of btn_Help in frame pfedit
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Edit_Parameter_File_Dlg_Box},
      	       	     	     INPUT ?).

&ENDIF

/*----- VALUE CHANGED of PARAM LIST -----*/
ON VALUE-CHANGED OF plist IN FRAME pfedit
DO:
   DEFINE VAR pkey   AS CHAR NO-UNDO.
   DEFINE VAR val    AS CHAR NO-UNDO.

   /* See comment on define of variable */   
   lst_val = SELF:SCREEN-VALUE.

   /* We have a new selection so get new parm key (without the leading 
      "-") and get it's index in the list */
   ASSIGN
      pkey = TRIM(SUBSTR(lst_val, 2, {&PKEY_LEN} - 1))
      ix = LOOKUP(pkey, arg_lst)
      prev_ix = ix.  /* setup for next time around */

   /* Enable the appropriate widget for new choose */
   ASSIGN
      arg_chr:visible IN FRAME pfedit = 
   	    (IF arg_typ[ix] = "c" THEN yes ELSE no)
      arg_int:visible IN FRAME pfedit = 
   	    (IF arg_typ[ix] = "n" THEN yes ELSE no)
      arg_log:visible IN FRAME pfedit = 
   	    (IF arg_typ[ix] = "l" THEN yes ELSE no).

   /* Show current value in editing widget */
   val = TRIM(SUBSTR(lst_val, {&VAL_START}, {&VAL_CHARS})).

   IF arg_typ[ix] = "c" THEN 
      arg_chr:SCREEN-VALUE IN FRAME pfedit = val.
   ELSE IF arg_typ[ix] = "n" THEN DO:
      IF val = "" THEN val = ?.
      DISPLAY INTEGER(val) @ arg_int WITH FRAME pfedit.
   END.
   ELSE /* arg_typ[ix] = "l" */
      DISPLAY (val = tru_txt) @ arg_log WITH FRAME pfedit.
END.


/*----- ON LEAVE of EDITING VARIABLE (arg_xxx) -----*/
ON LEAVE OF arg_chr IN FRAME pfedit,
      	    arg_log IN FRAME pfedit,
      	    arg_int IN FRAME pfedit
   RUN Save_Value (INPUT lst_val).


/*----- ON HIT of OK BUTTON OR GO -----*/
ON CHOOSE OF btn_OK OR GO OF FRAME pfedit
DO:
   DEFINE VAR part AS CHAR    	       	     	NO-UNDO.
   DEFINE VAR temp AS CHAR    EXTENT {&COMM#}	NO-UNDO.
   DEFINE VAR done AS LOGICAL INIT false     	NO-UNDO.
   DEFINE VAR i    AS INTEGER 	       	     	NO-UNDO. /* for dictsplt.i */
   DEFINE VAR j    AS INTEGER 	       	     	NO-UNDO. /* for dictsplt.i */

   RUN Save_Value (INPUT lst_val).

   /* Translate editor widget contents into array elements.  This
      is more complicated than it should be!  We break wrapping
      lines at spaces in {&COMM_LEN} char chunks.  But if the user put in
      an explicit return we want to move to the next array element.
   */ 
   ASSIGN
      INPUT FRAME pfedit comment
      arg_comm# = 1
      arg_comm = "".

   DO WHILE NOT done:
      ix = INDEX(comment, CHR(10)).  /* index of the carriage return */
      IF ix > 0 THEN
      DO:   
      	 /* Set part to the info up to the carriage return.
      	    comment is reset to the remainder.
      	 */
	 IF ix = 1 THEN
	    part = "".
	 else
	    part = SUBSTR(comment, 1, ix - 1).

      	 /* On windows, lines have CR Line feed */
	 IF ix + 1 < LENGTH(comment) THEN
	    comment = SUBSTR(comment, ix + 1).
	 else
	    done = true.
      END.
      else DO:
      	 /* No more carriage returns. part is the rest of the string. */
	 part = comment.
	 done = true.
      END.   
   
      temp = "".  /* re-initialize */
      IF part <> "" THEN
      DO:
      	 /* This breaks part into {&COMM_LEN} char chunks and puts it in 
      	    temp array */
	 {prodict/dictsplt.i
	    &src = part
	    &dst = temp
	    &num = {&COMM#}
	    &len = {&COMM_LEN}
	    &chr = " "}
       END.
       
      /* Move temp into the next available slots in arg_comm. */
      DO ix = 1 TO {&COMM#} while temp[ix] <> "":
	 arg_comm[arg_comm#] = temp[ix].
	 arg_comm# = arg_comm# + 1.
      END.
   END.
END.

ON WINDOW-CLOSE OF FRAME pfedit
   APPLY "END-ERROR" TO FRAME pfedit.


/*============================Mainline code===============================*/

/* the PROGRESS default truth for logicals */
tru_txt = STRING(TRUE).  /* will automatically match language */

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
      &FRAME  = "FRAME pfedit" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
}

/* Fill the choose list with the parameters in the form:
   <Key>   <Desc>  <Value>  e.g., -B    Buffers   <value> 
*/
DO ix = 1 TO args#:
   stat = plist:ADD-LAST(STRING(arg_nam[ix], "x({&PNAME_LEN})") + 
      	       	     	 " " +
       	     	 STRING(arg_val[ix], "x({&VAL_CHARS})")) IN FRAME pfedit.
END.
/* Construct label string for list.  May have to adjust horizontal position
   a few pixels, to take account of the internal margin in the list widget*/
labelstr = STRING("Parameter", "X({&PKEY_LEN})") + " " +
           STRING("Description", "X({&PDESC_LEN})") + " " +
           "Current Value".
labelstr:FORMAT IN FRAME pfedit = "X(" + STRING(LENGTH(labelstr)) + ")".
labelstr:X IN FRAME pfedit = labelstr:X IN FRAME pfedit + 4.

/* Fill the comment editor widget from the arg_comm array. */
comment = "".
DO ix = 1 TO arg_comm#:
   comment = comment + arg_comm[ix] + (IF ix < arg_comm# THEN CHR(10) ELSE "").
END.

/* Position the integer and logical input widgets to where the 
   char widget is.  They will all overlap - only one will be 
   visible at a time.
*/
ASSIGN
   arg_chr:hidden IN FRAME pfedit = (IF arg_typ[1] = "c" THEN no ELSE yes)
   arg_int:hidden IN FRAME pfedit = (IF arg_typ[1] = "n" THEN no ELSE yes)
   arg_log:hidden IN FRAME pfedit = (IF arg_typ[1] = "l" THEN no ELSE yes)
   arg_chr:sensitive IN FRAME pfedit = yes
   arg_int:sensitive IN FRAME pfedit = yes
   arg_log:sensitive IN FRAME pfedit = yes.

ASSIGN
   plist = plist:ENTRY(1) IN FRAME pfedit
   prev_ix = 1.  /* Index of the choose before any value-changed event */

comment:WIDTH IN FRAME pfedit = plist:WIDTH IN FRAME pfedit.
DISPLAY labelstr plist comment WITH FRAME pfedit.
ENABLE plist comment btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME pfedit.

/* Cause 1st value to be reflected in editing widget. */
APPLY "VALUE-CHANGED" TO plist IN FRAME pfedit.

/* Have to reset tab positions manually because of invisible stuff.  
   Everthing after these will be pushed down automatically.
*/
ASSIGN
   ldummy = arg_chr:MOVE-AFTER-TAB-ITEM(plist:HANDLE IN FRAME pfedit).
   ldummy = arg_int:MOVE-AFTER-TAB-ITEM(arg_chr:HANDLE IN FRAME pfedit).
   ldummy = arg_log:MOVE-AFTER-TAB-ITEM(arg_int:HANDLE IN FRAME pfedit).

p_canned = TRUE.
DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   WAIT-FOR CHOOSE OF btn_OK IN FRAME pfedit OR GO OF FRAME pfedit.
   p_canned = FALSE.
END.




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------
   _guipick.p - flexible 'pick' program - based on _usrpick.p
   
   This supports 6 pick flavors:
      1. Choose 1 with no instructions
      2. Choose 1 with instructions
      3. Choose n where order doesn't matter with no instructions
      4. Choose n where order doesn't matter with instructions
      5. Choose n where order matters w/ SKIP option (no instructions)
      6. Choose n where order matters but w/o SKIP option (no instructions)

   input:
   pik_column - column position of frame   (NOT USED)
   pik_count  - number of elements in list
   pik_down   - iterations of down frame   (NOT USED)
   pik_hide   - hide frame when done?      (NOT USED)
   pik_init   - initial value for cursor   (NOT USED)
   pik_list   - list of elements       
   pik_multi  - can pick multiple?     
   pik_number - number the elements?       (only with pik_multi)
   pik_row    - row position of frame             (NOT USED)
   pik_skip   - use 'skip number' option   (only with pik_number)
   pik_title  - title of frame             (spaces prepended and appended)
   pik_wide   - use wide list              (NOT SUPPORTED)
   pik_text   - instructional text or ?

   output:
   pik_chosen - list of chosen element ids (i.e., array indexes)
   pik_first  - first element out or ?     (same as pik_list[pik_chosen[1]])
   pik_return - number of elements chosen
   
History
    hutegger    94/04/04    fix multiple selection-problem by first
                            emptying the list and then reinitialize it 
    gfs         94/06/15    Fixed select/unselect problem.
                            94-06-09-051
-------------------------------------------------------------------------*/
{ prodict/user/userhue.i }
{ prodict/user/userpik.i }
{ prodict/user/uservar.i }

/* Frame variables */
define var slist1   as char    NO-UNDO
   view-as SELECTION-LIST SINGLE   inner-chars 41 inner-lines 10
                 SCROLLBAR-V.
define var slist2   as char    NO-UNDO
   view-as SELECTION-LIST MULTIPLE inner-chars 37 inner-lines 12 
                 SCROLLBAR-V NO-DRAG.
define var nextlbl  as char    format "x(7)" NO-UNDO init "Next #:".
/*define var nextnum  as integer format ">>9"  NO-UNDO init 1.*/

define button btn_skip  label "&>".
define button btn_skipd label "&<".

/* Control variables */
define var instruct    as logical         NO-UNDO.  /* display instructions? */
define var ix          as integer         NO-UNDO.  /* generic loop index */
define var widg        as widget-handle NO-UNDO.  /* either slist1 or slist2 */
define var stat        as logical       NO-UNDO.
define var canned      as logical       NO-UNDO init TRUE.
define var last_choice as char          NO-UNDO init "". 
define var item        as char          NO-UNDO. /* select list item */
define var num         as integer       NO-UNDO. /* # value in list entry */

/* This frame is for single or multi-select but without
   the ordering option.  So you just get a straight select list.
*/
FORM
   SKIP({&TFM_WID})
   pik_text at 2 FORMAT "x(400)" 
          VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 40 SCROLLBAR-VERTICAL
   slist1   at ROW {&TFM_ROW} COLUMN 2 
   {prodict/user/userbtns.i}
   with frame pick 
   NO-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel SCROLLABLE
   VIEW-AS DIALOG-BOX THREE-D title pik_title.   

/* This frame is for pick multiple with the ordering option -
   with or without skip option.
*/
FORM
   SKIP({&TFM_WID})
   slist2   at 2 FONT 0  /* fixed font so columns line up */
   {prodict/user/userbtns.i}
   &IF "{&WINDOW-SYSTEM}" begins "MS-WIN" &THEN
      nextlbl  at row 2 col 58 VIEW-AS TEXT SPACE(1) SKIP
      nextnum  at 58 format ">>9" SPACE(1)                SKIP
      btn_skipd at 58 SPACE(1) btn_skip
   &ELSE
      nextlbl  at row 2 col 45 VIEW-AS TEXT SPACE(1) SKIP
      nextnum  at 45 format ">>9" SPACE(1)               SKIP
      btn_skipd at 45 SPACE(1) btn_skip 
   &ENDIF
   with frame pick_ordered 
   NO-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   VIEW-AS DIALOG-BOX title pik_title THREE-D.   

/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame pick
   or CHOOSE of btn_Help in frame pick
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT pik_help,
                                               INPUT ?).
on HELP of frame pick_ordered
   or CHOOSE of btn_Help in frame pick_ordered
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT pik_help,
                                               INPUT ?).
&ENDIF


/*----- GO or OK (frame pick) -----*/
on GO of frame pick
do:
   if slist1:multiple AND slist1:screen-value in frame pick = ? then
   do:
      message "Select at least one item or press Cancel."
                    view-as alert-box error buttons ok.
      return NO-APPLY.
   end.
end.


/*----- GO or OK (frame pick_ordered)-----*/
on GO of frame pick_ordered
do:
   if slist2:screen-value in frame pick_ordered = ? then
   do:
      message "Select at least one item or press Cancel."
                    view-as alert-box error buttons ok.
      return NO-APPLY.
   end.
end.


/*----- CHOOSE of SKIP BUTTON -----*/
on choose of btn_skip in frame pick_ordered
do:
   nextnum = nextnum + 1.
   display nextnum with frame pick_ordered.
end.

/*----- CHOOSE of SKIPD BUTTON -----*/
on choose of btn_skipd in frame pick_ordered
do:
   def var i  as int no-undo.
   def var z  as int no-undo.
   def var zz as int no-undo.
   
   do i = 1 to NUM-ENTRIES(last_choice):
     z = int(substring(entry(i,last_choice),34,-1,"character":U)).
     if z > zz then zz = z.
   end.
   if nextnum > 1 and (slist2:SCREEN-VALUE = ? OR nextnum > zz + 1) then nextnum = nextnum - 1.
   display nextnum with frame pick_ordered.
end.


/*----- LEAVE of NEXTNUM -----*/
on leave of nextnum in frame pick_ordered
   /* just to make it easier to use when we need it. */
   nextnum = INTEGER(SELF:screen-value).


/*----- VALUE-CHANGED of LIST 2 -----*/
on value-changed of slist2 in frame pick_ordered
do:
   define var chosen  as char    NO-UNDO. /* list of selected items */
   define var newitem as char    NO-UNDO. /* new value for item clicked on */
   define var rmvnum  as integer NO-UNDO. /* # value of entry just deselected */
   define var oldcnt  as integer NO-UNDO. /* number selected last time */
   define var newcnt  as integer NO-UNDO. /* number selected now */

   assign
      chosen = SELF:screen-value
      oldcnt = NUM-ENTRIES(last_choice)
      newcnt = NUM-ENTRIES(chosen).
   if oldcnt = ? then oldcnt = 0.      
   if newcnt = ? then newcnt = 0.

   if newcnt > oldcnt then
      /* Item was added to choose - mark it with the next #.  To
               find which one was just selected, see which one doesn't have
               a number appended on the end yet.
      */
      add_number:
      do ix = 1 to newcnt:
         item = ENTRY(ix, chosen).
         num = INTEGER(TRIM(SUBSTR(item,34,-1,"character":U))).

         if num = 0 then
         do: 
            newitem = STRING(item, "x(33)") + STRING(nextnum, ">>9").
            stat = slist2:replace(newitem, item) in frame pick_ordered. 
   
            /* since replace un-selects the item we have to re-establish
               the selection. So add the new guy to the last choice
                     and then reset the widget value.
                  */
            if last_choice = "" OR last_choice = ? then /* gfs mod */
               chosen = newitem.
            else
                chosen = last_choice + "," + newitem.
            assign        /* first clear selected-list to fool deselect- */
              SELF:screen-value in frame pick_ordered = "" /* automatism */
              SELF:screen-value in frame pick_ordered = chosen.
   
            nextnum = nextnum + 1.
                  if pik_skip then
               display nextnum with frame pick_ordered.
                  leave add_number.
         end.
      end.
   else do:
      /* Item was removed from selection.  First we have to find the one
               that was just clicked on.  To do this, run through the old list
               and see which item is no longer in the current chosen list.
               When we find it, remove the number from the select list entry.
      */
      find_clicked:
      do ix = 1 to oldcnt:
         item = ENTRY(ix, last_choice).
               if chosen = ? OR NOT CAN-DO(chosen,item) then 
               do:
                  newitem = SUBSTR(item,1,33,"character":U).
                  stat = slist2:replace(newitem, item) in frame pick_ordered.
                  leave find_clicked.
               end.
      end.

      /* For all still-selected items whose number is higher than
               the one just de-selected, decrement the number.
      */      
      rmvnum = INTEGER(TRIM(SUBSTR(item,34,-1,"character":U))).
      do ix = 1 to newcnt:
         item = ENTRY(ix, chosen).
               num = INTEGER(TRIM(SUBSTR(item,34,-1,"character":U))).
               if num > rmvnum then
               do:
                  num = num - 1.
            newitem = SUBSTR(item,1,33,"character":U) + STRING(num, ">>9").
                  stat = slist2:replace(newitem, item) in frame pick_ordered.
            chosen = replace(chosen,item,newitem).
               end.
      end.
      /* Refresh the choose */
      if chosen <> ? then
               slist2:screen-value in frame pick_ordered = chosen.
      nextnum = nextnum - 1.
      if pik_skip then
               display nextnum with frame pick_ordered.
   end.

   last_choice = chosen.  /* remembers the choose as of now */
end.


/*----- WINDOW-CLOSE ---------*/
ON WINDOW-CLOSE of frame pick
   APPLY "END-ERROR" to frame pick.

ON WINDOW-CLOSE of frame pick_ordered
   APPLY "END-ERROR" to frame pick_ordered.


/*=======================Internal Procedures==============================*/

/*----------------------------------------------------------------------------
Description:
   Given a frame, with an editor widget at the top, figure out the size of
   the editor widget so that it retains its width but takes up as many
   lines as needed (based on embedded ~n characters as line breaks).
   Assume that the editor widget is hidden at the moment, and that if it
   takes up any space at all (i.e. if there's actually any text in it),
   then every other widget in the frame has to move down by however
   high the editor is.

Input Parameters:
   p_Editor   - Widget-handle of fill-in widget at top of frame
   p_Width    - Width to make the editor when the dust settles.
----------------------------------------------------------------------------*/
PROCEDURE AdjustEditor.

DEFINE INPUT parameter p_Editor   AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT parameter p_Width    AS DECIMAL NO-UNDO.

DEFINE VARIABLE framewid AS WIDGET-HANDLE.
DEFINE VARIABLE num-lines AS INTEGER.
DEFINE VARIABLE next-line-break AS INTEGER.
DEFINE VARIABLE playtext AS CHARACTER.
DEFINE VARIABLE fldgrp AS WIDGET-HANDLE.
DEFINE VARIABLE grndchld AS WIDGET-HANDLE.
DEFINE VARIABLE htincr AS DECIMAL.

/*The following variable is used to trick the editor widget into realizing
itself; we need to do this (without actually making the editor visible) in
order to be able to ask it what its new height is: if we ask it before it
gets realized, it returns 0.  Dumb, dumb, dumb*/
DEFINE VARIABLE reallyEgregiousHack AS INTEGER.

playtext = p_Editor:SCREEN-VALUE.


IF playtext = "" OR playtext = ? 
THEN RETURN. /*No work to do*/

ELSE DO:
   ASSIGN
      framewid = p_Editor:FRAME
      num-lines = 1 /*Minimum*/
      next-line-break = INDEX(playtext, "~n").

   DO WHILE (next-line-break <> 0):
      ASSIGN
         num-lines =  num-lines + 1
         playtext = SUBSTRING(playtext, next-line-break,-1,"character":U).
      IF (playtext = "~n")
      THEN next-line-break = 0. /*Strange case with ~n at end of text*/
      ELSE ASSIGN
          playtext = SUBSTRING(playtext,2,-1,"character":U)
          next-line-break = INDEX(playtext, "~n").
   END.

   IF num-lines > 7 THEN DO: /*Have to turn on scrolling*/
      p_Editor:width = p_Editor:width - 2. /*So scrollbars don't make it too
                                              wide for its frame..yucko*/
      p_Editor:inner-lines = 7.
      &IF "{&WINDOW-SYSTEM}" begins "MS-WIN" &THEN
        framewid:row = 4.  /*original centering no longer valuable; on Motif,
                             this would move the dialog over to the left edge
                               of the screen, so leave as-is*/
      &ENDIF
   END.
   ELSE p_Editor:inner-lines = num-lines.

   ASSIGN
      reallyEgregiousHack = p_Editor:length
      htincr = p_Editor:height + {&VM_WIDG}
      &IF "{&WINDOW-SYSTEM}" begins "MS-WIN" &THEN
                htincr = htincr + .75 /*Need this correction, for some reason*/
      &ENDIF
      framewid:height = framewid:height + htincr
      p_Editor:WIDTH = p_Width.
   
   /*Move every other widget in the frame down*/
   fldgrp = p_Editor:PARENT.
   grndchld = fldgrp:FIRST-CHILD.
   DO WHILE (grndchld <> ?):
      IF (grndchld <> p_Editor)
      THEN grndchld:row = grndchld:row + htincr.
      grndchld = grndchld:NEXT-SIBLING.
   END.
END.
RETURN.
END PROCEDURE.


/*============================Mainline code===============================*/

/* Configure the frame we will use based on the pick options. */
assign
   pik_number  = pik_number AND pik_multi
   instruct    = (pik_text <> ?) AND (pik_text <> "") AND NOT pik_number
   pik_skip    = pik_skip AND pik_number
   nextnum     = 1.

if pik_multi AND NOT pik_number then 
   slist1:MULTIPLE in frame pick = yes.

if pik_number AND NOT pik_skip then
   /* Use frame pick_ordered without the skip stuff */
   assign
      frame pick_ordered:width-chars = slist2:width-chars + 3
      nextlbl:visible in frame pick_ordered = no
      nextnum:visible in frame pick_ordered = no
      btn_skip:visible in frame pick_ordered = no
      btn_skipd:visible in frame pick_ordered = no.
   
/* Fill the select list */
widg = (if pik_number then slist2:HANDLE in frame pick_ordered
                                   else slist1:HANDLE in frame pick). 
do ix = 1 to pik_count:
   stat = widg:add-last(pik_list[ix]).
end.
if NOT pik_multi THEN
   slist1 = slist1:ENTRY(1) in frame pick.

/* Adjust the graphical rectangle and the ok and cancel buttons */
if pik_number then
do:
   {adecomm/okrun.i  
        &FRAME  = "FRAME pick_ordered" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
   }
end.
else do:
   pik_text:read-only in frame pick = yes.
   IF instruct THEN DO:
       /*Uncover the editor and put the pik_text into it; move everything
         else down to make room.*/
       pik_text:screen-value in frame pick = pik_text.
       RUN AdjustEditor
           (INPUT pik_text:HANDLE in frame pick,
            INPUT slist1:WIDTH in frame pick).
   END.
   {adecomm/okrun.i  
        &FRAME  = "FRAME pick" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
   }
end.

if pik_skip then
   display nextlbl nextnum with frame pick_ordered.

pik_return = 0.
do ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   if pik_number then
      update slist2
             btn_skip when pik_skip
             btn_skipd when pik_skip
             btn_OK
             btn_Cancel
             {&HLP_BTN_NAME}
             with frame pick_ordered.
   else
      update slist1 pik_text
             btn_OK
             btn_Cancel
             {&HLP_BTN_NAME}
             with frame pick.

   /* Translate selected items (comma delimited list) into array of
      index values.  The items must be in the order they were chosen
      if the number option is used with skipped #s having corresponding 
      values of -1 stored in pik_chosen.  If the number option isn't used
      the 1st n array elements contain the index of the values chosen
      with these indices always in ascending order.
   */
   assign
      last_choice = widg:screen-value
      pik_chosen = -1. 
   do ix = 1 to NUM-ENTRIES(last_choice):
      item = ENTRY(ix, last_choice).
      if pik_number then
        num = INTEGER(TRIM(SUBSTR(item,34,-1,"character":U))).
      else 
        num = ix.
      pik_chosen[num] = widg:LOOKUP(item). /* index of this item */

      /* pik_return may be > than the number chosen if #s were skipped.
               It will be equal to the highest # assigned or the number of 
               items chosen if the number option isn't being used.
      */
      if num > pik_return then pik_return = num.
   end.
   canned = FALSE.
end.
pik_first = (IF pik_return > 0 AND pik_chosen[1] > 0
               then pik_list[pik_chosen[1]] else ?).

if canned then
   user_path = "".

if pik_number then
   hide frame pick_ordered no-pause.
else
   hide frame pick no-pause.
RETURN.






/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*------------------------------------------------------------------
   Editor for setting File and Field level Security.
   Author: Tony Lavinio, Laura Stern
   Input: user_env[9] - ro (read only) or rw (read/write)
   
   History:  D. McMann changed length of text fields to x(500)
             
             03/13/06 fernando Using temp-table instead of cache_file - bug 20050930-006.
             12/14/07 fernando Fixed example
             
-------------------------------------------------------------------*/
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }
/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 14 NO-UNDO INITIAL [
  /* 1*/ "You must be a Security Administrator to execute this function.",
  /* 2*/ "",  /* goes with 1 */
  /* 3*/ "You need Database Security Administrator privileges in the master",
  /* 4*/ "{&PRO_DISPLAY_NAME} DB which contains the schema of this database to continue.",
  /* 5*/ "You may not use this function with a blank userid.  This applies to",
  /* 6*/ "both the {&PRO_DISPLAY_NAME} DB and the specific foreign DB, if appropriate.",
  /* 7*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 8*/ "You can only alter security on SQL tables with GRANT and REVOKE.",
  /* 9*/ "", /* reserved */
  /*10*/ "You cannot change permissions to exclude yourself.",
  /*11*/ "Permissions for Table ",
  /*12*/ "", /* reserved */
  /*13*/ "There are no tables to set security on.",
  /*14*/ "Undo all changes made in this dialog box?"
].
/* use these statements to man-handle scoping */
IF FALSE THEN RELEASE _File.
IF FALSE THEN RELEASE _Field.
/* Form variables */
DEFINE VARIABLE tlist AS CHAR NO-UNDO
   VIEW-AS SELECTION-LIST SINGLE INNER-LINES 5 INNER-CHARS 32
   SCROLLBAR-V SCROLLBAR-H.
DEFINE VARIABLE flist AS CHAR NO-UNDO
   VIEW-AS SELECTION-LIST SINGLE INNER-LINES 5 INNER-CHARS 32
   SCROLLBAR-V SCROLLBAR-H LIST-ITEMS "".
DEFINE VARIABLE t_hidden AS LOGICAL NO-UNDO
   VIEW-AS TOGGLE-BOX.
 
DEFINE VARIABLE which AS CHAR NO-UNDO INITIAL "t"
   VIEW-AS RADIO-SET VERTICAL
   RADIO-BUTTONS "Permissions for Selected T&able", "t",
                 "Permissions for Selected F&ield", "f".
DEFINE VARIABLE can_lbl    AS CHAR NO-UNDO.
DEFINE VARIABLE can_read   AS CHAR NO-UNDO.
DEFINE VARIABLE can_write  AS CHAR NO-UNDO.
DEFINE VARIABLE can_create AS CHAR NO-UNDO.
DEFINE VARIABLE can_delete AS CHAR NO-UNDO.
DEFINE VARIABLE can_dump   AS CHAR NO-UNDO.
DEFINE VARIABLE can_load   AS CHAR NO-UNDO.
/* Miscellaneous */
DEFINE VARIABLE ans     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE msg-num AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE r-o     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE istrans AS LOGICAL INITIAL TRUE. /* (not no-undo!) */
DEFINE VARIABLE changed AS LOGICAL INITIAL NO    NO-UNDO.
DEFINE VARIABLE ix      AS INTEGER               NO-UNDO.
DEFINE VARIABLE stat    AS LOGICAL               NO-UNDO.
DEFINE VARIABLE tab_lbl AS CHAR INIT "&Tables:"  NO-UNDO.
DEFINE VARIABLE fld_lbl AS CHAR INIT "&Fields:"  NO-UNDO.
DEFINE VARIABLE msgSecu1 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 22 INNER-LINES 1 NO-UNDO.
DEFINE VARIABLE msgSecu2 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 7 INNER-LINES 5 NO-UNDO.
DEFINE VARIABLE msgSecu3 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 22 INNER-LINES 5 NO-UNDO.
DEFINE VARIABLE msgSecu4 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 27 INNER-LINES 3 NO-UNDO.
DEFINE VARIABLE cr AS CHAR NO-UNDO.
FORM
   SKIP({&TFM_WID})
   tab_lbl    NO-LABEL             AT 2     VIEW-AS TEXT
   fld_lbl    NO-LABEL             AT 41    VIEW-AS TEXT  SKIP({&VM_WID})
   tlist      NO-LABEL             AT 2                  
   flist      NO-LABEL             AT 41                  SKIP({&VM_WID})
   t_hidden   LABEL "&Show Hidden" AT 2
   which      NO-LABEL             AT 25              SKIP({&VM_WID})
   can_lbl    NO-LABEL             AT 2     FORMAT "x(73)" 
                                            VIEW-AS TEXT SKIP({&VM_WID})
   can_read   LABEL "Can-&Read"    {&STDPH_FILL} COLON 12 FORMAT "x(500)" 
    VIEW-AS FILL-IN SIZE 29 BY 1 SKIP({&VM_WID})
   can_write  LABEL "Can-&Write"   {&STDPH_FILL} COLON 12 FORMAT "x(500)" 
    VIEW-AS FILL-IN SIZE 29 BY 1 SKIP({&VM_WID})
   can_create LABEL "Can-&Create"  {&STDPH_FILL} COLON 12 FORMAT "x(500)" 
    VIEW-AS FILL-IN SIZE 29 BY 1 SKIP({&VM_WID})
   can_delete LABEL "Can-&Delete"  {&STDPH_FILL} COLON 12 FORMAT "x(500)" 
    VIEW-AS FILL-IN SIZE 29 BY 1 SKIP({&VM_WID})
   can_dump   LABEL "Can-Du&mp"    {&STDPH_FILL} COLON 12 FORMAT "x(500)" 
    VIEW-AS FILL-IN SIZE 29 BY 1 SKIP({&VM_WID})
   can_load   LABEL "Can-&Load"    {&STDPH_FILL} COLON 12 FORMAT "x(500)" 
    VIEW-AS FILL-IN SIZE 29 BY 1
   {prodict/user/userbtns.i}
   msgSecu1 NO-LABEL AT COLUMN 45 ROW-OF can_read + .1
   msgSecu2 NO-LABEL AT COLUMN 45 ROW-OF can_read + .7
   msgSecu3 NO-LABEL AT COLUMN 53 ROW-OF can_read + .7
   msgSecu4 NO-LABEL AT COLUMN 45 ROW-OF can_dump
   WITH FRAME secu THREE-D 
   CENTERED ATTR-SPACE SIDE-LABELS
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   VIEW-AS DIALOG-BOX TITLE "Edit Data Security".
cr = chr(10).
ASSIGN msgSecu1:SCREEN-VALUE = 
   "Permission Examples:".
ASSIGN msgSecu2:SCREEN-VALUE = 
   "" + cr +
   "*" + cr +
   "!u1,*" + cr +
   "ab*" + cr +
   "".
ASSIGN msgSecu3:SCREEN-VALUE = 
   "" + cr +
   "= All Users" + cr +
   "= All Except u1" + cr +
   "= All Beginning ~"ab~"" + cr +
   "".
ASSIGN msgSecu4:SCREEN-VALUE = 
   "Note: Spaces used in the"  + cr +
   "permission string will be" + cr +
   "taken literally.".
msgSecu1:READ-ONLY = yes.
msgSecu2:READ-ONLY = yes.
msgSecu3:READ-ONLY = yes.
msgSecu4:READ-ONLY = yes.
   
/* Added to support selection list label mnemonics (tomn 8/1/95) */
ASSIGN
  tlist:SIDE-LABEL-HANDLE IN FRAME secu = tab_lbl:HANDLE
  tlist:LABEL = tab_lbl
  flist:SIDE-LABEL-HANDLE IN FRAME secu = fld_lbl:HANDLE
  flist:LABEL = fld_lbl.
  
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/
/*========================Internal Procedures=============================*/
/*--------------------------------------------------------------------
   Show security information on the selected table or field.
   The buffer _File is filled.  _Field may or may not have a record.
---------------------------------------------------------------------*/
PROCEDURE Show_Secu:
   can_lbl = new_lang[11] + 
             (IF AVAILABLE (_File) THEN _File._File-name ELSE "").
   if which = "t" THEN DO:
     IF AVAILABLE (_File) THEN DO:
     IF NOT r-o THEN
        ASSIGN
           Can_Create:sensitive IN FRAME secu = yes
           Can_Delete:sensitive IN FRAME secu = yes
           Can_Dump:sensitive IN FRAME secu = yes
           Can_Load:sensitive IN FRAME secu = yes.
             
      DISPLAY _File._Can-Read    @ Can_Read
          _File._Can-Write   @ Can_Write
          _File._Can-Create  @ Can_Create
          _File._Can-Delete  @ Can_Delete
          _File._Can-Dump    @ Can_Dump
          _File._Can-Load    @ Can_Load
          WITH FRAME secu.
     END.
     ELSE
     DISPLAY "" @ Can_Read
         "" @ Can_Write
         "" @ Can_Create
         "" @ Can_Delete
         "" @ Can_Dump
         "" @ Can_Load
         WITH FRAME secu.
   END.
   ELSE DO: /* which = "f" */
      ASSIGN
         can_lbl = can_lbl + "." + 
                   (IF AVAILABLE _FIELD THEN _Field._Field-name ELSE "")
         Can_Create:sensitive IN FRAME secu = no
         Can_Delete:sensitive IN FRAME secu = no
         Can_Dump:sensitive IN FRAME secu = no
         Can_Load:sensitive IN FRAME secu = no.
      DISPLAY "" @ Can_Create
              "" @ Can_Delete
              "" @ Can_Dump
              "" @ Can_Load
              WITH FRAME secu.
      IF AVAILABLE _Field THEN 
         DISPLAY _Field._Can-Read   @ Can_Read
                 _Field._Can-Write  @ Can_Write
                 WITH FRAME secu.
      ELSE 
         DISPLAY "" @ Can_Read
                 "" @ Can_Write
                 WITH FRAME secu.
   END.
   can_lbl = can_lbl + ":".
   DISPLAY can_lbl WITH FRAME secu.
END.
/*--------------------------------------------------------------------
   A new table has been chosen.  This is called after we've saved
   info for the current table to set up everything based on the new
   table chosen.
   Input Parameter:
      p_Tbl - the newly chosen table name
---------------------------------------------------------------------*/
PROCEDURE Next_Table:
   DEFINE INPUT PARAMETER p_Tbl AS CHAR NO-UNDO.
   IF t_hidden THEN
      FIND _File WHERE _File._Db-recid = drec_db AND
               _File._File-name = p_Tbl NO-ERROR.
   ELSE
      FIND _File WHERE _File._Db-recid = drec_db AND
               _File._File-name = p_Tbl AND
               NOT _File._Hidden NO-ERROR.
   IF AVAILABLE(_File) THEN DO:
      user_filename = _File._File-name.
      drec_file = RECID(_File).
      DISPLAY user_filename WITH FRAME user_ftr.
   END.
   ELSE DO:
      user_filename = "".
      drec_file = ?.
   END.
   /* If setting field permissions, refill the field list for this tbl */
   IF which = "f" THEN
      RUN Get_Fields.
   RUN Show_Secu.
END.
/*--------------------------------------------------------------------
   Fill the field list.
---------------------------------------------------------------------*/
PROCEDURE Get_Fields:
   flist:LIST-ITEMS IN FRAME secu = "".  /* clear the list */
   IF drec_file = ? THEN DO:
      RELEASE _Field.
      RETURN.
   END.
   RUN "adecomm/_fldlist.p" (INPUT flist:HANDLE IN FRAME secu,
                            INPUT drec_file,
                INPUT true,
                INPUT "",
                            INPUT ?,
                INPUT false,
                INPUT "",
                OUTPUT ans).
   flist = flist:ENTRY(1) IN FRAME secu.
   IF flist = ? THEN flist = "".
   flist:SCREEN-VALUE IN FRAME secu = flist.
   FIND _Field of _File WHERE _Field._Field-name = flist NO-ERROR.
END.
/*--------------------------------------------------------------------
   Save the information for this table or field in the database.
   
   Returns "error" if information is invalid, otherwise "".
   (In case of error, message is displayed here)
---------------------------------------------------------------------*/
PROCEDURE Save_Info:
   DEFINE VAR err as LOGICAL NO-UNDO INIT no.
   DEFINE VAR mod as LOGICAL NO-UNDO INIT no. 
   /* Read only - nothing to do. */
   if r-o OR NOT AVAILABLE(_File) THEN RETURN "".
   /* Side case - we're in field mode but there are no fields. Just
      don't do anything.*/
   IF which = "f" AND NOT AVAILABLE _Field THEN RETURN "".
   ASSIGN
      INPUT FRAME secu Can_Read
      INPUT FRAME secu Can_Write
      INPUT FRAME secu Can_Create
      INPUT FRAME secu Can_Delete
      INPUT FRAME secu Can_Dump
      INPUT FRAME secu Can_Load.
   /* mod will be yes if there were any modifications made */
   IF which = "t" THEN DO:
      IF Can_Read <> _File._Can-read THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Read ,USERID("DICTDB")) THEN err = yes.
      END.
      IF NOT err AND Can_Write <> _File._Can-write THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Write ,USERID("DICTDB")) THEN err = yes.
      END.
      IF NOT err AND Can_Create <> _File._Can-Create THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Create ,USERID("DICTDB")) THEN err = yes.
      END.
      IF NOT err AND Can_Delete <> _File._Can-Delete THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Delete ,USERID("DICTDB")) THEN err = yes.
      END.
      IF NOT err AND Can_Dump <> _File._Can-Dump THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Dump ,USERID("DICTDB")) THEN err = yes.
      END.
      IF NOT err AND Can_Load <> _File._Can-load THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Load ,USERID("DICTDB")) THEN err = yes.
      END.
      IF mod AND NOT err AND _File._Db-lang = 0 /* NOT SQL */ THEN
         ASSIGN
            _File._Can-Read   = Can_Read
            _File._Can-Write  = Can_Write
            _File._Can-Create = Can_Create
            _File._Can-Delete = Can_Delete
            _File._Can-Dump   = Can_Dump
            _File._Can-Load   = Can_Load.
   END.
   ELSE DO: /* which = "f" */
      IF Can_Read <> _Field._Can-read THEN DO:
         mod = yes.
         IF NOT CAN-DO(Can_Read ,USERID("DICTDB")) THEN err = yes.
      END.
      IF NOT err AND Can_Write <> _Field._Can-write THEN DO:
         mod = yes.
     IF NOT CAN-DO(Can_Write ,USERID("DICTDB")) THEN err = yes.
      END.
   
      IF mod AND NOT err AND _File._Db-lang = 0 /* NOT SQL */ THEN
     ASSIGN
        _Field._Can-Read  = Can_Read
        _Field._Can-Write = Can_Write.
   END.
   IF mod AND _File._Db-lang <> 0 THEN DO:
     MESSAGE new_lang[8] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     RETURN "error".
   END.
   IF err THEN DO:
      MESSAGE new_lang[10] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN "error".
   END.
   changed = changed OR mod.
   RETURN "".
END.
/*===============================Triggers=================================*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame secu
   or CHOOSE of btn_Help in frame secu
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Edit_Data_Security_Dlg_Box},
                             INPUT ?).
&ENDIF
/*----- ON HIT of CANCEL BUTTON or ENDKEY -----*/
ON CHOOSE OF btn_Cancel IN FRAME secu OR ENDKEY OF FRAME secu
DO:
   IF NOT changed THEN RETURN.  
   ans = yes.
   MESSAGE new_lang[14] /* Are you sure */
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE ans.
   IF NOT ans THEN
      RETURN NO-APPLY.
   ELSE
      changed = no.  /* reset */
END.
/*----- ON HIT of OK BUTTON or GO -----*/
ON CHOOSE OF btn_OK IN FRAME secu OR GO OF FRAME secu
DO:
   RUN Save_Info.
   IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
END.
/*----- ON VALUE-CHANGED of TABLE -----*/
ON VALUE-CHANGED OF tlist IN FRAME secu
DO:
   RUN Save_Info.
   IF RETURN-VALUE = "error" THEN DO:
      /* Return no-apply should prevent the value change but it 
         doesn't because in this case the widget already 
         processed the event.  So I have to do it myself.
      */
      tlist:SCREEN-VALUE IN FRAME secu = _File._File-name.
      RETURN NO-APPLY.
   END.
   RUN Next_Table (INPUT SELF:SCREEN-VALUE).
END.
/*----- ON VALUE-CHANGED of FIELD -----*/
ON VALUE-CHANGED OF flist IN FRAME secu
DO:
   RUN Save_Info.
   IF RETURN-VALUE = "error" THEN DO:
      /* Return no-apply should prevent the value change but it 
         doesn't because in this case the widget already 
         processed the event.  So I have to do it myself.
      */
      flist:SCREEN-VALUE IN FRAME secu = _Field._Field-name.
      RETURN NO-APPLY.
   END.
   FIND _Field of _File WHERE _Field._Field-name = SELF:SCREEN-VALUE.
   RUN Show_Secu.
END.
/*----- ON VALUE-CHANGED of SHOW-HIDDEN TOGGLE -----*/
ON VALUE-CHANGED OF t_hidden IN FRAME secu
DO:
   DEFINE VAR tbl AS CHAR NO-UNDO.
   RUN Save_Info. /* Save for current table selection */
   IF RETURN-VALUE = "error" THEN DO:  
      /* Return no-apply should prevent the value change but it 
         doesn't because in this case the widget already 
         processed the event.  So I have to do it myself.
      */
      t_hidden:SCREEN-VALUE IN FRAME secu = 
         (IF SELF:SCREEN-VALUE = "no" THEN "yes" ELSE "no").
      RETURN NO-APPLY.
   END.
   t_hidden = INPUT FRAME secu t_hidden.
   /* Re-fill the list with or without hidden tables. */
   tlist:LIST-ITEMS IN FRAME secu = "".  /* Clear first */
   run "prodict/_dctcach.p" (t_hidden).
   /* 20050930-006 - check if we are caching the table names in the temp-table */
   IF l_cache_tt THEN DO:
       FOR EACH tt_cache_file NO-LOCK:
           stat = tlist:ADD-LAST(tt_cache_file.cName) in frame secu.
       END.
   END.
   ELSE do ix = 1 to cache_file#:
      stat = tlist:ADD-LAST(cache_file[ix]) in frame secu.
   end.
   /* Don't try to keep the same selection they had.  Just set to 1st entry. */
   tbl = tlist:ENTRY(1) IN FRAME secu.
   tlist:SCREEN-VALUE IN FRAME secu = tbl.
   RUN Next_Table (INPUT tbl).
END.
/*----- ON VALUE-CHANGED of which (RADIO SET) -----*/
ON VALUE-CHANGED OF which IN FRAME secu
DO:
   RUN Save_Info.
   IF RETURN-VALUE = "error" THEN DO:
      /* Return no-apply should prevent the value change but it 
         doesn't because in this case the widget already 
         processed the event.  So I have to do it myself. 
      */
      which:SCREEN-VALUE IN FRAME secu = 
         (IF SELF:SCREEN-VALUE = "f" THEN "t" ELSE "f").
      RETURN NO-APPLY.
   END.   
   which = SELF:SCREEN-VALUE.  /* to avoid having to refer to frame value */
   IF SELF:SCREEN-VALUE = "f" THEN DO:
      flist:sensitive IN FRAME secu = yes.
      RUN Get_Fields.
   END.
   ELSE DO:
      flist:LIST-ITEMS IN FRAME secu = "". /* clear the list */
      flist:sensitive IN FRAME secu = no.
   END.
   RUN Show_Secu.
END.
/*----- ON WINDOW-CLOSE -----*/
ON WINDOW-CLOSE OF FRAME secu
   APPLY "END-ERROR" TO FRAME secu.
/*=============================Mainline Code==============================*/
DO ON ERROR UNDO:
  istrans = FALSE.
  UNDO,LEAVE.
END.
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ENABLE msgSecu1 msgSecu2 msgSecu3 msgSecu4 WITH FRAME secu.
&ENDIF
RUN "prodict/_dctadmn.p" (INPUT USERID("DICTDB"),OUTPUT ans).
IF NOT ans               THEN msg-num = 1. /* secu admin? */
IF NOT ans AND user_dbtype <> "PROGRESS"
                         THEN msg-num = 3. /* secu admn in pro db */
IF USERID("DICTDB") = "" THEN msg-num = 5. /* userid set? */
IF msg-num <> 0 THEN DO:
  MESSAGE new_lang[msg-num] SKIP
          new_lang[msg-num + 1] 
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.
r-o = user_env[9] = "ro".
IF (istrans
    OR PROGRESS = "Run-Time"
    OR CAN-DO("READ-ONLY",DBRESTRICTIONS(user_dbname)) 
    OR dict_rog) THEN 
   r-o = TRUE.
/* Should we put read-only status in a status line? */
/* Fill in the cache of file names if not done already or refill if
   cache is dirty.
*/
if cache_dirty then do:
   /* if current table is schema table, then include them by default */
   t_hidden = (IF user_filename BEGINS "_" then yes else no).
   run "prodict/_dctcach.p" (t_hidden).
end.
else do: /* determine if cache contains hidden tables */
   /* 20050930-006 - check if we are caching the table names in the temp-table */
   IF l_cache_tt THEN DO:
       FIND FIRST tt_cache_file WHERE tt_cache_file.cName BEGINS "_" NO-LOCK NO-ERROR.
       t_hidden = (AVAILABLE tt_cache_file).
   END.
   ELSE DO:
        do ix = 1 to cache_file# while NOT cache_file[ix] BEGINS "_":
        end.
        t_hidden = (cache_file[ix] BEGINS "_").
   END.
end.
/* Initialize the table select list and it's initial values. If there isn't
   already a current table, then set to first one.  
*/
IF (user_filename <> ""     AND 
    user_filename <> "SOME" AND
    user_filename <> "ALL") THEN 
DO:
   tlist = user_filename.  /* initialize to current table */
   FIND _File WHERE RECID(_File) = drec_file.
END.
ELSE DO:
   /* Set current table name */
   tlist = (if cache_file# > 0 then cache_file[1] else "").
   /* 20050930-006 - check if cached info is in the temp-table */
   IF cache_file# > 0 AND l_cache_tt THEN DO:
       FIND FIRST tt_cache_file NO-LOCK.
       tlist = tt_cache_file.cName.
   END.
   user_filename = tlist.
   IF user_filename <> "" THEN DO:
      FIND _File WHERE _File._File-name = user_filename AND 
         _File._Db-recid = drec_db.
      drec_file = RECID(_File).
      DISPLAY user_filename WITH FRAME user_ftr.
   END.
   ELSE drec_file = ?.
END.
/* 20050930-006 - check if cached info is in the temp-table */
IF l_cache_tt THEN DO:
    FOR EACH tt_cache_file NO-LOCK:
       stat = tlist:ADD-LAST(tt_cache_file.cName) IN FRAME secu.
    END.
END.
ELSE DO ix = 1 TO cache_file#:
   stat = tlist:ADD-LAST(cache_file[ix]) IN FRAME secu.
END.
RUN "adecomm/_scroll.p" (INPUT tlist:HANDLE IN FRAME secu,
                         INPUT user_filename).
/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME secu" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}
/* Field list starts out disabled and empty. We disable it later after
   it's tab order is set by ENABLE. 
*/
flist:LIST-ITEMS IN FRAME secu = "".
RUN Show_Secu.  /* show current table info */
DISPLAY tlist flist t_hidden which WITH FRAME secu.
DO TRANSACTION ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   ENABLE
      tlist 
      flist
      t_hidden
      which
      can_read    when NOT r-o
      can_write   when NOT r-o
      can_create  when NOT r-o AND which = "t"
      can_delete  when NOT r-o AND which = "t" 
      can_dump    when NOT r-o AND which = "t" 
      can_load    when NOT r-o AND which = "t" 
      btn_OK      when NOT r-o
      btn_Cancel
      {&HLP_BTN_NAME}
      WITH FRAME secu THREE-D.
   
   flist:sensitive IN FRAME secu = no.
   WAIT-FOR CHOOSE OF btn_OK IN FRAME secu OR GO OF FRAME secu.
END.
HIDE MESSAGE NO-PAUSE.
RETURN.

/*********************************************************************
* Copyright (C) 2006,2010 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _guisget.p  ("s" is for schema)
 
Description: Select one of the connected databases (if "dis" or "get")
      	     and switch to it as the current working database.

INPUT:
   user_env[1] = "dis" - this program disconnects a database
   user_env[1] = "new" - user just connected to a database - this may be
      	       	     	 the first database connected.
   user_env[1] = "get" - user wants to choose a database to work with
   user_env[1] = "sys" - dictionary forcing user to pick a database

Author: Tony Lavinio, Laura Stern

History:
    laurief     97/12/18    Made V8 to "generic version" changes
    laurief     97/05/12    Changed 2 messages to alert boxes. (95-09-27-025)
    hutegger    95/09/22    made V7 -> V8 changes
    hutegger    94/05/05    "automatically get select-dialogbox after
                            connecting to an n. db (n > 1)" was switched
                            off; I switched it on again. 
    hutegger    94/05/05    I inserted an extention of user_path in case
                            there are more then 1 db left after disconnect
                            1. commit transaction; 
                            2. call this routine again
    D. McMann   02/21/03    Replaced GATEWAYS with DATASERVERS
    fernando    02/17/06    Handle V9 db's - don't let user select them - 20050510-008
    fernando    9/30/10     OE11 support
----------------------------------------------------------------------------*/
/* This whole file should be used only on GUI, but in case it gets compiled
for TTY mode, let's just turn it into a big empty file */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN


{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE answer AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE choice AS INTEGER   INITIAL ?     NO-UNDO.
DEFINE VARIABLE dbpick AS CHARACTER               NO-UNDO.
DEFINE VARIABLE i      AS INTEGER                 NO-UNDO.
DEFINE VARIABLE j      AS INTEGER   INITIAL 0     NO-UNDO.
DEFINE VARIABLE is_dis AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE look   AS LOGICAL   INITIAL FALSE NO-UNDO.
/* old_db is index of currently selected database; user_dbname is it's name */
DEFINE VARIABLE old_db AS INTEGER   INITIAL ?     NO-UNDO. 
DEFINE VARIABLE oldbs  AS INTEGER   INITIAL 0     NO-UNDO.
DEFINE VARIABLE olname AS CHARACTER               NO-UNDO.
DEFINE NEW GLOBAL SHARED VARIABLE fast_track AS LOGICAL. /* FT active? */

/* Frame stuff */
DEFINE VARIABLE lsthead	AS CHAR	 NO-UNDO.
DEFINE VARIABLE dlist  	AS CHAR  NO-UNDO.

/* Miscelaneous */
DEFINE VARIABLE ix     	AS INTEGER   NO-UNDO. /* temp loop index */
DEFINE VARIABLE stat   	AS LOGICAL   NO-UNDO.
DEFINE VARIABLE item    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cancel  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE version AS CHARACTER NO-UNDO.


/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 23 NO-UNDO INITIAL [
  /*  1*/ "Are you sure that you want to disconnect database",
  /*  2*/ "Nothing was disconnected.",
  /*  3*/ "Cannot disconnect a database if it is not connected.",
  /*  4*/ "has been disconnected.",
  /*5,6*/ "There are only", "databases connected.  Please use the",
  /*7,8*/ "dictionary from", "OpenEdge to view/edit these databases.",
  /*  9*/ "ERROR! Database type inconsistency in _usrsget.p",
/*10,11*/ "Database", "is not connected.", /* used with 18 */
  /* 12*/ "You must select a current working database at this time.",
  /* 13*/ "is the only database connected - it is already selected.",
  /* 14*/ "You have been automatically switched to database",
/*15,16,17*/ "This", "tool can't be used with a OpenEdge", "database.",
  /* 18*/ "There are no databases connected to select!",
  /* 19*/ "This copy of OpenEdge does not support database type",
  /* 20*/ "There are no databases connected for you to disconnect.",
  /* 21*/ "You have to leave Fast Track before disconnecting a database",
  /* 22*/ "Would you like to connect it?",
  /* 23*/ "is the only selectable database connected - it is already selected."
].
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

&GLOBAL-DEFINE LSTHEAD_AT 2.3

FUNCTION isOlderDBVersion RETURNS LOGICAL (INPUT pos AS INTEGER) FORWARD.


FORM
/*---TTY layout 05/11/93 -------------------------------------------------
  SKIP(1)
  lsthead   AT 4  FORMAT "x(73)"     	      	      SKIP
  dlist     AT 1  VIEW-AS SELECTION-LIST SINGLE 
      	          INNER-CHARS 75 INNER-LINES 3
      	       	  SCROLLBAR-V 	        	      SKIP(1)
-----------------------------------------------------------------------*/
  SKIP({&TFM_WID})
  lsthead   AT {&LSTHEAD_AT}  FORMAT "x(73)" SKIP({&VM_WID})
  dlist     AT 2  VIEW-AS SELECTION-LIST SINGLE 
      	          INNER-CHARS 73 INNER-LINES 3
      	       	  SCROLLBAR-V
  {prodict/user/userbtns.i}
  WITH FRAME schema_stuff USE-TEXT 
       NO-LABELS CENTERED DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       SCROLLABLE FONT 0  /* use fixed pitch font */
       VIEW-AS DIALOG-BOX 
       TITLE "Select " + 
	      TRIM(STRING(is_dis,"Database to Disconnect/Working Database")).



/*==============================Triggers================================*/

/*----- HELP -----*/
on HELP of frame schema_stuff or CHOOSE of btn_Help in frame schema_stuff
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Select_Database_Dlg_Box},
      	       	     	     INPUT ?).


/*----- ON ANY PRINTABLE (ASCII) of DLIST -----*/
/*----- Do 1st letter navigation (only Motif doesn't do it natively -----*/


/*----- GO or OK -----*/
on GO of frame schema_stuff
do:
   if NOT is_dis then
   do:
      item = dlist:screen-value IN FRAME schema_stuff.
      choice = dlist:LOOKUP(item) IN FRAME schema_stuff.
      if isOlderDBVersion(choice)
      then do:
      	 message new_lang[15] PROVERSION new_lang[16] 
      	   /*version*/ ("R" + DBVERSION(cache_db_s[choice]))
          new_lang[17] /* cannot use V5/V6/V7/V8 db */
      	    view-as alert-box error buttons ok.
      	 return NO-APPLY.
      end.
   end.
end.


/*----- DEFAULT-ACTION of SELECT LIST-----*/
on default-action of dlist in frame schema_stuff 
   apply "GO" to frame schema_stuff.


/*----- WINDOW-CLOSE -----*/
on WINDOW-CLOSE of frame schema_stuff
    apply "END-ERROR" to frame schema_stuff.


/*=============================Mainline Code=============================*/

is_dis = user_env[1] = "dis".

IF is_dis AND NUM-DBS = 0 THEN DO:
  MESSAGE new_lang[20]  /* ain't nothin' to disconnect */
    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  user_path = "".
  RETURN.
END.

RUN "prodict/_dctsget.p".

IF is_dis THEN DO: /* removed unconnected items from list */
  DO i = 1 TO cache_db#:
    IF CONNECTED(cache_db_l[i]) THEN ASSIGN
      j             = j + 1
      cache_db_e[j] = cache_db_e[i]
      cache_db_l[j] = cache_db_l[i]
      cache_db_p[j] = cache_db_p[i]
      cache_db_s[j] = cache_db_s[i]
      cache_db_t[j] = cache_db_t[i].
  END.
  cache_db# = j.
END.

DO i = 1 TO cache_db#:
  IF cache_db_l[i] = user_dbname AND old_db = ? THEN old_db = i.
  IF  isOlderDBVersion(i)  THEN oldbs = oldbs + 1.
   version = "R" + DBVERSION(cache_db#).
END.

ASSIGN
  cache_dirty = TRUE.

IF cache_db# = oldbs AND oldbs > 0 THEN DO:
  IF NOT is_dis THEN
    MESSAGE new_lang[5] version new_lang[6] SKIP
      new_lang[7] version new_lang[8] /* only non-V9 dbs connected */
            VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  look = TRUE.
END.
IF cache_db# = 0 OR cache_db# = oldbs THEN DO:
  ASSIGN
    user_path     = ""
    user_dbname   = ""
    user_dbtype   = ""
    user_filename = "".
  DISPLAY user_dbname user_filename WITH FRAME user_ftr.
  IF CAN-DO("get,new",user_env[1]) AND oldbs = 0 THEN
    MESSAGE new_lang[18] /* no dbs connected */
      VIEW-AS ALERT-BOX ERROR BUTTONS OK. 
  if NOT (look AND is_dis) THEN RETURN.
END.

/* <hutegger> 94/05/05 user should be automatically prompted to select */
/* the current working db, if there are more then 1 db's connected     */
/*
IF old_db <> ? AND user_env[1] = "new" THEN
  choice = old_db.
ELSE
*/

IF cache_db# = 1 AND NOT look THEN DO:
  choice = 1.
  
  IF user_env[1] = "get" THEN 
    MESSAGE cache_db_l[1] new_lang[13] /* only 1 db to choose */
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
      
  IF cache_db_l[1] <> olname AND
    (user_env[1] = "new"
    OR (user_env[1] = "sys" AND user_dbname <> cache_db_l[1])) THEN
    MESSAGE new_lang[14] '"' + cache_db_l[1] + '"'. /* auto-switch to db... */
END.
ELSE IF ((cache_db# - oldbs) = 1) AND NOT look THEN DO:

  /* check if we only have one db that can be selected, for instance, if you have
     a db from an older version and a db from the current release, then you can only
     select the current version db. We do that only if the user is trying to select
     a different database, or it's a db that just got connected.
  */
  IF (user_env[1] = "get" AND user_dbname <> "") OR user_env[1] = "new" THEN DO:
     /* there is only 1 db that can be selected - find out which one */      
     choice = 1.

     DO WHILE isOlderDBVersion(choice) AND choice <= cache_db#:
           choice = choice + 1.
     END.
    
     /* message is only needed if the user is trying to select a db */
     IF user_env[1] = "get" THEN
         MESSAGE cache_db_l[choice] new_lang[23] /* only 1 selectable db */
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  END.
  
END.

IF choice = ? THEN
DO:
    /* Adjust the graphical rectangle and the ok and cancel buttons */
   {adecomm/okrun.i  
      &FRAME  = "FRAME schema_stuff" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
   }

   /* Setup header line for select list */
   lsthead = STRING("Logical Name",    "x(14)") +
	     STRING("Physical Name",   "x(28)") +
	     STRING("Type",            "x(12)") +
	     STRING("Schema Holder",   "x(15)") +
	     STRING("Conn",            "x(4)").
   
   /* Fill the select list of dbs with values from the cache. */
   DO ix = 1 TO cache_db#:
   
      item = (STRING(SUBSTR(cache_db_l[ix],1,13,"character"), "x(14)") + 
	      STRING(IF cache_db_p[ix] = ? 
      	       	     	THEN "" 
      	       	        ELSE SUBSTR(cache_db_p[ix],1,27,"character"), "x(28)") +
	      STRING(cache_db_e[ix], "x(12)") +
	      STRING(SUBSTR(cache_db_s[ix],1,14,"character"), "x(15)") +
	      STRING(CONNECTED(cache_db_l[ix]), "yes/no")).
      stat = dlist:ADD-LAST(item) IN FRAME schema_stuff.
      IF cache_db_l[ix] = user_dbname THEN
	 dlist = item.  /* This will be the default choose */
   END.
   if dlist = "" OR dlist = ? then
      dlist = dlist:ENTRY(1) IN FRAME schema_stuff.
   
   DISPLAY lsthead WITH FRAME schema_stuff.
   cancel = yes.
   DO ON ENDKEY UNDO, LEAVE:
      UPDATE dlist btn_OK btn_Cancel btn_Help WITH FRAME schema_stuff.
      choice = dlist:LOOKUP(dlist) IN FRAME schema_stuff.
      cancel = no.
   END.
   IF choice = ? THEN choice = old_db.
END.

IF cancel THEN DO:
   user_path = "".
   HIDE FRAME schema_stuff NO-PAUSE.
   RETURN.
END.
dbpick = cache_db_l[choice].

IF is_dis THEN _discon: DO: /*-----------------------------*/ /* disconnect */
  answer = FALSE.
  MESSAGE new_lang[1] + ' "' + dbpick + '"?' 
    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
  IF NOT answer THEN DO:
    MESSAGE new_lang[2] VIEW-AS ALERT-BOX. /* nothing disconnected */
    user_path = "".
    LEAVE _discon.
  END.
  /* If dictionary was started from Fast Track, return here.     */
  /* (Disconnecting within Fast Track doesn't make sense because */
  /* file-caching is done at startup-time when ft.p is run.      */
  IF fast_track THEN DO:
    MESSAGE new_lang[21] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    PAUSE.
    RETURN.
  END.
  DISCONNECT VALUE(dbpick).
  RUN "prodict/_dctsget.p". /* recache list */
  MESSAGE dbpick new_lang[4] VIEW-AS ALERT-BOX. /* disconnected */
  IF  (        user_dbname  = dbpick 
    OR SDBNAME(user_dbname) = dbpick )
    THEN DO:
    ASSIGN
      user_dbname   = ""
      user_dbtype   = ""
      user_filename = "".

    /* recount the residing db's:                                   */
    /* if disconnecting a shemaholder, then don't count NEITHER the */
    /* schemaholder NOR its schemas; else don't count only the      */
    /* disconnected db                                              */
    ASSIGN j = 0.
    DO i = 1 TO cache_db#:
      IF  ( cache_db_l[i] <> dbpick
        OR  cache_db_t[i] <> "PROGRESS" )
        AND cache_db_s[i] <> dbpick AND
        NOT isOlderDBVersion(i)       
        THEN j = j + 1.
    END.

    if j > 1 then assign user_path = "*C,1=get,_guisget" + user_path.
    DISPLAY user_dbname user_filename WITH FRAME user_ftr.
  END.
END. /*---------------------------------------------------------------------*/
ELSE
DO: /*---------------------------------------------------------*/ /* select */

  ASSIGN
    user_dbname   = dbpick
    user_dbtype   = cache_db_t[choice]
    cache_dirty   = TRUE
    user_filename = ""
    drec_db       = ?
    drec_file     = ?.
  { prodict/user/usercon.i user_filename }

  CREATE ALIAS "DICTDB" FOR DATABASE VALUE(cache_db_s[choice]) NO-ERROR.
  IF LDBNAME("DICTDBG") <> ? THEN DELETE ALIAS "DICTDBG".
  IF user_dbtype = "PROGRESS" THEN
    dbpick = ?.
  ELSE IF CONNECTED(dbpick) THEN
    CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(dbpick) NO-ERROR.
  RUN "prodict/_dctsset.p" (dbpick).

  IF NOT CONNECTED(user_dbname) AND CAN-DO(DATASERVERS,user_dbtype) THEN DO: 
    answer = TRUE.
    MESSAGE new_lang[10] + ' "' + user_dbname + '"' new_lang[11] SKIP
      	    new_lang[22]
      	    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF answer THEN user_path = "*C,1=usr,_usrscon".
  END.

END. /*---------------------------------------------------------------------*/

HIDE FRAME schema_stuff NO-PAUSE.


FUNCTION isOlderDBVersion RETURNS LOGICAL (INPUT pos AS INTEGER):

  IF index(cache_db_t[pos],"/R10") <> 0  THEN  
     RETURN YES.
   ELSE 
     RETURN NO.
   
END FUNCTION.

&ENDIF /*"{&WINDOW-SYSTEM}" <> "TTY"*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _guisqlw.p

Description:
   Set up the Adjust Field Width browser for SQL Properties.  This is used
   to modify the _width field that is used exclusively by SQL-92 client.  
   
Author: Mario Brunetti
Date Created: 02/16/99
    Modified: 05/28/99 Added code to prevent unnecessary repopulation of
                       temp-table & browse widget to avoid unnecessary redraw.
		       Made the query dynamic to facilitate different sorts.
              07/01/99 Mario B. Fine tuning + add SwitchTable button
	      07/28/99 Mario B. Support for array data types. BUG 19990716-033.
	      10/14/99 Mario B. 2k width limit now 31995. BUG 19990825-005.  
          06/10/02 D. McMann Added check for new SESSION attribute schema change.  
-----------------------------------------------------------------------------*/

/*----------------------------- Declarations --------------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   &GLOBAL-DEFINE WIN95-BTN YES
   &SCOPED-DEFINE WINDOW_TITLE "Adjust Field Width"
   &SCOPED-DEFINE WINDOW_MAXIMIZED 1

   DEF VAR RunBrowse    AS    LOG NO-UNDO.
   DEF VAR MethodRetval AS LOG NO-UNDO.
   DEF VAR sort-phrase  AS CHAR EXTENT 2
       INIT ["w_Field._Field-Name", "w_Field._Order"]. 
   
   {adedict/dictvar.i    shared}
   {adedict/menu.i       shared}
   {adedict/uivar.i      shared} 
   {adecomm/cbvar.i      shared} 
   {prodict/gui/widthvar.i shared} 
&ELSE
   {prodict/dictvar.i}  /* Automatically shared in character dictionary */
   {prodict/gui/widthvar.i "new shared"}
   {prodict/gui/widttrig.i}
   {prodict/user/uservar.i}
&ENDIF

/*-------------------- Internal Procedures and Functions --------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN

   PROCEDURE StatusBar:

      /* Allocate space for the status bar and create it. */
      ASSIGN s_win_Width:HEIGHT-CHARS = s_win_Width:HEIGHT-CHARS + 1.05.   
      RUN adecomm/_status.p (INPUT s_win_Width, 
                             INPUT "36,36", 
                             INPUT TRUE,
                             INPUT ?,
                             OUTPUT s_StatusLineHdl, 
                             OUTPUT s_StatusLineFlds).  

      ASSIGN s_win_Width:WINDOW-STATE = {&WINDOW_MAXIMIZED}.
   
   END PROCEDURE.     

&ENDIF

FUNCTION NoFields RETURNS LOGICAL ().

   /* Are there any fields to look at in the temp table */
   FIND FIRST w_Field NO-ERROR.
   IF NOT AVAIL w_Field THEN
   DO:

      MESSAGE
         "There are no fields in this table to view."
         SKIP
         "This utility is used exclusively with character, decimal and"
         SKIP
         "all database array data types.  Please choose another table."
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK TITLE "No Fields to Modify".
   END.
   ELSE RETURN FALSE.

   RETURN TRUE.
   
END FUNCTION.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
/* -------------------- A Local Trigger AND --------------------------------*/
/* This is a good example of how code gets convoluted after a short time    *
 * if it is not re-designed from scratch.  This was an afterthought.  It    *
 * couldn't go in the trigger procedure because user_path isn't at that     *
 * level.  And so it goes...                                                */
ON CHOOSE of s_btn_Switch IN FRAME frm-width
DO:
   user_path = "1=,_usrtget,19=alpha,_guisqlw".
   IF rowsModified THEN
      MESSAGE "Save changes to this table first?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO TITLE "Rows Modified"
      UPDATE saveCurr.
   IF saveCurr THEN
   DO:
      saveCurr = YES.
      APPLY "GO" TO FRAME frm-width.
   END.
   ELSE
      APPLY "END-ERROR" TO FRAME frm-width.
END.
&ENDIF

/*--------------------------- Mainline code ---------------------------------*/

DO ON ERROR UNDO, LEAVE
   ON STOP UNDO, LEAVE:

   find _File where _File._File-name = "_Field"
                and _File._Owner = "PUB" NO-LOCK.
   if NOT can-do(_File._Can-read, USERID("DICTDB")) THEN do:
      message s_NoPrivMsg "see field definitions."
         view-as ALERT-BOX ERROR buttons Ok
	   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            in window s_win_Browse
       &ENDIF
	 .
     return.
   end.
   IF SESSION:SCHEMA-CHANGE = "New Objects" THEN DO:
     MESSAGE 'You can not change field width when SESSION:SCHEMA-CHANGE = "New Objects".'
       VIEW-AS ALERT-BOX ERROR.
     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
       ASSIGN user_path = "".
     &ENDIF
     RETURN.
   END.
   
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   s_btn_Close:LABEL IN FRAME frm-width = "Cancel".
   CREATE QUERY qry-width-hdl.   
&ELSE  /* GUI  Only Code */
IF s_win_Width = ? THEN  
   DO:
      /* Don't want Cancel if moving to next table - only when window opens */
      s_btn_Close:label in frame frm-width = "Cancel". 
      /* Open the window if necessary */
      run adedict/_openwin.p
         (INPUT        {&WINDOW_TITLE},
          INPUT        frame frm-width:HANDLE,
          INPUT        {&OBJ_WIDTH},
          INPUT-OUTPUT  s_win_Width).

      /* Clear out the old buffer data that might still be around.        *
       * Need this to make sure refresh code below works right.           */
      FOR EACH w_Field:
         DELETE w_Field.
      END.
      
      CREATE QUERY qry-width-hdl.
      IF FRAME frm-width:PRIVATE-DATA <> "alive" THEN 
      DO:
         ASSIGN
            FRAME frm-width:PARENT       = s_win_Width
            s_win_Width:PARENT           = s_win_Browse 
            frame frm-width:private-data = "alive"
            s_win_Width:WIDTH            = s_win_Width:width + 1.

         {adecomm/okrun.i
            &FRAME  = "frame frm-width"
            &OK     = "s_btn_OK"
            &HELP   = "s_btn_Help"
            &OTHER  = "s_btn_Close
                       s_btn_Prev 
                       s_btn_Next"
            &CANCEL = s_btn_Save  
            
            &OKBOX  = NO
         }
         
         RUN StatusBar IN THIS-PROCEDURE.
      END.
      ELSE
         RUN StatusBar IN THIS-PROCEDURE.
   END.

   /* Determine if screen needs refresh or if someone just selected *
    * the menu to bring it to the forground again, or changed sort. */
   IF s_PreviousSort = s_Order_By THEN
   check-tbl:
   REPEAT:
      FIND NEXT w_Field WHERE w_Field._File-Recid = s_TblRecId NO-ERROR.
         FIND _Field WHERE
              _Field._File-Recid = w_Field._File-Recid AND
              _Field._Field-Name = w_Field._Field-NAME NO-ERROR.
         IF AVAIL w_Field AND AVAIL _Field AND
   	    _Field._Width <> w_Field._Width THEN LEAVE check-tbl.

         /* If we get this far, then nothing has changed and we just need *
          * to bring the window into focus.  We use this method to return *
          * to the currently focused row.  But first make sure we haven't *
          * changed tables in case w_Field was empty and that put us here.*/
          IF s_PreviousTbl <> s_CurrTbl THEN LEAVE check-tbl.

         /* Make sure we have at least one row before trying to select   *
          * it.  else, just apply entry to the OK button                 */
         FIND FIRST w_Field NO-ERROR.
         IF AVAIL w_Field THEN
            MethodRetval = brw-width:SELECT-FOCUSED-ROW().
         IF NOT (s_DB_ReadOnly OR s_Fld_ReadOnly) THEN
            APPLY "entry" TO s_btn_OK IN FRAME frm-width.
         ELSE
            APPLY "entry" TO s_btn_Close IN FRAME frm-width.

	 /* If we get this far, nothing's changed.  We've applied focus.  We *
	  * can go b-bye now.                                                */
         RETURN.

   END.
   
   ASSIGN
      s_PreviousTbl  = s_CurrTbl
      s_PreviousSort = s_Order_By 
      MethodRetval = NO.
          
   RUN adedict/_brwgray.p (INPUT NO).
   
&ENDIF
    
   /* Re-populate the temp-table.  Yes this could be a repeat of what was *
    * done above for GUI, but it always needs to be done and won't hurt   *
    * if it turns out it is unncessary.                                   */
   IF qry-width-hdl:IS-OPEN THEN
      qry-width-hdl:QUERY-CLOSE.

   FOR EACH w_Field:
      DELETE w_Field.
   END.

   qry-width-hdl:SET-BUFFERS(BUFFER w_field:HANDLE).
   
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   FIND _File WHERE RECID(_File) = drec_file NO-LOCK NO-ERROR. 
&ELSE
   FIND _FIle WHERE RECID(_File) = s_TblRecId NO-LOCK NO-ERROR. 
&ENDIF
   IF AVAIL _File THEN
      FOR EACH _Field OF _File WHERE 
         LOOKUP(_Field._Data-Type,"character,decimal,raw") > 0 OR
         _Field._Extent > 0: 

         CREATE w_Field.
         BUFFER-COPY _Field TO w_Field.
      END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   b-test = qry-width-hdl:QUERY-PREPARE("FOR EACH w_field").

&ELSE
   b-test = qry-width-hdl:QUERY-PREPARE("FOR EACH w_field" + " BY " +
            sort-phrase[s_Order_By]).
&ENDIF

ASSIGN
   b-test = qry-width-hdl:QUERY-OPEN.
   BROWSE brw-width:QUERY = qry-width-hdl.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN

   IF NoFields() THEN
   DO:
       user_path = "1=,_usrtget,19=alpha,_guisqlw".
       RETURN.
   END.
    
   FIND _File WHERE RECID(_File) = drec_file NO-LOCK NO-ERROR.
   IF _File._Frozen THEN
   ASSIGN
      BROWSE brw-width:READ-ONLY = TRUE
      s_btn_Close:LABEL          = "Close".
      
   UPDATE brw-width 
          s_btn_Save  WHEN NOT _File._Frozen
          s_btn_OK    WHEN NOT _File._Frozen
          s_btn_Close
	  s_btn_Switch
   WITH FRAME frm-width NO-ERROR.

   HIDE FRAME frm-width NO-PAUSE.
&ELSE

  ENABLE brw-width 
          s_btn_Save 
          s_btn_OK 
          s_btn_Close 
          s_btn_Prev 
          s_btn_Next 
          s_btn_Help 
   WITH FRAME frm-width IN WINDOW s_win_Width. 

   ASSIGN s_StatusLineHdl:VISIBLE = TRUE.
   
   RUN adecomm/_statdsp.p (INPUT s_StatusLineHdl, 1, "Database: " + s_CurrDb).
   RUN adecomm/_statdsp.p (INPUT s_StatusLineHdl, 2, "Table: " + s_CurrTbl).
                                
   /* Is this a read only DB, table or session */
   FIND _File WHERE RECID(_File) = s_TblRecId NO-LOCK NO-ERROR.
   ASSIGN
      s_Fld_ReadOnly = (S_ReadOnly OR s_DB_ReadOnly)
      s_Fld_ReadOnly = (IF AVAIL _File AND _File._Frozen THEN
                           TRUE
			ELSE
			   s_Fld_ReadOnly).
   IF (s_DB_ReadOnly OR s_Fld_ReadOnly) THEN
      ASSIGN
         BROWSE brw-width:READ-ONLY = TRUE
         s_btn_Save:SENSITIVE       = FALSE
         s_btn_OK:SENSITIVE         = FALSE
         s_btn_Close:LABEL          = "Close".
   ELSE /* Might be coming back from readonly to not readonly */
      ASSIGN
         s_btn_Close:LABEL          = "Cancel"
	 BROWSE brw-width:READ-ONLY = FALSE.

   NoFields(). 
   
   APPLY "entry" TO s_btn_OK IN FRAME frm-width.
   
&ENDIF

END.

/*********************************************************************
* Copyright (C) 2007,2009,2011,2013 by Progress Software Corporation.*
* All rights reserved.  Prior versions of this work may contain      *
* portions contributed by participants of Possenet.                  *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _guitget.p

Description:   
   Select one or more tables. 

INPUT:
   user_env[1] MATCHES "*o*":
      If this program sees an "o" (for "optional") in user_env[1], then it
      returns immediately if a filename is currently set (other than
      "ALL").
   
   user_env[1] MATCHES "*a*":
      If this program sees an "a" (for "all"), then "ALL" is a valid
      choice.
   
   user_env[1] MATCHES "*s*":
      If this program sees an "s" (for "some"), then [Return] marks (or
      unmarks) names, and the comma-delimited list of names is returned in
      user_env[1].

OUTPUT:
   drec_file
      Contains the recid of the _File record selected, or no record if
      'ALL' or some entered.
   
   user_filename
   user_env[1]
      Contains the filename selected, or 'ALL', or a comma-separated list
      of filenames.  Or it may be in user_longchar, if list was too big.
      If a comma-sep list is returned in user_env[1], 'SOME'
      is returned in user_filename.
 
Author: Laura Stern

Date Created: 11/16/92 

History
   McIntosh K.  02/15/05    Added "Show Hidden" toggle on TTY - 20050104-024.
   McMann D.    09/18/03    Added TTY to GUI and removed usrtget since it failed on large
                            number of files.
   McMann D.    04/21/00    Made sure ALL was not the only one in list
   McMann D.    01/25/00    Since ALL is not in the list when user_evn[1] = a
                            any table that started will all was being selected
                            as the table the user wanted.  If user_evn[1] = a I 
                            have added the literal "ALL" as the first table name
                            20000124001
   Mario B.     99/04/07    BUG 99-04-07-006.  In the case of the existence of
                            only 1 table, we were assigning "ALL" to user_env[1]
                            and user_filename because count = cache_file#.  Since
                            "ALL" is not always a valid option everywhere this is
                            used, this needed to be prevented.  
   Mario B.     98/12/09    See 98/04/09 comments below.  That modification 
                            was inneffective.  I changed it so we actually 
                            count the items in the selection list inside the 
                            GO trigger.  BUG 98-05-27-005.
    McMann      98/07/13    Added _Owner to _File finds
   laurief      98/04/09    Added p_allw and count to allow us to compare
                            the number of tables selected to the total
                            number of tables available.  This needs to be
                            done in the case where a user is not typing "ALL",
                            instead the user types an "*" in the
                            select/deselect dialog.  This allows us to
                            compare count with cache_file# and if they are
                            equal, the .df will contain all database schema
                            info correctly.  BUG 97-07-22-029	
    mcmann      98/02/18    Added initial value * to pattern
    gfs         94/10/31    fix conflict with 'h' hot-key.  
    gfs         94/07/22    fix sellist behavior and add mnemonics to buttons.
    gfs         94/07/21    display correct help on Select/Deselect.
    gfs         94/07/18    display correct titles on Select/Deselect.
    hutegger    94/03/31    modified select-button-trigger so it does NOT
                            deselct already selected tables
    fernando    03/13/06    Using temp-table to store table names - bug 20050930-006.
    fernando    12/13/07    Handle long list of selected tables
    fernando    08/04/09    fixed select some for temp-table case
                            
----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }
{ adecomm/cbvar.i }
{ prodict/fhidden.i }

/* User_Env input will be tranlated into these logicals. */
Define var p_gotname as logical NO-UNDO.
Define var p_all     as logical NO-UNDO.
Define var p_allw    as logical NO-UNDO.
Define var p_some    as logical NO-UNDO.

/* Form variables */
Define var tprompt  as char    NO-UNDO.
Define var pprompt  as char    NO-UNDO.
Define var tfill    as char    NO-UNDO init "".
Define var tlist    as char    NO-UNDO.
Define var pattern  as char    NO-UNDO initial "*".
Define var thidden  as logical NO-UNDO.
DEFINE VARIABLE tblslcn AS CHARACTER   INITIAL "A" NO-UNDO.
DEFINE VAR ismultitenant     AS LOGICAL NO-UNDO INIT FALSE.
DEFINE VAR issupertenant     AS LOGICAL NO-UNDO INIT FALSE.

Define button btn_select   label "&Select Some...".
Define button btn_deselect label "&Deselect Some...".

/* Miscellaneous */
Define var chosen as char     	   NO-UNDO.
Define var stat	  as logical       NO-UNDO.
Define var ix	  as integer       NO-UNDO init 0. /* temp looping variable */
Define var msg	  as char extent 1 NO-UNDO init
[
  /* 1 */ "You do not have permission to select tables."
].

DEFINE VAR message_displayed AS LOGICAL NO-UNDO INIT NO.
DEFINE VAR cLongSize         AS INTEGER NO-UNDO.
DEFINE VAR numCount          AS INTEGER NO-UNDO.

DEFINE VARIABLE isCpUndefined AS LOGICAL NO-UNDO.

/*================================Forms====================================*/
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN

FORM 
   tprompt        at 3 FORMAT "x(32)" view-as TEXT SKIP({&VM_WIDG}) 

   btn_select     at 2    SPACE(1) btn_deselect    SKIP({&VM_WID})
   tfill       	  at row 3 col 3 FORMAT "x(32)"    SKIP({&VM_WID})
   tlist       	  at 3 view-as SELECTION-LIST   SINGLE  
      	       	  SIZE 32 by 10 SCROLLBAR-V  	    SKIP({&VM_WID})
   tblslcn        at 2 VIEW-AS RADIO-SET RADIO-BUTTONS "All", "A",
                                               "Multi-tenant", "MT",
                                               "Shared", "SH"
                                 HORIZONTAL NO-LABEL  SKIP({&VM_WID})
   thidden        at 2 view-as TOGGLE-BOX
                       LABEL "&Show Hidden"
   {prodict/user/userbtns.i}
   with frame tbl_get 
      	view-as DIALOG-BOX CENTERED NO-LABELS.

&ELSE
 FORM 
  SKIP({&TFM_WID})
   tprompt        at 2 FORMAT "x(32)" NO-LABEL
      	       	       view-as TEXT    	     	   SKIP({&VM_WIDG}) 
   btn_select     at 2           	     	   SPACE(2)
   btn_deselect    
   tfill       	  at row 3 col 2 FORMAT "x(32)" 
      	       	       {&STDPH_FILL} NO-LABEL
   tlist       	  at 2 view-as SELECTION-LIST   SINGLE 
      	       	       INNER-CHARS 32 INNER-LINES 10
      	       	       SCROLLBAR-V SCROLLBAR-H
      	       	       NO-LABEL                    SKIP({&VM_WID})
   tblslcn          at 2 VIEW-AS RADIO-SET RADIO-BUTTONS "All", "A",
                                               "Multi-tenant", "MT",
                                               "Shared", "SH"
                                 HORIZONTAL NO-LABEL  SKIP({&VM_WID})
   thidden     	  at 2 view-as TOGGLE-BOX 
      	       	       LABEL "&Show Hidden"
   {prodict/user/userbtns.i}
   with frame tbl_get 
      	view-as DIALOG-BOX 
        CENTERED DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.
&ENDIF

FORM 
   SKIP({&TFM_WID})
   pprompt  FORMAT "x(40)" NO-LABEL at 2 view-as TEXT
   "Use '*' and '.' for wildcard patterns.":t45 at 2 view-as TEXT SKIP ({&VM_WIDG})
   pattern  FORMAT "x(50)"   LABEL "Table Name":t17 at 2  {&STDPH_FILL}
   {prodict/user/userbtns.i}
   with frame tbl_patt 
      	view-as DIALOG-BOX TITLE "Select Tables by Pattern Match"
        SIDE-LABELS CENTERED 
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.


/*===============================Triggers==================================*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
/*----- HELP -----*/
on HELP of frame tbl_get OR CHOOSE of btn_Help in frame tbl_get
do: 
   IF p_all then
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
         	       	       INPUT {&List_Tables_1orAll_Dlg_Box},
      	       	     	       INPUT ?).
   else if p_some or p_allw then
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&List_Tables_Some_Dlg_Box},
      	       	     	     INPUT ?).
   else /* select 1 */
         RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
               	     	           INPUT {&List_Tables_1_Dlg_Box},
      	       	     	           INPUT ?).
end.
   
on HELP of frame tbl_patt OR CHOOSE of btn_Help in frame tbl_patt
DO:
   IF FRAME tbl_patt:TITLE = "Select Tables by Pattern Match" THEN
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Select_by_Pattern_Dlg_Box},
      	       	     	       INPUT ?).
   ELSE 
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Deselect_by_Pattern_Dlg_Box},
      	       	     	       INPUT ?).
END.      	       	
&ENDIF

/*----- GO or CHOOSE of OK BUTTON-----*/
on GO of frame tbl_get /* or OK because of auto-go */
do:
   Define var count  as integer       NO-UNDO init 0.
   if tfill:sensitive in frame tbl_get then
      tfill = tfill:screen-value in frame tbl_get.

   if NOT P_all and tfill = "ALL" then
   do:
      message "All is not allowed. Select one table or press Cancel."
      	      view-as alert-box error buttons ok.
     return NO-APPLY.
   end.

   if tlist:screen-value in frame tbl_get = ? AND
      (p_some OR tfill <> "ALL") then
   do:
      message "Select at least one table or press Cancel."
      	      view-as alert-box error buttons ok.
      return NO-APPLY.
   end.
   
   IF tfill               NE "ALL"              AND 
      tfill               NE ""                 AND
      tfill               NE ?                  AND
      tfill               NE tlist:SCREEN-VALUE AND
      tlist:LOOKUP(tfill) EQ 0                  THEN 
   DO:
     MESSAGE "The name typed is not a valid table."
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     APPLY "ENTRY" TO tfill IN FRAME tbl_get.
     RETURN NO-APPLY.
   END.
     
   /* Following insures that if user selected "*" during execution of the *
    * btn_select trigger, then changed their minds and deselected some of *
    * tables, they will not get ALL tables anyway.                        */
   
   DO ix = 1 TO tlist:NUM-ITEMS:
      count = count + INT(tlist:IS-SELECTED(ix)).
   END.  

   assign
      chosen = tlist:screen-value in frame tbl_get
      p_gotname = true.

   if tfill = "ALL" or (count = cache_file# AND (p_some OR p_all)) OR
      (l_cache_tt AND chosen = "*ALL*") then
      assign
      	 user_env[1] = "ALL"  
      	 user_filename = "ALL"
         user_longchar = (IF isCpUndefined THEN user_longchar ELSE "").
   else do:
      user_env[1] = chosen NO-ERROR.
      /* if we couldn't add it to user_env[1], try the longchar in case
         string is too big .
      */
      IF NOT ERROR-STATUS:ERROR THEN
         ASSIGN user_longchar = (IF isCpUndefined THEN user_longchar ELSE "").
      ELSE DO:
         /* if undefined codepage, then there is nothing we can do but
            error out
         */
         IF isCpUndefined THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1)
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RETURN NO-APPLY.
         END.

         ASSIGN user_env[1] = ""
                user_longchar = chosen.
      END.

      if NUM-ENTRIES(chosen) > 1 THEN
      	 assign user_filename = "SOME".
      else
      	 assign user_filename = chosen.
   end.
   
end.


/*----- DEFAULT-ACTION of OK SELECT LIST-----*/
on default-action of tlist in frame tbl_get 
   apply "choose" to btn_OK in frame tbl_get.

/*------ MOUSE-SELECT-CLICK of SELECT LIST----*/
ON VALUE-CHANGED OF tlist IN FRAME tbl_get 
DO:

   DEFINE VARIABLE choice AS CHAR NO-UNDO.

   /* make sure that ALL is not selected when other tables are selected.
      This is only the case when we have too many tables in the list (l_cache_tt
      will be set).
   */
   IF l_cache_tt AND p_some THEN DO:
      IF SUBSTRING(tlist:screen-value,1,6) = "*ALL*," THEN DO:
         ASSIGN tlist:screen-value = ""
                tlist:screen-value = "*ALL*".
      END.

   END.
END.

/*----- CHOOSE of SELECT SOME BUTTON-----*/
on choose of btn_select in frame tbl_get
do:
    
   Define var choice as char NO-UNDO init "".
 
   ASSIGN FRAME tbl_patt:TITLE = "Select Tables by Pattern Match".
   
   pprompt = "Enter name of table to select.".
   display pprompt with frame tbl_patt.

   assign
     choice = if tlist:screen-value in frame tbl_get <> ?
            then tlist:screen-value in frame tbl_get
            else "".

   do ON ENDKEY UNDO, LEAVE:
      update pattern btn_OK btn_Cancel {&HLP_BTN_NAME} with frame tbl_patt.
 
      /* Find the list of files that matches the pattern and are
         not selected yet; -> set choice accordingly.
      */

      IF l_cache_tt AND (TRIM(pattern) = "*" OR TRIM(pattern) = "ALL") THEN
         ASSIGN choice = "*ALL*".
      else do:

         /* if they selected ALL and now are trying to select something else, 
             get rid of all 
         */

         IF l_cache_tt AND choice = "*ALL*" THEN
            ASSIGN choice = "".
         
         IF l_cache_tt THEN DO:
             /* look for tables in the temp-table */
          
            FOR EACH tt_cache_file NO-LOCK:              
                 if CAN-DO(pattern, tt_cache_file.cName) 
                 AND NOT LOOKUP( tt_cache_file.cName, choice) > 0 THEN 
                 DO:
                     IF choice = "" THEN
                         ASSIGN choice = tt_cache_file.cName.
                     ELSE DO:
                         ASSIGN choice = choice + "," + tt_cache_file.cName NO-ERROR.
                         IF ERROR-STATUS:ERROR THEN 
                         DO:
                            MESSAGE  "Too many tables selected. Not all tables were selected due to error:"
                                     SKIP ERROR-STATUS:GET-MESSAGE(1)
                                     VIEW-AS ALERT-BOX ERROR.
                            LEAVE.
                         END.
                     END.   
                 END.
            END.
         END.
         ELSE do ix = 1 to cache_file#:
           if   CAN-DO(pattern, cache_file[ix]) 
       	   AND NOT LOOKUP(cache_file[ix], choice) > 0 then 
       	   do:
             FIND DICTDB._File where DICTDB._File._File-name EQ cache_file[ix]
                                 and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
             
             if  tblslcn:SCREEN-VALUE in frame tbl_get = "A"  THEN DO:
                /* the assign below used to be one statement, but I separated it
                   in two to handle selecting lots of tables so we don't run
                   out of stack space.
                */
                IF choice = "" THEN
                    ASSIGN choice = cache_file[ix].
                ELSE DO:
                    ASSIGN choice = choice + "," + cache_file[ix] NO-ERROR.
                    IF ERROR-STATUS:ERROR THEN 
                    DO:
                       MESSAGE  "Too many tables selected. Not all tables were selected due to error:"
                                SKIP ERROR-STATUS:GET-MESSAGE(1)
                                VIEW-AS ALERT-BOX ERROR.
                       LEAVE.
                    END.
                END.
             END.

              if  tblslcn:SCREEN-VALUE in frame tbl_get = "MT"  THEN DO:
                /* the assign below used to be one statement, but I separated it
                   in two to handle selecting lots of tables so we don't run
                   out of stack space.
                */
               if DICTDB._File._File-attributes[1] EQ TRUE THEN DO:
                IF choice = "" THEN
                    ASSIGN choice = cache_file[ix].
                ELSE DO:
                    ASSIGN choice = choice + "," + cache_file[ix] NO-ERROR.
                    IF ERROR-STATUS:ERROR THEN 
                    DO:
                       MESSAGE  "Too many tables selected. Not all tables were selected due to error:"
                                SKIP ERROR-STATUS:GET-MESSAGE(1)
                                VIEW-AS ALERT-BOX ERROR.
                       LEAVE.
                    END.
                END.
             END.
            END.

              if  tblslcn:SCREEN-VALUE in frame tbl_get = "SH"  THEN DO:
                /* the assign below used to be one statement, but I separated it
                   in two to handle selecting lots of tables so we don't run
                   out of stack space.
                */
               if DICTDB._File._File-attributes[1] NE TRUE THEN DO:
                IF choice = "" THEN
                    ASSIGN choice = cache_file[ix].
                ELSE DO:
                    ASSIGN choice = choice + "," + cache_file[ix] NO-ERROR.
                    IF ERROR-STATUS:ERROR THEN 
                    DO:
                       MESSAGE  "Too many tables selected. Not all tables were selected due to error:"
                                SKIP ERROR-STATUS:GET-MESSAGE(1)
                                VIEW-AS ALERT-BOX ERROR.
                       LEAVE.
                    END.
                END.
             END.
            END.

           end.
      	 end.     	     
      end.

      tlist:screen-value in frame tbl_get = "".
      tlist:screen-value in frame tbl_get = choice.
   end.
end.


/*----- CHOOSE of DESELECT SOME BUTTON-----*/
on choose of btn_deselect in frame tbl_get
do:
   Define var choice as char NO-UNDO init "".
   Define var item   as char NO-UNDO.
   
   ASSIGN FRAME tbl_patt:TITLE = "Deselect Tables by Pattern Match".

   pprompt = "Enter name of table to deselect.".
   display pprompt with frame tbl_patt.

   do ON ENDKEY UNDO, LEAVE:
      update pattern btn_OK btn_Cancel {&HLP_BTN_NAME} with frame tbl_patt.

         chosen = tlist:screen-value in frame tbl_get.

         do ix = 1 to NUM-ENTRIES(chosen):
      	     item = ENTRY(ix, chosen).
      	     if NOT CAN-DO(pattern, item) then
      	        choice = choice + "," + item.
         end.
         choice = LEFT-TRIM(choice,",").
      /* Must clear choose and then reset to the ones we still want on. */
      tlist:screen-value in frame tbl_get = "". 
      tlist:screen-value in frame tbl_get = choice.
   end.
end.

/*----- ON VALUE-CHANGED of SHOW-HIDDEN TOGGLE -----*/
ON value-changed of thidden IN frame tbl_get
DO:
   DEFINE VAR tbl     AS CHAR NO-UNDO.
   DEFINE VAR selsave AS CHAR NO-UNDO.
   
   thidden = INPUT frame tbl_get thidden.

   run "prodict/_dctcach.p" (thidden).
   run BuildList(INPUT tblslcn:SCREEN-VALUE in frame tbl_get).

END.


/*----- ON VALUE-CHANGED of all, MT or shared radio-set -----*/
ON VALUE-CHANGED OF tblslcn IN FRAME tbl_get DO:
   run BuildList(INPUT tblslcn:SCREEN-VALUE  in frame tbl_get).
END. 

/*----- WINDOW-CLOSE of dialog -----*/
on window-close of frame tbl_get
   apply "END-ERROR" to frame tbl_get.
on window-close of frame tbl_patt
   apply "END-ERROR" to frame tbl_patt.



/*============================Mainline code=============================*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

&ENDIF
 
/* Check for read permissions */
find DICTDB._File WHERE DICTDB._File._File-name = "_File"
                    AND DICTDB._File._Owner = "PUB".
if NOT CAN-DO(_Can-read, USERID("DICTDB")) then ix = 1.
if ix > 0 then
do:
   message msg[ix] view-as ALERT-BOX ERROR buttons OK.
   assign
      drec_file     = ?
      user_path     = ""
      user_filename = ""
      user_env[1]   = ""
      user_longchar = (IF isCpUndefined THEN user_longchar ELSE "").
   return.
end.

ismultitenant = can-find(first DICTDB._tenant ). /* Is DB multitenant */
if ismultitenant then 
     assign issupertenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
else
    issupertenant = no.

if cache_dirty then do:
   /* if current table is schema table, then include them by default */
   find first DICTDB._File 
     where DICTDB._File._Db-recid  = drec_db 
     and   DICTDB._File._File-name = user_filename
     and  (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
     no-lock no-error.
   assign thidden = (available DICTDB._File and DICTDB._File._Hidden = TRUE).
   run "prodict/_dctcach.p" (thidden).
end.
else do: /* determine if cache contains hidden tables */
   assign thidden = false.

   /* 20050930-006 - check if we cached the table names in the temp-table */
   IF l_cache_tt THEN DO:

      FOR EACH tt_cache_file NO-LOCK:
         find first DICTDB._File 
           where DICTDB._File._Db-recid  = drec_db 
           and   DICTDB._File._File-name = tt_cache_file.cName
           and  (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
           no-lock no-error.
         assign thidden = (available DICTDB._File and DICTDB._File._Hidden = TRUE).

         IF thidden THEN 
            LEAVE. /* that's it */
      END.
   END.
   ELSE do ix = 1 to cache_file# while NOT thidden:
     find first DICTDB._File 
       where DICTDB._File._Db-recid  = drec_db 
       and   DICTDB._File._File-name = cache_file[ix]
       and  (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
       no-lock no-error.
     assign thidden = (available DICTDB._File and DICTDB._File._Hidden = TRUE).
   end.
end.

ASSIGN
  p_gotname     = user_env[1] MATCHES "*o*" AND drec_file <> ?
  p_all         = user_env[1] MATCHES "*a*"
  p_allw        = user_env[1] MATCHES "***"
  p_some        = user_env[1] MATCHES "*s*".

/* Initialize the prompt and configure the form based on the input */
if p_all then
   /* 1 or ALL */
   assign
      tprompt = "Select a table or type ~"ALL~"."
      btn_select:visible in frame tbl_get = no
      btn_deselect:visible in frame tbl_get = no
      frame tbl_get:title = "Select Tables".
else if p_some then
   /* Some */
   assign
      tprompt = "Select one or more tables."
      tfill:visible in frame tbl_get = no
      tlist:multiple = yes 
      tlist:drag-enabled in frame tbl_get = no
      frame tbl_get:title = "Select Tables".
else 
   /* Select 1 */
   assign
      tprompt = "Select a table."
      btn_select:visible in frame tbl_get = no
      btn_deselect:visible in frame tbl_get = no
      frame tbl_get:title = "Select Table".

/* clear it out */
IF NOT isCpUndefined THEN
   assign user_longchar = "".
/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME tbl_patt" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}
{adecomm/okrun.i  
   &FRAME  = "FRAME tbl_get" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}
tfill:width in frame tbl_get = tlist:width in frame tbl_get.

if ismultitenant and issupertenant THEN 
       tblslcn:visible in frame tbl_get = TRUE.
else
       ASSIGN tblslcn:visible in frame tbl_get = FALSE
              tblslcn:screen-value in frame tbl_get = "A".

if NOT p_gotname then
do:
   IF p_all THEN DO:
     IF CACHE_file# > 0 THEN
      ASSIGN stat = tlist:ADD-LAST("ALL") IN FRAME tbl_get.
   END.

   /* 20050930-006 - check if we are caching the table names in the temp-table */
   IF l_cache_tt THEN DO:
       IF p_some THEN
         stat =  tlist:ADD-LAST("*ALL*") in frame tbl_get.

       FOR EACH tt_cache_file NO-LOCK:
          stat = tlist:ADD-LAST(tt_cache_file.cName) in frame tbl_get.
       end.
   END.
   ELSE do ix = 1 to cache_file#:
          stat = tlist:ADD-LAST(cache_file[ix]) in frame tbl_get.
   end.
   
   /* Initialize the combo box and initialize the choose based on the 
      last table name chosen. This is only for choose 1 lists. */
   if NOT p_some then
   do:
      if user_filename = "ALL" OR user_filename = "SOME" then
      	 user_filename = "".
      {adecomm/cbdown.i &Frame  = "frame tbl_get"
		     	&CBFill = "tfill"
		     	&CBList = "tlist"
		     	&CBInit = "user_filename"}
   end.
   user_filename = "".
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   display tprompt thidden with frame tbl_get.
    enable btn_select 	when p_some
      	  btn_deselect 	when p_some
      	  tfill	     	when NOT p_some
      	  tlist 
          tblslcn       WHEN ismultitenant and issupertenant
      	  thidden 
      	  btn_OK
      	  btn_Cancel
	  {&HLP_BTN_NAME}
      	  with frame tbl_get.
  &ELSE
   display tprompt thidden with frame tbl_get. 
   enable btn_select 	when p_some
      	  btn_deselect 	when p_some
      	  tfill	     	when NOT p_some
      	  tlist 
          tblslcn       WHEN ismultitenant and issupertenant
          thidden
          btn_OK
          btn_Cancel
      	  with frame tbl_get.
   &ENDIF
 
  do ON ENDKEY UNDO, LEAVE:
      wait-for GO of frame tbl_get.  /* Or OK - due to auto-go */
  end.
end.

if p_gotname then
do:
   if user_filename = "ALL" OR user_filename = "SOME" then
      drec_file = ?.
   else do:
      FIND FIRST DICTDB._File WHERE DICTDB._File._Db-recid = drec_db AND
               	     	     DICTDB._File._File-name = user_filename AND
                             (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN") 
                             NO-ERROR.
      drec_file = RECID(DICTDB._File).
   end.
end.

SESSION:IMMEDIATE-DISPLAY = yes.
display user_filename WITH FRAME user_ftr.
SESSION:IMMEDIATE-DISPLAY = no.

hide frame tbl_get NO-PAUSE.
if user_filename = "" THEN user_path = "".

  ASSIGN thidden
         fhidden = thidden.
return.



PROCEDURE BuildList:
    DEFINE INPUT PARAMETER ttype AS CHARACTER NO-UNDO.
    DEFINE VAR selsave AS CHAR NO-UNDO.

    /*ASSIGN selsave = tlist:SCREEN-VALUE in frame tbl_get. */ /* Save off selected items */
    ASSIGN tlist:LIST-ITEMS IN frame tbl_get = "".  /* Clear first */

   IF l_cache_tt THEN DO:
       IF p_some THEN
         stat =  tlist:ADD-LAST("*ALL*") in frame tbl_get.

    IF ttype = "A" THEN 
       FOR EACH tt_cache_file NO-LOCK:
          stat = tlist:ADD-LAST(tt_cache_file.cName) in frame tbl_get.
       end.

    ELSE IF ttype = "MT" THEN 
       FOR EACH tt_cache_file NO-LOCK where  tt_cache_file.multitenant = TRUE:
          stat = tlist:ADD-LAST(tt_cache_file.cName) in frame tbl_get.
       end.


    ELSE IF ttype = "SH" THEN 
       FOR EACH tt_cache_file NO-LOCK where  tt_cache_file.multitenant NE TRUE:
          stat = tlist:ADD-LAST(tt_cache_file.cName) in frame tbl_get.
       end.
   end.
   ELSE
     do ix = 1 to cache_file#:
     FIND DICTDB._File where DICTDB._File._File-name EQ cache_file[ix]
          and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").

       if  ttype = "A"  THEN DO:
           stat = tlist:ADD-LAST(cache_file[ix]) in frame tbl_get.
       END.
       if  ttype = "MT"  THEN DO:
         if DICTDB._File._File-attributes[1] EQ TRUE THEN 
           stat = tlist:ADD-LAST(cache_file[ix]) in frame tbl_get.
       END.
       else if ttype = "SH"  THEN DO:
         if DICTDB._File._File-attributes[1] NE TRUE THEN 
           stat = tlist:ADD-LAST(cache_file[ix]) in frame tbl_get.
       END.
   end.

   /*ASSIGN tlist:SCREEN-VALUE = selsave. */ /* put 'em back */
   IF tlist:SCREEN-VALUE = "" or tlist:SCREEN-VALUE = ? THEN DO:
      tlist:SCREEN-VALUE in frame tbl_get = tlist:ENTRY(1) IN frame tbl_get.
      if tfill:SENSITIVE in frame tbl_get then
         tfill:SCREEN-VALUE in frame tbl_get = tlist:ENTRY(1) in frame tbl_get.
   END.

END PROCEDURE.

/***********************************************************************
* Copyright (C) 2000-2011 by Progress Software Corporation.            *
* All rights reserved.  Prior versions of this work may contain        *
* portions contributed by participants of Possenet.                    *
*                                                                      *
***********************************************************************/

/*------------------------------------------------------------------
   Add/Modify/Delete users from the user list (_User table).

   Author: Tony Lavinio, Laura Stern
   
   History:
        tomn    12/06/95    Changed "FIND FIRST _User ... " in 
                            "delete user" trigger to
                            "CAN-FIND(FIRST _User ... " so current _User
                            record does not have to be reset
        D. McMann 10/23/02  Changed BLANK to PASSWORD-FIELD
        fernando  09/22/09  Reset other can-fields when unsetting sec admin
        Rajinder  04/18/11 OE00208533  fixed error if domain name is empty.
                            
-------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 27 NO-UNDO INITIAL [
  /*  1*/ "This function only works on {&PRO_DISPLAY_NAME} databases.",
  /*  2*/ "You may not use this function with a blank userid.",
  /*  3*/ "You must be a Security Administrator to execute this function.",
  /*  4*/ "You may delete the current User only if it is the only User left.",
  /*  5*/ "Are you sure that you want to remove this user?",
  /*  6*/ "Undo all changes made in this dialog box?",
  /*  7*/ "(no password)",
  /*  8*/ "(password assigned)",
  /*  9*/ "Add User",
  /* 10*/ "Modify User Name",
  /* 11*/ "You did not type the same password each time.",
  /* 12*/ "No User record was created.",
  /* 13*/ "The dictionary is in read-only mode - alterations not allowed.",
      	  /* 14 - 17 used together */
  /* 14*/ "You have removed all security administrators, leaving none of",
  /* 15*/ "the remaining users with security administrator privileges.",
  /* 16*/ "There must be at least one user with security administrator",
  /* 17*/ "privileges.",
      	  /* 18 - 22 used together */
  /* 18*/ "You are about to end the transacton in which",
  /* 19*/ "you have deleted the last User record.  When",
  /* 20*/ "you do this, you will force all users to have",
  /* 21*/ "security administrator privileges.",
  /* 22*/ "Do you want to do this?  (If not, either cancel",
  /* 23*/ "out or add back a security administrator.)",
  /* 24*/ "This User ID already exists.",
  /* 25*/ "User IDs must be unique within each database.",
  /* 26*/ "The User ID cannot be the unknown value.",
  /* 27 */ " Invalid domain name entered."
].

/* Form variables */
DEFINE VARIABLE ulist AS CHAR NO-UNDO INITIAL ?
   VIEW-AS SELECTION-LIST SINGLE INNER-CHARS 45 INNER-LINES 8 SCROLLBAR-V.

DEFINE BUTTON btn_add LABEL "&Add..."    SIZE 12 BY 1.
DEFINE BUTTON btn_mod LABEL "&Modify..." SIZE 12 BY 1.
DEFINE BUTTON btn_del LABEL "&Delete..." SIZE 12 BY 1.

/* Miscellaneous */
DEFINE VARIABLE stat          AS LOGICAL NO-UNDO.
DEFINE VARIABLE answer        AS LOGICAL               NO-UNDO.
DEFINE VARIABLE changed       AS LOGICAL INITIAL NO    NO-UNDO.
DEFINE VARIABLE istrans       AS LOGICAL INITIAL TRUE. /* (not no-undo!) */
DEFINE VARIABLE user_cnt_in   AS INTEGER INITIAL 0     NO-UNDO. 
DEFINE VARIABLE user_cnt_out  AS INTEGER INITIAL 0     NO-UNDO. 
DEFINE VARIABLE ix            AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE num  	      AS INTEGER               NO-UNDO.
DEFINE VARIABLE lhasPassword  AS LOGICAL               NO-UNDO.
 

DEFINE VARIABLE domainType    AS CHARACTER INITIAL "_oeusertable" NO-UNDO.
 /*
DEFINE VARIABLE cmb-domain-name AS CHARACTER FORMAT "X(256)":U 
     LABEL "Domain Name"
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST SORT
     SIZE 42 BY 1
      NO-UNDO.
*/
define button btnDomain size 19 by 1.

define buffer b_user for dictdb._user.

DEFINE QUERY qUser FOR  b_user SCROLLING.

DEFINE BROWSE bUser QUERY qUser
    DISPLAY b_User._Userid  column-label "User ID" 
            b_User._Domain-Name  column-label "Domain Name" 
            width 42      
            b_User._User-Name  column-label "User Name"  width 20
            b_User._Password <> ENCODE("") @ lhasPassword 
                                          column-label "Password"        
            b_User._Sql-only-user column-label "SQL Only"
            
    WITH NO-ROW-MARKERS SEPARATORS 6 down.

FORM
   bUser  AT ROW 1.24 COL 1.8  SKIP({&VM_WIDG}) 
   {prodict/user/userbtns.i}
   btn_add     	     	      	       AT COL 103 ROW 1.24 SKIP({&VM_WID})
   btn_mod     	     	      	       AT 103	           SKIP({&VM_WID})   
   btn_del     	     	      	       AT 103  	      	   SKIP({&VM_WID})
   WITH FRAME usr_lst WIDTH 116 /* no particular reason */
   CENTERED SIDE-LABELS 
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   VIEW-AS DIALOG-BOX TITLE "Edit User List".

FORM
   SKIP({&TFM_WID})
   _User._Userid      {&STDPH_FILL} LABEL "User ID"   COLON 16 
    view-as fill-in size 17 by 1   SKIP ({&VM_WID})
   _user._domain-name    {&STDPH_FILL} LABEL "Domain Name"     COLON 16 
    view-as fill-in size 64 by 1    
     btnDomain label "Select Domain..." SKIP({&VM_WID})
    /* cmb-domain-name at col 16 row-of btnDomain  colon-aligned */
   _User._User-Name   {&STDPH_FILL} LABEL "User Name"     COLON 16 
    view-as fill-in size 64 by 1   SKIP ({&VM_WID})
   _User._Password    {&STDPH_FILL} LABEL "Password"     COLON 16 PASSWORD-FIELD  
    view-as fill-in size 17 by 1   SKIP ({&VM_WID})
   _User._sql-only-user {&STDPH_FILL} LABEL "SQL Only"  COLON 16
   {prodict/user/userbtns.i}
   WITH FRAME usr_mod 
   CENTERED SIDE-LABELS   
   width 103
   DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
   VIEW-AS DIALOG-BOX.

 

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/


/*========================Internal Procedures=============================*/

/*--------------------------------------------------------------------
   Show information on the user selected in the information area.

   Input Parameter:
      p_Id = If ? - We've already got the record, display values 
      	     else - Get the record with this userid and 
      	       	    display the values (it may be "" if no users).
---------------------------------------------------------------------*/

function FullUserId returns char(id as char, name as char):
    if name = "" then 
        return id.
    else 
        return id + "@" + name.           
end.     

function GetDomainList returns char (pType as char,pdelimiter as char):
    define variable domainList as character no-undo. 
    run prodict/pro/_pro_domain_list.p(pType,pdelimiter,output domainList). 
    return domainlist.
end.     

procedure openQuery:
    define input  parameter rcurrent as rowid no-undo.    
    open query qUser for each b_user no-lock by b_user._userid by b_user._domain-name .
    if rCurrent = ? then
        reposition quser to row 1.
    else do:
        reposition quser to rowid rCurrent. 
    end.    
end.
/*  
Procedure initModFrame: 
    /* "fillin" "combo" or "browse" */
    define input  parameter pMode as character no-undo.
    define variable hlabel as handle no-undo.
    
    do with frame usr_mod:
       _User._Domain-name:hidden = pmode = "combo" .
       btnDomain:hidden = pmode <> "browse".
       cmb-domain-name:hidden = pmode <> "combo" .
       if pmode = "combo" then 
       do: 
           if cmb-domain-name:list-items = ? then
               cmb-domain-name:list-items = getDomainList(domainType,cmb-domain-name:delimiter).     
           cmb-domain-name:inner-lines = min(9,num-entries(cmb-domain-name:list-items)).
       end.   
   end.  
end procedure.   
   */
Procedure selectDomain :
    define variable domaindlg as prodict.pro._domain-sel-presenter no-undo.
    domaindlg = new  prodict.pro._domain-sel-presenter ().
    do with frame usr_mod:
      
       domaindlg:Row = btnDomain:row + btnDomain:height +  frame usr_mod:row + 0.5.
       domaindlg:Col =  _user._domain-name:col + frame usr_mod:col .
       domaindlg:QueryString = "for each ttdomain where ttdomain.DomainTypeName = " + quoter(domainType) .
   
       domaindlg:Title = "Select Domain".
/*    glInSelect = true. /* stop end-error anywhere trigger */*/
       if domaindlg:Wait() then 
         _user._domain-name:screen-value = domaindlg:ColumnValue("ttdomain.Name").
/*    glInSelect = false.*/
   end.
end.   

/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame usr_lst
   or CHOOSE of btn_Help in frame usr_lst
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Edit_User_List_Dlg_Box},
      	       	     	     INPUT ?).

on HELP of frame usr_mod
   or CHOOSE of btn_Help in frame usr_mod
do: 
   IF FRAME usr_mod:TITLE = new_lang[9] then
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
       	       	     	       INPUT {&Add_User_Dlg_Box},
      	       	     	       INPUT ?).
   else
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Modify_User_Dlg_Box},
      	       	     	       INPUT ?).
end.
&ENDIF


/*----- ON HIT OF OK BUTTON or GO -----*/
ON GO OF FRAME usr_lst
DO:
   DEFINE VAR rec_id AS RECID NO-UNDO.

   /* user_cnt_out: 0=none, 1=many - that's all we need to know */
   if integer(dbversion("DICTDB":U)) > 10 then 
      user_cnt_out = (IF can-find( first _User where _User._sql-only-user = false ) THEN 1 ELSE 0).
   
   else  
      user_cnt_out = (IF can-find( first _User) THEN 1 ELSE 0).

   IF user_cnt_in = 0 AND user_cnt_out = 0 
      THEN RETURN.   /* don't care */
   ELSE
   IF user_cnt_out > 0 THEN DO: 
      /* some user left (though may not be one we had to start with -
      	 killed last sec adm? */
      rec_id = RECID(_User). /* save current id */
      answer = FALSE.
      if integer(dbversion("DICTDB":U)) > 10 then 
      do:
          FOR EACH _User where _User._sql-only-user = false WHILE NOT answer:
              RUN "prodict/_dctadmn.p"  /* determines if user is sec administrator */
                 (FullUserId(_User._Userid,_User._Domain-Name), OUTPUT answer).
          END.
      end.
      else do:
          FOR EACH _User  WHILE NOT answer:
              RUN "prodict/_dctadmn.p"  /* determines if user is sec administrator */
                (FullUserId(_User._Userid,_User._Domain-Name), OUTPUT answer).
         END.
      end.          
     
      IF NOT answer THEN DO:
      	 /* There are no administrators */
      	 MESSAGE new_lang[14] SKIP  
      	       	 new_lang[15] SKIP
      	         new_lang[16] SKIP
      	         new_lang[17] 	 
      	       	 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      	 FIND _User WHERE RECID(_User) = rec_id. /* Reset current user rec */
      	 RETURN NO-APPLY.
      END.
   END.
   ELSE DO: /* user_cnt_out = 0 */
      /* Make sure user wants to set all schema table privileges to * */
      MESSAGE new_lang[18] SKIP
      	      new_lang[19] SKIP
      	      new_lang[20] SKIP
      	      new_lang[21] SKIP(1)
      	      new_lang[22] SKIP
      	      new_lang[23] 	 
      	      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
      IF NOT answer THEN 
       	 RETURN NO-APPLY.
      
      /* set the security administrator fields back to "*" */
      FIND _File "_File" WHERE _File._Db-recid = drec_db
                           AND _File._Owner = "PUB".
      FIND _Field "_Can-read"   OF _File.
      _Field._Can-write = "*".
      FIND _Field "_Can-write"  OF _File.
      _Field._Can-write = "*".
      FIND _Field "_Can-create" OF _File.
      _Field._Can-write = "*".
      FIND _Field "_Can-delete" OF _File.
      _Field._Can-write = "*".
 
      FIND _File "_Field" WHERE _File._Db-recid = drec_db
                            AND _File._Owner = "PUB".
      FIND _Field "_Can-read"   OF _File.
      _Field._Can-write = "*".
      FIND _Field "_Can-write"  OF _File.
      _Field._Can-write = "*".
 
      FIND _File "_User" WHERE _File._Db-recid = drec_db
                           AND _File._Owner = "PUB".
      ASSIGN
	   _File._Can-create = "*"
	   _File._Can-delete = "*".

      FIND _File "_Db-Option" NO-ERROR.
      IF AVAILABLE _File THEN
          ASSIGN _File._Can-create = "*" 
                 _File._Can-write = "*"
                 _File._Can-delete = "*".

      FIND _File "_Db-Detail" NO-ERROR.
      IF AVAILABLE _File THEN
          ASSIGN _File._Can-create = "*" 
                 _File._Can-write = "*"
                 _File._Can-delete = "*".

      FIND _File "_Db".
      FIND _Field "_Db-guid" OF _File NO-ERROR.
      IF AVAILABLE _Field THEN
          ASSIGN _Field._Can-write = "*".

   END.
END.

/*----- ON HIT of CANCEL BUTTON or ENDKEY -----*/
ON CHOOSE OF btn_Cancel IN FRAME usr_lst OR ENDKEY OF FRAME usr_lst
DO:
   IF NOT changed THEN RETURN.  

   answer = yes.
   MESSAGE new_lang[6] /* Are you sure */
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
   IF NOT answer THEN
      RETURN NO-APPLY.
   ELSE
      changed = no.  /* reset */
END.

/*----- DEFAULT-ACTION (DBL-CLICK) OF USER LIST -----*/
ON DEFAULT-ACTION OF bUser IN FRAME usr_lst
   APPLY "CHOOSE" TO btn_mod IN FRAME usr_lst.


/*----- HIT OF tenant BUTTON -----*/
ON CHOOSE OF btnDomain IN FRAME usr_mod 
do: 
    run selectDomain.
end.

/*----- HIT OF ADD BUTTON -----*/
ON CHOOSE OF btn_add IN FRAME usr_lst 
DO:
   DEFINE VARIABLE passwd AS CHARACTER NO-UNDO.
   DEFINE VARIABLE encpwd AS CHARACTER NO-UNDO.   
       
   /*----- GO or HIT of OK BUTTON IN ADD FRAME -----*/
   ON GO OF FRAME usr_mod
   DO:	 
      IF _User._Userid:SCREEN-VALUE IN FRAME usr_mod = "?" THEN DO:
      	 MESSAGE new_lang[26] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      	 APPLY "ENTRY" TO _User._Userid IN FRAME usr_mod.
      	 RETURN NO-APPLY.
      END.

      /* Make sure Id is unique */
      IF SELF:SCREEN-VALUE <> "?" AND
         (CAN-FIND(_User USING INPUT FRAME usr_mod _User._Userid
                         WHERE INPUT _User._Domain-Name = _User._Domain-Name)) THEN DO:
         MESSAGE new_lang[24] SKIP new_lang[25] /* Id not unique */
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
         APPLY "ENTRY" TO _User._Userid IN FRAME usr_mod.   
         RETURN NO-APPLY.
      END.   

      /* Verify password if one was typed in */
      passwd = INPUT FRAME usr_mod _User._Password.
      IF passwd = ? THEN passwd = "".
      encpwd = ENCODE(passwd).
      
      IF _User._Domain-Name:screen-value <> "" then
      DO:
         IF NOT can-find(FIRST DICTDB._sec-authentication-domain 
                           WHERE DICTDB._sec-authentication-domain._Domain-name = _User._Domain-Name:screen-value) then
         DO:
             MESSAGE new_lang[27]
                  VIEW-AS ALERT-BOX.
             RETURN NO-APPLY.
         END.                     
      END.
      IF passwd <> "" THEN DO:
	 RUN "prodict/user/_usrpwd2.p" (INPUT encpwd, OUTPUT answer).
	 IF answer = NO THEN DO:
	    MESSAGE new_lang[11] SKIP  /* didn't type same passwd each time */
		    new_lang[12]       /* no user record created */
		    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
	    RETURN NO-APPLY.
	 END.
	 ELSE IF answer = ? THEN 
	    RETURN NO-APPLY.
      END.
     
       
   END.   /*-End of OK trigger-*/

   /*----- LEAVE of USERID IN ADD FRAME -----*/
/*  moved to ON GO...
   ON LEAVE OF _User._Userid IN FRAME usr_mod
   DO:
      /* Make sure Id is unique */
      IF SELF:SCREEN-VALUE <> "?" AND
      	 (CAN-FIND(_User USING INPUT FRAME usr_mod _User._Userid
      	                 WHERE cmb-domain-name:INPUT-VALUE = _User._Domain-Name)) THEN DO:
      	 MESSAGE new_lang[24] SKIP new_lang[25] /* Id not unique */
      	    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      	 RETURN NO-APPLY.
      END. 	 
   END.
   /*-End of LEAVE trigger-*/
*/
  
   
   FRAME usr_mod:TITLE = new_lang[9].
   DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE WITH FRAME usr_mod:
      
      CREATE _User.
      DISPLAY "" @ _User._Userid
              "" @ _User._Domain-Name 
              "" @ _User._User-name
              "" @ _User._Password
              _User._sql-only-user
             . 
      SET    _User._Userid 
             _User._Domain-Name  
              btnDomain         
             _User._User-name 
             _User._Password 
             _User._sql-only-user
      	     btn_OK btn_Cancel {&HLP_BTN_NAME}. 
       
      ASSIGN      
        _User._Password  = encpwd
        changed = yes.
         
      ASSIGN
      	 num = num + 1
      	 btn_mod:sensitive IN FRAME usr_lst = yes
      	 btn_del:sensitive IN FRAME usr_lst = yes.
      	       	 
      /* validate ensures row is written to buffer (in case not all fields in (a unique?) index is updated) */	 
     
      validate _user.
       
      run openQuery(rowid(_user)).
   
   END.
      
END.


/*----- HIT OF MODIFY BUTTON -----*/
ON CHOOSE OF btn_mod IN FRAME usr_lst 
DO:
   FRAME usr_mod:TITLE = new_lang[10].
   
   /* we avoid combo for domain-name since the combo has _oeusertable domains
      but we do allow a domain to change to another type even if it has users */
   
   btnDomain:hidden = yes.  
   find _user where rowid(_user) = rowid(b_user) exclusive no-error.
  
   if avail _user then 
   do:
       DISPLAY _User._Userid 
               _User._domain-name 
               IF _User._Password = ENCODE("") THEN "" ELSE "aaaaaaaaaaaa" @ _User._Password
               _User._sql-only-user 
       
       WITH FRAME usr_mod.
       DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
          UPDATE _User._Domain-Name  
                 btnDomain         
                 _User._User-name 
                _User._sql-only-user
          	     btn_OK btn_Cancel {&HLP_BTN_NAME}
          	     WITH FRAME usr_mod.
    
    /*      _User._Domain-Name = cmb-domain-name:INPUT-VALUE. */
          changed = yes.
          reposition qUser to rowid rowid(_user).
          display b_User._User-name with browse buser.    
       END.
      
   end.
END.


/*----- HIT OF DELETE BUTTON -----*/
ON CHOOSE OF btn_del IN FRAME usr_lst 
DO:
   DEFINE VAR row_id  AS ROWID NO-UNDO.
    
   DEFINE VAR prev_id  AS ROWID NO-UNDO.
   DEFINE VAR del_uid AS CHAR  NO-UNDO.  /* User id deleted */
   
   if avail b_user then 
   do:
       row_id = ROWID(b_User).  /* save current recid and user id */
       get prev qUser.
       prev_id  = ROWID(b_User).
       reposition qUser to rowid row_id.
       del_uid = FullUserId(b_User._Userid,b_User._Domain-Name).
        
       /* Do some checking if user tries to delete his own Id */ 
       IF del_uid = USERID(user_dbname) THEN DO:
          IF CAN-FIND(FIRST _User WHERE ROWID(_User) ne row_id)  THEN 
          DO:
           	 MESSAGE new_lang[4] /* can only delete self if last user */
          	    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
           	 RETURN.
          END.
       END.
       find _user where rowid(_user) =  row_id  exclusive .
       DO ON ERROR UNDO,LEAVE:
          MESSAGE new_lang[5] 
          	 VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
          IF answer THEN DO:
             find current _user exclusive. 
           	 DELETE _User.
           	 num = num - 1.
          	 changed = yes.
             
             get next qUser.
             if avail b_user then 
             do:
              
                 run openQuery(ROWID(b_User)). 
             end.
             else if prev_id <> ? then
             do:
                 run openQuery(prev_id). 
             end.    
             else do:
                 run openQuery(?). 
                 if not avail b_user then
          	     DO:
          	         ASSIGN
          	             btn_mod:sensitive IN FRAME usr_lst = no
          	             btn_del:sensitive IN FRAME usr_lst = no.
          	     END.
          	 end.
          END.
       END.
   end.
END.


/*----- WINDOW-CLOSE -----*/
ON WINDOW-CLOSE OF FRAME usr_lst
   APPLY "END-ERROR" TO FRAME usr_lst.
ON WINDOW-CLOSE OF FRAME usr_mod
   APPLY "END-ERROR" to FRAME usr_mod.

/*============================Mainline code===============================*/

DO ON ERROR UNDO:
  istrans = FALSE.
  UNDO,LEAVE.
END.
 
RUN "prodict/_dctadmn.p" (INPUT USERID(user_dbname),OUTPUT answer).
IF NOT answer                THEN ix = 3. /* secu admin? */
IF istrans OR PROGRESS = "Run-Time" OR
   CAN-DO("READ-ONLY",DBRESTRICTIONS(user_dbname)) 
      	       	     	     THEN ix = 13. /* r/o mode */
IF USERID(user_dbname) = "" then 
do:
    if integer(dbversion("DICTDB":U)) > 10 then
    do: 
        if CAN-FIND(FIRST _User where _user._sql-only-user = false) THEN 
            ix = 2. /* userid set? */
    end.
    else do: 
        if CAN-FIND(FIRST _User) then
            ix = 2. /* userid set? */
    end. 
end.
IF user_dbtype <> "PROGRESS" THEN ix = 1. /* dbtype okay */

IF ix <> 0 THEN DO:
  MESSAGE new_lang[ix] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

/* user_cnt_in: 0=none, 1=many - that's all we need to know */
if integer(dbversion("DICTDB":U)) > 10 then 
do:     
    
    FIND FIRST _User where _User._sql-only-user = false  NO-ERROR.
end.
else do:
    FIND FIRST _User NO-ERROR.
end.

user_cnt_in = (IF AVAILABLE _User THEN 1 ELSE 0).
   
PAUSE 0.

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME usr_lst" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}
{adecomm/okrun.i  
    &FRAME  = "FRAME usr_mod" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}

/* Fill the list of current users  */
num = 0.

FOR EACH _User no-lock:
   num = num + 1.
END.

run openQuery(?). 
 
DO TRANSACTION ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   ENABLE
      bUser
      btn_add 
      btn_mod WHEN num > 0
      btn_del WHEN num > 0
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME usr_lst.
   
   btn_mod:MOVE-AFTER-TAB-ITEM(btn_add:HANDLE IN FRAME usr_lst).
   btn_del:MOVE-AFTER-TAB-ITEM(btn_mod:HANDLE IN FRAME usr_lst).
   WAIT-FOR CHOOSE OF btn_OK IN FRAME usr_lst OR
      GO OF FRAME usr_lst
      FOCUS bUser.
END.

HIDE FRAME usr_lst NO-PAUSE.
RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*----------------------------------------------------------------------------

File: _guivget.p
 
Description: Select a view.

INPUT:
   user_env[1] MATCHES "*a*":
   If this program sees an "a" (for "all"), then "ALL" is a valid choice.
   
OUTPUT:
   user_env[1] contains the view name selected, or 'ALL'.

Last Modified on 10/31/94 by GFS - disallow bad view name entered
                  07/14/98 by DLM - Added _Owner to _file finds

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE NOTTCACHE 1

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ adecomm/cbvar.i }

/* Form variables */
Define var vprompt as char     NO-UNDO.
Define var vfill    as char    NO-UNDO.
Define var vlist    as char    NO-UNDO.

/* Miscelaneous */
Define var p_all  as logical NO-UNDO.
Define var stat	  as logical       NO-UNDO.
Define var ix	  as integer       NO-UNDO init 0. /* temp looping variable */
Define var access as logical       NO-UNDO.
Define var msg	  as char extent 2 NO-UNDO init
[
  /* 1 */ "You do not have permission to select views.",
  /* 2 */ "There are no views in this database to select."
].


/*================================Forms====================================*/

/* I couldn't get this to work really well under both enviroments so
   here's two slightly different frame layouts.
*/
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
FORM 
   vprompt    at 3 FORMAT "x(32)" view-as TEXT	 SKIP(1) 

   vfill      at 3 FORMAT "x(32)"  SKIP
   vlist      at 3 
      	      view-as SELECTION-LIST SINGLE 
      	      SIZE 32 by 12 SCROLLBAR-V     	 SKIP(1)
   {prodict/user/userbtns.i}
   with frame view_get 
      	view-as DIALOG-BOX title "Select Views"
        CENTERED NO-LABELS
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.
&ELSE
FORM 
   SKIP({&TFM_WID})
   vprompt    at 3 FORMAT "x(32)" view-as TEXT 	 SKIP({&VM_WID}) 

   vfill      at 3 FORMAT "x(32)"  {&STDPH_FILL} SKIP
   vlist      at 3 
      	      view-as SELECTION-LIST SINGLE 
      	      INNER-CHARS 32 INNER-LINES 12 
      	      SCROLLBAR-V
   {prodict/user/userbtns.i}
   with frame view_get 
      	view-as DIALOG-BOX title "Select Views"
        CENTERED NO-LABELS 
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.
&ENDIF

/*===============================Triggers==================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame view_get
   or CHOOSE of btn_Help in frame view_get
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&List_Views_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


/*----- GO OR CHOOSE of OK BUTTON-----*/
on GO of frame view_get    /* or OK due to auto-go */
do:
   vfill = vfill:screen-value in frame view_get.

   if NOT (vfill = "ALL" AND p_all) AND
      vlist:LOOKUP(vfill) = 0 then
   do:	 
      message "The name entered does not match" SKIP
      	      "any view name in this database."
      	      view-as ALERT-BOX ERROR buttons OK.
      apply "entry" to vfill in frame view_get.
      return NO-APPLY.
   end.

   user_env[1] = vfill.
end.


/*----- DEFAULT-ACTION of OK SELECT LIST-----*/
on default-action of vlist in frame view_get 
   apply "choose" to btn_OK in frame view_get.

ON WINDOW-CLOSE OF FRAME view_get
   APPLY "END-ERROR" TO FRAME view_get.

/*==============================Mainline code=============================*/

DEFINE VARIABLE l AS LOGICAL NO-UNDO.

if NOT CAN-FIND(FIRST DICTDB._View) then
   ix = 2. /* there are no views */

do for DICTDB._File:
   find _File "_View" WHERE _File._Owner = "PUB" NO-LOCK.
   access = CAN-DO(_Can-read,USERID("DICTDB")).
   if access then
   do:
      find _File "_View-ref" WHERE _File._Owner = "PUB" NO-LOCK.
      access = CAN-DO(_Can-read,USERID("DICTDB")).
   end.
   if access then
   do:
      find _File "_View-col" WHERE _File._Owner = "PUB" NO-LOCK.
      access = CAN-DO(_Can-read,USERID("DICTDB")).
   end.
   if NOT access THEN ix = 1. /* You're not supposed to see any views */
end.

IF ix > 0 then
do:
  message msg[ix] view-as ALERT-BOX ERROR buttons OK.
  assign
    user_path   = ""
    user_env[1] = "".
  return.
END.

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
   &FRAME  = "FRAME view_get" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}
p_all = (if user_env[1] MATCHES "*a*" then yes else no).
if p_all then
   vprompt = "Select a view or type ~"ALL~".".
else
   vprompt = "Select a view.".

for each DICTDB._View:
   stat = vlist:add-last(DICTDB._View._View-name) in frame view_get.
end.

{adecomm/cbdown.i &Frame  = "frame view_get"
		  &CBFill = "vfill"
		  &CBList = "vlist"
		  &CBInit = """"}

display vprompt with frame view_get.
enable  vfill	 
      	vlist 
   	btn_OK
   	btn_Cancel
        {&HLP_BTN_NAME}
   	with frame view_get.

user_status = "Press the" + " [" + KBLABEL("END-ERROR") + "] " + "key to end.".
STATUS DEFAULT user_status.

user_env[1] = "".
do ON ENDKEY UNDO, LEAVE:
   wait-for GO of frame view_get.   /* or OK - due to auto-go */
end.

user_status = ?.
STATUS DEFAULT.

IF user_env[1] = "" THEN user_path = "".
hide frame view_get no-pause.
return.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _savefld.p

Description:
   Save any changes the user made in the field property window.

Author: Mario Brunetti

Date Created: 04/02/99

-----------------------------------------------------------------------------*/

/*--------------------------------- Definitions -----------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
&GLOBAL-DEFINE WIN95-BTN YES
{adedict/dictvar.i shared}
{adedict/brwvar.i shared}
{adedict/menu.i shared}
{adedict/uivar.i shared}
{adecomm/cbvar.i shared}
&ELSE
{prodict/dictvar.i}  /* automatically shared unless "new" is passed in char */
&ENDIF
{prodict/gui/widthvar.i shared}

DEF VAR rows-changed AS LOGICAL NO-UNDO.
DEF VAR ret-val      AS CHAR    NO-UNDO.

RUN adecomm/_setcurs.p (INPUT "WAIT").

/*--------------------------------- Mainline Code ----------------------------*/
width-subtran:
DO ON ERROR UNDO, LEAVE
   ON STOP  UNDO, LEAVE:
    
   save-changed: 
   FOR EACH w_Field:
  
      FIND _Field WHERE 
         _Field._File-Recid = w_Field._File-Recid AND
         _Field._Field-Name = w_Field._Field-NAME
      EXCLUSIVE-LOCK NO-ERROR.   
      IF NOT AVAIL _Field THEN
      DO:
         MESSAGE "A row that was changed has since been deleted." SKIP
                 "Changes will be backed out.  Please click OK." 
         VIEW-AS ALERT-BOX.
         ret-val = "error".
         RUN adecomm/_setcurs.p (INPUT "").
         UNDO, LEAVE width-subtran.
         /* I don't like the above either,                           *
          * but it's backward compatable with the existing code base */
      END.
      IF _Field._Width = w_Field._Width THEN NEXT save-changed.
      ASSIGN _Field._Width = w_Field._Width
             rows-changed = YES.
   END.

   IF rows-changed THEN
   DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
         dict_dirty = YES.
      &ELSE
         {adedict/setdirty.i &Dirty = "true"}
      &ENDIF
   END.
       
END.

RUN adecomm/_setcurs.p (INPUT "").

RETURN ret-val.
/*********************************************************************
* Copyright (C) 2006,2008-2009 by Progress Software Corporation. All *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: prodict/gui/guigget.i


Description:   
   Select one or more objects from the list of records in the gatework
   temp-table. 

   GUI-behaviour:
        * select/deselect object to pull/verify/transfer by either
          - double-clicking on it
          - pressing the spacebar
          - pressing the return/enter key
        * updating report-window by value-changed
        * persistent procedure to display the reports
        * single mouse click selects object without "updating" it
        * cursor-up/cursor-down are disabled
   TTY-behaviour:
        * select/deselect object to pull/verify/transfer by either:
          - pressing the spacebar
          - pressing the return/enter key
        * cursor keys are enabled
        * REPORT not available
        * overlay-frame to display the verify-reports (???)
   
Input: 
    Workfile gate-work contains info on all the gateway objects.
    p_Gate      Name of the gateway, e.g., "Oracle".
    p_sel-type  "Pull"      when seelcting objects to pull info
                            into s_ttb-tables
                "Compare"   to browse differences

Output:
    gatework.gate-flag = "yes"  object to be created/updated/deleted
 
Returns:
    "ok"     if 1 or more tables were chosen.
    "cancel" if user cancelled out.

Author: Laura Stern

Date Created : 07/28/93 

History:
    hutegger    95/03   extented functionality to get used for create, update
                        and browse differences
    gfs         94/07   Install correct help contexts
    gfs         94/05   Changed Selection-List to Browse
    kmcintos    03/05   Changed "Object Owner" to "Owner/Library" for DB2/400
                        Bug # 20041220-008
----------------------------------------------------------------------------*/

Define INPUT PARAMETER p_Gate       as char NO-UNDO.
Define INPUT PARAMETER p_Sel-Type   as char NO-UNDO.
&IF DEFINED(GATE_OMIT_PARM3) = 0 &THEN
Define INPUT PARAMETER p_Gate_AS400 as LOGICAL NO-UNDO.
&ENDIF

define new shared variable s_edt_diff   as character NO-UNDO.
define new shared variable s_tgl_upd    as logical   NO-UNDO.

&SCOPED-DEFINE xxDS_DEBUG   DEBUG
&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER
Define var canned      as logical NO-UNDO init TRUE.
Define var flg2patt    as logical NO-UNDO.
Define var inc_user    as logical NO-UNDO.
Define var inc_qual    as logical NO-UNDO.
Define var ix	       as integer NO-UNDO init 0. /* temp looping variable */
Define var l_logical   as logical NO-UNDO. /* result flag for methods */
Define var l_prc_diff  as handle  NO-UNDO.
define var l_wdw_brws  as widget-handle NO-UNDO.
define var l_wdw_old   as widget-handle NO-UNDO.

Define var lsthead     as char    NO-UNDO.
Define var name	       as char    NO-UNDO.
Define var pprompt     as char    NO-UNDO.
Define var qual	       as char    NO-UNDO.
Define var qualpatt    as char    NO-UNDO.
Define var slctpatt    as logical NO-UNDO.
Define var stat	       as logical NO-UNDO.
Define var tblpatt     as char    NO-UNDO.
Define var text1       as char    NO-UNDO format "x(76)".
Define var text2       as char    NO-UNDO format "x(76)".
Define var type	       as char    NO-UNDO.
Define var typpatt     as char    NO-UNDO.
Define var usr	       as char    NO-UNDO.
Define var usrpatt     as char    NO-UNDO.
define var curshit     as logical NO-UNDO init no.
define var is_as400sh  as logical NO-UNDO init FALSE.

DEFINE QUERY qgate-work FOR gate-work SCROLLING.

DEFINE BROWSE bgate-work QUERY qgate-work
    DISPLAY gate-flag FORMAT "*/"        NO-LABEL
            gate-name FORMAT "X(30)" COLUMN-LABEL "Object Name"
            &IF "{&GATE_FLG2}" = "YES"
             &THEN gate-flg2 FORMAT "yes/no"   COLUMN-LABEL "Changed"
             &ENDIF
            gate-user FORMAT "X(16)" 
            gate-type FORMAT "X(11)" COLUMN-LABEL "Object Type"
            gate-qual FORMAT "X(22)" COLUMN-LABEL "Qualifier"
  WITH SIZE 75 BY 12 FONT 0 /*MULTIPLE*/.

&IF DEFINED(GATE_OMIT_PARM3) = 0 &THEN
IF p_Gate_AS400 THEN DO:
     gate-user:label IN BROWSE bgate-work = "Col/Lib". 
     is_AS400sh = TRUE.
END.
ELSE 
&ENDIF
     gate-user:label IN BROWSE bgate-work = "Owner".

&IF "{&WINDOW-SYSTEM}" = "TTY"
 &THEN
  Define button btn_select       label "(S)elect Some..."    SIZE 18 BY 1.
  Define button btn_deselect     label "(D)eselect Some..."  SIZE 18 BY 1.
  &IF "{&GATE_FLG2}" = "YES"
   &THEN Define button btn_print label "(P)rint Reports..."  SIZE 18 BY 1.
   &ENDIF
 &ELSE
  Define button btn_select       label "&Select Some..."     SIZE 18 BY 1.
  Define button btn_deselect     label "&Deselect Some..."   SIZE 18 BY 1.
  Define button btn_diff         label "Close &Reports"      SIZE 18 BY 1.
  &IF "{&GATE_FLG2}" = "YES"
   &THEN Define button btn_print label "&Print"            {&STDPH_OKBTN}.
   &ENDIF
 &ENDIF
 

/*================================Forms====================================*/

/* create window */
&IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  create window l_wdw_brws
  assign
    HIDDEN              = YES
    TITLE               = "Schema-Verify - Detected Differences"
    HEIGHT              = 19.5
    WIDTH               = 80
    MAX-HEIGHT          = 19.5
    MAX-WIDTH           = 80
    VIRTUAL-HEIGHT      = 19.5
    VIRTUAL-WIDTH       = 80
    RESIZE              = no
    SCROLL-BARS         = no
    STATUS-AREA         = no
    BGCOLOR             = ?
    FGCOLOR             = ?
    KEEP-FRAME-Z-ORDER  = yes
    THREE-D             = yes
    MESSAGE-AREA        = no
    SENSITIVE           = yes.
 &ENDIF

FORM
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN                                                 SKIP({&TFM_WID})
   &ENDIF
  text1  format "x(76)"                at 2 view-as TEXT SKIP
  text2  format "x(76)"                at 2 view-as TEXT SKIP({&VM_WIDG})

  &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN btn_select                           at  2 SPACE(2)
  &ELSEIF "{&GATE_FLG2}" = "YES"
   &THEN btn_select                           at 10 SPACE(2)
   &ELSE btn_select                           at 20 SPACE(2)
   &ENDIF
  btn_deselect                              SPACE(2)
  &IF "{&GATE_FLG2}" = "YES"
   &THEN
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN btn_diff                                      SKIP({&VM_WIDG})
     &ELSE btn_print                                     SKIP /*({&VM_WIDG})*/
     &ENDIF
   &ELSE                                                 SKIP({&VM_WIDG})
   &ENDIF

  bgate-work                           at 2

  &IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN
    {prodict/user/userbtns.i
      &OTHER = "btn_print"
      }
   &ELSE
    {prodict/user/userbtns.i }
   &ENDIF
  with frame gtbl_get
    &IF "{&GATE_FLG2}" <> "YES" 
     &THEN view-as DIALOG-BOX
     &ELSE size 79 by 19.5
     &ENDIF
    TITLE "Select " + p_Gate + " Objects"
    CENTERED NO-LABELS SCROLLABLE overlay
    /*DEFAULT-BUTTON btn_OK*/ CANCEL-BUTTON btn_Cancel.
    /* The default-button is commented out because 
     * double-clicking on the browse causes the button to fire 
     */

FORM 
   SKIP({&TFM_WID})
   "Enter object information to"       at  2 view-as TEXT
   pprompt           FORMAT "x(10)" NO-LABEL view-as TEXT SKIP
   "Use '*' and '.' for wildcard patterns." 
                                       at  2 view-as TEXT SKIP({&VM_WIDG})

   tblpatt  FORMAT "x(29)"  LABEL "Object Name" 
                                    colon 14 {&STDPH_FILL} SKIP({&VM_WID})
   usrpatt  FORMAT "x(15)"   
                                    colon 14 {&STDPH_FILL} SKIP({&VM_WID})
   typpatt  FORMAT "x(15)"  LABEL "Object Type" 
                                    colon 14 {&STDPH_FILL} SKIP({&VM_WID})
   qualpatt FORMAT "x(22)"  LABEL "Qualifier"  
                                    colon 14 {&STDPH_FILL} SKIP({&VM_WID})
    &IF "{&GATE_FLG2}" = "YES" 
     &THEN 
   flg2patt FORMAT "yes/no"  LABEL "Changed"  
                                    colon 14 {&STDPH_FILL} SKIP({&VM_WID})
    &ENDIF
   {prodict/user/userbtns.i}
   with frame tbl_patt 
      	view-as DIALOG-BOX TITLE "Select Objects by Pattern Match"
        SIDE-LABELS CENTERED 
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.

&IF DEFINED(GATE_OMIT_PARM3) = 0 &THEN
IF p_Gate_AS400 THEN DO:
     usrpatt:label IN frame tbl_patt = "Col/Lib".
     is_AS400sh = TRUE.
END.
ELSE
&ENDIF
     usrpatt:label IN frame tbl_patt = "Owner".

&IF "{&WINDOW-SYSTEM}" = "TTY"
 &THEN
  form
                                                        skip({&TFM_WID})
   "Verifying this object resulted in these messages:" 
                                    at  2 view-as TEXT  skip({&VM_WID})
    gate-work.gate-edit at  2 
                        view-as EDITOR
                        scrollbar-horizontal scrollbar-vertical
                        inner-chars 47 inner-lines 12   skip({&VM_WID})
    with row 2 column 28 overlay
    no-labels
    frame frm_report.
  &ENDIF

/*===============================Triggers==================================*/

  /*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  on HELP of frame gtbl_get OR CHOOSE of btn_Help in frame gtbl_get
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                 	     	     INPUT {&Select_DataServer_Tables_Dlg_Box},
        	       	     	     INPUT ?).
   
  on HELP of frame tbl_patt OR CHOOSE of btn_Help in frame tbl_patt DO:
     IF FRAME tbl_patt:TITLE = "Select Objects by Pattern Match" THEN
       RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
        	       	     	       INPUT {&Select_by_Pattern_DataServer_Dlg_Box},
        	       	     	       INPUT ?).
     ELSE 
       RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
          	       	     	       INPUT {&Deselect_by_Pattern_DataServer_Dlg_Box},
        	       	     	       INPUT ?).   
  END.
 &ENDIF
 
&IF "{&GATE_FLG2}" = "YES" 
 &THEN  /*---------------------- WITH REPORTS ---------------------*/
  /*----- CHOOSE of print BUTTON-----*/
  on choose of btn_print or "P","p" of bgate-work in frame gtbl_get do:
  
    define variable l_header1 as character format "x(78)".
    define variable l_header2 as character format "x(78)".

    assign
      l_header1 = fill(" ",integer(5 - length(p_gate,"character") / 2))
                + "Results of comparison of the {&PRO_DISPLAY_NAME} image with the " 
                + p_Gate + " DB's schema"
      l_header2 = ( if user_dbtype = "ORACLE"
                      then "SH-Name="     + SDBNAME("DICTDBG")   + " "
                         + "Image-Name="  + LDBNAME("DICTDBG")
                        /* ORACLE-DB transparent -> no more info avlble */
                      else "SH-Name="     + SDBNAME("DICTDBG")   + " "
                         + "Image-Name="  + LDBNAME("DICTDBG")   + " "
                       /*+ "DSQUERY="     + OS-GETENV("DSQUERY") + " "*/
                         + "Physcl-Name=" + PDBNAME("DICTDBG")
                  )
      l_header2 = fill(" ",integer(38 - length(l_header2,"character") / 2))
                + l_header2.

    run prodict/misc/_prt_rpt.p
      ( INPUT "prodict/gate/_gat_prt.p",
        INPUT l_header1,
        INPUT l_header2,
        INPUT "guigget",
        INPUT "a"
      ).
    end.
    
  &IF "{&WINDOW-SYSTEM}" <> "TTY" 
   &THEN /*------------------------- GUI ---------------------------*/

    /*----- CHOOSE of verify report BUTTON-----*/
    on choose of btn_diff in frame gtbl_get do:

      if valid-handle(l_prc_diff)
       and l_prc_diff:type = "procedure"
       then do:  /* stop persistent procedure */
        assign btn_diff:label in frame gtbl_get = "View &Reports...".
        APPLY "U2" to l_prc_diff.
        end.     /* stop persistent procedure */
       else do:  /* start-up persistent procedure */
        assign btn_diff:label in frame gtbl_get = "Close &Reports".
        run prodict/user/_usr_dif.p persistent set l_prc_diff
          ( INPUT THIS-PROCEDURE).
        end.     /* start-up persistent procedure */

      end.
    
    /*----- U1 from persistent proc -----*/
    on U1 of THIS-PROCEDURE 
      assign btn_diff:label in frame gtbl_get = "View &Reports...".
    
   &ELSE  /*------------------------ TTY ---------------------------*/
 
    /*----- CURSOR-RIGHT of bgate-work -----* /
    on  CURSOR-DOWN of bgate-work in frame gtbl_get
     or CURSOR-UP   of bgate-work in frame gtbl_get
     or PAGE-DOWN   of bgate-work in frame gtbl_get
     or PAGE-UP     of bgate-work in frame gtbl_get
     do:

      assign
        s_edt_diff = gate-work.gate-edit.
        
      update
       s_edt_diff
        with frame frm_report.
      /* pause. */
      hide frame report.
      end.     / * CURSOR-RIGHT of bgate-work */

   &ENDIF /*------------------------- UI ---------------------------*/

  &ENDIF /*---------------------- WITH REPORTS ---------------------*/


/*----- MOUSE-SELECT-CLICK of bgate-work browser -----*/
on mouse-select-click of bgate-work in frame gtbl_get do:
  curshit = yes.
  &if "{&window-system}" ne "tty"
   &then
    apply "value-changed" to self.
  &endif
end.

/*----- DEFAULT-ACTION, SPACEBAR or RETURN of bgate-work browser -----*/
on default-action," ",RETURN of bgate-work in frame gtbl_get do:
  curshit = no.  /* see large comment below */
  if "{&window-system}" ne "osf/motif" or
     last-event:function ne "default-action"
   then apply "value-changed" to bgate-work in frame gtbl_get.
  return no-apply.
end.
  
/* tty:
   cursor keys fire the value-changed trigger, but we don't want the
   selection to occur in this case.  Unfortunately, there does not appear
   to be a way to tell what high-level event caused the value-change, so:
   cludge #1: we need to set a flag.
   cludge #2: we need to make sure the flag is off when either 
   default-action, spacebar or return fires the value-changed trigger,
   because it can be set when the user presses the cursor keys
   on the first or last row of the browser (this does not fire the
   value-changed event, which resets the flag).
   osf/motif and ms-windows:
   we need the same sort of control, but having the trigger effectively
   disables the cursor action, so we'll settle for that.
*/
on cursor-up,cursor-down of bgate-work in frame gtbl_get 
  &if "{&window-system}" = "tty" 
   &then
    curshit = yes.
   &else
    return no-apply.
  &endif


/*----- VALUE-CHANGED of bgate-work browser -----*/
on value-changed of bgate-work in frame gtbl_get do:

  define variable l_logical    as logical.

  if  bgate-work:NUM-SELECTED-ROWS = 0
   then assign l_logical = bgate-work:select-focused-row().

  if curshit then do:
    curshit = no.

    /* refresh "detail" window if displayed */
    assign
      s_edt_diff = gate-work.gate-edit
      s_tgl_upd  = gate-work.gate-flag.    
    
    if valid-handle(l_prc_diff)
     and l_prc_diff:type = "procedure"
     then APPLY "U1" to l_prc_diff.

    /* do not select/deselect new row for update */
    return no-apply.
    end.

  if gate-work.gate-type begins "FROZEN:"
   then do:  /* tried to select FROZEN table */
    message "This Table is FROZEN; It needs to be unfrozen before" skip
            "its definition can get updated."
      view-as alert-box.
    end.     /* tried to select FROZEN table */
    
   else do:  /* tried to select NON-frozen table */
   
    assign
      gate-work.gate-flag = NOT gate-work.gate-flag
      s_edt_diff          = gate-work.gate-edit
      s_tgl_upd           = gate-work.gate-flag.

    display
      gate-work.gate-flag
      gate-work.gate-name
      &IF "{&GATE_FLG2}" = "YES" 
       &THEN gate-flg2
      &ENDIF
      gate-work.gate-user
      gate-work.gate-qual
      gate-work.gate-type
      with browse bgate-work.

    if valid-handle(l_prc_diff)
     and l_prc_diff:type = "procedure"
     then APPLY "U1" to l_prc_diff.

    end.     /* tried to select NON-frozen table */

   assign
    l_logical = bgate-work:select-next-row().

  end.  /* on DEFAULT-ACTION of bgate-work */
  
  
/*----- GO or CHOOSE of OK BUTTON -----*/
on GO of frame gtbl_get /* or OK because of auto-go */ do:

  if NOT can-find(first gate-work 
                    where gate-work.gate-slct = slctpatt
                    and   gate-work.gate-flag = TRUE
                    )
   then do:
    message "Please select at least one Object or press Cancel."
            view-as alert-box error buttons ok.
    RETURN NO-APPLY.
    end.

  end.  /* on GO of frame gtbl_get */


/*----- CHOOSE of SELECT SOME BUTTON-----*/
on choose of btn_select or "S","s" of bgate-work in frame gtbl_get do:

  Define var choice as char NO-UNDO init "".
  Define var i      as int  NO-UNDO.

  assign
    &IF "{&GATE_FLG2}" = "YES" 
     &THEN flg2patt      = TRUE
     &ELSE flg2patt      = FALSE
    &ENDIF
    qualpatt             = "*"
    pprompt              = "select."
    tblpatt              = "*"
    typpatt              = "*"
    FRAME tbl_patt:TITLE = "Select Objects by Pattern Match".
  if usrpatt = ""
   then do:  /* initialize user-pattern */
    assign  
      usrpatt  = (IF is_as400sh THEN s_owner else USERID(user_dbname))          
      i        = ( if   INDEX(usrpatt,"/") <> 0
                    and INDEX(usrpatt,"@") <> 0
                    then MIN(INDEX(usrpatt,"/"), INDEX(usrpatt,"@"))
                    else MAX(INDEX(usrpatt,"/"), INDEX(usrpatt,"@"))
                 ).
   /* sqlnet-usernames are <userid>/<password>@<dbname...> or  */
   /*                      <userid>@<db-name...>               */
   /*   if @ contained in userid and we can-find a Object with */
   /*   the cut userid we use the cut userid as default-value  */
    if i > 0 
     and can-find(first gate-work 
        where gate-slct    =    slctpatt
        and   gate-user matches substring(usrpatt, 1, i - 1,"character")
                 )
     then assign usrpatt = substring(usrpatt, 1, i - 1,"character").
    end.     /* initialize user-pattern */

  if user_dbtype = "ORACLE" AND usrpatt begins "/@" then 
     RUN prodict/ora/_get_orauser.p (OUTPUT usrpatt).

  display pprompt with frame tbl_patt.

  do ON ENDKEY UNDO, LEAVE:

    update
      tblpatt
      usrpatt  when inc_user
      typpatt 
      qualpatt when inc_qual
    &IF "{&GATE_FLG2}" = "YES" 
     &THEN flg2patt
    &ENDIF
      btn_OK 
      btn_Cancel 
      {&HLP_BTN_NAME} with frame tbl_patt.

    /* Find the list of files that matches the pattern and set 
     * selection accordingly.
     */

     RUN adecomm/_setcurs.p ("WAIT").

    for each gate-work
      where gate-work.gate-slct    =    slctpatt
      and   gate-work.gate-flg2    =    flg2patt
      and   gate-work.gate-name matches tblpatt
      and   gate-work.gate-type matches typpatt
      and ( gate-work.gate-user matches (if inc_user then usrpatt else "")
        or  gate-work.gate-user = ?
          )
      and ( gate-work.gate-qual matches (if inc_qual then qualpatt else "")
        or  gate-work.gate-qual = ?
          )
      and NOT gate-work.gate-type begins "FROZEN:"    :
      assign gate-work.gate-flag = TRUE.
      end.  /* for each gate-work */

    OPEN QUERY qgate-work /*FOR*/ preselect EACH gate-work
                            where gate-work.gate-slct = slctpatt
                         /* and   gate-work.gate-type <> "PROGRESS" */
                            use-index upi.
                            
    bgate-work:MAX-DATA-GUESS = num-results("qgate-work").
    
    find last gate-work
      where gate-work.gate-slct = slctpatt
      and   gate-work.gate-flag = TRUE
      no-error.
    if available gate-work
     then do:
      assign
        s_edt_diff = gate-work.gate-edit
        s_tgl_upd  = gate-work.gate-flag.
      if valid-handle(l_prc_diff)
       and l_prc_diff:type = "procedure"
       then APPLY "U1" to l_prc_diff.
      end.
      
     RUN adecomm/_setcurs.p ("").

    end.  /* do on endkey */

  end.  /* on choose of btn_select */


/*----- CHOOSE of DESELECT SOME BUTTON-----*/
on choose of btn_deselect or "D","d" of bgate-work in frame gtbl_get do:

  Define var choice as char NO-UNDO init "".
  Define var i      as int  NO-UNDO.

  assign
    flg2patt             = FALSE
    pprompt              = "deselect."
    qualpatt             = ( if qualpatt = "" 
                              then "*"
                              else qualpatt
                           )
    tblpatt              = ( if tblpatt = "" 
                              then "*"
                              else tblpatt
                           )
    typpatt              = ( if typpatt = "" 
                              then "*"
                              else typpatt
                           )
    FRAME tbl_patt:TITLE = "Deselect Objects by Pattern Match".

  if usrpatt = ""
   then do:  /* initialize user-pattern */
    assign  
      usrpatt  = (IF is_as400sh THEN s_owner else USERID(user_dbname))
      i        = ( if   INDEX(usrpatt,"/") <> 0
                    and INDEX(usrpatt,"@") <> 0
                    then MIN(INDEX(usrpatt,"/"), INDEX(usrpatt,"@"))
                    else MAX(INDEX(usrpatt,"/"), INDEX(usrpatt,"@"))
                 ).
    /* sqlnet-usernames are <userid>/<password>@<dbname...> or  */
    /*                      <userid>@<db-name...>               */
    /*   if @ contained in userid and we can-find a Object with */
    /*   the cut userid we use the cut userid as default-value  */
    if i > 0 
     and can-find(first gate-work 
         where gate-slct    =    slctpatt
         and   gate-user matches substring(usrpatt, 1, i - 1,"character"))
     then assign usrpatt = substring(usrpatt, 1, i - 1,"character").
    end.       /* initialize user-pattern */

  display pprompt with frame tbl_patt.

  do ON ENDKEY UNDO, LEAVE:

    update
      tblpatt
      usrpatt  when inc_user
      typpatt 
      qualpatt when inc_qual
    &IF "{&GATE_FLG2}" = "YES" 
     &THEN flg2patt
    &ENDIF
      btn_OK 
      btn_Cancel 
      {&HLP_BTN_NAME} with frame tbl_patt.

    /* Go through the items already chosen.  Create a new list
     * without the ones that match the pattern. 
     */

     RUN adecomm/_setcurs.p ("WAIT").

    for each gate-work
      where gate-work.gate-slct    =    slctpatt
      and   gate-work.gate-flg2    =    flg2patt
      and   gate-work.gate-name matches tblpatt
      and   gate-work.gate-type matches typpatt
      and ( gate-user matches (if inc_user then usrpatt else "")
        or  gate-work.gate-user = ?
          )
      and ( gate-work.gate-qual matches (if inc_qual then qualpatt else "")
        or  gate-work.gate-qual = ?
          ):
      assign gate-work.gate-flag = FALSE.
      end.  /* for each gate-work */

    OPEN QUERY qgate-work /*FOR*/ preselect EACH gate-work
                            where gate-work.gate-slct = slctpatt
                         /* and   gate-work.gate-type <> "PROGRESS" */
                            use-index upi.
                            
    bgate-work:MAX-DATA-GUESS = num-results("qgate-work").

    find last gate-work
      where gate-work.gate-slct = slctpatt
      and   gate-work.gate-flag = TRUE
      no-error.
    if available gate-work
     then do:
      assign s_edt_diff = gate-work.gate-edit.
      if valid-handle(l_prc_diff)
       and l_prc_diff:type = "procedure"
       then APPLY "U1" to l_prc_diff.
      end.
      
     RUN adecomm/_setcurs.p ("").

    end.  /* do on endkey */
    
  end.  /* on choose of btn_deselect */


/*----- WINDOW-CLOSE of dialog -----*/
on window-close of frame gtbl_get
  apply "END-ERROR" to frame gtbl_get.

on window-close of frame tbl_patt
  apply "END-ERROR" to frame tbl_patt.


/*============================Mainline code================================*/

/**/&IF "{&DS_DEBUG}" = "DEBUG"
/**/ &THEN
/**/  define stream s_stm_errors.
/**/ /*run error_handling(4, "*****----- END odb_pul.p!!! -----*****" ,"").*/
/**/
/**/  output stream s_stm_errors to gate-work.d.
/**/  for each gate-work no-lock: 
/**/    display stream s_stm_errors gate-work with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/ &ENDIF
 
&IF "{&GATE_FLG2}" = "YES" 
 &THEN
  find first gate-work 
    where gate-work.gate-slct = TRUE
    no-error.
  if available gate-work
   then assign
     s_edt_diff   = ( if s_edt_diff = ""
                        then gate-work.gate-edit
                        else s_edt_diff
                    ) /* init it with the first gate-work */
     s_tgl_upd    = gate-work.gate-flag
     slctpatt     = TRUE.
 &ELSE
  assign slctpatt = FALSE.
 &ENDIF

/* Configure pattern frame based on if user is appropriate or not */
find FIRST gate-work
  where gate-work.gate-slct  = slctpatt
  and   gate-work.gate-user <> ""
  and   gate-work.gate-user <> ?
  no-error.
if not available gate-work
 then assign
   usrpatt:visible in frame tbl_patt = no
   inc_user = no.
 else assign inc_user = yes.

find FIRST gate-work
  where gate-work.gate-slct  = slctpatt
  and   gate-work.gate-qual <> ""
  and   gate-work.gate-qual <> ?
  no-error.
if not available gate-work
 then assign
   qualpatt:visible in frame tbl_patt = no
   inc_qual = no.
 else assign inc_qual = yes.

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME tbl_patt" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}
{adecomm/okrun.i  
   &FRAME  = "FRAME gtbl_get" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}
if      p_sel-type = "Create"
 then assign
  text1 = "Below is a list of objects from the &1 database."
  text2 = "For each Object you choose its {&PRO_DISPLAY_NAME} image will be created.".
else if p_sel-type = "Compare"
 then assign
  text1 = "Below is a list of all the objects you chose to be verified."
  text2 = "You can select or deselect objects to get updated or not.".
 else if p_sel-type = "Pull"
 then assign
  text1 = "Below is a list of objects from the &1 database. For each Object "
  text2 = "you choose the info will get prepared to be used later on.".
 else assign    /* = "Update" */
  text1 = "Below is a list of objects from the &1 database."
  text2 = "For each Object you choose its {&PRO_DISPLAY_NAME} image will be updated.".

/* we don't need this - preselect query w/num-results() is better...
for each gate-work
  where gate-work.gate-slct = slctpatt: 
  accumulate gate-work.gate-flag (count).
  end.
*/

pause 0 before-hide.

OPEN QUERY qgate-work /*FOR*/ preselect EACH gate-work
                        where gate-work.gate-slct = slctpatt
                     /* and   gate-work.gate-type <> "PROGRESS" */
                        use-index upi.

/* The following line is here becuase the browse scrollbar does not 
 * acknowledge that there are more records beyond the default setting
 * of MAX-DATA-GUESS
 */
assign
  bgate-work:MAX-DATA-GUESS = /*accum count gate-work.gate-flag*/ 
                              num-results("qgate-work")
  text1      = SUBSTITUTE (text1, p_Gate)
/*text2      = SUBSTITUTE (text2, p_Gate)
  s_edt_diff = gate-work.gate-edit*/
  .

/* create window */
&IF "{&GATE_FLG2}" = "YES"  AND "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  assign
    l_wdw_old           = CURRENT-WINDOW:handle
    CURRENT-WINDOW      = l_wdw_brws
    l_wdw_old:sensitive = false.
  view l_wdw_brws.
 &ELSE assign l_wdw_brws = CURRENT-WINDOW.
 &ENDIF

display text1 text2 with frame gtbl_get in window l_wdw_brws.

enable 

  bgate-work
  btn_select
  btn_deselect

  &IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN
    btn_diff
   &ENDIF

  &IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" = "TTY"
   &THEN
    btn_print
   &ENDIF

  btn_OK
  btn_Cancel

  &IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN
    btn_print
   &ENDIF

  {&HLP_BTN_NAME}

  with frame gtbl_get in window l_wdw_brws.
  
  &if "{&window-system}" ne "tty"
   &then
    /* make sure first row is selected when browse is initially opened */
    l_logical  = bgate-work:select-focused-row().
  &endif

/*===== start "detail" window =====*/

&IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" <> "TTY" 
 &THEN
  if not ( valid-handle(l_prc_diff)
   and l_prc_diff:type = "procedure"
         )
   then run prodict/user/_usr_dif.p persistent set l_prc_diff
          ( INPUT THIS-PROCEDURE).
 &ENDIF

do ON ENDKEY UNDO, LEAVE:
   wait-for GO of frame gtbl_get.  /* Or OK - due to auto-go */
   canned = false.
end.

if valid-handle(l_prc_diff)
 and l_prc_diff:type = "procedure"
 then APPLY "U2" to l_prc_diff.

for each gate-work
  where gate-work.gate-flag = TRUE:
  assign gate-work.gate-slct = TRUE.
  end.

hide frame gtbl_get NO-PAUSE.

/* delete window */
&IF "{&GATE_FLG2}" = "YES" AND "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  assign
    l_wdw_old:sensitive = yes
    CURRENT-WINDOW      = l_wdw_old.
  delete widget l_wdw_brws.
 &ENDIF

RETURN (if canned then "cancel" else "ok").


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: widthvar.i

Description:
   Definitions for _sqlwidt.p, the field with browser for SQL-92 client.
   
Author: Mario Brunetti

Date Created: 02/16/99
    Modified: 05/28/99 Mario B.  Made query dynamic.  Added code to prevent
                       unnecessary screen re-draw.  
              07/01/99 Mario B. Fine tuning + add SwitchTable button
    	      07/28/99 Mario B. Support for array data types. BUG 19990716-033.
	      10/14/99 Mario B. 2k width limit now 31995. BUG 19990825-005.
              06/09/00 D. McMann Added open of query to surpress 3159 error 
----------------------------------------------------------------------------*/
DEFINE {1} TEMP-TABLE t_Field LIKE _Field. 

DEFINE {1} BUFFER w_Field FOR t_Field.

/* This is a dummy placeholder for a dynamic query.    */
DEFINE {1} QUERY qry-width FOR w_Field SCROLLING.
OPEN QUERY qry-width FOR EACH w_field.

DEFINE {1}    VARIABLE qry-width-hdl AS WIDGET-HANDLE NO-UNDO.
DEFINE {1}    VARIABLE b-test        AS LOGICAL       NO-UNDO.

DEFINE {1} BROWSE brw-width QUERY qry-width
   DISPLAY w_Field._Field-Name w_Field._Width w_Field._Format
   ENABLE w_Field._Width 
WITH 
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   12 DOWN 
&ELSE
   15 DOWN   
&ENDIF   
   SEPARATORS. 

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN

/* These constants are defined in the GUI Dict, but not avail in char.  *
 * Needed to be defined so that we could share the code.                */
&SCOPED-DEFINE VM_WID 0
&SCOPED-DEFINE VM_WIDG 0
&SCOPED-DEFINE IVM_OKBOX 0
&SCOPED-DEFINE HM_DBTN 1
&SCOPED-DEFINE HM_DBTNG 1
&SCOPED-DEFINE HFM_OKBOX 0
&SCOPED-DEFINE VM_OKBOX 0

/* Allows exit with END-ERROR and cancel, but doesn't apply it so as to *
 * not undo all previous saves.  Enables sharing of code between GUI    *
 * and char dictionary.                                                 */
DEF VAR s_ExitNoSave AS LOG NO-UNDO. 
DEF VAR s_NoPrivMsg AS CHAR NO-UNDO
   init "You do not have permission to".
DEF VAR saveCurr AS LOG     NO-UNDO INIT TRUE.
DEF VAR rowsModified AS LOG NO-UNDO INIT FALSE.

DEFINE BUTTON s_btn_OK LABEL "OK" AUTO-GO.
DEFINE BUTTON s_btn_Save LABEL "Save".
DEFINE BUTTON s_btn_Close LABEL "Close".
DEFINE BUTTON s_btn_Help LABEL "Help".
DEFINE BUTTON s_btn_Switch LABEL "SwitchTable".

DEFINE {1} FRAME frm-width
   brw-width 
   {adecomm/okform.i 
      &STATUS = NO
      &AT_OKBTN = "AT 24"
      &OK     = s_btn_OK 
      &OTHER  = "s_btn_Close SPACE(2) s_btn_Switch"
      &CANCEL = s_btn_Save      
      }
WITH FRAME frm-width 
     1 DOWN 
     WIDTH 82 
     NO-BOX 
     KEEP-TAB-ORDER 
     SIDE-LABELS 
     OVERLAY.
&ELSE           /*----- GUI Frame Layout and Other Defintions -----*/
DEF {1} VAR s_StatusLineHdl  AS HANDLE    NO-UNDO.
DEF {1} VAR s_StatusLineFlds AS INT       NO-UNDO.
DEF {1} VAR s_PreviousSort   AS INT       NO-UNDO.
DEF {1} VAR s_PreviousTbl    AS CHAR      NO-UNDO.
DEFINE {1} FRAME frm-width
   SKIP({&VM_WIDG})
   brw-width SKIP({&VM_WID}) 
   {adecomm/okform.i 
      &STATUS = NO 
      &OK     = s_btn_OK
      &OTHER  = "SPACE({&HM_DBTN}) 
                s_btn_Close SPACE({&HM_DBTNG}) 
                s_btn_Prev  SPACE({&HM_DBTN})
                s_btn_Next"
      &CANCEL = "s_btn_Save"
      &HELP   = s_btn_Help} 
      SKIP(.33) 
WITH FRAME frm-width 
     1 DOWN 
     WIDTH 83 
     NO-BOX 
     KEEP-TAB-ORDER 
     SIDE-LABELS.
&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _widttrig.i

Description: 
    Triggers for Adjust SQL Width browser.  These triggers are defined in this
    include so that they could be part of _dcttran.p and thus use its wait-for
    and thus be non-modal.  
    
Author: Mario Brunetti
Date Created: 03/10/99 
    Modified: 05/28/99 Mario B. Cleaned up closing of window, added help token.
              07/01/99 Mario B. Fine tuning + add SwitchTable button
	      07/28/99 Mario B. Support for array data types. BUG 19990716-033.
	      10/14/99 Mario B. 2k width limit now 31995. BUG 19990825-005.
              11/15/99 Mario B. fix END-ERROR key in char mode. Bug 19990625-027
----------------------------------------------------------------------------*/

/*================================ Triggers ================================*/

/*----- Hit of OK Button -----*/
/* This is in here as a reminder that the OK button is AUTO-GO in this      *
 * case. So, if we APPPLY "GO" as is done elsewhere, we will be getting     *
 * 2 go events.                                                             */

   
/*----- END-ERROR or CANCEL of frm-width -----*/
ON END-ERROR OF FRAME frm-width OR CHOOSE OF s_btn_Close IN FRAME frm-width 
DO:
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      RUN prodict/gui/_closqlw.p.  
      {adedict/delwin.i &Win = s_win_Width &Obj = {&OBJ_WIDTH}}  
      RUN adedict/_brwgray.p (INPUT NO).
   &ELSE
      /* This is to prevent undoing of "save" subtransactions if the user *
       * saves, then modifies other rows, then cancels.  Not pretty, but  *
       * necessary because of the differences betwen GUI and TTY          *
       * dictionary architectures.                                        */
      s_ExitNoSave = YES.
      APPLY "GO" TO FRAME frm-width.
   &ENDIF
   RETURN NO-APPLY.
END.

/*----- Go -----*/
ON GO OF FRAME frm-width
DO:
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      IF NOT s_ExitNoSave THEN  /* See above comment on cancel trigger. */
   &ENDIF
      run prodict/gui/_savwidt.p.  /* always runs for GUI, conditional TTY */
   IF RETURN-VALUE = "error" then
      RETURN NO-APPLY.   

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      RUN prodict/gui/_closqlw.p.
      {adedict/delwin.i &WIN = s_win_Width &Obj = {&OBJ_WIDTH}}
      RUN adedict/_brwgray.p (INPUT NO).       
   &ENDIF
END.

/*------ Hit OF SAVE Button -----*/
ON CHOOSE OF s_btn_Save IN FRAME frm-width
DO:
   run prodict/gui/_savwidt.p.
   if RETURN-VALUE = "error" then
      RETURN NO-APPLY.   
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
      run adedict/_objsel.p (INPUT {&OBJ_TBL}).  /* Causes Refresh */
   &ENDIF
   ASSIGN
      s_btn_Close:LABEL IN FRAME frm-width = "Close"
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
         rowsModified = NO
      &ENDIF
      .
END.

/*------- Row Leave -------*/
ON ROW-LEAVE of BROWSE brw-width
DO:
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   IF s_ExitNoSave THEN LEAVE.  /* So that trigger won't fire on F4 */
   &ENDIF
   IF brw-width:CURRENT-ROW-MODIFIED IN FRAME frm-width THEN
   DO:
      ASSIGN
         s_btn_Close:LABEL IN FRAME frm-width = "Cancel"
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
            rowsModified = YES
         &ENDIF	    
	 .
   
      IF INT(w_Field._Width:SCREEN-VALUE IN BROWSE brw-width) > 31995 THEN
      DO:
         MESSAGE "SQL-92 client cannot access fields that have" SKIP
                 "width values greater than 31995."             SKIP
         VIEW-AS ALERT-BOX ERROR BUTTONS OK TITLE "Value Out of Range".
         RETURN NO-APPLY.
      END.
   END.   
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
/*----- Hit of Help Button -----*/
ON CHOOSE OF s_btn_Help IN FRAME frm-width
RUN adecomm/_adehelp.p("dict", "context", {&Adjust_Field_Width_Dialog_Box}, ?).

/*----- HIT of NEXT button -----*/
ON CHOOSE OF s_btn_Next IN FRAME frm-width
DO:
   run adedict/_nextobj.p ({&OBJ_TBL}, true).
END.

/*----- HIT of PREV button -----*/
ON CHOOSE OF s_btn_Prev IN FRAME frm-width
DO:
   run adedict/_nextobj.p ({&OBJ_TBL}, false).
END.
&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*  Procedure prodict/misc/_clproto.p  Procedure to remove created database when
              an error has occurred so that user can fix the problems and run the
              ProToxxx again.  Do not delete *.log as there could be information
              in the log that the user needs.  The *.sql gets overwritten so
              no need to delete in case user wants to look.
    
    Created: 12/07/99 D. McMann
*/              

DEFINE INPUT PARAMETER sh_dbname  AS CHARACTER.
DEFINE INPUT PARAMETER pro_dbname AS CHARACTER.

DEFINE VARIABLE deldb    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE extsion  AS CHARACTER EXTENT 5 NO-UNDO.
DEFINE VARIABLE i        AS INTEGER            NO-UNDO.
 
  
ASSIGN extsion[1] = ".lg"
       extsion[2] = ".st"
       extsion[3] = ".db"
       extsion[4] = ".d1"
       extsion[5] = ".b1".

DO i = 1 TO 5:
  ASSIGN deldb = sh_dbname + extsion[i]. 
  OS-DELETE VALUE(deldb).       
END.

CREATE ALIAS DICTDB FOR DATABASE VALUE(pro_dbname).

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Procedure prodict/misc/_del-db.p
   Created:  12/07/99 D. McMann
   Procedure to clean up schema holder when the ProToxxx has failed
   and the user is returned to the original screen to fix whatever
   was wrong.
   
   Used by prodict/ora/protoora.p
           prodict/odb/protoodb.p
           
*/   

DEFINE INPUT PARAMETER fdb_dbname AS CHARACTER.
DEFINE INPUT PARAMETER sh_dbname  AS CHARACTER.
DEFINE INPUT PARAMETER pro_dbname   AS CHARACTER.

  FIND DICTDB._db where DICTDB._db._db-name = LDBNAME(fdb_dbname) EXCLUSIVE-LOCK.
  IF AVAILABLE _Db THEN DO:
    IF CONNECTED (_Db._Db-name) THEN
      DISCONNECT VALUE(_Db._Db-name).
      
    FOR EACH _File OF _Db EXCLUSIVE-LOCK:
       FOR EACH _Index OF _File EXCLUSIVE-LOCK:
         FOR EACH _index-field OF _Index EXCLUSIVE-LOCK:
             DELETE _Index-field.
         END.
         DELETE _index.
       END.
       FOR EACH _FIELD OF _File EXCLUSIVE-LOCK:
         DELETE _Field.
       END.
       DELETE _File.
    END.
    FOR EACH _SEQUENCE OF _Db EXCLUSIVE-LOCK:
      DELETE _Sequence.
    END.
    DELETE _Db. 
    DISCONNECT VALUE(sh_dbname).
    CREATE ALIAS DICTDB FOR DATABASE VALUE(pro_dbname).
  END.
 
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _filebtn.p

Description:
   Trigger code for the Files... button in a dialog.  Use either the 
   specified filter in the get-file dialog, or use the same one as 
   on the default filename parameter.

Input Parameters:
   p_Fillin  - Associated fill-in widget handle
   p_Title   - Title for the get-file dialog.
   p_Filter  - Filter (if null, figure something out from p_Filename)
   p_Suffix  - Default extension (if null, figure something out from p_Filename)
   p_Mustexit- Must the file exist?

Author: Bryan Mau

Date Created: 05/13/93

              04/03/05  kmcintos Optimized and beautified
----------------------------------------------------------------------------*/

DEFINE INPUT PARAMETER p_Fillin    AS HANDLE    NO-UNDO.
DEFINE INPUT PARAMETER p_Title     AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_Filter    AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_Mustexist AS LOGICAL   NO-UNDO.
                       
DEFINE VARIABLE pickedOne      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE fname          AS CHARACTER NO-UNDO.
DEFINE VARIABLE filt           AS CHARACTER NO-UNDO.
DEFINE VARIABLE Get_Must_Exist AS CHARACTER NO-UNDO.

fname     = TRIM(p_Fillin:SCREEN-VALUE).

IF (p_Filter = "") OR (p_Filter = ?) THEN DO:
   IF (NUM-ENTRIES(fname,".") < 2) THEN filt = "*".
   ELSE filt = "*" + ENTRY(NUM-ENTRIES(fname,"."),fname,".").
END.
ELSE filt = p_Filter.


&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  IF p_Mustexist THEN
    SYSTEM-DIALOG GET-FILE    fname 
                  FILTERS    filt filt 
                  TITLE      p_Title 
                  MUST-EXIST 
                  UPDATE     pickedOne.
  ELSE
    SYSTEM-DIALOG GET-FILE fname 
                  FILTERS filt filt 
                  TITLE   p_Title 
                  UPDATE  pickedOne.

&ELSE
  ASSIGN Get_Must_Exist = IF p_Mustexist THEN "MUST-EXIST" ELSE "".
  RUN adecomm/_filecom.p ( INPUT filt, /* p_Filter */
                           INPUT "", /* p_Dir */
                           INPUT "", /* p_Drive */
                           INPUT NO, /* p_Save_As */
                           INPUT p_Title,
                           INPUT Get_Must_Exist,
                           INPUT-OUTPUT fname,
                           OUTPUT pickedOne ). 
&ENDIF

IF pickedOne THEN
  p_Fillin:SCREEN-VALUE = fname.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

IMPORTANT: THIS PROGRAM CANNOT BE RAN WITH NO _DB-RECORD IN THE SYSTEM!!

File: prodict/misc/_getconp.p

Description:
    parses the connection-parameters of the databases (according to
    p_user_dbname) and returns them within the corresponding parameters
    
Input-Parameters:       
    p_user_dbname logical name of the DB to be connected
    
Output-Parameters:      
    p_db          physical db-name
    p_ld          logical db-name
    p_dt          db-type
    p_tl          trigger-file-name
    p_pf          parameter-file
    p_1           multi-user ?
    p_network     network type (-N)
    p_host        host name (-H)
    p_service     service name (-S)
    p_u           user-id
    p_p           password
    p_r1          rest of parameters 1. line
    p_r2          rest of parameters 2. line
    p_r3          rest of parameters 3. line
    
Used/Modified Shared Objects:
    none
    

Author: Tom Hutegger

History:
    hutegger    94/03/31    creation
    hutegger    94/05/02    removed .ai and .bi-handling 
    j.palazzo   95/04/17    Added p_network, p_host, p_service.
    Mario B     99/06/16    Fixed so that -S would not be confused with -Sn,
                            also made it case senstive.
    
NOTE:
I use this file only from within 
  prodict/user/_usrscon.p
  adedict/DB/_connect.p. 
There the physical db-name and the db-type are already known, so I don't 
care about that around here.

--------------------------------------------------------------------*/        
/*h-*/
/*----------------------------  DEFINES  ---------------------------*/

DEFINE INPUT        parameter p_user_dbname AS CHARACTER      .
DEFINE INPUT-OUTPUT parameter p_db          AS CHARACTER      .
DEFINE INPUT-OUTPUT parameter p_ld          AS CHARACTER      .
DEFINE INPUT-OUTPUT parameter p_dt          AS CHARACTER      .
DEFINE OUTPUT       parameter p_tl          AS CHARACTER      .
DEFINE OUTPUT       parameter p_pf          AS CHARACTER      .
DEFINE OUTPUT       parameter p_1           AS LOGICAL        .
DEFINE OUTPUT       parameter p_network     AS CHARACTER      .
DEFINE OUTPUT       parameter p_host        AS CHARACTER      .
DEFINE OUTPUT       parameter p_service     AS CHARACTER      .
DEFINE OUTPUT       parameter p_u           AS CHARACTER      .
DEFINE OUTPUT       parameter p_p           AS CHARACTER      .
DEFINE OUTPUT       parameter p_r1          AS CHARACTER      .
DEFINE OUTPUT       parameter p_r2          AS CHARACTER      .
DEFINE OUTPUT       parameter p_r3          AS CHARACTER      .

DEFINE VARIABLE         ix            AS INTEGER       NO-UNDO.
DEFINE VARIABLE         l_stri          AS CHARACTER     NO-UNDO CASE-SENSITIVE.

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

    find first _db where _db._db-name = p_user_dbname
      no-lock no-error.
    if available _db
     then do:   /* try to scan for specific parameters */

      assign 
        l_stri = " " + _db._db-comm
        p_db   = ( if _Db._Db-addr <> "" 
                    then _Db._Db-addr
                    ELSE ""
                 ).  
      
      /* replace CarriageReturns by Blanks to make text scanable */
      repeat while index(l_stri,chr(10)) <> 0:
        assign substring(l_stri,index(l_stri,chr(10))) = " ".  
        end.
        
      if index(l_stri," -db":u) <> 0
       then assign 
        p_db   = substring(l_stri,index(l_stri," -db":u) + 5)
        p_db   = substring(p_db,1,index(p_db + " "," "))
        l_stri = substring(l_stri,1,index(l_stri," -db":u)) +
                 substring(l_stri,index(l_stri," -db":u) + 5 + length(p_db)).

      if index(l_stri," -ld":u) <> 0
       then assign 
        p_ld   = substring(l_stri,index(l_stri," -ld":u) + 5)
        p_ld   = substring(p_ld,1,index(p_ld + " "," ") - 1)
        l_stri = substring(l_stri,1,index(l_stri," -ld":u)) +
                 substring(l_stri,index(l_stri," -ld":u) + 5 + length(p_ld)).

      if index(l_stri," -dt":u) <> 0
       then assign 
        p_dt   = substring(l_stri,index(l_stri," -dt":u) + 5)
        p_dt   = substring(p_dt,1,index(p_dt + " "," ") - 1)
        l_stri = substring(l_stri,1,index(l_stri," -dt":u)) +
                 substring(l_stri,index(l_stri," -dt":u) + 5 + length(p_dt)).

      if index(l_stri," -trig":u) <> 0
       then assign 
        p_tl   = substring(l_stri,index(l_stri," -trig":u) + 7)
        p_tl   = substring(p_tl,1,index(p_tl + " "," "))
        l_stri = substring(l_stri,1,index(l_stri," -trig":u)) +
                 substring(l_stri,index(l_stri," -trig":u) + 7 + length(p_tl)).

      if index(l_stri," -pf":u) <> 0
       then assign 
        p_pf   = substring(l_stri,index(l_stri," -pf":u) + 5)
        p_pf   = substring(p_pf,1,index(p_pf + " "," "))
        l_stri = substring(l_stri,1,index(l_stri," -pf":u)) +
                 substring(l_stri,index(l_stri," -pf":u) + 5 + length(p_pf)).

      if index(l_stri," -1":u) <> 0
       then assign 
        p_1    = false
        l_stri = substring(l_stri,1,index(l_stri," -1":u)) +
                 substring(l_stri,index(l_stri," -1":u) + 4).
       else assign 
        p_1    = true.

      if index(l_stri," -N":u) <> 0
       then assign 
        p_network = substring(l_stri,index(l_stri," -N":u) + 4)
        p_network = substring(p_network,1,index(p_network + " "," "))
        l_stri    = substring(l_stri,1,index(l_stri," -N":u)) +
                    substring(l_stri,index(l_stri," -N":u) + 4 + length(p_network)).
      
      if index(l_stri," -H":u) <> 0
       then assign 
        p_host    = substring(l_stri,index(l_stri," -H":u) + 4)
        p_host    = substring(p_host,1,index(p_host + " "," "))
        l_stri    = substring(l_stri,1,index(l_stri," -H":u)) +
                    substring(l_stri,index(l_stri," -H":u) + 4 + length(p_host)).

      if index(l_stri," -S ":u) <> 0
       then assign 
        p_service = substring(l_stri,index(l_stri," -S":u) + 4)
        p_service = substring(p_service,1,index(p_service + " "," "))
        l_stri    = substring(l_stri,1,index(l_stri," -S":u)) +
                    substring(l_stri,index(l_stri," -S":u) + 4 + length(p_service)).

      if index(l_stri," -U":u) <> 0
       then assign 
        p_u    = substring(l_stri,index(l_stri," -U":u) + 4)
        p_u    = substring(p_u,1,index(p_u + " "," "))
        l_stri = substring(l_stri,1,index(l_stri," -U":u)) +
                 substring(l_stri,index(l_stri," -U":u) + 4 + length(p_u)).

      if index(l_stri," -P":u) <> 0
       then assign 
        p_p    = substring(l_stri,index(l_stri," -P":u) + 4)
        p_p    = substring(p_p,1,index(p_p + " "," ":u))
        l_stri = substring(l_stri,1,index(l_stri," -P":u)) +
                 substring(l_stri,index(l_stri," -P":u) + 4 + length(p_p)).

      assign l_stri = trim(l_stri).  

      if length(l_stri) > 64 then assign p_r1   = substring(l_stri,1,64)
                                         l_stri = substring(l_stri,65).
                             else assign p_r1   = l_stri
                                         l_stri = "".            
      if length(l_stri) > 64 then assign p_r2   = substring(l_stri,1,64)
                                         l_stri = substring(l_stri,65).
                             else assign p_r2   = l_stri
                                         l_stri = "".            
      if length(l_stri) > 64 then assign p_r3   = substring(l_stri,1,64)
                                         l_stri = substring(l_stri,65).
                             else assign p_r3   = l_stri
                                         l_stri = "".            


      end.      /* try to scan for specific parameters */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/gate/_gat_prt.p

Description:
    
    printing of all difference-reports

        
Text-Parameters:
    &object    {Sequence|Table|Field|Index|Index-Field}  
    &obj       {seq|tbl|fld|idx|idf}

output-Parameters:
    none
    
Called from:
    gui/guigget.i

History:
    hutegger    95/03   creation (derived from adecomm/_report.p)
    
--------------------------------------------------------------------*/
/*h-*/

{ adecomm/commeng.i }       /* Help contexts */
{ adecomm/adestds.i }       /* Standard layout defines, colors etc. */
{ adecomm/adeintl.i }       /* International support */
{ prodict/user/uservar.i }  /* btn_Ok, btn_Cancel, btn_Help */

/*
{ prodict/dictvar.i }
*/

define input parameter p_func       as character.
define input parameter p_header1    as character.
define input parameter p_header2    as character.
define input parameter p_caller     as character.
define input parameter p_param      as character.

define new shared stream   rpt.

define button btn_Files  label "&Files..."
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN size 12 by 1 &ENDIF .

define variable l_append        as logical.
define variable l_device        as character initial "PRINTER".
define variable l_file          as character.
define variable l_logical       as logical.
define variable l_param         as character initial "s".
define variable l_size          as integer.

form 
                                                          SKIP({&TFM_WID})
   
   l_device             COLON 17 LABEL "&Send output to"  
       view-as radio-set radio-buttons "Printer", "PRINTER",
                                       "File"   , "F"     SKIP ({&VM_WID})

   l_file               AT    19 NO-LABEL FORMAT "x(60)"          
       view-as fill-in native size 30 by 1 {&STDPH_FILL}  SPACE(.3)
   btn_Files                                              SKIP({&VM_WID})

   l_append             AT    19 LABEL "&Append to Existing File?"
       view-as toggle-box                                 SKIP({&VM_WIDG})
   
   l_size               COLON 17 LABEL "&Page Length" FORMAT ">>9"
      {&STDPH_FILL}
   "(# Lines, 0 for Continuous)"                   	  

   l_param              COLON 17 LABEL "&Add Parameter"  
       view-as radio-set radio-buttons "a", "a",
                                       "b", "b",
                                       "c", "c"     SKIP ({&VM_WID})

   {prodict/user/userbtns.i}

   with frame l_frm_options 
      side-labels 
      default-button btn_Ok cancel-button btn_Cancel
      view-as dialog-box title "Print Options".

/*---------------------  Internal Procedures  ----------------------*/

PROCEDURE adjust_l_param:

  if p_caller = "guigget"
   then do with frame l_frm_options:  /* printing after schema-compare */
    assign
      l_param   = p_param
      l_logical = l_param:replace("All objects in browser","a","a")
      l_logical = l_param:replace("Objects with differences","d","b")
      l_logical = l_param:replace("All selected objects","s","c").      
    end.                              /* printing after schema-compare */
   else do with frame l_frm_options:  /* no parameters -> hide widget */
    assign
      l_param:hidden = true.
    end.                              /* no parameters -> hide widget */
    
  end.     /* display_Schema_Info */

/*------------------------------------------------------------------*/

PROCEDURE display_Schema_Info:

  run adecomm/_setcurs.p ("WAIT").

  RUN VALUE(p_Func) (INPUT l_param).

  run adecomm/_setcurs.p ("").
   
  end.     /* display_Schema_Info */


/*---------------------------  TRIGGERS  ---------------------------*/

/*----- HELP -----*/
on HELP of frame l_frm_options
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN or choose of btn_Help in frame l_frm_options
   &ENDIF
  RUN "adecomm/_adehelp.p" (INPUT "comm", INPUT "CONTEXT", 
                            INPUT {&Print_Options},
                            INPUT ?).


/*-----WINDOW-CLOSE-----*/
on WINDOW-CLOSE of frame l_frm_options
  apply "END-error" to frame l_frm_options.


/*----- OK or GO -----*/
on GO of frame l_frm_options do:
  assign 
    l_device
    l_file
    l_append
    l_size
    l_param.

  l_file = TRIM(l_file).
  if l_device <> "PRINTER" then do:
    /* open the file to make sure we have permission */
    if l_file BEGINS "|"
     then output THROUGH VALUE(SUBSTRING(l_file,2,-1,"character"))
                             page-size VALUE(l_size).
    else if l_append
     then output to VALUE(l_file) page-size VALUE(l_size) APPEND.
     else output to VALUE(l_file) page-size VALUE(l_size).
    output close.
    assign l_device = l_file.
    end.
   
/*  {adecomm/prtrpt.i
 *     &Header = "p_Header"
 *     &Flags  = "p_Flags"
 *     &dev    = "l_device"
 *     &app    = "l_append"
 *     &siz    = "l_size"
 *     &Func   = "display_Schema_info"
 *     } 
 */
  {adecomm/prtrpt.i
     &Header = "p_Header1"
     &Flags  = "p_Header2"
     &dev    = "l_device"
     &app    = "l_append"
     &siz    = "l_size"
     &Func   = "display_Schema_info"
     } 

  end.  /* GO of frame l_frm_options */ 

/*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
on VALUE-CHANGED of l_device in frame l_frm_options do:

/* Default to continuous output for terminal, 60 for printer. */
  assign l_device = SELF:SCREEN-VALUE.
  if l_device = "F" /* file */
   then do with frame l_frm_options:  /* output to file */
    assign
      l_size:SCREEN-VALUE = "0"
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
      l_file:SENSITIVE    = yes
      btn_Files:SENSITIVE = yes
      l_append:SENSITIVE  = yes
     &ELSE
      l_file:VISIBLE      = yes
      btn_Files:VISIBLE   = yes
      l_append:VISIBLE    = yes
     &ENDIF
      .
     APPLY "ENTRY" TO l_file in frame l_frm_options.
     end.                           /* output to file */
 
    else do with frame l_frm_options: /* output to printer */
     assign
       l_size:SCREEN-VALUE   = "60"
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
       l_file:SENSITIVE      = no
       l_file:SCREEN-VALUE   = ""
       btn_Files:SENSITIVE   = no
       l_append:SENSITIVE    = no
       l_append:SCREEN-VALUE = "no"
      &ELSE
       l_file:VISIBLE        = no
       btn_Files:VISIBLE     = no
       l_append:VISIBLE      = no
      &ENDIF
       .
     end.                           /* output to printer */
     
  end.  /* VALUE-CHANGED of l_device */

/*----- HIT of FILE BUTTON -----*/
on CHOOSE of btn_Files in frame l_frm_options do:

  Define var name       as char    NO-UNDO.
  Define var picked_one as logical NO-UNDO.
  Define var d_title    as char    NO-UNDO init "Report File".
   
  assign name = TRIM(l_file:screen-value in frame l_frm_options).

  &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN
    system-dialog GET-FILE 
      name 
      filters            "*" "*"
      default-extension  ""
      title            d_title 
      /*must-exist*/
      update          picked_one.
   &ELSE
    run adecomm/_filecom.p
      ( INPUT        ""       /* p_Filter */, 
        INPUT        ""       /* p_Dir */ , 
        INPUT        ""       /* p_Drive */ ,
        INPUT        no       /* p_Save_As */ ,
        INPUT        d_title ,
        INPUT        ""       /* Dialog Options */ ,
        INPUT-OUTPUT name,
        OUTPUT       picked_one
      ). 
   &ENDIF
   
  if picked_one
   then assign l_file:screen-value in frame l_frm_options = name.

  end.  /* CHOOSE of btn_Files */

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

/** / message "prt_rpt.p:" p_caller p_param view-as alert-box. / **/

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME l_frm_options" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

run adjust_l_param.

/* Printer is default so adjust file and files button accordingly */
do with frame l_frm_options:
  assign
    l_append:SCREEN-VALUE = "no"
    l_file:SCREEN-VALUE   = ""
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN
    l_file:SENSITIVE      = no
    btn_Files:SENSITIVE   = no
    l_append:SENSITIVE    = no
   &ELSE
    l_file:HIDDEN         = yes
    btn_Files:HIDDEN      = yes
    l_append:HIDDEN       = yes
    l_file:SENSITIVE      = yes
    btn_Files:SENSITIVE   = yes
    l_append:SENSITIVE    = yes
   &ENDIF
    .
  end.
  
assign
   l_device = "Printer"
   l_size = 60.
display l_device l_size with frame l_frm_options.

enable
  l_device
  l_size
  l_param
  btn_Ok 
  btn_Cancel
  {&HLP_BTN_NAME}
  with frame l_frm_options.

/* Reset tab-order for things that will be enabled later. */
assign
  l_logical = l_file:MOVE-AFTER-TAB-ITEM(l_device:HANDLE in frame l_frm_options)
  l_logical = btn_Files:MOVE-AFTER-TAB-ITEM(l_file:HANDLE in frame l_frm_options)
  l_logical = l_append:MOVE-AFTER-TAB-ITEM(btn_Files:HANDLE in frame l_frm_options).

DO on error UNDO, LEAVE  on ENDKEY UNDO, LEAVE:
  wait-for CHOOSE of btn_OK in frame l_frm_options 
        or GO of frame l_frm_options FOCUS l_device.
 end.

hide frame l_frm_options.   

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2005,2011 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

file: prodict/misc/_resxlat.p

Description:
    This routine checks wether an object-name is a reserved word by the
    respective foreign DB. If so, it appends an "_". In addition all 
    characters that are not supported by the foreign DB are replaced with
    "_".

Input:
    p_param     <object-name>[,<db-type>]

Output:
    p_param    <corrected object-name>

Changed/Used Shared Objects:
    none

Used Aliases:
    none

History:
    hutegger    01/96   rewritten based on the old version
                        prepared for separate lists per dataserver
                        (i.e: generic list for all DS, generic list
                        for ODBC-based DataServer, special lists
                        for all SQL-based DataServers)
                        I also prepared for separate substitution-chars
                        and/or different unallowed characters.
    jlewis   01/10/96   Added mssqlsrv V6.0 keywords
    hutegger    01/96   Added "&" as unallowed character
    jlewis   02/01/96   Added new Sybase 11 keywords
    jlewis   06/28/96   Added mssqlsrv V6.5 keywords
    dmcmann  01/14/00   Added percent to odbc keywords and changed lookup
                        function.
    dmcmann 07/18/00    Added timestamp as keyword
    dmcmann 07/25/00    Changed l_odb-keywords to include all generic plus
                        all keywords for supported database types. 
    dmcmann  11/18/02   Added freetext for MSS
    dmcmann  03/12/03   Added SYS_ logic in names.
    kmayur   16/01/12	Added check for Progress Keyword

--------------------------------------------------------------------*/
/*-h*/
define input-output parameter p_param  as character no-undo.

define variable l_ch                as character no-undo.
define variable l_db-type           as character no-undo.
define variable l_db2-keywords      as character no-undo.
define variable l_gen-char          as character no-undo.
define variable l_ext-indicat       as character no-undo.
define variable l_gen-keywords      as character no-undo.
define variable l_i                 as integer   no-undo.
define variable l_mss-keywords      as character no-undo.
define variable l_odb-keywords      as character no-undo.
define variable l_ora-keywords      as character no-undo.
define variable l_pos               as integer   no-undo.
define variable l_s10-keywords      as character no-undo.
define variable l_subst-ch          as character no-undo.
define variable l_syb-keywords      as character no-undo.
define variable l_word              as character no-undo.
define variable l_maxlen            as integer   no-undo.

/*----------------------- INTERNAL PROCEDURES ----------------------*/
/*---------------------------- TRIGGERS ----------------------------*/
/*------------------------- INITIALIZATIONS ------------------------*/

assign

  /* all words, that are keywords in ALL foreign DBs */
  /* actually this is an Oracle reserved word list, but I cant assume
     that it is only Oracle without knowing ALL foreign DBs reserved
     words--sorry, in the future, we will add new Oracle reserved
     words to the Oracle list. (2/2/96 DaveM.) */
  l_gen-keywords = "ACCESS,ADD,ALL,ALTER,AND,ANY,ARITH_OVERFLOW,AS,ASC,"
                 + "ASSERT,ASSIGN,AT,AUDIT,AUTHORIZATION,AVG,BEGIN,"
                 + "BETWEEN,BREAK,BROWSE,BULK,BY,CASCADE,CHAR_CONVERT,"
                 + "CHAR,CHECK,CHECKPOINT,CLOSE,CLUSTER,CLUSTERED,"
                 + "COLUMN,COMMENT,COMMIT,COMPRESS,COMPUTE,CONFIRM,"
                 + "CONNECT,CONSTRAINT,CONTAIN,CONTAINS,CONTINUE,"
                 + "CONTROLROW,CONVERT,COUNT,CRASH,CREATE,CURRENT,CURSOR,"
                 + "DATA_PGS,DATABASE,DATABASES,DATAPAGES,DATE,DBA,DBCC,"
                 + "DEALLOCATE,DECIMAL,DECLARE,DEFAULT,DEFINITION,"
                 + "DELETE,DESC,DISK,DISTINCT,DOES,DOUBLE,DROP,DUMMY,"
                 + "DUMP,EACH,ELSE,END,ENDIF,ENDTRAN,ERRLVL,ERROREXIT,"
                 + "ESCAPE,EVALUATE,EXCEPT,EXCLUSIVE,EXEC,EXECUTE,EXISTS,"
                 + "EXIT,FETCH,FILE,FILLFACTOR,FLOAT,FOR,FOREIGN,"
                 + "FROM,GOTO,GRANT,GRAPHIC,GROUP,HAVING,HOLDLOCK,"
                 + "IDENTIFIED,IDENTITY,IDENTITY_INSERT,IF,IFDEF,"
                 + "IMAGE,IMMEDIATE,IN,INCREMENT,INDEX,INDEXED,"
                 + "INDEXPAGES,INITIAL,INSERT,INTEGER,INTERSEC,"
                 + "INTERSECT,INTO,IS,ISOLATION,KEY,KILL,LEVEL,LIKE,"
                 + "LINENO,LIST,LOAD,LOCK,LONG,MAX,MAXEXTENTS,MERGE,MIN,"
                 + "MINUS,MIRROR,MIRROREXIT,MODE,MODIFY,MOVE"
                 + "NATIONAL,NEW,NOAUDIT,NOCOMPRESS,NOHOLDLOCK,"
                 + "NONCLUSTERED,NOSYSSORT,NOT,NOWAIT,NULL,NUMBER,"
                 + "NUMERIC_TRANSACTION,NUMERIC_TRUNCATION,OF,OFF,"
                 + "OFFLINE,OFFSETS,OLD,ON,ONCE,ONLINE,ONLY,OPEN,"
                 + "OPTIMIZE,OPTION,OR,ORDER,OVER,PARTITION,PCTFREE,PERM,"
                 + "PERMANENT,PLAN,PRECISION,PREPARE,PRIMARY,PRINT,PRIOR,"
                 + "PRIVILEGES,PROC,PROCEDURE,PROCESSEXIT,PUBLIC,"
                 + "RAISERROR,RAW,READ,READTEXT,RECONFIGURE,REFERENCES,"
                 + "RENAME,REPLACE,RESERVE_PGS,RESOURCE,RETURN,REVOKE,"
                 + "ROLE,ROLLBACK,ROW,ROWCNT,ROWCOUNT,ROWID,ROWLABEL,"
                 + "ROWNUM,ROWS,RULE,RUN,SAVE,SCHEMA,SELECT,SESSION,SET,"
                 + "SETUSER,SHARE,SHARED,SHUTDOWN,SIZE,SMALLINT,SOME,"
                 + "SPACE,START,STATEMENT,STATISTICS,STRIPE,SUCCESSFUL,"
                 + "SUM,SYNONYM,SYSDATE,SYSSORT,"
                 + "TABLE,TAPE,TEMP,TEMPORARY,TEXTSIZE,THEN,TO,TRAN,"
                 + "TRANSACTION,TRIGGER,TRUNCATE,TSEQUAL,UID,UNION,"
                 + "UNIQUE,UPDATE,USE,USED_PGS,USER,USER_OPTION,USING,"
                 + "VALIDATE,VALUES,VARCHAR,VARCHAR2,VARGRAPHIC,VARYING,"
                 + "VIEW,WAITFOR,WHENEVER,WHERE,WHILE,"
                 + "WITH,WORK,WRITETEXT"

  /* generic keywords plus all words, that are keywords in ORACLE only */
  l_ora-keywords = l_gen-keywords
                 + ",DUAL,ORACLE"

  /* generic keywords plus all words, that are keywords in MS SQL-Server only */
  /* 01/10/95 jlewis - Below are a list of MS SQL Server V6.0 Reserved Words
                       These are POSSIBLE FUTURE KEYWORDS that may be added later 
                       by Microsoft.
                   "absolute,action,allocate,are,assertion,both,cascaded,cast,"
                 + "char_length,character,character_length,collate,collation,connection,"
                 + "constraints,corresponding,day,deferrable,deferred,describe,"
                 + "descriptor,diagnostics,disconnect,domain,end_exec,exception,"
                 + "expiredate,external,extract,false,first,get,global,hour,"
                 + "initially, inner,input,interval,last,leading,local,"
                 + "match,minute,month,names,natural,nchar,next,no,octet_length,"
                 + "output,overlaps,pad,partial,position,preserve,relative,"
                 + "retaindays,rows,second,sqlstate,time,timestamp,timezone_hour,"
                 + "timezone_minute,trailing,translate,translation,true,unknown,usage,"
                 + "using,value,volume,write,year,zone"                           */

  l_mss-keywords = l_gen-keywords
                 + ",case,coalesce,committed,cross,current_date,current_time,current_timestamp,"
                 + "current_user,deny,distributed,floppy,freetext,full,identitycol,insensitive,inner,join,"
                 + "left,nocheck,nullif,outer,percent,pipe,repeatable,replication,restrict,right,"
                 + "scroll,serializable,session_user,system_user,uncommitted,updatetext,when"
                 + "BACKUP,FREETEXTTABLE,FUNCTION,RESTORE,ROWGUIDCOL,COLLATE,CONTAINSTABLE,"
                 + "TOP,NATIONAL,OPENDATASOURCE,OPENQUERY,OPENROWSET,OPENXML"

 /* Added all keywords for supported ODBC DataServer Databases */
  l_odb-keywords = l_gen-keywords + l_mss-keywords
                 + ",SYB_IDENTITY,SYB_RESTREE,SYB_TERMINATE,"
                 + "max_rows_per_page,unpartition,timestamp"
  .

assign

  /* characters that are not allowed */
  l_gen-char     = "%,-,&"

  /* substitution-character for characters that are not allowed */
  l_subst-ch     = "_"

  /* characters that are not allowed */
  l_ext-indicat  = "##"

  /* split up input-parameter's value */
  l_db-type      = ( if num-entries(p_param) > 1
                        then entry(2,p_param)
                        else ""
                   )
  l_word         = lc(entry(1,p_param))
  l_maxlen       = ( if num-entries(p_param) > 2
                        then integer ( entry(3,p_param))
                        else 0
                   )
  p_param        = l_word.

/*--------------------------- MAIN-BLOCK ---------------------------*/

/* replace unallowed characters */
repeat l_i = 1 to num-entries(l_gen-char):
  assign
    l_ch  = entry(l_i,l_gen-char)
    l_pos = index(l_word,l_ch)
    .
  repeat while l_pos <> 0:
    assign
      overlay(l_word,l_pos,1) = l_subst-ch
      l_pos                   = index(l_word,l_ch)
      .
    end.  /* repeat while l_pos <> 0 */
  end.  /* repeat l_i = 1 to num-entries(l_gen-char) */

/* trim leading "_"s */
repeat while substring(l_word,1,1,"character") = "_":
  assign l_word = substring(l_word,2,-1,"character").
  end.

/* check for empty value in l_word */
if l_word = ""
 then assign l_word = "z" + fill(l_subst-ch
                                ,length(p_param,"character") - 1
                                ).


/* Need to verify that if Progress name has ## in it that the ## is separated so that it is
   not confused as an extent field. 
*/   
assign l_pos = r-index(l_word,l_ext-indicat).
if l_pos > 1 and l_pos < length(l_word,"character") THEN 
  ASSIGN l_word = substring(l_word, 1, l_pos) + "_" + substring(l_word, l_pos + 1).

IF SUBSTRING(l_word, 1, 4) = "SYS_" THEN
  ASSIGN l_word = "z" + l_word.
   
/* check for reserved words */
/* note: if no db-type got passed, we check every db-type's keywords
 *       if db-type is not specially handled we check odbc's keywords
 */

IF l_db-type = "ORACLE" AND
     (lookup(l_word,l_Ora-keywords) <> 0) THEN
   ASSIGN l_word = l_word + l_subst-ch.
ELSE IF l_db-type = "ODBC" AND lookup(l_word,l_odb-keywords) <> 0 THEN
   ASSIGN l_word = l_word + l_subst-ch.
ELSE IF l_db-type = "MSS" AND lookup(l_word,l_mss-keywords) <> 0 THEN
   ASSIGN l_word = l_word + l_subst-ch.
/* let MSS fall through so we check l_odb-keywords. Don't do ORACLE since it is not an ODBC db
   and don't do ODBC since we already did up above - no point in doing it again */
ELSE IF (LOOKUP(l_db-type,"ORACLE,ODBC") = 0) AND LOOKUP(l_word,l_odb-keywords) <> 0 THEN
   ASSIGN l_word = l_word + l_subst-ch.


/* Check for max length     */
/* This isn't perfect;  it will cut off a few characters;  it's possible what
   we end up with won't be unique 
*/

if l_maxlen <> 0 then do:
  if length (l_word) > l_maxlen then do:
    l_word = substring(l_word, 1, l_maxlen).
  end.
end.

IF KEYWORD(l_word) <> ? then
assign SUBSTRING(l_word,MINIMUM(l_maxlen,LENGTH(l_word,"character") + 1),-1,"character") = "_". 

assign p_param = l_word.

/*------------------------------------------------------------------*/









/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptaqik.p

Description:
   Quick and dirty area report for character dictionary.
 
Author: Donna McMann

Date Created: 1/5/98

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qarerpt.p
   (INPUT drec_db).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptflds.p

Description:
   Detailed table report for character dictionary.  Includes table, field
   and index information.

Input:
   user_env[19] = begins "a" for _Field-name order or "o" for _Order order
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/12/92

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_dtblrpt.p
   (INPUT drec_db,
    INPUT (IF LDBNAME(user_dbname) = ? 
      	     THEN user_dbname ELSE LDBNAME(user_dbname)),
    INPUT user_dbtype,
    INPUT "",
    INPUT user_filename,
    INPUT no).

/* Reset global for "order by", if user switched order during report viewing */
IF INDEX(RETURN-VALUE, "o") > 0 THEN
   user_env[19] = "o".
ELSE IF INDEX(RETURN-VALUE, "a") > 0 THEN
   user_env[19] = "a".
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptfqik.p

Description:
   Quick and dirty field report for character dictionary.

Input:
   user_env[19] = begins "a" for _Field-name order or "o" for _Order order
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92
     History: 04/13/00 Added long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qfldrpt.p
   (INPUT drec_db,
    INPUT user_dbname, /*(IF LDBNAME(user_dbname) = ? 
      	     THEN user_dbname ELSE PDBNAME(user_dbname)),*/
    INPUT user_dbtype,
    INPUT user_filename,
    INPUT "s" + SUBSTRING(user_env[19],1,1)).

/* Reset global for "order by", based on what was last chosen in report */
IF INDEX(RETURN-VALUE, "o") > 0 THEN
   user_env[19] = "o".
ELSE IF INDEX(RETURN-VALUE, "a") > 0 THEN
   user_env[19] = "a".

/* See if switch file was chosen */
IF INDEX(RETURN-VALUE, "s") > 0 THEN
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   user_path   = "1=a,_usrtget,_rptfqik".
   &ELSE
   user_path   = "1=a,_guitget,_rptfqik".
   &ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptiqik.p

Description:
   Quick and dirty index report for character dictionary.
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92
    History:  04/13/00 Added long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qidxrpt.p
   (INPUT drec_db,
    INPUT user_dbname,
    INPUT user_dbtype,
    INPUT user_filename,
    INPUT "s").

IF RETURN-VALUE = "s" THEN 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   user_path = "1=a,_usrtget,_rptiqik".
   &ELSE
   user_path = "1=a,_guitget,_rptiqik".
   &ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptrels.p

Description:
   File relation report for character dictionary.

Author: Tony Lavinio, Laura Stern

Date Created: 10/13/92
    History:  04/13/00 Added long path name support
----------------------------------------------------------------------------*/


{ prodict/dictvar.i }
{ prodict/user/uservar.i }


RUN adecomm/_trelrpt.p
   (INPUT drec_db,
    INPUT user_dbname,
    INPUT user_dbtype,
    INPUT user_filename,
    INPUT "s").

/* See if switch file was chosen */
IF INDEX(RETURN-VALUE, "s") > 0 THEN
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   user_path = "1=a,_usrtget,_rptrels". 
   &ELSE
   user_path = "1=a,_guitget,_rptrels". 
   &ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptsqik.p

Description:
   Quick and dirty sequence report for character dictionary.
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92
     History:  04/13/00 Added long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qseqrpt.p
   (INPUT drec_db,    
    INPUT user_dbname,
    INPUT user_dbtype).

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rpttqik.p

Description:
   Quick and dirty table report for character dictionary.
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92
     History:  04/13/00 Added long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qtblrpt.p
   (INPUT drec_db,    
    INPUT user_dbname,
    INPUT user_dbtype).

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rpttrig.p

Description:
   Trigger report for character dictionary.
 
Author: Laura Stern

Date Created: 11/20/92
    History:  04/13/00 Added long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_trigrpt.p
   (INPUT drec_db,    
    INPUT user_dbname,
    INPUT user_dbtype).

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptuqik.p

Description:
   Quick and dirty user report for character dictionary.
 
Author: Tony Lavinio, Laura Stern

Date Created: 10/05/92
    History:  04/13/00 Added long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qusrrpt.p
   (INPUT drec_db,    
    INPUT user_dbname,
    INPUT user_dbtype).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptvqik.p

Description:
   Quick and dirty view report for character dictionary.
 
Input: user_env[1] = View name or "ALL".

Author: Tony Lavinio, Laura Stern

Date Created: 10/07/92
    History:  04/13/00 Added Long path name support

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

RUN adecomm/_qviwrpt.p
   (INPUT drec_db,    
    INPUT user_dbname,
    INPUT user_dbtype,
    INPUT user_env[1]).

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptwdat.p

History:  09/18/02 D. McMann Created
          11/01/02 Added correct help topic

Main controlling procedure called from either prodict/misc/_rptwdth.p or
from the GUI Data Dictionary to call for the generation of the Verify Data
Report.  

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES
{adecomm/commeng.i}  /* Help contexts */
{adecomm/adestds.i}  /* Standard layout defines, colors etc. */
{adecomm/adeintl.i}  /* International support */

DEFINE INPUT PARAMETER p_DbId 	 AS RECID    NO-UNDO.
DEFINE INPUT PARAMETER p_PName 	 AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_DbType  AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl 	 AS CHAR     NO-UNDO.
DEFINE INPUT PARAMETER p_TblRec  AS RECID    NO-UNDO.

DEFINE NEW SHARED STREAM rpt.  /* used by prtrpt.i */

DEFINE VAR ans         AS LOGICAL      	     	       NO-UNDO.
DEFINE VAR header_str  AS CHAR 	       	     	       NO-UNDO.
DEFINE VAR app         AS LOGICAL   INITIAL FALSE      NO-UNDO.
DEFINE VAR dev         AS CHAR 	       	     	       NO-UNDO
   VIEW-AS RADIO-SET
   RADIO-BUTTONS "Terminal","TERMINAL","Printer","PRINTER","File","F"
   INITIAL "TERMINAL".
DEFINE VAR fil           AS CHAR                         NO-UNDO.
DEFINE VAR siz           AS INTEGER   INITIAL 0          NO-UNDO.
DEFINE VARIABLE vhow     AS CHARACTER                    NO-UNDO.
DEFINE VARIABLE p_TblAsk AS LOGICAL                      NO-UNDO.

DEFINE VARIABLE Verify-by AS CHARACTER INITIAL "W" 
   LABEL "&Verify Using"
   VIEW-AS RADIO-SET 
   RADIO-BUTTONS  "Width", "W", "Format", "F"
   NO-UNDO.

DEFINE VAR which_tbl   AS CHARACTER  INITIAL "t"       NO-UNDO
      LABEL "&Report on"
      VIEW-AS RADIO-SET  
      RADIO-BUTTONS "Selected Table", "t",
      	       	    "ALL Tables",     "a".

DEFINE BUTTON btn_Ok 	 LABEL "OK"       {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel"   {&STDPH_OKBTN} AUTO-ENDKEY.
DEFINE BUTTON btn_Files  LABEL "&Files..." 
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SIZE 15 by 1.125 &ENDIF .
   
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   Define button    btn_Help  label "&Help" {&STDPH_OKBTN}.
   Define rectangle rect_Btns {&STDPH_OKBOX}. /* standard button rectangle */
   &global-define   HLP_BTN  &HELP = "btn_Help"
&ELSE
   &global-define   HLP_BTN  
&ENDIF

DEFINE VAR stat AS LOGICAL NO-UNDO.


/*-------------------------------Forms------------------------------------*/
FORM
   SKIP({&TFM_WID})
   
   dev LABEL "&Send Output to"           COLON 17  
   SKIP ({&VM_WID})

   fil NO-LABEL FORMAT "x({&PATH_WIDG})"           AT    19
       VIEW-AS FILL-IN NATIVE SIZE 30 BY 1   	   {&STDPH_FILL} SPACE(.3)
   btn_Files
   SKIP({&VM_WID})

   app LABEL "&Append to Existing File?" AT    19
       VIEW-AS TOGGLE-BOX 
   SKIP({&VM_WIDG})
   
   siz LABEL "&Page Length" FORMAT ">>9" COLON 17   {&STDPH_FILL}
   "(# Lines, 0 for Continuous)":t35                   	  
   SKIP({&VM_WIDG})
   Verify-by                             COLON 17
   which_tbl
   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      {&HLP_BTN}
   }

   WITH FRAME options 
      SIDE-LABELS 
      DEFAULT-BUTTON btn_Ok CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX TITLE "Report Options".


/*-----------------------------Triggers------------------------------------*/

/*----- OK or GO -----*/
ON GO OF FRAME OPTIONS  
DO:

   DEFINE VARIABLE flags AS CHARACTER.
  
   ASSIGN dev
          fil
          app
          siz
          Verify-by
          fil = TRIM(fil).

   IF p_tblAsk THEN DO:
     ASSIGN  which_tbl = which_tbl:SCREEN-VALUE.
     IF which_tbl = "t" THEN DO:
       FIND DICTDB._File WHERE recid(DICTDB._File) = p_TblRec.
       ASSIGN p_Tbl = DICTDB._File._File-name.
     END.
     ELSE
       ASSIGN p_Tbl = "ALL".
   END.

   
   /* Do it.  If user displays to terminal he will have the option to print
      later.  If going to printer - that's all folks.
   */   
   header_str = "Database: " + p_PName + " (" + p_DbType + ")".
   IF dev = "TERMINAL" THEN
   DO:
      header_str = "Database: " + p_PName + " (" + p_DbType + ")".
      vhow = (IF verify-by = "F" THEN "Verified by Format"
             ELSE "Verified by Width").
      RUN adecomm/_report.p 
	 (INPUT p_DbId, 
	  INPUT header_str,
      INPUT "Data Width Report",
	  INPUT vhow,
	  INPUT verify-by,
	  INPUT  "prodict/user/_usrwdth.p",
	  INPUT p_Tbl,
      INPUT {&Verify_Data_Width_Report_Dialog_Box}).
   END.
   ELSE DO:
      IF dev = "F" then DO:
        ASSIGN dev = fil.  
        IF NOT app THEN DO:
          FILE-INFO:FILE-NAME = fil.
          IF FILE-INFO:FULL-PATHNAME NE ? THEN DO:
            DEF VAR choice AS LOGICAL INITIAL NO.
            MESSAGE fil "already exists. Overwrite?" VIEW-AS ALERT-BOX QUESTION 
              BUTTONS YES-NO UPDATE choice.
            IF NOT choice THEN DO:
              APPLY "ENTRY" TO fil.
              RETURN NO-APPLY.
            END.
          END.
        END.
      END.
      {adecomm/prtrpt.i
	      &Header = header_str
          &Flags  = flags
	      &dev    = dev
	      &app    = app
	      &siz    = siz
	      &Func   = "prodict/user/_usrwdth.p (INPUT p_Dbid, INPUT p_Tbl, INPUT verify-by)"}.
     
   END.
END.

/*----- VALUE-CHANGED of DEVICE RADIO SET -----*/
ON VALUE-CHANGED OF dev IN FRAME options
DO:
   /* Default to continuous output for terminal, 60 for printer */
   dev = SELF:SCREEN-VALUE.
   IF dev = "F" /* file */ THEN DO:
      ASSIGN
	 siz:SCREEN-VALUE IN FRAME options = "0"
	 &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	    fil:VISIBLE IN FRAME options = yes
	    btn_Files:VISIBLE IN FRAME options = yes
	    app:VISIBLE IN FRAME options = yes
	 &ELSE
	    fil:SENSITIVE IN FRAME options = yes
	    btn_Files:SENSITIVE IN FRAME options = yes
	    app:SENSITIVE IN FRAME options = yes
	 &ENDIF
      	 .
      APPLY "ENTRY" TO fil IN FRAME options.
   END.
   ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	 ASSIGN
	    fil:VISIBLE IN FRAME options = no
	    btn_Files:VISIBLE IN FRAME options = no
	    app:VISIBLE IN FRAME options = no.
      &ELSE
	 ASSIGN
	    fil:SENSITIVE IN FRAME options = no
	    fil:SCREEN-VALUE IN FRAME options = ""
	    btn_Files:SENSITIVE IN FRAME options = no
	    app:SENSITIVE IN FRAME options = no.
      &ENDIF
      IF dev = "TERMINAL" THEN
	 siz:SCREEN-VALUE IN FRAME options = "0".
      ELSE IF dev = "PRINTER" THEN  
	 siz:SCREEN-VALUE IN FRAME options = "60".
   END.
END.

/*----- HIT of FILE BUTTON -----*/
on choose of btn_Files in frame options
do:
   Define var name       as char    NO-UNDO.
   Define var picked_one as logical NO-UNDO.
   Define var d_title    as char    NO-UNDO init "Report File".

   name = TRIM(fil:screen-value in frame options).
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      system-dialog GET-FILE 
		    name 
		    filters            "*" "*"
		    default-extension  ""
		    title 	       d_title 
		    /*must-exist*/
		    update             picked_one.
   &ELSE
      run adecomm/_filecom.p
	  ( INPUT "" /* p_Filter */, 
	    INPUT "" /* p_Dir */ , 
	    INPUT "" /* p_Drive */ ,
	    INPUT no /* File Open */ ,
	    INPUT d_title ,
            INPUT "" /* Dialog Options */ ,
	    INPUT-OUTPUT name,
   	    OUTPUT picked_one ). 
   &ENDIF

   if picked_one then
      fil:screen-value in frame options = name.
end.

ON HELP OF FRAME options
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    OR CHOOSE OF btn_Help IN FRAME options
  &ENDIF
  RUN "adecomm/_adehelp.p" ("comm", "CONTEXT", {&Report_Options}, ?).

/*-------------------------------Mainline code-----------------------------*/
/* Check for privileges */

IF INTEGER(DBVERSION("DICTDB")) > 8 THEN DO:
  FIND _File WHERE  _File._File-name = "_File" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE _File._File-name = "_Field" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE  _File._File-name = "_Index" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File WHERE  _File._File-name = "_Index-field" 
               AND _File._Owner = "PUB" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
ELSE DO:
  FIND _File "_File" NO-LOCK.
  ans = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Field" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Index" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Index-field" NO-LOCK.
  ans = ans AND CAN-DO(_Can-read,USERID("DICTDB")).
END.  
IF NOT ans THEN DO:
  MESSAGE "You do not have permission to use this option."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.


/* "ALL" selected -> print all non-hidden files, if there are none -> error */
IF  p_Tbl = "ALL" OR p_Tbl = "" THEN DO:
  FIND LAST _File NO-LOCK WHERE _File._Db-recid = p_DbId AND 
    NOT _File._Hidden NO-ERROR.
  IF NOT AVAILABLE _File THEN DO:
    MESSAGE "There are no tables in this database to look at."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.

IF p_Tbl = "" THEN
  ASSIGN p_TblAsk = TRUE.

ASSIGN which_tbl:HIDDEN IN FRAME OPTIONS = (IF p_TblAsk THEN no else yes).

/* "File" related fields start insensitive or hidden by default */
ASSIGN
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    fil:hidden IN FRAME options = yes
    btn_Files:hidden IN FRAME options = yes
    app:hidden IN FRAME options = yes
    fil:sensitive IN FRAME options = yes
    btn_Files:sensitive IN FRAME options = yes
    app:sensitive IN FRAME options = yes
  &ELSE
    fil:sensitive IN FRAME options = no
    btn_Files:sensitive IN FRAME options = no
    app:sensitive IN FRAME options = no
  &ENDIF
  .

/* Run time layout for button area. */
{adecomm/okrun.i  
  &FRAME  = "frame options" 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  &Cancel = "btn_Cancel"
  {&HLP_BTN} }

DISPLAY
  dev
  siz
  Verify-by
  which_tbl WHEN p_TblAsk
  WITH FRAME options.

ENABLE
  dev siz Verify-by which_tbl WHEN p_TblAsk
  btn_Ok btn_Cancel
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    btn_Help
  &ENDIF
  WITH FRAME options.

/* Reset tab-order for things that will be enabled later. */
ASSIGN
  stat = fil:MOVE-AFTER-TAB-ITEM(dev:HANDLE IN FRAME options)
  stat = btn_Files:MOVE-AFTER-TAB-ITEM(fil:HANDLE IN FRAME options)
  stat = app:MOVE-AFTER-TAB-ITEM(btn_Files:HANDLE IN FRAME options).

/* If user choose print and there's a problem with the printer, 
   Progress may generate a STOP condition - so trap that so
   we don't get kicked out of the whole application.  */
DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE ON STOP UNDO, LEAVE:
  WAIT-FOR CHOOSE of btn_OK in FRAME options OR GO of FRAME options FOCUS dev.
END.

HIDE FRAME options.
RETURN RETURN-VALUE.

/* _dtblrpt.p -  end of file */





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _rptwdth.p

History:  09/18/02 D. McMann Created


----------------------------------------------------------------------------*/

{ prodict/dictvar.i } 
{ prodict/user/uservar.i }

RUN prodict/misc/_rptwdat.p
   (INPUT drec_db,
    INPUT (IF LDBNAME(user_dbname) = ? 
      	     THEN user_dbname ELSE LDBNAME(user_dbname)),
    INPUT user_dbtype,
    INPUT user_filename,
    INPUT ?).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

DEFINE SHARED VARIABLE totrecs AS INTEGER INITIAL 0 NO-UNDO.
DISABLE TRIGGERS FOR DUMP OF DICTDB2.{1}.
FOR EACH DICTDB2.{1} {2}:
 totrecs = totrecs + 1.
END.
/*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

Preprocessor parameters
    1 - table name 
    2 - where .. [use index] no-lock
    3 -  no-lobs (trailing space)
    4 -  except <fields>
History:
 
  K McIntosh 04/25/05  Added code, when dumping _db-detail table, to ensure 
                       that the current _db-detail record is the first one 
                       in the output file.
                       
                       Also added except list support, to allow facilities to
                       compile lists of specific data not to dump.  Added
                       code to prevent system owned _sec-role records from
                       being dumped.
                       
*/                       
/* _rundump.i - Data Dictionary file dump module */
DEFINE SHARED STREAM   dump.

DEFINE SHARED VARIABLE recs         AS DECIMAL   FORMAT "ZZZZZZZZZZZZ9" NO-UNDO.
DEFINE SHARED VARIABLE xpos         AS INTEGER   NO-UNDO.
DEFINE SHARED VARIABLE ypos         AS INTEGER   NO-UNDO.
DEFINE SHARED VARIABLE user_excepts AS CHARACTER NO-UNDO.
DEFINE SHARED VARIABLE drec_db      AS RECID     NO-UNDO.

/* Will be "y" or "n" */
DEFINE INPUT PARAMETER p_Disable AS CHARACTER NO-UNDO.

DEFINE VARIABLE i     AS INTEGER     NO-UNDO.

DEFINE VARIABLE cGuid AS CHARACTER   NO-UNDO.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  IF TERMINAL <> "" THEN DO:
    DEFINE STREAM run_dump.
    OUTPUT STREAM run_dump TO TERMINAL.

  END.
&ENDIF
IF p_Disable  = "y" THEN
  DISABLE TRIGGERS FOR DUMP OF DICTDB2.{1}.
recs = 0.

/* If the table is _db-detail, ensure that we dump out the current record
   first. */
&IF "{1}" = "_db-detail" &THEN
  FIND DICTDB2._db WHERE RECID(DICTDB2._db) EQ drec_db NO-LOCK NO-ERROR.
  FIND DICTDB2._db-detail 
      WHERE DICTDB2._db-detail._db-guid = DICTDB2._db._db-guid NO-LOCK NO-ERROR.
  IF AVAILABLE DICTDB2._db-detail THEN DO:
    ASSIGN cGuid = DICTDB2._db._db-guid
           recs  = recs + 1.
    EXPORT STREAM dump DICTDB2._db-detail {3}.
  END.
&ENDIF
 
for each DICTDB2.{1} {2}: 

  /* Here we prevent dumping the current record a second time. */
  &IF "{1}" = "_db-detail" &THEN
     IF DICTDB2._db-detail._db-guid = cGuid THEN NEXT.
  &ENDIF
  
  /* Ensure that this record is not in the except list before 
     dumping it. */
  &IF "{1}" = "_sec-role" &THEN
    IF CAN-DO(user_excepts, DICTDB2._sec-role._role-name) THEN NEXT.
  &ENDIF
  
  &IF "{1}" = "_aud-event" &THEN
    IF DICTDB2._aud-event._event-id < 32000 THEN NEXT.
  &ENDIF
 
  assign recs = recs + 1.
  export stream dump DICTDB2.{1} {4} {3}.
  
  if   terminal       <> ""
   and recs modulo 100 = 0
   then do:  /* */
    
    end.
  end.  /* for each DICTDB2.{1} {2} */

RETURN.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
NOTE:
  Do not change any text in this program.  _dctlrec.p must
  be able to parse the error log this program outputs.
*/
/*
History:
 
  laurief    6/9/98   Added user_env[6] to determine whether load errors
                      are displayed to screen.
  Mario B.  08/04/99  If triggers causes error, output to .e file
                      BUG# 19990803-032
  
   {1} - Name of the table to load
   {2} - tolerable load rate (%).  
   {3} - set size, status will be displayed after each set
   {4} - either table name or specific field names to load.
   {5} - expected # load records.  If {2} is either 0 or 100%, then
      	 this is ignored.
   {6} - NO-LOBS keyword, if passed.      
   {7} - except fieldlist  (including the except keyword) 
  D. McMann  11/19/02  Added check for num-messages after import to catch
                       warning messages.       
  D. McMann  03/06/03  Added support for NO-LOBS in import.
  K McIntosh 04/25/05  Added check when loading _db-detail table to tie the 
                       first record read to the _db record.
  K McIntosh 05/26/05  Added ELSE when not first _db-detail record 20050525-038.
  fernando   11/09/05  Added code for _db-option 20051109-033 
  fernando   06/16/06  Assign _db-recid in _db-option when loading db options - 20060612-001
  fernando   06/20/07  Support for large files
*/
   
/* Will be "y" or "n" to indicate whether to disable triggers or not */
DEFINE INPUT PARAMETER p_Disable AS CHARACTER NO-UNDO.

DEFINE SHARED STREAM   loaderr.
DEFINE SHARED VARIABLE errs    AS INTEGER NO-UNDO.
DEFINE SHARED VARIABLE recs    AS INT64. /*UNDO*/
DEFINE SHARED VARIABLE xpos    AS INTEGER NO-UNDO.
DEFINE SHARED VARIABLE ypos    AS INTEGER NO-UNDO.
define shared variable fil-d as character no-undo.
DEFINE SHARED VARIABLE dictMonitor    AS OpenEdge.DataAdmin.Binding.ITableDataMonitor NO-UNDO.

DEFINE        VARIABLE errbyte AS INT64   NO-UNDO.
DEFINE        VARIABLE errline AS INTEGER NO-UNDO.
DEFINE        VARIABLE nxtstop AS INT64   NO-UNDO.
DEFINE        VARIABLE err%    AS INTEGER NO-UNDO.
DEFINE        VARIABLE ans999  AS LOGICAL NO-UNDO.
DEFINE        VARIABLE stopped AS LOGICAL NO-UNDO INIT FALSE.
DEFINE        VARIABLE j       AS INTEGER NO-UNDO.

DEFINE SHARED VARIABLE user_env    AS CHARACTER NO-UNDO EXTENT 42.
DEFINE SHARED VARIABLE drec_db     AS RECID     NO-UNDO.

DEFINE VARIABLE cDbDetail          AS CHARACTER NO-UNDO EXTENT 4.

/* Need a little dialog instead of using PUT SCREEN for GUI because
   here, xpos and ypos will be based on fill-in height whereas frame is
   USE-TEXT so the rows won't line up. 
*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  IF TERMINAL <> "" THEN DO:
    DEFINE STREAM run_load.
    OUTPUT STREAM run_load TO TERMINAL.
  END.
&ENDIF

ASSIGN
  recs = 0
  errs = 0
  err% = {2}.

IF p_Disable  = "y" THEN
  DISABLE TRIGGERS FOR LOAD OF DICTDB2.{1}.

/* Go through all load records.  When IMPORT hits the end of file or 
   ".", ENDKEY will be generated which will kick us out of this "top"
   loop.
*/
top:
DO WHILE TRUE TRANSACTION:
  nxtstop = recs + {3}.

  /* Go through set of {3} at a time */
  bottom:
  REPEAT FOR DICTDB2.{1}
    WHILE recs < nxtstop ON ENDKEY UNDO,LEAVE top:

    IF RETRY THEN DO:
      errs = errs + 1.
      IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
      DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
          PUT STREAM loaderr UNFORMATTED
            ">> ERROR READING LINE #" errline 
            " (Offset=" errbyte  "): " ERROR-STATUS:GET-MESSAGE(j) SKIP.
      END.
      ELSE IF p_Disable = "n" THEN
      DO:
         PUT STREAM loaderr UNFORMATTED
	    ">> ERROR READING LINE #" errline
	    " (Offset=" errbyte  "): Unknown error caused by database"
	    " trigger." SKIP.
      END.

      IF (err% = 0) OR
         (err% <> 100 AND errs > ({5} * {2}) / 100) THEN DO:
      	 
      	 if valid-object(dictMonitor) then
             dictMonitor:SetTableBailed(fil-d).
          
      	 PUT STREAM loaderr UNFORMATTED
      	    "** Tolerable load error rate is: {2}%." SKIP
      	    "** Loading table {1} is stopped after " errs " error(s)." SKIP.
      	 RETURN.
      END.
      NEXT.
    END.

    ASSIGN
      errbyte = SEEK(INPUT)
      errline = errline + 1
      recs    = recs + 1.
    
    if valid-object(dictMonitor) then
        dictMonitor:CountRow(fil-d).
 
    &IF "{1}" = "_db-detail" &THEN
      IF recs = 1 THEN DO:
        /* the first record was the current one when the records were loaded */
        /* the code below will make it the current one now */
        FIND DICTDB2._db WHERE RECID(DICTDB2._db) = drec_db.
        CREATE DICTDB2._db-detail.
	  
        IMPORT DICTDB2._db-detail NO-ERROR.
        DICTDB2._db._db-guid = DICTDB2._db-detail._db-guid.
      END.
      ELSE DO:
        CREATE DICTDB2._db-detail.
        IMPORT DICTDB2._db-detail NO-ERROR.
      END.
    &ELSEIF "{1}" = "_db-option" &THEN
        /* check if the record for this db option exists. If not, create the record,
           otherwise just update the option.
        */
        cDbDetail = "".
        IMPORT cDbDetail NO-ERROR.

        IF NOT ERROR-STATUS:ERROR THEN DO:
            /* if can't find the record for the db option imported, create it */
            FIND FIRST DICTDB2._db-option 
                 WHERE DICTDB2._db-option._Db-option-type = INTEGER(cDbDetail[1]) AND
                 DICTDB2._db-option._Db-option-code = cDbDetail[2] NO-ERROR.
            IF NOT AVAILABLE DICTDB2._db-option THEN DO:
                CREATE {1}.
                ASSIGN _Db-option._Db-option-type = INTEGER(cDbDetail[1])
                       _Db-option._Db-option-code = cDbDetail[2]
                       _Db-option._Db-option-description = cDbDetail[3]
                       _Db-option._Db-option-value = cDbDetail[4] 
                       _Db-option._db-recid = drec_db NO-ERROR.
            END.
            ELSE DO:
                /* record is already in the db - just update the option value */
                ASSIGN DICTDB2._db-option._Db-option-value = cDbDetail[4] NO-ERROR.
            END.
        END.
    &ELSEIF "{1}" = "_sec-authentication-domain" &THEN
      define temp-table ttdom like {1}. 
      
      create ttdom.
      IMPORT ttdom {7} {6} NO-ERROR.
      IF NOT ERROR-STATUS:ERROR THEN 
      DO:
          if ttdom._Domain-category <> 0 then
          do:
              find DICTDB2._sec-authentication-domain 
                     where DICTDB2._sec-authentication-domain._Domain-name = ttdom._Domain-name exclusive-lock no-wait no-error.
              if locked DICTDB2._sec-authentication-domain then
              do:
                 delete ttDom.         
                 undo, retry.
              end.         
              if not avail DICTDB2._sec-authentication-domain then
              do:
                 delete ttDom.         
                 undo, retry.
              end.         
              assign DICTDB2._sec-authentication-domain._Domain-enabled   = ttdom._Domain-enabled NO-ERROR.
              IF  ttdom._Domain-category = 1 THEN 
                  ASSIGN DICTDB2._sec-authentication-domain._Domain-type = ttdom._Domain-type NO-ERROR.
          end.
          else do:
              create {1}.
              buffer-copy ttdom {7} to {1} NO-ERROR.
          end.
      END.
      delete ttDom.         
    &ELSEIF "{1}" = "_sec-authentication-system" &THEN
      define temp-table ttSec like {1}. 
      
      create ttSec.
      IMPORT ttSec {7} {6} NO-ERROR.
      IF NOT ERROR-STATUS:ERROR THEN
      DO: 
          if ttSec._domain-type begins '_' then
          do:
              find DICTDB2._sec-authentication-system 
                     where DICTDB2._sec-authentication-system._Domain-type = ttSec._Domain-type exclusive-lock no-wait no-error.
              if locked DICTDB2._sec-authentication-system then
              do:
                 delete ttSec.
                 undo, retry.
              end.         
              if not avail DICTDB2._sec-authentication-system then
              do:
                 delete ttSec.
                 undo, retry.
              end.         
              assign DICTDB2._sec-authentication-system._PAM-callback-procedure   = ttSec._PAM-callback-procedure NO-ERROR.
          end.
          else do:
              create {1}.
              buffer-copy ttSec {7} to {1} NO-ERROR.
          end.
      END.
      delete ttSec.
      
    &ELSE
      CREATE {1}.
      IMPORT {4} {7} {6} NO-ERROR.
    &ENDIF
     
    
    IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
      IF SUBSTRING(ERROR-STATUS:GET-MESSAGE(1), 1, 7) = "WARNING" THEN DO:
        errs = errs + 1.      
        DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
          PUT STREAM loaderr UNFORMATTED
             ERROR-STATUS:GET-MESSAGE(j) SKIP.
        END.
      END.
      ELSE DO: 
       IF TERMINAL <> "" AND user_env[6] = "s" THEN DO:
         DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
       	    ans999 = yes.
            MESSAGE ERROR-STATUS:GET-MESSAGE(j) SKIP(1)
      	         "Press OK to continue or Cancel to stop processing."
      	       VIEW-AS ALERT-BOX ERROR BUTTONS OK-CANCEL UPDATE ans999.
            IF NOT ans999 THEN DO:
      	       stopped = TRUE.
      	       UNDO top, LEAVE top.
            END.
      	 END.
        END.
        UNDO bottom, RETRY bottom.
      END.
    END.   /* ERROR raised */

    VALIDATE {1} NO-ERROR . 

    IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
      IF TERMINAL <> "" AND user_env[6] = "s" THEN DO:
         DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
       	    ans999 = yes.
            MESSAGE ERROR-STATUS:GET-MESSAGE(j) SKIP(1)
      	         "Press OK to continue or Cancel to stop processing."
      	       VIEW-AS ALERT-BOX ERROR BUTTONS OK-CANCEL UPDATE ans999.
            IF NOT ans999 THEN DO:
      	       stopped = TRUE.
      	       UNDO top, LEAVE top.
            END.
      	 END.
      END.
      UNDO bottom, RETRY bottom.
    END.   /* ERROR raised */
    
/*     IF recs = {5} THEN LEAVE top. */
  END. /* end bottom repeat */
END. /* top */

IF stopped 
   THEN RETURN "stopped".
   ELSE RETURN.








/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _runsylk.i - takes a .sl files and makes it a .d file */

DEFINE INPUT PARAMETER file_in  AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER file_out AS CHARACTER NO-UNDO.

DEFINE VARIABLE line-no   AS INTEGER   NO-UNDO.
DEFINE VARIABLE c-x       AS INTEGER   NO-UNDO.
DEFINE VARIABLE c-y       AS INTEGER   NO-UNDO.
DEFINE VARIABLE chr-val   AS CHARACTER NO-UNDO.
DEFINE VARIABLE curr-c    AS INTEGER   NO-UNDO.
DEFINE VARIABLE curr-col  AS INTEGER   NO-UNDO.
DEFINE VARIABLE curr-r    AS INTEGER   NO-UNDO.
DEFINE VARIABLE curr-row  AS INTEGER   NO-UNDO.
DEFINE VARIABLE f-x       AS INTEGER   NO-UNDO.
DEFINE VARIABLE f-y       AS INTEGER   NO-UNDO.
DEFINE VARIABLE first-chr AS CHARACTER NO-UNDO.
DEFINE VARIABLE i         AS INTEGER   NO-UNDO.
DEFINE VARIABLE in-line   AS CHARACTER NO-UNDO.
DEFINE VARIABLE k-data    AS CHARACTER NO-UNDO.
DEFINE VARIABLE line-len  AS INTEGER   NO-UNDO.
DEFINE VARIABLE looking   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE max-col   AS INTEGER   NO-UNDO.
DEFINE VARIABLE ndx       AS INTEGER   NO-UNDO.
DEFINE VARIABLE num-col   AS INTEGER   NO-UNDO.
DEFINE VARIABLE s-x       AS INTEGER   NO-UNDO.
DEFINE VARIABLE s-y       AS INTEGER   NO-UNDO.

DEFINE STREAM in-stream.
DEFINE STREAM out-stream.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

FORM
  line-no LABEL "Working on line"
  WITH FRAME working ROW 5 CENTERED ATTR-SPACE SIDE-LABELS.
COLOR DISPLAY MESSAGES line-no WITH FRAME working.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

INPUT STREAM in-stream FROM VALUE(file_in) NO-ECHO NO-MAP.
OUTPUT STREAM out-stream TO VALUE(file_out) NO-ECHO NO-MAP.

ASSIGN
  line-no  = 0
  curr-row = 1
  curr-col = 1.

REPEAT:
  IMPORT STREAM in-stream in-line.
  ASSIGN
    line-no   = line-no + 1
    first-chr = SUBSTRING(in-line,1,1)
    line-len  = LENGTH(in-line).
  DISPLAY line-no WITH FRAME working.
  IF INDEX("CEF",first-chr) = 0 THEN NEXT.
  IF first-chr = "E" THEN LEAVE. /* E signifies THE END OF SYLK FILE */
  IF first-chr = "F" THEN DO:    /* F signifies FORMATTING PHRASE */
    ASSIGN
      f-y     = 0                /* BUT IT MIGHT HAVE ROW & COL COORDs */
      f-x     = 0
      chr-val = ""
      ndx     = INDEX(in-line,";X").
    IF ndx <> 0 THEN DO:
      ASSIGN
        ndx     = ndx + 2
        looking = TRUE.
      DO WHILE looking:  /* looking for X VALUE */
        ASSIGN
          chr-val = chr-val + SUBSTRING(in-line,ndx,1)
          ndx     = ndx + 1.
        IF ndx > line-len THEN looking = FALSE.
        IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
      END.
      f-x = INTEGER(chr-val).
    END.
    ASSIGN
      chr-val = ""
      ndx     = INDEX(in-line,";Y").
    IF ndx <> 0 THEN DO:
      ASSIGN
        ndx     = ndx + 2
        looking = TRUE.
      DO WHILE looking:  /* looking for Y VALUE */
        ASSIGN
          chr-val = chr-val + SUBSTRING(in-line,ndx,1)
          ndx     = ndx + 1.
        IF ndx > line-len THEN looking = FALSE.
        IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
      END.
      f-y = INTEGER(chr-val).
    END.
    /* logic to figure out row and col */
    IF f-y <> 0 THEN curr-row = f-y.
    IF f-x <> 0 THEN curr-col = f-x.
  END.  /* RTD F */
  IF first-chr = "C" THEN DO:     /* C signifies ACTUAL DATA LINE */
    ASSIGN
      c-x     = 0
      c-y     = 0
      k-data  = ""
      chr-val = "".

    ndx = INDEX(in-line,";X").
    IF ndx <> 0 THEN DO:
      ASSIGN
        ndx     = ndx + 2
        looking = TRUE.
      DO WHILE looking:  /* looking for X VALUE */
        ASSIGN
          chr-val = chr-val + SUBSTRING(in-line,ndx,1)
          ndx     = ndx + 1.
        IF ndx > line-len THEN looking = FALSE.
        IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
      END.
      c-x = INTEGER(chr-val).
    END.
    ASSIGN
      chr-val = ""
      ndx     = INDEX(in-line,";Y").
    IF ndx <> 0 THEN DO:
      ASSIGN
        ndx     = ndx + 2
        looking = TRUE.
      DO WHILE looking:  /* looking for Y VALUE */
        ASSIGN
          chr-val = chr-val + SUBSTRING(in-line,ndx,1)
          ndx     = ndx + 1.
        IF ndx > line-len THEN looking = FALSE.
        IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
      END.
      c-y = INTEGER(chr-val).
    END.
    ASSIGN
      chr-val = ""
      ndx     = INDEX(in-line,";K").
    IF ndx <> 0 THEN DO:
      ASSIGN
        ndx     = ndx + 2
        looking = TRUE.
      DO WHILE looking:  /* looking for K (DATA) VALUE */
        ASSIGN
          chr-val = chr-val + SUBSTRING(in-line,ndx,1)
          ndx     = ndx + 1.
        IF ndx > line-len THEN looking = FALSE.
        IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
      END.
      k-data = chr-val.
    END.
    ELSE DO:  /* look for a the S value then the R & C values. */
      ASSIGN
        chr-val = ""
        s-x     = 0
        s-y     = 0
        ndx     = INDEX(in-line,";S").
      IF ndx <> 0 THEN DO:   /* if there was an S then look for */
        ASSIGN
          ndx     = INDEX(in-line,";R")  /* the R & C values. */
          chr-val = "".
        IF ndx <> 0 THEN DO:
          ASSIGN
            ndx     = ndx + 2
            looking = TRUE.
          DO WHILE looking:  /* looking for R (ROW) VALUE */
            ASSIGN
              chr-val = chr-val + SUBSTRING(in-line,ndx,1)
              ndx     = ndx + 1.
            IF ndx > line-len THEN looking = FALSE.
            IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
          END.
          s-y = INTEGER(chr-val).
        END.
        ASSIGN
          ndx     = INDEX(in-line,";C")  /* the R & C values. */
          chr-val = "".
        IF ndx <> 0 THEN DO:
          ASSIGN
            ndx     = ndx + 2
            looking = TRUE.
          DO WHILE looking:  /* looking for R (ROW) VALUE */
            ASSIGN
              chr-val = chr-val + SUBSTRING(in-line,ndx,1)
              ndx     = ndx + 1.
            IF ndx > line-len THEN looking = FALSE.
            IF SUBSTRING(in-line,ndx,1) = ";" THEN looking = FALSE.
          END.
          s-x = INTEGER(chr-val).
        END.
        IF s-y <> 0 THEN curr-r = s-y.
        IF s-x <> 0 THEN curr-c = s-x.

        FIND sylk WHERE sylk.y = curr-r.
        k-data = sylk.x[curr-c].
      END.

    END. /* having S VALUE */
    IF c-y <> 0 THEN curr-row = c-y.
    IF c-x <> 0 THEN curr-col = c-x.
    IF max-col < curr-col THEN max-col = curr-col.
    /* at this point I have the data point and data */

    /* find the sylk record */
    FIND sylk WHERE sylk.y = curr-row NO-ERROR.
    IF NOT AVAILABLE sylk THEN DO:
      CREATE sylk.
      sylk.y = curr-row.
    END.
    sylk.x[curr-col] = k-data.
  END.    /* IF RTD = C */
END.  /* repeat */

FOR EACH sylk:
  DO i = 1 TO max-col:
    PUT STREAM out-stream UNFORMATTED
      (IF sylk.x[i] = "" THEN "-" ELSE sylk.x[i]).
    IF i < max-col THEN PUT STREAM out-stream UNFORMATTED " ".
  END.
  PUT STREAM out-stream UNFORMATTED SKIP.
  DELETE sylk.
END.

INPUT  STREAM in-stream  CLOSE.
OUTPUT STREAM out-stream CLOSE.
HIDE FRAME working NO-PAUSE.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

DEFINE INPUT  PARAMETER name AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER found AS LOGICAL  NO-UNDO.

found = CAN-FIND (DICTDB2._Db WHERE DICTDB2._Db._Db-name = name).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
This program generates a COPY assignment for copying the contents of
one buffer to another.


HISTORY:

tomn        12/05/95    Added spacing to frame "working" to fix 4041 
                        errors on intl windows platforms  
D. McMann   09/08/00    Added owner to find statement     
D. McMann   03/05/03    Excluded LOB fields from being outputted.                    

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE i    AS INTEGER           NO-UNDO.
DEFINE VARIABLE lin  AS CHARACTER         NO-UNDO.
DEFINE VARIABLE mlen AS INTEGER INITIAL 1 NO-UNDO.
DEFINE VARIABLE mstr AS CHARACTER         NO-UNDO.
DEFINE VARIABLE maxlin AS INTEGER INITIAL 0 NO-UNDO.
DEFINE STREAM code.

FORM
  SKIP(1)
  _Field._Field-name LABEL "Working on Field" AT 3
  SKIP(1)
  WITH FRAME working
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D &ENDIF
  TITLE "Generate ASSIGN Statement".
  
COLOR DISPLAY MESSAGES _Field._Field-name WITH FRAME working.

SESSION:IMMEDIATE-DISPLAY = yes.
PAUSE 0.
OUTPUT STREAM code TO VALUE(user_env[1]) NO-ECHO NO-MAP.
PUT STREAM code UNFORMATTED 
 "/* " STRING(TODAY,"99/99/99") " COPY assignment */" SKIP(1)
  "DO:" SKIP.
PUT STREAM code UNFORMATTED SPACE(2) "ASSIGN".

FIND _File WHERE _File._Db-recid = drec_db AND _File._File-name = user_filename
             AND (_File._Owner = "PUB" OR _file._Owner = "_FOREIGN") .

FOR EACH _Field OF _File:
  mlen = MAXIMUM(mlen,LENGTH(_Field._Field-name)
       + (IF _Extent = 0 THEN 0 ELSE 2 + LENGTH(STRING(_Extent)))).
END.
mstr = "x(" + STRING(mlen) + ")".
FOR EACH _Field OF _File WHERE _Field._Data-type <> "BLOB"
                           AND _Field._Data-type <> "CLOB"
                           AND _Field._Data-type <> "XLOB"
                           BY _Field._Order:
  IF TERMINAL <> "" THEN
    DISPLAY _Field._Field-name WITH FRAME working.

  DO i = MINIMUM(1,_Extent) TO _Extent:
    lin = _Field-name
        + (IF _Extent = 0 THEN "" ELSE "["
        + STRING(i,FILL("Z",LENGTH(STRING(_Extent)))) + "]").
    PUT STREAM code UNFORMATTED
      SKIP SPACE(2) "  ~{1~}." STRING(lin,mstr) " = ~{2~}." lin.
    maxlin = maxlin + 1.
    IF maxlin = 20 THEN DO:
      PUT STREAM code UNFORMATTED "." SKIP(1).
      PUT STREAM code UNFORMATTED SPACE(2) "ASSIGN".
      maxlin = 0.
     END.
  END.

END.
PUT STREAM code UNFORMATTED "." SKIP.
PUT STREAM code UNFORMATTED "END.".
OUTPUT STREAM code CLOSE.

HIDE FRAME working NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
MESSAGE "Output Completed" VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* This program generates explicit FRAME definitions from file
definitions in the database.  These frame definitions can then
be customized.

This is especially useful if the default frame for a file won't
fit completely on the screen.  This program allows you to make
a form statement up that matches the default frame, and then you
can remove the fields that are not necessary.

HISTORY:

tomn        12/05/95    Added spacing to frame "working" to fix 4041 
                        errors on intl windows platforms  
                        
mcmann      03/05/03    Excluded LOB fields                       

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE fa   AS LOGICAL           NO-UNDO.
DEFINE VARIABLE fs   AS CHARACTER         NO-UNDO.
DEFINE VARIABLE ft   AS CHARACTER         NO-UNDO.
DEFINE VARIABLE i    AS INTEGER           NO-UNDO.
DEFINE VARIABLE lb   AS CHARACTER         NO-UNDO.
DEFINE VARIABLE lin  AS CHARACTER         NO-UNDO.
DEFINE VARIABLE lp   AS CHARACTER         NO-UNDO.
DEFINE VARIABLE qs   AS LOGICAL           NO-UNDO.
DEFINE STREAM code.

FORM
  SKIP(1)
  _Field._Field-name LABEL "Working on Field" AT 3
  SKIP(1)
  WITH FRAME working 
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D &ENDIF
  TITLE "Generate FORM Statement".
  
COLOR DISPLAY MESSAGES _Field._Field-name WITH FRAME working.

SESSION:IMMEDIATE-DISPLAY = yes.

ASSIGN
    /* user_env[1] */    /* output file name */
    /* user_env[2] */    /* fully quality */
  fa = user_env[3] = "Y" /* expand arrays */
    /* user_env[4] */    /* format */
    /* user_env[5] */    /* validation */
    /* user_env[6] */    /* labeling */
  fs = user_env[7].      /* columns */
  ft = user_env[8].      /* overlay */

FIND _File WHERE _File._Db-recid = drec_db AND _File._File-name = user_filename.

qs = NOT (fs BEGINS "T" OR fs BEGINS "N").
IF fs BEGINS "N" THEN qs = ?.

PAUSE 0.
OUTPUT STREAM code TO VALUE(user_env[1]) NO-ECHO NO-MAP.
PUT STREAM code UNFORMATTED
  "/* " STRING(TODAY,"99/99/99") " FORM LIKE table"
    " " _File._File-name " */" SKIP(1)
  "FORM".

FOR EACH _Field OF _File WHERE _Field._Data-type <> "BLOB"
                           AND _Field._Data-type <> "CLOB"
                           AND _Field._Data-type <> "XLOB"
                           BY _Order:
  IF TERMINAL <> "" THEN
    DISPLAY _Field._Field-name WITH FRAME working.
  lb = "".

  IF user_env[4] = "Y" THEN DO:
    lp = "".
    DO i = 1 TO LENGTH(_Format):
      lp = lp + SUBSTRING(_Format,i,1)
         + (IF SUBSTRING(_Format,i,1) = "~"" THEN "~"" ELSE "").
    END.
    lb = lb + " FORMAT ~"" + lp + "~"".
  END.

  IF user_env[6] BEGINS "E" THEN DO:
    IF ((qs) OR (NOT qs AND _Col-label = ?)) AND _Label <> ? THEN DO:
      lp = "".
      DO i = 1 TO LENGTH(_Label):
        lp = lp + SUBSTRING(_Label,i,1)
           + (IF SUBSTRING(_Label,i,1) = "~"" THEN "~"" ELSE "").
      END.
      lb = lb + " LABEL ~"" + lp + "~"".
    END.
    IF NOT qs AND _Col-label <> ? THEN DO:
      lp = "".
      DO i = 1 TO LENGTH(_Col-label):
        lp = lp + SUBSTRING(_Col-label,i,1)
           + (IF SUBSTRING(_Col-label,i,1) = "~"" THEN "~"" ELSE "").
      END.
      lb = lb + " COLUMN-LABEL ~"" + lp + "~"".
    END.
  END.

  IF user_env[5] BEGINS "E" AND _Field._Valexp <> ? THEN DO:
    lp = "".
    DO i = 1 TO LENGTH(_Field._Valmsg):
      lp = lp + SUBSTRING(_Field._Valmsg,i,1)
         + (IF SUBSTRING(_Field._Valmsg,i,1) = "~"" THEN "~"" ELSE "").
    END.
    lb = lb + " VALIDATE(" + _Field._Valexp + ",~"" + lp + "~")".
  END.

  DO i = 1 TO (IF _Extent > 0 AND fa THEN _Extent ELSE 1):
    lin = "  "
       + (IF user_env[2] = "Y" THEN _File._File-name + "." ELSE "")
       + _Field-name
       + (IF _Extent = 0 THEN "" ELSE "["
           + (IF fa THEN STRING(i) ELSE "1 FOR " + STRING(_Extent))
           + "]")
       + lb.
    DO WHILE ASC(SUBSTRING(lin,LENGTH(lin),1)) = 32:
      lin = SUBSTRING(lin,1,LENGTH(lin) - 1).
    END.
    PUT STREAM code UNFORMATTED SKIP lin.
  END.
END.

PUT STREAM code UNFORMATTED SKIP "  WITH FRAME " + LC(_File._File-name).

IF      ft BEGINS "O" THEN PUT STREAM code UNFORMATTED " OVERLAY".
ELSE IF ft BEGINS "T" THEN PUT STREAM code UNFORMATTED " TOP-ONLY".

IF NOT user_env[5] BEGINS "D" AND NOT user_env[5] BEGINS "E" THEN
  PUT STREAM code UNFORMATTED " NO-VALIDATE".

IF          fs BEGINS "N" THEN PUT STREAM code UNFORMATTED " NO-LABELS".
ELSE IF     fs BEGINS "S" THEN PUT STREAM code UNFORMATTED " SIDE-LABELS".
ELSE IF NOT fs BEGINS "T" THEN PUT STREAM code UNFORMATTED " " fs " COLUMNS".

IF ft BEGINS "D" THEN PUT STREAM code UNFORMATTED " VIEW-AS DIALOG-BOX".

PUT STREAM code UNFORMATTED "." SKIP.
OUTPUT STREAM code CLOSE.

HIDE FRAME working NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
MESSAGE "Output Completed" VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* This program resets all _Order fields in a file to multiples
of <fi>, starting with <fb>.
 
    History:  DMcMann 11/16/98 Added _Owner to for each loop to
                               eliminate SQL92 fields
	      Mario B. 11/17/98 Changed renumbering from using a fixed offset
                                of - 10000 for pre-conversion to using * -1 to
				prevent conflicts when a 10000+ Order# exists.
 */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE fa  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE fb  AS INTEGER   NO-UNDO.
DEFINE VARIABLE fi  AS INTEGER   NO-UNDO.
DEFINE VARIABLE i   AS INTEGER   NO-UNDO.
DEFINE VARIABLE txt AS CHARACTER NO-UNDO.

ASSIGN
  fa = (user_env[1] = "f")   /* field-name or order */
  fb = INTEGER(user_env[2])  /* base */
  fi = INTEGER(user_env[3]). /* increment */

FORM
  txt FORMAT "x(72)"
  WITH FRAME reseqing SCREEN-LINES - 6 DOWN ROW 2 COLUMN 1 NO-LABELS.

DO TRANSACTION:
  FIND _File WHERE _File._Db-recid = drec_db
    AND _File._File-name = user_filename
    AND (_FILE._OWNER = "PUB" OR _FILE._OWNER = "_FOREIGN").
  FOR EACH _Field OF _File:
    _Field._Order = _Field._Order * -1.
  END.
  i = fb.
  IF fa THEN FOR EACH _Field OF _File BY _Field._Field-name:
    txt = "Changing Order of " + _Field._Field-name + " "
        + "from " + STRING(_Field._Order * -1) + " "
        + "to " + STRING(i) + ".".
    DISPLAY txt WITH FRAME reseqing.
    IF FRAME-LINE(reseqing) = FRAME-DOWN(reseqing) THEN DO:
      UP FRAME-DOWN(reseqing) - 1 WITH FRAME reseqing.
      CLEAR FRAME reseqing ALL NO-PAUSE.
    END.
    ELSE
      DOWN WITH FRAME reseqing.
    ASSIGN
      _Field._Order = i
      i = i + fi.
  END.
  ELSE FOR EACH _Field OF _File BY _Field._Order DESCENDING:
    txt = "Changing Order of " + _Field._Field-name + " "
        + "from " + STRING(_Field._Order * -1) + " "
        + "to " + STRING(i) + ".".
    DISPLAY txt WITH FRAME reseqing.
    IF FRAME-LINE(reseqing) = FRAME-DOWN(reseqing) THEN DO:
      UP FRAME-DOWN(reseqing) - 1 WITH FRAME reseqing.
      CLEAR FRAME reseqing ALL NO-PAUSE. 
    END.
    ELSE
      DOWN WITH FRAME reseqing.
    ASSIGN
      _Field._Order = i
      i = i + fi.
  END.
END.

MESSAGE "Field Order resequencing completed." 
   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
HIDE FRAME reseqing NO-PAUSE.

RETURN.
/*********************************************************************
* Copyright (C) 2006-2011 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

_wrktgen.p

This program generates CREATE TABLE statements from DICTDB._File records
stored in the database.  These CREATE TABLE statements can then be
run on another database to define those tables.

  user_env[2] = output file
  user_env[3] = '' or separate output file for 'create index'
  user_env[4] = allow PROGRESS format statements and CASE-SENS modifier
  user_env[5] = statement terminator
  user_env[6] = unique index names
  user_env[7] = support DEFAULT <init value>
  user_env[8] = xlat "-" -> "_", "%" -> "_", Append "_" to reserved words
  user_env[9] = userid
  user_env[10] = Maximun size of Varchar for MS SQL Server 7 
                        or list of other options for ORACLE
  user_env[11..18] = a string of how to convert PROGRESS datatypes to SQL:
         [11] = character -> char, character, vchar, varchar, long char
         [12] = date      -> date, datetime
         [13] = logical   -> logical, bit
         [14] = integer   -> integer, smallint, number
         [15] = decimal   -> decimal, number, real, float, double precision
         [16] = decimal*  -> decimal, integer, number
         [17] = recid     -> recid, rowid
         [18] = char**    -> long, character, long varchar
         [19] = logical** -> logical, tinyint
              (decimal* is decimal with _Decimals=0)
              (char** is character longer than 240)
              (logical** is logical fields which are key components)
  user_env[20] = character to use for unique name creation
  user_env[21] = Add shadow column for case-insensitive key fields
  user_env[22] = external dbtype ("ORACLE"...)
  user_env[23] = Min width for character fields.
  user_env[24] = Min width for numeric fields.
  user_env[25] = comma-separated list:
                 [1] = create sequences
                 [2] = new sequence generator (for MSS)
                 [3] = use newer datetime types (for MSS).
  user_env[26] = foreign database login name.
  user_env[27] = comma-separated list of values
                    entry 1: compatible or not ("" is yes)
                    entry 2: "dbe"|"singel-byte"
                 (old users supply only the first entry!)
                    entry 2: ""1"|"2" (for DB2/400 only)
		             1- All tables
			     2- Tables without unique key /* OE00177721 */
                    entry 2: ""1"|"2" (for MSS-DS only)
		             1- trigger /* default */
			     2- Computed Columns/* OE00186593 */
  user_env[28] = maximum number of characters for index names,
                 undefined indicates no limit.
  user_env[29] = maximum length of identifiers.
  user_env[30] = write exit at end of SQL.
  user_env[32] = Underlying DBMS Type
  user_env[31] = string to comment out a line of SQL. 
  user_env[33] = Field width... 
                   Values:
                      "y" = Use SQL WIDTH
                      "n" = Use VARCHAR(30) for "x(8)" fields
                      "?" = Use field format
  user_env[34] = name of tablespace for tables for Oracle only. Or DB2 db type.
  user_env[35] = name of tablespace for indexes for Oracle only. For MSS, whether to expand
                 the field width (for Unicode).
*/
/*
HISTORY:

    hutegger 06/01/12   ORACLE defines length of a character in bytes,
                        so in case of dbe we need to double the 
                        calculated default.
                        Added this info as entry two to user_env[27]
    tomn     12/05/95   Added spacing to frame "working" to fix 4041 
                        errors on intl windows platforms  
    radams   94/09/09   Add support for more batch mode logging.
                        Cleanup error messages and information message 
                        logging.
                        Add support for commenting out SQL that isn't
                        valid.
                        Add column count calculation to avoid SQL errors.
                        Add check for descending index components for 
                        Sybase 10.
    fladung  94/07/22   add support for ALLBASE DataServer
    radams   94/07/22   if user_env[27] "compatable" is "" then assume yes
    radams   94/07/19   if user_env[27] "compatable" is ?  then assume yes
    gfs      94/07/13   94-07-07-066 & 94-07-13-034
    radams   94/06/03   add support for a maximum identifier length.
    radams   94/06/01   add support for producing non-compatible sql.
    radams   94/05/10   add sybase 10 functionality 
    hutegger 94/05/06   after discussing with Marceau I made the following
                        changes:
                        + oracle7 longchar gets identified by
                                user_env[18] = "VARCHAR2"
                        + topic             PROGRESS  ORACLE  SYBASE
                          DROP TABLE            no      yes     yes
                          progress_recid        no      yes     yes
                          ditto - index         no      yes     yes
                          ditto for uniqueness  no      yes     yes
Note: I did not use the dictgate.i functionality because this file has
to be worked on anytime we add another DataServer anyhow. I rather
enumerate all DataServers that allow things than use <> "PROGRESS" to
prevent future-bugs resulting out of default behaviour <hutegger>

    mcmann  97/11/12  Removed references to all DataServers except ODBC and ORACLE.
    mcmann  97/12/18  Added validation for more than one long, changed size of long and
                      changed how length of format was calculated.  Also eliminated
                      creation of file if zero fields were defined in PROGRESS.
    mcmann  98/01/13  Added check for oracle version for proper assignment of
                      longs.
    mcmann  98/04/02   98-03-26-025 problem with defaults and duplicate names
    mcmann  98/05/11   98-05-05-055 Seq-name was not being set properly.
    mcmann  98/05/18   Changed how the default value for logical's are determined
    mcmann  98/06/12   Added initialization of nbrchar for character data type 98-06-09-012
    mcmann  98/07/06   Added user_env[32] for ODBC underlying DBMS and added code
                       to handle multiple data sources for ODBC.
    mcmann  98/09/03   Removed drop statement from script.
    mcmann  98/09/15   Changed how unique index for recid is created using
                       prowid_col.
    mcmann  98/10/29   Change how the length of a character field is calcaluated when checking
                       for long fields.
    mcmann  99/01/14   99-01-13-022 Changed Oralce PROGRESS_RECID index name
    mcmann  99/01/26   Added check for _decimals = ? for data type decimals
    mcmann  99/03/09   Added logic to put all field names into verify-name file.
    mcmann  99/03/10   Changed trigger for MS SQL Server and split out Sybase
    mcmann  99/03/25   Removed use <db-name> syntax from Sybase and MS SQL Server
    mcmann  99/08/31   Added logic to verify table and index names
    mcmann  99/09/01   Added logic to change a sequence name if it ends in _seq.
    mcmann  99/09/03   Added check for RAW datatype so not too many longs
                       could be created.
    mcmann  99/09/07   Changed PROGRESS_RECID to be the name for all ODBC Db's.
    mcmann  99/09/28   Added "_" to Ident for name for seperation of words.
    mcmann  99/12/02   Added DESC in indexes for Oracle 19991102005
    mcmann  99/12/15   Added check for truncated index field name 19991215003
    mcmann  99/12/30   Added check for length of sequence name 19991230038
    mcmann  00/01/18   Added _foreign for owner 20000111011
                       check for length of extent names and
                       number of long columns 
    mcmann  00/02/01   Added use of _Width and size of field.
    mcmann  00/02/17   Added support for Current Value Support for ODBC
    mcmann  00/03/21   Removed block for ODBC on number of long columns. 
    mcmann  00/03/22   Added support for MS SQL Server 7
    mcmann  00/04/25   put back syntax remvoed for MSSQLServer 7 for 6.5 and
                       Sybase
    mcmann  00/05/11   Quoted PROGRESS 20000502007
    mcmann  05/24/00   Added support for LONG RAW for Oracle.
    mcmann  07/17/00   Changed calculation of sqlwidth for extent fields.
    mcmann  09/12/00   Added increament to non-cycling seq for initial value
                       20000821013
    mcmann  12/05/00   Recognized MS SQL Server 7 and Oracle limitation of decimal size for using _Width.
    mcmann  02/09/01   syslogins column suid has been removed for ms sql server 7 changed to sid                       
    mcmann  04/09.01   Removed the "use dbname" from script for Sybase and SQL Server 6.5
    mcmann  11/13/01   Added DEFAULT values for all data types except RECID and RAW. 20011127-002
                       20011026-013, 20011108-022
    mcmann  05/28/02   Logic error on date defaults if not equal to today it will be blanked out.
    mcmann  06/11/02   Added comment_chars to Tablespace logic 20020611-021
    mcmann  06/25/02   Support for UPPER function indexes
    mcmann  08/08/02   Changed max number of possible sequences to 2000 20020731-003
    mcmann  08/08/02   Eliminated any sequences whose name begins "$" - Peer Direct
    mcmann  10/01/02   Eliminated SQL tables from being processed.
    mcmann  01/16/03   Added logic to check start with value to initial 20030116-015
    mcmann  02/17/03   Added support for BLOB for Oracle
    mcmann  07/31/03   Added blocking of unsupported Progress Data Types.
    mcmann  10/23/03   Changed routine for generating unique names to match Delta
                       SQL routine 20031023-018
  kmcintos  04/13/04   Added support for DB2/400 Libraries.  Prepending library names 
                       to CREATE (TABLE & INDEX) statements
  
  kmcintos 02/15/05   Added "DB2" to case statement.  Fixed bug # 20050214-020.
  kmcintos 02/28/05   Added cases for user_env[33] (Field width/x8override)
  fernando 01/04/06   Handle decimals for DB2/400 20051214-009
  fernando 06/26/06   Added support for int64
  fernando 06/11/07   Unicode and clob support for ORACLE
  fernando 02/14/08   Support for datetime for MSS
  fernando 04/07/08   Support for datetime for ORACLE
  fernando 04/11/08   Support for new sequence generator for MSS.
  rkumar   05/15/08   Support for new sequence generator for MSS DataServers
  rkumar   06/09/08   Fixed bug OE00169473/75 related to new sequence generator for MSS DataServers
  fernando 08/25/08   Start cyclic sequence with current value - ORACLE - OE00167056
  fernando 08/25/08   Fix logic for extent and sql-width - OE00172253
If working with an Oracle Database and the user wants to have a DEFAULT value of blank for VARCHAR2 fields, an environment variable BLANKDEFAULT can be set to "YES" and the code will put the DEFAULT ' ' syntax on the definition. D. McMann 11/27/02    
  knavneet 09/28/08   Added error handling code to the sequence generator - OE00172741
  rkumar   12/10/08   DROP TABLE SQL for MSS DataServers  OE00177726 
  rkumar   01/07/09   Added default values for ODBC DataServer- OE00177724
  rkumar   03/30/09   Fixed issue with error-handling code using new seq generator- OE00182302
  rkumar   03/30/09   DROP TABLE SQL for ODBC DataServers  OE00182649
  fernando 04/03/09   Support for DATETIME-TZ (and other date time types) for MSS
  knavneet 04/28/09   Support for BLOB for MSS (OE00178319)
  rkumar   05/05/09   Added RECID support for ODBC DataServer- OE00177721
  nmanchal 07/15/09   Trigger changes for MSS(OE00178470)
  nmanchal 07/20/09   Trigger changes for MSS(OE00178470) to remove 'WITH NOWAIT'
  nmanchal 07/30/09   To fix MSS unicode migration issues for trigger creation (OE00188693)
  rkumar   08/25/09   Fix RECID implementation issues (OE00189366)
  Nagaraju 09/22/09   Implement Computed column solution for MSS DS (OE00189563)
  fernando 02/11/10   Fix issue with sql generated for old sequence generator
  sgarg    06/03/10   Support for CLOB for MSS (OE00193877)
  kmayur   06/21/11   Support for migration of constraint - OE00195067
  sgarg    12/05/13   Default INITIAL value for character field w/ env. variable (OE00241307)
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
/* 195067 */
DEFINE VARIABLE AllConsFields      AS CHARACTER   NO-UNDO.
DEFINE VARIABLE ClustCons          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE AllForeignFields   AS CHARACTER   NO-UNDO.
DEFINE VARIABLE ConType            AS CHARACTER   NO-UNDO.
DEFINE VARIABLE ConName            AS CHARACTER   NO-UNDO.
DEFINE VARIABLE dfltconname        AS CHARACTER   NO-UNDO.
DEFINE VARIABLE AllCons            AS CHARACTER   NO-UNDO.
DEFINE VARIABLE DefCons            AS CHARACTER   NO-UNDO.
DEFINE VARIABLE CheckField         AS CHARACTER   NO-UNDO.
DEFINE VARIABLE uncons             AS CHARACTER   NO-UNDO.
DEFINE VARIABLE uniconname         AS CHARACTER   NO-UNDO.
DEFINE VARIABLE defaultfld         AS CHARACTER   NO-UNDO.
DEFINE VARIABLE uniqueindx         AS CHARACTER   NO-UNDO.
DEFINE VARIABLE DefC               AS CHARACTER   NO-UNDO.
DEFINE VARIABLE part_of_primary    AS LOGICAL     NO-UNDO.
DEFINE VARIABLE max_con_length     AS INTEGER     NO-UNDO.
DEFINE VARIABLE cnstrpt_name       AS CHARACTER   NO-UNDO.
DEFINE BUFFER   buff-file for DICTDB._FILE.
DEFINE BUFFER   buff-Index for DICTDB._INDEX.
DEFINE STREAM   constlog.
DEFINE VARIABLE migConstraint       AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mvdata              AS LOGICAL    NO-UNDO.

DEFINE VARIABLE FieldList           AS CHARACTER  NO-UNDO.
DEFINE VARIABLE userPKexist         AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE msstryp             AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mssrecidCompat      AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mssselBestRowidIdx  AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE msschoiceSchema     AS INTEGER    NO-UNDO.
DEFINE VARIABLE mssOptRowid         AS CHARACTER  NO-UNDO INITIAL "".
DEFINE VARIABLE mandatory           AS LOGICAL    NO-UNDO INITIAL TRUE. 
DEFINE VARIABLE pk_unique           AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE idxrecidcompat      AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE NonUnikCC           AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE CcExist             AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE CcCreated           AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE uniqCompat          AS LOGICAL    NO-UNDO INITIAL TRUE. 
DEFINE VARIABLE uniqfyIdx           AS LOGICAL    NO-UNDO INITIAL TRUE. 
DEFINE VARIABLE keyCreated          AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE PKCreated           AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE uniqueness          AS CHARACTER  NO-UNDO INITIAL "".
DEFINE VARIABLE keyExist            AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE useNewRanking       AS LOGICAL    NO-UNDO INITIAL TRUE.

DEFINE VARIABLE n3                  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE n4                  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE n5                  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE ora_lang            AS CHARACTER  NO-UNDO.
DEFINE VARIABLE ora_lang1           AS CHARACTER  NO-UNDO.
DEFINE VARIABLE nls_upp             AS CHARACTER  NO-UNDO.
DEFINE VARIABLE nlsflag             AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE flag                AS LOGICAL    NO-UNDO INITIAL FALSE.

/* 195067 end. */

DEFINE VARIABLE a                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE c                   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE e                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE f                   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE i                   AS INT64      NO-UNDO.
DEFINE VARIABLE j                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE k                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE ri                  AS INTEGER    NO-UNDO.
DEFINE VARIABLE n1                  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE n2                  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE pfmt                AS LOGICAL    NO-UNDO.
DEFINE VARIABLE sdef                AS LOGICAL    NO-UNDO.
DEFINE VARIABLE xlat                AS LOGICAL    NO-UNDO.
DEFINE VARIABLE skptrm              AS LOGICAL    NO-UNDO. /* skip line before user_env[5] */
DEFINE VARIABLE shadow              AS LOGICAL    NO-UNDO. /* Evil twin (uppercase) columns */
DEFINE VARIABLE prowid_col          AS CHARACTER  NO-UNDO.
DEFINE VARIABLE doseq               AS LOGICAL    NO-UNDO. /* create sequences (oracle) */
DEFINE VARIABLE have_u              AS LOGICAL    NO-UNDO.
DEFINE VARIABLE compatible          AS LOGICAL    NO-UNDO. 
DEFINE VARIABLE batch_mode          AS LOGICAL    NO-UNDO. 

DEFINE VARIABLE column_count        AS INTEGER    NO-UNDO. 
DEFINE VARIABLE col_long_count      AS INTEGER    NO-UNDO.
DEFINE VARIABLE dbe-factor          AS INTEGER    NO-UNDO.
DEFINE VARIABLE longwid             AS INTEGER    NO-UNDO INITIAL 240.
DEFINE VARIABLE minwdth             AS INTEGER    NO-UNDO.
DEFINE VARIABLE mindgts             AS INTEGER    NO-UNDO.
DEFINE VARIABLE unik                AS CHARACTER  NO-UNDO.
DEFINE VARIABLE dbtyp               AS CHARACTER  NO-UNDO.
DEFINE VARIABLE db2type             AS CHARACTER  NO-UNDO.
DEFINE VARIABLE idbtyp              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE afldn               AS CHARACTER  NO-UNDO.
DEFINE VARIABLE pindex              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE pindex2             AS CHARACTER  NO-UNDO.
DEFINE VARIABLE pclst_name          AS CHARACTER  NO-UNDO.
DEFINE VARIABLE uc_col              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE uc_tmp              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE max_idx_len         AS INTEGER    NO-UNDO.
DEFINE VARIABLE max_id_length       AS INTEGER    NO-UNDO.
DEFINE VARIABLE max_ext_length      AS INTEGER    NO-UNDO.
DEFINE VARIABLE comment_chars       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE comment_all_objects AS LOGICAL    NO-UNDO.
DEFINE VARIABLE sqlwidth            AS LOGICAL    NO-UNDO.
DEFINE VARIABLE maxidxcollen        AS INTEGER    NO-UNDO.
DEFINE VARIABLE blankdefault        AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE useoedflt           AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE tmp_str             AS CHARACTER  NO-UNDO.

DEFINE VARIABLE tmpfile             AS CHARACTER  NO-UNDO.

DEFINE VARIABLE l_seq-num           AS INTEGER    NO-UNDO.
DEFINE VARIABLE start               AS INT64      NO-UNDO.
DEFINE VARIABLE limit               AS CHARACTER  NO-UNDO.
DEFINE VARIABLE logfile_name        AS CHARACTER  NO-UNDO. 
DEFINE VARIABLE codefile_name       AS CHARACTER  NO-UNDO.
DEFINE VARIABLE warnings_issued     AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE tables_not_created  AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE index_checking      AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE shadow_is_valid     AS LOGICAL    NO-UNDO. 
DEFINE VARIABLE trunc_name          AS LOGICAL    NO-UNDO.

DEFINE VARIABLE left_paren          AS INTEGER    NO-UNDO.
DEFINE VARIABLE right_paren         AS INTEGER    NO-UNDO.
DEFINE VARIABLE lngth               AS INTEGER    NO-UNDO.
DEFINE VARIABLE wdth                AS INTEGER    NO-UNDO.
DEFINE VARIABLE z                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE nbrchar             AS INTEGER    NO-UNDO.
DEFINE VARIABLE slash               AS INTEGER    NO-UNDO.
DEFINE VARIABLE unsprtdt            AS LOGICAL    NO-UNDO.
DEFINE VARIABLE dot                 AS CHARACTER  NO-UNDO.
DEFINE VARIABLE cTmpFmt             AS CHARACTER  NO-UNDO.
DEFINE VARIABLE large_seq           AS LOGICAL    NO-UNDO.
DEFINE VARIABLE lUniExpand          AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE lnewSeq             AS LOGICAL    NO-UNDO.
DEFINE VARIABLE seqt_prefix         AS CHARACTER  NO-UNDO INITIAL "_SEQT_".
DEFINE VARIABLE seqp_prefix         AS CHARACTER  NO-UNDO INITIAL "_SEQP_".
DEFINE VARIABLE other-seq-tab       AS CHARACTER  NO-UNDO. /* OE00170189 */
DEFINE VARIABLE other-seq-proc      AS CHARACTER  NO-UNDO. /* OE00170189 */
DEFINE VARIABLE mssNewDTTypes       AS LOGICAL    NO-UNDO.
DEFINE VARIABLE unique_idx_flag     AS LOGICAL    NO-UNDO INITIAL FALSE. /* OE00177721 */

DEFINE NEW SHARED VARIABLE crnt-vals AS INT64 EXTENT 2000 init 0 NO-UNDO.

DEFINE TEMP-TABLE verify-name NO-UNDO
  FIELD new-name LIKE _Field._Field-name
  FIELD prog-name LIKE _Field._Field-name
  FIELD rec-fld  AS   RECID 
  INDEX trun-name IS UNIQUE new-name
  INDEX prog-name IS UNIQUE prog-name.
  
DEFINE TEMP-TABLE verify-field NO-UNDO
  FIELD new-name LIKE _Field._Field-name
  FIELD prog-name LIKE _Field._Field-name
  FIELD rec-fld  AS   RECID 
  INDEX rec-fd IS UNIQUE rec-fld.
        
DEFINE TEMP-TABLE verify-table NO-UNDO
  FIELD new-name LIKE _File._File-name
  FIELD rec-fld  AS   RECID 
  FIELD has-unsprtdt AS CHARACTER 
  INDEX trun-name IS UNIQUE new-name
  INDEX rec_tab   IS UNIQUE rec-fld.
  
DEFINE TEMP-TABLE verify-index NO-UNDO
  FIELD new-name LIKE _index._index-name
  INDEX trun-name IS UNIQUE new-name.  
                
DEFINE STREAM code.           /* file containing SQL for foreign database */
DEFINE STREAM tmpstream.   /* */

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

FORM
  SKIP(1)
  DICTDB._File._File-name LABEL "Working on Table" FORMAT "x(32)" AT 3
  SKIP(1)
  WITH FRAME working 
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D TITLE "Dump CREATE TABLE Statement" &ENDIF.

/* If user_library has been specified, then this is for DB2/400 and we
   need to define a dot(.) in order to prepend the library name to the
   TABLE/INDEX name */
ASSIGN user_library = (IF user_library EQ ? THEN "" ELSE user_library)
       dot          = (IF user_library NE "" THEN "." ELSE "").

IF NOT batch_mode THEN 
  COLOR DISPLAY MESSAGES DICTDB._File._File-name WITH FRAME working.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

SESSION:IMMEDIATE-DISPLAY = yes.

IF OS-GETENV("BLANKDEFAULT")   <> ? THEN
  tmp_str   = OS-GETENV("BLANKDEFAULT").
IF tmp_str BEGINS "Y" THEN
  ASSIGN blankdefault = TRUE.

IF OS-GETENV("_USE_OE_CHAR_DFLT_INIT")   <> ? THEN
  tmp_str   = OS-GETENV("_USE_OE_CHAR_DFLT_INIT").
IF tmp_str BEGINS "Y" THEN
  ASSIGN useoedflt = TRUE.

ASSIGN
  pfmt   = (user_env[4]  BEGINS "y") /* progress-format */
  sdef   = (user_env[7]  BEGINS "y") /* default <init value> */
  xlat   = (user_env[8]  BEGINS "y") /* xlat "-" -> "_", "%" -> "_", reswrds */
  shadow = (user_env[21] BEGINS "y") /* Create shadow columns for case-insens key fields */
  doseq  = (user_env[22] = "ORACLE" and user_env[25] BEGINS "y") OR
           (user_env[32] <> ?   and user_env[25] BEGINS "y")
  doseq  = doseq and user_env[1] = "ALL".
  defaultfld = user_env[39].   /* default as fld attr  */
  uniqueindx = user_env[38].
  migConstraint = (ENTRY(1,user_env[36]) = "y").
  mvdata        = (ENTRY(5,user_env[36]) = "y").
  nls_upp = user_env[40].
  ora_lang1 = user_env[41].
  ora_lang = UPPER(ora_lang1).
  
IF user_env[33] = "y" THEN
  sqlwidth = TRUE. /* Use _Width field for size */
ELSE IF user_env[33] = "?" THEN
  sqlwidth = ?. /* Use _Format field for size */
ELSE sqlwidth = FALSE. /* Calculate size */

IF user_env[30] = ? OR user_env[30] = "" 
 THEN ASSIGN user_env[30] = "y".

/* parse user_env[27]:
 * entry 1: ""|"y*" -> create recid fields/indexes and shadow-columns
 *                  <> create non-compatible foreign MetaSchema
 * entry 2:
 */
if  user_env[27] = ?  OR user_env[27] = ""
 THEN ASSIGN compatible = true
             dbe-factor = 1.
else if num-entries(user_env[27]) > 1
 then assign  /* more than one value in user_env[27] */
  compatible = ( entry(1,user_env[27]) BEGINS "y"
              or entry(1,user_env[27]) = ""
               ) 
  shadow     = shadow and compatible
  dbe-factor = ( if entry(1,user_env[27]) = "dbe"
                    then 2
                    else 1
               ).
 else assign
  compatible = (user_env[27] BEGINS "y") /* create recid fields/indexes */
  dbe-factor = 1.

batch_mode = SESSION:BATCH-MODE.

IF user_env[20] = ""   THEN unik = "##".
ELSE unik = SUBSTR( user_env[20], 1, 1) + SUBSTR( user_env[20], 1, 1).

assign  minwdth = INTEGER (user_env[23])
        mindgts = INTEGER (user_env[24])
        idbtyp = { adecomm/ds_type.i 
                  &direction = "ETOI"
                  &from-type = "user_env[22]"
                  }.

/* protoodbc assign the foreign data source type in user_env[32] and has
   the generic ODBC type in [22]
*/   
IF user_env[22] = "ODBC" OR user_env[22] = "MSS" THEN DO:
  ASSIGN dbtyp = user_env[32].

  /* 20051214-009 DB2 type is in user_env[34] */
  IF user_env[22] = "ODBC" THEN
     assign db2type = user_env[34].
  ELSE DO:     
     /* MSS db type */
     RUN setMSSOptions.
  END.
END.
ELSE
  ASSIGN dbtyp = user_env[22]
         db2type = ?.

CASE dbtyp:
  WHEN "ORACLE" THEN DO:
    prowid_col = "progress_recid".

    IF user_env[18] = "VARCHAR2" OR user_env[18] = "NVARCHAR2" THEN DO:
        /* the max size for char columns is the first entry stored in user_env[10],  */
       ASSIGN longwid = integer(entry(1,user_env[10])).

       /* if the second entry is yes, user wants char fields to expand to CLOB and not LONG */
       IF LOGICAL(ENTRY(2,user_env[10])) THEN
          ASSIGN user_env[18] = "clob".
       ELSE /* if using Unicode data types, expand column to NCLOB */
          ASSIGN user_env[18] = (IF user_env[18] = "NVARCHAR2" THEN "nclob" ELSE "long").
    END.
    ELSE
       ASSIGN longwid = 2000
              user_env[18] = "long".
  END. 
  WHEN "Informix" THEN
    ASSIGN longwid = 2000
           prowid_col = "PROGRESS_RECID".
           
  WHEN "DB2/400" OR WHEN "DB2(Other)" OR WHEN "DB2" THEN
    ASSIGN longwid = 4000
           prowid_col = "PROGRESS_RECID".
                 
  WHEN "MS SQL Server" THEN 
    ASSIGN longwid = 255
           prowid_col = "PROGRESS_RECID". 
  
 WHEN "MSSQLSRV7" THEN 
    ASSIGN longwid = integer(user_env[10])
           prowid_col = "PROGRESS_RECID"
           shadow     = (user_env[21] BEGINS "y").

  WHEN "SYBASE"  THEN 
    ASSIGN longwid = 255
           prowid_col = "PROGRESS_RECID".
           
  WHEN "MS Access" OR WHEN "Other" THEN 
    ASSIGN longwid = 255
           prowid_col = "PROGRESS_RECID".
  
END CASE.

/* Check for a max idx name length, if undefed, assume none */

IF user_env[28] <> ? THEN
  max_idx_len = INTEGER(user_env[28]).
ELSE
  max_idx_len = 0.  /* Since a max length of 0 is silly, this implies no max */

IF user_env[28] <> ? THEN
  max_con_length = INTEGER(user_env[28]).
ELSE
  max_con_length = 0. 
  
IF user_env[29] <> ? THEN 
  max_id_length = INTEGER(user_env[29]).
ELSE
  max_id_length = 0. 

IF ((NUM-ENTRIES(user_env[42]) >= 2) AND
     UPPER(ENTRY(2,user_env[42])) = "L" ) THEN
   assign useNewRanking = FALSE.

PAUSE 0.
IF user_env[3] <> "" THEN DO:
  /* This clears the file if it existed already */
  OUTPUT STREAM code TO VALUE(user_env[3]) NO-ECHO NO-MAP.
  OUTPUT STREAM code CLOSE.
END.

IF INDEX(user_env[2],".", 1) > 0 THEN
     ASSIGN logfile_name  = SUBSTRING(user_env[2],1,INDEX(user_env[2],".", 1) - 1) + ".log"
            codefile_name = user_env[2].
ELSE ASSIGN logfile_name  = user_env[2] + ".log"
            codefile_name = user_env[2] + ".sql".

/* 195067 */
  IF (dbtyp = "MSSQLSRV7" OR dbtyp = "ORACLE")
  THEN DO:
    ASSIGN cnstrpt_name = "constraint.lg".
    OUTPUT STREAM constlog TO VALUE(cnstrpt_name) UNBUFFERED APPEND NO-ECHO NO-MAP.
  END.
OUTPUT STREAM code    TO VALUE(codefile_name) NO-ECHO NO-MAP.

/* 
 * Open the logfile if we haven't got an open one already.
 */
IF NOT logfile_open THEN 
    OUTPUT STREAM logfile to VALUE(logfile_name)  UNBUFFERED APPEND NO-ECHO NO-MAP.

IF dbtyp = "SYBASE" OR dbtyp = "MS SQL Server"  OR dbtyp = "MSSQLSRV7" THEN 
  skptrm = TRUE.
ELSE
  skptrm = FALSE.

IF dbtyp = "ORACLE" THEN DO:
    /* this defines if the user wants character semantics */
    IF LOGICAL(entry(3,user_env[10])) THEN
        PUT STREAM code UNFORMATTED "ALTER SESSION SET NLS_LENGTH_SEMANTICS='CHAR';" SKIP.
END.

_fileloop:
FOR EACH DICTDB._File  WHERE DICTDB._File._Db-recid = drec_db
                         AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                         AND (IF user_env[1] = "ALL"  THEN 
                              NOT DICTDB._File._Hidden AND 
                             (CAN-DO(_File._Can-read, user_env[9]) OR user_env[9] = "ALL")
                               ELSE
                                  DICTDB._File._File-name = user_filename
                              ):
  
  ASSIGN unique_idx_flag = FALSE. /* OE00177721 */
  IF DICTDB._File._Db-lang > 0 THEN NEXT _fileloop.

  /* If Progress database, clear index names */
  IF dbtyp = "PROGRESS"  THEN DO:
      FOR EACH verify-index:
          DELETE verify-index.
      END.
  END.
                              
  IF TERMINAL <> "" or NOT batch_mode THEN
    DISPLAY DICTDB._File._File-name WITH FRAME working.
  ELSE IF batch_mode THEN DO:
      PUT STREAM logfile UNFORMATTED 
          "Table " at 10 DICTDB._File._File-name at 25 skip. 
  END. 
  
  ASSIGN comment_chars = ""
         comment_all_objects = FALSE
         unsprtdt = FALSE.

  /* Count the number of columns that will be in the table. 
   * This should be used to see if we are exceeding any limits 
   * of individual data managers. 
   
   * Verify that no unsupport datatypes are present
 */
   
  ASSIGN column_count = 0
         col_long_count = 0.

  for each DICTDB._Field where DICTDB._Field._file-recid = recid(DICTDB._file):
 
    /*  If this isn't an array then only add one. If it is an array add one 
     * for each column we'll create. */
      
    if DICTDB._Field._Extent = 0 then
        column_count = column_count + 1. 
    else 
        column_count = column_count + DICTDB._Field._Extent.

    /*  add the shadow columns if appropriate*/
    
    if can-find(DICTDB._Index-field where DICTDB._Index-field._Field-recid = recid(DICTDB._Field))
        AND shadow then
         ASSIGN column_count = column_count + 1. 
         
    /* check for long data types which will be a format greater than maximum char length (longwid) */    
    IF DICTDB._Field._Dtype = 1 THEN DO:
      IF sqlwidth THEN DO:
        IF DICTDB._Field._Extent = 0 THEN 
          ASSIGN z = DICTDB._Field._Width.
        ELSE DO:
          ASSIGN wdth = (IF DICTDB._Field._fld-res1[3] EQ ? OR DICTDB._Field._Fld-Misc3[1] EQ ?
                            THEN DICTDB._Field._Width 
                            ELSE MAXIMUM(DICTDB._Field._Fld-Misc3[1],DICTDB._Field._fld-res1[3])).
          ASSIGN z = (( wdth - (DICTDB._Field._Extent * 2)) / DICTDB._Field._Extent).
          /* OE00172253 - check if value is negative, then assign it the width value unless it's too
             big, in which case we assign the max value allowed for this type.
          */
          IF z <= 0 THEN DO:
              z = DICTDB._Field._Width.
              IF z > longwid THEN
                  z = longwid.
          END.
        END.
      END.
      ELSE DO:       
        ASSIGN lngth = LENGTH(DICTDB._Field._format, "character")
               z = 0.
           
        IF INDEX(DICTDB._Field._Format, "(") > 1 THEN DO:
           left_paren = INDEX(DICTDB._Field._Format, "(").
           right_paren = INDEX(DICTDB._Field._Format, ")").
           lngth = right_paren - (left_paren + 1).
           assign z = INTEGER(SUBSTRING(DICTDB._Field._Format, left_paren + 1, lngth)).  
        END. 
        ELSE DO:         
          DO j = 1 to lngth:        
            IF SUBSTRING(DICTDB._Field._Format,j,1) = "9" OR
               SUBSTRING(DICTDB._Field._Format,j,1) = "N" OR   
               SUBSTRING(DICTDB._Field._Format,j,1) = "A" OR    
               SUBSTRING(DICTDB._Field._Format,j,1) = "x" OR
               SUBSTRING(DICTDB._Field._Format,j,1) = "!"   THEN
                 ASSIGN z = z + 1.
          END.      
        END.   
        IF z = 0 THEN                    
           ASSIGN z = lngth.    
      END.
      
      IF lUniExpand THEN
          z = z * 2.

      /* if not ORACLE, or if expanding to long column, then increment long count */
      /* user_env[18] may be a clob type, in which case it's ok to have more than one column on a given table */
      IF dbtyp <>  "ORACLE" OR user_env[18] EQ "long" THEN DO:
        IF z > longwid THEN 
            ASSIGN col_long_count = col_long_count + 1.
        END.
        ELSE IF DICTDB._Field._Dtype = 8 THEN
             ASSIGN col_long_count = col_long_count + 1.
    END.
    
    IF dbtyp <> "PROGRESS" AND DICTDB._Field._Dtype NE 41 /*int64*/ THEN DO:
      IF (dbtyp = "MSSQLSRV7" OR dbtyp = "ORACLE") 
          AND DICTDB._Field._Dtype EQ 34 /*datetime*/ THEN 
          /*ok*/ .
      ELSE IF (dbtyp = "ORACLE" OR (dbtyp = "MSSQLSRV7" AND mssNewDTTypes)) AND 
               DICTDB._Field._Dtype EQ 40 /*datetime-tz*/ THEN 
          /*ok*/ .
      ELSE IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Dtype EQ 18 /*BLOB*/ THEN
          /*ok*/ .
      ELSE IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Dtype EQ 19 /*CLOB*/ THEN
          /*ok*/ .
      ELSE IF dbtyp <>  "ORACLE" AND DICTDB._Field._Dtype > 17 THEN
        ASSIGN unsprtdt = TRUE.
      ELSE IF dbtyp = "ORACLE" AND DICTDB._Field._Dtype > 19 THEN     
        ASSIGN unsprtdt = TRUE.
    END.
  end.   

  IF dbtyp <> "PROGRESS" AND column_count = 0 THEN DO:
    PUT STREAM logfile UNFORMATTED
          "WARNING: TABLE " DICTDB._File._File-name " will not be created." skip
          " " skip
          "         Table has " column_count " columns." skip
          " " skip.  
    warnings_issued = true. 
  END. /* empty tables check */
  
  IF dbtyp = "ORACLE"  AND col_long_count > 1 THEN DO:
    PUT STREAM logfile UNFORMATTED
          "WARNING: TABLE " DICTDB._File._File-name " will not be created." skip
          " " skip
          "         Table has " col_long_count " long columns." skip
          " " skip.  
    ASSIGN warnings_issued = true
           tables_not_created = true
           comment_chars = user_env[31]
           comment_all_objects = TRUE.

  END. 
  
  IF (dbtyp = "SYBASE" OR dbtyp = "MS SQL Server" ) AND column_count > 250 THEN DO:
    PUT STREAM logfile UNFORMATTED
        "WARNING: TABLE " DICTDB._File._File-name " will not be created." skip
        " " skip
        "         Table has " column_count " columns including shadow " skip
        "         columns and arrays. SQL Server only supports 250." skip
        " " skip.  
    ASSIGN comment_chars = user_env[31]
           comment_all_objects = true
           warnings_issued = true.            
  END. /* sybase & SQL Server 6.5 check */

  IF dbtyp = "MSSQLSRV7"  AND column_count > 1024 THEN DO:
    PUT STREAM logfile UNFORMATTED
        "WARNING: TABLE " DICTDB._File._File-name " will not be created." skip
        " " skip
        "         Table has " column_count " columns including shadow " skip
        "         columns and arrays. MS SQL Server 7 only supports 1024." skip
        " " skip.  
    ASSIGN comment_chars = user_env[31]
           comment_all_objects = true
           tables_not_created = true
           warnings_issued = true.            
  END. /* MS SQL Server 7 check */

  IF (dbtyp = "DB2" ) AND column_count > 500 THEN DO:
    PUT STREAM logfile UNFORMATTED
        "WARNING: TABLE " DICTDB._File._File-name " will not be created." skip
        " " skip
        "         Table has " column_count " columns including shadow " skip
        "         columns and arrays. DB2 only supports 500." skip
        " " skip.  
    ASSIGN comment_chars = user_env[31]
           comment_all_objects = true
           tables_not_created = true
           warnings_issued = true.        
  END. /* DB2 check */
  IF unsprtdt THEN DO:
    PUT STREAM logfile UNFORMATTED
        "WARNING: TABLE " DICTDB._File._File-name " will not be created." skip
        " " skip
        "         Table contains unsupported Progress data types " SKIP
        "         and cannot be created. " SKIP
        " " skip.  

    ASSIGN comment_chars = user_env[31]
           comment_all_objects = true
           tables_not_created = true
           warnings_issued = true.        
  END.
  
  ASSIGN uc_col = "".

  IF DICTDB._File._For-name <> ? AND DICTDB._File._For-name <> "n/a" 
                                 AND DICTDB._File._For-name <> "" THEN 
      n1 = DICTDB._File._For-name.
  
  ELSE IF DICTDB._File._fil-misc2[1] <> ? THEN DO:
    IF R-INDEX (_fil-misc2[1], ".") > 0 THEN
      n1 = SUBSTR (_fil-misc2[1], R-INDEX (_fil-misc2[1], ".") + 1).
    ELSE
      n1 = DICTDB._File._fil-misc2[1].
  END. 
  ELSE
    n1 = DICTDB._File._File-name.

  trunc_name = FALSE.
  IF xlat THEN DO:
     if max_id_length <> 0 and length(n1) > max_id_length then do:
           /*  _resxlat will truncate name  */
           put stream logfile unformatted
              "WARNING: Table name " n1 " is longer than the maximum " skip
              "         legal identifier length of " max_id_length "." skip.
           trunc_name = TRUE.
      end.
      n1 = n1 + "," + idbtyp + "," + string (max_id_length).
      RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n1).
  end.
  else if max_id_length <> 0  and length(n1) > max_id_length then do:
        /*  need to truncate name  */
     put stream logfile unformatted
           "WARNING: Table name " n1 " is longer than the maximum " skip
           "         legal identifier length of " max_id_length "." skip.
     n1 = substring(n1,1,max_id_length).
     trunc_name = TRUE.
  end.
 
  _verify-table:
  DO WHILE TRUE:
    FIND verify-table WHERE verify-table.new-name = n1 NO-ERROR.
    IF NOT AVAILABLE verify-table THEN DO:
      CREATE verify-table.
      ASSIGN verify-table.new-name = n1
             verify-table.rec-fld  = RECID (DICTDB._File)
             verify-table.has-unsprtdt = comment_chars.
      LEAVE _verify-table.
    END.
    ELSE DO:
      DO a = 1 TO 999:
        ASSIGN n1 = SUBSTRING(n1, 1, LENGTH(n1) - LENGTH(STRING(a))) + STRING(a).

        IF CAN-FIND(verify-table WHERE verify-table.new-name = n1) THEN NEXT.
        ELSE DO:
          CREATE verify-table.
          ASSIGN verify-table.new-name = n1
                 verify-table.rec-fld  = RECID (DICTDB._File).
          LEAVE _verify-table.
        END.
      END.
    END.    
  END.
 
  if trunc_name then     
     put stream logfile unformatted 
             "         Truncating table name to " n1 skip(2).         
    
  IF dbtyp = "ORACLE" THEN DO:
     PUT STREAM code UNFORMATTED comment_chars
        "DROP SEQUENCE " n1 "_SEQ".
     IF skptrm THEN
        PUT STREAM code UNFORMATTED SKIP.
     PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
     IF compatible THEN DO:
         PUT STREAM code UNFORMATTED comment_chars
            "CREATE SEQUENCE " n1 "_SEQ START WITH 1 INCREMENT BY 1".
         IF skptrm THEN
            PUT STREAM code UNFORMATTED SKIP.
         PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
     END.
  
     PUT STREAM code UNFORMATTED comment_chars "DROP TABLE " n1.
     IF skptrm THEN PUT STREAM code UNFORMATTED SKIP.
     PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
  END.

  ELSE IF DBTYP = "SYBASE" OR DBTYP = "MS SQL Server"  THEN DO:

      PUT STREAM CODE UNFORMATTED 
          comment_chars "if (select name from sysobjects " SKIP 
          comment_chars "           where name = '" n1 "' and type = 'U' and " SKIP
          comment_chars "                 uid = (select uid from sysusers " SKIP  
          comment_chars "                               where suid = (select suid from master.dbo.syslogins" SKIP 
          comment_chars "                                                    where UPPER(name) = UPPER('" 
          user_env[26] "'))))" skip 
          comment_chars "   is not NULL" SKIP          
          comment_chars "    drop table " n1 SKIP
          comment_chars user_env[5] SKIP.
  END. 
  ELSE IF dbtyp = "MSSQLSRV7" THEN DO:
      PUT STREAM CODE UNFORMATTED 
          comment_chars "if (select name from sysobjects " SKIP 
          comment_chars "    where name = '" n1 "' and type = 'U' and " SKIP
          comment_chars "    uid = (select uid from sysusers " SKIP  
          comment_chars "            where sid = (select sid from master.dbo.syslogins" SKIP 
          comment_chars "                         where UPPER(name) = UPPER('" user_env[26] "'))))" skip 
          comment_chars "   is not NULL" SKIP          
          comment_chars "    drop table " n1 SKIP
          comment_chars user_env[5] SKIP.
  END.
 /*  ELSE IF ( dbtyp <> "Informix" AND dbtyp <> "DB2" AND dbtyp <> "MS ACCESS" )  THEN DO: */ 
 /*  OE00177726- Added DROP SQL statement to .sql file for all ODBC-compliant
                databases which are not handled above */
   ELSE DO:
      PUT STREAM code UNFORMATTED comment_chars "DROP TABLE " user_library dot n1.
      IF skptrm THEN
          PUT STREAM code UNFORMATTED SKIP.
      PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
  end. 
 
  PUT STREAM code UNFORMATTED comment_chars "CREATE TABLE " user_library dot.
  PUT STREAM code UNFORMATTED n1 " (" SKIP.
  
  DefC = "".
  FOR EACH DICTDB._Field OF DICTDB._File BREAK BY DICTDB._Field._Order:
   
    IF DICTDB._Field._For-type = "TIME" THEN NEXT.
    
    IF   DICTDB._Field._For-name <> ? AND 
         DICTDB._Field._For-name <> "n/a" AND 
         DICTDB._Field._For-name <> "" THEN          
       ASSIGN n2 = DICTDB._Field._For-name.    
    ELSE DO:
        /* Avoid collisions with unrolled extents */
       ASSIGN n2 = DICTDB._Field._Field-name.
       
       IF DICTDB._Field._Extent > 0 THEN DO:
         ASSIGN ri = R-INDEX (n2, "##").
              
         IF ri > 2 AND ri < LENGTH (n2) THEN DO:
           IF INDEX ("0123456789", SUBSTR (n2, ri + 1, 1)) > 0 THEN DO:
             ASSIGN afldn = SUBSTR (n2, 1, ri - 1).
             IF CAN-FIND (DICTDB._Field WHERE DICTDB._Field._Field-name = afldn) THEN 
                OVERLAY (n2, ri, 1) = "_".
           END.
         END.
       END.
    END.

    trunc_name = FALSE.
    IF xlat THEN DO:
       IF DICTDB._Field._Extent > 0 THEN DO:
         ASSIGN max_ext_length = max_id_length - 2 - length(string(DICTDB._Field._Extent)).
         if max_ext_length <> 0 and length(n2) > max_ext_length then do:
           /*  _resxlat will truncate name  */
           put stream logfile unformatted
              "WARNING: Field name " n2 " is longer than the maximum " skip
              "         legal identifier length of " max_id_length "." skip.
             trunc_name = TRUE.
         end.
         n2 = n2 + "," + idbtyp + "," + string (max_ext_length).
         RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
       END.
       ELSE if max_id_length <> 0 and length(n2) > max_id_length then do:
          /*  _resxlat will truncate name  */
          put stream logfile unformatted
              "WARNING: Field name " n2 " is longer than the maximum " skip
              "         legal identifier length of " max_id_length "." skip.
             trunc_name = TRUE.
        end.
        
        n2 = n2 + "," + idbtyp + "," + string (max_id_length).
        RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
    end.
    else if max_id_length <> 0 and length(n2) > max_id_length then do:
       /*  need to truncate name  */
       put stream logfile unformatted
             "WARNING: Field name " n2 " is longer than the maximum " skip
             "         legal identifier length of " max_id_length "." skip.
       n2 = substring(n2,1,max_id_length).
       trunc_name = TRUE.
    end.
  
    _verify-name:
    DO WHILE TRUE:
      FIND verify-name WHERE verify-name.new-name = n2 NO-ERROR.
      IF NOT AVAILABLE verify-name THEN DO:
        CREATE verify-name.
        ASSIGN verify-name.new-name = n2
               verify-name.prog-name = DICTDB._Field._Field-name
               verify-name.rec-fld   = RECID (DICTDB._Field).
        LEAVE _verify-name.
      END.
      ELSE DO:
        DO a = 1 TO 999:
          ASSIGN n2 = SUBSTRING(n2, 1, LENGTH(n2) - LENGTH(STRING(a))) + STRING(a).

          IF CAN-FIND(verify-name WHERE verify-name.new-name = n2) THEN NEXT.
          ELSE DO:
            CREATE verify-name.
            ASSIGN verify-name.new-name = n2
                   verify-name.prog-name = DICTDB._Field._Field-name
                   verify-name.rec-fld   = RECID (DICTDB._Field).
            LEAVE _verify-name.
          END.
        END.
      END.    
    END.

    if trunc_name then       
       put stream logfile unformatted 
               "         Truncating field name to " n2 skip(2).         
 
     DO e = MINIMUM(DICTDB._Field._Extent,1)TO MAXIMUM(0,DICTDB._Field._Extent):  /* extent unrolling */

         IF (  ( NOT FIRST(DICTDB._Field._Order) ) 
              OR ( e > MINIMUM(DICTDB._Field._Extent,1) ) )
           THEN PUT STREAM code UNFORMATTED "," SKIP.

      ASSIGN c = ""
             i = DICTDB._Field._dtype.

      /* character data type */ 
      IF i = 1 THEN DO: /* char */  
        IF sqlwidth THEN DO:
          IF DICTDB._Field._Extent = 0 THEN 
            ASSIGN j = DICTDB._Field._Width.
          ELSE DO:
            ASSIGN wdth = (IF DICTDB._Field._fld-res1[3] EQ ? OR DICTDB._Field._Fld-Misc3[1] EQ ?
                            THEN DICTDB._Field._Width
                            ELSE MAXIMUM(DICTDB._Field._Fld-Misc3[1],DICTDB._Field._fld-res1[3])).
            ASSIGN j = ((wdth - (DICTDB._Field._Extent * 2)) / DICTDB._Field._Extent).
           END.

            /* OE00172253 - check if value is negative, then assign it the width value unless it's too
               big, in which case we assign the max value allowed for this type.
            */
            IF j <= 0 THEN DO:
                j = DICTDB._Field._Width.
                IF j > longwid THEN
                    j = longwid.
            END.

        END.
        ELSE DO:    

          ASSIGN nbrchar = 0 
                 lngth = LENGTH(DICTDB._Field._format, "character").  
           
          if index(DICTDB._Field._Format, "(") > 1 THEN DO:
             left_paren = INDEX(DICTDB._Field._Format, "(").
             right_paren = INDEX(DICTDB._Field._Format, ")").
             lngth = right_paren - (left_paren + 1).
             assign j = INTEGER(SUBSTRING(DICTDB._Field._Format, left_paren + 1, lngth)).  
          END.  
          ELSE DO:           
               DO z = 1 to lngth:        
                   IF SUBSTRING(DICTDB._Field._Format,z,1) = "9" OR
                        SUBSTRING(DICTDB._Field._Format,z,1) = "N" OR   
                        SUBSTRING(DICTDB._Field._Format,z,1) = "A" OR    
                        SUBSTRING(DICTDB._Field._Format,z,1) = "x" OR
                        SUBSTRING(DICTDB._Field._Format,z,1) = "!"   THEN
                   ASSIGN nbrchar = nbrchar + 1.
                END.         
                IF nbrchar > 0 THEN
                    ASSIGN j = nbrchar.
                ELSE
                    ASSIGN j = lngth.    
          END.                            

          IF DICTDB._Field._Decimals > 0 
            AND can-find(first DICTDB._Db where RECID(DICTDB._Db) = drec_db
                         and DICTDB._Db._Db-type <> "PROGRESS" ) THEN 
            ASSIGN j = DICTDB._Field._Decimals.
          
          IF j = 8 AND sqlwidth = FALSE THEN j = minwdth.
        END.

        IF lUniExpand THEN
            j = j * 2.

        IF j > longwid THEN
             i = 8. /* long char */
        ELSE
          c = " (" + STRING(j * dbe-factor) + ")".
      END.     /*===== character =====*/

      /* If its a logical field that's a key componet, it can't be a bit */

      IF i = 3 AND CAN-FIND (FIRST DICTDB._Index-field WHERE
              DICTDB._Index-field._Field-recid = RECID (DICTDB._Field)) THEN 
         ASSIGN i = 9.
     

      /* Decimal data type */ 
      IF dbtyp = "ORACLE" OR dbtyp = "SYBASE" OR 
         dbtyp = "MS SQL Server" OR dbtyp = "MSSQLSRV7" OR 
         /* 20051214-009 - handle decimals for DB2/400 too */
        (dbtyp = "DB2" and db2type = "DB2/400") THEN DO:
          /* get the size of decimal fields */

          IF i = 5 AND LENGTH(DICTDB._Field._Format) <> 0 THEN DO: 
            IF sqlwidth THEN DO:
              IF DICTDB._Field._Extent = 0 THEN DO:        
                IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Width > 28 THEN 
                  ASSIGN j = 28.
                ELSE IF dbtyp = "ORACLE" AND DICTDB._Field._Width > 38 THEN
                  ASSIGN j = 38.
                ELSE 
                  ASSIGN j = DICTDB._Field._Width.
                  IF j < DICTDB._Field._Decimals THEN ASSIGN j = DICTDB._Field._Decimals.  
              END.              
              ELSE DO:              
                ASSIGN wdth = (IF DICTDB._Field._fld-res1[3] EQ ? OR DICTDB._Field._Fld-Misc3[1] EQ ?
                               THEN DICTDB._Field._Width
                               ELSE MAXIMUM(DICTDB._Field._Fld-Misc3[1],DICTDB._Field._fld-res1[3])).

                ASSIGN j = ((wdth - (DICTDB._Field._Extent * 2)) / DICTDB._Field._Extent).            
                IF dbtyp = "MSSQLSRV7" AND j > 28 THEN 
                  ASSIGN j = 28.
                ELSE IF dbtyp = "ORACLE" AND j > 38 THEN
                  ASSIGN j = 38.

                IF j < DICTDB._Field._Decimals THEN ASSIGN j = DICTDB._Field._Width.
                IF j < DICTDB._Field._Decimals THEN ASSIGN j = DICTDB._Field._Decimals.                                        
              END.
            END.
            ELSE DO:
              ASSIGN k = 1
                     j = 0. 
              /* get count of significant digits stopping at ".".
               * only count elements that can be considered digits. */
              REPEAT:
                IF k > LENGTH(DICTDB._Field._Format) OR SUBSTR(DICTDB._Field._Format,k,1) = "." THEN 
                   LEAVE. 
                IF SUBSTR(DICTDB._Field._Format,k,1) = ">" OR 
                   SUBSTR(DICTDB._Field._Format,k,1) = "<" OR 
                   SUBSTR(DICTDB._Field._Format,k,1) = "Z" OR 
                   SUBSTR(DICTDB._Field._Format,k,1) = "z" OR 
                   SUBSTR(DICTDB._Field._Format,k,1) = "9" OR 
                   SUBSTR(DICTDB._Field._Format,k,1) = "*" THEN
                     j = j + 1. 

                k = k + 1.
              END. 

              /* Add the scale to the precision. */ 
              j = j + DICTDB._Field._Decimals.
            END.
              /* use the datatype only and not the default type and size */
            ASSIGN  i = 6. 
              /* format the string that will follow the datatype   */
            IF DICTDB._Field._Decimals <> ? THEN  
              c = "(" + STRING(j) + "," + STRING(DICTDB._Field._Decimals) + ")".
            ELSE
               c = " ".
          END.  
      END. /*===== decimal =====*/

      /* create shadow columns, char field, case-insens, and a key componet */

      IF shadow AND  i = 1 AND DICTDB._Field._Fld-case = FALSE AND
          CAN-FIND (FIRST DICTDB._Index-field WHERE
                    DICTDB._Index-field._Field-recid = RECID (DICTDB._Field))THEN 
      _Shadow_Block:
      DO:

        /* Make sure that there is at least one NON-Word index this 
         * field is participating in.  If all the indexes it is in are 
         * word indexes, then we must skip creating the shadow columns. */ 
         
         ASSIGN shadow_is_valid = false. 
         for each DICTDB._Index-field where DICTDB._Index-field._Field-recid = RECID(DICTDB._Field):
           find DICTDB._Index where RECID(DICTDB._Index) = DICTDB._Index-field._Index-recid 
                                and DICTDB._Index._Wordidx <> 1 NO-ERROR.

           if available(DICTDB._Index) then do: 
             ASSIGN shadow_is_valid = true. 
             leave.
           end. 
         end. 

         if not shadow_is_valid then leave _Shadow_Block. 

          IF LENGTH (uc_col) > 0 THEN
            uc_col = uc_col + ",".
          uc_col = uc_col + n2.

        IF dbtyp = "SYBASE" OR dbtyp = "MS SQL Server" OR
           dbtyp = "MSSQLSRV7" THEN 
          PUT STREAM code UNFORMATTED
             comment_chars "  _S#_" n2 
             (if e = 0 then "" else unik + string(e))
             " " user_env[i + 10] c "," SKIP.         
        ELSE
          PUT STREAM code UNFORMATTED comment_chars " "
             comment_chars " U" unik n2  
             (IF e = 0 THEN "" ELSE unik + STRING(e)) 
             " " user_env[i + 10] c 
              (IF DICTDB._Field._Mandatory THEN " NOT NULL" ELSE "") "," SKIP.
            
      END. /* end of creation of shadow columns  _Shadow_Block */ 
      
      /* Oracle and the RAW data type must be recognized so that proper one 
        is put into the script.  They are also supporting BLOBS.
      */
      IF dbtyp = "ORACLE" AND (DICTDB._Field._Dtype = 8 OR DICTDB._Field._Dtype > 17 ) 
          AND DICTDB._Field._Dtype NE 41 /*int64 */ THEN DO: 
        IF DICTDB._Field._Dtype = 8 THEN
          PUT STREAM code UNFORMATTED
           comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) 
           " " "long raw".    
        ELSE IF DICTDB._Field._Dtype = 18 THEN
          PUT STREAM CODE UNFORMATTED
          comment_chars "  " n2 " blob not null".
        ELSE IF DICTDB._Field._Dtype = 19 THEN
          PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2  (IF user_env[11] = "NVARCHAR2" THEN " nclob" ELSE " clob")
            " not null".
        ELSE IF DICTDB._Field._Dtype = 34 /*datetime*/ THEN
            PUT STREAM CODE UNFORMATTED
             comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) " timestamp".
        ELSE IF DICTDB._Field._Dtype = 40 /*datetime-tz*/ THEN
            PUT STREAM CODE UNFORMATTED
             comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) " timestamp with time zone".
        ELSE  
          PUT STREAM CODE UNFORMATTED comment_chars "  " n2 " UNSUPPORTED-" DICTDB._Field._Data-type.          
      END.
      ELSE IF dbtyp = "PROGRESS" AND DICTDB._Field._Dtype > 17 THEN DO:
          IF DICTDB._Field._DType = 18 THEN
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2 " blob".
          ELSE IF DICTDB._Field._Dtype = 19 THEN
            PUT STREAM CODE UNFORMATTED
              comment_chars "  " n2  " clob".
          ELSE IF DICTDB._Field._Dtype = 20 THEN
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2  " xlob".
          ELSE IF DICTDB._Field._Dtype = 34 THEN
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) " datetime".
          ELSE IF DICTDB._Field._Dtype = 40 THEN
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) " datetime-tz".
          ELSE IF DICTDB._Field._Dtype = 41 THEN
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) " int64".
      END.
      ELSE IF DICTDB._Field._Dtype > 17 AND dbtyp <> "PROGRESS" THEN DO:
        IF DICTDB._Field._Dtype EQ 41 /*int64 */ THEN DO:
            PUT STREAM code UNFORMATTED
             comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) 
                /* extent unrolling */
             " "  (IF dbtyp = "ORACLE" THEN "number" ELSE "bigint")
                /*char,date,log,int,deci,deci0,recid,lchar,tinyint*/
             c. /* (n,m) */
        END.
        ELSE IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Dtype EQ 34 /* datetime */ THEN DO:
            PUT STREAM code UNFORMATTED
             comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e))
             (IF mssNewDTTypes THEN " datetime2(3)" ELSE " datetime")
             c. /* (n,m) */
        END.
        ELSE IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Dtype EQ 40 /* datetime-tz */ AND 
            mssNewDTTypes THEN DO:
            PUT STREAM code UNFORMATTED
             comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e))
             " datetimeoffset(3)"
             c. /* (n,m) */
        END.
        ELSE IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Dtype EQ 18 /* BLOB */ THEN DO:
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2 " varbinary(max)".
        END.
        ELSE IF dbtyp = "MSSQLSRV7" AND DICTDB._Field._Dtype EQ 19 /* CLOB */ THEN DO:
            PUT STREAM CODE UNFORMATTED
            comment_chars "  " n2  (IF user_env[18] = "nvarchar(max)" THEN " nvarchar(max)" ELSE " varchar(max)").
        END.
        ELSE
           PUT STREAM CODE UNFORMATTED
               comment_chars "  " n2 " UNSUPPORTED-" DICTDB._Field._Data-type.       
      END.
      ELSE
        PUT STREAM code UNFORMATTED
         comment_chars "  " n2 (IF e = 0 THEN "" ELSE unik + STRING(e)) 
            /* extent unrolling */
         " " user_env[i + 10] 
            /*char,date,log,int,deci,deci0,recid,lchar,tinyint*/
         c. /* (n,m) */

      IF pfmt THEN DO:
        IF DICTDB._Field._dtype = 1 THEN PUT STREAM code UNFORMATTED
            " " TRIM(STRING(_Fld-case,"/NOT")) " CASE-SENSITIVE".
        RUN "prodict/_dctquot.p" (_Format,"'",OUTPUT c).
        PUT STREAM code UNFORMATTED " FORMAT " c.
        IF DICTDB._Field._Label <> ? AND DICTDB._Field._Label <> "" THEN DO:
          RUN "prodict/_dctquot.p"
            (_Label + (IF e > 0 THEN "[" + STRING(e) + "]" ELSE ""),
            "'",OUTPUT c).
          PUT STREAM code UNFORMATTED " LABEL " c.
        END.
        IF DICTDB._Field._Col-label <> ? AND DICTDB._Field._Col-label <> "" THEN DO:
          RUN "prodict/_dctquot.p"
            (_Col-label + (IF e > 0 THEN "[" + STRING(e) + "]" ELSE ""),
            "'",OUTPUT c).
          PUT STREAM code UNFORMATTED " COLUMN-LABEL " c.
        END.
      END.

      IF DICTDB._Field._Data-type = "character" AND sdef AND defaultfld eq "1" AND
          (dbtyp = "ORACLE" OR dbtyp = "MSSQLSRV7") AND
         (DICTDB._Field._Initial = ? OR Dictdb._field._Initial = " " OR DICTDB._Field._Initial = "?") THEN DO:
         IF blankdefault THEN
            PUT STREAM code UNFORMATTED " DEFAULT ' ' ".
           ELSE IF (DICTDB._Field._Data-type = "character" AND Dictdb._field._Initial = "") AND useoedflt THEN
              PUT STREAM code UNFORMATTED " DEFAULT '' ".
      END.
      /* Put default values */
      IF sdef AND (DICTDB._Field._Initial <> ? AND Dictdb._field._Initial <> " " AND DICTDB._Field._Initial <> "?" )THEN DO:      
          c = DICTDB._Field._Initial. 
         IF DICTDB._Field._Data-type = "DATE" OR 
            DICTDB._Field._Data-type BEGINS "DATETIME" THEN DO:
           IF UPPER(c) = "TODAY" OR UPPER(c) = "NOW" THEN DO:        
             IF dbtyp = "ORACLE" THEN
               ASSIGN c = "SYSDATE".
             ELSE IF dbtyp = "MSSQLSRV7" THEN DO:
                IF mssNewDTTypes AND DICTDB._Field._Data-type BEGINS "DATETIME" THEN DO:
                   IF DICTDB._Field._Data-type = "DATETIME" THEN
                      ASSIGN c = "SYSDATETIME()".
                   ELSE /* must be datetime-tz */
                      ASSIGN c = "SYSDATETIMEOFFSET()".
                END.
                ELSE IF DICTDB._Field._Data-type NE "DATETIME-TZ" THEN
                     ASSIGN c = "GETDATE()".
                ELSE
                    ASSIGN c = "".
             END.
             ELSE IF dbtyp = "DB2" and db2type = "DB2/400" THEN 
	       ASSIGN c = "CURRENT DATE".
	     ELSE IF dbtyp = "PROGRESS" THEN.  /* OK to leave TODAY/NOW for OpenEdge */
             ELSE 
               ASSIGN c = "".
           END.
           ELSE
             ASSIGN c = "".
         END.
         IF DICTDB._Field._dtype = 3 THEN DO:
            ASSIGN slash = INDEX("/", Dictdb._Field._Format).
            IF UPPER(c) = UPPER(SUBSTRING(Dictdb._Field._Format,1, (slash - 1))) OR
               UPPER(c) BEGINS "Y" OR UPPER(c) BEGINS "T" THEN
                  ASSIGN c = "1".
            ELSE IF UPPER(c) = UPPER(SUBSTRING(Dictdb._Field._Format,(slash + 1))) OR
               UPPER(c) BEGINS "N" OR UPPER(c) BEGINS "F"  THEN  
                  ASSIGN c = "0".
            ELSE
              ASSIGN c = "".               
         END.
         ELSE IF DICTDB._Field._dtype = 4 THEN
           ASSIGN c = DICTDB._Field._Initial.
         ELSE IF DICTDB._Field._dtype = 5 THEN DO:
           ASSIGN c = DICTDB._Field._Initial.
           IF INDEX(c, ",") > 0 THEN DO:           
             DO k = 1 TO LENGTH(c):
               IF INDEX(c, ",") > 0 THEN
                 ASSIGN c = SUBSTRING(c, 1, (INDEX(c, ",") - 1)) +  
                            SUBSTRING(c, (INDEX(c, ",") + 1)).
               ELSE
                 ASSIGN k = LENGTH(c).
             END.
           END.           
         END.
         IF DICTDB._Field._Data-type = "character" THEN DO:
           RUN "prodict/_dctquot.p" (_Initial,"'",OUTPUT c).        
       IF c <> " " AND defaultfld eq "1" AND c <> "0"
          THEN DO:
              IF (migConstraint AND dbtyp = "MSSQLSRV7") 
              THEN DO:
                   IF NOT CAN-FIND (DICTDB._constraint where DICTDB._constraint._file-recid = recid(DICTDB._File) AND DICTDB._Constraint._Con-Active = TRUE
                     AND DICTDB._constraint._con-type = "D" AND DICTDB._constraint._Field-Recid = integer(RECID(DICTDB._Field))) THEN
                   PUT STREAM code UNFORMATTED " DEFAULT " c.
                   ELSE PUT STREAM constlog UNFORMATTED " FIELD " + n2 + " HAS CONSTRAINT; DEFAULT VALUE NOT ADDED "  SKIP. 
              END.
              ELSE PUT STREAM code UNFORMATTED " DEFAULT " c.
           END.
         END.    
         ELSE IF c <> " " AND defaultfld eq "1" AND CAN-DO("logical,date,datetime,datetime-tz",DICTDB._Field._Data-type)
         THEN DO:
              IF (migConstraint AND dbtyp = "MSSQLSRV7") 
              THEN DO:         
                   IF NOT CAN-FIND (DICTDB._constraint where DICTDB._constraint._file-recid = recid(DICTDB._File) AND DICTDB._Constraint._Con-Active = TRUE
                     AND DICTDB._constraint._con-type = "D" AND DICTDB._constraint._Field-Recid = integer(RECID(DICTDB._Field))) THEN         
                   PUT STREAM code UNFORMATTED " DEFAULT " c.
                   ELSE PUT STREAM constlog UNFORMATTED " FIELD " + n2 + " HAS CONSTRAINT; DEFAULT VALUE NOT ADDED "  SKIP. 
              END.
              ELSE PUT STREAM code UNFORMATTED " DEFAULT " c.                   
         END.     
         ELSE IF c <> " " AND defaultfld eq "1" AND c <> ? 
         THEN DO:
              IF (migConstraint AND dbtyp = "MSSQLSRV7") 
              THEN DO:             
                   IF NOT CAN-FIND (DICTDB._constraint where DICTDB._constraint._file-recid = recid(DICTDB._File) AND DICTDB._Constraint._Con-Active = TRUE
                     AND DICTDB._constraint._con-type = "D" AND DICTDB._constraint._Field-Recid = integer(RECID(DICTDB._Field))) THEN         
                   PUT STREAM code UNFORMATTED " DEFAULT " c. 
                   ELSE PUT STREAM constlog UNFORMATTED " FIELD " + n2 + " HAS CONSTRAINT; DEFAULT VALUE NOT ADDED "  SKIP. 
              END.
              ELSE PUT STREAM code UNFORMATTED " DEFAULT " c.                      
         END.
      END.
      IF sdef  AND (DICTDB._Field._Initial <> ? AND Dictdb._field._Initial <> " " AND DICTDB._Field._Initial <> "?" )
            AND c <> " " AND defaultfld eq "2" AND dbtyp = "MSSQLSRV7"
      THEN DO:
         IF NOT CAN-FIND (DICTDB._constraint where DICTDB._constraint._file-recid = recid(DICTDB._File) AND DICTDB._Constraint._Con-Active = TRUE
                     AND DICTDB._constraint._con-type = "D" AND DICTDB._constraint._Field-Recid = integer(RECID(DICTDB._Field)))
         THEN DO:
            dfltconname = "DC_" + n1 + "_" + n2.

            IF xlat THEN DO:
               if max_con_length <> 0 and length(dfltconname) > max_con_length
               then do:
                    /*  _resxlat will truncate name  */
                   put stream logfile unformatted
                   "WARNING: Field name " dfltconname " is longer than the maximum " skip
                   "         legal identifier length of " max_id_length "." skip.
                   trunc_name = TRUE.
               end.
               dfltconname = dfltconname + "," + idbtyp + "," + string (max_con_length).
               RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT dfltconname).
            END.
            ELSE if max_con_length <> 0 and  length(dfltconname) > max_con_length THEN
             /*  need to truncate name  */
               ASSIGN dfltconname = substring(dfltconname,1,max_con_length)
               trunc_name = TRUE.
  
            _verify-con-name:
            DO WHILE TRUE:
                FIND verify-name WHERE verify-name.new-name = dfltconname NO-ERROR.
                IF NOT AVAILABLE verify-name
                THEN DO:
                CREATE verify-name.
                   ASSIGN verify-name.new-name = dfltconname.
                   LEAVE _verify-con-name.
                END.
                ELSE DO:
                DO a = 1 TO 999:
                   ASSIGN dfltconname = SUBSTRING(dfltconname, 1, LENGTH(dfltconname) - LENGTH(STRING(a))) + STRING(a).
                 IF CAN-FIND(verify-name WHERE verify-name.new-name = dfltconname) THEN NEXT.
                 ELSE DO:
                   CREATE verify-name.
                   ASSIGN verify-name.new-name = dfltconname.
                   LEAVE _verify-con-name.
                 END.
                END.
             END.    
            END.

	        IF DefC <> "" then  DefC = DefC + ",~n" + comment_chars .
            DefC = DefC +  "  CONSTRAINT  " +  dfltconname  + "  DEFAULT " +  c   
		                + " FOR  " +   n2 + (IF e = 0 THEN "" ELSE unik + STRING(e)) . 
            PUT STREAM constlog UNFORMATTED " DEFAULT CONSTRAINT " + dfltconname + " FOR FIELD " + n2 +
                       (IF e = 0 THEN "" ELSE unik + STRING(e)) + " FILE " + n1 + " CREATED "  SKIP.                  
         END.
         ELSE PUT STREAM constlog UNFORMATTED " FIELD " + n2 + " HAS CONSTRAINT; DEFAULT VALUE NOT ADDED "  SKIP.        
      END.
     
      IF dbtyp = "ORACLE" OR dbtyp = "PROGRESS" THEN DO:
        IF DICTDB._Field._Mandatory 
           THEN PUT STREAM code UNFORMATTED " NOT NULL".
           

         /* The following code will find if the DICTDB._Field is part of a primary unique
         ** Index for the table.   This test should be done for the demo database
         ** because there are NO mandatory fields in the demo database.*/
         
        ELSE IF not compatible THEN DO:  /* add "NOT NULL" if is part of the primary index */
           IF CAN-FIND(DICTDB._Index-field
                        where DICTDB._Index-field._Field-recid = recid(DICTDB._Field) 
                          and CAN-FIND(DICTDB._Index where recid(DICTDB._Index) =
                                                           DICTDB._Index-field._Index-recid 
                                                       and CAN-FIND(DICTDB._File
                                                           where DICTDB._File._Prime-Index =
                                                                  recid(DICTDB._Index))))
            THEN
                PUT STREAM code UNFORMATTED
                    " NOT NULL".
        END.     /* add "not null" if is part of the primary index */
      END.     /* oracle or PROGRESS */
      ELSE IF (dbtyp = "SYBASE" OR dbtyp = "MS SQL Server" OR 
              dbtyp = "MSSQLSRV7") AND NOT unsprtdt THEN 
        PUT STREAM code UNFORMATTED
          (if DICTDB._Field._Mandatory OR (i <= 9 /*not int64 */ AND user_env[i + 10] = "bit") 
           then " not null" else " null").
      ELSE IF (db2type <> ? AND db2type <> "")  AND DICTDB._Field._Mandatory THEN
          PUT STREAM code UNFORMATTED " NOT NULL".
    END.     
  END. /* FOR EACH DICTDB._Field OF DICTDB._File BREAK BY DICTDB._Field._Order */

/************************************************************************************************/
/******************************** generation of constraint **************************************/
/************************************************************************************************/


   /* 195067 begins */ /* Code for generating the constriants in foreign DB at table level. */
     IF migConstraint and (dbtyp = "MSSQLSRV7" OR dbtyp = "ORACLE") then  
     DO:
       ASSIGN AllCons = ""
	          DefCons = ""
	          ClustCons = "".
      FOR EACH DICTDB._constraint where DICTDB._constraint._file-recid =  recid(DICTDB._File) exclusive-lock:
	  IF( DICTDB._Constraint._Con-Active = TRUE AND (DICTDB._constraint._con-status = "N" OR DICTDB._constraint._con-status = "C" 
	                                                                             OR DICTDB._constraint._con-status = "M"))
	                                                                           
	  THEN DO:
	   ASSIGN ConType = DICTDB._constraint._con-type
              ConName = DICTDB._constraint._con-name. 
	   
       trunc_name = FALSE.
       IF xlat THEN DO:
         if max_con_length <> 0 and length(ConName) > max_con_length
         then do:
           /*  _resxlat will truncate name  */
           put stream logfile unformatted
              "WARNING: Field name " ConName " is longer than the maximum " skip
              "         legal identifier length of " max_id_length "." skip.
             trunc_name = TRUE.
         end.
         ConName = ConName + "," + idbtyp + "," + string (max_con_length).
         RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT ConName).
       /*  ConName = "_" + ConName. */
       END.
       ELSE if max_con_length <> 0 and  length(ConName) > max_con_length THEN
          /*  need to truncate name  */
               ASSIGN ConName = substring(ConName,1,max_con_length)
              trunc_name = TRUE.
   
       _verify-con-name:
       DO WHILE TRUE:
         FIND verify-name WHERE verify-name.new-name = ConName NO-ERROR.
         IF NOT AVAILABLE verify-name
         THEN DO:
           CREATE verify-name.
           ASSIGN verify-name.new-name = ConName.
           LEAVE _verify-con-name.
         END.
         ELSE DO:
          DO a = 1 TO 999:
            ASSIGN ConName = SUBSTRING(ConName, 1, LENGTH(ConName) - LENGTH(STRING(a))) + STRING(a).
            IF CAN-FIND(verify-name WHERE verify-name.new-name = ConName) THEN NEXT.
            IF CAN-FIND(verify-table WHERE verify-name.new-name = ConName) THEN NEXT.
            IF CAN-FIND(verify-index WHERE verify-name.new-name = ConName) THEN NEXT.            
            ELSE DO:
               CREATE verify-name.
               ASSIGN verify-name.new-name = ConName.
               LEAVE _verify-con-name.
            END.
          END.
         END.    
       END.  
        
	   IF (ConType <> "D" or ConType <> "C") THEN
	   DO:
	     FIND FIRST DICTDB._INDEX of DICTDB._Constraint NO-LOCK NO-ERROR.
         ASSIGN AllConsFields = "". 
                      
         FOR EACH DICTDB._INDEX-Field of DICTDB._INDEX NO-LOCK,
	      first DICTDB._Field of DICTDB._INDEX-Field no-lock:
	      FIND verify-name WHERE verify-name.rec-fld = RECID(DICTDB._Field) AND 
               verify-name.prog-name = DICTDB._Field._Field-name NO-LOCK NO-ERROR.
              IF AllConsFields <> "" THEN 
                 AllConsFields = AllConsFields + "," .
                 Assign AllConsFields = AllConsFields + verify-name.new-name.  
         END. /* FOR each DICTDB._INDEX-Field of DICTDB._INDEX NO-LOCK, */
	     
            IF  (ConType = "P" AND dbtyp = "MSSQLSRV7") THEN                  
            DO:
	            if AllCons <> "" then AllCons = AllCons + ",~n" + comment_chars.
	            AllCons = AllCons + " CONSTRAINT  " +  ConName  + " PRIMARY KEY NONCLUSTERED( " + AllConsFields + ")" . 
                    PKCreated = TRUE.
            
            END. /* IF ConType = "P" */
	        
	    IF  (ConType = "P" AND dbtyp = "ORACLE") THEN                  
            DO:
	            if AllCons <> "" then AllCons = AllCons + ",~n" + comment_chars.
	            AllCons = AllCons + " CONSTRAINT  " +  ConName  + " PRIMARY KEY( " + AllConsFields + ")" . 
            
            END. /* IF ConType = "P" */
	        
	    IF  (ConType = "PC" OR ConType = "MP") THEN                  
            DO:
	      if AllCons <> "" then AllCons = AllCons + ",~n" + comment_chars.
	      AllCons = AllCons + " CONSTRAINT  " +  ConName  + " PRIMARY KEY( " + AllConsFields + ")" .
              PKCreated = TRUE.
            END. /* IF ConType = "PC" */
                    
            IF (ConType = "M" and dbtyp = "MSSQLSRV7") THEN                  
            DO:
	       if ClustCons <> "" then ClustCons = ClustCons + ",~n" + comment_chars.
	          ClustCons = ClustCons + " CLUSTERED INDEX " + ConName + " ON " + DICTDB._File._File-Name + " ( "
	             + AllConsFields + ")".

            END. /* IF ConType = "M" */
            
	    IF ConType = "U" THEN
            DO:	       
	      if AllCons <> "" then AllCons = AllCons + ",~n" + comment_chars.
              AllCons = AllCons +  " CONSTRAINT " +  ConName  + " UNIQUE( " + AllConsFields + ")" .
            END. /* IF ConType = "U" */
	       	      
       END. /* IF ConType <> "D" or ConType <> "C" */
       	  
	   IF ConType = "D" THEN
	   DO:
             FIND FIRST DICTDB._Field WHERE RECID(DICTDB._Field) = DICTDB._Constraint._Field-Recid NO-LOCK NO-ERROR.
		     IF AVAIL(DICTDB._Field) THEN 
		     DO:
               FIND verify-name WHERE verify-name.rec-fld = RECID(DICTDB._Field) AND 
                      verify-name.prog-name = DICTDB._Field._Field-name NO-LOCK NO-ERROR.
	           if DefCons <> "" then DefCons = DefCons + ",~n" + comment_chars .
               DefCons = DefCons +  " CONSTRAINT " +  ConName  + " DEFAULT " +  replace(DICTDB._constraint._Con-Expr,"-","_")   
		       + " FOR  " +   verify-name.new-name. 
            END.
	   END.  /* IF DICTDB._constraint._con-type = "D" */
	   	   
       IF DICTDB._constraint._con-type = "C" THEN
	   DO:
	        if AllCons <> "" then AllCons = AllCons + ",~n" + comment_chars.
		    AllCons = AllCons +  " CONSTRAINT  " +  ConName  + " CHECK( " +  replace(DICTDB._constraint._Con-Expr,"-","_")  + ")" .
	   END.
	   
	   ASSIGN DICTDB._constraint._con-status = "M".
	   ASSIGN DICTDB._constraint._For-Name = ConName.
   
     END.  /*IF( DICTDB._Constraint._Con-Active = TRUE AND (DICTDB._constraint._con-status = "N" */   
    END.    /* for each DICTDB._constraint where DICTDB._constraint.DICTDB._file-recid */    

    IF dbtyp = "MSSQLSRV7" THEN DO:
        IF AllCons <> "" AND AllCons <> ? THEN
	    PUT STREAM code UNFORMATTED  " , ".  
        PUT STREAM code UNFORMATTED  AllCons. 
        IF DefC <> "" THEN DO:
          IF DefCons <> "" THEN DefCons = DefCons + ",~n" + comment_chars + DefC.
          ELSE DefCons = DefC.
        END.  
    END.
    
   END.   /* IF migConstraint*/

  /* 195067 ends.*/
  
  FOR EACH DICTDB._Index of DICTDB._File WHERE DICTDB._Index._Index-name BEGINS "sql-uniq":
    PUT STREAM code UNFORMATTED "," SKIP "  UNIQUE (".
    FOR EACH DICTDB._Index-field OF DICTDB._Index,DICTDB._Field OF DICTDB._Index-field
      BREAK BY DICTDB._Index-field._Index-seq:
        n2 = DICTDB._Field._Field-name.

        /* Avoid collisions with unrolled extents */

        ri = R-INDEX (n2, "#").
        IF ri > 2 AND ri < LENGTH (n2) THEN DO:
           IF INDEX ("0123456789", SUBSTR (n2, ri + 1, 1)) > 0 THEN DO:
              afldn = SUBSTR (n2, 1, R-INDEX (n2, "#") - 1).
              IF CAN-FIND (DICTDB._Field WHERE DICTDB._Field._Field-name = afldn) THEN DO:
                OVERLAY (n2, R-INDEX (n2, "#"), 1) = "_".
              END.
           END.
        END.

        IF xlat THEN DO:
           n2 = n2 + "," + idbtyp + "," + string (max_id_length).
           RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
        end.
        else if max_id_length <> 0 and length(n2) > max_id_length then 
            /*  need to truncate name  */
          n2 = substring(n2,1,max_id_length).

        PUT STREAM code UNFORMATTED n2 (IF LAST(_Index-seq) THEN ")" ELSE ",").
    END. /* end of each _index_field */
  END. /* FOR EACH DICTDB._Index of DICTDB._File WHERE DICTDB._Index._Index-name BEGINS "sql-uniq" */
  IF (dbtyp = "MS SQL Server" OR dbtyp = "MSSQLSRV7" ) THEN DO: 
    keyExist = CAN-FIND(FIRST DICTDB._CONSTRAINT WHERE 
                              DICTDB._CONSTRAINT._File-Recid = RECID (DICTDB._File) AND 
                              DICTDB._Constraint._Con-Active AND 
                             ( DICTDB._Constraint._Con-Type = "P" OR 
                               DICTDB._Constraint._Con-Type = "PC" OR 
                               DICTDB._Constraint._Con-Type = "MP" )
                       ). 

    FIND FIRST DICTDB._CONSTRAINT WHERE DICTDB._CONSTRAINT._File-Recid = RECID (DICTDB._File) AND
         DICTDB._Constraint._Con-Active AND DICTDB._Constraint._Con-Type = "M" NO-ERROR. 
    IF AVAILABLE DICTDB._CONSTRAINT THEN DO:
       FIND FIRST DICTDB._Index OF DICTDB._File 
                  WHERE RECID (DICTDB._Index) = DICTDB._CONSTRAINT._Index-recid AND 
                        DICTDB._Index._Unique <> TRUE NO-ERROR.
       IF AVAILABLE DICTDB._Index THEN ASSIGN NonUnikCC = TRUE.
       ASSIGN keyExist = TRUE
              CCExist  = TRUE.
    END.
    IF CAN-FIND (DICTDB._INDEX WHERE RECID (DICTDB._Index) = DICTDB._File._Prime-index
                    AND DICTDB._Index._Unique = TRUE ) THEN 
       ASSIGN pk_unique = TRUE.

    IF ((NUM-ENTRIES(user_env[27]) >= 3) AND (mssOptRowid EQ "U")) THEN  
       ASSIGN prowid_col = "PROGRESS_RECID_UNIQUE". 

    IF ( migConstraint AND keyExist) THEN ASSIGN uniqCompat = FALSE.
    ELSE IF (msstryp) THEN DO:
       IF CAN-FIND (DICTDB._INDEX WHERE RECID (DICTDB._Index) = DICTDB._File._Prime-index 
                      AND DICTDB._Index._Index-name = "default" ) THEN
          ASSIGN uniqCompat = FALSE.
       IF pk_unique THEN ASSIGN uniqCompat = FALSE. else ASSIGN uniqueness = " UNIQUE ".
       IF mssrecidCompat THEN ASSIGN uniqCompat = FALSE.
    END.
    ELSE DO:
        IF mssOptRowid EQ "U" THEN DO:
           FIND FIRST DICTDB._Index of DICTDB._File 
              WHERE  INDEX(DICTDB._Index._I-MISC2[1],"v") = 0 NO-ERROR.
           /* IF (AVAILABLE DICTDB._Index AND NOT mssrecidCompat ) THEN */
              IF (AVAILABLE DICTDB._Index ) THEN 
                 assign uniqCompat = FALSE.
           IF CAN-FIND (DICTDB._INDEX WHERE RECID (DICTDB._Index) = DICTDB._File._Prime-index 
                      AND DICTDB._Index._Index-name = "default" ) THEN
              ASSIGN uniqCompat = FALSE.
        END.
    END.
  END.
  
  IF compatible AND uniqCompat THEN DO: 
    IF dbtyp = "Informix" THEN  
      PUT STREAM code UNFORMATTED "," SKIP comment_chars "  " prowid_col " " user_env[14] " default null".      
    ELSE IF dbtyp = "MS SQL Server" OR dbtyp = "MSSQLSRV7" OR dbtyp = "SYBASE" THEN DO:
      IF ((NUM-ENTRIES(user_env[27]) < 2) OR (entry(2,user_env[27]) EQ "1")) THEN 
        PUT STREAM code UNFORMATTED "," SKIP comment_chars "  " prowid_col " bigint null". 
      ELSE IF entry(2,user_env[27]) EQ "2" THEN DO: 
        PUT STREAM code UNFORMATTED "," SKIP comment_chars "  "   prowid_col " AS  " skip comment_chars
               "      CASE WHEN " + prowid_col + "_ALT_" + " is null " skip comment_chars
               "        THEN  " + prowid_col + "_IDENT_ " skip comment_chars
               "        ELSE  " + prowid_col + "_ALT_   " skip comment_chars
               "      END PERSISTED not null". 
      END. /* END of entry(2,user_env[27]) EQ "2"  */
    END. /* END of dbtyp is MSS/SYBASE */

    ELSE IF dbtyp = "DB2" and db2type = "DB2/400"  THEN DO: 
             IF entry(2,user_env[27]) EQ "1" THEN
                 PUT STREAM code UNFORMATTED "," SKIP comment_chars "  " prowid_col " bigint  " skip  
                      "  GENERATED ALWAYS AS IDENTITY " skip
                      "  (START WITH 1 INCREMENT BY 1 " skip
                      "  NO MINVALUE "                  skip
                      "  MAXVALUE 9223372036854775807 " skip
                      "  NO ORDER "                     skip
                      "  CACHE 20)" .
            ELSE IF entry(2,user_env[27]) EQ "2"   THEN DO: 
             /* OE00177721- Find tables without unique key- If no unique key, create RECID column */
             FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Unique = TRUE NO-ERROR.
             IF AVAILABLE DICTDB._Index THEN ASSIGN unique_idx_flag = TRUE.
             ELSE 
                 PUT STREAM code UNFORMATTED "," SKIP comment_chars "  " prowid_col " bigint  " skip  
                      "  GENERATED ALWAYS AS IDENTITY " skip
                      "  (START WITH 1 INCREMENT BY 1 " skip
                      "  NO MINVALUE "                  skip
                      "  MAXVALUE 9223372036854775807 " skip
                      "  NO ORDER "                     skip
                      "  CACHE 20)" .
             END. /* END of entry(2,user_env[27]) EQ "2"  */
    END. /* END of dbtyp = DB2 */
    ELSE
      PUT STREAM code UNFORMATTED "," SKIP comment_chars "  " prowid_col " " user_env[14] " null". 
      
    IF dbtyp = "MS SQL Server" OR dbtyp = "MSSQLSRV7" OR dbtyp = "SYBASE" THEN DO:  
      PUT STREAM code UNFORMATTED "," SKIP.
      PUT STREAM code UNFORMATTED comment_chars "  " prowid_col "_IDENT_ bigint identity".

      IF (NUM-ENTRIES(user_env[27]) >= 2) AND (entry(2,user_env[27]) EQ "2")   THEN DO :
        PUT STREAM code UNFORMATTED "," SKIP.
        PUT STREAM code UNFORMATTED comment_chars "  " prowid_col "_ALT_ bigint NULL default NULL".
        PUT STREAM code UNFORMATTED "," SKIP.

        /* unique constraint name */
        ASSIGN n2 = prowid_col.
        IF user_env[6] = "Y" THEN 
          n2 = n1 + unik + n2. 

        IF xlat THEN DO:
           if max_idx_len <> 0 and length(n2) > max_idx_len then 
                 ASSIGN trunc_name = TRUE.
           n2 = n2 + "," + idbtyp + "," + string (max_idx_len).
           RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
        END.
        IF mssOptRowid EQ "P" AND NOT keyCreated THEN DO:
           PUT STREAM code UNFORMATTED comment_chars "  CONSTRAINT "
               n2 " PRIMARY KEY (" prowid_col ")".
           Assign keyCreated = TRUE
                  PKCreated  = TRUE.
        END.
        ELSE
           PUT STREAM code UNFORMATTED comment_chars "  CONSTRAINT "
              n2 " UNIQUE (" prowid_col ")".
      END. /* END of entry(2,user_env[27]) EQ "2"  */

    END.
  END.  
  
  PUT STREAM code UNFORMATTED SKIP comment_chars ")".

  IF skptrm THEN 
     PUT STREAM code UNFORMATTED SKIP.
  IF dbtyp = "ORACLE" AND user_env[34] <> ? AND user_env[34] <> "" THEN 
     PUT STREAM code UNFORMATTED SKIP comment_chars "TABLESPACE " user_env[34].
     
  PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.

  pindex = "".

  /* If this is sybase or MS SQL Server, we must add an insert trigger to set 
     the value of the progress_recid and fill out any case insensitive 
     shadow columns.
  */ 
  IF (dbtyp = "SYBASE" OR dbtyp = "MS SQL Server") and uniqCompat and compatible  THEN DO:
    n2 = "_TI_" + n1.
    
    PUT STREAM code UNFORMATTED
      comment_chars " "  skip    
      comment_chars "create trigger " n2 " ON " n1 " for insert as" SKIP
      comment_chars "begin" SKIP
      comment_chars "    if  ( select max(inserted." prowid_col ") from inserted) is NULL" SKIP
      comment_chars "    begin" SKIP
      comment_chars "        update " n1 " set " prowid_col " = @@identity " SKIP
      comment_chars "               where " prowid_col " is NULL" skip
      comment_chars "        select convert (bigint, @@identity)" SKIP
      comment_chars "    end" SKIP.    
      
    /* end the insert trigger's code */
    PUT STREAM code UNFORMATTED comment_chars "end".

    IF skptrm THEN
      PUT STREAM code UNFORMATTED SKIP.
    PUT STREAM code UNFORMATTED  comment_chars user_env[5] SKIP.
  END.
  ELSE  IF dbtyp = "MSSQLSRV7" and compatible and uniqCompat and (entry(2,user_env[27]) EQ "1") THEN DO:
    n2 = "_TI_" + n1.
    
    PUT STREAM code UNFORMATTED
      comment_chars " "  skip    
      comment_chars "create trigger " n2 " ON " n1 " for insert as" SKIP
      comment_chars " RAISERROR ('PSC-init',0,1) " SKIP    
      comment_chars " SET XACT_ABORT ON " SKIP    
      comment_chars " SET LOCK_TIMEOUT -1 " SKIP    
      comment_chars "    if  ( select " prowid_col " from inserted) is NULL" SKIP
      comment_chars "    begin" SKIP
      comment_chars "        update t set " prowid_col " = i.IDENTITYCOL " SKIP
      comment_chars "         from " n1 " t  JOIN inserted i ON " skip
      comment_chars "         t." prowid_col "_IDENT_ = i." prowid_col "_IDENT_" SKIP
      comment_chars "        select convert (bigint, @@identity)" SKIP
      comment_chars "    end" SKIP    
      comment_chars " SET XACT_ABORT OFF " SKIP    
      comment_chars " RAISERROR ('PSC-end',0,1) " SKIP.    

    IF skptrm THEN
      PUT STREAM code UNFORMATTED SKIP.
    PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
    PUT STREAM code UNFORMATTED 
      comment_chars "sp_settriggerorder @triggername = '" n2 "', " SKIP
      comment_chars "       @order='first', @stmttype = 'INSERT' " SKIP.
    PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
  END. /* dbtyp = "SYBASE" OR "MS SQL Server" and compatible */

  IF user_env[3] <> "" THEN DO:
    OUTPUT STREAM code CLOSE.
    OUTPUT STREAM code TO VALUE(user_env[3]) NO-ECHO APPEND NO-MAP.
  END.

  /* Create unique progress_recid index */
  IF  compatible AND uniqCompat THEN DO:
    IF dbtyp = "ORACLE"  THEN DO:
      IF LENGTH(n1) < 15 THEN
        ASSIGN n2 = n1 + unik + prowid_col.
      ELSE
        ASSIGN n2 = n1.  
    END.
    ELSE DO:  
      ASSIGN n2 = prowid_col.
      IF user_env[6] = "Y" THEN n2 = n1 + unik + n2. /* unique index names */
      IF xlat THEN DO:
         if max_idx_len <> 0 and length(n2) > max_idx_len then 
               ASSIGN trunc_name = TRUE.
         n2 = n2 + "," + idbtyp + "," + string (max_idx_len).
         RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
      END.
    END.
    IF dbtyp = "MSSQLSRV7" THEN DO:
      IF (entry(2,user_env[27]) EQ "1") THEN DO:
        IF mssOptRowid EQ "P" AND NOT keyCreated THEN DO:
           /* clustered index statement code */
           PUT STREAM code UNFORMATTED comment_chars 
               "CREATE UNIQUE CLUSTERED INDEX " n2 SKIP.
           PUT STREAM code UNFORMATTED comment_chars 
               " ON " n1 " (" prowid_col ")".
           Assign keyCreated = TRUE
                  CcCreated  = TRUE.
        END.
        ELSE 
            PUT STREAM code UNFORMATTED comment_chars "CREATE INDEX "
                n2 " ON " n1 " (" prowid_col ")".
       
        ASSIGN n2 = n2 + "_ident_".
        PUT STREAM code UNFORMATTED SKIP .
        PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
        PUT STREAM code UNFORMATTED comment_chars "CREATE UNIQUE INDEX "
              n2 " ON " n1 " (" prowid_col "_IDENT_ )".
      END.
    END.
    ELSE IF dbtyp = "DB2" AND db2type = "DB2/400"  THEN DO: 
        IF NOT unique_idx_flag THEN
           PUT STREAM code UNFORMATTED comment_chars "CREATE UNIQUE INDEX "
             user_library dot n2 " ON " user_library dot n1 " (" prowid_col ")". /* OE00189366 */
        ELSE .
    END. 
    ELSE 
       PUT STREAM code UNFORMATTED comment_chars "CREATE UNIQUE INDEX "
              n2 " ON " n1 " (" prowid_col ")".
  
    IF skptrm THEN
        PUT STREAM code UNFORMATTED SKIP comment_chars.
        
    IF dbtyp = "ORACLE" AND user_env[35] <> ? AND user_env[35] <> "" THEN
      PUT STREAM code UNFORMATTED SKIP comment_chars "TABLESPACE " user_env[35].

    IF (dbtyp = "MSSQLSRV7") THEN DO:
      IF ((NUM-ENTRIES(user_env[27]) < 2) OR (entry(2,user_env[27]) EQ "1")) then 
        PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
    END.
    ELSE 
        PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
  END.

  _idxloop:
  FOR EACH DICTDB._Index OF DICTDB._File
    WHERE NOT DICTDB._Index._Index-name BEGINS "sql-"
      AND NOT DICTDB._Index._Index-name = "default": /* eliminate empty idxs */
     
    /* re-initialize */
    ASSIGN mandatory = TRUE 
           uniqueness = "".
    n2 = DICTDB._Index._Index-name.
    uniqfyIdx = uniqCompat.
    IF INDEX(DICTDB._Index._I-MISC2[1],"c") <> 0 THEN assign idxrecidcompat = TRUE.
    
    if DICTDB._Index._Wordidx = 1 then do:
      PUT STREAM logfile UNFORMATTED 
         "++ " skip 
         "WARNING: INDEX " n2 " not created." skip 
          " " skip
          "         Cannot create index " n2 " because it is a " skip
          "         WORD index. " skip
          "-- " skip.
         ASSIGN comment_chars = user_env[31]
                warnings_issued = true.
       NEXT  _idxloop.  
    END.
    trunc_name = FALSE.

    IF xlat THEN DO:
       if max_idx_len <> 0 and length(n2) > max_idx_len then 
                trunc_name = TRUE.
       n2 = n2 + "," + idbtyp + "," + string (max_idx_len).
       RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
    end.
    else if max_idx_len <> 0 and  length(n2) > max_idx_len then 
          /*  need to truncate name  */
       ASSIGN n2 = substring(n2,1,max_idx_len)
              trunc_name = TRUE.
 
    /* 
        Check that the index name is not longer than the max, and if 
        so then fix it.  First we check if n2 + unik, are under the max, 
        and if so we add them to a substring of n1, otherwise we 
        widdle n2 down in a repeat loop, and then concatinate the 
        smaller n2 with a substring of n1 and the unik.
        ***  There is a problem here, because the fixup will not find
                and index with this name
    */ 

    IF user_env[6] = "Y" THEN DO:    /* need unique names, so create/check len*/
      IF max_idx_len > 0 THEN DO:    /* We have a max len so check it */
        IF LENGTH(n1) + LENGTH(n2) + LENGTH(unik) > max_idx_len THEN DO:
          IF LENGTH(n2) + LENGTH(unik) < max_idx_len THEN  /* easy way */
             ASSIGN n2 = SUBSTRING(n1,1,max_idx_len - LENGTH(n2) - LENGTH(unik)) + unik + n2
                    trunc_name = TRUE.               
          
          ELSE DO:  /* Then, we have to knock some chars off of n2 as well */
            REPEAT:
              n2 =  SUBSTRING (n2,1, LENGTH(n2) - 1).       
              IF LENGTH(n2) + LENGTH(unik) < max_idx_len THEN
              LEAVE.   /* This what we want */
            END.  
            ASSIGN n2 = SUBSTRING(n1,1,max_idx_len - LENGTH(n2) - LENGTH(unik)) + unik + n2
                   trunc_name = TRUE.              
          END.  
        END. /* Done with length checking */
        ELSE  /*string was okay in the first place */
          ASSIGN n2 = n1 + unik + n2. 
      END. 
      ELSE  /* No need to check for length */
        ASSIGN n2 = n1 + unik + n2.         
    END.  
  
    FIND FIRST verify-index WHERE verify-index.new-name = n2 NO-ERROR.
    IF NOT AVAILABLE verify-index THEN DO:
      CREATE verify-index.
      ASSIGN verify-index.new-name = n2.
    END.
    ELSE DO:
      DO WHILE AVAILABLE verify-index:
        ASSIGN n2 = SUBSTRING(n2, 1, (length(n2) - 1)).
        FIND FIRST verify-index WHERE verify-index.new-name = n2 NO-ERROR.  
      END.
      CREATE verify-index.
      ASSIGN verify-index.new-name = n2
             trunc_name = TRUE.
    END.
 
    if trunc_name then do:
      put stream logfile unformatted 
        "WARNING: Index name too long. Name truncated to " max_idx_len skip
        "         characters.  New index name = " n2 skip(2).
        warnings_issued = true.
    END. 

    /* Index block:
     **
     **     This block contains all appropriate index validation for 
     **     creation of indexes in the foreign data manager. */ 
    _Index_Block: 
    DO: 

      /* Make sure we check indexes.  If we run across an invalid index we 
       * can stop further index checking by setting this variable to false. 
     */
      
      ASSIGN index_checking = true. 

      IF NOT comment_all_objects THEN comment_chars = "". 
 
     /* Do not allow descending indexes with Sybase or MS SQL Server 6.  
        It doesn't do them so we shouldn't create them.
     */
     IF (dbtyp = "SYBASE" OR dbtyp = "MS SQL Server" OR 
        (dbtyp = "MSSQLSRV7" and user_env[34] = "n")) AND index_checking THEN DO: 
       FIND FIRST DICTDB._Index-field of DICTDB._Index
           WHERE NOT DICTDB._Index-field._Ascending NO-ERROR.
       IF AVAILABLE(DICTDB._Index-field) THEN DO:
          FIND FIRST DICTDB._Field
               WHERE RECID(DICTDB._Field) = DICTDB._Index-Field._Field-recid.
         
           PUT STREAM logfile UNFORMATTED 
             "++ " skip 
             "WARNING: INDEX " n2 " not created." skip
             " " skip
             "         Cannot create index " n2 " because it contains " skip
             "         a decending component " DICTDB._Field._Field-name "." SKIP
             "-- " skip.
             
           ASSIGN comment_chars = user_env[31]
                  warnings_issued = true
                  index_checking = false. 
       END. 
     END. 


      /* Don't allow indexes with text or long / clob datatypes */ 
      if index_checking then do: 
        ASSIGN maxidxcollen = 0.
        for each DICTDB._Index-field of DICTDB._Index, 
            each DICTDB._Field of DICTDB._Index-field where DICTDB._Field._Data-Type = "character": 

            lngth = LENGTH(DICTDB._Field._format, "character").  
           
            if index(DICTDB._Field._Format, "(") > 1 THEN DO:
               left_paren = INDEX(DICTDB._Field._Format, "(").
               right_paren = INDEX(DICTDB._Field._Format, ")").
               lngth = right_paren - (left_paren + 1).
               assign j = INTEGER(SUBSTRING(DICTDB._Field._Format, left_paren + 1, lngth)).  
            END.  
            else
              j = lngth.
            IF DICTDB._Field._Decimals > 0 THEN j = DICTDB._Field._Decimals.
                  
            IF j > 255 AND (dbtyp = "SYBASE" or dbtyp = "MS SQL Server") THEN DO:  
              PUT STREAM logfile UNFORMATTED
                   "++ " skip 
                   "WARNING: INDEX " n2 " not created." skip
                   " " skip 
                   "         Cannot create index " n2 " because it contains " skip
                   "         column " DICTDB._Field._Field-name " which cannot be ".

              PUT STREAM logfile UNFORMATTED
                       " indexed by SQL Server" skip
                       "         because it has data type text." skip. 
              PUT STREAM logfile UNFORMATTED
                   "-- " skip.
              ASSIGN comment_chars = user_env[31]
                      warnings_issued = true
                      index_checking = false.
              
            END.       
            ELSE IF j > 900 AND dbtyp = "MSSQLSRV7" THEN DO:  
              PUT STREAM logfile UNFORMATTED
                   "++ " skip 
                   "WARNING: INDEX " n2 " not created." skip
                   " " skip 
                   "         Cannot create index " n2 " because it contains " skip
                   "         column " DICTDB._Field._Field-name " which cannot be ".

              PUT STREAM logfile UNFORMATTED
                       " indexed by MS SQL Server 7" skip
                       "         because it has data type text." skip. 
              PUT STREAM logfile UNFORMATTED
                   "-- " skip.
              ASSIGN comment_chars = user_env[31]
                      warnings_issued = true
                      index_checking = false.
              
            END.       
            ELSE IF dbtyp = "ORACLE" AND j > longwid /*4000*/ then DO:  
              PUT STREAM logfile UNFORMATTED
                   "++ " skip 
                   "WARNING: INDEX " n2 " not created." skip
                   " " skip 
                   "         Cannot create index " n2 " because it contains " skip
                   "         column " DICTDB._Field._Field-name " which cannot be ".
              PUT STREAM logfile UNFORMATTED
                       " indexed by Oracle" skip
                       "         because it has data type " user_env[18] /*" long"*/ "." skip. 

              PUT STREAM logfile UNFORMATTED
                   "-- " skip.
              ASSIGN comment_chars = user_env[31]
                      warnings_issued = true
                      index_checking = false.
               
            END.  /* end of longwid (formely 4000) */ 
            IF dbtyp = "MSSQLSRV7" THEN 
                ASSIGN maxidxcollen = maxidxcollen + j.
        end. /* end of for each */ 
        IF dbtyp = "MSSQLSRV7" AND maxidxcollen > 900 THEN DO:
           PUT STREAM logfile UNFORMATTED "++ " SKIP 
             "WARNING: INDEX " n2 " not created." skip
             " " skip 
             "         Cannot create index " n2 " because it's length is greater than 900. " SKIP
             "-- " skip.

            ASSIGN comment_chars = user_env[31]
                   warnings_issued = true
                   index_checking = false.
             
          END.       
      end. /* end of text and long dbtyp test */ 


      IF DICTDB._File._Prime-index = RECID (DICTDB._Index) THEN
         pindex = comment_chars + "sp_primarykey " + n1.
      
      /* Primary key code */
      IF DICTDB._File._Prime-index = RECID (DICTDB._Index) AND msstryp
      THEN DO:  
         Assign userPKexist = TRUE.
         FOR EACH DICTDB._Index-field OF DICTDB._Index,
                DICTDB._Field OF DICTDB._Index-field:
          FOR EACH DICTDB._Field WHERE RECID(DICTDB._Field)  = DICTDB._Index-field._Field-Recid:
               FIND verify-name WHERE verify-name.rec-fld = RECID(DICTDB._Field) AND 
                                      verify-name.prog-name = DICTDB._Field._Field-name NO-LOCK NO-ERROR.
               IF FieldList <> "" THEN ASSIGN FieldList = FieldList + ", ".
                  FieldList = FieldList + verify-name.new-name.
               IF NOT DICTDB._Field._Mandatory THEN ASSIGN mandatory = FALSE.
           END.
         END.
         IF NOT keyCreated AND ((migConstraint = FALSE) OR (migConstraint AND NOT keyExist)) THEN DO:
            RUN createKey.
            if keyCreated THEN NEXT  _idxloop.
         END.
      END.
      assign n3 = DICTDB._Index._I-MISC2[1].
      IF (INDEX(n3,"v") = 0 OR mssrecidCompat OR INDEX(n3,"r") = 0) AND mssOptRowid EQ "U" THEN assign uniqfyIdx = FALSE. 
IF dbtyp = "MSSQLSRV7" AND useNewRanking AND NOT KeyCreated AND 
   n3 begins "r" AND INDEX(n3,"n") = 0 AND NOT ( migConstraint AND   
         CAN-FIND (FIRST DICTDB._constraint WHERE DICTDB._Constraint._File-Recid = RECID(DICTDB._File)
                    AND DICTDB._Constraint._Con-Active = TRUE 
                    AND ( DICTDB._Constraint._Con-Type = "M" OR DICTDB._Constraint._Con-Type = "P"
                          OR DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP"
                          OR DICTDB._Constraint._Con-Type = "M" ) 
                  )
       )
THEN DO:

      IF INDEX(n3,"m") <> 0 OR 
        (INDEX(n3,"v") <> 0 AND ((NUM-ENTRIES(user_env[27]) >= 2) AND (entry(2,user_env[27]) EQ "1"))) 
      THEN DO:
         IF ((migConstraint AND CcExist ) OR NOT migConstraint ) AND NOT CcCreated THEN
            n5 = " CLUSTERED ".
         ELSE n5 = "".
         IF INDEX(n3,"v") <> 0 OR DICTDB._Index._Unique THEN n4 = " UNIQUE". ELSE n4 = "".
         PUT STREAM code UNFORMATTED
             comment_chars "CREATE" n4
             n5 " INDEX " user_library dot n2 " ON " user_library dot n1 " (".
         ASSIGN keyCreated = TRUE.
         IF n5 <> "" THEN CcCreated = TRUE.
      END.
      ELSE DO:
        IF NOT PKCreated THEN DO:
         /* Generate Alter table add PK constraint */
         IF migConstraint AND NonUnikCC THEN n5 = " NONCLUSTERED".
         ELSE n5 = "".
         n4 = user_library + dot + "PKCI_" + n2.
         PUT STREAM code UNFORMATTED comment_chars "ALTER TABLE " user_library dot n1 " ADD CONSTRAINT "
                         n4 " PRIMARY KEY" n5 "(".
         ASSIGN PKCreated = TRUE.
                keyCreated = TRUE.
        END.
        ELSE PUT STREAM code UNFORMATTED
             comment_chars "CREATE" (IF DICTDB._Index._Unique THEN " UNIQUE" ELSE "")
             " INDEX " user_library dot n2 " ON " user_library dot n1 " (".
      END.

END.
ELSE DO:
      IF (uniqueindx eq "1") 
      THEN DO:
        IF migConstraint AND CAN-FIND (FIRST DICTDB._constraint WHERE DICTDB._Constraint._Index-Recid = RECID(DICTDB._Index)
               AND DICTDB._Constraint._Con-Active = TRUE AND DICTDB._Constraint._Con-Type = "M") AND dbtyp = "MSSQLSRV7" 
        THEN DO:
          Assign uniqueness = "".
          IF DICTDB._Index._Unique THEN 
             uniqueness = " UNIQUE ". 
          PUT STREAM code UNFORMATTED
              comment_chars "CREATE " uniqueness
              " CLUSTERED INDEX " user_library dot n2 " ON " user_library dot n1 " (".
          CcCreated = TRUE.
        END. 
        ELSE DO:
           IF n3 <> ? AND INDEX(n3,"p") <> 0 AND NOT PKCreated THEN  DO:
              n4 = user_library + dot + "PKCI_" + n2.
              PUT STREAM code UNFORMATTED
                  comment_chars "ALTER TABLE " user_library dot n1 SKIP.
              PUT STREAM code UNFORMATTED
                  comment_chars "ADD CONSTRAINT " n4 " PRIMARY KEY NONCLUSTERED (".
              ASSIGN PKCreated = TRUE.
           END.
           ELSE PUT STREAM code UNFORMATTED
              comment_chars "CREATE" (IF DICTDB._Index._Unique THEN " UNIQUE" ELSE "")
              " INDEX " user_library dot n2 " ON " user_library dot n1 " (".
        END.
      END. /* IF (uniqueindx eq "1") */
      ELSE DO:
        IF DICTDB._Index._Unique THEN DO:
           FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = RECID(DICTDB._Index) 
              AND DICTDB._Constraint._Con-Active = TRUE AND (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC" OR
              DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "M" OR DICTDB._Constraint._Con-Type = "U" )NO-LOCK NO-ERROR.
           IF AVAILABLE (DICTDB._Constraint)  AND migConstraint
           THEN DO:
            IF DICTDB._Constraint._Con-Type = "M" THEN DO:
             PUT STREAM code UNFORMATTED
             comment_chars "CREATE UNIQUE CLUSTERED INDEX " user_library dot n2 " ON " user_library dot n1 " (".
             CcCreated = TRUE.
            END.
            ELSE PUT STREAM code UNFORMATTED
             comment_chars "CREATE UNIQUE INDEX " user_library dot n2 " ON " user_library dot n1 " (".
           END.
           ELSE DO: 
             ASSIGN flag = FALSE.
             IF dbtyp = "ORACLE" THEN DO:
                     FOR EACH DICTDB._Index-field OF DICTDB._Index,
                         DICTDB._Field OF DICTDB._Index-field 
                         BREAK BY DICTDB._Index-field._Index-seq:
                       
                       IF DICTDB._Field._Dtype = 1 THEN ASSIGN flag = TRUE.                        
                     END.
                 IF flag THEN PUT STREAM code UNFORMATTED
                           comment_chars "CREATE UNIQUE INDEX " user_library dot n2 " ON " user_library dot n1 " (".
                 ELSE   
                     PUT STREAM code UNFORMATTED comment_chars "ALTER TABLE " user_library dot n1 " ADD CONSTRAINT "
                            user_library dot n2 " UNIQUE (".        
             END.
             ELSE DO:         
             PUT STREAM code UNFORMATTED
             comment_chars "ALTER TABLE " user_library dot n1 " ADD CONSTRAINT "
             user_library dot n2 " UNIQUE (".
             END.
           END.
        END.
        ELSE DO:
        IF migConstraint AND CAN-FIND (FIRST DICTDB._constraint WHERE DICTDB._Constraint._Index-Recid = RECID(DICTDB._Index) 
             AND DICTDB._Constraint._Con-Active = TRUE AND DICTDB._Constraint._Con-Type = "M") AND dbtyp = "MSSQLSRV7" THEN DO:         
             Assign uniqueness = "".
             IF (NonUnikCC AND ((NUM-ENTRIES(user_env[27]) >= 3) AND (mssOptRowid EQ "U"))) THEN 
                      uniqueness = " UNIQUE ".
             PUT STREAM code UNFORMATTED
               comment_chars "CREATE" uniqueness
               "CLUSTERED INDEX " user_library dot n2 " ON " user_library dot n1 " (".
             CcCreated = TRUE.
        END.
        ELSE     
          PUT STREAM code UNFORMATTED
              comment_chars "CREATE INDEX " user_library dot n2 " ON " user_library dot n1 " (".
        END.
      END.      
END. 
      FOR EACH DICTDB._Index-field OF DICTDB._Index,
             DICTDB._Field OF DICTDB._Index-field 
             BREAK BY DICTDB._Index-field._Index-seq:
        n2 = DICTDB._Field._Field-name.

        /* Avoid collisions with unrolled extents */

        ri = R-INDEX (n2, "#").
        IF ri > 2 AND ri < LENGTH (n2) THEN DO:
           IF INDEX ("0123456789", SUBSTR (n2, ri + 1, 1)) > 0 THEN DO:
              afldn = SUBSTR (n2, 1, R-INDEX (n2, "#") - 1).
              IF CAN-FIND (DICTDB._Field WHERE DICTDB._Field._Field-name = afldn) THEN DO:
                 OVERLAY (n2, R-INDEX (n2, "#"), 1) = "_".
              END.
          END.
        END.

        IF xlat THEN DO:
          FIND FIRST verify-name WHERE verify-name.prog-name = DICTDB._Field._Field-name.
          IF AVAILABLE verify-name THEN
            ASSIGN n2 = verify-name.new-name.
          ELSE DO:          
            n2 = n2 + "," + idbtyp + "," + string (max_id_length).
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n2).
          END.
        end.
        else if max_id_length <> 0 and length(n2) > max_id_length then 
               /*  need to truncate name  */
               n2 = substring(n2,1,max_id_length).
        
        IF (dbtyp = "SYBASE" OR dbtyp = "MS SQL Server" OR dbtyp = "MSSQLSRV7") THEN DO:
          IF LOOKUP(n2, uc_col) > 0 THEN 
              ASSIGN n2 = "_S#_" + n2. 
        END.
        ELSE     
          IF LOOKUP(n2, uc_col) > 0 THEN 
             ASSIGN n2 = "U" + unik + n2.
          
        IF dbtyp = "ORACLE" THEN DO:
        
        IF NOT shadow AND DICTDB._Field._Dtype = 1  /*AND longwid = 4000*/ AND NOT DICTDB._Field._fld-case THEN DO:
	         IF  nls_upp = "y" and ora_lang NE "BINARY" then DO:
		     ASSIGN  
 		          n2 = "NLS_UPPER(" + n2 + "," + "'NLS_SORT = " + ora_lang + " ')". 
 		          nlsflag = true.  				
            END.
 		    ELSE   
            ASSIGN n2 = "upper(" + n2 + ") ".
        END.
	    IF dbtyp = "ORACLE" THEN DO:
           IF NOT shadow AND DICTDB._Field._Dtype = 1  /*AND longwid = 4000*/ AND  DICTDB._Field._fld-case THEN DO:
	         IF  nls_upp = "y" and ora_lang NE "BINARY" then DO:
		    ASSIGN
		          n2 = "NLSSORT(" + n2 + "," + "'NLS_SORT = " + ora_lang + " ')". 
             END.
           END.
        END.
            IF NOT DICTDB._Index-field._Ascending THEN
                ASSIGN n2 = n2 + " DESC".
        END.
        IF dbtyp = "MSSQLSRV7" AND user_env[34] = "y" THEN DO:
           IF NOT DICTDB._Index-field._Ascending THEN
                ASSIGN n2 = n2 + " DESC".
        END.
        IF DICTDB._Field._For-type = "TIME" THEN 
           assign n2 = "".

        else IF DICTDB._File._Prime-index = RECID (DICTDB._Index)
          THEN pindex = pindex + ", " + n2.

        
           

        PUT STREAM code UNFORMATTED n2.
        IF LAST(_Index-seq) THEN DO:
          IF DICTDB._Index._Unique 
             or dbtyp = "PROGRESS"   
             or not compatible       /* progress_recid not available in PROGRESS */ 
             or (dbtyp = "DB2" and db2type = "DB2/400" and
                 entry(2,user_env[27]) EQ "2" and unique_idx_flag) THEN 
                PUT STREAM code UNFORMATTED ")".     
                                                     /* hutegger 94/06 */
          ELSE IF compatible THEN DO:
             IF DICTDB._File._Prime-index = RECID (DICTDB._Index) THEN
                pindex = pindex + ", " + prowid_col.
           IF uniqfyIdx THEN
             PUT STREAM code UNFORMATTED ", " prowid_col ")".
           ELSE PUT STREAM code UNFORMATTED ")". 
          END. /* compatible */ 
        END. /* last (_Index-seq) */
        ELSE
        PUT STREAM code UNFORMATTED ", ".
      END. /* for each DICTDB._index-field  */ 
      IF skptrm THEN
         PUT STREAM code UNFORMATTED SKIP comment_chars.
      IF dbtyp = "ORACLE" AND user_env[35] <> ? AND user_env[35] <> "" THEN
         PUT STREAM code UNFORMATTED SKIP comment_chars "TABLESPACE " user_env[35].         
      PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
    END.  /* Index Block */ 

  END.  /* _idxloop */

  IF user_env[3] <> "" THEN DO:
    OUTPUT STREAM code CLOSE.
    OUTPUT STREAM code TO VALUE(user_env[2]) NO-ECHO APPEND NO-MAP.
  END.
  /* re-initialize */
  ASSIGN pk_unique = FALSE
         userPKexist = FALSE
         keyCreated = FALSE
         PKCreated  = FALSE
         CcCreated  = FALSE
         FieldList  = ""
         keyExist   = FALSE
         NonUnikCC  = FALSE
         CcExist    = FALSE
         uniqCompat = TRUE.


     /* 195067 begins */
    IF AllCons <> "" and dbtyp = "ORACLE" THEN
    DO:
        PUT STREAM code UNFORMATTED comment_chars "ALTER TABLE " + user_library dot n1  +  " ADD (" +  AllCons + ")" skip.
	    PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
    END.
    IF DefCons <> "" and (dbtyp = "MSSQLSRV7") THEN
	DO:
	    PUT STREAM code UNFORMATTED comment_chars "ALTER TABLE " +  user_library dot n1  +  " ADD " +  DefCons skip.
	    PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
	END.
	
/* 195067 ends */

  /* Clear temp table for new file */                            
  FOR EACH verify-name: 
    CREATE verify-field.
    ASSIGN verify-field.new-name  = verify-name.new-name
           verify-field.prog-name = verify-name.prog-name
           verify-field.rec-fld   = verify-name.rec-fld.
     DELETE verify-name.
  END. 
  
END. /* for each DICTDB._File */

/************************************************/
/****** loop2 for creating foreign constraints***/
/************************************************/

IF migConstraint and (dbtyp = "MSSQLSRV7" OR dbtyp = "ORACLE")
THEN DO:
_fileloop2:
FOR EACH DICTDB._File  WHERE DICTDB._File._Db-recid = drec_db
                         AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                         AND (IF user_env[1] = "ALL"  THEN 
                              NOT DICTDB._File._Hidden AND 
                             (CAN-DO(_File._Can-read, user_env[9]) OR user_env[9] = "ALL")
                               ELSE
                                  DICTDB._File._File-name = user_filename
                              ):
                                                            
IF DICTDB._File._Db-lang > 0 THEN NEXT _fileloop2.
            
  FOR EACH DICTDB._constraint where DICTDB._constraint._file-recid =  recid(DICTDB._File) exclusive-lock:
  IF( DICTDB._Constraint._Con-Active = TRUE AND (DICTDB._constraint._con-status = "N" OR DICTDB._constraint._con-status = "C" 
	                                                                             OR DICTDB._constraint._con-status = "M"))
  THEN DO:
    IF DICTDB._constraint._con-type  = "F" THEN
	DO:
	  ASSIGN AllCons = "".
	  FIND first DICTDB._INDEX of DICTDB._constraint NO-LOCK NO-ERROR.
      ASSIGN AllConsFields = ""
             ConType = DICTDB._constraint._con-type
             ConName = DICTDB._constraint._con-name.


        FOR each DICTDB._INDEX-Field of DICTDB._INDEX NO-LOCK,
	           first DICTDB._Field of DICTDB._INDEX-Field no-lock:
	             FIND verify-field WHERE verify-field.rec-fld = RECID(DICTDB._Field) AND 
                   verify-field.prog-name = DICTDB._Field._Field-name NO-LOCK NO-ERROR.
               IF AllConsFields <> "" THEN 
               AllConsFields = AllConsFields + "," .
               Assign AllConsFields = AllConsFields + verify-field.new-name.               
        END. /* FOR each DICTDB._INDEX-Field of DICTDB._INDEX NO-LOCK, */
          
       
	  trunc_name = FALSE.
      IF xlat THEN DO:
         if max_con_length <> 0 and length(ConName) > max_con_length
         then do:
           /*  _resxlat will truncate name  */
           put stream logfile unformatted
              "WARNING: Field name " ConName " is longer than the maximum " skip
              "         legal identifier length of " max_id_length "." skip.
             trunc_name = TRUE.
         end.
         ConName = ConName + "," + idbtyp + "," + string (max_con_length).
         RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT ConName).
      END.
      ELSE if max_con_length <> 0 and  length(ConName) > max_con_length THEN
          /*  need to truncate name  */
               ASSIGN ConName = substring(ConName,1,max_con_length)
              trunc_name = TRUE.
   
      _verify-con-name:
      DO WHILE TRUE:
         FIND verify-name WHERE verify-name.new-name = ConName NO-ERROR.
         IF NOT AVAILABLE verify-name
         THEN DO:
           CREATE verify-name.
           ASSIGN verify-name.new-name = ConName.
           LEAVE _verify-con-name.
        END.
        ELSE DO:
          DO a = 1 TO 999:
            ASSIGN ConName = SUBSTRING(ConName, 1, LENGTH(ConName) - LENGTH(STRING(a))) + STRING(a).
            IF CAN-FIND(verify-name WHERE verify-name.new-name = ConName) THEN NEXT.
            IF CAN-FIND(verify-table WHERE verify-name.new-name = ConName) THEN NEXT.
            IF CAN-FIND(verify-index WHERE verify-name.new-name = ConName) THEN NEXT.            
            ELSE DO:
               CREATE verify-name.
               ASSIGN verify-name.new-name = ConName.
               LEAVE _verify-con-name.
            END.
          END.
        END.    
      END.  
	        
      FIND FIRST buff-Index WHERE RECID(buff-Index) = DICTDB._constraint._Index-parent-recid NO-LOCK NO-ERROR.
	  IF AVAIL(buff-Index) 
	  THEN DO:
		   FIND FIRST buff-file where recid(buff-file) = buff-Index._file-recid no-lock no-error.
      END.
		AllForeignFields = "".
		FOR each DICTDB._INDEX-Field of buff-Index NO-LOCK,
	        first DICTDB._Field of DICTDB._INDEX-Field no-lock:
	         FIND verify-field WHERE verify-field.rec-fld = RECID(DICTDB._Field) AND 
                   verify-field.prog-name = DICTDB._Field._Field-name NO-LOCK NO-ERROR.	        
            IF AllForeignFields <> "" THEN 
               AllForeignFields = AllForeignFields + "," .
                       
               Assign AllForeignFields =  AllForeignFields  + verify-field.new-name.
        END. /* FOR each DICTDB._INDEX-Field of buff-Index NO-LOCK, */
        
        FIND verify-table WHERE verify-table.rec-fld = RECID(buff-file) NO-LOCK NO-ERROR.
        AllCons = AllCons +  " CONSTRAINT " +  ConName  + " FOREIGN KEY( " + AllConsFields + ")" 
		           + "  REFERENCES  " + verify-table.new-name + "(" +  AllForeignFields   + ")".
    
      ASSIGN DICTDB._constraint._con-status = "M".
	  ASSIGN DICTDB._constraint._For-Name = ConName.
	  IF ( dbtyp = "ORACLE" AND DICTDB._constraint._con-misc2[1] <> "SET DEFAULT" AND DICTDB._constraint._con-misc2[1] <> "NONE" 
	                    AND DICTDB._constraint._con-misc2[1] <> ""  AND DICTDB._constraint._con-misc2[1] <> ?) THEN
	    Allcons = Allcons + " ON DELETE  " + DICTDB._constraint._con-misc2[1].
	  IF ( dbtyp = "MSSQLSRV7" AND DICTDB._constraint._con-misc2[1] <> "NONE"
	                    AND DICTDB._constraint._con-misc2[1] <> ""  AND DICTDB._constraint._con-misc2[1] <> ?) THEN
	      Allcons = Allcons + " ON DELETE  " + DICTDB._constraint._con-misc2[1].	    
	  
	 IF AllCons <> "" AND AllCons <> ? THEN
     DO:
       FIND verify-table WHERE verify-table.rec-fld = RECID(DICTDB._File) NO-LOCK NO-ERROR.
	   PUT STREAM code UNFORMATTED verify-table.has-unsprtdt "ALTER TABLE " +  user_library dot verify-table.new-name +  " ADD " +  replace(AllCons,"-","_") skip.
       PUT STREAM code UNFORMATTED verify-table.has-unsprtdt user_env[5] SKIP.
     END. 
     
     IF mvdata AND dbtyp = "ORACLE" THEN DO:
       FIND verify-table WHERE verify-table.rec-fld = RECID(DICTDB._File) NO-LOCK NO-ERROR.
       PUT STREAM code UNFORMATTED verify-table.has-unsprtdt "ALTER TABLE " +  user_library dot verify-table.new-name +  " DISABLE CONSTRAINT " + ConName SKIP.
       PUT STREAM code UNFORMATTED verify-table.has-unsprtdt user_env[5] SKIP.
     END.
    END. /* IF ConType = "F" */
    
  END. /* IF( DICTDB._Constraint._Con-Active = TRUE) */           
  END. /* FOR EACH _Constraint */              
 
  IF mvdata AND dbtyp = "MSSQLSRV7" THEN DO:
       FIND verify-table WHERE verify-table.rec-fld = RECID(DICTDB._File) NO-LOCK NO-ERROR.
       PUT STREAM code UNFORMATTED verify-table.has-unsprtdt "ALTER TABLE " +  user_library dot verify-table.new-name + " NOCHECK CONSTRAINT ALL " SKIP.
       PUT STREAM code UNFORMATTED verify-table.has-unsprtdt user_env[5] SKIP.          
  END.

END.   /*  FOR EACH DICTDB._File  WHERE DICTDB._File._Db-recid = drec_db  */
END.  /* THEN */

/* creating SEQT_REV_SEQTMGR table for revised sequence generator for MSS if one does not exist. */
IF lnewSeq THEN DO:
put stream code unformatted 
    " if not exists (select * from dbo.sysobjects where id = object_id('_SEQT_REV_SEQTMGR') " skip
    "    and OBJECTPROPERTY(id, 'IsTable') = 1)" skip
           "create table _SEQT_REV_SEQTMGR (" skip
           "        seq_name varchar(30) not null, " skip
	   "        initial_value bigint, " skip
	   "        increment_value bigint, " skip
	   "        upper_limit bigint, " skip
	   "        cycle bit not null )" skip 
           " " skip.
END.

IF doseq THEN DO:

  /* find out if source db supports large sequences */
  FIND FIRST  DICTDB._Db WHERE RECID(_Db) = drec_db.
  IF DICTDB._DB._Db-res1[1] = 1 THEN
     large_seq = YES.

  /* clear it out */
  ASSIGN comment_chars = "".

  if PROGRESS = "full" then do:  /* get real current sequence values */
    RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
    OUTPUT STREAM tmpstream TO VALUE(tmpfile) NO-MAP NO-ECHO.
    PUT STREAM tmpstream UNFORMATTED
      'DEFINE  SHARED VARIABLE crnt-vals AS INT64 EXTENT 2000 NO-UNDO.' SKIP.

    assign l_seq-num = 0.

    FOR EACH DICTDB._Sequence  WHERE DICTDB._Sequence._Db-recid = drec_db
                                 AND NOT DICTDB._Sequence._Seq-name BEGINS "$":
      assign l_seq-num = l_seq-num + 1.
      IF DICTDB._Sequence._Seq-Num >= 0
        THEN PUT STREAM tmpstream UNFORMATTED
              'crnt-vals [' 
              STRING (DICTDB._Sequence._Seq-Num + 1) 
              '] = CURRENT-VALUE ('
              DICTDB._Sequence._Seq-Name ', DICTDB).' SKIP.
      ELSE PUT STREAM tmpstream UNFORMATTED
           'crnt-vals [' 
              STRING (l_seq-num) 
              '] = 0 /*CURRENT-VALUE ('
              DICTDB._Sequence._Seq-Name ', DICTDB)*/.' SKIP.
    END. /* for each DICTDB._Sequence */

    PUT STREAM tmpstream UNFORMATTED
      'RETURN.' SKIP.

    OUTPUT STREAM tmpstream CLOSE.

    RUN VALUE (tmpfile).
    OS-DELETE VALUE (tmpfile). 

  end.  /* get real current sequence values */
       /*  else use 0's as current values */

  assign l_seq-num = 0.
  FOR EACH DICTDB._Sequence  WHERE DICTDB._Sequence._Db-recid = drec_db
                               AND NOT DICTDB._Sequence._Seq-name BEGINS "$" :

    assign l_seq-num = l_seq-num + 1.

    IF DICTDB._Sequence._Seq-misc[2] <> ? THEN
      n1 = DICTDB._Sequence._Seq-misc[1].
    ELSE
      n1 = DICTDB._Sequence._Seq-name.
    
    IF n1 = ? THEN
       assign n1 = DICTDB._Sequence._Seq-name.
       
    /*
     * check that the maximum size of an identifer is not exceeded for 
     * the sequence name.
     */ 

    trunc_name = FALSE.
    IF xlat THEN DO:
      if max_id_length <> 0  and length(n1) > max_id_length then do:
        /*  _resxlat will truncate name  */
        put stream logfile unformatted
              "WARNING: Sequence name " n1 " is longer than the maximum " skip
              "         legal identifier length of " max_id_length "." skip.
        trunc_name = TRUE.
      end.
      n1 = n1 + "," + idbtyp + "," + string (max_id_length).

      RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT n1). 
    end.
    
    else if max_id_length <> 0 and length(n1) > max_id_length then do:
      /*  need to truncate name  */
      put stream logfile unformatted
         "WARNING: Sequence name " n1 " is longer than the maximum " skip
         "         legal identifier length of " max_id_length "." skip.
         n1 = substring(n1,1,max_id_length).
         trunc_name = TRUE.
    end.
    IF length(n1) > 3 AND lc(SUBSTRING(n1, (LENGTH(n1) - 3))) = "_seq" THEN
        ASSIGN n1 = SUBSTRING(n1, 1, (LENGTH(n1) - 1))
               trunc_name = TRUE.

    if trunc_name then
       put stream logfile unformatted 
               "         Truncating sequence name to " n1 skip(2).         
    
    IF (dbtyp = "SYBASE" or dbtyp = "MS SQL Server" OR dbtyp = "MSSQLSRV7") THEN DO: 
     IF (dbtyp = "SYBASE" or dbtyp = "MS SQL Server")  THEN DO:
        PUT STREAM code UNFORMATTED 
           "if (select name from sysobjects where name = '_SEQT_" n1 "' and" skip
           "    uid = (select uid from sysusers " SKIP
           "where suid = (select suid from master.dbo.syslogins" skip 
           "where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           "is not NULL" skip
           "drop table _SEQT_" n1 skip. 
        IF skptrm THEN 
           put stream code unformatted skip.
           
        PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.

        PUT STREAM code UNFORMATTED 
           "if (select name from sysobjects where name = '_SEQP_" n1 "' and" skip
           "           uid = (select uid from sysusers " SKIP
           "                  where suid = (select suid from master.dbo.syslogins" skip 
           "                  where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           " is not NULL" skip
           "    drop procedure _SEQP_" n1 skip. 
           
        IF skptrm THEN 
           PUT STREAM code UNFORMATTED SKIP.
     END.
     ELSE IF dbtyp = "MSSQLSRV7" THEN DO:

       PUT STREAM code UNFORMATTED 
           "if (select name from sysobjects where name = '"seqt_prefix n1 "' and" skip
           "    uid = (select uid from sysusers " SKIP
           "           where sid = (select sid from master.dbo.syslogins" skip 
           "                        where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           "is not NULL" skip
           "drop table " seqt_prefix n1 skip.  /* OE00170729 */
	
	IF seqt_prefix = "_SEQT_REV_" THEN 
	   ASSIGN other-seq-tab = "_SEQT_".
        ELSE 
           ASSIGN other-seq-tab = "_SEQT_REV_".
	
	IF seqt_prefix = "_SEQT_" THEN
	   PUT STREAM code UNFORMATTED 
            "if exists (select name from dbo.sysobjects where id = object_id('_SEQT_REV_SEQTMGR') " skip
            "   and OBJECTPROPERTY(id, 'IsTable') = 1) " skip
            "      if (select seq_name from _SEQT_REV_SEQTMGR where seq_name = '" n1 "') " skip
            "         is not NULL delete from _SEQT_REV_SEQTMGR where seq_name = '" n1 "'" skip
    
            "if exists (select name from dbo.sysobjects where id = object_id('_SEQT_REV_SEQTMGR') " skip
            "   and OBJECTPROPERTY(id, 'IsTable') = 1) " skip
    	    "       if (select seq_name from _SEQT_REV_SEQTMGR) is NULL drop table _SEQT_REV_SEQTMGR " skip.

	PUT STREAM code UNFORMATTED 
           "if (select name from sysobjects where name = '"other-seq-tab n1 "' and" skip
           "    uid = (select uid from sysusers " SKIP
           "           where sid = (select sid from master.dbo.syslogins" skip 
           "                        where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           "is not NULL" skip
           "drop table " other-seq-tab n1 skip.

        IF skptrm THEN 
           put stream code unformatted skip.
           
        PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.

        PUT STREAM code UNFORMATTED 
           "if (select name from sysobjects where name = '"seqp_prefix n1 "' and" skip
           "           uid = (select uid from sysusers " SKIP
           "                  where sid = (select sid from master.dbo.syslogins" skip 
           "                               where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           " is not NULL" skip
           "    drop procedure " seqp_prefix n1 skip.  /* OE00170729 */

	IF seqp_prefix = "_SEQP_REV_" THEN 
	     ASSIGN other-seq-proc = "_SEQP_".
	ELSE 
	     ASSIGN other-seq-proc = "_SEQP_REV_".
        
	PUT STREAM code UNFORMATTED 
           "if (select name from sysobjects where name = '"other-seq-proc n1 "' and" skip
           "           uid = (select uid from sysusers " SKIP
           "                  where sid = (select sid from master.dbo.syslogins" skip 
           "                               where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           " is not NULL" skip
           "    drop procedure " other-seq-proc n1 skip. 
           
        IF skptrm THEN 
           PUT STREAM code UNFORMATTED SKIP.
     END.
     PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.

    IF NOT lnewSeq THEN 
        PUT STREAM code UNFORMATTED 
           "create table _SEQT_" n1 " ( " skip 
           "    initial_value    bigint null," skip
           "    increment_value  bigint null," skip
           "    upper_limit      bigint null," skip
           "    current_value    bigint null," skip
           "    cycle            bit not null) " skip 
           "  " skip.
     ELSE 
        PUT STREAM code UNFORMATTED 
     	  "create table _SEQT_REV_" n1 " ( " skip 
           "    current_value bigint identity(" _Seq-Init ", " _Seq-Incr ")" skip
           "    primary key, " skip
	   "    seq_val int) " skip 
           "  " skip.

       /* If the increment is positive, get the sequence's maximum.
          Otherwise, get its minimum. This will be stored as the
          upper_limit value.
       */
       IF DICTDB._Sequence._Seq-Incr > 0 THEN
         limit = ( IF DICTDB._Sequence._Seq-Max <> ?
                   THEN STRING(DICTDB._Sequence._Seq-Max)
                   ELSE (IF large_seq THEN "9223372036854775807" ELSE "2147483647")
                 ).
       ELSE
         limit = ( IF DICTDB._Sequence._Seq-Min <> ?
                   THEN STRING(DICTDB._Sequence._Seq-Min)
                   ELSE "0"
                 ).

     IF NOT lnewSeq then DO:
       IF DICTDB._Sequence._Seq-Num >= 0
        then put stream code unformatted 
           "insert into _SEQT_" n1 skip
           "       (initial_value, increment_value, upper_limit, current_value, cycle)" skip 
           "       values(" STRING(_Seq-Init) ", "
           STRING(_Seq-Incr) ", " limit ", " 
           STRING(crnt-vals[_Seq-Num + 1])  ", " 
           (if DICTDB._Sequence._Cycle-Ok then "1" else "0") ") " skip 
           " " skip.  
        else put stream code unformatted 
           "insert into _SEQT_" n1 skip
           "       (initial_value, increment_value, upper_limit, current_value, cycle)" skip 
           "       values(" STRING(_Seq-Init) ", "
           STRING(_Seq-Incr) ", " limit ", " 
           STRING(crnt-vals[l_seq-num])  ", " 
           (if DICTDB._Sequence._Cycle-Ok then "1" else "0") ") " skip 
           " " skip.  
       END.
       ELSE DO:
         PUT STREAM code UNFORMATTED 
           "if (select seq_name from _SEQT_REV_SEQTMGR where seq_name = '" n1 "') " skip
           " is not NULL" skip
           "    delete from _SEQT_REV_SEQTMGR where seq_name = '" n1 "' " skip
	   " " skip 
           "insert into _SEQT_REV_SEQTMGR " skip
           "       (seq_name, initial_value, increment_value, upper_limit, cycle)" skip 
           "       values('" n1 "', "
	       STRING(_Seq-Init) ", "
               STRING(_Seq-Incr) ", " limit ", " 
               (if DICTDB._Sequence._Cycle-Ok then "1" else "0") ") " skip 
           " " skip.
       END.

       if skptrm then 
           put stream code unformatted skip.
       put stream code unformatted comment_chars user_env[5] skip.

       /* 
        * Create the procedure to keep sequence numbers 
        */

       /* only MSS will have support for the new sequence generator. We should
          only get here with lnewSeq = TRUE for MSS, but just in case, check the
          db type.
       */
       IF NOT lnewSeq OR dbtyp NE "MSSQLSRV7" THEN DO:
           /* this is the default version of the sequence generator */
           put stream code unformatted 
               "create procedure _SEQP_" n1 " (@op int, @val bigint output) as " skip
               "begin" skip 
               "    /* " skip 
               "     * Current-Value function " skip 
               "     */" skip.
           if dbtyp NE "SYBASE" THEN 
                put stream code unformatted "   SET XACT_ABORT ON " skip.
           put stream code unformatted
               "    declare @err int " skip
               "    if @op = 0 " skip 
               "    begin" skip 
               "        begin transaction" skip
               "        select @val = (select current_value from _SEQT_" n1 ")" skip 
               "        SET @err = @@error " skip
               "        if @err <> 0 goto Err " skip
               "        commit transaction " skip
               "        return 0" skip
               "    end" skip 
               "    " skip 
               "    /*" skip  
               "     * Next-Value function " skip 
               "     */" skip 
               "    else if @op = 1" skip 
               "    begin" skip 
               "        declare @cur_val  bigint" skip 
               "        declare @last_val bigint" skip 
               "        declare @inc_val  bigint" skip 
               " " skip 
               "        begin transaction" skip 
               " " skip 
               "        /* perform a 'no-op' update to ensure exclusive lock */" skip 
               "        update _SEQT_" n1 " set initial_value = initial_value" skip
               "        SET @err = @@error " skip
               "        if @err <> 0 goto Err " skip
               " " skip 
               "        select @cur_val = (select current_value from _SEQT_" n1 ")" skip
               "        SET @err = @@error " skip
               "        if @err <> 0 goto Err " skip
               "        select @last_val = (select upper_limit from _SEQT_" n1 ")" skip
               "        SET @err = @@error " skip
               "        if @err <> 0 goto Err " skip
               "        select @inc_val  = (select increment_value from _SEQT_" n1 ")" skip
               "        SET @err = @@error " skip
               "        if @err <> 0 goto Err " skip
               " " skip 
               "        /*" skip 
               "         * if the next value will pass the upper limit, then either" skip
               "         * wrap or return a range violation" skip 
               "         */ " skip 
               "        if  @inc_val > 0 and @cur_val > @last_val - @inc_val  or @inc_val < 0 and @cur_val < @last_val - @inc_val " skip  
               "        begin" skip 
               "            if (select cycle from _SEQT_" n1 ") = 0 /* non-cycling sequence */" skip 
               "            begin " skip 
               "                SET @err = @@error " skip
               "                if @err <> 0 goto Err " skip
               "                select @val = @cur_val" skip
               "                commit transaction" skip 
               "                return -1" skip 
               "            end" skip 
               "            else " skip 
               "            BEGIN " skip
               "                 select @val = (select initial_value from _SEQT_" n1 ")" skip
               "                 SET @err = @@error " skip
               "                 if @err <> 0 goto Err " skip
               "            END " skip
               "        end" skip 
               "        else " skip 
               "             select @val = @cur_val + @inc_val" skip 
               " " skip 
               " " skip 
               "        update _SEQT_" n1 " set current_value = @val" skip 
               "        SET @err = @@error " skip
               "        if @err <> 0 goto Err " skip
               " " skip 
               " " skip 
               "        commit transaction" skip 
               "        return 0" skip 
               "    end" skip 
               "    else " SKIP
               "    /*" skip  
               "     * Set Current-Value function " skip 
               "     */" skip
               "    if @op = 2 " SKIP
               "    begin " SKIP
               "      begin transaction " SKIP
               "      update _SEQT_" n1 " set current_value = @val" SKIP
               "      SET @err = @@error " skip
               "      if @err <> 0 goto Err " skip
               "      commit transaction " SKIP
               "      return 0 " SKIP
               "   end " SKIP           
               "    else " skip 
               "        return -2" skip 
               "   Err: " skip
               "       rollback " skip
               "       return @err " skip
               "end" skip 
               " "   skip. 
       END.
       ELSE DO:
           /* here we will create the revised version of the sequence generator procedure */
	put stream code unformatted 
           "create procedure _SEQP_REV_" n1 " (@op int, @val bigint output) as " skip
           " begin " skip 
           "    DECLARE @err int " skip
           "    /* " skip 
           "     * Current-Value function " skip 
           "     */" skip
           "    if @op = 0 " skip 
           "    begin" skip
           "     BEGIN TRAN " skip
           "       set @val = ident_current('_SEQT_REV_" n1 "')" skip 
           "       SET @err = @@error " skip
           "       if @err <> 0 goto Err " skip
           "       commit transaction " skip
           "       return " skip
           "    end" skip
           "    " skip  
           "    /*" skip  
           "     * Next-Value function " skip 
           "     */" skip 
           "    else if @op = 1" skip 
           "    begin" skip 
           "     BEGIN TRAN " skip
           "        declare @ini_val  bigint" skip 
           "        declare @inc_val  bigint" skip 
           "        declare @upper_limit  bigint" skip 
           "        declare @cycle  bit" skip
           "        /* get upper limit and cycle info from _seqt_rev_seqtmgr */" skip 
           " " skip 
           "   select @upper_limit = upper_limit, " skip
           "          @inc_val = increment_value, " skip 
           "          @cycle = cycle, " skip
           "          @ini_val = initial_value " skip 
           "          from _seqt_rev_seqtmgr where seq_name = '" n1 "'" skip
           "    SET @err = @@error " skip
           "    if @err <> 0 goto Err " skip
           " " skip 
           "        /*" skip 
           "         * get current value from sequence table " skip
           "         */" skip 
           " " skip
           "       set @val = ident_current('_SEQT_REV_" n1 "')" skip 
           "       SET @err = @@error " skip
           "       if @err <> 0 goto Err " skip
           "        if (@inc_val > 0 and @upper_limit - @val < @inc_val) or (@inc_val < 0 and @upper_limit + @val > @inc_val) " skip  
           "     begin " skip 
           "         if @cycle != 0 " skip 
           "           begin " skip 
           "             DBCC CHECKIDENT ('_SEQT_REV_" n1 "', RESEED, @ini_val) " SKIP
           "             SET @err = @@error " skip
           "             if @err <> 0 goto Err " skip
           "             set @val = ident_current('_SEQT_REV_" n1 "')" skip
           "             SET @err = @@error " skip
           "             if @err <> 0 goto Err " skip
           "           end" skip 
           "         else " skip 
           "          BEGIN  " skip
           "           commit transaction " skip
           "           return -1" skip
           "          END " skip
           "     end" skip 
           "        else " skip 
           "     begin" skip
           "        insert into _SEQT_REV_" n1 " (seq_val) values (@val) " skip
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "        set @val = scope_identity() " skip
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "        delete from _SEQT_REV_" n1 skip 
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "     end" skip 
           "   commit transaction " skip
           "   return " skip
           "   end" skip
           "    else " skip
           "    /*" skip  
           "     * Set Current-Value function: Reseed the identity with passed value " skip 
           "     */" skip
           "    if @op = 2 " skip
           "    begin " skip
           "     BEGIN TRAN " skip
           "      DBCC CHECKIDENT ('_SEQT_REV_" n1 "', RESEED, @val) " skip
           "      SET @err = @@error " skip
           "      if @err <> 0 goto Err " skip
           "     COMMIT TRAN " skip
           "     return  " skip
           "    end " skip           
           "    else " skip 
           "        return -2" skip 
           " Err: " skip
           "   rollback " skip
           "   return @err "
           " end " skip          
           " "   skip. 

       END.

       if skptrm then 
           put stream code unformatted skip.
       put stream code unformatted comment_chars user_env[5] skip.

    end. /* (dbtyp = "SYBASE" or dbtyp = "MS SQL Server") */
    ELSE DO:
      IF dbtyp = "Informix" THEN
        PUT STREAM code UNFORMATTED
          "DROP SEQUENCE " n1 " ".
      ELSE
        PUT STREAM code UNFORMATTED
          "DROP SEQUENCE " n1.          

      /* If cycling sequence, start with initial value, 
        otherwise, start with current value.
        OE00167056 - Changing behavior. Always start with current value.
      */
      /* IF DICTDB._Sequence._Cycle-OK THEN
          start = DICTDB._Sequence._Seq-Init.
      ELSE */
          start = (IF DICTDB._Sequence._Seq-Num >= 0  
                   THEN (crnt-vals [_Seq-Num + 1] + _Seq-Incr)
                   ELSE (crnt-vals [l_seq-num] + _Seq-Incr)
                  ).

       assign
          i = ( IF DICTDB._Sequence._Seq-Min <> ?
                  THEN DICTDB._Sequence._Seq-Min
                  ELSE 0
              )
          limit = ( IF DICTDB._Sequence._Seq-Max <> ?
                  THEN STRING(DICTDB._Sequence._Seq-Max)
                  ELSE (IF large_seq THEN "9223372036854775807" ELSE "2147483647")
              ).

      /* If the initial value is some how greater than the current value
         Oracle will issue an error stating that the start with value can
         not be less than the initial value */
      IF start < i THEN
        ASSIGN start = i + _Seq-Incr.

      IF skptrm THEN
        PUT STREAM code UNFORMATTED SKIP.
        
      PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP
         "CREATE SEQUENCE " n1 "  START WITH " 
          STRING (start)
         " INCREMENT BY " + STRING (_Seq-Incr) 
         " MAXVALUE " limit " MINVALUE " STRING (i)
         (IF DICTDB._Sequence._Cycle-OK THEN " CYCLE" ELSE " NOCYCLE").

      IF skptrm THEN
        PUT STREAM code UNFORMATTED SKIP.
        
      PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.   
    END.
  END. /* for each DICTDB._Sequence */
END. /* if doseq */

IF ( dbtyp <> "PROGRESS" ) and ( user_env[30] begins "y") THEN 
    PUT STREAM code UNFORMATTED "exit" SKIP.

OUTPUT STREAM code CLOSE.
OUTPUT STREAM constlog  CLOSE.
/* Close the logfile if it wasn't open before we started. */
IF NOT logfile_open THEN DO:
   OUTPUT STREAM logfile CLOSE.
END. 
  

IF NOT batch_mode THEN DO:
    HIDE FRAME working NO-PAUSE.
    SESSION:IMMEDIATE-DISPLAY = no.
    IF NOT warnings_issued THEN 
        MESSAGE "Output Completed" VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    ELSE IF tables_not_created = true THEN
        MESSAGE "Output Completed. Some tables will not be created." SKIP
                "See" logfile_name "for more information." 
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    ELSE 
        MESSAGE "Output Completed. See" logfile_name "for more information." 
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
END.

RETURN.

PROCEDURE setMSSOptions:
   DEFINE VARIABLE numEntries          AS INTEGER    NO-UNDO.

   /* for new sequence generator support. If it's set, it will be the
     second entry. use2008types will be the third one.
   */
   numEntries = NUM-ENTRIES(user_env[25]).

   IF numEntries > 1 THEN DO:
      IF numEntries > 2 AND ENTRY(3,user_env[25]) BEGINS "Y" THEN
         ASSIGN mssNewDTTypes = YES.

       IF ENTRY(2,user_env[25]) BEGINS "Y" THEN DO:
         ASSIGN lnewSeq = TRUE
                seqt_prefix = "_SEQT_REV_"
                seqp_prefix = "_SEQP_REV_".
       END.
   END.

   ASSIGN lUniExpand = (user_env[35] = "y").
   ASSIGN msstryp = (ENTRY(2,user_env[36]) = "y").
   IF compatible THEN ASSIGN mssOptRowid = ENTRY(3,user_env[27]).
   ASSIGN mssrecidCompat = (ENTRY(3,user_env[36]) = "y").
   ASSIGN mssselBestRowidIdx = (ENTRY(4,user_env[36]) = "y").
   IF mssselBestRowidIdx THEN  ASSIGN msschoiceSchema = INTEGER(ENTRY(5,user_env[36])).   
END.

PROCEDURE createKey:

DEFINE VARIABLE ignorePK   AS LOGICAL    NO-UNDO INITIAL FALSE. 
/* Primary/clustered statement code */
  
  ASSIGN pindex2 = "PKCI_".
  ASSIGN pindex2 = user_library + dot + pindex2 + n2 
         pclst_name = user_library + dot + n2. 

  IF mssrecidCompat AND NOT idxrecidcompat THEN assign ignorePK = TRUE.
  IF msstryp AND userPKexist AND NOT ignorePK THEN DO:
     IF DICTDB._Index._Unique THEN  ASSIGN uniqueness = " UNIQUE".
     IF pk_unique THEN DO: 
       IF mandatory THEN RUN  createPrimaryKey (INPUT pindex2).
       ELSE RUN  createClusteredKey (INPUT pclst_name). 
       keyCreated = TRUE.
     END.
     ELSE DO: /* not unique */
       IF compatible AND (mssOptRowid EQ "U") THEN DO: /* For ROWID uniqueness */
          ASSIGN FieldList = FieldList + ", " + prowid_col.
          ASSIGN uniqueness = " UNIQUE".
          IF entry(2,user_env[27]) EQ "1" THEN mandatory = FALSE. 
          IF mandatory THEN RUN  createPrimaryKey (INPUT pindex2).
          ELSE RUN  createClusteredKey (INPUT pclst_name). 
          ASSIGN keyCreated = TRUE.
       END. /* For ROWID uniqueness */
     END. /* else-part -i.e. not unique */
  END. /* Try Primary */

IF keyCreated THEN
    PUT STREAM code UNFORMATTED comment_chars user_env[5] SKIP.
END.

PROCEDURE createPrimaryKey:
   DEFINE INPUT PARAMETER pindex2  AS CHARACTER  NO-UNDO.

      /* Generate Alter table add PK constraint */
      PUT STREAM code UNFORMATTED
          comment_chars "ALTER TABLE " user_library dot n1 SKIP. 
      PUT STREAM code UNFORMATTED 
          comment_chars "ADD CONSTRAINT " pindex2 " PRIMARY KEY".
      PUT STREAM code UNFORMATTED SKIP
          comment_chars "(" + FieldList + ")" SKIP.
      ASSIGN PKCreated = TRUE.
END PROCEDURE.

PROCEDURE createClusteredKey:
   DEFINE INPUT PARAMETER pclst_name AS CHARACTER  NO-UNDO.

/* clustered index statement code */
      PUT STREAM code UNFORMATTED
          comment_chars "CREATE " uniqueness " CLUSTERED INDEX " pclst_name SKIP. 
      PUT STREAM code UNFORMATTED 
          comment_chars "ON " user_library dot n1 SKIP.
      PUT STREAM code UNFORMATTED SKIP
          comment_chars "(" + FieldList + ")" SKIP.
      CcCreated = TRUE.
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

_wrkvgen.p  - creates file with CREATE VIEW statements

user_env[1] = view name or "ALL"
user_env[2] = output file
user_env[3] = userid
user_env[4] = statement terminator

HISTORY:

tomn        12/05/95    Added spacing to frame "working" to fix 4041 
                        errors on intl windows platforms  
gfs         07/03/94    94-07-07-075, 94-07-07-066.

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE lin  AS CHARACTER EXTENT 32 NO-UNDO.
DEFINE VARIABLE lin# AS INTEGER   INITIAL 1 NO-UNDO.
DEFINE VARIABLE c    AS CHARACTER           NO-UNDO.
DEFINE VARIABLE f    AS LOGICAL             NO-UNDO.
DEFINE VARIABLE i    AS INTEGER             NO-UNDO.
DEFINE STREAM code.

FORM
  SKIP(1)
  _View._View-name LABEL "Working on View" AT 3
  SKIP(1)
  WITH FRAME working 
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D TITLE "Dump CREATE VIEW Statement" &ENDIF.
  
COLOR DISPLAY MESSAGES _View._View-name WITH FRAME working.

SESSION:IMMEDIATE-DISPLAY = yes.
PAUSE 0.
OUTPUT STREAM code TO VALUE(user_env[2]) NO-ECHO NO-MAP.

FOR EACH _View WHERE (IF user_env[1] = "ALL"
  /*THEN (user_env[3] = "ALL" OR user_env[3] = ENTRY(1,_View._Can-read))*/
    THEN (user_env[3] = "ALL" OR CAN-DO(_View._Can-read, user_env[3]) )
  ELSE _View-name = user_env[1]):

  IF TERMINAL <> "" THEN
    DISPLAY _View._View-name WITH FRAME working.

  ASSIGN
    lin    = ""
    lin[1] = "DROP VIEW " + _View._View-Name + user_env[4]
    lin[2] = "CREATE VIEW " + _View._View-Name
    lin#   = 3
    f      = TRUE.

  FOR EACH _View-col OF _View BREAK BY _Vcol-Order:
    IF   INDEX(_Col-name,"-") > 0
      OR INDEX(_Col-name,"#") > 0
      OR INDEX(_Col-name,"%") > 0
      OR INDEX(_Col-name,"&") > 0
      OR INDEX(_Col-name,"$") > 0 THEN f = FALSE.
    IF NOT f THEN LEAVE.
  END.

  IF f THEN DO:
    lin[lin#] = "  (".
    FOR EACH _View-col OF _View BREAK BY _Vcol-Order:
      IF LENGTH(lin[lin#]) + LENGTH(_Col-name) > 76 THEN ASSIGN
        lin#      = lin# + 1
        lin[lin#] = "  ".
      lin[lin#] = lin[lin#] + _Col-name.
      IF NOT LAST(_Vcol-Order) THEN lin[lin#] = lin[lin#] + ",".
    END.
    ASSIGN
      lin[lin#] = lin[lin#] + ")"
      lin# = lin# + 1.
  END.

  ASSIGN
    lin[lin#] = "  AS SELECT"
    lin#      = lin# + 1
    lin[lin#] = "  ".

  FOR EACH _View-col OF _View BREAK BY _Vcol-Order:
    c = _Base-col.
    IF c MATCHES "(*)" THEN c = SUBSTRING(c,2,LENGTH(c) - 2).
    IF LENGTH(lin[lin#]) + LENGTH(c) > 76 THEN ASSIGN
      lin#      = lin# + 1
      lin[lin#] = "  ".
    lin[lin#] = lin[lin#] + c.
    IF NOT LAST(_Vcol-Order) THEN lin[lin#] = lin[lin#] + ",".
  END.

  ASSIGN
    lin# = lin# + 1
    lin[lin#] = "  FROM " + _Base-Tables.

  IF _Where-Cls <> ? THEN ASSIGN
    lin# = lin# + 1
    lin[lin#] = "  WHERE " + _Where-Cls.

  IF _Group-By <> ? THEN ASSIGN
    lin# = lin# + 1
    lin[lin#] = "  " + (IF _Updatable
                THEN "WITH CHECK OPTION"
                ELSE "GROUP BY " + _Group-By).

  lin[lin#] = lin[lin#] + user_env[4]. /* statement terminator */

  DO i = 1 TO lin#:
    PUT STREAM code lin[i] FORMAT "x(" + STRING(LENGTH(lin[i])) + ")" SKIP.
  END.
  PUT STREAM code UNFORMATTED SKIP(1).

END. /* for each _View */
OUTPUT STREAM code CLOSE.
HIDE FRAME working NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
MESSAGE "Output Completed" VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.

/*
_View            _Base-Tables char         x(60)
                 _Can-Create  char         x(60)
                 _Can-Delete  char         x(60)
                 _Can-Read    char         x(60)
                 _Can-Write   char         x(60)
                 _Group-By    char         x(60)
                 _Updatable   logi         yes/no
                 _View-Def    char         x(60)
               * _View-Name   char         x(18)
                 _Where-Cls   char         x(60)

_View-Col        _Base-Col    char         x(60)
                 _Can-Create  char         x(60)
                 _Can-Write   char         x(60)
             idx _Col-Name    char         x(18)
             idx _Vcol-Order  inte         >>>9
                 _View-Name   char         x(18)
*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* This program generates explicit WORKFILE definitions from file
definitions in the database.  These workfile definitions can then
be customized.

This is useful if you need a workfile to temporarily hold some,
but not all, of the fields in a database file. */
/*
HISTORY:
    mcmann      10/15/03    Added initial value for Datetime and Datetime-tz
    mcmann      09/20/03    Changed size of Data type field.
    mcmann      03/03/03    Removed LOB fields from work-table definition
    mcmann      07/13/98    Added _Owner for _File finds
    tomn        12/05/95    Added spacing to frame "working" to fix 4041 
                            errors on intl windows platforms  
    hutegger    94/05/04    _decimals seems to be no longer = ? for 
                            non-decimal fields -> "decimals #" gets
                            printed only if _dtype = 5
*/
                            
{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE lin AS CHARACTER NO-UNDO.
DEFINE STREAM code.

FORM
  SKIP(1)
  _Field._Field-name LABEL "Working on Field" AT 3
  SKIP(1)
  WITH FRAME working 
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D &ENDIF
  TITLE "Generate DEFINE WORK-TABLE Statements".
  
COLOR DISPLAY MESSAGES _Field._Field-name WITH FRAME working.

SESSION:IMMEDIATE-DISPLAY = yes.

FIND _File WHERE _File._Db-recid = drec_db AND _File._File-name = user_filename
             AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").

PAUSE 0.
OUTPUT STREAM code TO VALUE(user_env[1]) NO-ECHO NO-MAP.
PUT STREAM code UNFORMATTED
  "/* " STRING(TODAY,"99/99/99") " workfile definition for table "
    _File._File-name " */" SKIP
  "/* ~{1~} = """", ""NEW"" or ""NEW SHARED"" */" SKIP
  "/* ~{2~} = """" or ""NO-UNDO"" */" SKIP(1)
  "DEFINE ~{1~} WORK-TABLE w" LC(_File._File-name)
    " ~{2~} /* LIKE " _File._File-name " */".

FOR EACH _Field OF _File:
  ACCUMULATE LENGTH(_Field._Field-name) (MAXIMUM).
END.

FOR EACH _Field OF _File WHERE _Field._Data-type <> "BLOB"
                           AND _Field._Data-type <> "CLOB"
                           AND _Field._Data-type <> "XLOB":
  DISPLAY _Field._Field-name WITH FRAME working.
  lin = "  FIELD " + STRING(_Field-name,"x("
      + STRING(ACCUM MAXIMUM LENGTH(_Field._Field-name))
      + ")") + " AS " + STRING(CAPS(_Data-type),"x(11)").
  IF _Extent > 0 THEN
    lin = lin + " EXTENT " + STRING(_Extent).
  IF _dtype = 5 THEN
    lin = lin + " DECIMALS " + STRING(_Decimals).

  IF ENCODE(_Format) <> ENCODE(LC(_Format)) /* match u/l case */
    OR (_dtype = 1 AND _Format <> "x(8)")         /* character */
    OR (_dtype = 2 AND _Format <> "99/99/99")     /* date */
    OR (_dtype = 3 AND _Format <> "yes/no")       /* logical */
    OR (_dtype = 4 AND _Format <> "->,>>>,>>9")   /* integer */
    OR (_dtype = 5 AND _Format <> "->>,>>9.99")   /* decimal */
    OR (_dtype = 7 AND _Format <> ">>>>>>9") THEN /* recid */
    lin = lin + " FORMAT " + CHR(34) + _Format + CHR(34).

  IF (_dtype =  2 OR _dtype =  7) AND (_Initial = ? OR _Initial = "?") THEN .
  ELSE
  IF _dtype <> 2 AND _dtype <> 7 AND (_Initial = ? OR _Initial = "?") THEN
    lin = lin + " INITIAL ?".

  ELSE
  IF _dtype = 1 AND _Initial <> "" THEN /* character */
    lin = lin + " INITIAL " + CHR(34) + _Initial + CHR(34).

  ELSE
  IF (_dtype = 2 OR _dtype = 7) AND _Initial <> "" THEN /* date, recid */
    lin = lin + " INITIAL " + _Initial.

  ELSE /* logical */
  IF _dtype = 3 AND (_Initial <> "FALSE" AND _Initial <> "NO") THEN DO:
    IF _Initial = "TRUE" OR _Initial = "YES" THEN
      lin = lin + " INITIAL " + _Initial.
    ELSE IF INDEX(_Format,_Initial) < INDEX(_Format,"/") THEN
      lin = lin + " INITIAL TRUE".
  END.

  ELSE /* integer, decimal */
  IF (_dtype = 4 OR _dtype = 5) AND DECIMAL(_Initial) <> 0 THEN
    lin = lin + " INITIAL " + STRING(DECIMAL(_Initial)).

  ELSE
  IF (_dtype = 34 OR _dtype = 40) AND (_Initial <> "" AND _Initial <> ?) THEN DO:
    IF _Initial = "NOW" THEN
        lin = lin + " INITIAL " + _Initial.
    ELSE
      lin = lin + " INITIAL " + CHR(34) + _Initial + CHR(34).
  END.

  IF _dtype = 1 AND _Fld-case THEN lin = lin + " CASE-SENSITIVE".

  IF _Label <> ? THEN lin = lin + " LABEL " + CHR(34) + _Label + CHR(34).
  IF _Col-label <> ? THEN
    lin = lin + " COLUMN-LABEL " + CHR(34) + _Col-label + CHR(34).

  DO WHILE ASC(SUBSTR(lin,LENGTH(lin),1)) = 32:
    lin = SUBSTR(lin,1,LENGTH(lin) - 1).
  END.
  PUT STREAM code UNFORMATTED SKIP lin.
END.
PUT STREAM code UNFORMATTED "." SKIP.
OUTPUT STREAM code CLOSE.

HIDE FRAME working NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.
MESSAGE "Output Completed" VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* filesbtn.i--defines a Files... button, with a specified name.*/
/**
** PARAMETERS:
** &NAME    button name
** &NOACC   if present leave off accelerator on Files button
**/
&IF "{&NAME}" = "" &THEN
   &SCOPED-DEFINE BTN-NAME btn_File /*Default button name is btn_File*/
&ELSE
   &SCOPED-DEFINE BTN-NAME {&NAME}
&ENDIF

&IF "{&NOACC}" = "" &THEN
   DEFINE BUTTON {&BTN-NAME} LABEL "&Files..." 
&ELSE
   DEFINE BUTTON {&BTN-NAME} LABEL "Files..." 
&ENDIF
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   SIZE 11 by 1
&ENDIF
   .
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* This routine appends <appe> to the end of <base>. */

DEFINE INPUT PARAMETER appe AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER base AS CHARACTER NO-UNDO.

IF CAN-DO("MSDOS,WIN32",OPSYS) THEN
  DOS SILENT type VALUE(appe) >> VALUE(base).

ELSE IF OPSYS = "UNIX" THEN
  UNIX SILENT cat VALUE(appe) >> VALUE(base).

ELSE MESSAGE "osappend.p: Unknown Operating System -" OPSYS.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Runs dbf with dbfmode */

/*
Usage: dbf dbfmode nuximode args...
  dbfmode = 1 (produce .d file)
          = 2 (produce .df file (table info))
          = 3 (produce .df file (index info))
  nuximode = 0 .dbf file created by 680x0 (lsb, msb format)
           = 1 .dbf file created by 80x86 (msb, lsb format)
  args... =
    if dbfmode = 1: filename.dbf filename.err >filename.d
               = 2: filename.dbf filename.err >filename.df
               = 3: filename.dbf filename.ndx filename.err >filename.df
*/

DEFINE INPUT PARAMETER dbfmode AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER nuximod AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER infiles AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER errfile AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER outfile AS CHARACTER NO-UNDO.

DEFINE VARIABLE tmp     AS CHARACTER.

IF CAN-DO("MSDOS,WIN32",OPSYS)
 THEN DO:
  /* There is a limit to the size of a DOS command issued from MS-WINDOWS.
     So, we generate a batch file to disk, execute it, then clean it up. */
  IF "{&WINDOW-SYSTEM}" begins "MS-WIN"
   THEN DO:
    /* generate a temp file for the batch command */
    RUN "adecomm/_tmpfile.p" (INPUT "qt", INPUT ".bat", OUTPUT tmp).
    OUTPUT TO VALUE(tmp) NO-ECHO.
    PUT UNFORMATTED
      "dbf "
      dbfmode " " 
      nuximod " " 
      infiles " " 
      errfile " " 
      ">" outfile.
    OUTPUT CLOSE.
    DOS SILENT VALUE(tmp).
    OS-DELETE VALUE(tmp).
    END.  /* MS-WINDOWS */
  
   ELSE  /* DOS TTY    */
    DOS SILENT dbf
      VALUE(dbfmode)
      VALUE(nuximod)
      VALUE(infiles)
      VALUE(errfile)
      VALUE(">" + outfile).
  END.  /* CAN-DO("MSDOS,WIN32",OPSYS) */

ELSE IF OPSYS = "OS2"
 THEN OS2 SILENT dbf
    VALUE(dbfmode)
    VALUE(nuximod)
    VALUE(infiles)
    VALUE(errfile)
    VALUE(">" + outfile).

ELSE IF OPSYS = "UNIX"
 THEN UNIX SILENT dbf
    VALUE(dbfmode)
    VALUE(nuximod)
    VALUE(infiles)
    VALUE(errfile)
    VALUE(">" + outfile).

ELSE IF OPSYS = "VMS"
 THEN DO:
  OUTPUT TO VALUE(errfile) NO-ECHO.
  PUT UNFORMATTED "~"The 'dbf' utility is not supported under VMS.~"" SKIP.
  OUTPUT CLOSE.
  END.

ELSE IF OPSYS = "BTOS"
 THEN BTOS SILENT VALUE(SEARCH("Dbf.Run")) DBF
    VALUE(dbfmode)
    VALUE(nuximod)
    VALUE(infiles)
    VALUE(errfile)
    VALUE(">" + outfile).

 ELSE DO:
  OUTPUT TO VALUE(errfile) NO-ECHO.
  PUT UNFORMATTED
    "~"osdbfutl.p: Unknown Operating System - " + OPSYS + "~"" SKIP.
  OUTPUT CLOSE.
  END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* this splits the filename prefix from the basename */

DEFINE INPUT  PARAMETER filename AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER fiprefix AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER basename AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.
basename = filename.

IF CAN-DO("MSDOS,WIN32,UNIX",OPSYS) THEN DO:
  i = INDEX(basename,":").
  DO WHILE i > 0:
    ASSIGN
      basename = SUBSTRING(basename,i + 1)
      i        = INDEX(basename,":").
  END.
END.

IF CAN-DO("MSDOS,WIN32,UNIX",OPSYS) THEN DO:
  i = MAXIMUM(INDEX(basename,"~\"),INDEX(basename,"/")).
  DO WHILE i > 0:
    ASSIGN
      basename = SUBSTRING(basename,i + 1)
      i        = MAXIMUM(INDEX(basename,"~\"),INDEX(basename,"/")).
  END.
END.

fiprefix = SUBSTRING(filename,1,LENGTH(filename) - LENGTH(basename)).
RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* this was copied from prodict/user/uservar.i */
&GLOBAL-DEFINE PRO_DISPLAY_NAME OpenEdge

/* This routine runs quoter on <infile>, producing <outfile>.*/

/* NOTE: quotes are not available as delimiters!!! (Some     */
/*  OS have problems with passing them on <hutegger 94/06>   */
/* Added check to see if quoter.exe can be found 20000523043 */
/* Added variable to hold full path name of quoter 20010404009 */

DEFINE INPUT PARAMETER infile  AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER delim   AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER colum   AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER outfile AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmp            AS CHARACTER NO-UNDO.
DEFINE VARIABLE qpath          AS CHARACTER NO-UNDO.

IF delim = '"'
  THEN DO:
    MESSAGE "Quotes are not allowed as delimiter."
            VIEW-AS ALERT-BOX ERROR.
    RETURN /*ERROR*/.        
    END.

IF delim = ?          THEN delim = "".
ELSE                       delim = "-d ~"" + delim + "~" ".

IF colum = ?          THEN colum = "".
ELSE                       colum = "-c ~"" + colum + "~" ".

IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DO: 
  IF SEARCH("quoter.exe") = ? THEN DO:
    MESSAGE "Unable to find the quoter utility.  Make sure that" SKIP
            "{&PRO_DISPLAY_NAME}' bin directory is in your PATH." SKIP
    VIEW-AS ALERT-BOX ERROR.
    RETURN "error".
  END.
  ELSE
    ASSIGN qpath = SEARCH("quoter.exe").
END.
ELSE  IF OPSYS = "UNIX" THEN DO: 
  IF SEARCH("quoter") = ? THEN DO:
    MESSAGE "Unable to find the quoter utility.  Make sure that" SKIP
            "{&PRO_DISPLAY_NAME}' bin directory is in your PATH." SKIP
    VIEW-AS ALERT-BOX ERROR.
    RETURN "error".
  END.
  ELSE
  ASSIGN qpath = SEARCH("quoter").
END.

IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DO:
  /* There is a limit to the size of a DOS command issued from MS-WINDOWS.
     So, we generate a batch file to disk, execute it, then clean it up. */

  IF "{&WINDOW-SYSTEM}" begins "MS-WIN" THEN DO:
    /* generate a temp file for the batch command */
    RUN "adecomm/_tmpfile.p" (INPUT "qt", INPUT ".bat", OUTPUT tmp).
    OUTPUT TO VALUE(tmp) NO-ECHO.
    PUT UNFORMATTED
      "~"" qpath "~" " /* quotes around paths, to avoid embedded spaces */
      delim  " " 
      colum  " " 
      "~"" infile "~" " 
      "> ~"" outfile "~"".
    OUTPUT CLOSE.
    DOS SILENT VALUE(tmp).
    OS-DELETE VALUE(tmp).
  END.  /* MS-WINDOWS */
  
  ELSE  /* DOS TTY    */
    DOS SILENT VALUE(qpath)
      VALUE(delim)
      VALUE(colum)
      VALUE(infile)
      VALUE(">" + outfile).
END.  /* CAN-DO("MSDOS,WIN32",OPSYS) */

ELSE IF OPSYS = "UNIX" THEN DO: 
  UNIX SILENT VALUE(qpath)
    VALUE(delim)
    VALUE(colum)
    VALUE(infile)
    VALUE(">" + outfile).
END.
ELSE MESSAGE "osquoter.p: Unknown Operating System -" OPSYS.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* ostodir.p - takes its parameter and makes it look like a directory name */

DEFINE INPUT-OUTPUT PARAMETER dirname AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.

IF dirname = "" AND OPSYS = "UNIX" THEN dirname = "./".

i = (IF CAN-DO("MSDOS,WIN32,OS2",OPSYS) THEN INDEX(dirname,"~\") ELSE 0).
DO WHILE i > 0:
  ASSIGN
    OVERLAY(dirname,i,1) = "/"
    i = INDEX(dirname,"~\").
END.

IF CAN-DO("MSDOS,WIN32,OS2,UNIX",OPSYS) AND dirname <> ""
  AND NOT dirname MATCHES "*/" THEN dirname = dirname + "/".

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _dirbtn.p

Description:
   Trigger code for the directory... button in a dialog.  

Input Parameters:
   p_Fillin  - Associated fill-in widget handle
   p_Title   - Title for the get-file dialog.
   p_Filter  - Filter (if null, figure something out from p_Filename)
   

Author: Donna McMann

Date Created: 08/04/03

----------------------------------------------------------------------------*/

DEFINE INPUT parameter p_Fillin AS WIDGET-HANDLE NO-UNDO.
DEFINE INPUT parameter p_Title  AS CHAR NO-UNDO.
DEFINE INPUT parameter p_Filter  AS CHAR NO-UNDO.


DEFINE VAR pickedOne  AS LOGICAL NO-UNDO.
DEFINE VAR fname      AS CHARACTER NO-UNDO.
DEFINE VAR initdir    AS CHAR    NO-UNDO.
DEFINE VAR rindex     AS INTEGER NO-UNDO.
DEFINE VAR Get_Must_Exist AS CHAR NO-UNDO.

fname = TRIM(p_Fillin:screen-value).
file-info:file-name = ".".
initdir = file-info:full-pathname. 
 
SYSTEM-DIALOG GET-DIR
             fname 
     INITIAL-DIR initdir
     title   p_Title 
     update  pickedOne.


IF pickedOne THEN
   p_Fillin:screen-value = fname.
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME chgid-frame
/*------------------------------------------------------------------------
/*************************************************************/
/* Copyright (c) 1984-2005,2012 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

  File: prodict/misc/_db-chgid.p

  Description: Dialog for changing database guid & or mac-key.

  Input Parameters:
      INPUT phTTDbDetail - Handle to the DbDetail Temp-Table

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 1, 2005
  
  History: 
    kmcintos May 23, 2005  Disable "Verify" field unless changes have been made. 
                           Bug # 20050506-002.
    kmcintos May 25, 2005  Major changes to UI in order to make changing Passkey 
                           seem more intuitive.
    kmcintos May 26, 2005  Changed "Blank Passkey" logic around a bit 
                           20050526-010.    
    kmcintos June 7, 2005  Added context sensitive help to dialog.
    kmcintos June 17, 2005 Added logic to encrypt the mac key using the 
                           new ENCRYPT-AUDIT-MAC-KEY method of the 
                           AUDIT-POLICY handle 20050614-032.
    kmcintos June 21, 2005 Added HEX-DECODE function for turning MacKey
                           into RAW 20050620-031.
    kmcintos Oct  26, 2005 Assigning hex-decode output to temp var before 
                           comparison 20050928-003.
    rkmaboj  05/02/2012    fixed unknown record creation, when creating record first time.                       
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

DEFINE STREAM utilStream.

/* Parameters Definitions ---                                           */

DEFINE INPUT  PARAMETER phDbDetail AS HANDLE      NO-UNDO.
DEFINE INPUT  PARAMETER phOldBuff  AS HANDLE      NO-UNDO.
DEFINE OUTPUT PARAMETER pcStatus   AS CHARACTER   NO-UNDO.

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE glMacMod  AS LOGICAL     NO-UNDO.
DEFINE VARIABLE glCancel  AS LOGICAL     NO-UNDO.
DEFINE VARIABLE glHasMac  AS LOGICAL     NO-UNDO.
DEFINE VARIABLE lProceed  AS LOGICAL     NO-UNDO.

DEFINE VARIABLE gcInitial AS CHARACTER   NO-UNDO.

{prodict/admnhlp.i}
{prodict/misc/misc-funcs.i}

/* ********************  Preprocessor Definitions  ******************** */

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME chgid-frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS tbBlank fiMacKey fiVerifMac btnPasskey Btn_OK Btn_Cancel   
&Scoped-Define DISPLAYED-OBJECTS fiGuid btnPasskey tbBlank fiMacKey fiVerifMac txtLine1 txtLine2 txtLine3 txtLine4 btn_OK btn_Cancel

/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON BtnHelp DEFAULT 
     LABEL "&Help" 
     SIZE 10 BY .95 BGCOLOR 8.
     
  DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
     SIZE 75.8 BY 1.57.
&ENDIF

DEFINE BUTTON Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 10 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON Btn_OK 
     LABEL "OK" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 10 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnPasskey
     LABEL "Change Passkey"
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
       SIZE 18 BY .95 BGCOLOR 8
     &ELSE
       SIZE 16 BY .95 
     &ENDIF .
                    
DEFINE VARIABLE fiGuid AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Identifier" 
     VIEW-AS FILL-IN SIZE 40 BY 1 NO-UNDO.

DEFINE VARIABLE fiMacKey AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Passkey" 
     VIEW-AS FILL-IN SIZE 40 BY 1 NO-UNDO.

DEFINE VARIABLE fiVerifMac AS CHARACTER FORMAT "X(256)":U 
     LABEL "Verify Passkey" 
     VIEW-AS FILL-IN SIZE 40 BY 1 NO-UNDO.

DEFINE VARIABLE txtLine1 AS CHARACTER FORMAT "X(256)":U 
    INITIAL 
"Generating a new Database Passkey or Identifier may change how your" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 74 BY 1
     &ELSE SIZE 74 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE txtLine2 AS CHARACTER FORMAT "X(256)":U 
    INITIAL "database is identified in utilities that use these values." 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 74 BY 1
     &ELSE SIZE 74 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE txtLine3 AS CHARACTER FORMAT "X(256)":U 
    INITIAL 
"You should be very certain that it is your intention to perform this" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 74 BY 1
     &ELSE SIZE 74 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE txtLine4 AS CHARACTER FORMAT "X(256)":U 
    INITIAL "action before saving changes." 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 74 BY 1
     &ELSE SIZE 74 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE tbBlank AS LOGICAL 
    INITIAL FALSE VIEW-AS TOGGLE-BOX
    LABEL "No Passkey" NO-UNDO.
    
/* ************************  Frame Definitions  *********************** */

DEFINE FRAME chgid-frame
     fiGuid
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 1 COL 6 
          &ELSE AT ROW 1.24 COL 8.2 &ENDIF
     btnPasskey
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 2 COL 62 
          &ELSE AT ROW 2.33 COL 60 COLON-ALIGNED PASSWORD-FIELD &ENDIF
     tbBlank
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 45 
          &ELSE AT ROW 4.52 COL 45 COLON-ALIGNED PASSWORD-FIELD &ENDIF
     fiMacKey
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 2 COL 19 COLON-ALIGNED BLANK 
          &ELSE AT ROW 2.33 COL 19 COLON-ALIGNED PASSWORD-FIELD &ENDIF  
     fiVerifMac
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 3 COL 19 COLON-ALIGNED BLANK 
          &ELSE AT ROW 3.43 COL 19 COLON-ALIGNED PASSWORD-FIELD &ENDIF 
     txtLine1 NO-LABEL
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 6 COL 1 COLON-ALIGNED
          &ELSE AT ROW 5.81 COL 3 &ENDIF
     txtLine2 NO-LABEL
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 7 COL 1 COLON-ALIGNED
          &ELSE AT ROW 6.48 COL 1 COLON-ALIGNED &ENDIF
     txtLine3 NO-LABEL
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 1 COLON-ALIGNED
          &ELSE AT ROW 7.86 COL 1 COLON-ALIGNED &ENDIF
     txtLine4 NO-LABEL
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 10 COL 1 COLON-ALIGNED
          &ELSE AT ROW 8.48 COL 1 COLON-ALIGNED &ENDIF
     Btn_OK
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 12 COL 28
          &ELSE AT ROW 9.76 COL 2.8 &ENDIF
     Btn_Cancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 12 COL 39
          &ELSE AT ROW 9.76 COL 13.4 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       BtnHelp AT ROW 9.76 COL 66.2 
       RECT-1 AT ROW 9.43 COL 1.6 
     &ENDIF
     SPACE(0.99) &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP(1) &ENDIF
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER CENTERED
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN ROW 1 &ENDIF
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "New Database Passkey/Identifier"
         DEFAULT-BUTTON Btn_OK.

ASSIGN FRAME chgid-frame:SCROLLABLE            = FALSE
       FRAME chgid-frame:HIDDEN                = TRUE
       fiGuid:READ-ONLY IN FRAME {&FRAME-NAME} = TRUE.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME chgid-frame /* New Database Passkey/Identifier */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  ON CHOOSE OF BtnHelp IN FRAME chgid-frame OR
     HELP OF FRAME {&FRAME-NAME}
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Database_Passkey_Identifier_Dialog_Box},
                               INPUT ?).
  
&ENDIF

ON CHOOSE OF Btn_Cancel IN FRAME chgid-frame /* Cancel */
DO:
  APPLY "WINDOW-CLOSE" TO FRAME chgid-frame.
END.

ON CHOOSE OF Btn_OK IN FRAME chgid-frame /* OK */
DO:
  APPLY "GO" TO FRAME chgid-frame.
END.

ON VALUE-CHANGED OF tbBlank
  RUN valueChangedTB.

ON CHOOSE OF btnPasskey IN FRAME {&FRAME-NAME} DO:
  IF SELF:LABEL = "Change Passkey" THEN
    ASSIGN tbBlank:SENSITIVE = TRUE
           SELF:LABEL        = "Undo".
  ELSE
    ASSIGN tbBlank:SENSITIVE = FALSE
           tbBlank:CHECKED   = NOT glHasMac
           SELF:LABEL        = "Change Passkey"
           glMacMod          = FALSE.
  
  /* Put TB VALUE-CHANGED trigger code in a procedure because
     of differences in the way this behaves between GUI and TTY. 
     Bug # 19970128-029 */        
  RUN valueChangedTB.

  IF tbBlank:SENSITIVE THEN
    APPLY "ENTRY" TO tbBlank.
  ELSE APPLY "ENTRY" TO fiMacKey.
END.

ON VALUE-CHANGED OF fiMacKey OR 
   VALUE-CHANGED OF fiVerifMac 
  glMacMod = TRUE.
  
/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

ON END-ERROR OF FRAME {&FRAME-NAME}
  pcStatus = "Cancelled".

ON GO OF FRAME {&FRAME-NAME} DO:
  DEFINE VARIABLE tmpRaw AS RAW.
  DEFINE VARIABLE rawBI  AS RAW.
  
  IF NOT tbBlank:CHECKED AND
     glMacMod AND
     COMPARE(fiMacKey:SCREEN-VALUE,"NE",
             fiVerifMac:SCREEN-VALUE,"CASE-SENSITIVE") THEN DO:
    MESSAGE "DB Passkey value does not match Verify Passkey value!" SKIP(1)
            "You must verify the database passkey, or hit Cancel to undo " +
            "changes."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "CHOOSE" TO btnPasskey.
    APPLY "ENTRY" TO btnPasskey.
    RETURN NO-APPLY.
  END.
  
  phDbDetail:EMPTY-TEMP-TABLE().
  phDbDetail:BUFFER-CREATE().
  IF NOT phOldBuff:AVAILABLE THEN
  DO:
      tmpRaw = HEX-DECODE(AUDIT-POLICY:ENCRYPT-AUDIT-MAC-KEY("_db-id-mnt_initial_")).
      ASSIGN phDbDetail::_db-mac-key = tmpRaw
             phDbDetail::_db-description = "PROGRESSST"
             phDbDetail::_db-custom-detail = "".
  END.      
  ELSE 
  phDbDetail:BUFFER-COPY(phOldBuff,"_db-guid").
      
  phDbDetail::_db-guid      = fiGuid:SCREEN-VALUE.
  
  IF glMacMod AND
     (tbBlank:CHECKED OR
      (fiMacKey:SCREEN-VALUE NE "" AND
       fiMacKey:SCREEN-VALUE NE ?))THEN DO:
    /* If the user blanked out the mac key, reset the db to not use a 
       mac key. */
    IF tbBlank:CHECKED THEN DO:
      /* Only make the change if necessary. */
      IF glHasMac THEN
        phDbDetail::_db-mac-key = tmpRaw.
    END.
    ELSE DO:
      tmpRaw = HEX-DECODE(AUDIT-POLICY:ENCRYPT-AUDIT-MAC-KEY(fiMacKey:SCREEN-VALUE)).
      
      IF phOldBuff:AVAILABLE AND tmpRaw NE phOldBuff::_db-mac-key THEN
        phDbDetail::_db-mac-key = tmpRaw.
    END.
  END.
  ELSE IF tbBlank:CHECKED        EQ FALSE  AND
          glHasMac               EQ FALSE  AND
          btnPasskey:LABEL       EQ "Undo" AND
          (fiMacKey:SCREEN-VALUE EQ ""     OR
           fiMacKey:SCREEN-VALUE EQ ?) THEN DO:
    MESSAGE "You have deselected the ~"No Passkey~" toggle, indicating that " +
            "you wish to assign a Passkey to this database, but have " +
            "entered no Passkey value!" SKIP(1)
            "Please enter a Passkey, re-select the ~"No Passkey~" toggle or " +
            "choose the Cancel button to cancel this transaction."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK-CANCEL UPDATE lProceed.
    
    IF lProceed THEN DO:
      APPLY "ENTRY" TO tbBlank.
      RETURN NO-APPLY.
    END.
    ELSE pcStatus = "Cancelled".
  END.
END.
  
/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  RUN initializeUI.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */
PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME chgid-frame.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY {&DISPLAYED-OBJECTS} 
      WITH FRAME chgid-frame.
  ENABLE fiGuid WHEN NOT (SESSION:DISPLAY-TYPE = "TTY")
         {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
           RECT-1
           BtnHelp 
         &ENDIF
      WITH FRAME chgid-frame.
  VIEW FRAME chgid-frame.
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Generate and display new GUID and initialize interface.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cGuid     AS CHARACTER   NO-UNDO.

  FRAME chgid-frame:TITLE = FRAME chgid-frame:TITLE + 
                            " (" + LDBNAME("DICTDB") + ")".

  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    SESSION:SET-WAIT-STATE("GENERAL").
  &ENDIF
  
  cGuid = generateGuid().
 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    SESSION:SET-WAIT-STATE("").
  &ENDIF
  
  DO WITH FRAME chgid-frame:
      IF phOldBuff:AVAILABLE THEN 
         ASSIGN glHasMac           = (STRING(phOldBuff::_db-mac-key) NE "020000").
    
        ASSIGN gcInitial               = (IF glHasMac THEN "_db-chgid_initial_" 
                                      ELSE "")
               fiGuid:SCREEN-VALUE     = cGuid
               fiMacKey:SCREEN-VALUE   = gcInitial 
               fiVerifMac:SCREEN-VALUE = gcInitial
               tbBlank:CHECKED         = NOT glHasMac
               fiMacKey:SENSITIVE      = FALSE
               fiVerifMac:SENSITIVE    = FALSE
               tbBlank:SENSITIVE       = FALSE.
  END.
END PROCEDURE.

PROCEDURE valueChangedTB:
  DO WITH FRAME {&FRAME-NAME}:
    IF tbBlank:CHECKED THEN
      ASSIGN fiMacKey:SCREEN-VALUE   = ""
             fiMacKey:SENSITIVE      = FALSE
             fiVerifMac:SCREEN-VALUE = ""
             fiVerifMac:SENSITIVE    = FALSE.
    ELSE
      ASSIGN fiMacKey:SCREEN-VALUE   = (IF btnPasskey:LABEL = "Undo" THEN
                                          "" ELSE gcInitial)
             fiMacKey:SENSITIVE      = (btnPasskey:LABEL = "Undo")
             fiVerifMac:SCREEN-VALUE = (IF btnPasskey:LABEL = "Undo" THEN
                                          "" ELSE gcInitial)
             fiVerifMac:SENSITIVE    = (btnPasskey:LABEL = "Undo").
           
    glMacMod = TRUE.
    IF tbBlank:CHECKED = FALSE THEN
      APPLY "ENTRY" TO fiMacKey.
  END.
END PROCEDURE.

&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME history-frame
/*------------------------------------------------------------------------
/*************************************************************/  
/* Copyright (c) 1984-2007,2012 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

  File: prodict/aud/_db-aud-hst.p

  Description: Dialog for displaying all _db-detail records in a database

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 3, 2005
 
  History: 
    kmcintos May 24, 2005  Added NO-ERROR and _db-detail creation in case no 
                           _db-detail exists bug # 20050505-031.
    kmcintos May 26, 2005  Added code to check if field values changed, instead 
                           of depending on VALUE-CHANGED trig bug # 20050525-017.
    kmcintos June 7, 2005  Added context sensitive help to dialog and removed
                           appbuilder friendly code.
    kmcintos Oct 28, 2005  Changed context sensitive help id.
    fernando 11/30/07      Check if read-only mode.
    rkmaboj  05/02/2012    fixed unknown record creation, when creating record first time.
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

CREATE WIDGET-POOL.

{prodict/misc/misc-funcs.i}
{prodict/admnhlp.i}

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Database Administrator to run this tool!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "No Permission".
END.

IF checkReadOnly("DICTDB","_Db-detail") NE "" THEN
   RETURN "No Permission".

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE TEMP-TABLE ttDetail RCODE-INFORMATION
    FIELD tcDBGuid       AS CHARACTER LABEL "DB Identifier"      FORMAT "x(36)"
    FIELD tcDescription  AS CHARACTER LABEL "Description"        FORMAT "x(35)"
    FIELD tcCustomDetail AS CHARACTER LABEL "Additional Details" FORMAT "x(500)"
    FIELD tlHasMacKey    AS LOGICAL
    FIELD tlModified     AS LOGICAL
    FIELD tiSequence     AS INTEGER
    INDEX tiSequence AS PRIMARY UNIQUE tcDBGuid.

DEFINE QUERY qDetail FOR ttDetail SCROLLING.

DEFINE BROWSE bDetail QUERY qDetail
    DISPLAY tcDescription
            tcDBGuid 
    WITH &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           3 DOWN NO-BOX 
         &ELSE 4 DOWN &ENDIF WIDTH 75.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
  BROWSE bDetail:COLUMN-RESIZABLE = TRUE.
&ENDIF

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

&Scoped-define LAYOUT-VARIABLE CURRENT-WINDOW-layout

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME history-frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS fiDescription edCustDtl BtnOK-2 BtnCancel
&Scoped-Define DISPLAYED-OBJECTS fiGuid fiDescription edCustDtl tbHasMac lblCustDtl lblHasMac 

/* Define a variable to store the name of the active layout.            */
DEFINE VAR CURRENT-WINDOW-layout AS CHAR INITIAL "Master Layout":U NO-UNDO.

/* ***********************  Control Definitions  ********************** */

/* Definitions of the field level widgets                               */
DEFINE BUTTON BtnCancel AUTO-END-KEY DEFAULT 
     LABEL "Cancel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON BtnHelp DEFAULT 
     LABEL "&Help" 
     SIZE 11 BY .95
     BGCOLOR 8.
   
  DEFINE RECTANGLE RECT-2
   EDGE-PIXELS 2 GRAPHIC-EDGE NO-FILL 
   SIZE 75 BY 1.38. &ENDIF

DEFINE BUTTON BtnOK-2 DEFAULT 
     LABEL "OK" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE VARIABLE edCustDtl AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 5
     &ELSE SIZE 54.8 BY 2.62 &ENDIF NO-UNDO.

DEFINE VARIABLE fiDescription AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Description" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 1
     &ELSE SIZE 54.8 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiGuid AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Identifier" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 1
     &ELSE SIZE 54.8 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE lblCustDtl AS CHARACTER FORMAT "X(256)":U INITIAL "Additional Details:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 19 BY 1
     &ELSE SIZE 17.4 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE lblHasMac AS CHARACTER FORMAT "X(256)":U INITIAL "Has Passkey:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 12 BY 1
     &ELSE SIZE 14 BY .62 &ENDIF NO-UNDO.

DEFINE VARIABLE tbHasMac AS LOGICAL INITIAL yes 
     LABEL "" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 3 BY 1
     &ELSE SIZE 2.4 BY .81 &ENDIF NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME history-frame
     bDetail AT COLUMN &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 1 ROW 2 
                       &ELSE 2 ROW 1 &ENDIF
     fiGuid
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 8 COL 19 COLON-ALIGNED
          &ELSE AT ROW 6.62 COL 18.2 COLON-ALIGNED &ENDIF
     fiDescription
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 19 COLON-ALIGNED
          &ELSE AT ROW 7.81 COL 18.2 COLON-ALIGNED &ENDIF
     edCustDtl
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 11 COL 21
          &ELSE AT ROW 9 COL 20.2 &ENDIF NO-LABEL
     tbHasMac
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 16 COL 72
          &ELSE AT ROW 11.67 COL 72.2 &ENDIF
     BtnOK-2
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 17 COL 27
          &ELSE AT ROW 12.86 COL 3.6 &ENDIF
     BtnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 17 COL 40
          &ELSE AT ROW 12.86 COL 15.4 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       BtnHelp AT ROW 12.86 COL 64.8 &ENDIF
     lblCustDtl
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 11 COL 1
          &ELSE AT ROW 9.05 COL 2.6 &ENDIF NO-LABEL
     lblHasMac
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 16 COL 58 COLON-ALIGNED
          &ELSE AT ROW 11.71 COL 55.6 COLON-ALIGNED &ENDIF NO-LABEL
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       RECT-2 AT ROW 12.62 COL 2.2 &ENDIF
     SPACE(0.79) SKIP(0.04)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER CENTERED
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Database Identification History"
         DEFAULT-BUTTON BtnOK-2 CANCEL-BUTTON BtnCancel.

/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

ASSIGN FRAME history-frame:SCROLLABLE       = FALSE
       FRAME history-frame:HIDDEN           = TRUE.

ASSIGN fiGuid:READ-ONLY IN FRAME history-frame        = TRUE.

IF SESSION:DISPLAY-TYPE = 'TTY':U  THEN 
  RUN CURRENT-WINDOW-layouts (INPUT 'Standard Character':U) NO-ERROR.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME history-frame 
  APPLY "END-ERROR":U TO SELF.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  ON CHOOSE OF BtnHelp IN FRAME {&FRAME-NAME} OR 
     HELP OF FRAME {&FRAME-NAME}
    RUN adecomm/_adehelp.p ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Database_Identification_History_Dialog_Box},
                             INPUT ? ).
&ENDIF

ON CHOOSE OF BtnOK-2 IN FRAME {&FRAME-NAME}
  APPLY "GO" TO FRAME {&FRAME-NAME}.

ON LEAVE OF edCustDtl IN FRAME {&FRAME-NAME} DO:
  IF ttDetail.tcCustomDetail NE SELF:SCREEN-VALUE THEN
    ASSIGN ttDetail.tlModified     = TRUE
           ttDetail.tcCustomDetail = SELF:SCREEN-VALUE.
END.

ON VALUE-CHANGED OF fiDescription IN FRAME {&FRAME-NAME} DO:
  ASSIGN ttDetail.tlModified    = TRUE
         ttDetail.tcDescription = SELF:SCREEN-VALUE
         ttDetail.tcDescription:SCREEN-VALUE IN BROWSE bDetail = SELF:SCREEN-VALUE.
END.

ON 'VALUE-CHANGED':U OF BROWSE bDetail DO:
  IF NOT AVAILABLE ttDetail THEN
    RETURN.

  DISPLAY tcDBGuid @ fiGuid
          tcDescription @ fiDescription
    WITH FRAME {&FRAME-NAME}.
  
  tbHasMac:CHECKED = tlHasMacKey.
  edCustDtl:SCREEN-VALUE IN FRAME {&FRAME-NAME} = tcCustomDetail.  
END.

ON GO OF FRAME {&FRAME-NAME}
  RUN writeChanges.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT EQ ? THEN 
  FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  RUN enable_UI.
  RUN initializeUI.

  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME history-frame.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY fiGuid fiDescription edCustDtl tbHasMac lblCustDtl lblHasMac 
      WITH FRAME history-frame.
   
  ENABLE &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN RECT-2 &ENDIF
         fiGuid WHEN NOT (SESSION:DISPLAY-TYPE = 'TTY':U )
         {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN BtnHelp &ENDIF
      WITH FRAME history-frame.

  IF ronly THEN
      DISABLE fiDescription edCustDtl lblHasMac WITH FRAME history-frame.
  VIEW FRAME history-frame.
  
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Initialize the user interface
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  
  RUN loadDetailTT.

  FRAME {&FRAME-NAME}:TITLE = 
      FRAME {&FRAME-NAME}:TITLE + "(" + LDBNAME("DICTDB") + ")".

  OPEN QUERY qDetail FOR EACH ttDetail NO-LOCK BY tiSequence.
  ENABLE bDetail WITH FRAME {&FRAME-NAME}.
  IF NOT CAN-FIND(FIRST ttDetail) then
     DISABLE fiDescription edCustDtl lblHasMac WITH FRAME history-frame. 
  APPLY "ENTRY" TO BROWSE bDetail.
  APPLY "VALUE-CHANGED" TO BROWSE bDetail.
END PROCEDURE.

PROCEDURE loadDetailTT :
/*------------------------------------------------------------------------------
  Purpose:     Load the local ttDetail temp-table with records from the
               _db-detail table.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hDbDetail AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery    AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDb       AS HANDLE      NO-UNDO.

  DEFINE VARIABLE iSequence AS INTEGER     NO-UNDO.

  CREATE BUFFER hDbDetail FOR TABLE "DICTDB._db-detail".
  CREATE BUFFER hDb       FOR TABLE "DICTDB._db".


  hDb:FIND-FIRST().
  hDbDetail:FIND-FIRST("WHERE _db-guid = ~'" + hDb::_db-guid + "~'",NO-LOCK) NO-ERROR.
  IF hDbDetail:AVAILABLE THEN DO ON ERROR UNDO, LEAVE TRANSACTION:
    iSequence = iSequence + 1.
    CREATE ttDetail.
    ASSIGN ttDetail.tiSequence     = iSequence
           ttDetail.tcDBGuid       = hDbDetail::_db-guid + "  **"
           ttDetail.tcDescription  = hDbDetail::_db-description 
           ttDetail.tcCustomDetail = hDbDetail::_db-custom-detail
           ttDetail.tlHasMacKey    = (STRING(hDbDetail::_db-mac-key) NE "020000")
           ttDetail.tlModified     = FALSE NO-ERROR.
  END.
  ELSE DO TRANSACTION:
    IF hDb::_db-guid <> ? THEN
    DO:
        
        hDbDetail:BUFFER-CREATE().
        ASSIGN hDbDetail::_db-guid          = hDb::_db-guid
               hDbDetail::_db-description   = hDbDetail:DBNAME
               hDbDetail::_db-custom-detail = "".
    
        iSequence = iSequence + 1.
        CREATE ttDetail.
        ASSIGN ttDetail.tiSequence     = iSequence
               ttDetail.tcDBGuid       = hDbDetail::_db-guid + "  **"
               ttDetail.tcDescription  = hDbDetail::_db-description 
               ttDetail.tcCustomDetail = hDbDetail::_db-custom-detail
               ttDetail.tlHasMacKey    = (STRING(hDbDetail::_db-mac-key) NE "020000")
               ttDetail.tlModified     = FALSE NO-ERROR.
    END.
  END.
  IF hDb::_db-guid <> ? THEN DO:
  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(hDbDetail).

  hQuery:QUERY-PREPARE("FOR EACH " + hDbDetail:NAME + 
                       " WHERE _db-guid NE ~'" + hDb::_db-guid +
                       "~' NO-LOCK").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  QRY-BLK:
  DO WHILE NOT hQuery:QUERY-OFF-END:
    iSequence = iSequence + 1.

    DO ON ERROR UNDO, LEAVE TRANSACTION:
      CREATE ttDetail.
      ASSIGN ttDetail.tiSequence     = iSequence
             ttDetail.tcDBGuid       = hDbDetail::_db-guid
             ttDetail.tcDescription  = hDbDetail::_db-description
             ttDetail.tcCustomDetail = hDbDetail::_db-custom-detail
             ttDetail.tlHasMacKey    = (STRING(hDbDetail::_db-mac-key) NE "020000")
             ttDetail.tlModified     = FALSE NO-ERROR.
    END.
    hQuery:GET-NEXT().
  END.
  DELETE OBJECT hQuery.
  DELETE OBJECT hDb.
  DELETE OBJECT hDbDetail.
  END.
END PROCEDURE.

PROCEDURE writeChanges :
/*------------------------------------------------------------------------------
  Purpose:     Write any changes, made by the user during this session, back
               to the _db-detail table.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hDbDetail AS HANDLE      NO-UNDO.

  CREATE BUFFER hDbDetail FOR TABLE "DICTDB._db-detail".

  FOR EACH ttDetail WHERE (ttDetail.tlModified = TRUE):
    DEFINE VARIABLE cGuid AS CHARACTER   NO-UNDO.

    DO ON ERROR UNDO, LEAVE TRANSACTION:
      cGuid = (IF ttDetail.tiSequence = 1 THEN 
                 TRIM(RIGHT-TRIM(ttDetail.tcDBGuid,"**"))
               ELSE ttDetail.tcDBGuid).

      hDbDetail:FIND-FIRST("WHERE _db-guid = ~'" + cGuid + "~'").
      IF hDbDetail:AVAILABLE THEN
        ASSIGN hDbDetail::_db-description   = ttDetail.tcDescription
               hDbDetail::_db-custom-detail = ttDetail.tcCustomDetail.
    END.
  END.
  
  DELETE OBJECT hDbDetail.
END PROCEDURE.

PROCEDURE CURRENT-WINDOW-layouts:
  DEFINE INPUT PARAMETER layout AS CHARACTER                     NO-UNDO.
  DEFINE VARIABLE lbl-hndl AS WIDGET-HANDLE                      NO-UNDO.
  DEFINE VARIABLE widg-pos AS DECIMAL                            NO-UNDO.

  /* Copy the name of the active layout into a variable accessible to   */
  /* the rest of this file.                                             */
  CURRENT-WINDOW-layout = layout.

  CASE layout:
    WHEN "Master Layout" THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME history-frame:HIDDEN       = yes &ENDIF
               FRAME history-frame:HEIGHT       = 13.05 + 
                                                  FRAME history-frame:BORDER-TOP + 
                                                  FRAME history-frame:BORDER-BOTTOM.

      ASSIGN BtnCancel:HIDDEN            = yes
             BtnCancel:COL               = 15.4
             BtnCancel:HEIGHT            = .95
             BtnCancel:ROW               = 12.86
             BtnCancel:HIDDEN            = no.

      &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
        ASSIGN BtnHelp:HIDDEN            = yes
               BtnHelp:COL               = 64.8
               BtnHelp:HEIGHT            = .95
               BtnHelp:ROW               = 12.86
               BtnHelp:HIDDEN            = no
               BtnHelp:HIDDEN            = no.

          ASSIGN RECT-2:HIDDEN           = yes
               RECT-2:COL                = 2.2
               RECT-2:EDGE-PIXELS        = 2
               RECT-2:HEIGHT             = 1.38
               RECT-2:ROW                = 12.62
               RECT-2:HIDDEN             = no
               RECT-2:HIDDEN             = no.
      &ENDIF
      
      ASSIGN BtnOK-2:HIDDEN              = yes
             BtnOK-2:COL                 = 3.6
             BtnOK-2:HEIGHT              = .95
             BtnOK-2:ROW                 = 12.86
             BtnOK-2:HIDDEN              = no.

      ASSIGN edCustDtl:HIDDEN            = yes
             edCustDtl:COL               = 20.2
             edCustDtl:HEIGHT            = 2.62
             edCustDtl:ROW               = 9
             edCustDtl:WIDTH             = 54.8
             edCustDtl:HIDDEN            = no.

      ASSIGN fiDescription:HIDDEN        = yes
             widg-pos                    = fiDescription:COL  
             fiDescription:COL           = 20.2
             lbl-hndl                    = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                = lbl-hndl:COL + 
                                           fiDescription:COL - widg-pos
             widg-pos                    = fiDescription:ROW  
             fiDescription:ROW           = 7.81
             lbl-hndl                    = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                = lbl-hndl:ROW + 
                                           fiDescription:ROW - widg-pos
             fiDescription:WIDTH         = 54.8
             fiDescription:HIDDEN        = no.

      ASSIGN fiGuid:HIDDEN               = yes
             widg-pos                    = fiGuid:COL  
             fiGuid:COL                  = 20.2
             lbl-hndl                    = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                = lbl-hndl:COL + 
                                           fiGuid:COL - widg-pos
             widg-pos                    = fiGuid:ROW  
             fiGuid:ROW                  = 6.62
             lbl-hndl                    = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                = lbl-hndl:ROW + 
                                           fiGuid:ROW - widg-pos
             fiGuid:WIDTH                = 54.8
             fiGuid:HIDDEN               = no.

      ASSIGN lblCustDtl:HIDDEN           = yes
             lblCustDtl:COL              = 2.6
             lblCustDtl:HEIGHT           = .62
             lblCustDtl:ROW              = 9.05
             lblCustDtl:WIDTH            = 17.4
             lblCustDtl:HIDDEN           = no.

      ASSIGN lblHasMac:HIDDEN            = yes
             lblHasMac:COL               = 57.6
             lblHasMac:HEIGHT            = .62
             lblHasMac:ROW               = 11.71
             lblHasMac:WIDTH             = 14
             lblHasMac:HIDDEN            = no.

      ASSIGN tbHasMac:HIDDEN             = yes
             tbHasMac:COL                = 72.2
             tbHasMac:HEIGHT             = .81
             tbHasMac:ROW                = 11.67
             tbHasMac:WIDTH              = 2.4
             tbHasMac:HIDDEN             = no.

      ASSIGN FRAME history-frame:VIRTUAL-HEIGHT = 13.05
                                   WHEN FRAME history-frame:SCROLLABLE
             &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME history-frame:HIDDEN       = no &ENDIF.

    END.  /* Master Layout Layout Case */

    WHEN "Standard Character":U THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME history-frame:HIDDEN       = yes &ENDIF
             FRAME history-frame:HEIGHT         = 18 +
                                                  FRAME history-frame:BORDER-TOP + 
                                                  FRAME history-frame:BORDER-BOTTOM
           NO-ERROR.

      ASSIGN BtnCancel:HIDDEN            = yes
             BtnCancel:COL               = 40
             BtnCancel:HEIGHT            = 1
             BtnCancel:ROW               = 17
             BtnCancel:HIDDEN            = no NO-ERROR.

      ASSIGN BtnOK-2:HIDDEN              = yes
             BtnOK-2:COL                 = 27
             BtnOK-2:HEIGHT              = 1
             BtnOK-2:ROW                 = 17
             BtnOK-2:HIDDEN              = no NO-ERROR.

      ASSIGN edCustDtl:HIDDEN            = yes
             edCustDtl:COL               = 20.5
             edCustDtl:HEIGHT            = 5
             edCustDtl:ROW               = 10
             edCustDtl:WIDTH             = 54.5
             edCustDtl:HIDDEN            = no NO-ERROR.

      ASSIGN fiDescription:HIDDEN        = yes
             widg-pos                    = fiDescription:COL  
             fiDescription:COL           = 21
             lbl-hndl                    = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                = lbl-hndl:COL + 
                                           fiDescription:COL - widg-pos
             widg-pos                    = fiDescription:ROW  
             fiDescription:ROW           = 9
             lbl-hndl                    = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                = lbl-hndl:ROW + 
                                           fiDescription:ROW   - widg-pos
             fiDescription:WIDTH         = 54
             fiDescription:HIDDEN        = no NO-ERROR.

      ASSIGN fiGuid:HIDDEN               = yes
             widg-pos                    = fiGuid:COL  
             fiGuid:COL                  = 21
             lbl-hndl                    = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                = lbl-hndl:COL + 
                                           fiGuid:COL - widg-pos
             widg-pos                    = fiGuid:ROW  
             fiGuid:ROW                  = 8
             lbl-hndl                    = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                = lbl-hndl:ROW + 
                                           fiGuid:ROW - widg-pos
             fiGuid:WIDTH                = 54
             fiGuid:HIDDEN               = no NO-ERROR.

      ASSIGN lblCustDtl:HIDDEN           = yes
             lblCustDtl:COL              = 1
             lblCustDtl:HEIGHT           = 1
             lblCustDtl:ROW              = 10
             lblCustDtl:WIDTH            = 19
             lblCustDtl:HIDDEN           = no NO-ERROR.

      ASSIGN lblHasMac:HIDDEN            = yes
             lblHasMac:COL               = 60
             lblHasMac:HEIGHT            = 1
             lblHasMac:ROW               = 15
             lblHasMac:WIDTH             = 12
             lblHasMac:HIDDEN            = no NO-ERROR.

      ASSIGN tbHasMac:HIDDEN             = yes
             tbHasMac:COL                = 72
             tbHasMac:HEIGHT             = 1
             tbHasMac:ROW                = 15
             tbHasMac:WIDTH              = 3
             tbHasMac:HIDDEN             = no NO-ERROR.

      ASSIGN FRAME history-frame:VIRTUAL-HEIGHT = 11.00
                        WHEN FRAME history-frame:SCROLLABLE
             &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME history-frame:HIDDEN       = no &ENDIF NO-ERROR.

    END.  /* Standard Character Layout Case */

  END CASE.
END PROCEDURE.  /* CURRENT-WINDOW-layouts */
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME controls-frame
/*------------------------------------------------------------------------
/*************************************************************/  
/* Copyright (c) 1984-2007,2012 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

  File: prodict/misc/_db-id-mnt.p

  Description: Dialog for maintaining _db-detail records.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 1st, 2005

  History: 
    kmcintos May 26, 2005  Checking for changes on leave of editor & displaying 
                           blank when no mac key:20050525-017
    kmcintos May 27, 2005  Removed ANY-PRINTABLE trigger from editor 
                           20050525-017.
    kmcintos June 7, 2005  Added context sensitive help to dialog and removed
                           appbuilder friendly code.
    fernando 11/30/07      Check if read-only mode.
    rkmaboj  05/02/2012    fixed unknown record creation, when creating record first time.                           
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

CREATE WIDGET-POOL.

{prodict/misc/misc-funcs.i}
{prodict/admnhlp.i}

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE        VARIABLE glDescMod   AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glCustMod   AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glNew       AS LOGICAL     NO-UNDO.

DEFINE        VARIABLE ghDb        AS HANDLE      NO-UNDO.
DEFINE        VARIABLE ghDbDetail  AS HANDLE      NO-UNDO.
DEFINE        VARIABLE ghTTDetail  AS HANDLE      NO-UNDO.
DEFINE        VARIABLE cMessage    AS CHARACTER   NO-UNDO.
DEFINE        VARIABLE gcInitial   AS CHARACTER   NO-UNDO.

DEFINE SHARED VARIABLE drec_db     AS RECID       NO-UNDO.

/* Sanity check, to ensure that there is a DB connected.  This is
   probably unnecessary, but it's better to be safe... */
IF NUM-DBS = 0 THEN
  cMessage = "There is no database connected!" + CHR(10) + CHR(10) +
             "Please connect to a database and try again.".
ELSE DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Database Administrator to run this tool!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "No Permission".
  END.

  IF checkReadOnly("DICTDB","_Db-detail") NE "" THEN
     RETURN "No Permission".

  CREATE BUFFER ghDb FOR TABLE "DICTDB._db".
  CREATE BUFFER ghDbDetail FOR TABLE "DICTDB._db-detail" NO-ERROR.
  IF NOT VALID-HANDLE(ghDbDetail) THEN
    cMessage = "The _db-detail table doesn't exist in this database.".
END.

IF cMessage NE "" THEN DO:
  MESSAGE cMessage
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

CREATE TEMP-TABLE ghTTDetail.
ghTTDetail:CREATE-LIKE(ghDbDetail).
ghTTDetail:TEMP-TABLE-PREPARE("dbDetail").
/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

&Scoped-define LAYOUT-VARIABLE CURRENT-WINDOW-layout

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME controls-frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS fiDescription edCustomDetail btnMacId Btn_OK Btn_Cancel
&Scoped-Define DISPLAYED-OBJECTS fiDescription edCustomDetail fiGuid fiMacKey lblCustomDetail 

/* Define a variable to store the name of the active layout.            */
DEFINE VAR CURRENT-WINDOW-layout AS CHAR INITIAL "Master Layout":U NO-UNDO.

/* ***********************  Control Definitions  ********************** */

/* Definitions of the field level widgets                               */
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON BtnHelp DEFAULT 
     LABEL "&Help" 
     SIZE 10 BY .95 
     BGCOLOR 8. &ENDIF

DEFINE BUTTON btnMacId 
     LABEL "New DB Passkey/Identifier" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 34 BY 1
     &ELSE SIZE 34.2 BY .95 &ENDIF.

DEFINE BUTTON Btn_Cancel AUTO-END-KEY 
     LABEL "Cancel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 10 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON Btn_OK 
     LABEL "OK" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 10 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE VARIABLE edCustomDetail AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 6
     &ELSE SIZE 54.2 BY 2.76 &ENDIF NO-UNDO.

DEFINE VARIABLE fiDescription AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Description" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 1
     &ELSE SIZE 54 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiGuid AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Identifier" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 1
     &ELSE SIZE 54 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiMacKey AS CHARACTER FORMAT "X(256)":U 
     LABEL "DB Passkey" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 54 BY 1
     &ELSE SIZE 54 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE lblCustomDetail AS CHARACTER FORMAT "X(256)":U INITIAL "Additional Details:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 19 BY 1
     &ELSE SIZE 17.4 BY .62 &ENDIF NO-UNDO.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 75.8 BY 1.57 &ENDIF.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME controls-frame
     fiDescription
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 20 COLON-ALIGNED
          &ELSE AT ROW 3.62 COL 18.8 COLON-ALIGNED &ENDIF
     edCustomDetail
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 5 COL 22
          &ELSE AT ROW 4.67 COL 20.8 &ENDIF NO-LABEL
     btnMacId
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 12 COL 42
          &ELSE AT ROW 8.1 COL 28.2 &ENDIF
     Btn_OK
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 12 COL 3
          &ELSE AT ROW 8.1 COL 3.2 &ENDIF
     Btn_Cancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 12 COL 13
          &ELSE AT ROW 8.1 COL 13.8 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       BtnHelp AT ROW 8.1 COL 66.6 &ENDIF
     fiGuid
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 1 COL 20 COLON-ALIGNED
          &ELSE AT ROW 1.24 COL 18.8 COLON-ALIGNED &ENDIF
     fiMacKey
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 3 COL 20 COLON-ALIGNED
          &ELSE AT ROW 2.43 COL 18.8 COLON-ALIGNED &ENDIF PASSWORD-FIELD 
     lblCustomDetail
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 5 COL 2
          &ELSE AT ROW 4.67 COL 3.4 &ENDIF NO-LABEL
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       RECT-1 AT ROW 7.76 COL 2 &ENDIF
     SPACE(0.59) &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP(1) &ENDIF
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER CENTERED
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN ROW 1 &ENDIF
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Database Identification Maintenance"
         DEFAULT-BUTTON Btn_OK.


/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

ASSIGN FRAME controls-frame:SCROLLABLE       = FALSE
       FRAME controls-frame:HIDDEN           = TRUE.

ASSIGN fiGuid:READ-ONLY IN FRAME controls-frame        = TRUE.

IF SESSION:DISPLAY-TYPE = 'TTY':U  THEN 
  RUN CURRENT-WINDOW-layouts (INPUT 'Standard Character':U) NO-ERROR.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME controls-frame 
  APPLY "END-ERROR":U TO SELF.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  ON CHOOSE OF BtnHelp IN FRAME controls-frame OR 
     HELP OF FRAME {&FRAME-NAME} 
    RUN adecomm/_adehelp.p ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Database_Identification_Maintenance_Dialog_Box},
                             INPUT ? ).
&ENDIF

ON CHOOSE OF btnMacId IN FRAME controls-frame DO:
  DEFINE VARIABLE cStatus AS CHARACTER   NO-UNDO.

  RUN prodict/misc/_db-chgid.p ( INPUT ghTTDetail:DEFAULT-BUFFER-HANDLE,
                                 INPUT ghDbDetail,
                                 OUTPUT cStatus ).

  IF cStatus NE "cancelled" THEN DO:
    glNew = TRUE.
    RUN displayDbDetail ( INPUT ghTTDetail:DEFAULT-BUFFER-HANDLE ).
    APPLY "ENTRY" TO btn_Ok IN FRAME controls-frame.
  END.
END.

ON CHOOSE OF Btn_Cancel IN FRAME controls-frame
  APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.

ON CHOOSE OF Btn_OK IN FRAME controls-frame 
  APPLY "GO" TO FRAME controls-frame.

ON VALUE-CHANGED OF fiDescription IN FRAME controls-frame 
  glDescMod = TRUE.

ON GO OF FRAME controls-frame DO:
  DO TRANSACTION ON ERROR UNDO, LEAVE:
    IF glNew THEN DO:
      ghDbDetail:BUFFER-CREATE().
      ghDbDetail:BUFFER-COPY(ghTTDetail:DEFAULT-BUFFER-HANDLE).
      ghDb::_db-guid = ghDbDetail::_db-guid.
    END.
    IF ghDbDetail:AVAILABLE THEN 
    DO:
        IF glDescMod OR
           ghDbDetail::_db-description NE fiDescription:SCREEN-VALUE THEN
          ghDbDetail::_db-description = fiDescription:SCREEN-VALUE.
          
        IF glCustMod OR
           ghDbDetail::_db-custom-detail NE edCustomDetail:SCREEN-VALUE THEN
          ghDbDetail::_db-custom-detail = edCustomDetail:SCREEN-VALUE.
    END.      
  END. /* DO TRANSACTION */
END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  
  RUN enable_UI.
  ghDb:FIND-FIRST("WHERE RECID(_db) = " + STRING(drec_db),NO-LOCK) NO-ERROR.
  ghDbDetail:FIND-FIRST("WHERE _db-detail._db-guid = ~'" + 
                        ghDb::_db-guid + "~'") NO-ERROR.
    
  RUN initializeUI.
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE assignDbDetail :
/*------------------------------------------------------------------------------
  Purpose:     Generic proc to create a new _db-detail record and assign
               values to all of it's fields.
  Parameters:  INPUT phDbDetail     - Buffer handle to _db-detail buffer
               INPUT pcGuid         - Value of _db-guid field
               INPUT pcMacKey       - Value of _db-mac-key field
               INPUT pcDescription  - Value of _db-description field
               INPUT pcCustomDetail - Value of _db-custom-detail field
  Notes:        
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER phDbDetail     AS HANDLE      NO-UNDO.
  DEFINE INPUT  PARAMETER pcGuid         AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER prMacKey       AS RAW         NO-UNDO.
  DEFINE INPUT  PARAMETER pcDescription  AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcCustomDetail AS CHARACTER   NO-UNDO.

  ASSIGN phDbDetail::_db-guid          = pcGuid
         phDbDetail::_db-mac-key       = prMacKey
         phDbDetail::_db-description   = pcDescription
         phDbDetail::_db-custom-detail = pcCustomDetail.

END PROCEDURE.

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME controls-frame.
END PROCEDURE.

PROCEDURE displayDbDetail :
/*------------------------------------------------------------------------------
  Purpose:     To display the current _db-detail record on the screen.
  Parameters:  <none>
  Notes:       If no _db-detail record exists, we create one.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER phDbDetail AS HANDLE      NO-UNDO.
  DEFINE VARIABLE locGuide        AS CHARACTER NO-UNDO.
  DEFINE VARIABLE locMacKey       AS CHARACTER NO-UNDO.
  DEFINE VARIABLE locDesc         AS CHARACTER NO-UNDO.
  DEFINE VARIABLE locCustomDetail AS CHARACTER NO-UNDO.
  IF NOT phDbDetail:AVAILABLE THEN DO:
/*    phDbDetail:BUFFER-CREATE().*/
/*    RUN assignDbDetail ( INPUT phDbDetail,       */
/*                         INPUT ghDb::_db-guid,   */
/*                         INPUT ?,                */
/*                         INPUT phDbDetail:DBNAME,*/
/*                         INPUT "" ).             */
     ASSIGN locGuide = "?"
            locMacKey = "_db-id-mnt_initial_"
            locDesc   = "PROGRESSST"
            locCustomDetail = "".
  END.
  else
  DO WITH FRAME controls-frame:
      ASSIGN locGuide = phDbDetail::_db-guid
            locMacKey = (IF STRING(phDbDetail::_db-mac-key) 
                                                    EQ "020000" THEN ""
                                              ELSE "_db-id-mnt_initial_") 
            locDesc   = (IF NOT glDescMod THEN 
                                                phDbDetail::_db-description
                                              ELSE fiDescription:SCREEN-VALUE)
            locCustomDetail = (IF NOT glCustMod THEN 
                                                phDbDetail::_db-custom-detail
                                              ELSE edCustomDetail:SCREEN-VALUE).
  END.
  DO WITH FRAME controls-frame:
    ASSIGN fiGuid:SCREEN-VALUE         = locGuide
           fiMacKey:SCREEN-VALUE       =  locMacKey  
           fiDescription:SCREEN-VALUE  = locDesc
           edCustomDetail:SCREEN-VALUE = locCustomDetail.
  END.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY fiDescription edCustomDetail fiGuid fiMacKey lblCustomDetail 
      WITH FRAME controls-frame.
  
  ENABLE {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN BtnHelp &ENDIF
         fiGuid WHEN NOT (SESSION:DISPLAY-TYPE = 'TTY':U )
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN RECT-1 &ENDIF
      WITH FRAME controls-frame.
  IF ronly THEN
      DISABLE fiDescription edCustomDetail btnMacId WITH FRAME controls-frame.
  VIEW FRAME controls-frame.
  
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Find the current _db-detail record and display it in the 
               interface.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  RUN displayDbDetail ( INPUT ghDbDetail ).

  FRAME controls-frame:TITLE = FRAME controls-frame:TITLE + 
                               " (" + LDBNAME("DICTDB") + ")".
END PROCEDURE.

PROCEDURE CURRENT-WINDOW-layouts:
  DEFINE INPUT PARAMETER layout AS CHARACTER                     NO-UNDO.
  DEFINE VARIABLE lbl-hndl AS WIDGET-HANDLE                      NO-UNDO.
  DEFINE VARIABLE widg-pos AS DECIMAL                            NO-UNDO.

  /* Copy the name of the active layout into a variable accessible to   */
  /* the rest of this file.                                             */
  CURRENT-WINDOW-layout = layout.

  CASE layout:
    WHEN "Master Layout" THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME controls-frame:HIDDEN = yes &ENDIF
             FRAME controls-frame:HEIGHT   = 8.33 + 
                                             FRAME controls-frame:BORDER-TOP + 
                                             FRAME controls-frame:BORDER-BOTTOM
             FRAME controls-frame:WIDTH    = 77.4 + 
                                             FRAME controls-frame:BORDER-LEFT + 
                                             FRAME controls-frame:BORDER-RIGHT.

      &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
        ASSIGN BtnHelp:HIDDEN              = yes
               BtnHelp:COL                 = 66.6
               BtnHelp:HEIGHT              = .95
               BtnHelp:ROW                 = 8.1
               BtnHelp:HIDDEN              = no
               BtnHelp:HIDDEN              = no.

        ASSIGN RECT-1:EDGE-PIXELS          = 2
               RECT-1:HIDDEN               = yes
               RECT-1:HEIGHT               = 1.57
               RECT-1:ROW                  = 7.76
               RECT-1:WIDTH                = 75.8
               RECT-1:HIDDEN               = no
               RECT-1:HIDDEN               = no.
      &ENDIF

      ASSIGN btnMacId:HIDDEN               = yes
             btnMacId:COL                  = 28.2
             btnMacId:HEIGHT               = .95
             btnMacId:ROW                  = 8.1
             btnMacId:WIDTH                = 34.2
             btnMacId:HIDDEN               = no.

      ASSIGN Btn_Cancel:HIDDEN             = yes
             Btn_Cancel:COL                = 13.8
             Btn_Cancel:HEIGHT             = .95
             Btn_Cancel:ROW                = 8.1
             Btn_Cancel:HIDDEN             = no.

      ASSIGN Btn_OK:HIDDEN                 = yes
             Btn_OK:COL                    = 3.2
             Btn_OK:HEIGHT                 = .95
             Btn_OK:ROW                    = 8.1
             Btn_OK:HIDDEN                 = no.

      ASSIGN edCustomDetail:HIDDEN         = yes
             edCustomDetail:COL            = 20.8
             edCustomDetail:HEIGHT         = 2.76
             edCustomDetail:ROW            = 4.67
             edCustomDetail:WIDTH          = 54.2
             edCustomDetail:HIDDEN         = no.

      ASSIGN fiDescription:HIDDEN          = yes
             widg-pos                      = fiDescription:COL  
             fiDescription:COL             = 20.8
             lbl-hndl                      = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                  = lbl-hndl:COL + 
                                             fiDescription:COL - widg-pos
             widg-pos                      = fiDescription:ROW  
             fiDescription:ROW             = 3.62
             lbl-hndl                      = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                  = lbl-hndl:ROW + 
                                             fiDescription:ROW - widg-pos
             fiDescription:HIDDEN          = no.

      ASSIGN fiGuid:HIDDEN                 = yes
             widg-pos                      = fiGuid:COL  
             fiGuid:COL                    = 20.8
             lbl-hndl                      = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                  = lbl-hndl:COL + 
                                             fiGuid:COL - widg-pos
             widg-pos                      = fiGuid:ROW  
             fiGuid:ROW                    = 1.24
             lbl-hndl                      = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                  = lbl-hndl:ROW + 
                                             fiGuid:ROW - widg-pos
             fiGuid:HIDDEN                 = no.

      ASSIGN fiMacKey:HIDDEN               = yes
             widg-pos                      = fiMacKey:COL  
             fiMacKey:COL                  = 20.8
             lbl-hndl                      = fiMacKey:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                  = lbl-hndl:COL + 
                                             fiMacKey:COL - widg-pos
             widg-pos                      = fiMacKey:ROW  
             fiMacKey:ROW                  = 2.43
             lbl-hndl                      = fiMacKey:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                  = lbl-hndl:ROW + fiMacKey:ROW   - widg-pos
             fiMacKey:HIDDEN               = no.

      ASSIGN lblCustomDetail:HIDDEN        = yes
             lblCustomDetail:COL           = 3.4
             lblCustomDetail:HEIGHT        = .62
             lblCustomDetail:ROW           = 4.67
             lblCustomDetail:WIDTH         = 17.4
             lblCustomDetail:HIDDEN        = no.

      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME controls-frame:HIDDEN = no &ENDIF.

    END.  /* Master Layout Layout Case */

    WHEN "Standard Character":U THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME controls-frame:HIDDEN = yes &ENDIF
             FRAME controls-frame:HEIGHT   = 12 + 
                                             FRAME controls-frame:BORDER-TOP + 
                                             FRAME controls-frame:BORDER-BOTTOM
             FRAME controls-frame:WIDTH    = 77 + 
                                             FRAME controls-frame:BORDER-LEFT + 
                                             FRAME controls-frame:BORDER-RIGHT 
           NO-ERROR.

      ASSIGN btnMacId:HIDDEN               = yes
             btnMacId:COL                  = 42
             btnMacId:HEIGHT               = 1
             btnMacId:ROW                  = 12
             btnMacId:WIDTH                = 34
             btnMacId:HIDDEN               = no NO-ERROR.

      ASSIGN Btn_Cancel:HIDDEN             = yes
             Btn_Cancel:COL                = 14
             Btn_Cancel:HEIGHT             = 1
             Btn_Cancel:ROW                = 12
             Btn_Cancel:HIDDEN             = no NO-ERROR.

      ASSIGN Btn_OK:HIDDEN                 = yes
             Btn_OK:COL                    = 3
             Btn_OK:HEIGHT                 = 1
             Btn_OK:ROW                    = 12
             Btn_OK:HIDDEN                 = no NO-ERROR.

      ASSIGN edCustomDetail:HIDDEN         = yes
             edCustomDetail:COL            = 22
             edCustomDetail:HEIGHT         = 6
             edCustomDetail:ROW            = 5
             edCustomDetail:WIDTH          = 54
             edCustomDetail:HIDDEN         = no NO-ERROR.

      ASSIGN fiDescription:HIDDEN          = yes
             widg-pos                      = fiDescription:COL  
             fiDescription:COL             = 22
             lbl-hndl                      = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                  = lbl-hndl:COL + 
                                             fiDescription:COL - widg-pos
             widg-pos                      = fiDescription:ROW  
             fiDescription:ROW             = 4
             lbl-hndl                      = fiDescription:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                  = lbl-hndl:ROW + 
                                             fiDescription:ROW - widg-pos
             fiDescription:HIDDEN          = no NO-ERROR.

      ASSIGN fiGuid:HIDDEN                 = yes
             widg-pos                      = fiGuid:COL  
             fiGuid:COL                    = 22
             lbl-hndl                      = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                  = lbl-hndl:COL + 
                                             fiGuid:COL - widg-pos
             widg-pos                      = fiGuid:ROW  
             fiGuid:ROW                    = 1.5
             lbl-hndl                      = fiGuid:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                  = lbl-hndl:ROW + 
                                             fiGuid:ROW - widg-pos
             fiGuid:HIDDEN                 = no NO-ERROR.

      ASSIGN fiMacKey:HIDDEN               = yes
             widg-pos                      = fiMacKey:COL  
             fiMacKey:COL                  = 22
             lbl-hndl                      = fiMacKey:SIDE-LABEL-HANDLE  
             lbl-hndl:COL                  = lbl-hndl:COL + 
                                             fiMacKey:COL - widg-pos
             widg-pos                      = fiMacKey:ROW  
             fiMacKey:ROW                  = 3
             lbl-hndl                      = fiMacKey:SIDE-LABEL-HANDLE  
             lbl-hndl:ROW                  = lbl-hndl:ROW + 
                                             fiMacKey:ROW - widg-pos
             fiMacKey:HIDDEN               = no NO-ERROR.

      ASSIGN lblCustomDetail:HIDDEN        = yes
             lblCustomDetail:COL           = 2
             lblCustomDetail:HEIGHT        = 1
             lblCustomDetail:ROW           = 5
             lblCustomDetail:WIDTH         = 19
             lblCustomDetail:HIDDEN        = no NO-ERROR.

      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME controls-frame:HIDDEN = no &ENDIF NO-ERROR.

    END.  /* Standard Character Layout Case */

  END CASE.
END PROCEDURE.  /* CURRENT-WINDOW-layouts */
&Scoped-define WINDOW-NAME CURRENT-WINDOW
/*------------------------------------------------------------------------
/*************************************************************/  
/* Copyright (c) 1984-2007,2009 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

  File: prodict/misc/_db-optn.p

  Description: Dialog for modifying Progress owned _db-option fields.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 19, 2005

  History: 
    kmcintos May 26, 2005  Renamed options and option-types for changes made 
                           by db group bug # 20050525-025.
    kmcintos June 7, 2005  Added context sensitive help for dialog and removed
                           appbuilder friendly code.
    kmcintos Aug 31, 2005  Added DB Option for _pvm.enforceauditinsert.
    kmcintos Sep  8, 2005  Ensure that option which don't exist and haven't
                           been modified don't get enabled or assigned
                           20050908-026.
    kmcintos Oct 21, 2005  Installed workaround for bug # 20050920-031 in 
                           order to complete fix for 20050908-026.  
                           20050921-017.
    fernando 11/30/07      Check if read-only mode.
    fernando 07/20/09      look at correct _db record
                            
------------------------------------------------------------------------*/
/*          This .p file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

{prodict/misc/misc-funcs.i}
{prodict/admnhlp.i}

/* ***************************  Definitions  ************************** */
CREATE WIDGET-POOL.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You do not have permission to run this tool!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "No Permission".
END.

IF checkReadOnly("DICTDB","_Db-option") NE "" THEN
   RETURN "No Permission".

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE        VARIABLE glAppUser     AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glAudInsrt    AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glTrustDomain AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glRecord      AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glNoBlank     AS LOGICAL     NO-UNDO.
DEFINE        VARIABLE glRuntime     AS LOGICAL     NO-UNDO.

DEFINE SHARED VARIABLE drec_db       AS RECID       NO-UNDO.

/* ********************  Preprocessor Definitions  ******************** */

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS tbAppUser tbAudInsrt tbTrustDomain tbNoBlank tbRecord tbRuntime btnOk btnCancel txtAuditing txtSecurity 
&Scoped-Define DISPLAYED-OBJECTS tbAppUser tbAudInsrt tbTrustDomain tbRecord tbNoBlank tbRuntime txtAuditing txtSecurity 

/* ***********************  Control Definitions  ********************** */

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnCancel AUTO-END-KEY 
     LABEL "Cancel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON btnHelp 
     LABEL "&Help" 
     SIZE 11 BY .95
     BGCOLOR 8.

  DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     SIZE 62 BY 1.29. &ENDIF

DEFINE BUTTON btnOk 
     LABEL "OK" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE VARIABLE txtAuditing AS CHARACTER FORMAT "X(256)":U 
      INITIAL "Auditing Options:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 23 BY 1
     &ELSE SIZE 23 BY .62 &ENDIF
     FONT 6 NO-UNDO.

DEFINE VARIABLE txtSecurity AS CHARACTER FORMAT "X(256)":U 
      INITIAL "Security Options:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 23 BY 1
     &ELSE SIZE 23 BY .62 &ENDIF
     FONT 6 NO-UNDO.

DEFINE VARIABLE tbAppUser AS LOGICAL INITIAL no 
         LABEL "Use Application User Id for Auditing" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 44 BY 1
     &ELSE SIZE 44 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE tbAudInsrt AS LOGICAL INITIAL no
     LABEL "Enforce Audit Insert Privilege"
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 44 BY 1
     &ELSE SIZE 44 BY .81 &ENDIF NO-UNDO.
                    
DEFINE VARIABLE tbNoBlank AS LOGICAL INITIAL no 
     LABEL "Disallow Blank UserId Connections" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 41 BY 1
     &ELSE SIZE 41 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE tbRecord AS LOGICAL INITIAL no 
     LABEL "Record Authenticated Client Sessions" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 41 BY 1
     &ELSE SIZE 40.8 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE tbRuntime AS LOGICAL INITIAL no 
     LABEL "Use Runtime Permissions Checking" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 41 BY 1
     &ELSE SIZE 41 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE tbTrustDomain AS LOGICAL INITIAL no 
    LABEL "Use Application Domain Registry"
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 41 BY 1
     &ELSE SIZE 40.8 BY .81 &ENDIF NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     tbAppUser
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 3 COL 7
          &ELSE AT ROW 2.52 COL 7.2 &ENDIF
     tbAudInsrt
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 7
          &ELSE AT ROW 3.38 COL 7.2 &ENDIF
     tbTrustDomain
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 7 COL 7
          &ELSE AT ROW 6.52 COL 7.2 &ENDIF
     tbRecord
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 8 COL 7
          &ELSE AT ROW 7.38 COL 7.2 &ENDIF 
     tbNoBlank
         &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 7
         &ELSE AT ROW 8.24 COL 7.2 &ENDIF
     tbRuntime
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 10 COL 7
          &ELSE AT ROW 9.05 COL 7.2 &ENDIF
     btnOk
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 13 COL 18
          &ELSE AT ROW 12 COL 3 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 13 COL 30
          &ELSE AT ROW 12 COL 15 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       btnHelp AT ROW 12 COL 51.8 &ENDIF
     txtAuditing
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 2 COL 2 COLON-ALIGNED
          &ELSE AT ROW 1.71 COL 2 COLON-ALIGNED &ENDIF NO-LABEL
     txtSecurity
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 6 COL 2 COLON-ALIGNED
          &ELSE AT ROW 5.81 COL 2 COLON-ALIGNED &ENDIF NO-LABEL
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       RECT-1 AT ROW 11.81 COL 2 &ENDIF
     SPACE(1.19) SKIP(0.18)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           ROW 2
         &ENDIF
         SIDE-LABELS NO-UNDERLINE THREE-D SCROLLABLE CENTERED
         TITLE "Database Options"
         CANCEL-BUTTON btnCancel.

/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

ASSIGN FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.

DO WITH FRAME {&FRAME-NAME}:
  ASSIGN tbAppUser:PRIVATE-DATA     = "_pvm.useAppUserID|1"
         tbAudInsrt:PRIVATE-DATA    = "_pvm.enforceauditinsert|1"
         tbNoBlank:PRIVATE-DATA     = "_pvm.noBlankUser|2"
         tbRecord:PRIVATE-DATA      = "_pvm.recordSessions|2"
         tbRuntime:PRIVATE-DATA     = "_pvm.RuntimePermissions|2" 
         tbTrustDomain:PRIVATE-DATA = "_pvm.useAppRegistry|2".
END. /* Do With Frame {&Frame-Name} */

/* ************************  Control Triggers  ************************ */
ON WINDOW-CLOSE OF FRAME Dialog-Frame 
  APPLY "END-ERROR":U TO SELF.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  ON CHOOSE OF btnHelp IN FRAME {&FRAME-NAME} OR 
     HELP OF FRAME {&FRAME-NAME}
    RUN adecomm/_adehelp.p ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Database_Options_Dialog_Box},
                             INPUT ? ).
&ENDIF

ON CHOOSE OF btnOk IN FRAME {&FRAME-NAME}
  APPLY "GO" TO FRAME {&FRAME-NAME}.

ON GO OF FRAME {&FRAME-NAME}
  RUN saveOptions.

ON VALUE-CHANGED OF tbAppUser IN FRAME {&FRAME-NAME} 
  SELF:MODIFIED = (SELF:CHECKED NE glAppUser).

ON VALUE-CHANGED OF tbAudInsrt IN FRAME {&FRAME-NAME}
  SELF:MODIFIED = (SELF:CHECKED NE glAudInsrt).
  
ON VALUE-CHANGED OF tbNoBlank IN FRAME {&FRAME-NAME} 
  SELF:MODIFIED = (SELF:CHECKED NE glNoBlank).

ON VALUE-CHANGED OF tbRecord IN FRAME {&FRAME-NAME}
  SELF:MODIFIED = (SELF:CHECKED NE glRecord).

ON VALUE-CHANGED OF tbRuntime IN FRAME {&FRAME-NAME} 
  SELF:MODIFIED = (SELF:CHECKED NE glRuntime).

ON VALUE-CHANGED OF tbTrustDomain IN FRAME {&FRAME-NAME} 
  SELF:MODIFIED = (SELF:CHECKED NE glTrustDomain).

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ? THEN 
  FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.


/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  RUN initializeUI.
  IF RETURN-VALUE = "No Db" THEN
    APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.

  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME {&FRAME-NAME}.
END PROCEDURE.

PROCEDURE displayOptions :
/*------------------------------------------------------------------------------
  Purpose:     This routine is responsible for displaying the values of the 
               current options in the _db-option table.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hDbOption AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDb       AS HANDLE      NO-UNDO.
  
  DEFINE VARIABLE hField    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE lFound    AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE cPData    AS CHARACTER   NO-UNDO.

  CREATE BUFFER hDbOption FOR TABLE "DICTDB._db-option".
  CREATE BUFFER hDb       FOR TABLE "DICTDB._db".

  lFound = hDb:FIND-FIRST("WHERE RECID(_db) = " + 
                          STRING(drec_db),NO-LOCK) NO-ERROR.
  IF NOT lFound THEN DO:
    MESSAGE "No database connected!" SKIP(1)
            "You must be connected to a database to acces this tool!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "No Db".
  END.

  hField = FRAME {&FRAME-NAME}:FIRST-CHILD:FIRST-CHILD.

  DO WHILE VALID-HANDLE(hField):
    IF NOT hField:TYPE = "TOGGLE-BOX" THEN DO: 
      hField = hField:NEXT-SIBLING.
      NEXT.
    END.

    cPData = hField:PRIVATE-DATA.
    lFound = hDbOption:FIND-FIRST("WHERE _db-option._db-recid = " + 
                                  STRING(hDb:RECID) +
                                  " AND _db-option._db-option-code = ~'" +
                                  ENTRY(1,cPData,"|") + "~' AND " + 
                                  "_db-option._db-option-type = " +
                                  ENTRY(2,cPData,"|"),NO-LOCK) NO-ERROR.
    IF (lFound = TRUE) THEN 
      ASSIGN hField:CHECKED   = (hDbOption::_db-option-value = "yes")
             &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
               hField:TOOLTIP   
             &ELSE
               hField:HELP
             &ENDIF           = hDbOption::_db-option-description             
             hField:MODIFIED  = FALSE
             hField:SENSITIVE = (NOT ronly) AND 
                     featureEnabled(STRING(hDbOption::_db-option-type)).
    ELSE 
      ASSIGN hField:CHECKED   = FALSE
             hField:MODIFIED  = FALSE
             hField:SENSITIVE = FALSE.
    hField = hField:NEXT-SIBLING.
  END.
  DELETE OBJECT hDbOption.
  DELETE OBJECT hDb.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY {&DISPLAYED-OBJECTS} 
      WITH FRAME {&FRAME-NAME}.
  
  ENABLE &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN RECT-1 &ENDIF
         {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN btnHelp &ENDIF
      WITH FRAME {&FRAME-NAME}.
  VIEW FRAME {&FRAME-NAME}.
  
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Initialization of the User Interface
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  
  FRAME {&FRAME-NAME}:TITLE = FRAME {&FRAME-NAME}:TITLE + 
                              " (" + LDBNAME("DICTDB") + ")".

  RUN displayOptions.
  IF RETURN-VALUE = "No Db" THEN
    RETURN RETURN-VALUE.

  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN glAppUser     = tbAppUser:CHECKED
           glAudInsrt    = tbAudInsrt:CHECKED
           glTrustDomain = tbTrustDomain:CHECKED
           glRecord      = tbRecord:CHECKED
           glNoBlank     = tbNoBlank:CHECKED
           glRuntime     = tbRuntime:CHECKED.
  END.
  
END PROCEDURE.

PROCEDURE saveOptions :
/*------------------------------------------------------------------------------
  Purpose:     This routine is responsible for saving the values of the 
               current options in the _db-option table.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hDbOption AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDb       AS HANDLE      NO-UNDO.
  
  DEFINE VARIABLE hField    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE lFound    AS LOGICAL     NO-UNDO.

  CREATE BUFFER hDbOption FOR TABLE "DICTDB._db-option".
  CREATE BUFFER hDb       FOR TABLE "DICTDB._db".

  lFound = hDb:FIND-FIRST("WHERE _db._db-type = ~'PROGRESS~' and _db-local",NO-LOCK) NO-ERROR.
  IF NOT lFound THEN DO:
    MESSAGE "No database connected!" SKIP(1)
            "You must be connected to a database to acces this tool!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "No Db".
  END.

  hField = FRAME {&FRAME-NAME}:FIRST-CHILD:FIRST-CHILD.
  DO WHILE VALID-HANDLE(hField):
    
    /* If this is not a TOGGLE-BOX or it's not sensitive then skip it. */
    IF hField:TYPE      <> "TOGGLE-BOX" OR
       hField:SENSITIVE =  FALSE THEN DO:
      hField = hField:NEXT-SIBLING.
      NEXT.
    END.

    lFound = hDbOption:FIND-FIRST("WHERE _db-option._db-recid = " + 
                                  STRING(hDb:RECID) +
                                  " AND _db-option-code = ~'" +
                                  ENTRY(1,hField:PRIVATE-DATA,"|") + "~'" +
                                  " AND _db-option-type = " +
                                  ENTRY(2,hField:PRIVATE-DATA,"|")) 
                                  NO-ERROR.
    /* If we couldn't find an option that matches this one (unlikely) or
       the value hasn't changed, skip it (don't attempt to change the value) */
    IF NOT (lFound = TRUE) OR
       hField:CHECKED = (IF hDbOption::_db-option-value EQ "yes" THEN
                           TRUE ELSE FALSE) THEN DO:
      hField = hField:NEXT-SIBLING.
      NEXT.
    END.
    
    DO TRANSACTION:
      lFound = hDbOption:FIND-FIRST("WHERE _db-option._db-recid = " +
                                    STRING(hDb:RECID) +
                                    " AND _db-option-code = ~'" +
                                    ENTRY(1,hField:PRIVATE-DATA,"|") + "~'" +
                                    " AND _db-option-type = " +
                                    ENTRY(2,hField:PRIVATE-DATA,"|"),
                                    EXCLUSIVE-LOCK) NO-ERROR.

      hDbOption::_db-option-value = (IF hField:CHECKED THEN "yes" 
                                     ELSE "no").
      hDbOption:BUFFER-RELEASE().
    END. /* Transaction Block */
    hField = hField:NEXT-SIBLING.
  END.
END PROCEDURE.

/*************************************************************/  
/* Copyright (c) 1984-2006,2008 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*----------------------------------------------------------------------------

File: _rptaud.p

Description:
   Pass through program from tty dict menu to adecomm/_audrpt.p.  Converts 
   Dictionary pertinent shared variable values into parameters.

Input:
   drec_db     = RECID of current database
   user_env[9] = Numeric Identifier of the report being called.
                 1    = Audit Policy Changes Report
                 2    = Database Schema Changes Report
                 3    = Audit Data Administration Report
                 4    = Application Data Administration Report
                 5    = User Account Changes Report
                 6    = Audit Permissions Changes Report
                 7    = Database Administration Changes Report
                 8    = Authentication System Changes Report
                 9    = Client Session Authentication
                10    = Application/Database Access Report (Logins/Logouts/etc.)
                11    = Database Access Report
                12    = Custom Report
                13    = Encryption Policy Changes
                14    = Key-store Changes 
                15    = Database Encryption Administration (Utilities)
 
Author: Kenneth S. McIntosh

Date Created: June 8, 2005

History: 
    kmcintos Aug 2, 2005  Changed permission check 20050721-007.
    kmcintos Jan 4, 2006  Changed permission list to audit reader and audit 
                          admin 20051108-060.
    fernando Dec 23,2008  Adding encryption related reports                     
----------------------------------------------------------------------------*/

&GLOBAL-DEFINE NOTTCACHE 1

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/sec/sec-func.i }

DEFINE VARIABLE cRoles  AS CHARACTER   NO-UNDO
            INITIAL "_sys.audit.read,_sys.audit.admin".

DEFINE VARIABLE iRole   AS INTEGER     NO-UNDO.

DEFINE VARIABLE lCanRun AS LOGICAL     NO-UNDO.

/* Check for privileges */
DO iRole = 1 TO NUM-ENTRIES(cRoles):
  lCanRun = hasRole(USERID("DICTDB"),
                    ENTRY(iRole,cRoles),
                    FALSE).
  IF lCanRun THEN LEAVE.
END.

IF NOT lCanRun THEN DO:
  user_env = "".
  MESSAGE "You must have a minimum of Audit Reader permissions to access " +
          "this option."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

IF user_env[9] EQ "12" THEN
  RUN adecomm/_cust-flt.p ( INPUT  LDBNAME("DICTDB"),
                            OUTPUT user_env[1] ).
ELSE 
  RUN adecomm/_auddfilt.p ( INPUT user_env[9],
                            OUTPUT user_env[1] ).

IF user_env[1] EQ ? THEN DO:
  user_env  = "".
  user_path = "".
  RETURN.
END.

RUN adecomm/_audrpt.p ( INPUT drec_db,
                        INPUT LDBNAME("DICTDB"),
                        INPUT INTEGER(user_env[9]),
                        INPUT user_env[1] ).
/*------------------------------------------------------------------------
/*************************************************************/  
/* Copyright (c) 1984-2007 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

  File: prodict/misc/misc-funcs.i

  Description: Miscellaneous functions for use with database admin 
               tools

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 19, 2005

  History: kmcintos May 26, 2005 Changed feature codes in featureEnabled
                                 bug # 20050525-025.
           fernando 11/30/07     Check if read-only mode.
                                 
------------------------------------------------------------------------*/

DEFINE VARIABLE ronly  AS LOGICAL NO-UNDO.

FUNCTION checkReadOnly RETURNS CHARACTER (INPUT pcdbNname AS CHARACTER,
                                          INPUT pctableName AS CHARACTER):
                                              
    DEFINE VARIABLE hFileBuffer AS HANDLE NO-UNDO.
    DEFINE VARIABLE cWhere      AS CHAR   NO-UNDO.
    
    CREATE BUFFER hFileBuffer FOR TABLE pcdbNname + "._File" NO-ERROR.

    /* if we can't even get a handle to the table, assume it's that
      user doesn't have permissions.
    */
    IF NOT VALID-HANDLE(hFileBuffer) THEN
       RETURN "No Permission".

    ASSIGN cWhere = "WHERE " + pcdbNname + "._File._File-name = '" +
        pctableName + "'".
    hFileBuffer:FIND-FIRST(cWhere, NO-LOCK).

    IF NOT CAN-DO(hFileBuffer::_Can-read,USERID(pcdbNname)) THEN DO:
      MESSAGE "You do not have permission to use this option."
           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN "No Permission".
    END.

    IF CAN-DO("READ-ONLY", DBRESTRICTIONS(pcdbNname)) or
        NOT CAN-DO(hFileBuffer::_Can-write,USERID(pcdbNname)) THEN
        ASSIGN ronly = YES.

    RETURN "".
END FUNCTION.


FUNCTION generateGuid RETURNS CHARACTER ():
/*------------------------------------------------------------------------------
  Purpose:  Returns a new GUID value using the GENERATE-UUID function.
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cGuid      AS CHARACTER   NO-UNDO.

  cGuid = SUBSTRING(BASE64-ENCODE(GENERATE-UUID),1,22).
  
  RETURN cGuid.
END FUNCTION.

FUNCTION featureEnabled RETURNS LOGICAL
    ( INPUT pcFeature AS CHARACTER ):
/*------------------------------------------------------------------------------
  Purpose:  Returns whether a particular feature is installed or enabled.
Parameters: INPUT pcFeature - Name, or number of the feature 
    Notes:  This function has a predefined set of rules to determine if 
            a feature is installed or enabled.
            
            Features:   "1"     =    Check to see if any auditing tables exist
                                     in the database.
                        "2"     =    Check to see if any security tables exist
                                     in the database.
------------------------------------------------------------------------------*/

  DEFINE VARIABLE hFile  AS HANDLE      NO-UNDO.

  DEFINE VARIABLE lFound AS LOGICAL     NO-UNDO.

  CREATE BUFFER hFile FOR TABLE "DICTDB._file".

  CASE pcFeature:
    WHEN "1" THEN
      lFound = hFile:FIND-FIRST("WHERE _file._file-name BEGINS ~'_aud~'",NO-LOCK) NO-ERROR.
    WHEN "2" THEN
      lFound = hFile:FIND-FIRST("WHERE _file._file-name BEGINS ~'_sec~'",NO-LOCK) NO-ERROR.
    OTHERWISE
      lFound = hFile:FIND-FIRST("WHERE _file._file-name BEGINS ~'" + 
                                pcFeature + "~'",NO-LOCK) NO-ERROR.
  END CASE.
  RETURN lFound.
END FUNCTION.

FUNCTION canRun RETURNS LOGICAL
    ( INPUT pcFeature AS CHARACTER ):
/*------------------------------------------------------------------------------
  Purpose:  Returns whether the user can access a feature.
Parameters: INPUT pcFeature - Name, or number of the feature 
    Notes:  This function has a predefined set of rules to determine if 
            the connected user has permission to access a perticular feature.
            
            Features:   "No features implemented yet"
------------------------------------------------------------------------------*/
  RETURN TRUE.
END FUNCTION.

FUNCTION dbAdmin RETURNS LOGICAL
    ( INPUT pcUser AS CHARACTER ):
/*------------------------------------------------------------------------------
  Purpose:  Returns whether the user (pcUser) is a database administrator or not.
Parameters: INPUT pcUser - Userid of the user to check
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lOk AS LOGICAL     NO-UNDO.

  RUN prodict/_dctadmn.p ( INPUT USERID("DICTDB"),
                           OUTPUT lOk ).

  RETURN lOk.
END FUNCTION.
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _db-lkey.p

Description:
   Enables large key support for the connected database

Input Parameters:

Author: Fernando de Souza

Date Created: 06/09/06

----------------------------------------------------------------------------*/
DEFINE SHARED VARIABLE drec_db       AS RECID       NO-UNDO.

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  /* 1*/ "The dictionary is in read-only mode",
  /* 2*/ "This option is only available for OpenEdge databases",
  /* 3*/ "This option is not available for the working database",
  /* 4*/ "You do not have permission to use this option",
  /* 5*/ "This option only applies to databases with block sizes of 4K or 8K",
  /* 6*/ "This option is not valid for databases running on releases previous to 10.1B",
  /* 7*/ "Large key entries support for this database is already enabled",
  /* 8*/ "Large key entries support enabled successfully",
  /* 9*/ "Failed to enable large key entries support.",
  /*10*/ "If you enable large key entries support for this database, it may cause",
  /*11*/ "runtime issues to pre-10.1B clients that connect to this database.",
  /*12*/ "Do you really want to enable large keys support?"
      ].

DEFINE VARIABLE cError AS CHARACTER NO-UNDO.

IF CAN-DO(DBRESTRICTIONS(LDBNAME("DICTDB")), "Read-Only":U) THEN DO:
    MESSAGE new_lang[1]
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

/* not for dataservers */
FIND FIRST _Db WHERE RECID(_Db) = drec_db NO-ERROR.
IF NOT AVAILABLE _Db OR _Db._Db-type NE "PROGRESS" THEN DO:
    MESSAGE new_lang[2]
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

/* first let's check if the user has permissons to the database feature table */
FIND FIRST DICTDB._File WHERE _File-name = "_Database-feature" AND _File._db-recid = drec_db NO-LOCK.
IF NOT AVAILABLE DICTDB._File THEN DO:
    MESSAGE new_lang[6]
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

/* check if user can read and write to tbl */
IF NOT CAN-DO(DICTDB._File._Can-read,USERID("DICTDB")) OR 
   NOT CAN-DO(DICTDB._File._Can-write,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[4]
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

/* check if this is a 4k block size db at least */
FIND FIRST DICTDB._Dbstatus NO-ERROR.
IF AVAILABLE DICTDB._Dbstatus AND DICTDB._Dbstatus._Dbstatus-dbblksize < 4096 THEN DO:
    MESSAGE new_lang[5] 
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

/* check if db knows about large keys feature */
FIND FIRST DICTDB._Database-feature where _DBFeature_Name = "Large Keys" NO-LOCK NO-ERROR.
IF NOT AVAILABLE DICTDB._Database-feature THEN DO:
    MESSAGE new_lang[6] 
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END.

/* check if feature is already enabled */
IF DICTDB._Database-feature._DBFeature_Enabled = "1" THEN DO:
   MESSAGE new_lang[7] 
       VIEW-AS ALERT-BOX INFO BUTTONS OK.
   RETURN.
END.

MESSAGE new_lang[10] SKIP new_lang[11] SKIP new_lang[12]
    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO TITLE "Warning" UPDATE opt AS LOGICAL.

IF NOT opt THEN
    RETURN.

/* if we get here, the feature is not enabled. let's enable it */
DO TRANS ON ERROR UNDO, LEAVE:
    FIND FIRST DICTDB._Database-feature where _DBFeature_Name = "Large Keys" EXCLUSIVE-LOCK.
    DICTDB._Database-feature._DBFeature_Enabled = "1" NO-ERROR.
    IF ERROR-STATUS:ERROR THEN DO:
       ASSIGN cError = ERROR-STATUS:GET-MESSAGE(1).
       UNDO,LEAVE.
    END.

    /* don't want to see the message displayed by the client */
    RELEASE DICTDB._Database-feature NO-ERROR.
    IF ERROR-STATUS:ERROR THEN
       ASSIGN cError = ERROR-STATUS:GET-MESSAGE(1).
END.

/* display a message whether we failed or not */

FIND FIRST DICTDB._Database-feature where _DBFeature_Name = "Large Keys" NO-LOCK.
IF DICTDB._Database-feature._DBFeature_Enabled = "1" THEN
    MESSAGE new_lang[8] 
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
ELSE
    MESSAGE new_lang[9] SKIP cError
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.

RETURN.

/*********************************************************************
* Copyright (C) 2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------

File: prodict/misc/_rptaltbuf.p

Description:
    Report for alternate buffer pools

Input-Parameters:
    none
    
Output-Parameters:
    none
    
History:
    04/07/09  fernando   created

--------------------------------------------------------------------*/
&GLOBAL-DEFINE NOTTCACHE 1
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/misc/misc-funcs.i }

DEFINE VARIABLE lAsk AS LOGICAL NO-UNDO.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to run this report."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot use this option with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

RUN adecomm/_altbufrpt.p
   (INPUT drec_db).

/*********************************************************************
* Copyright (C) 2008 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------

File: prodict/misc/_rptencp.p

Description:
    Report for encryption policies

Input-Parameters:
    user_env[9] =  Numeric Identifier of the report being called.
                   1 = quick report
                   2 = detailed report

Output-Parameters:
    none
    
History:
    10/27/08  fernando   created

--------------------------------------------------------------------*/
&GLOBAL-DEFINE NOTTCACHE 1
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/misc/misc-funcs.i }

DEFINE VARIABLE lAsk AS LOGICAL NO-UNDO.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to use this option."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot use this option with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF NUM-ENTRIES(user_env[9]) = 2 THEN DO:
    /* called from adedict */
    ASSIGN user_filename =  ENTRY(2,user_env[9])
           user_env[9] =  ENTRY(1,user_env[9])
           lAsk = YES. /* ask if user wants selected table or all */
END.

RUN adecomm/_encprpt.p
   (INPUT INTEGER(user_env[9]),
    INPUT LDBNAME("DICTDB"),
    INPUT user_filename,
    INPUT lAsk).

 /*************************************************************/
  /* Copyright (c) 2011 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _browse
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     :  
    Notes       : 
  ----------------------------------------------------------------------*/
routine-level on error undo, throw.
using Progress.Lang.*.
using prodict.misc._iwidgethandler from propath. 

class prodict.misc._browse implements _iwidgethandler:
    
    define public event Sort signature void (columnName as char).
    define public event DefaultAction signature void ().
    
    define public property Browse as handle no-undo get. set.
     
       /* hidden frame parent of browse - static browse cannot be added to frame */
    define private variable BrowseFrame as handle no-undo.
    
    define public property Query as handle no-undo
        get():
            return Browse:query.
        end.       
        set(h as handle): 
            Browse:query = h.
        end.
    
    define public property Row as decimal no-undo
        get():
            return BrowseFrame:row.
        end.       
        set(drow as decimal): 
            BrowseFrame:row = drow.
        end.
    
    define public property Col as decimal no-undo
        get():
            return BrowseFrame:Col.
        end.       
        set(dcol as decimal): 
            BrowseFrame:Col = dcol.
        end.
    
    define public property Width as decimal no-undo
        get():
            return BrowseFrame:Width.
        end.       
        set(dwidth as decimal): 
            if dwidth > Width then 
            do:
                BrowseFrame:Width = dwidth.
                Browse:Width = dwidth.
            end.
            else do:  
                BrowseFrame:Width = dwidth.
                Browse:Width = dwidth.
            end.
        end.
   	
   	 define public property Height as decimal no-undo
        get():
            return BrowseFrame:Height.
        end.       
        set(dHeight as decimal): 
            if dHeight > Height then 
            do:
                BrowseFrame:Height = dHeight.
                Browse:Height = dHeight.
            end.
            else do:  
                BrowseFrame:Height = dHeight.
                Browse:Height = dHeight.
            end.
        end.
   	
	define public property Parent as handle no-undo 
    	get():
            return BrowseFrame:frame.
    	end.       
    	set(h as handle): 
    	     BrowseFrame:frame = h.
        end.
    
    define protected variable WidgetHandler as handle no-undo.
     
    /* expects browse with frame for parenting   */ 
    constructor public _browse (hBrowse as handle):
        super ( ).   
        Browse = hBrowse.
        BrowseFrame = Browse:frame.
        run prodict/misc/_eventhandler.p persistent set WidgetHandler (this-object).
    end constructor.
    
    method public void Init():    
        Browse:allow-column-searching = true.
             
        on start-search of browse persistent 
           run widgetEvent in WidgetHandler ("start-search").   
        on default-action of browse persistent 
           run widgetEvent in WidgetHandler ("default-action").    
        
    end method.
    
    method public void SetFocus():
        apply "entry" to browse.
    end method.
    
    method public void MoveAfter(h as handle):
        Browse:move-after-tab-item (h).
    end method.
    
    method public void MoveBefore(h as handle):
        Browse:move-before-tab-item (h).
    end method.
         
    method public void WidgetEvent(pcname as char):
        case pcname:
            when "start-search" then 
            do:
                Browse:select-focused-row() no-error.
                Browse:set-repositioned-row (int(Browse:down / 2),"conditional").
                Sort:Publish(Browse:current-column:name).
            end.  
            when "default-action" then do:
                DefaultAction:Publish().
            end.    
        end.               
    end method.
      
    method public void View(): 
        Browse:hidden = false. 
        Browse:select-focused-row() no-error.
    end method. 
    
    method public void ShowSort(pcSort as char): 
        define variable lDesc as logical no-undo.
        define variable cColumn as character no-undo.
        define variable hColumn as handle no-undo.
        define variable iColumn as integer no-undo.
        Browse:clear-sort-arrows().
        if pcSort > '' then
        do:
            
           lDesc = num-entries(pcSort,' ':U) > 1.
           do iColumn = 1 to Browse:num-columns:
              assign
                  cColumn = ''
                  hColumn = Browse:get-browse-column(iColumn) 
                  cColumn = hColumn:name. 
              if cColumn = entry(1,pcSort,' ':U) then
              do:
                  hColumn:sort-ascending = not lDesc.
                  return.
              end. /* column = sortcolumn */
          end. /* column loop */
        end. /* SortColumn > '' */
        finally:
           apply "end-search" to Browse.       		
        end finally.
    end method. 
  
    
    method public void Hide(): 
        Browse:hidden = true. 
    end method. 
        
    method public void Disable(): 
        Browse:sensitive = false. 
    end method. 
  
    method public void Enable(): 
        Browse:sensitive = true. 
    end method. 
    
    destructor public _browse ( ):
        delete object WidgetHandler no-error.
    end destructor.

end class./*************************************************************/
 /* Copyright (c) 2011 by progress Software Corporation.      */
 /*                                                           */
 /* all rights reserved.  no part of this program or document */
 /* may be  reproduced in  any form  or by  any means without */
 /* permission in writing from progress Software Corporation. */
 /*************************************************************/
/*------------------------------------------------------------------------
    File        : _eventhandler.p
    Purpose     : event handler for widgets in classes 

    Syntax      :

    Description : The class that creates, defines or manages widgets must 
                  - implement _iwidgethandler 
                  - start this procedure persistent with the class as input.
                  - define persistent triggers to run the widgetEvent procedure in this
                    The event name is passed back to _iwidgethandler and can be 
                    anything really. (SELF can also be used to identify widget) 
                    example:
                      ON START-SEARCH OF mBrowse persistent 
                           run widgetEvent in WidgetHandler ("start-search"). 
                     

    Author(s)   : hdaniels
    Created     :  2011
    Notes       :
  ----------------------------------------------------------------------*/

 
/* ***************************  Main Block  *************************** */
define input  parameter pEventhandler as prodict.misc._iwidgethandler no-undo.
procedure widgetEvent :
    define input parameter pcEvent as character no-undo.
    pEventhandler:WidgetEvent(pcEvent).
end procedure.    
/*------------------------------------------------------------------------
    File        : _iwidgethandler
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     :  
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

interface prodict.misc._iwidgethandler:  
    method public void WidgetEvent(pcEvent as char). 
end interface./*************************************************************/
 /* Copyright (c) 2011 by progress Software Corporation.      */
 /*                                                           */
 /* all rights reserved.  no part of this program or document */
 /* may be  reproduced in  any form  or by  any means without */
 /* permission in writing from progress Software Corporation. */
 /*************************************************************/
/*------------------------------------------------------------------------------
  Purpose:      
      
  Notes:                 
------------------------------------------------------------------------------*/
routine-level on error undo, throw.   
using Progress.Lang.* from propath.
 
 
class prodict.misc._query  :
  /* Pretend properties (must be controlled) */ 
  define public property Tables         as character no-undo get. set.
  define public property Table          as character no-undo 
      get .         
      set.
      
  define public property BaseQuery      as character no-undo get. set.
  define public property QueryString    as character no-undo get. set.
  define public property KeyFields      as character no-undo 
      get.  
      set.    
/*  define public property UseRowid       as logical   no-undo get. set. */
/*  define public property PhysicalTables as character no-undo  get. set.*/
  define public property QueryHandle    as handle    no-undo  get. set.
  define private variable mBuffers as handle extent no-undo. 
  
  constructor public _query(pcTables as char,pcKeyFields as char): 
/*       this-object(pcTables,pcTables,pcKeyFields).*/
      assign
         Tables         = pcTables  
         KeyFields      = pcKeyFields. 
  end constructor.
  
  constructor public _query(phbuffer as handle):     
      CreateQuery(phbuffer).
  end constructor.
  
  constructor public _query(phbuffers as handle extent): 
      CreateQuery(phbuffers). 
  end constructor.
  
  method private void CreateQuery(phbuffer as handle):
      define variable hBuffer as handle extent 1 no-undo.
      hBuffer[1] = phbuffer.
      CreateQuery(hBuffer).
  end method.
  
  method private void CreateQuery(phbuffers as handle  extent):
      define variable iBuffer as integer no-undo.
      define variable hBuffer as handle  no-undo.
     
      DeleteQuery().
      create query QueryHandle.    
      do iBuffer = 1 to extent(phbuffers):
          create buffer hBuffer for table phBuffers[ibuffer] .          
          QueryHandle:add-buffer(hBuffer).
          if ibuffer = 1 then 
          do:
            
              assign 
                  this-object:Table = hBuffer:name
                  Tables = this-object:Table 
                  KeyFields = hBuffer:keys.
          end.    
          else
              Tables = Tables + "," + hBuffer:name.
      end.
      
  end method.
  
  /*
  constructor public _query(pcTables as char,pcPhysicalTables as char,pcKeyFields as char): 
    /* We operate on Tables, but have it as optional parameter ! */
    if pcPhysicalTables = '' then
       pcPhysicalTables = pcTables.
    assign
        PhysicalTables = pcPhysicalTables
        Tables         = pcTables  
        KeyFields      = pcKeyFields.
  end constructor.
  */
  
  method protected void DeleteQuery():
      /* delete the handles  */
    define variable iBuffer as integer    no-undo.
    define variable h       as handle     no-undo extent 18.
    define variable iNum    as integer    no-undo.
 
    if valid-handle(QueryHandle) then
    do:
      iNum = QueryHandle:num-buffers.
      /* we loose num-buffers on first delete */
 
      do iBuffer = 1 to iNum:
        h[iBuffer] = QueryHandle:get-buffer-handle(iBuffer).
      end.
      
      do iBuffer = 1 to iNum: 
        delete object h[iBuffer]  no-error.
      end.
      delete object QueryHandle no-error.
    end.
      
  end method.
  
  /* delete the dynamic query and buffers */ 
  destructor public _query () :
      DeleteQuery().
  end destructor.

  method public logical Prepare ():
      define variable cQuery as character no-undo.
      if QueryString <> "" then 
          cQuery = QueryString.
      else
          cQuery = CurrentQuery().     
      return QueryHandle:query-prepare(cQuery ).     
  end.
  
  method public logical Init ():
      OpenQuery().
      GetFirst().      
  end.
  
   method public void GetFirst():
      QueryHandle:reposition-to-row(1) no-error.
      
  end method.     
  
  method public void OpenQuery():
      Prepare().
      QueryHandle:query-open().
  end method.     
  
  
  method protected logical ResetQuery ():
      return QueryHandle:query-prepare(defaultQuery()).     
  end.
  
  method protected character CurrentQuery ():
  /*------------------------------------------------------------------------------
    Purpose:     Return the current query for query manipulation and prepare.
                 returns the default if not yet prepared.
  ------------------------------------------------------------------------------*/
      define variable cQueryString as character  no-undo.
    
      if QueryHandle:prepare-string > '' then
          return QueryHandle:prepare-string.

      return DefaultQuery().

  end method. 
  
  method public character extent GetPosition():
      define variable i          as integer   no-undo.
      define variable bufferHdl  as handle    no-undo.
      define variable fieldName  as character no-undo.
      define variable bufferName as character no-undo.
      define variable tableNum   as integer   no-undo.
      define variable keyWhere   as character extent no-undo.
      define variable fieldWhere as character no-undo.
      
      extent(keyWhere) = num-entries(Tables).
      do i = 1 to num-entries(KeyFields):
          fieldName = entry(i,KeyFields).
          if num-entries(fieldName,".") > 2 then
              undo, throw new AppError("Too many qualifiers in KeyFields").
          if num-entries(fieldName,".") = 2 then
              assign 
                  bufferName = entry(1,fieldName,".")
                  fieldName  = entry(2,fieldName,".").
          else 
              bufferName = entry(1,Tables).
          
          assign
              tableNum   = lookup(bufferName,Tables)        
              bufferHdl  = QueryHandle:get-buffer-handle(bufferName).
 
          if (bufferHdl:avail) then   
              keyWhere[tableNum] = bufferName + "." + fieldName 
                                  + " = " 
                                  + quoter(bufferHdl:buffer-field(fieldName):buffer-value).
          else 
              keyWhere[tableNum] = ?.                       
      end.    
      return keyWhere.
  end method.    
  
  method protected character DefaultQuery ():
  /*------------------------------------------------------------------------------
    Purpose:     Return the BaseQuery or build a default query. 
  ------------------------------------------------------------------------------*/
    define variable iBuffer     as integer    no-undo.
    define variable cPrepare    as character  no-undo.
    define variable cBuffer     as character  no-undo.
    define variable cParent     as character  no-undo.
    define variable cMode       as character  no-undo.
    define variable cKeyTable   as character  no-undo.

    if BaseQuery <> '' then
      return BaseQuery.
    
    /* assume the first table in the definition is the main table that 
       the others join to and that need to have 'EACH' if joined from
       one of the other tables */
    cKeyTable = entry(1,Tables).
    
    /* If there's more than one buffer than add them, just assuming that
       an OF relationship to the first table in tables will properly relate them. */
    cPrepare = " FOR EACH " + QueryHandle:get-buffer-handle(1):NAME + " NO-LOCK ".
    do iBuffer = 2 to QueryHandle:num-buffers:

      assign 
          cBuffer  = QueryHandle:get-buffer-handle(iBuffer):NAME
          cParent  = if cKeyTable = cBuffer then 
                         QueryHandle:get-buffer-handle(1):NAME
                     else  
                         QueryHandle:get-buffer-handle(cKeyTable):NAME
          cMode    = if cKeyTable = cBuffer then 'EACH' else 'FIRST'
          cPrepare = cPrepare 
                 + ", " + cMode + " " + cBuffer + " OF " +  cParent + " NO-LOCK".

    end.   /* DO iBuffer = 2 */
    cPrepare = cPrepare + ' INDEXED-REPOSITION'.  
    return cPrepare.
  end.

  method public character ColumnValue (pcColumn as char):
    define variable cBuffer as character  no-undo.
    define variable cColumn as character  no-undo.
    define variable cValue  as character  no-undo.
    define variable hBuffer as handle     no-undo.
    if num-entries(pcColumn,".") = 2 then
        assign
            cBuffer = entry(1,pcColumn,'.')
            cColumn = entry(2,pcColumn,'.')  
            hBuffer = QueryHandle:get-buffer-handle(cBuffer).
    else 
        hBuffer = QueryHandle:get-buffer-handle(1).        
    if hBuffer:AVAIL then
    do:
      /* extent support could be added by <field>[i] as param, 
        but this used for keys though */
      cValue = hBuffer:buffer-field(cColumn):BUFFER-VALUE(0). 
      /* this string is for transport of values, so return unknown as string
       (assuming '?' never is a value in a progress DB...)*/        
      return if cValue <> ? then cValue else '?'.
    end.
    return ?. /* not avail*/ 
  end method.

/*  /* order neutral position that is safe if tables changes order in query          */
/*     passed back to setPosition                                                    */
/*     note that one need all rowids when the unique table is not                    */
/*     the first  */                                                                 */
/*  method public character extent GetPosition ():                                   */
/*     define variable iBuffer as integer    no-undo.                                */
/*     define variable cBuffer as character  no-undo.                                */
/*     define variable cPosition as character extent no-undo.                        */
/*                                                                                   */
/*     extent(cPosition) = num-entries(Tables).                                      */
/*                                                                                   */
/*     do iBuffer = 1 to num-entries(Tables):                                        */
/*       assign                                                                      */
/*         cBuffer = entry(iBuffer,Tables)                                           */
/*         cPosition[iBuffer] = string(QueryHandle:get-buffer-handle(cBuffer):rowid).*/
/*     end.                                                                          */
/*     return cPosition.                                                             */
/*  end method.                                                                      */
  
  /* set position as returned from GetPosition */
  method public logical SetPosition (prPosition as rowid extent):
      define variable lOk as logical no-undo.
      if extent(prPosition) = 1 then
          lOk = QueryHandle:reposition-to-rowid(prPosition[1]) no-error.
      else
          lOk = QueryHandle:reposition-to-rowid(prPosition) no-error.
      if lOk then 
          QueryHandle:get-next.
      return lOk.  
  end method. 
  
  method public logical SetPosition (pKeyWhere as char):
      define variable tableNum   as integer no-undo.
      define variable tokenNum   as integer no-undo.
      define variable fieldName  as character no-undo.
      define variable fieldValue as character no-undo.
      define variable bufferName as character no-undo.
      define variable keyWhere   as character extent no-undo.
      
      extent(keyWhere) = num-entries(Tables).
      /* remove double blanks */
      do while index(pKeyWhere,"  ") > 0:
          pKeyWhere = replace(pKeyWhere,"  "," ").
      end.     
      
      /* allow string passed without "where" and trim blanks front/end */ 
      pKeyWhere = (if entry(1,pKeyWhere," ") <> "where" then "where " else "")
                + trim(pKeyWhere," ").
          
      do tokenNum = 1 to num-entries(pKeyWhere," ") by 3:
          if tokenNum > 1 and entry(tokenNum,pKeyWhere," ") <> "and" then
              undo, throw new AppError("Illegal format of key where: "  + pKeyWhere).
      
          assign
              fieldName  = entry(tokenNum + 1,pKeyWhere," ")
              fieldValue = entry(tokenNum + 2,pKeyWhere," ").
          
          if num-entries(fieldName,".") = 1 then
          do:
              if num-entries(Tables) = 1 then 
                  bufferName = Tables.
              else
                  undo, throw new AppError("Illegal unqualified field reference: "  + fieldName).
          end.
          else if num-entries(fieldName,".") = 2 then
              assign 
                  bufferName = entry(1,fieldName,".")
                  fieldName  = entry(2,fieldName,".").
          else do:
              undo, throw new AppError("Too many qualifiers in field reference: "  + fieldName).
          end.
 
          assign 
              tableNum = lookup(bufferName,Tables) 
              keyWhere[tableNum] = (if keyWhere[tableNum] > "" 
                                    then keyWhere[tableNum] + " and " 
                                    else "where ")
                                  +  bufferName + "." + fieldName 
                                  + " = " 
                                  + if not fieldValue begins "'" and not fieldValue begins '"' 
                                    then quoter(fieldValue)
                                    else fieldValue.         
             
      end.    
      SetPosition(KeyWhere).
  end method.
  
  /* set position as returned from GetPosition */
  method public logical SetPosition (pcPosition as char extent):
      define variable hBuffer    as handle  no-undo.
      define variable iBuffer    as integer no-undo.
      define variable iTable     as integer no-undo.
      define variable rPosition  as rowid   extent no-undo.
      define variable lOk        as logical no-undo.
      
      extent(rPosition) = QueryHandle:num-buffers.
      do iBuffer = 1 to QueryHandle:num-buffers:
          iTable = lookup(QueryHandle:get-buffer-handle(iBuffer):NAME,Tables).
          /*
          if UseRowid then 
              rPosition[iBuffer] = to-rowid(pcPosition[iTable]).
          else do:
            */     
              hBuffer = QueryHandle:get-buffer-handle(iTable). 
              hBuffer:find-unique("where " + pcPosition[iTable]) no-error.
              rPosition[iBuffer] = hBuffer:rowid.
/*          end.*/
      end.
      
      return SetPosition(rPosition).
  end method.
 
  method public character ValueList  
   ( pcColumns   as char,
     pcFormat    as char,
     pcDelimiter as char) :
/*------------------------------------------------------------------------------
  Purpose: Retrieve a list of data from ALL rows in the dataobject.     
  Parameters: 
    pcColumns - Comma separated list of   column names.
    pcFormat  - Formatting option
                 blank or ?   - unformatted: columnValue()  
                'Formatted'   - Formatted without trailing blanks                                     
                'TrimNumeric' - Formatted without leading spaces for
                                numeric data (left justified).     
                'NoTrim'      - Formatted with leading and trailing blanks. 
                ' &1 &2 '     - &n, where the number references the column 
                                in pcColumns order, indicates that the column 
                                values should be substituted as specified 
                                instead of returned as delimiter separated
                                values. This allows formatting data to be mixed
                                with the returned values; f.ex: '&2 (&1)', 
                                '&2 / &1'  etc.. 
                                In order to build a list-item-pair list just 
                                ensure that the delimiter is in the format;
                                F. ex: '&2 (&1)' + ',' + '&1' where ',' also 
                                is passed as delimiter would return a paired
                                list where the second item of the pair is the 
                                column number one.   
              pcDelimiter     - Single char delimiter 
                                 ?      = chr(1) ! 
                                 blank  = single space !         
              
  Notes: - Should only be used with smaller amounts of records/data, as all data 
           need to fit in the character return value. The limit is in theory 32K,
           in reality somewhat smaller. The concatination of the data is 
           currently wrapped in an on stop block using no-error. The Progress 
           error message will be shown if the limit is encountered.
         - Maximum 9 columns can be passed when a substitute format is specified   
------------------------------------------------------------------------------*/ 
  define variable hDataQuery   as handle     no-undo.
  define variable hBuffer      as handle     no-undo.
  define variable rRowid       as rowid      no-undo.
  define variable iLastRowNum  as integer    no-undo.
  define variable iCol         as integer    no-undo.
  define variable cValue       as character  no-undo.
  define variable cList        as character  no-undo.
  define variable iReturnRows  as integer    no-undo.
  define variable iLoop        as integer    no-undo.
  define variable hColumnExt   as handle     no-undo extent 9.
  define variable cSub         as character  no-undo extent 9.
  define variable hColumn      as handle     no-undo.
  define variable lSizeError   as logical    no-undo. /* if bfx size error was detected */
  define variable iNumCols     as integer    no-undo.
  define variable lSubstitute  as logical    no-undo.
  define variable cSubstitute  as character  no-undo.
  define variable cMessage     as character  no-undo.
  define variable lRebuild     as logical    no-undo.
  define variable iFirstRowNum as integer    no-undo.
  define variable cTable       as character  no-undo.
  define variable cColumn      as character  no-undo.
  define variable cColName     as character  no-undo.
    
   /* It ain't pretty... but fast ..  
      This is used to assign 9 fields from the buffer to be substituted without looping 
      (9 = max substititute params)
      through the fields */
   &SCOPED-DEFINE  formatvalue ~
      IF VALID-HANDLE(~{&hdl~}) ~
      THEN IF ~{&hdl~}:BUFFER-VALUE = ? THEN '?':U ~
           ELSE IF pcFormat = '' OR lSubstitute THEN ~{&hdl~}:BUFFER-VALUE ~
           ELSE IF pcformat = 'TrimNumeric':U AND CAN-DO('Decimal,Integer':U,~{&hdl~}:DATA-TYPE) ~
                THEN TRIM(~{&hdl~}:STRING-VALUE) ~
                ELSE IF pcformat = 'Formatted':U OR pcFormat = 'TrimNumeric':U ~
                     THEN RIGHT-TRIM(~{&hdl~}:STRING-VALUE) ~
                     ELSE ~{&hdl~}:STRING-VALUE ~
      ELSE ''
  &SCOPED-DEFINE hdl hColumnExt[~{&Num~}]
  
  &SCOPED-DEFINE Num 1
  &SCOPED-DEFINE formatvalue1 {&formatvalue}
  &SCOPED-DEFINE Num 2
  &SCOPED-DEFINE formatvalue2 {&formatvalue}
  &SCOPED-DEFINE Num 3
  &SCOPED-DEFINE formatvalue3 {&formatvalue}
  &SCOPED-DEFINE Num 4
  &SCOPED-DEFINE formatvalue4 {&formatvalue}
  &SCOPED-DEFINE Num 5 
  &SCOPED-DEFINE formatvalue5 {&formatvalue}
  &SCOPED-DEFINE Num 6 
  &SCOPED-DEFINE formatvalue6 {&formatvalue}
  &SCOPED-DEFINE Num 7
  &SCOPED-DEFINE formatvalue7 {&formatvalue}
  &SCOPED-DEFINE Num 8
  &SCOPED-DEFINE formatvalue8 {&formatvalue}
  &SCOPED-DEFINE Num 9
  &SCOPED-DEFINE formatvalue9 {&formatvalue}
  
  &UNDEFINE hdl
  
  /* We are not opening the query from here .. */
  if valid-handle(QueryHandle) and QueryHandle:is-open then
  do:
      
        /* ? is CHR(1) */
    if pcDelimiter = ? then
      pcDelimiter = chr(1).
    /* Ensure blank delimiter is single space */ 
    else if pcDelimiter = "":U then
      pcDelimiter = " ":U.
    
    hBuffer = QueryHandle:get-buffer-handle(1). 
    
    assign           /* if then else used as ? is allowed in format */
      lSubstitute = if index(pcFormat,'&':U) > 0 then true else false  
      /* Used in WHEN, so must be set BEFORE Assign statement! */  
      iNumCols = num-entries(pcColumns). 
    
    if lSubstitute and iNumCols > 9 then
    do:
        undo, throw new AppError("The maximum number of columns that can be passed to ValueList()"
            +   " with a substitute format is 9.").  
     
    end.
  
    if lSubstitute then 
      assign
        cSubstitute = pcFormat
        /* for default substitute we remove trailing banks in data */
        pcFormat    = 'Formatted':U.
    
    else do: 
       /* support dashes in format input parameter */
       pcFormat = replace(pcformat,"-":U,"":U). 

      /* use substitute logic for any format in order to use the performance 
         preprocessor and avoid looping thru each column */   
       do iCol = 1 to MIN(9,iNumCols):
         cSubstitute = cSubstitute 
                     + (if iCol = 1 then '' else pcDelimiter)
                     +  '&':U + STRING(iCol).
       end.
    end.
    
    /* Maximize performance, avoid regetting dynamic buffer fields in row loop.
       (This loop is duplicated below inside the column loop for column 
        number 10 and higher )*/
       
    do iCol = 1 to iNumCols:
      cColumn  = entry(iCol,pcColumns).
      if num-entries(cColumn,'.':U) > 1 then
        assign
          cTable   = entry(1,cColumn,'.')
          cColName = entry(2,cColumn,'.').
      else 
        assign
          cTable   = ''  
          cColName = cColumn.   
     
       if cTable = '' or hBuffer:name = cTable then
           hColumnExt[iCol] = hBuffer:buffer-field(cColname).  
       else do:
           hColumnExt[iCol] = QueryHandle:get-buffer-handle(cTable):buffer-field(cColname).
       end.    
       if not valid-handle(hColumnExt[iCol]) then
       do:
           undo, throw new AppError("Column " + cColumn + " not found" ).
       end.
    end. /* DO iCol = 1 TO iNumCol */
  
 
    QueryHandle:get-first ().
    if hBuffer:available then 
    do:
        
      /**  
       /* We cannot call rowValues with data from the middle of the batch */
      if iFirstRowNum = ? then
      do:
        message "The rowValues() function is being called while the first record of"
                " the result set is not present in the existing batch." skip
                if {fn getRebuildOnRepos} 
                then "The RebuildOnRepos property must be FALSE in order to call rowValues()"
                   + " in an object that only has a batch of data."
                else ""   
                view-as alert-box error.

        return ?.
      end.
      **/
      BuildBlock:
      do iLoop = 1 to /*if iLastRowNum = ? then 2 else*/ 1: /* need two loops if batching */      
        /*
        if iLoop = 2 then
          dynamic-function("retrieveBatch":U in target-procedure,
                           'NEXT':U,
                           0). /* all remaining data */
          */  
        do while QueryHandle:query-off-end = false:
  
          /* on stop undo, leave to manage bfx error */
          do on stop undo, leave :
              /* Use local variable to avoid issues with -inp blowing up
                 the SUBSTITUTE() function.
               */
              assign cSub[1] = {&formatvalue1}
                     cSub[2] = {&formatvalue2}
                     cSub[3] = {&formatvalue3}
                     cSub[4] = {&formatvalue4}
                     cSub[5] = {&formatvalue5}.
              /* Break up assign stmt to avoind -inp errors
                 on the assign statement.
               */
              assign cSub[6] = {&formatvalue6}
                     cSub[7] = {&formatvalue7}
                     cSub[8] = {&formatvalue8}
                     cSub[9] = {&formatvalue9}.
              
              assign cList = cList + pcDelimiter
                           + SUBSTITUTE(cSubstitute,
                                        cSub[1], cSub[2], cSub[3],
                                        cSub[4], cSub[5], cSub[6],
                                        cSub[7], cSub[8], cSub[9]) NO-ERROR.
          end. /* end assign block */         
            
          if error-status:error then 
          do:
            assign
              lSizeError = true
              cMessage   = error-status:get-message(1). 
            leave BuildBlock.
          end.
          
          if iNumCols > 9 then
          do iCol = 10 to iNumCols on error undo, throw:
            cColumn  = entry(iCol,pcColumns).
            if num-entries(cColumn,'.':U) > 1 then
              assign
                cTable   = entry(1,cColumn,'.')
                cColName = entry(2,cColumn,'.').
            else 
              assign
                cTable   = ''  
                cColname = cColumn. 
           
            if cTable = '' or hBuffer:name = cTable then
                 hColumnExt[iCol] = hBuffer:buffer-field(cColname).  
            else do:
                hColumnExt[iCol] = QueryHandle:get-buffer-handle(cTable):buffer-field(cColname).
            end.
            if not valid-handle(hColumnExt[iCol]) then
            do:
                undo, throw new AppError("Column " + cColumn + " not found" ).
            end.
          
            &SCOPED-DEFINE hdl hColumn
            cValue = {&formatvalue}.
            &UNDEFINE hdl 
            /* on stop undo, leave to avoid bfx error */
            do on stop undo, leave :
              assign
               cList = cList 
                     + pcDelimiter
                     + cValue NO-ERROR.
          
            end. /* end assign block */         
            
            if error-status:error then 
            do:
              assign
                lSizeError = true
                cMessage   = error-status:get-message(1). 
              leave BuildBlock.
            end.
          end. /* do iCol = 9 to num-entries */         
          QueryHandle:get-next.
        end. /* BuildBlock: do while Query-off-end = false */    
      end.  /* do loop */
    end. /* if hRowObject:avail  */
    /*
    if rRowid <> ? then
    do:  
      QueryHandle:REPOSITION-TO-ROWID(rRowid). 
      if not hBuffer:AVAILABLE then
        QueryHandle:GET-NEXT.
    end.
     */
  end. /* queryopen and valid */
  
  /* More than 32K in string error... */ 
  if lSizeError then 
  do:
      undo, throw new AppError(cmessage).       
  end.

  /* Ensure that only the first delimiter is removed; as opposed to the 
     left-trim(...,Separator). We may have space as delimiter and prepend the 
     delimiter above */
  return substring(cList,2).

  &UNDEFINE formatvalue
  &UNDEFINE formatvalue1
  &UNDEFINE formatvalue2
  &UNDEFINE formatvalue3
  &UNDEFINE formatvalue4
  &UNDEFINE formatvalue5
  &UNDEFINE formatvalue6
  &UNDEFINE formatvalue7
  &UNDEFINE formatvalue8
  &UNDEFINE formatvalue9
  &UNDEFINE num
  end method. 
end class./*********************************************************************
* Copyright (C) 2005 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _valsch.p

Description:
   Validates DataServer selections for a schema holder for delta.df
   and the logical database selected within the schema holder.

Input Parameters:
   ds_shname    - Schema holder database name
   ds_dbname    - Logical database name in schema holder database
   user-dbtype  - Logical database type
   shdb-id      - RECID of schema holder database
   dictdb-id    - RECID of DICTDB/DICTDB2 database
   errcode      - Reason code for failure. 

Author: David Moloney

Date Created: 05/08/13

----------------------------------------------------------------------------*/

DEFINE INPUT        PARAMETER ds_alias    AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER ds_shname   AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER ds_dbname   AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER user-dbtype AS CHARACTER NO-UNDO.
DEFINE OUTPUT       PARAMETER shdb-id     AS RECID     NO-UNDO.
DEFINE OUTPUT       PARAMETER dictdb-id   AS RECID     NO-UNDO.
DEFINE OUTPUT       PARAMETER errcode     AS INTEGER   NO-UNDO.

DEFINE VARIABLE i             AS INTEGER   NO-UNDO.
DEFINE VARIABLE hBuf          AS HANDLE    NO-UNDO.
DEFINE VARIABLE hQ            AS HANDLE    NO-UNDO.
DEFINE VARIABLE idfld         AS HANDLE    NO-UNDO.

shdb-id = ?.
dictdb-id = ?.
errcode = 0.

/* DICTDB/DICTDB2 references not always known to caller, so running dynamic db requests */ 

CREATE BUFFER hBuf FOR TABLE ds_alias + "._Db". 

/* RECID of compare database */
IF ds_shname <> ? THEN DO:
  IF ds_shname = SDBNAME(ds_alias) THEN DO:
    IF VALID-HANDLE(hBuf) THEN 
      hBuf:FIND-FIRST('WHERE ' + ds_alias + '._Db._Db-type = ' + QUOTER("PROGRESS"), NO-LOCK) NO-ERROR.
    IF hBuf:AVAILABLE THEN
      shdb-id = hBuf:RECID.
  END.
  ELSE
    errcode = 1. /* Schema holder database not set properly */
END.

CREATE QUERY hQ.
hQ:SET-BUFFERS(hBuf).

IF user-dbtype = "" THEN DO:

  hQ:QUERY-PREPARE("FOR EACH " + ds_alias + "._Db WHERE " + ds_alias + "._Db._Db-type <> " + QUOTER("PROGRESS")).
  hQ:QUERY-OPEN().

  REPEAT:
    hQ:GET-NEXT().
    IF hQ:QUERY-OFF-END THEN LEAVE.
    IF ds_dbname = "" THEN DO:
      ds_dbname = hBuf:BUFFER-FIELD("_Db-name"):BUFFER-VALUE().
      user-dbtype = hBuf:BUFFER-FIELD("_Db-type"):BUFFER-VALUE().
    END.
    ELSE DO: /* If there are more than one non-progress dbs */
      ds_dbname = "". /* Reset to empty */
      user-dbtype = "". 
      errcode = 3.
    END.
  END.
  IF user-dbtype = "" AND errcode = 0 THEN
    user-dbtype = "PROGRESS". /* Revert back to PROGRESS if there were no non-progress logical dbs */

  hQ:QUERY-CLOSE().
END.

IF user-dbtype = "" OR CAPS(ds_dbname) = CAPS("<none>") THEN 
  user-dbtype = "PROGRESS". /* With no foreign schemas, revert to original Progress schema incremental dump */
ELSE DO:

  hQ:QUERY-PREPARE("FOR EACH " + ds_alias + "._Db WHERE " + ds_alias + "._Db._Db-type = " + QUOTER(user-dbtype)).
  hQ:QUERY-OPEN().

  REPEAT:
    hQ:GET-NEXT().
    IF hQ:QUERY-OFF-END THEN LEAVE.
    IF hBuf:BUFFER-FIELD("_Db-name"):BUFFER-VALUE() = ds_dbname THEN DO:
      IF ds_shname <> SDBNAME(ds_dbname) THEN DO: /* Sanity check */
        errcode = 2. /* Logical schema is attached to wrong schema holder */
        RETURN.
      END.
      ELSE 
        dictdb-id = hBuf:RECID.
    END.
  END.
  hQ:QUERY-CLOSE().

END.

if dictdb-id = ? AND CAPS(ds_dbname) <> CAPS("<none>") THEN errcode = 4.

DELETE OBJECT hQ.

hBuf:BUFFER-RELEASE().
DELETE OBJECT hBuf.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/odb/_beauty.p

Description:
    wrapper to odb/_odb_fix.p, which fix-up a SI to match an original
    PROGRESS-DB
    

Input-Parameters:
    none

Output-Parameters:
    none
    
History:
    96/06   hutegger    created

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/mss/mssvar.i NEW }

{ prodict/gate/beauty.i
  &edb-type = "MSS"
  }

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* MSS stored procedures definitions 

  History:  DLM 01/28/98 Added files to handle procedures
            DLM 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
            musingh 03/30/11 Added additional _Fields to the SQLColumns_buffer.
  
*/
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.
DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.
batch_mode = SESSION:BATCH-MODE.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "SQLTables" NO-ERROR.
IF AVAILABLE _File THEN DO:
  find _db where RECID(_Db) = dbkey NO-LOCK.
  IF NOT batch_mode THEN
  MESSAGE "Meta schema definitions for" _db-name "already exists.".
  RETURN.
END. 


CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLTables"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLTables"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 
/* Stored procedure for SQLTables ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLTables_buffer"
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLTables_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Remark"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 5
  _Field._For-name     = "Type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for SQLColumns ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLColumns"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLColumns"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for SQLColumns ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLColumns_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLColumns_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Data-type"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 5
  _Field._For-name     = "Data-type"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 60   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 6
  _Field._For-name     = "Type-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Precision"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "9999999999"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 7
  _Field._For-name     = "Precision"
  _Field._For-type     = "integer".


CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Length"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 80
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 8
  _Field._For-name     = "Length"
  _Field._For-type     = "integer".  
 
 
CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Scale"  
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 90
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 9
  _Field._For-name     = "Scale"
  _Field._For-type     = "smallint".
 
   
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Radix"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 100 
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 10 
  _Field._For-name     = "Radix"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "Nullable" 
  _Field._Data-Type    = "integer" 
  _Field._Initial      = "0"    
  _Field._Mandatory    = yes 
  _Field._Format       = "99999" 
  _Field._Order        = 110 
  _Field._Fld-stdtype  = 32 
  _Field._Fld-stoff    = 11 
  _Field._For-name     = "Nullable" 
  _Field._For-type     = "smallint". 


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Remarks"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 120 
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 12 
  _Field._For-name     = "Remarks"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "column-def"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 130 
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 13 
  _Field._For-name     = "column-def"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "sql-data-type"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 140
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 14
  _Field._For-name     = "sql-data-type"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "sql-datetime-sub"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 150
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 15
  _Field._For-name     = "sql-datetime-sub"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "char-octet-length"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 160
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 16
  _Field._For-name     = "char-octet-length"
  _Field._For-type     = "integer".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "ordinal-pos"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 170
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 17
  _Field._For-name     = "ordinal-pos"
  _Field._For-type     = "integer".
CREATE _Field. /* file: col$ */

ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "is-nullable"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 180   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 18
  _Field._For-name     = "is-nullable"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "ss-data-type"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 190
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 19
  _Field._For-name     = "ss-data-type"
  _Field._For-type     = "integer".

/* Stored procedure for SQLStatistics ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLStatistics"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLStatistics"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for SQLStatistics ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLStatistics_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLStatistics_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "non-unique"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 40 
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 4
  _Field._For-name     = "non-unique"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "index-qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 50   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 5
  _Field._For-name     = "index-qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "index-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 60   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 6
  _Field._For-name     = "index-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  

 
CREATE _Field. /* file: col$ */ 
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type" 
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 7
  _Field._For-name     = "Type"
  _Field._For-type     = "smallint".

  
CREATE _Field. /* file: col$ */  
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "seq-in-index" 
  _Field._Data-Type    = "integer" 
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes 
  _Field._Format       = "99999" 
  _Field._Order        = 80  
  _Field._Fld-stdtype  = 32 
  _Field._Fld-stoff    = 8 
  _Field._For-name     = "seq-in-index"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 90 
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 9 
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

 
CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "collation"
  _Field._Data-Type    = "character" 
  _Field._Initial      = "" 
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 100 
  _Field._Fld-stdtype  = 36 
  _Field._Fld-stoff    = 10 
  _Field._For-name     = "collation" 
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".    
 
 
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Cardnality"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "9999999999"
  _Field._Order        = 110 
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 11 
  _Field._For-name     = "Cardnality"
  _Field._For-type     = "integer".


CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Pages"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 120 
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 12 
  _Field._For-name     = "Pages"
  _Field._For-type     = "integer".  

/* Stored procedure for GetInfo ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetInfo"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetInfo"
  _File._For-Owner    = "".
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "unused"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 1
  _Field._For-name     = "unused"
  _Field._For-type     = "integer".

CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetInfo_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetInfo_buffer"
  _File._For-Owner    = "".
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "escape_char"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "escape_char"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "driver_name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "driver_name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "driver_version" 
  _Field._Data-Type    = "character" 
  _Field._Initial      = "" 
  _Field._Mandatory    = yes 
  _Field._Format       = "x(32)" 
  _Field._Order        = 30  
  _Field._Fld-stdtype  = 36 
  _Field._Fld-stoff    = 3 
  _Field._For-name     = "driver_version" 
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".    

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "dbms_version"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "dbms_version"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "odbc_version"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 5
  _Field._For-name     = "odbc_version"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "dbms_name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 6
  _Field._For-name     = "dbms_name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "prgrs_srvr_version"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 7
  _Field._For-name     = "prgrs_srvr_version"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

 
CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "prgrs_clnt_version"
  _Field._Data-Type    = "character"  
  _Field._Initial      = ""    
  _Field._Mandatory    = yes 
  _Field._Format       = "x(32)" 
  _Field._Order        = 80    
  _Field._Fld-stdtype  = 36 
  _Field._Fld-stoff    = 8 
  _Field._For-name     = "prgrs_clnt_version" 
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".   
   
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "quote_char"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 90
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 9
  _Field._For-name     = "quote_char"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

  
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "do_extents"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 100
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 10 
  _Field._For-name     = "do_extents"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

 
/* Stored procedure for GetFieldIds ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetFieldIds"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetFieldIds"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "logical-file-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "logical-file-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "file-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "file-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "file-num"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 3
  _Field._For-name     = "file-num"
  _Field._For-type     = "integer".

 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "spcl-len"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 4 
  _Field._For-name     = "spcl-len"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "user-len"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 5 
  _Field._For-name     = "user-len"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "table-len"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 6 
  _Field._For-name     = "table-len"
  _Field._For-type     = "smallint".

/* Stored procedure for GetFieldIds ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetFieldIds_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetFieldIds_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "field-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "field-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for sending an info string to PROGRESS. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SendInfo"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SendInfo"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "info"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "info"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 

/* Stored procedure for CloseAllProcs ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "CloseAllProcs"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "CloseAllProcs"
  _File._For-Owner    = "".

/* OE00195067 BEGIN: Stored procedure for SQLConstraintInfo ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "_Constraint_Info"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "_Constraint_Info"
  _File._For-Owner    = "".

CREATE _Field. /* file: SQLConstraintInfo$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 
/* OE00195067 END */

/* Generic Stored procedures buffer.					  */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "PROC-TEXT-BUFFER"
  _File._ianum        = 6
  _File._For-type     = "GENERIC-BUFFER"
  _File._For-name     = "NONAME"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE.
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "proc-text"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "NONAME"
  _Field._For-type     = "char".

/* Dummy Stored procedures SQL pass thru. 				*/
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SEND-SQL-STATEMENT"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._For-name     = "SEND-SQL-STATEMENT"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE.
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "sql-statement"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "sql-statement"
  _Field._For-type     = "char".

/*
   The following _file and _field records are for support of stored
   procedures in ODBC
*/
   
CREATE _File.
ASSIGN _File._Db-recid = dbkey
       _File._File-name = "SQLProcs_buffer"
       _File._ianum     = 6
       _File._For-type = "buffer"          /* FOREIGN-TYPE */
       _File._For-name = "SQLProcs_buffer" /* FOREIGN-NAME */
       _File._Hidden = yes
       _File._Dump-name = "SQLProcs1"      /* DUMP-NAME */
       _File._For-owner = ""               /* FOREIGN-OWNER */
       _File._Fil-misc1[1] = ?             /* PROGRESS-RECID */
       _File._Fil-misc1[3] = ?             /* INDEX-FREE-FLD */
       _File._Fil-misc2[4] = ? .           /* FLD-NAMES-LIST */
       
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes             /* MANDATORY */
       _Field._Format = "x(76)"            /* FORMAT */
       _Field._Order = 10                  /* ORDER */
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1               /* FOREIGN-POS */
       _Field._For-name = "Qualifier"      /* FOREIGN-NAME */
       _Field._For-type = "char"           /* FOREIGN-TYPE */
       _Field._Fld-misc1[1] = 500          /* DSRVR-PRECISION */
       _Field._Fld-misc1[2] = ?            /* DSRVR-SCALE */
       _Field._Fld-misc1[3] = ?            /* DSRVR-LENGTH */
       _Field._Fld-misc1[4] = ?            /* DSRVR-FLDMISC */
       _Field._Fld-misc2[4] = ?.           /* MISC-PROPERTIES */
       
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "num_input_parms"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 40
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 4
       _Field._For-name = "num_input_parms"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "num_output_parms"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 50
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 5
       _Field._For-name = "num_output_parms"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "num_result_sets"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 60
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 6
       _Field._For-name = "num_result_sets"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Remarks"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 70
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 7
       _Field._For-name = "Remarks"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Procedure_type"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 80
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 8
       _Field._For-name = "Procedure_type"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.


create _File.
assign _File._Db-recid = dbkey
       _File._File-name = "SQLProcCols_buffer"
       _File._ianum     = 6
       _File._For-type = "buffer" 
       _File._For-name = "SQLProcCols_buffer"    
       _File._Hidden = yes
       _File._Dump-name = "SQLProcCols1"   
       _File._For-owner = ""      
       _File._Fil-misc1[1] = ?        
       _File._Fil-misc1[3] = ?      
       _File._Fil-misc2[4] = ?.      
     
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes          
       _Field._Format = "x(76)"    
       _Field._Order = 10       
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1           
       _Field._For-name = "Qualifier"   
       _Field._For-type = "char"    
       _Field._Fld-misc1[1] = 500    
       _Field._Fld-misc1[2] = ?     
       _Field._Fld-misc1[3] = ?     
       _Field._Fld-misc1[4] = ?     
       _Field._Fld-misc2[4] = ?.     
       
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Column-Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 40
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 4
       _Field._For-name = "Column-Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Column-Type"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 50
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 5
       _Field._For-name = "Column-Type"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Data-Type"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 60
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 6
       _Field._For-name = "Data-Type"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Type-Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 70
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 7
       _Field._For-name = "Type-Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Precision"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "999999999"
       _Field._Order = 80
       _Field._Fld-stdtype = 33
       _Field._Fld-stoff = 8
       _Field._For-name = "Precision"
       _Field._For-type = "integer"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Length"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "999999999"
       _Field._Order = 90
       _Field._Fld-stdtype = 33
       _Field._Fld-stoff = 9
       _Field._For-name = "Length"
       _Field._For-type = "integer"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Scale"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 100
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 10
       _Field._For-name = "Scale"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Radix"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 110
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 11
       _Field._For-name = "Radix"
       _Field._For-type = "Smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Nullable"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 120
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 12
       _Field._For-name = "Nullable"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Remarks"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 130
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 13
       _Field._For-name = "Remarks"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

/* Stored procedure for SQLSpecialColumns_buffer ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLSpecialColumns_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLSpecialColumns_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Scope"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Scope"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Data-type"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Data-type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Type-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Precision"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "9999999999"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 5
  _Field._For-name     = "Precision"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "integer".


CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Length"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 6
  _Field._For-name     = "Length"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "integer".  
 
CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Scale"  
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 7
  _Field._For-name     = "Scale"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "smallint".
 
CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "pseudo"  
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 80
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 8
  _Field._For-name     = "Pseudo"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "smallint".
 
CREATE _File.
ASSIGN _File._Db-recid = dbkey
       _File._File-name = "SQLProcedures"
       _File._ianum     = 6
       _File._For-type = "PROCEDURE"      
       _File._For-name = "SQLProcedures"  
       _File._Hidden = yes
       _File._Dump-name = "SQLProcedures" 
       _File._For-owner = ""              
       _File._Fil-misc1[1] = ?            
       _File._Fil-misc1[3] = ?            
       _File._Fil-misc2[4] = ?.          
      
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes           
       _Field._Format = "x(76)"          
       _Field._Order = 10              
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1           
       _Field._For-name = "Qualifier"  
       _Field._For-type = "char"        
       _Field._Fld-misc1[1] = 500       
       _Field._Fld-misc1[2] = ?         
       _Field._Fld-misc1[3] = ?         
       _Field._Fld-misc1[4] = ?         
       _Field._Fld-misc2[4] = ?.        
       
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _File.
ASSIGN _File._Db-recid = dbkey
       _File._File-name = "SQLProcColumns"
       _File._ianum     = 6
       _File._For-type = "PROCEDURE" 
       _File._For-name = "SQLProcColumns"
       _File._Hidden = yes
       _File._Dump-name = "SQLProcColumns"
       _File._For-owner = ""      
       _File._Fil-misc1[1] = ?    
       _File._Fil-misc1[3] = ?    
       _File._Fil-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 10      
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1   
       _Field._For-name = "Qualifier" 
       _Field._For-type = "char"     
       _Field._Fld-misc1[1] = 500    
       _Field._Fld-misc1[2] = ?      
       _Field._Fld-misc1[3] = ?      
       _Field._Fld-misc1[4] = ?      
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "ProcName"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "ProcName"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "ColName"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 40
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 4
       _Field._For-name = "ColName"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

/***** Prime Index to RECID support - Begin code change *********************/ 

/* Stored procedure for SQLSpecialColumns ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLSpecialColumns"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._For-name     = "SQLSpecialColumns"
  _File._Hidden       = TRUE
  _File._Dump-name     = "SQLSpecialColumns"
  _File._For-Owner    = "".

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 10      
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1   
       _Field._For-name = "Qualifier" 
       _Field._For-type = "char"     
       _Field._Fld-misc1[1] = 500    
       _Field._Fld-misc1[2] = ?      
       _Field._Fld-misc1[3] = ?      
       _Field._Fld-misc1[4] = ?      
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "TableName"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "TableName"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

/***** Prime Index to RECID support - End of code change *********************/ 

RETURN.
/*********************************************************************
* Copyright (C) 2005,2008-2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/*
Copied from _Odb_fix.p for MS Sql Server 7 DataServer

History:  D. McMann 04/21/00 Added assignment of user_env 28 and 29 as well
                               as checking for _seq in sequence name.
          D. McMann 08/14/00 Added assignment of index numbers 20000727012
          D. McMann 08/18/00 Changed size of identifiers max length 20000727-013
          D. McMann 07/05/01 Added assignment of _Order to be greater than original
                             Progress database so conflict would not happen.
                             20010703-019
          D.McMann  08/07/02 Added _Owner to FOR EACH on delete loop.
          D. McMann 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add

*/  

DEFINE INPUT PARAMETER p_edbtype AS CHARACTER NO-UNDO.

DEFINE VARIABLE sseqn            AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE sfiln            AS CHARACTER NO-UNDO.
DEFINE VARIABLE sfldn            AS CHARACTER NO-UNDO.
DEFINE VARIABLE asfldn           AS CHARACTER NO-UNDO.
DEFINE VARIABLE m21              AS CHARACTER NO-UNDO.
DEFINE VARIABLE sidxn            AS CHARACTER NO-UNDO.
DEFINE VARIABLE ppi              AS CHARACTER NO-UNDO.
DEFINE VARIABLE spi              AS CHARACTER NO-UNDO.
DEFINE VARIABLE cext             AS INTEGER   NO-UNDO.
DEFINE VARIABLE ri               AS INTEGER   NO-UNDO.
DEFINE VARIABLE msg              AS CHARACTER   EXTENT 4 NO-UNDO.
DEFINE VARIABLE max_idx_len      AS INTEGER NO-UNDO.
DEFINE VARIABLE max_id_length    AS INTEGER NO-UNDO.
DEFINE VARIABLE idbtype          AS CHARACTER NO-UNDO.
DEFINE VARIABLE del-cycle        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_idx-num       AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_files          AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_seqs           AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_views          AS CHARACTER NO-UNDO.
DEFINE VARIABLE maxorder         AS INTEGER   NO-UNDO.
DEFINE VARIABLE a                AS INTEGER   NO-UNDO.
DEFINE VARIABLE cType            AS CHARACTER NO-UNDO.
DEFINE VARIABLE migCon           AS LOGICAL   NO-UNDO.

DEFINE BUFFER   a_DICTDB         FOR DICTDB._Field.
DEFINE BUFFER   i_DICTDB        FOR DICTDB._Index.

DEFINE VARIABLE sconn            AS CHARACTER NO-UNDO.
DEFINE VARIABLE con_recid        AS INTEGER   NO-UNDO INITIAL 0.
DEFINE VARIABLE con-fld_recid    AS INTEGER   NO-UNDO.
DEFINE VARIABLE con_indx_recid   AS INTEGER   NO-UNDO.
DEFINE VARIABLE con_parnt_recid  AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_con-num        AS INTEGER   NO-UNDO.
DEFINE BUFFER   f_DICTDB2        FOR DICTDB2._File.
DEFINE BUFFER   f_DICTDB         FOR DICTDB._File.

DEFINE TEMP-TABLE verify-fname NO-UNDO
  FIELD new-name LIKE _Field._Field-name
  INDEX trun-name IS UNIQUE new-name.

DEFINE TEMP-TABLE verify-table NO-UNDO
  FIELD tnew-name LIKE _File._File-name
  INDEX trun-name IS UNIQUE tnew-name.

{ prodict/dictvar.i }
{ prodict/mss/mssvar.i } /* temp */
{ prodict/user/uservar.i }

/* DICTDB is the newly created schema holder.
 * DICTDB2 is the original progress database.
 */

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
FORM
  SKIP(1)
  msg[1] FORMAT "x(25)" LABEL "  File" SKIP
  msg[2] FORMAT "x(25)" LABEL " Field" SKIP
  msg[3] FORMAT "x(25)" LABEL " Index" SKIP
  msg[4] FORMAT "x(25)" LABEL " Component" SKIP
  SKIP(1)
  WITH FRAME mss_fix ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  TITLE " Updating MSS Schema Holder".
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

IF NOT SESSION:BATCH-MODE  
 then assign SESSION:IMMEDIATE-DISPLAY = yes.

IF ENTRY(1,user_env[36]) = "y" 
THEN migCon = YES.
ELSE migCon = NO. 
  
if  user_env[25] = "**all**"
 or user_env[25] = ""
 then assign
  l_files = "**all**"
  l_seqs  = "**all**"
  l_views = "**all**"
  del-cycle = TRUE.
else if  num-entries(user_env[25],";") < 2
 then assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = "**all**"
  l_views = "**all**".
else if  num-entries(user_env[25],";") < 3
 then assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = entry(2,user_env[25],";")
  l_views = "**all**".
 else assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = entry(2,user_env[25],";")
  l_views = entry(3,user_env[25],";").

 idbtype = { adecomm/ds_type.i
                &direction = "ETOI"
                &from-type = "p_edbtype"
                }.

IF user_env[28] <> ? AND user_env[28] <> ""  THEN
  max_idx_len = INTEGER(user_env[28]).
ELSE
  max_idx_len = 128.  

IF user_env[29] <> ? AND user_env[29] <> "" THEN
  max_id_length = INTEGER(user_env[29]).
ELSE
  max_id_length = 128.

  FOR EACH DICTDB2._View
    where ( l_views = "**all**"
         or lookup(DICTDB2._View._View-Name,l_views) <> 0
          ):
    FIND DICTDB._View WHERE DICTDB._View._View-Name = DICTDB2._View._View-Name NO-ERROR.
    IF AVAILABLE DICTDB._View THEN DO:
      FOR EACH DICTDB._View-col OF DICTDB._View:
          DELETE DICTDB._View-col.
      END.
      FOR EACH DICTDB._View-ref OF DICTDB._View:
          DELETE DICTDB._View-ref.
      END.
      DELETE DICTDB._View.
    END.
    CREATE DICTDB._View.
    ASSIGN DICTDB._View._View-Name    = DICTDB2._View._View-Name
           DICTDB._View._Auth-Id      = DICTDB2._View._Auth-Id
           DICTDB._View._Base-Tables  = DICTDB2._View._Base-Tables
           DICTDB._View._Where-Cls    = DICTDB2._View._Where-Cls
           DICTDB._View._Group-By     = DICTDB2._View._Group-By
           DICTDB._View._View-Def     = DICTDB2._View._View-Def
           DICTDB._View._Can-Read     = DICTDB2._View._Can-Read
           DICTDB._View._Can-Write    = DICTDB2._View._Can-Write
           DICTDB._View._Can-Create   = DICTDB2._View._Can-Create
           DICTDB._View._Can-Delete   = DICTDB2._View._Can-Delete
           DICTDB._View._Desc         = DICTDB2._View._Desc
           DICTDB._View._Updatable    = DICTDB2._View._Updatable.
    FOR EACH DICTDB2._View-Col of DICTDB2._View:    
      CREATE DICTDB._View-Col.
      ASSIGN DICTDB._View-Col._View-Name = DICTDB2._View-Col._View-Name
             DICTDB._View-Col._Auth-Id    = DICTDB2._View-Col._Auth-Id
             DICTDB._View-Col._Col-Name   = DICTDB2._View-Col._Col-Name
             DICTDB._View-Col._Base-Col   = DICTDB2._View-Col._Base-Col
             DICTDB._View-Col._Can-Write  = DICTDB2._View-Col._Can-Write
             DICTDB._View-Col._Can-Create = DICTDB2._View-Col._Can-Create
             DICTDB._View-Col._Vcol-Order = DICTDB2._View-Col._Vcol-Order.
    END. /* DICTDB2._View-Col */

    FOR EACH DICTDB2._View-Ref of DICTDB2._View:    
      CREATE DICTDB._View-Ref.
      ASSIGN DICTDB._View-Ref._View-Name = DICTDB2._View-Ref._View-Name
             DICTDB._View-Ref._Auth-Id   = DICTDB2._View-Ref._Auth-Id
             DICTDB._View-Ref._Ref-Table = DICTDB2._View-Ref._Ref-Table
             DICTDB._View-Ref._Base-Col  = DICTDB2._View-Ref._Base-Col.
    END. /* DICTDB2._View-Ref */
  END. /* each DICTDB2._View */

/* IF (user_env[32] <> ?   and user_env[25] BEGINS "y") THEN*/
FOR EACH DICTDB2._Sequence where ( l_seqs = "**all**"
       or lookup(DICTDB2._Sequence._Seq-Name,l_seqs) <> 0 ):
  ASSIGN sseqn = _Seq-Name
         sseqn = sseqn + "," + p_edbtype + "," + STRING(max_id_length).

  RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sseqn).

/* _wrktgen.p does not allow _seq to be at the end of the sequence name so we have to do
   the same thing here.
*/   
  IF length(sseqn) > 3 AND lc(SUBSTRING(sseqn, (LENGTH(sseqn) - 3))) = "_seq" THEN
        ASSIGN sseqn = SUBSTRING(sseqn, 1, (LENGTH(sseqn) - 1)).

  FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-LOCK.

  FIND DICTDB._Sequence OF DICTDB._Db WHERE DICTDB._Sequence._Seq-name = sseqn NO-ERROR.

  IF AVAILABLE DICTDB._Seq THEN 
    ASSIGN    
      DICTDB._Sequence._Seq-Name = DICTDB2._Sequence._Seq-Name
      DICTDB._Sequence._Seq-Init = DICTDB2._Sequence._Seq-Init
      DICTDB._Sequence._Seq-Incr = DICTDB2._Sequence._Seq-Incr
      DICTDB._Sequence._Seq-Min  = DICTDB2._Sequence._Seq-Min
      DICTDB._Sequence._Seq-Max  = DICTDB2._Sequence._Seq-Max
      DICTDB._Sequence._Cycle-Ok = DICTDB2._Sequence._Cycle-OK.

END. /* each DICTDB2._Sequence */


/* To avoid double dump-names we set them to ? for now, they will be
 * set to dictdb2._File._Dump-name lateron
 */
FOR EACH DICTDB._File WHERE DICTDB._File._DB-recid = drec_db
        and DICTDB._File._Owner = "_FOREIGN"
        and ( l_files = "**all**" or lookup(DICTDB._File._File-name,l_files) <> 0):
  ASSIGN DICTDB._File._Dump-name = ?.
END. /* each DICTDB2._File */


FOR EACH DICTDB2._File WHERE DICTDB2._File._Owner = "PUB" 
                         AND DICTDB2._File._Tbl-type = "T"
                         AND ( l_files = "**all**"
                               or lookup(DICTDB2._File._File-name,l_files) <> 0):

  IF DICTDB2._File._File-name BEGINS "_" THEN NEXT.
  
  ASSIGN sfiln = DICTDB2._File._File-name
         sfiln = sfiln + "," + p_edbtype + "," + string (max_id_length).

  RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sfiln).

  _verify-table:
  DO WHILE TRUE:
    FIND verify-table WHERE verify-table.tnew-name = sfiln NO-ERROR.
    IF NOT AVAILABLE verify-table THEN DO:
      CREATE verify-table.
      ASSIGN verify-table.tnew-name = sfiln.
      LEAVE _verify-table.
    END.
    ELSE DO:
      DO a = 1 TO 999:
        ASSIGN sfiln = SUBSTRING(sfiln, 1, LENGTH(sfiln) - LENGTH(STRING(a))) + STRING(a).

        IF CAN-FIND(verify-table WHERE verify-table.tnew-name = sfiln) THEN NEXT.
        ELSE DO:
          CREATE verify-table.
          ASSIGN verify-table.tnew-name = sfiln.
          LEAVE _verify-table.
        END.
      END.
    END.    
  END.

  FIND DICTDB._File WHERE DICTDB._File._File-name = sfiln 
                      and DICTDB._File._DB-recid = drec_db 
                      and DICTDB._File._Owner = "_FOREIGN" NO-ERROR.

  IF NOT AVAILABLE DICTDB._File THEN NEXT.

  FOR EACH DICTDB._Field OF DICTDB._File WHERE	
    DICTDB._Field._For-Type = "TIME":
   
    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB._File._File-name @ msg[1]
	DICTDB._Field._Field-name @ msg[2]
	"" @ msg[3] "" @ msg[4]
	WITH FRAME mss_fix.
    DELETE DICTDB._Field.

  END. /* each DICTDB._Field */

  /* Do first to avoid _order collisions */
  FIND LAST DICTDB._Field OF DICTDB._FILE USE-INDEX _Field-position.
  ASSIGN maxorder = DICTDB._Field._Order.

  FOR EACH DICTDB._Field OF DICTDB._File:
    ASSIGN DICTDB._Field._Order = maxorder + 5
           maxorder = maxorder + 5.
  END.

  FOR EACH DICTDB2._File-Trig OF DICTDB2._File:
    FIND DICTDB._File-Trig OF DICTDB._File WHERE   
      DICTDB._File-Trig._Event = DICTDB2._File-Trig._Event NO-ERROR.
    IF AVAILABLE DICTDB._File-Trig THEN 
        DELETE DICTDB._File-Trig.

    CREATE DICTDB._File-Trig.
    ASSIGN DICTDB._File-Trig._File-Recid = RECID(DICTDB._File)
           DICTDB._File-Trig._Event      = DICTDB2._File-Trig._Event
           DICTDB._File-Trig._Proc-Name  = DICTDB2._File-Trig._Proc-Name
           DICTDB._File-Trig._Override   = DICTDB2._File-Trig._Override.

  END. /* each DICTDB2._File-Trig OF DICTDB2._File */

  /* Clear temp table for new file */
  FOR EACH verify-fname:
     DELETE verify-fname.
  END.

  FOR EACH DICTDB2._Field OF DICTDB2._File:
    ASSIGN sfldn = DICTDB2._Field._Field-name.

    /* Avoid collisions with unrolled extents */

    ASSIGN ri = R-INDEX (sfldn, "#").    
    IF ri > 2 AND ri < LENGTH (sfldn) THEN DO:
      IF INDEX ("0123456789", SUBSTR (sfldn, ri + 1, 1)) > 0 THEN DO:
	    ASSIGN asfldn = SUBSTR (sfldn, 1, ri - 1).
	    IF CAN-FIND (DICTDB._Field OF DICTDB._File WHERE
	          DICTDB._Field._Field-name = asfldn) THEN
          OVERLAY (sfldn, ri, 1) = "_".   
      END.
    END.

    ASSIGN sfldn = sfldn + "," + p_edbtype + "," + string (max_id_length).
    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sfldn).

    /* We have to do the same thing we do when running protoora.
       We need to keep track of the names we come up with, and
       find unique names if the one we just got now is duplicate.*/
    FIND FIRST verify-fname WHERE new-name = sfldn NO-ERROR.

    IF NOT AVAILABLE verify-fname THEN DO:
      CREATE verify-fname.
      ASSIGN verify-fname.new-name = sfldn.
    END.
    ELSE DO:
        DO a = 1 TO 999:
          ASSIGN sfldn = SUBSTRING(sfldn, 1, LENGTH(sfldn) - LENGTH(STRING(a))) + STRING(a).

          IF CAN-FIND(verify-fname WHERE verify-fname.new-name = sfldn) THEN 
              NEXT.
          ELSE DO:
            CREATE verify-fname.
            ASSIGN verify-fname.new-name = sfldn.
            LEAVE. /* get out of the a =1 to 999 loop */
          END.
        END.
    END.

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB2._File._File-name @ msg[1]
        DICTDB2._Field._Field-name @ msg[2]
        "" @ msg[3] "" @ msg[4]
        WITH FRAME mss_fix.

    IF DICTDB2._Field._Extent > 0 AND NOT CAN-FIND (DICTDB._Field OF DICTDB._File 
                WHERE DICTDB._Field._Field-name = sfldn) THEN DO:
      ASSIGN asfldn = sfldn + "#".
      
      FIND a_DICTDB OF DICTDB._File WHERE a_DICTDB._Field-name = asfldn NO-ERROR.
      IF NOT AVAILABLE a_DICTDB THEN NEXT.
      
      ASSIGN m21 = a_DICTDB._For-Name.
      IF R-INDEX (m21, "#") > 3 THEN
	    ASSIGN m21 = SUBSTR (m21, 1, R-INDEX(m21, "#") - 2).

      CREATE DICTDB._Field.
      ASSIGN DICTDB._Field._File-recid      = RECID(DICTDB._File)
	         DICTDB._Field._For-Name        = m21
	         DICTDB._Field._Fld-stdtype     = a_DICTDB._Fld-stdtype
	         DICTDB._Field._Fld-stoff       = a_DICTDB._Fld-stoff
	         DICTDB._Field._Fld-misc2[8]    = a_DICTDB._Fld-misc2[8]
	         DICTDB._Field._Field-name      = DICTDB2._Field._Field-name
	         DICTDB._Field._Fld-case        = DICTDB2._Field._Fld-case
	         DICTDB._Field._Data-type       = DICTDB2._Field._Data-type
	         DICTDB._Field._Format          = DICTDB2._Field._Format
	         DICTDB._Field._Initial         = DICTDB2._Field._Initial
	         DICTDB._Field._Mandatory       = DICTDB2._Field._Mandatory
	         DICTDB._Field._Decimals        = DICTDB2._Field._Decimals
	         DICTDB._Field._Order           = DICTDB2._Field._Order
	         DICTDB._Field._Desc            = DICTDB2._Field._Desc
	         DICTDB._Field._Can-Read        = DICTDB2._Field._Can-Read
	         DICTDB._Field._Can-Write       = DICTDB2._Field._Can-Write
	         DICTDB._Field._Label           = DICTDB2._Field._Label
	         DICTDB._Field._Col-label       = DICTDB2._Field._Col-label
	         DICTDB._Field._Valexp          = DICTDB2._Field._Valexp
	         DICTDB._Field._Valmsg          = DICTDB2._Field._Valmsg
	         DICTDB._Field._Help            = DICTDB2._Field._Help
             DICTDB._Field._Col-label-sa    = DICTDB2._Field._Col-label-sa
             DICTDB._Field._Format-sa       = DICTDB2._Field._Format-sa
             DICTDB._Field._Help-sa         = DICTDB2._Field._Help-sa
             DICTDB._Field._Initial-sa      = DICTDB2._Field._Initial-sa
             DICTDB._Field._Label-sa        = DICTDB2._Field._Label-sa
             DICTDB._Field._Valmsg-sa       = DICTDB2._Field._Valmsg-sa
	         DICTDB._Field._For-Id          = a_DICTDB._For-Id
	         DICTDB._Field._For-Primary     = a_DICTDB._For-Primary
	         DICTDB._Field._For-Spacing     = a_DICTDB._For-Spacing
	         DICTDB._Field._For-Scale       = a_DICTDB._For-Spacing
	         DICTDB._Field._For-Type        = a_DICTDB._For-Type
	         DICTDB._Field._For-Itype       = a_DICTDB._For-Itype
	         DICTDB._Field._For-Xpos        = a_DICTDB._For-Xpos
	         DICTDB._Field._For-Retrieve    = a_DICTDB._For-Retrieve
	         DICTDB._Field._For-Separator   = a_DICTDB._For-Separator
	         DICTDB._Field._For-Maxsize     = a_DICTDB._For-Maxsize
	         DICTDB._Field._For-Allocated   = a_DICTDB._For-Allocated
	         DICTDB._Field._View-As         = DICTDB2._Field._View-As
	         DICTDB._Field._Extent          = DICTDB2._Field._Extent.

/*      IF DICTDB._Field._Data-type = "RECID" THEN
          DICTDB._Field._Data-type = "INTEGER".
*/
	  DO cext = 1 TO DICTDB._Field._Extent:
	    ASSIGN asfldn = sfldn + "#" + STRING (cext).

	    FIND a_DICTDB OF DICTDB._File WHERE a_DICTDB._Field-name = asfldn NO-ERROR.

	    IF AVAILABLE a_DICTDB THEN
	      DELETE a_DICTDB.

	  END. /* DICTDB._Field._Extent > 1 DO cext = 1 TO ... */
    END. /* DICTDB2._Field._Extent > 0 */
    ELSE DO: /* !  DICTDB2._Field._Extent > 0 */

      FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = sfldn NO-ERROR.
      IF NOT AVAILABLE DICTDB._Field THEN NEXT.
    END. /* !  DICTDB2._Field._Extent > 0 */

    ASSIGN cType =  DICTDB2._Field._Data-type.

    /* if type is RAW in the OE db and varchar in the foreign db, we can't make it
       RAW or we will get error 6187, so leave it alone.
    */
    IF cType = "RAW" AND INDEX(DICTDB._Field._For-type, "varchar") > 0  THEN
       ASSIGN cType = DICTDB._Field._Data-type.

    ASSIGN  DICTDB._Field._Field-name   = DICTDB2._Field._Field-name
            DICTDB._Field._Data-type    = cType
            DICTDB._Field._Format       = DICTDB2._Field._Format
            DICTDB._Field._Fld-case     = DICTDB2._Field._Fld-case
            DICTDB._Field._Initial      = DICTDB2._Field._Initial
            DICTDB._Field._Mandatory    = DICTDB2._Field._Mandatory
            DICTDB._Field._Decimals     = DICTDB2._Field._Decimals
            DICTDB._Field._Order        = DICTDB2._Field._Order
            DICTDB._Field._Desc         = DICTDB2._Field._Desc
            DICTDB._Field._Can-Read     = DICTDB2._Field._Can-Read
            DICTDB._Field._Can-Write    = DICTDB2._Field._Can-Write
            DICTDB._Field._Label        = DICTDB2._Field._Label
            DICTDB._Field._Col-label    = DICTDB2._Field._Col-label
            DICTDB._Field._Valexp       = DICTDB2._Field._Valexp
            DICTDB._Field._Valmsg       = DICTDB2._Field._Valmsg
            DICTDB._Field._Col-label-sa = DICTDB2._Field._Col-label-sa
            DICTDB._Field._Format-sa    = DICTDB2._Field._Format-sa
            DICTDB._Field._Help-sa      = DICTDB2._Field._Help-sa
            DICTDB._Field._Initial-sa   = DICTDB2._Field._Initial-sa
            DICTDB._Field._Label-sa     = DICTDB2._Field._Label-sa
            DICTDB._Field._Valmsg-sa    = DICTDB2._Field._Valmsg-sa
            DICTDB._Field._View-As      = DICTDB2._Field._View-As
            DICTDB._Field._Help         = DICTDB2._Field._Help.


/*    IF DICTDB._Field._Data-type = "RECID" THEN
       DICTDB._Field._Data-type = "INTEGER".
*/
 /*------------------------------------------------------------------*/
/*------------------------  FIELD-TRIGGERS  ------------------------*/
/*------------------------------------------------------------------*/

    FOR EACH DICTDB2._Field-Trig OF DICTDB2._Field:
      FIND DICTDB._Field-Trig OF DICTDB._Field WHERE
        DICTDB._Field-Trig._Event = DICTDB2._Field-Trig._Event NO-ERROR.
      IF AVAILABLE DICTDB._Field-Trig THEN 
          DELETE DICTDB._Field-Trig.

      CREATE DICTDB._Field-Trig.
      ASSIGN
          DICTDB._Field-Trig._Field-Recid = RECID (DICTDB._Field)
          DICTDB._Field-Trig._File-Recid  = RECID (DICTDB._File)
          DICTDB._Field-Trig._Event       = DICTDB2._Field-Trig._Event
          DICTDB._Field-Trig._Proc-Name   = DICTDB2._Field-Trig._Proc-Name
          DICTDB._Field-Trig._Override    = DICTDB2._Field-Trig._Override.
    END. /* each DICTDB2._Field-Trig OF DICTDB2._Field */
  END. /* each DICTDB2._Field OF DICTDB2._File */

  /*------------------------------------------------------------------*/
  /*---------------------------  INDEXES  ----------------------------*/
  /*------------------------------------------------------------------*/

  /* we first need to give the indexes a higher number, so that we then
   * can safely assign the number from the original db. Otherwise we run
   * the problem of assigning the same number to two different indexes
   */
  ASSIGN l_idx-num = 0.
  FOR EACH DICTDB._Index OF DICTDB._File:
    IF l_idx-num < DICTDB._Index._idx-num THEN
      ASSIGN l_idx-num = DICTDB._Index._idx-num.
  END.

  _idxloop:
  FOR EACH DICTDB2._Index OF DICTDB2._File:
    IF DICTDB2._Index._Wordidx = 1  OR DICTDB2._Index._Index-name = "default"
        THEN NEXT _idxloop.

    ASSIGN sidxn = DICTDB2._Index._Index-Name.

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB2._File._File-name @ msg[1] "" @ msg[2]
         DICTDB2._Index._Index-Name @ msg[3] "" @ msg[4]
         WITH FRAME mss_fix.

    ASSIGN sidxn = sidxn + "," + p_edbtype + "," + string (max_idx_len).
    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sidxn).

    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = sidxn
      NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._For-Name = sidxn
      NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = DICTDB2._index._Index-name NO-ERROR.

    IF NOT AVAILABLE DICTDB._Index THEN DO:
      CREATE DICTDB._Index.
      ASSIGN
        l_idx-num                   = l_idx-num + 1
        DICTDB._Index._File-recid   = RECID (DICTDB._File)
        DICTDB._Index._Wordidx      = DICTDB2._Index._Wordidx
        DICTDB._Index._Desc         = DICTDB2._Index._Desc
        DICTDB._Index._For-Name     = sidxn
        DICTDB._Index._For-type     = DICTDB2._Index._For-type
        DICTDB._Index._Index-name   = DICTDB2._Index._Index-Name
        DICTDB._Index._Active       = DICTDB2._Index._Active
        DICTDB._Index._idx-num      = l_idx-num
        DICTDB._Index._Unique       = DICTDB2._Index._Unique.
    END. /* NOT AVAILABLE DICTDB._Index */
    ELSE DO: /* AVAILABLE DICTDB._Index */
      ASSIGN
        DICTDB._Index._Desc         = DICTDB2._Index._Desc
	    DICTDB._Index._Index-name   = DICTDB2._Index._Index-name.
    END. /* AVAILABLE DICTDB._Index */

    FOR EACH DICTDB2._Index-field OF DICTDB2._Index:

      FIND DICTDB2._Field WHERE RECID(DICTDB2._Field) = 
	       DICTDB2._Index-field._Field-recid NO-ERROR.
      IF NOT AVAILABLE DICTDB2._Field THEN NEXT.     

      IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
        DISPLAY  DICTDB2._File._File-name @ msg[1] "" @ msg[2]
	             DICTDB2._Index._Index-Name @ msg[3]
                 DICTDB2._Field._Field-name @ msg[4]
	         WITH FRAME mss_fix.

      ASSIGN sfldn = DICTDB2._Field._Field-name.

      FIND DICTDB._Field WHERE DICTDB._Field._File-recid = RECID (DICTDB._File) 
                           AND DICTDB._Field._Field-name = sfldn NO-ERROR.
      IF NOT AVAILABLE DICTDB._Field THEN NEXT.

      FIND DICTDB._Index-field OF DICTDB._Index WHERE DICTDB._Index-field._Index-seq = DICTDB2._Index-field._Index-seq NO-ERROR.
      IF NOT AVAILABLE DICTDB._Index-field THEN DO:
	    CREATE DICTDB._Index-field.
	    ASSIGN DICTDB._Index-field._Index-recid = RECID (DICTDB._Index)
	           DICTDB._Index-field._Field-recid = RECID (DICTDB._Field)
	           DICTDB._Index-field._Index-seq   = DICTDB2._Index-field._Index-seq
	           DICTDB._Index-field._Ascending   = DICTDB2._Index-field._Ascending
	           DICTDB._Index-field._Abbreviate  = DICTDB2._Index-field._Abbreviate
	           DICTDB._Index-field._Unsorted    = DICTDB2._Index-field._Unsorted.
      END. /* NOT avaiable DICTDB._Index-field */
      ELSE DO: /* avaiable DICTDB._Index-field */
	    ASSIGN DICTDB._Index-field._Ascending   = DICTDB2._Index-field._Ascending
               DICTDB._Index-field._Abbreviate  = DICTDB2._Index-field._Abbreviate.
      END. /* avaiable DICTDB._Index-field */
    END. /* each DICTDB2._Index-field */
  END. /* each DICTDB2._Index OF DICTDB2._File */

	/* Remove any extra indexes from the schema holder */
  _rmvidx:
  FOR EACH DICTDB._Index OF DICTDB._File:
    ASSIGN sidxn = DICTDB._Index._Index-Name.
    IF sidxn = "default_" THEN NEXT.

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB._File._File-name @ msg[1] "" @ msg[2]
               DICTDB._Index._Index-Name @ msg[3] "" @ msg[4]
               WITH FRAME mss_fix.

    FIND DICTDB2._Index OF DICTDB2._File WHERE  DICTDB2._Index._Index-Name = DICTDB._Index._Index-Name NO-ERROR.
    IF AVAILABLE DICTDB2._Index THEN NEXT.
    IF RECID(DICTDB._Index) = DICTDB._File._Prime-index THEN DO:
      FIND FIRST i_dictdb WHERE RECID(i_dictdb) <> RECID(DICTDB._Index)
                             AND i_dictdb._File-recid = RECID(DICTDB._File)
                             AND i_dictdb._Unique NO-ERROR.
      IF AVAILABLE i_dictdb THEN 
        ASSIGN DICTDB._File._Prime-index = RECID(i_dictdb).
      ELSE DO:
        FIND FIRST i_dictdb WHERE RECID(i_dictdb) <> RECID(DICTDB._Index)
                              AND i_dictdb._File-recid = RECID(DICTDB._File)
                              NO-ERROR.
        IF AVAILABLE i_dictdb THEN
          ASSIGN DICTDB._File._Prime-index = RECID(i_dictdb).
        ELSE NEXT _rmvidx.
      END.
    END.
    IF DICTDB._Index._idx-num = DICTDB._File._Fil-misc1[2] THEN DO:
       /* This is a selected ROWID for this table but no mapping in progress db    *
          find a corresponding Progress index and pass the rowid designation to it *
       */
       FIND FIRST DICTDB._constraint WHERE DICTDB._Constraint._File-Recid = RECID(DICTDB._File)
                               AND (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "U" OR
                                    DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" )
                               AND DICTDB._constraint._Con-Status <> "D" AND DICTDB._constraint._Con-Status <> "O"
                               AND DICTDB._constraint._con-name = DICTDB._Index._Index-Name 
                               AND DICTDB._constraint._Con-Active = TRUE
                               NO-LOCK NO-ERROR.
      IF NOT AVAILABLE DICTDB._constraint THEN 
             FIND FIRST DICTDB._constraint WHERE DICTDB._Constraint._File-Recid = RECID(DICTDB._File)
                               AND (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "U" OR
                                    DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" )
                               AND DICTDB._constraint._Con-Status <> "D" AND DICTDB._constraint._Con-Status <> "O"
                               AND substr(DICTDB._constraint._con-name,2,LENGTH(DICTDB._constraint._con-name)) = 
                                          DICTDB._Index._Index-Name 
                               AND DICTDB._constraint._Con-Active = TRUE
                               NO-LOCK NO-ERROR.

      IF AVAILABLE DICTDB._constraint THEN
         ASSIGN con_recid =  RECID(DICTDB._CONSTRAINT).
    END.
    FOR EACH DICTDB._Index-field OF DICTDB._Index:
      DELETE DICTDB._Index-field.
    END. /* DICTDB._Index-field OF DICTDB._Index */

    DELETE DICTDB._Index.

  END. /* DICTDB._Index OF DICTDB._File */

	/* Set the primary index */

  FIND DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._File._Prime-Index
      NO-ERROR.
  IF AVAILABLE DICTDB._Index THEN
    ASSIGN spi = DICTDB._Index._Index-Name.
  ELSE
    ASSIGN spi = ?.

  FIND DICTDB2._Index WHERE RECID(DICTDB2._Index) = DICTDB2._File._Prime-Index
     NO-ERROR.
  IF AVAILABLE DICTDB2._Index THEN
    ASSIGN ppi = DICTDB2._Index._Index-Name.
  ELSE
    ASSIGN ppi = ?.

  IF spi <> ppi AND ppi <> ? THEN DO:
    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = ppi NO-ERROR.
    IF AVAILABLE DICTDB._Index THEN 
      DICTDB._File._Prime-Index= RECID(DICTDB._Index).      
  END. /* spi <> ppi AND ppi <> ? */

  /*-----------------------------------------------------------------*/
 /*-----------------------  CONSTRAINTS     ------------------------*/
/*-----------------------------------------------------------------*/

IF migCon THEN DO: /* constraints only fixed if migrate constraints set intitially */
  ASSIGN l_con-num = 0.
  FOR EACH DICTDB._Constraint:
    IF l_con-num < DICTDB._Constraint._con-num THEN
      ASSIGN l_con-num = DICTDB._Constraint._con-num.
  END.
  
  _con-loop:
  FOR EACH DICTDB2._Constraint OF DICTDB2._File:
    IF DICTDB2._Constraint._Con-Status = "D" OR DICTDB2._Constraint._Con-Status = "O"
       THEN NEXT _con-loop.
       
        IF (DICTDB2._Constraint._Con-Type = "C" OR DICTDB2._Constraint._Con-Type = "D")
        THEN DO:
          FIND FIRST DICTDB2._Field OF DICTDB2._File WHERE RECID(DICTDB2._Field) = DICTDB2._Constraint._Field-Recid NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-Name = DICTDB2._Field._Field-Name NO-LOCK NO-ERROR.
          ASSIGN con-fld_recid = RECID (DICTDB._Field).
        END.   
        
        
        IF (DICTDB2._Constraint._Con-Type = "F" OR DICTDB2._Constraint._Con-Type = "U" OR DICTDB2._Constraint._Con-Type = "PC" 
              OR DICTDB2._Constraint._Con-Type = "P" OR DICTDB2._Constraint._Con-Type = "MP" OR DICTDB2._Constraint._Con-Type = "M")
        THEN DO:     
          FIND FIRST DICTDB2._Index OF DICTDB2._File WHERE RECID(DICTDB2._Index) = DICTDB2._Constraint._Index-Recid NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = DICTDB2._Index._Index-Name NO-LOCK NO-ERROR.
          ASSIGN con_indx_recid = RECID (DICTDB._Index).
        END.
        
        IF DICTDB2._Constraint._Con-Type = "F"
        THEN DO:
          FIND FIRST DICTDB2._Index WHERE RECID(DICTDB2._Index) = DICTDB2._Constraint._Index-Parent-Recid NO-LOCK NO-ERROR.
          FIND first f_DICTDB2 WHERE RECID(f_DICTDB2) = DICTDB2._Index._File-Recid NO-LOCK NO-ERROR.
          FIND FIRST f_DICTDB WHERE f_DICTDB._File-Name = f_DICTDB2._File-Name NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Index OF f_DICTDB WHERE DICTDB._Index._Index-Name = DICTDB2._Index._Index-Name NO-LOCK NO-ERROR.
          ASSIGN con_parnt_recid = RECID(DICTDB._Index).  
        END.  
        
        
      FIND FIRST DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-Name = DICTDB2._Constraint._Con-Name EXCLUSIVE-LOCK NO-ERROR.
          IF NOT AVAILABLE(DICTDB._Constraint) THEN
      FIND FIRST DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-Name = DICTDB2._Constraint._For-Name EXCLUSIVE-LOCK NO-ERROR.
          IF NOT AVAILABLE(DICTDB._Constraint) 
      THEN DO: 
      l_con-num                        = l_con-num + 1.      
      CREATE DICTDB._Constraint.
      ASSIGN
        DICTDB._Constraint._File-recid   = RECID (DICTDB._File)
        DICTDB._constraint._db-recid     = drec_db
        DICTDB._Constraint._Con-Desc     = DICTDB2._Constraint._Con-Desc
        DICTDB._Constraint._For-Name     = DICTDB2._Constraint._For-Name
        DICTDB._Constraint._Con-Name     = DICTDB2._Constraint._Con-Name
        DICTDB._Constraint._Con-Type     = DICTDB2._Constraint._Con-Type
        DICTDB._Constraint._Con-Expr     = DICTDB2._Constraint._Con-Expr
        DICTDB._Constraint._Con-Status   = DICTDB2._Constraint._Con-Status
        DICTDB._Constraint._Con-Type     = DICTDB2._Constraint._Con-Type
        DICTDB._constraint._con-num      = l_con-num
        DICTDB._Constraint._Con-Active   = TRUE.
        
        IF (DICTDB2._Constraint._Con-Type = "C" OR DICTDB2._Constraint._Con-Type = "D")
        THEN
           DICTDB._Constraint._Field-Recid = con-fld_recid.
        ELSE 
           DICTDB._Constraint._Index-Recid = con_indx_recid.
        
        IF DICTDB2._Constraint._Con-Type = "F"
        THEN
           DICTDB._Constraint._Index-Parent-Recid = con_parnt_recid.   
        
      END.
      ELSE DO:
      ASSIGN 
        DICTDB._constraint._db-recid     = drec_db
        DICTDB._Constraint._Con-Desc     = DICTDB2._Constraint._Con-Desc
        DICTDB._Constraint._For-Name     = DICTDB2._Constraint._For-Name
        DICTDB._Constraint._Con-Name     = DICTDB2._Constraint._Con-Name
        DICTDB._Constraint._Con-Status   = DICTDB2._Constraint._Con-Status
        DICTDB._Constraint._Con-Expr     = DICTDB2._Constraint._Con-Expr
        DICTDB._Constraint._Con-Active   = TRUE.
        
        IF (DICTDB2._Constraint._Con-Type = "C" OR DICTDB2._Constraint._Con-Type = "D")
        THEN
           DICTDB._Constraint._Field-Recid = con-fld_recid.
        ELSE 
           DICTDB._Constraint._Index-Recid = con_indx_recid.
        
        IF DICTDB2._Constraint._Con-Type = "F"
        THEN
           DICTDB._Constraint._Index-Parent-Recid = con_parnt_recid.  
   
      END. 
  END.
END. /* Migrate constraint */  
  _rmcon:
  FOR EACH DICTDB._constraint OF DICTDB._File:
     FIND FIRST DICTDB2._Constraint WHERE DICTDB2._Constraint._Con-Name = DICTDB._Constraint._Con-Name NO-LOCK NO-ERROR.
     IF NOT AVAILABLE (DICTDB2._Constraint)
     THEN DO: 
         FOR EACH DICTDB._Constraint-Keys WHERE recid(DICTDB._Constraint) = DICTDB._Constraint-Keys._con-recid:
             DELETE DICTDB._Constraint-Keys.
         END.
         DELETE DICTDB._Constraint.
     END.
  END.
  
  IF con_recid <> 0 THEN DO:
     FIND FIRST DICTDB._constraint WHERE RECID(DICTDB._constraint) = con_recid NO-LOCK NO-ERROR.
     FIND FIRST i_dictdb WHERE RECID(i_dictdb) = DICTDB._Constraint._Index-recid EXCLUSIVE-LOCK NO-ERROR.
     ASSIGN DICTDB._File._Fil-misc1[2] = i_dictdb._idx-num
            con_recid = 0.  /* re-initialize */

     IF substring(i_dictdb._I-misc2[1],1,1) <> "r" THEN DO:
        IF index(i_dictdb._I-misc2[1],"u") = 0 THEN
          ASSIGN i_dictdb._I-misc2[1] = "r" + i_dictdb._I-misc2[1].
        ELSE i_dictdb._I-misc2[1] = REPLACE(i_dictdb._I-misc2[1],"u","r").
        IF NOT i_dictdb._Unique AND index(i_dictdb._I-misc2[1],"v") = 0 THEN
           ASSIGN i_dictdb._I-misc2[1] = i_dictdb._I-misc2[1] + "v".
     END.
  END.

  IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
    DISPLAY DICTDB2._File._File-name @ msg[1] "" @ msg[2] "" @ msg[3] 
        "" @ msg[4]
        WITH FRAME mss_fix.
  /* Do this last since it may set _File._Frozen. */

  ASSIGN DICTDB._File._File-name     = DICTDB2._File._File-name
         DICTDB._File._Can-Create    = DICTDB2._File._Can-Create
         DICTDB._File._Can-Read      = DICTDB2._File._Can-Read
         DICTDB._File._Can-Write     = DICTDB2._File._Can-Write
         DICTDB._File._Can-Delete    = DICTDB2._File._Can-Delete
         DICTDB._File._Desc          = DICTDB2._File._Desc
         DICTDB._File._Valexp        = DICTDB2._File._Valexp
         DICTDB._File._Valmsg        = DICTDB2._File._Valmsg
         DICTDB._File._File-Label    = DICTDB2._File._File-Label
         DICTDB._File._File-Label-sa = DICTDB2._File._File-Label-sa
         DICTDB._File._Valmsg-sa     = DICTDB2._File._Valmsg-sa
         DICTDB._File._Dump-name     = DICTDB2._File._Dump-name.

  ASSIGN DICTDB._File._Frozen        = DICTDB2._File._Frozen.
END. /* each DICTDB2._File */

/* Now check DICTDB._File to make sure we get only those we pushed */
IF del-cycle THEN DO:
  FOR EACH DICTDB._File WHERE DICTDB._File._Tbl-type = "T"
                          AND DICTDB._File._Owner = "_Foreign":
    IF DICTDB._File._Hidden THEN NEXT.
    FIND DICTDB2._File WHERE DICTDB2._File._File-name = DICTDB._File._File-name 
                         AND DICTDB2._File._Owner = "PUB"  NO-ERROR.
    IF NOT AVAILABLE DICTDB2._File THEN DO:
      FOR EACH DICTDB._Constraint OF DICTDB._File:
         FOR EACH DICTDB._Constraint-Keys WHERE recid(DICTDB._Constraint) = DICTDB._Constraint-Keys._con-recid:
             DELETE DICTDB._Constraint-Keys.
         END.
         DELETE DICTDB._Constraint.
      END.
      FOR EACH DICTDB._INDEX OF DICTDB._File:
        FOR EACH DICTDB._Index-field of DICTDB._Index:
          DELETE DICTDB._Index-field.
        END.
        DELETE DICTDB._Index.
      END.
      FOR EACH DICTDB._Field OF DICTDB._File:
        DELETE DICTDB._Field.
      END.
      DELETE DICTDB._File.
    END.
  END.  
  FOR EACH DICTDB._Sequence:
    FIND DICTDB2._Sequence WHERE DICTDB2._Sequence._Seq-name = DICTDB._Sequence._Seq-name NO-ERROR.    
    IF NOT AVAILABLE DICTDB2._Sequence THEN
       DELETE DICTDB._Sequence.
  END.    
END.

IF NOT SESSION:BATCH-MODE THEN 
    HIDE FRAME mss_fix NO-PAUSE.

IF NOT SESSION:BATCH-MODE  
 then assign SESSION:IMMEDIATE-DISPLAY = no.

RETURN.









/*********************************************************************
* Copyright (C) 2006,2008,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* mss_get - finder for MSS tables */

/*

OUTPUT:
    gate-work records for found objects

INPUT:
    user_env[25]    "{AUTO},<name>,<owner>,<type>,<qualifier>"
                        for autmatically select all or bringing up the 
                            selection-dialog-box, Initial-values for
                            pre-selection-criterias    
                            
History: Copied _odb_get.p for MS Sql Server 7 DataServer
         04/24/00 Added logic not to support older versions D. McMann
         02/28/06 Always skip table valued functions and skip system objects
                  when running proto utility - 20060120-003 - fernando
         05/20/08 Adding code for revised sequence genrator in MSS DataServers                                          
         05/27/08 Fixing code that looks for existing stored-proc - OE00130417
         04/06/09 Changed for batch mode migration
         10/20/09 support for computed columns in MSSDS for PROGRESS_RECID - OE00186593
*/

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/gate/odb_ctl.i }
&UNDEFINE DATASERVER

DEFINE VARIABLE bug1             AS LOGICAL   NO-UNDO.
DEFINE VARIABLE escp             AS CHARACTER NO-UNDO.
DEFINE VARIABLE c	         AS CHARACTER NO-UNDO.
DEFINE VARIABLE edbtyp           AS CHARACTER NO-UNDO. /* db-type external format */
DEFINE VARIABLE hint	         AS CHARACTER NO-UNDO INITIAL "".
DEFINE VARIABLE i	         AS INTEGER   NO-UNDO.
DEFINE VARIABLE j	         AS INTEGER   NO-UNDO.
DEFINE VARIABLE l	         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lim	         AS INTEGER   NO-UNDO INITIAL 0.
DEFINE VARIABLE msstyp           AS CHARACTER NO-UNDO. /* list of ODBC-types */
DEFINE VARIABLE redraw	         AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE VARIABLE rpos1	         AS CHARACTER NO-UNDO.
DEFINE VARIABLE rpos2	         AS CHARACTER NO-UNDO.
DEFINE VARIABLE rpos3	         AS CHARACTER NO-UNDO.
DEFINE VARIABLE xld	         AS INTEGER   NO-UNDO INITIAL 0.
DEFINE VARIABLE canned	         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE inc_qual         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE driver-prefix	 AS CHARACTER NO-UNDO.
DEFINE VARIABLE sqltables-type	 AS CHARACTER NO-UNDO.
DEFINE VARIABLE sqltables-name	 AS CHARACTER NO-UNDO case-sensitive.
DEFINE VARIABLE SQLProcedures-name AS CHARACTER NO-UNDO.
DEFINE VARIABLE object-type	 AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_client-qual    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_name_f	 AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE l_owner_f	 AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE l_qual_f	 AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE l_rep-presel     AS logical   NO-UNDO.
DEFINE VARIABLE escape_char      AS CHARACTER NO-UNDO.
DEFINE VARIABLE quote_char       AS CHARACTER NO-UNDO.
DEFINE VARIABLE fromProto        AS LOGICAL   NO-UNDO INIT NO.
DEFINE VARIABLE sqltables-seqpre AS CHARACTER NO-UNDO. /* sequence prefix- new sequence generator */

DEFINE BUFFER gate-buff FOR gate-work.
DEFINE stream s_stm_errors.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE err-msg AS CHARACTER NO-UNDO EXTENT 4 INITIAL [
  /* 1*/ "You have not selected an &1 database.",
  /* 2*/ "  Please wait while information is gathered from the &1 schema ",
  /* 3*/ "" /* unused */ , 
  /* 4*/ "" /* unused */
    /*      ....+....1....+....2....+....3....+....4....+....5....+....6 */
].

FORM SKIP(1)
  err-msg[2]       AT  3 NO-LABEL           FORMAT "x(70)"     SKIP(1)
  hint              AT 10 LABEL "(Searching" FORMAT "x(32)" ")" SKIP(1)
 WITH FRAME gate_wait 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  ROW 6 CENTERED SIDE-LABELS NO-ATTR-SPACE.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*------------------------------------------------------------------*/
/*------------------------------------------------------------------*/
/*------------------------------------------------------------------*/
PROCEDURE fix_the_wild_cards:
/* Put an escape sequenve in front of meta-characters. */
DEFINE INPUT PARAMETER src AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER trgt AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER mss-escape AS CHARACTER NO-UNDO.

DEFINE VARIABLE strt AS INT INIT 1 NO-UNDO.
DEFINE VARIABLE ind AS INT NO-UNDO.
DEFINE VARIABLE escape-seq AS CHARACTER NO-UNDO.


DEFINE VAR orig1  AS CHARACTER init "~~*" NO-UNDO.
DEFINE VAR orig2  AS CHARACTER init "~~." NO-UNDO.
DEFINE VAR orig3  AS CHARACTER init "*" NO-UNDO.
DEFINE VAR orig4  AS CHARACTER init "." NO-UNDO.
DEFINE VAR trgt1  AS CHARACTER init "*" NO-UNDO.
DEFINE VAR trgt2  AS CHARACTER init "." NO-UNDO.
DEFINE VAR trgt3  AS CHARACTER init "%" NO-UNDO.
DEFINE VAR trgt4  AS CHARACTER init "_" NO-UNDO.
IF src = ? 
THEN DO:
  trgt = src.
  RETURN.
END.

IF mss-escape = ? or mss-escape = " " THEN mss-escape = "".

escape-seq = mss-escape + "_".
strt = 1.
ind = 0.
REPEAT:
  IF escape-seq = "_" THEN LEAVE.
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), "_").

  IF ind = 0
    THEN LEAVE.

  SUBSTRING(src, ind + strt - 1, 1,"character") = escape-seq.
  strt = strt + ind  + 1.
END.


escape-seq = mss-escape + "%".
strt = 1.
ind = 0.
REPEAT:
  IF escape-seq = "%" THEN LEAVE.
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), "%").
 
  IF ind = 0
    THEN LEAVE.
 
  SUBSTRING(src, ind + strt - 1, 1,"character") = escape-seq.
  strt = strt + ind  + 1.
END.
 
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig3).
 
  IF ind = 0
    THEN LEAVE.
 
  IF strt + ind > 2 AND SUBSTRING(src, strt + ind - 2, 1,"character") = "~~" THEN DO:
    strt = strt + ind.
    NEXT.
  END.
    
  SUBSTRING(src, ind + strt - 1, 1 ,"character") = trgt3.
  strt = strt + ind.
END.
 
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig4).
 
  IF ind = 0
    THEN LEAVE.
     
  IF strt + ind > 2 AND SUBSTRING(src, strt + ind - 2, 1,"character") = "~~"
   THEN DO:
    strt = strt + ind.
    NEXT.
  END.
      
  SUBSTRING(src, ind + strt - 1, 1,"character") = trgt4  .
  strt = strt + ind.
END.
 
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig1).
 
  IF ind = 0
    THEN LEAVE.
 
  SUBSTRING(src, ind + strt - 1, 2,"character") = trgt1.
  strt = strt + ind.
END.

strt = 1. 
ind = 0.
REPEAT: 
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig2). 
  
  IF ind = 0 
    THEN LEAVE. 
  
  SUBSTRING(src, ind + strt - 1, 2,"character") = trgt2. 
  strt = strt + ind. 
END. 


trgt = src.
 
RETURN.
END PROCEDURE.


/*------------------------------------------------------------------*/
/*--------------------------- MAIN-BLOCK ---------------------------*/
/*------------------------------------------------------------------*/

ASSIGN
  SESSION:IMMEDIATE-DISPLAY = yes
  edbtyp      = {adecomm/ds_type.i
                  &direction = "itoe"
                  &from-type = "user_dbtype"
                  }
  msstyp      = {adecomm/ds_type.i
                  &direction = "MSS"
                  &from-type = "user_dbtype"
                  }
  err-msg[1] = SUBSTITUTE(err-msg[1],edbtyp)
  err-msg[2] = SUBSTITUTE(err-msg[2],edbtyp)
  s_wildcard  = FALSE.
  .

  
IF INDEX(msstyp,user_dbtype) = 0
 THEN DO:
  MESSAGE err-msg[1] /* not odbc */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
  END.

/* check if we are automatically selecting all */
IF user_env[25] BEGINS "AUTO" THEN
   fromProto = YES.

/* delete eventually left-over records from earlier schema-pulls */
for each gate-work: delete gate-work. end.
for each s_ttb_seq: delete s_ttb_seq. end.
for each s_ttb_tbl: delete s_ttb_tbl. end.
for each s_ttb_fld: delete s_ttb_fld. end.
for each s_ttb_idx: delete s_ttb_idx. end.
for each s_ttb_idf: delete s_ttb_idf. end.
for each s_ttb_con: delete s_ttb_con. end.

/*------------------------------------------------------------------*/
/*                        get driver-bug-info                       */
/*------------------------------------------------------------------*/

assign
  l_rep-presel = TRUE.

presel:  
repeat while l_rep-presel:   /* end for this repeat is in nogatwrk.i */

{prodict/gate/presel.i
  &block  = "presel"
  &frame  = "frm_ntoq"
  &link   = """ """
  &master = """ """
  }


/* if either no qualifier-support from the server (BUG24), or no    */
/* wildcard-support from the server (BUG23) but wildcards contained */
/* in the variables we have to do the selection on the client-side  */
FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.

IF NOT SESSION:BATCH-MODE THEN DO:
    PAUSE 0.
    DISPLAY err-msg[2] WITH FRAME gate_wait.
END. 

SESSION:IMMEDIATE-DISPLAY = yes.
RUN adecomm/_setcurs.p ("WAIT").

DO TRANSACTION on error undo, leave on stop undo, leave:

  RUN STORED-PROC DICTDBG.CloseAllProcs.
  FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.

  RUN STORED-PROC DICTDBG.GetInfo (0).

  FOR EACH DICTDBG.GetInfo_buffer:


    IF DICTDB._Db._Db-misc2[1] = ?
     THEN DO:       
        IF (LENGTH(DICTDBG.GetInfo_buffer.escape_char,"character") < 1)
            THEN  escape_char = " ".
            ELSE  escape_char = DICTDBG.GetInfo_buffer.escape_char .
        IF (LENGTH(DICTDBG.GetInfo_buffer.quote_char,"character") < 1)
            THEN  quote_char = " ".
            ELSE  quote_char = DICTDBG.GetInfo_buffer.quote_char.
    
       IF INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2)) < 7 THEN DO:         
         MESSAGE "The DataServer for MS SQL Server was designed to work with Versions 7 " SKIP
            "and above.  You have tried to connect to a prior version of MS SQL Server. " SKIP
            "The DataServer for ODBC supports that version and must be used to perform " SKIP
            "this function. " SKIP(1)
         VIEW-AS ALERT-BOX ERROR BUTTONS OK.
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
           ASSIGN user_path = "*N,35=wrg-ver,_usrsdel,1=sys,_usrsget".
         &ELSE
           ASSIGN user_path = "*N,35=wrg-ver,_usrsdel,1=sys,_guisget".
         &ENDIF           
         RETURN. 
       END.
       
      ASSIGN
        DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name
        DICTDB._Db._Db-misc2[2] = DICTDBG.GetInfo_buffer.driver_version
        DICTDB._Db._Db-misc2[3] = escape_char + quote_char
        DICTDB._Db._Db-misc2[5] = DICTDBG.GetInfo_buffer.dbms_name + " " 
  			        + DICTDBG.GetInfo_buffer.dbms_version 
        DICTDB._Db._Db-misc2[6] = DICTDBG.GetInfo_buffer.odbc_version
        DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver
  		                          + ",Client Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_clnt
  		                          + ",Server Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_srvr
  		                          + ","
        DICTDB._Db._Db-misc2[8] = DICTDBG.GetInfo_buffer.dbms_name
        driver-prefix    = ( IF DICTDB._Db._Db-misc2[1] BEGINS "QE"
                              THEN SUBSTRING(DICTDB._Db._Db-misc2[1]
                                      ,1
                                      ,LENGTH(DICTDB._Db._Db-misc2[1]
                                              ,"character") - 6
                                      ,"character")
  		              ELSE DICTDB._Db._Db-misc2[1]
  		           )
        DICTDB._Db._Db-misc2[4] = "".
        
      REPEAT i = 1 TO 80:
        IF   ( CAN-DO(odbc-bug-list[i], driver-prefix)
         OR    CAN-DO(odbc-bug-list[i], "ALL") )
         AND NOT CAN-DO(odbc-bug-excld[i], driver-prefix)
         THEN ASSIGN
           DICTDB._Db._Db-misc2[4] = DICTDB._Db._Db-misc2[4]
                                   + string(i) + "," .
        END. /* REPEAT */

      END. /* DICTDB._Db._Db-misc2[1] = ? DO */
    
    ELSE IF DICTDB._Db._Db-misc2[1] <> DICTDBG.GetInfo_buffer.driver_name
     THEN DO:
      RUN adecomm/_setcurs.p ("").
      MESSAGE
	    "The Schema Holder was not created with the ODBC driver you have"
	    "connected with." SKIP
	    "You may experience problems with this connection."
	    SKIP(1)
	    "Schema Holder: "  DICTDB._Db._Db-misc2[1] SKIP
	    "Current driver: " DICTDBG.GetInfo_buffer.driver_name
	    SKIP(1)
	    "Please consider recreating your schema holder using the current"
	    "ODBC driver."
	    VIEW-AS ALERT-BOX WARNING BUTTONS OK.
      RUN adecomm/_setcurs.p ("WAIT").
      END.

    
    END.  /* FOR EACH DICTDBG.GetInfo_buffer */
    
  CLOSE STORED-PROC DICTDBG.GetInfo.

/*------------------------------------------------------------------*/
/*                        pull in schema-info                       */
/*------------------------------------------------------------------*/

  ASSIGN
    l_client-qual = ( CAN-DO(DICTDB._Db._Db-misc2[4], "24") /* no qualifier-sprt */
                OR  ( CAN-DO(DICTDB._Db._Db-misc2[4], "23") /* no wildcard-sprt */
                AND   ( INDEX(s_name + s_owner + s_qual + s_type,"*") <> 0
                OR      INDEX(s_name + s_owner + s_qual + s_type,"?") <> 0
                      )                   /* but wildcards in the vars */
                    )
                  )
    bug1     = LOOKUP("1",DICTDB._Db._Db-misc2[4]) <> 0. 

  /* Refresh the bug info we just calculated.				*/
  RUN STORED-PROC DICTDBG.SendInfo (DICTDB._Db._Db-misc2[4]).
  CLOSE STORED-PROC DICTDBG.SendInfo.

  escp  = SUBSTRING(DICTDB._Db._Db-misc2[3],1,1,"character").
  escp  = IF (escp = " ") THEN "" ELSE escp.
  RUN fix_the_wild_cards(INPUT s_qual, OUTPUT l_qual_f, INPUT escp).
  RUN fix_the_wild_cards(INPUT s_owner, OUTPUT l_owner_f, INPUT escp).
  RUN fix_the_wild_cards(INPUT s_name, OUTPUT l_name_f, INPUT escp).
 IF l_client-qual
   THEN RUN STORED-PROC DICTDBG.SQLTables (?, ?, ?, ?).
   ELSE  RUN STORED-PROC DICTDBG.SQLTables (l_qual_f, l_owner_f, l_name_f, ?).

  FOR EACH DICTDBG.SQLTables_buffer:

   IF NOT CAN-DO(odballowed,TRIM(DICTDBG.SQLTables_buffer.type)) THEN NEXT.

   /* A table for sequence implementation.				*/
   IF TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "_SEQP_" THEN NEXT.

   /* if from migration utility, don't need to pull system objects */
   IF fromProto AND UPPER(TRIM(DICTDBG.SQLTables_buffer.owner)) = "SYS" THEN
      NEXT.

   /* if from migration utility, don't need to pull INFORMATION_SCHEMA objects */
   IF fromProto AND UPPER(TRIM(DICTDBG.SQLTables_buffer.owner)) = "INFORMATION_SCHEMA" THEN
      NEXT.

   /* if object is _SEQT_REV_SEQTMGR (management table for new MSS sequences)
      we dont pull it into the schema, so ignoring it- OE157473 */
   IF DICTDBG.SQLTables_buffer.name BEGINS "_SEQT_REV_SEQTMGR" THEN NEXT.

   /* selection to be done on the client-side */
   /* This IF catches all matches except where one or both  
    * operands have the unknown value. These are caught in the
    * ELSE block.
    */
   IF   l_client-qual
    AND ( NOT TRIM(DICTDBG.SQLTables_buffer.name)      MATCHES s_name
    OR    NOT TRIM(DICTDBG.SQLTables_buffer.owner)     MATCHES s_owner
    OR    NOT TRIM(DICTDBG.SQLTables_buffer.qualifier) MATCHES s_qual
    OR    NOT TRIM(DICTDBG.SQLTables_buffer.type)      MATCHES s_type
        )
    AND NOT ( TRIM(DICTDBG.SQLTables_buffer.name)      BEGINS "_buffer_"
    AND       s_type                                   MATCHES "buffer"
            )
    AND NOT TRIM(DICTDBG.SQLTables_buffer.name)        MATCHES "_buffer_"
                                                             + s_name
    THEN NEXT.
    ELSE DO: 
        /* Check if there is a match with unknown value for
         * in SQLTables_buffer.  This can happen in PODBC. 
         */
        IF s_owner-hlp BEGINS "%%%" AND SUBSTRING(s_owner-hlp,4) <> "sa" AND
         TRIM(DICTDBG.SQLTables_Buffer.owner) <> substring(s_owner-hlp,4) THEN NEXT.


        IF TRIM(DICTDBG.SQLTables_buffer.name)  = ? THEN 
            IF  NOT ( (s_name = ?) OR (s_name = "*") )  THEN NEXT.
            
        IF TRIM(DICTDBG.SQLTables_buffer.owner) = ? THEN
            IF NOT ( (s_owner = ?) OR (s_owner = "*") ) THEN NEXT.
            
        IF TRIM(DICTDBG.SQLTables_buffer.qual)  = ? THEN 
            IF NOT ( (s_qual = ?) OR (s_qual = "*") )   THEN NEXT.
            
        IF TRIM(DICTDBG.SQLTables_buffer.type)  = ?  THEN 
            IF NOT ( (s_type = ?) OR (s_type = "*") )   THEN NEXT.
            
    END. /* ELSE DO */                                            
    
    ASSIGN
      sqltables-type = TRIM(DICTDBG.SQLTables_buffer.type)
      sqltables-name = TRIM(DICTDBG.SQLTables_buffer.name)
      object-type    = ( IF (    sqltables-type    =    "VIEW" 
                          AND LC(sqltables-name) BEGINS "_buffer_"
                            )
                          THEN substring(sqltables-name,2,6,"character")
                         ELSE IF NOT ( sqltables-type = "TABLE" 
                          AND sqltables-name BEGINS "_SEQT_" )
                          THEN ENTRY(LOOKUP(sqltables-type ,sobjects),pobjects)
                         ELSE IF asc(substring(sqltables-name,2,1,"character")) = 115
                          THEN "sequence"
                          ELSE "SEQUENCE"
                       ).

    /* new sequence generator implementation for MSS DataServers */ 
	    IF (sqltables-type = "TABLE") THEN DO:
		IF (sqltables-name BEGINS "_SEQT_REV_")
		   THEN sqltables-seqpre = "_SEQT_REV_".
	        ELSE IF (sqltables-name BEGINS "_SEQT_") 
		   THEN sqltables-seqpre = "_SEQT_". 
	    END.

    FIND DICTDB._File
      WHERE DICTDB._File._Db-recid     = drec_db
      AND   UPPER(DICTDB._File._For-name)  = UPPER(sqltables-name)
      AND   UPPER(DICTDB._File._For-owner) = UPPER(TRIM(DICTDBG.SQLTables_buffer.owner))
      AND ( bug1
      OR    DICTDB._File._FIl-misc2[1] = TRIM(DICTDBG.SQLTables_buffer.qualifier)
          )
      NO-ERROR.

    /* to prevent schemaholder-tables from beeing updated        */
    /*                                          <hutegger> 94/06 */
    IF available DICTDB._File
     AND DICTDB._File._file-name begins "SQLTables" THEN NEXT.
    
    /* skip objects that are not yet contained in the schema-holder */
    if not available DICTDB._File
     and s_vrfy = TRUE then NEXT.

    IF NOT SESSION:BATCH-MODE THEN 
        DISPLAY 
          TRIM(DICTDBG.SQLTables_buffer.name) @ hint 
          WITH FRAME gate_wait.


    CREATE gate-work.
    ASSIGN
      lim = lim + 1
      gate-work.gate-type = TRIM(STRING((AVAILABLE DICTDB._File 
                                    AND DICTDB._File._Frozen),"FROZEN:/"
                                  ))
                            + object-type

      gate-work.gate-name = ( IF object-type = "BUFFER"
                               THEN SUBSTRING(sqltables-name,9,-1,"character")
                              ELSE IF (object-type = "SEQUENCE" AND sqltables-seqpre = "_SEQT_") 
			        THEN SUBSTRING(sqltables-name,7,-1,"character")
			      ELSE IF (object-type = "SEQUENCE" AND sqltables-seqpre = "_SEQT_REV_")
                                THEN SUBSTRING(sqltables-name,11,-1,"character")
			      ELSE sqltables-name
                            )

      gate-work.gate-qual = ( IF DICTDBG.SQLTables_buffer.qualifier = ?
  			       THEN "" 
  			       ELSE TRIM(DICTDBG.SQLTables_buffer.qualifier)
                            )
      gate-work.gate-user = TRIM(DICTDBG.SQLTables_buffer.owner)
      gate-work.gate-prog = ( IF AVAILABLE DICTDB._File
                               THEN DICTDB._File._File-name 
                               ELSE ?
                            ).
     /* assigning gate-work.gate-seqpre value to either "_SEQT_REV_" or "_SEQT_" )- OE157473 */
	IF (object-type = "SEQUENCE") THEN DO:
	  IF (sqltables-seqpre = "_SEQT_REV_")
		THEN gate-work.gate-seqpre  = "_SEQT_REV_".
	  IF (sqltables-seqpre = "_SEQT_")
		THEN gate-work.gate-seqpre  = "_SEQT_". 
	END.

    END.   /* FOR EACH DICTDBG.SQLTables_buffer */

  CLOSE STORED-PROC DICTDBG.SQLTables.
    IF l_client-qual
   THEN RUN STORED-PROC DICTDBG.SQLProcedures (?, ?, ?).
   ELSE RUN STORED-PROC DICTDBG.SQLProcedures (l_qual_f, l_owner_f, l_name_f).

  FOR EACH DICTDBG.SQLProcs_Buffer:

   /* This IF catches all matches except where one or both  
    * operands have the unknown value. These are caught in the
    * ELSE block.
    */
   IF   l_client-qual
    AND ( NOT TRIM(DICTDBG.SQLProcs_Buffer.name)      MATCHES s_name
    OR    NOT TRIM(DICTDBG.SQLProcs_Buffer.owner)     MATCHES s_owner
    OR    NOT TRIM(DICTDBG.SQLProcs_Buffer.qualifier) MATCHES s_qual
        )
    AND NOT ( TRIM(DICTDBG.SQLProcs_Buffer.name)      BEGINS "_buffer_" )
    AND NOT TRIM(DICTDBG.SQLProcs_Buffer.name)        MATCHES "_buffer_"
                                                             + s_name
    THEN NEXT.
    ELSE DO: 
        /* Check if there is a match with unknown value for
         * in SQLProcs_Buffer.  This can happen in PODBC. 
         */
        IF s_owner-hlp BEGINS "%%%" AND SUBSTRING(s_owner-hlp,4) <> "sa" AND
         TRIM(DICTDBG.SQLProcs_Buffer.owner) <> substring(s_owner-hlp,4) THEN NEXT.

        IF TRIM(DICTDBG.SQLProcs_Buffer.name)  = ? THEN 
            IF  NOT ( (s_name = ?) OR (s_name = "*") )  THEN NEXT.
            
        IF TRIM(DICTDBG.SQLProcs_Buffer.owner) = ? THEN
            IF NOT ( (s_owner = ?) OR (s_owner = "*") ) THEN NEXT.
            
        IF TRIM(DICTDBG.SQLProcs_Buffer.qual)  = ? THEN 
            IF NOT ( (s_qual = ?) OR (s_qual = "*") )   THEN NEXT.
 
            
    END. /* ELSE DO */    

    IF DICTDBG.SQLProcs_Buffer.name BEGINS "_SEQP_" THEN
        NEXT.
    
    IF DICTDBG.SQLProcs_Buffer.name BEGINS "_Constraint_Info" THEN
        NEXT.
    /* if from migration utility, don't need to pull system objects */
    IF fromProto AND UPPER(TRIM(DICTDBG.SQLProcs_Buffer.owner)) = "SYS" THEN
        NEXT.

    /* if from migration utility, don't need to pull INFORMATION_SCHEMA objects */
    IF fromProto AND UPPER(TRIM(DICTDBG.SQLProcs_Buffer.owner)) = "INFORMATION_SCHEMA" THEN
        NEXT.

    /* skip table valued functions */
    IF substring(DICTDBG.SQLProcs_Buffer.name,(length(DICTDBG.SQLProcs_Buffer.name) - 1)) = ";0" THEN
       NEXT.

    ASSIGN
      SQLProcedures-name = TRIM(DICTDBG.SQLProcs_Buffer.name)
      object-type    = "PROCEDURE".

    /* OE00130417 - remove this now so we can lool for the correct name in the schema,
       when checking if it already exists
    */
    IF substring(SQLProcedures-name,(length(SQLProcedures-name) - 1)) = ";1" THEN
       ASSIGN SQLProcedures-name = substring(SQLProcedures-name,1,(length(SQLProcedures-name) - 2)).

    FIND DICTDB._File
      WHERE DICTDB._File._Db-recid     = drec_db
      AND   DICTDB._File._For-name     = SQLProcedures-name
      AND   DICTDB._File._For-owner    = TRIM(DICTDBG.SQLProcs_Buffer.owner)
      AND ( bug1
      OR    DICTDB._File._FIl-misc2[1] = TRIM(DICTDBG.SQLProcs_Buffer.qualifier)
          )
      NO-ERROR.

    /* to prevent schemaholder-tables from beeing updated        */
    /*                                          <hutegger> 94/06 */
    IF available DICTDB._File
     AND DICTDB._File._file-name begins "SQLProcedures" THEN NEXT.
    
    /* skip objects that are not yet contained in the schema-holder */
    if not available DICTDB._File
     and s_vrfy = TRUE then NEXT.

    IF NOT SESSION:BATCH-MODE THEN 
        DISPLAY 
          TRIM(DICTDBG.SQLProcs_Buffer.name) @ hint 
          WITH FRAME gate_wait.


    CREATE gate-work.
    ASSIGN
      lim = lim + 1
      gate-work.gate-type = TRIM(STRING((AVAILABLE DICTDB._File 
                                    AND DICTDB._File._Frozen),"FROZEN:/"
                                  ))
                            + object-type

      gate-work.gate-name =  SQLProcedures-name
      gate-work.gate-qual = ( IF DICTDBG.SQLProcs_Buffer.qualifier = ?
  			       THEN "" 
  			       ELSE TRIM(DICTDBG.SQLProcs_Buffer.qualifier)
                            )
      gate-work.gate-user = TRIM(DICTDBG.SQLProcs_Buffer.owner)
      gate-work.gate-prog = ( IF AVAILABLE DICTDB._File
                               THEN DICTDB._File._File-name 
                               ELSE ?
                            ).
    END.   /* FOR EACH DICTDBG.SQLProcs_Buffer */

  CLOSE STORED-PROC DICTDBG.SQLProcedures.

  END. /* DO TRANSACTION */

IF NOT SESSION:BATCH-MODE THEN
   HIDE FRAME gate_wait no-pause.


{prodict/gate/gat_get.i
  &block     = "presel"
  &cleanup   = " "
  &end       = "end."
  &gate-flag = "YES"
  &special1  = " "
  &special2  = " "
  &where     = "gate-work.gate-type <> ""STABLE"""
  }

/*------------------------------------------------------------------*/



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i }


FIND FIRST DICTDB._Db WHERE _Db-local NO-LOCK.

ASSIGN
  drec_db      = RECID(DICTDB._Db).

IF SESSION:BATCH-MODE and logfile_open THEN DO: 
    PUT STREAM logfile UNFORMATTED
        " " skip 
        "-- ++ " skip
        "-- Creating SQL to create database objects " skip
        "-- -- " skip(2).
END.

RUN prodict/misc/_wrktgen.p.

IF SESSION:BATCH-MODE and NOT logfile_open THEN DO:
    OUTPUT STREAM logfile TO VALUE(user_env[2] + ".log") 
           APPEND UNBUFFERED NO-MAP NO-ECHO.
    logfile_open = true. 
END.

stages_complete[mss_create_sql] = TRUE. 

IF not stages[mss_dump_data] THEN RETURN.

IF movedata THEN DO:
  /* dump the data in Progress format */

  OUTPUT TO dump.tmp NO-ECHO NO-MAP.
  IF SESSION:BATCH-MODE and logfile_open THEN 
      PUT STREAM logfile UNFORMATTED 
          " " skip
          "-- ++ " skip
          "-- Dumping data " skip
          "-- -- " skip(2).
 
  RUN prodict/dump_d.p ("ALL","","").

END.

stages_complete[mss_dump_data] = TRUE. 

RETURN.
/***********************************************************************
* Copyright (C) 2000,2006,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Procedure created  from odb/_odb_md1.p for MS SQL Server 7 Database
   Donna L. McMann
   
   History:  Added logic not to support old versions D. McMann
             Added -Dsrv switch to connection parameter
             Output messages in batch mode to stream
*/

&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i NEW }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE DATASERVER

{ prodict/user/uservar.i }
{ prodict/user/userhue.i NEW }
{ prodict/user/userhdr.f NEW }
{ prodict/mss/mssvar.i }


DEFINE VARIABLE c            AS CHARACTER NO-UNDO.
DEFINE VARIABLE i            AS INTEGER   NO-UNDO.
DEFINE VARIABLE j            AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_debug      AS logical   NO-UNDO INIT FALSE.
DEFINE VARIABLE md1_conparms AS CHARACTER NO-UNDO. 
DEFINE VARIABLE conp1        AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp2        AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp3        AS CHARACTER NO-UNDO. 
DEFINE VARIABLE user_env_save22 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save25 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save28 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save29 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save5 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save26 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save31 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save36 AS CHARACTER NO-UNDO.

DEFINE VARIABLE connection_string as CHARACTER NO-UNDO.

DEFINE STREAM code.
OUTPUT STREAM code TO VALUE("enable.sql") NO-ECHO NO-MAP.

PROCEDURE connect-schdb:

  IF connection_string = "" OR connection_string = ? THEN 
    CONNECT  VALUE (mss_dbname)
       -dt VALUE (user_dbtype)
       -ld VALUE (mss_pdbname).

  ELSE IF mss_password = "" or mss_password = ? THEN 
    CONNECT  VALUE (mss_dbname)
         -dt VALUE (user_dbtype)
         -ld VALUE (mss_pdbname)
             VALUE (connection_string).
  ELSE 
    CONNECT  VALUE (mss_dbname)
      -dt VALUE (user_dbtype)
      -ld VALUE (mss_pdbname)
          VALUE (connection_string) 
      -P  VALUE (mss_password).

  CREATE ALIAS "DICTDBG" FOR DATABASE VALUE (mss_pdbname) NO-ERROR.
END.

/* connect up the database to work with ------------------------------------*/

CONNECT VALUE (osh_dbname) -1.
CREATE ALIAS "DICTDB" FOR DATABaSE VALUE (osh_dbname).

/* create _db record and load MSS definitions ---------------------------*/

RUN prodict/mss/_mss_md2.p.

ASSIGN
 /* user_dbname = mss_pdbname */
  user_dbtype = "MSS".

md1_conparms = mss_conparms.

IF md1_conparms = "" OR md1_conparms = ? THEN
  md1_conparms = "-Dsrv PRGRS_PROC_TRAN,1".
ELSE 
  md1_conparms = md1_conparms + " -Dsrv PRGRS_PROC_TRAN,1".

IF md1_conparms <> "" and md1_conparms <> ? THEN DO:
  IF mss_username <> "" AND mss_username <> ? THEN
     ASSIGN connection_string = "-U " + mss_username + " " + md1_conparms.
  ELSE
     ASSIGN connection_string = md1_conparms.
END.        
ELSE DO:
  IF mss_username <> "" AND mss_username <> ? THEN
     connection_string = "-U " + mss_username.
END.     

/* Save the user_env variables we will need later.  _mss_pul.p
     reinitializes user_env 
*/
ASSIGN
    user_env_save22 = user_env[22]
    user_env_save28 = user_env[28]
    user_env_save29 = user_env[29]
    user_env_save5  = user_env[5]
    user_env_save26 = user_env[26]
    user_env_save31 = user_env[31]
    user_env_save36 = user_env[36].
        
IF not stages[mss_create_objects] THEN RETURN.

/* connect to MSS database ----------------------------------------------*/
/* disconnect-connect is to reload schema cache -- workaround */
DISCONNECT VALUE (osh_dbname).
CONNECT VALUE (osh_dbname) -1.
RUN connect-schdb.
IF PDBNAME("DICTDBG") = ? THEN
  RETURN "undo".

RUN prodict/mss/_mss_sdb.p.

IF RETURN-VALUE = "wrg-ver" THEN DO:
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    ASSIGN user_path = "*N,1=sys,_usrsget".
  &ELSE
    ASSIGN user_path = "*N,1=sys,_guisget".
  &ENDIF   
  RETURN "wrg-ver".
END.
/* Discconnect again so _db updates are available */
DISCONNECT VALUE (osh_dbname).
CONNECT VALUE (osh_dbname) -1.
/* Reconnect the schema holder */

RUN connect-schdb.

RUN "prodict/mss/_sndinfo.p".

/*
 * Create the schema in Database.
 */
RUN "prodict/gate/_snd_sql.p"
      ( INPUT user_env[31],
        INPUT l_debug,
        INPUT mss_pdbname,
        INPUT user_dbtype,
        INPUT user_env[5],
        INPUT user_env[26],
        INPUT osh_dbname + ".sql"
      ).

IF SESSION:BATCH-MODE and NOT logfile_open THEN DO:
   OUTPUT STREAM logfile TO VALUE(user_env[2] + ".log") 
       APPEND UNBUFFERED NO-ECHO NO-MAP.
   logfile_open = true.
END.

stages_complete[mss_create_objects] = TRUE.
IF not stages[mss_build_schema] THEN RETURN.

IF SESSION:BATCH-MODE AND logfile_open THEN 

   PUT STREAM logfile UNFORMATTED
       " " skip 
       "-- ++ " skip
       "-- Getting List of Objects from foreign DB Schema" skip
       "-- -- " skip(2).

/*
** Create a list of all the appropriate objects we want from
** the MS Sql Server database.
*/

assign
  s_name-hlp   = "*"
  s_owner-hlp  = "%%%" + mss_username
  s_qual-hlp   = "*"
  s_type-hlp   = "*"
  user_env[25] = "AUTO".
RUN prodict/mss/_mss_get.p.

IF SESSION:BATCH-MODE AND logfile_open THEN 

   PUT STREAM logfile UNFORMATTED
       " " skip 
       "-- ++ " skip
       "-- Importing Objects into the {&PRO_DISPLAY_NAME} Schema Holder" skip
       "-- -- " skip(2).


/* 
** Create a procedure for pulling constraints
*/
RUN prodict/mss/procbfrpul.p.

/*
** Pull objects from sybase schema.
*/
RUN prodict/mss/_mss_pul.p.

/*
** Create objects in the schema holder to match objects in sybase.
*/
RUN prodict/gate/_gat_cro.p.

stages_complete[mss_build_schema] = TRUE.

IF not stages[mss_fixup_schema] THEN RETURN.

/* destroy time fields, then load up progress database changes --------------*/


ASSIGN
    user_env[22]    = user_env_save22
    user_env[28]    = user_env_save28 
    user_env[29]    = user_env_save29
    user_env_save25 = user_env[25]
    user_env[25]    = "**all**"
    user_env[5]     = user_env_save5  
    user_env[26]    = user_env_save26 
    user_env[31]    = user_env_save31
    user_env[36]    = user_env_save36.
    
    
IF movedata THEN DO:
   FOR EACH s_ttb_tbl WHERE s_ttb_tbl.ds_type = "TABLE":
        PUT STREAM code UNFORMATTED "ALTER TABLE " + s_ttb_tbl.ds_name + " CHECK CONSTRAINT ALL" SKIP. 
        PUT STREAM code UNFORMATTED user_env[5] SKIP.
   END.
END.

IF SESSION:BATCH-MODE and logfile_open THEN
    PUT STREAM logfile UNFORMATTED
        " " skip
        "-- ++ " skip
        "-- Fixing schema to resemble original {&PRO_DISPLAY_NAME} database." skip
        "-- -- " skip(2).

RUN prodict/mss/_mss_md5.p (osh_dbname, 
                            pro_dbname, 
                            pro_conparms, 
                            user_env[22]).

ASSIGN
    user_env[25] = user_env_save25
    stages_complete[mss_fixup_schema] = TRUE. 

RETURN.







/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
   History:  D. McMann 03/04/99 Added assignment of connect parameters
             D. McMann 06/18/01 Added assignment of _Db-Misc1[1]
   
*/   

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i }
{ prodict/gate/odb_ctl.i }	

DEFINE VARIABLE c AS CHARACTER NO-UNDO.

FIND DICTDB._Db WHERE DICTDB._Db._Db-name = mss_pdbname NO-LOCK NO-ERROR.
 
IF NOT AVAILABLE DICTDB._Db THEN DO TRANSACTION:

  IF mss_username <> ? AND mss_username <> "" THEN
    ASSIGN c = "-U " + mss_username.
  IF mss_password <> ? AND mss_password <> "" THEN
    ASSIGN c = c + " -P " + mss_password.
  ASSIGN c = c + " " + mss_conparms.
  
  CREATE DICTDB._Db.
  ASSIGN
    DICTDB._Db._Db-name    = mss_pdbname 
    DICTDB._Db._Db-addr    = mss_dbname
    DICTDB._Db._Db-comm    = c
    DICTDB._Db._Db-slave   = TRUE    
    DICTDB._Db._Db-type    = {adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "user_env[22]"
                        }.
    { prodict/gate/gat_cp1a.i
              &incpname = "mss_codepage" }
              
  ASSIGN DICTDB._Db._Db-coll-name = (IF mss_collname <> ? AND mss_collname <> "" THEN mss_collname
                                     ELSE SESSION:CPCOLL)
         DICTDB._Db._Db-Misc1[1] = (IF mss_incasesen = TRUE THEN 1 
                                   ELSE 0).
 
END.

ASSIGN
  user_dbname = DICTDB._Db._Db-name
  user_dbtype = DICTDB._Db._Db-type
  drec_db     = RECID(DICTDB._Db)
  c           = "add".

RUN prodict/mss/_mss_sys.p (drec_db,INPUT-OUTPUT c).

RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
   History:  DLM 09/03/98  New ProToOdb already connects to Progress
                           database.  I added a check so connect would
                           not issue an error
*/                           


DEFINE INPUT PARAMETER mss-name     AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pro-name     AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pro-conparms AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_edbtype  AS CHARACTER NO-UNDO.

DEFINE VARIABLE connted AS LOGICAL INITIAL FALSE.

/* connect up the databases to work with ------------------------------------*/

DELETE ALIAS DICTDB2.

IF NOT CONNECTED (pro-name) THEN DO:
  CONNECT VALUE(pro-name) -ld DICTDB2 VALUE (pro-conparms) -1.
  ASSIGN connted = TRUE.
END.  

ELSE
  CREATE ALIAS DICTDB2 FOR DATABASE VALUE(pro-name).  

RUN prodict/mss/_mss_fix.p (p_edbtype).

IF connted THEN
  DISCONNECT DICTDB2.
ELSE
  DELETE ALIAS DICTDB2.
    
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

{ prodict/gate/_gat_md9.i
    &db-type  = "mss"
    &tmp-name = "mss"
    }
/*********************************************************************
* Copyright (C) 2006,2012 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
file:   prodict/mss/_mss_pul.p

description:
    pulls schemainfo of all objects contained in gate-work into
    the temp-tables

    <DS>_get.p gets a list of all pullable objects from the foreign DB
    <DS>_pul.p pulled over the definition from the foreign side
    gat_cmp.p  compared the existing definitions with the pulled info
    gat_cro.p  replaces the existing definitions with the pulled info
               or creates the new object if it didn't already exist

    Create <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Update <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Verify <DS> Schema: <DS>_get.p <DS>_pul.p gat_cmp.p gat_cro.p

Input:
    &DS_DEBUG   DEBUG to protocol the creation
                ""    to turn off protocol
    gate-work   shared temp-table that contains all the objects to pull

Output:
    s_ttb_tbl   table-information of all objects
    s_ttb_fld   field-information of all objects
    s_ttb_idx   index-information of all objects
    s_ttb_idf   index-field-information of all objects
    s_ttb_seq   sequence-information of all objects

History:
    03/31/00 D. McMann Created from _odb_pul.p
    10/25/00 D. McMann Added " to Progress_Recid name since names are now quoted.
    11/20/00 Recid index causing meta schema mismatches correct for index name. #147
    04/18/01 Added check for stored procedure parameter @RETURN_VALUE new for SQL Server 2000
    10/16/01 D. McMann Added logic for fields that begin with progress_
    04/02/02 D. McMann Added logic to increase counter after ident field
    07/01/02 D. McMann Added logic to set pro_case to false if case-insentive code page.
                       20020701-004
    12/09/02 D. McMann Added logic to see if an index component is desc.
    01/08/03 D. McMann Added DICTDBG to send-sql call
    04/17/03 D. McMann Changed error msg for skipping table instead of fields
    04/23/03 D. McMann Added logic to check sequence names - support on-line schema
    10/17/03 D. McMann Add NO-LOCK statement to _Db find in support of on-line schema add
    02/28/06 fernando  Skip table valued tables - 20060120-003
    04/17/06 fernando  Unicode support
    07/19/06 fernando  Unicode support - restrict to MSS 2005
    08/24/06 fernando  Add warning about non utf-8 codepage and unicode columns - 20060802-024
    10/06/06 fernando  Check object name in case it has underscore - 20031205-003
    08/10/07 fernando  Removed UI restriction for Unicode support    
    02/22/08 fernando  Support for datetime
    02/23/09 Nagaraju  to handle timestamp field properly
    03/16/09 knavneet  datetime-tz support for MSS
    04/28/09 knavneet  BLOB support for MSS (OE00178319)
    05/22/09 sgarg     ROWGUID support for MSS
    09/23/09 Nagaraju  Computed column implementation for RECID support
    10/29/09 Nagaraju  To update new format for version string
    02/23/10 Nagaraju  to avoid computed_column check if MSS vers 2000 or earlier
    09/16/10 knavneet  CR - OE00198360
    06/21/11 kmayur    added support for constraint pull - OE00195067    
    02/27/13 sdash     Implementation of independent Batch Pull.
*/

&SCOPED-DEFINE xxDS_DEBUG                   DEBUG /**/
&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

{ prodict/user/uservar.i }
{ prodict/gate/odb_ctl.i  }

define BUFFER   hlp-work         FOR  gate-work.
define BUFFER   A_col            FOR  DICTDBG.SQLColumns_buffer.
define BUFFER   P_col            FOR  DICTDBG.SQLProcCols_buffer.
define BUFFER   S_col            FOR  DICTDBG.SQLSpecialColumns_buffer.

define variable A_proc_handle    as integer.
define variable P_proc_handle    as integer.
define variable S_proc_handle    as integer.

define variable array_name 	     as character no-undo. 
define variable batch-mode	     as logical.
define variable bug1             as logical no-undo.
define variable bug4             as logical no-undo.
define variable bug7             as logical no-undo.
define variable bug8             as logical no-undo.
define variable bug19            as logical no-undo.
define variable bug22            as logical no-undo.
define variable bug28            as logical no-undo.
define variable bug29            as logical no-undo.
define variable bug34            as logical no-undo.
define variable char-type	     as logical no-undo. 
define variable column_available as logical no-undo. 
define variable comp-name  	     as character no-undo.
define variable temp-comp-name   as character no-undo.
define variable comp-ind         as integer   no-undo.
define variable comp-num         as integer   no-undo.
define variable doextent         as logical   no-undo. 
define variable dot1             as character no-undo.
define variable dot2             as character no-undo.
define variable dtyp             as integer   no-undo.
define variable edbtyp           as character no-undo. /* db-type external format */
define variable escp             as character no-undo.
define variable field-position   as integer   no-undo.
define variable fld-name-1   	 as character no-undo.
define variable fld-prior        as integer   no-undo.
define variable fld-properties   as character no-undo.
define variable fld-remark       as character no-undo.
define variable fnam             as character no-undo.
define variable format_len       as integer   no-undo.
define variable format_len1      as integer   no-undo.
define variable full_table_name  as character no-undo.
define variable has_id_ix        as logical   no-undo.
define variable i     	         as integer   no-undo.
define variable indn             as integer   no-undo.
define variable keycp 	         as integer   no-undo.
define variable l_char-types     as character no-undo.
define variable l_chrw-types     as character no-undo.
define variable l_date-types     as character no-undo.
define variable l_dcml           as integer   no-undo.
define variable l_dcml-types     as character no-undo.
define variable l_dt             as character no-undo.
define variable l_tmp            as character no-undo.
define variable l_floa-types     as character no-undo.
define variable l_frmt           as character no-undo.
define variable l_i###-types     as character no-undo.
define variable l_i##d-types     as character no-undo.
define variable l_i##l-types     as character no-undo.
define variable l_i#dl-types     as character no-undo.
define variable l_logi-types     as character no-undo.
define variable l_prec 	         as integer   no-undo.
define variable l_time-types     as character no-undo.
define variable l_tmst-types     as character no-undo.
define variable l_init           as character no-undo. 
define variable l_matrix         as character no-undo initial
            "a,ax,ax,ax,u,ux,ux,ux".
define variable m1               as integer   no-undo.
define variable m2               as integer   no-undo. 
define variable msg              as character no-undo   EXTENT 6.
define variable namevar          as character no-undo case-sensitive.
define variable namevar-1   	 as character no-undo case-sensitive.
define variable newf  	         as logical   no-undo. /* new file definition */
define variable ntyp  	         as character no-undo.
define variable numeric-type	 as logical   no-undo. 
define variable oldf  	         as logical   no-undo. /* old file definition */
define variable pnam             as character no-undo.
define variable prev-prior       as integer   no-undo.
define variable progvar          as character no-undo.
define variable quote            as character no-undo.
define variable r                AS RECID     no-undo.
define variable scrap            as logical   no-undo.
define variable shadow_col_name  as character no-undo.
define variable shadow_col       as integer   no-undo. 
define variable spclvar          as character no-undo.
define variable spclvar-1   	 as character no-undo.
define variable table_comment    as character no-undo.
define variable table_name  	 as character no-undo case-sensitive.
define variable table_user  	 as character no-undo.
define variable table_user_1  	 as character no-undo.
define variable table-properties as character no-undo.
define variable table_spcl       as character no-undo.
define variable table_spcl_1     as character no-undo.
define variable table_type  	 as character no-undo.
define variable temp1            as integer   no-undo.
define variable temp2            as integer   no-undo.
define variable typevar          as character no-undo.
define variable typevar-1   	 as character no-undo.
define variable unique-prime     as logical   no-undo. /* upi already found */
define variable uservar          as character no-undo.
define variable uservar-1   	 as character no-undo.
define variable vfmt1            as character no-undo.
define variable spcl_len         as integer   no-undo.
define variable user_len         as integer   no-undo.
define variable table_len        as integer   no-undo.
define variable dq_index         as integer   no-undo.
DEFINE VARIABLE stph1            AS INTEGER   NO-UNDO.
DEFINE VARIABLE stph2            AS INTEGER   NO-UNDO.
DEFINE VARIABLE dfth1            AS INTEGER   NO-UNDO.
DEFINE VARIABLE isasc            AS LOGICAL   NO-UNDO.
DEFINE VARIABLE idxidn           AS INTEGER   NO-UNDO.
DEFINE VARIABLE tblname          AS CHARACTER NO-UNDO.
DEFINE VARIABLE sqlstate         AS CHARACTER NO-UNDO.
DEFINE VARIABLE s                AS CHARACTER NO-UNDO.
DEFINE VARIABLE tdbtype          AS CHARACTER NO-UNDO.
DEFINE VARIABLE itype            AS LOGICAL   NO-UNDO.
DEFINE VARIABLE has_recid_idx    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE tmp_str          AS CHARACTER NO-UNDO.
DEFINE VARIABLE isUnicodeType    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE warn_tablename   AS CHARACTER NO-UNDO.
DEFINE VARIABLE warn_codepage    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE esc-idx1         AS INTEGER   NO-UNDO.
DEFINE VARIABLE esc-idx2         AS INTEGER   NO-UNDO.
DEFINE VARIABLE ch1              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE ch2              AS CHARACTER  NO-UNDO.
DEFINE VARIABLE isFileStream     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE change-dict-ver  AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE VARIABLE ds_srvr_vers     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE ds_clnt_vers     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE foreign_dbms_version    AS INTEGER   NO-UNDO.
DEFINE VARIABLE isOutput         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE rowid_idx_name   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE ClustAsROWID     AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE uniquifyAddon    AS INTEGER    NO-UNDO INITIAL 0.
DEFINE VARIABLE mssselBestRowidIdx  AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE useLegacyRanking AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE found            AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE err_sp           AS CHARACTER  NO-UNDO.
DEFINE VARIABLE err_sp_flag      AS LOGICAL    NO-UNDO.
DEFINE VARIABLE mssrecidCompat   AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mapmssdatetime   AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE callerid         AS INTEGER    NO-UNDO INITIAL 2.


define TEMP-TABLE column-id
          FIELD col-name         as character case-sensitive
          FIELD col-id           as integer
          INDEX upi        IS UNIQUE PRIMARY col-name.

/*------------------------------------------------------------------*/

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/
FORM
                                                    SKIP(1)
  msg[1]   FORMAT "x(29)" LABEL "Table"  colon 8 
    "->"
    msg[2] FORMAT "x(25)" LABEL "Table"             SKIP
  msg[3]   FORMAT "x(29)" LABEL "Column" colon 8 
    "->"
    msg[4] FORMAT "x(25)" LABEL "Field"             SKIP
  msg[5]   FORMAT "x(29)" LABEL "Key"    colon 8 
    "->"
    msg[6] FORMAT "x(25)" LABEL "Index"             SKIP (1)
/*  SKIP(1) */
  with ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  TITLE " Loading " + edbtyp + " Definition " USE-TEXT
  frame ds_make.

/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/


/*------------------------------------------------------------------*/
FUNCTION isComputed RETURNS LOGICAL (INPUT t1 AS CHAR, INPUT c1 AS CHAR):
DEFINE VARIABLE isComputeCol     AS LOGICAL   NO-UNDO.

/* OE00198360  - For MSS 7 and below, computed column is not supported
    For MSS 2000 - computed column info is got from 'syscolumns' table
    For MSS 2005 and above - computed column info is got from 'sys.columns' table */

          IF (foreign_dbms_version < 8) THEN  
              RETURN FALSE. 
          ELSE IF (foreign_dbms_version = 8) THEN
              assign sqlstate = "SELECT iscomputed FROM syscolumns where name = '" + c1 +
                            "' and id = (OBJECT_ID('" + t1 + "'))".
          ELSE
              assign sqlstate = "SELECT is_computed FROM sys.columns where name = '" + c1 +
                            "' and object_id = (OBJECT_ID('" + t1 + "'))".

          RUN STORED-PROC DICTDBG.send-sql-statement dfth1 = PROC-HANDLE NO-ERROR ( sqlstate ).

          IF ERROR-STATUS:ERROR THEN. /*Don't do anything inital value already set to unknown */
          ELSE IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
              /* if no-error and have messages, we failed to run it (must be MSS 2000),
                 so we just close it and will return FALSE.
              */
              CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
          END.
          ELSE DO:
            FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth1:
                ASSIGN isComputeCol = LOGICAL(INTEGER(proc-text)). /* convert to atoi to logical */
            END.
            CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
          END.

RETURN isComputeCol.
END FUNCTION.

procedure error_handling:

define INPUT PARAMETER error-nr         as INTEGER.
define INPUT PARAMETER param1           as CHARACTER.
define INPUT PARAMETER param2           as CHARACTER.

define       variable  err-msg as character extent 10 initial [
/*  1 */ "WARNING: Column &1 is hidden; it cannot be an index component",
/*  2 */ "ERROR: Table &1 has unsupported data types.",
/*  3 */ "       Skipping this table...",
/*  4 */ " &1 &2 ", /* intentionally left blank for div. error-messages */
/*  5 */ "WARNING: No index for the RECID &1 field of table &2",
/*  6 */ "WARNING: The Driver sends wrong data about indexes, they cant be build automatically",
/*  7 */ "WARNING: Table &1 has Unicode data type, which is supported only with MS SQL Server 2005 and up",
/*  8 */ "WARNING: Table &1 has Unicode data types and the schema holder's codepage is not utf-8.",
/*  9 */ "It is recommended that you set the codepage to utf-8 in this case to avoid data loss!",
/* 10 */ " "
    ].

    if param1 = ? then assign param1 = "".
    if param2 = ? then assign param2 = "".
    
    if s_1st-error = false
     then do:
      assign s_1st-error = TRUE
             user_env[34] = "true".
      output stream s_stm_errors to ds_upd.e.
      output stream s_stm_errors close.
      end.
    output stream s_stm_errors to ds_upd.e append.
    PUT stream s_stm_errors unformatted
              SUBSTITUTE(err-msg[error-nr],param1,param2)  skip.
    PUT STREAM s_stm_errors UNFORMATTED "" SKIP.

    output stream s_stm_errors close.
end.  /* error_handling */

/*------------------------------------------------------------------*/
/* Get the list of components of: "FUNC1(f1,N)+FUNC2(f2)+f3 as:     */
/* f1+f2+f3. retunr ? for errors.                                   */
PROCEDURE extract_comp_names:
define INPUT  PARAMETER src             as character no-undo.
define OUTPUT PARAMETER trgt            as character no-undo.

define variable left_par                as integer   no-undo.
define variable right_par               as integer   no-undo.
define variable begin_replace           as integer   no-undo.
define variable to_replace              as integer   no-undo.
define variable comma                   as integer   no-undo.
define variable fld_delim               as integer   no-undo.
define variable fld_len                 as integer   no-undo.
define variable fld_name                as character no-undo.
define variable blnk                    as integer   no-undo.

IF INDEX(src, "(") = 0
 then do:
  trgt = src.
  RETURN.
  end.

REPEAT:
  left_par = INDEX(src, "(").
  if left_par = 0 then LEAVE.
  right_par = INDEX(src, ")").
 
  if right_par = 0
   then do:
    trgt = ?. 
    RETURN.
    end.
 
  assign
    begin_replace = R-INDEX( SUBSTRING(src, 1, left_par, "raw"), "+") + 1
    comma = INDEX(src, ",").
 
  if right_par = 0
   then do:
    trgt = ?.
    RETURN.
    end.
 
  assign
    fld_delim  = ( if (right_par < comma OR comma = 0)
                     then right_par
                     else comma
                 )
    fld_len    = fld_delim - left_par - 1
    fld_name   = SUBSTRING(src, left_par + 1, fld_len, "character")
    blnk       = INDEX(fld_name, " ")
    fld_name   = ( if blnk = 0
                     then fld_name 
                     else TRIM(fld_name)
                 )
    to_replace = right_par - begin_replace + 1
    SUBSTRING(src, begin_replace, to_replace, "character") = fld_name.
  
  end.   /* repeat */
 
assign trgt = src.
RETURN.
 
end PROCEDURE.

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

assign
  batch-mode   = SESSION:BATCH-MODE
  edbtyp       = {adecomm/ds_type.i
                   &direction = "itoe"
                   &from-type = "user_dbtype"
                   }
  l_char-types = "CHAR,VARCHAR,BINARY,VARBINARY,NCHAR,NVARCHAR,ROWGUID"
  l_chrw-types = "LONGVARBINARY,LONGVARCHAR,NLONGVARCHAR,TIME"
  l_date-types = "DATE"
  l_dcml-types = "DECIMAL,NUMERIC"
  l_floa-types = "DOUBLE,FLOAT,REAL"
  l_i###-types = ""
  l_i##d-types = "BIGINT"
  l_i##l-types = ""
  l_i#dl-types = "INTEGER,SMALLINT,TINYINT"
  l_logi-types = "BIT"
  l_time-types = ""
  l_tmst-types = "TIMESTAMP,TIMESTAMP-TZ"
  .

IF NUM-ENTRIES(user_env[25]) = 12
   THEN ASSIGN
     s_datetime = LOGICAL(ENTRY(6,user_env[25]))
     s_primary = LOGICAL(ENTRY(7,user_env[25]))
     s_lob = LOGICAL(ENTRY(8,user_env[25]))
     s_blobtype = LOGICAL(ENTRY(9,user_env[25]))
     s_clobtype = LOGICAL(ENTRY(10,user_env[25]))
     ClustAsROWID = LOGICAL(ENTRY(11,user_env[25]))
     s_best = INTEGER(ENTRY(12,user_env[25])).


IF NOT batch-mode then assign SESSION:IMMEDIATE-DISPLAY = yes.

RUN adecomm/_setcurs.p ("WAIT").

IF user_env[37] = "PP" THEN DO:
    assign ClustAsROWID = TRUE.
    ASSIGN mssselBestRowidIdx = (ENTRY(4,user_env[36]) = "y").
    ASSIGN s_best = (IF mssselBestRowidIdx THEN  INTEGER(ENTRY(5,user_env[36])) ELSE 0 ).
    ASSIGN mssrecidCompat = (ENTRY(3,user_env[36]) = "y").
    if user_env[12] = "datetime" then mapmssdatetime = TRUE.
    else  mapmssdatetime = FALSE.

    IF ((NUM-ENTRIES(user_env[42]) >= 2) AND
        UPPER(ENTRY(2,user_env[42])) <> "L" ) THEN
      assign useLegacyRanking = FALSE.
END.
ELSE DO:
    assign ClustAsROWID = s_primary.
          /* s_best = 1 (OE Schema )
                    = 2 (Foreign Schema)
           */
    assign mssrecidCompat = s_recidcompat
           mapmssdatetime = s_datetime.
    IF s_primary OR s_recidcompat THEN assign useLegacyRanking = FALSE.
END.

assign
  cache_dirty = TRUE
  user_env    = "" /* yes this is destructive, but we need the -l space */
  l_dt        = ?
  l_tmp       = (if s_datetime then "datetime_default" else ?).

if s_lob then do:
  assign l_tmp = (if s_datetime then l_tmp + ",lob_default" else ",lob_default").

  if s_clobtype and s_blobtype then 
    assign l_tmp = l_tmp + ",clob_default,blob_default" .
  else if s_clobtype and not s_blobtype then 
    assign l_tmp =  l_tmp + ",clob_default" .
  else if s_blobtype and not s_clobtype then 
    assign l_tmp =  l_tmp + ",blob_default" .
end.

RUN prodict/mss/_mss_typ.p
  ( INPUT-OUTPUT i,
    INPUT-OUTPUT i,
    INPUT-OUTPUT l_tmp,
    INPUT-OUTPUT l_dt,
    OUTPUT       l_dt
    ). /* fills user_env[11..17] with datatype-info */
/* Get the name of the foreign dbms and set the foreign_dbms name */
    define variable foreign_dbms            as character no-undo.

    RUN STORED-PROC DICTDBG.GetInfo (0).
    for each DICTDBG.GetInfo_buffer:
       assign foreign_dbms = ( DICTDBG.GetInfo_buffer.dbms_name )
              foreign_dbms_version = INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2))
              ds_clnt_vers = DICTDBG.GetInfo_buffer.prgrs_clnt
              ds_srvr_vers = DICTDBG.GetInfo_buffer.prgrs_srvr.
    end.

    CLOSE STORED-PROC DICTDBG.GetInfo.

find DICTDB._Db where RECID(_Db) = drec_db NO-LOCK.

assign
  bug1  = can-do(_Db._Db-misc2[4], "1")
  bug4  = can-do(_Db._Db-misc2[4], "4")
  bug7  = can-do(_Db._Db-misc2[4], "7")
  bug8  = can-do(_Db._Db-misc2[4], "8")
  bug19 = can-do(_Db._Db-misc2[4], "19")
  bug22 = can-do(_Db._Db-misc2[4], "22")
  bug28 = can-do(_Db._Db-misc2[4], "28")
  bug29 = can-do(_Db._Db-misc2[4], "29")
  bug34 = can-do(_Db._Db-misc2[4], "34")
  quote = SUBSTRING(_Db._Db-misc2[3],2,1, "character")
  quote = ( if (quote = " " OR bug7)
                then ""
                else quote
          )
  escp  = SUBSTRING(_Db._Db-misc2[3],1,1, "character")
  escp  = ( if (escp = " ")
                then ""
                else escp
          ).

if bug22 then RUN error_handling(6, "", "").
if bug34 then escp = "".

/*---------------------------- MAIN-LOOP ---------------------------*/

/* just in case some garbage left over */
for each s_ttb_tbl: delete s_ttb_tbl. end.
for each s_ttb_fld: delete s_ttb_fld. end.
for each s_ttb_idx: delete s_ttb_idx. end.
for each s_ttb_idf: delete s_ttb_idf. end.
for each s_ttb_con: delete s_ttb_con. end.

_crtloop:
for each gate-work
  where gate-work.gate-slct = TRUE:
  
  /* Skip pseudo-entry, which is needed to signal, if user wants to 
   * compare not just <DS> -> PROGRESS, but also the other direction
   */
  if gate-work.gate-type = "PROGRESS" then next.

   /* This is for MS SQL 7 causing GPF when schema tables are pulled */
  IF gate-work.gate-user = "INFORMATION_SCHEMA" THEN
    NEXT.
  

  assign
    has_id_ix          = no
    namevar   = ( if      gate-work.gate-type = "BUFFER"
                   then "_" + gate-work.gate-type /* coud be lower-case */
                      + "_" + gate-work.gate-name
                  else if gate-work.gate-type <> "SEQUENCE"
                   then            gate-work.gate-name
                  else if asc(substring(gate-work.gate-type,1,1,"character")) = 115
		    then LC(gate-work.gate-seqpre) + gate-work.gate-name
                  else gate-work.gate-seqpre + gate-work.gate-name
                )
    typevar   = ( if gate-work.gate-type = "BUFFER"
                   then "VIEW"
                   else ENTRY(LOOKUP(gate-work.gate-type,pobjects),sobjects)
                )
    uservar   = gate-work.gate-user
    progvar   = gate-work.gate-prog
    spclvar   = ( if  gate-work.gate-qual = ""
                   then "%"
                   else gate-work.gate-qual
                ).
    
  if batch-mode and logfile_open
   then put STREAM logfile unformatted
     gate-work.gate-type at 16
     gate-work.gate-user at 32
     gate-work.gate-name at 45 skip.

  RUN  prodict/mss/mss_fix.p (spclvar, OUTPUT spclvar-1, escp, bug1).
  RUN  prodict/mss/mss_fix.p (uservar, OUTPUT uservar-1, escp, bug8).
  RUN  prodict/mss/mss_fix.p (namevar, OUTPUT namevar-1, escp, no).
  RUN  prodict/mss/mss_fix.p (typevar, OUTPUT typevar-1, escp, no).
  assign typevar-1 = "'" + typevar-1 + "'". 
  
  IF gate-work.gate-type <> "PROCEDURE" THEN DO:
  
    /*-------------------------- SEQUENCES -----------------------------*/

    if gate-work.gate-type = "SEQUENCE"
        then do:  /* gate-work.gate-type = "SEQUENCE" */

      ASSIGN s = progvar.
      IF SESSION:SCHEMA-CHANGE = "new objects"  THEN 
      DO i = 1 TO 9999 WHILE can-find(FIRST s_ttb_seq
                       where s_ttb_seq.pro_name = progvar)
                       OR CAN-FIND(FIRST DICTDB._Sequence
                       WHERE DICTDB._Sequence._db-recid = drec_db
                         AND DICTDB._Sequence._Seq-name = progvar
                         AND DICTDB._Sequence._Seq-misc[2] <> uservar ) :
        progvar = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
                  + STRING(- i).
      end.
      create s_ttb_seq.
      assign
        gate-work.ttb-recid = RECID(s_ttb_seq)
        s_ttb_seq.ds_name   = namevar /* used to be progvar, but:
                                     * progvar could be <> namevar
                                     * in case of name-collisions */
        s_ttb_seq.ds_user   = uservar
        s_ttb_seq.ds_spcl   = uservar + ","
                          + ( if asc(substring(gate-work.gate-type
                                              ,1
                                              ,1
                                              ,"character"
                                    )         )  =  115
                                then "_seqp_"
                                else "_SEQP_" 
                            )
                          + substr(namevar,7,-1,"character") + ","
			  + "@op" + "," + "@val" + ","
        s_ttb_seq.gate-work = RECID(gate-work)
        s_ttb_seq.pro_name  = progvar.

      if TERMINAL <> "" and NOT batch-mode
        then DISPLAY 
          namevar @ msg[1]   ""   @ msg[4]
          progvar @ msg[2]   ""   @ msg[5]
          ""      @ msg[3]   ""   @ msg[6]
          with frame ds_make.

      NEXT.

    end.     /* gate-work.gate-type = "SEQUENCE" */


    /*---------------------------- TABLES ------------------------------*/

    RUN STORED-PROC DICTDBG.GetInfo (0).
    for each DICTDBG.GetInfo_buffer:
      assign doextent = ( DICTDBG.GetInfo_buffer.do_extent = "Y" ).
    end.
    CLOSE STORED-PROC DICTDBG.GetInfo.

    RUN STORED-PROC DICTDBG.SQLTables
                 (spclvar-1, uservar-1, namevar-1, typevar-1).
    for each DICTDBG.SQLTables_buffer:

      /* 20031205-003
         If the table name has underscore (_), we may get records for
         different tables, since '_' may be a search pattern depending on
         the driver settings/version. So we need to filter out anything
         that is not the table we are looking for.
      */
      IF TRIM(DICTDBG.SQLTables_buffer.name) NE ? AND 
         trim(namevar-1) NE TRIM(DICTDBG.SQLTables_buffer.name) THEN
         NEXT.

      assign
        table_name = ( if TRIM(DICTDBG.SQLTables_buffer.name) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.name)
                   )
        table_spcl = ( if TRIM(DICTDBG.SQLTables_buffer.qualifier) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.qualifier)
                   )
        table_type = ( if TRIM(DICTDBG.SQLTables_buffer.type) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.type)
                   )
        table_user = ( if TRIM(DICTDBG.SQLTables_buffer.owner) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.owner)
                   ).

    end.

    CLOSE STORED-PROC DICTDBG.SQLTables.

    create s_ttb_tbl.

    assign
      gate-work.ttb-recid = RECID(s_ttb_tbl)
      s_ttb_tbl.ds_name   = table_name
      s_ttb_tbl.ds_recid  = 0
      s_ttb_tbl.ds_spcl   = ( if (table_spcl = "%" OR bug1) 
                             then ?
                             else table_spcl
                          )
      s_ttb_tbl.ds_type   =  gate-work.gate-type
      s_ttb_tbl.ds_user   = ( if table_user = "%" or bug28
                             then ?
                             else table_user 
                          )
      s_ttb_tbl.gate-work = RECID(gate-work)
      s_ttb_tbl.pro_desc  = ( if table_comment <> ""
                             then table_comment 
                             else s_ttb_tbl.pro_desc
                          )                               
      s_ttb_tbl.pro_name  = gate-work.gate-prog.
 
    if TERMINAL <> "" and NOT batch-mode
    then DISPLAY
      namevar @ msg[1]  "" @ msg[4]
      progvar @ msg[2]  "" @ msg[5]
      ""      @ msg[3]  "" @ msg[6]
      with frame ds_make.

    /* there is a bug in the ODBC-Driver. The stored-procedure GetFieldIds
     * chokes on Tables with no fields. We know that SysGams doesn't have
     * any fields, so we end the processing for SysGams right here. In case
     * this bug gets fixed by the ODBC-Driver supplier, we can just remove 
     * this comment plus the next statment.         (hutegger 95/05)
    */


    if gate-work.gate-name = "sysgams" then NEXT.
  
    /*---------------------------- FIELDS ------------------------------*/

    assign
    /* Get the ordinal number of fields in the table.		*/
      table_spcl_1 = ( if (spclvar-1 = "%" or spclvar-1 = ?)
                            then ""
                            else spclvar
                        )
      spcl_len         = length(table_spcl_1)
 
      table_user_1     = ( if (uservar-1 = "%" or uservar-1 = ?)
                            then ""
                            else uservar
                        )
      user_len         = length(table_user_1)


      dot1              = ( if table_spcl_1 = ""
                            then ""
                            else ( if bug34 
                                     then ":"
                                     else "."
                                 )
                        )

      dot2              = ( if (table_spcl_1 <> "" OR table_user_1 <> "")
                            then "."
                            else ""
                        )
      table_len          = length(table_name)

      full_table_name   = table_spcl_1 + dot1
		      + table_user_1 + dot2 + table_name
      shadow_col        = -1
      array_name        = "".

    /* 20000 is just an arbitrary # since we dont have a _file-number yet.*/
    RUN STORED-PROC DICTDBG.GetFieldIds 
                (s_ttb_tbl.pro_name, full_table_name, 20000, spcl_len,
                 user_len, table_len).

    assign i = 1.
    _loop:
    for each DICTDBG.GetFieldIds_buffer:

      IF DICTDBG.GetFieldIds_buffer.field-name BEGINS '_PROGRESS_RECID' OR
         DICTDBG.GetFieldIds_buffer.field-name BEGINS '_PROGRESS_ROWID' OR
         DICTDBG.GetFieldIds_buffer.field-name BEGINS 'PROGRESS_RECID' OR
         DICTDBG.GetFieldIds_buffer.field-name BEGINS 'PROGRESS_ROWID' THEN DO: 

         IF s_ttb_tbl.ds_recid = 0 THEN DO:
         IF (NOT DICTDBG.GetFieldIds_buffer.field-name BEGINS 'PROGRESS_RECID_UNIQUE') OR
             mssrecidCompat THEN s_ttb_tbl.ds_recid = i.
           ASSIGN s_ttb_tbl.ds_msc23 = DICTDBG.GetFieldIds_buffer.field-name.
           IF isComputed(full_table_name, DICTDBG.GetFieldIds_buffer.field-name) THEN DO:
             IF s_ttb_tbl.ds_msc22 = ? THEN 
               ASSIGN s_ttb_tbl.ds_msc22 = "".
             ASSIGN s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + string(i) + ",".
             /* If PROGRESS_RECID column uses computed column feature, then */
             /* check if the dictionary version in _db-misc2[7] is version, i.e 'odbc-dict-ver' */
             /* and modify the dictionary version to 'odbc-dict-ver-new' */
             IF NOT change-dict-ver AND INDEX(_Db._Db-misc2[7], odbc-dict-ver) <> 0 THEN 
               change-dict-ver = TRUE.
           END.
           i = i + 1.
         END.
         ELSE IF SUBSTRING(DICTDBG.GetFieldIds_buffer.field-name,
              (LENGTH(DICTDBG.GetFieldIds_buffer.field-name) - 6)) = "_IDENT_"
           THEN DO:
           IF s_ttb_tbl.ds_msc22 = ? THEN 
             ASSIGN s_ttb_tbl.ds_msc22 = "".
           ASSIGN s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + string(i) + ","
                  i = i + 1.
        END.
         ELSE IF SUBSTRING(DICTDBG.GetFieldIds_buffer.field-name,
              (LENGTH(DICTDBG.GetFieldIds_buffer.field-name) - 4)) = "_ALT_"
            /* OE00211239 : The logic to identify the PROGRES_RECID as 
            * "computed column" is based on the SQL function COLUMNPROPERTY 
            * which returns false for a computed column in SQL view, hence 
            * we end up not putting RPOGRESS_RECID  column in the comma 
            * separated list of FILMISC2,2. Since function isComputed(..) 
            * always return false for computed column in case of VIEW  
            * and there is no other mechanism/interface to determine if a 
            * column is computed in a SQL view, The idea is that if column 
            * PROGRESS_RECID_ALT is present in a view due to virtue of 
            * computed column PROGRESS_RECID functionality then we would 
            * refresh the comma separated list of PROGRESS_RECID columns 
            * by appending the PROGRESS_RECID field position in the existing 
            * list. 
	    */  
           THEN do:
           IF s_ttb_tbl.ds_type NE "VIEW"
              THEN DO:   
                IF s_ttb_tbl.ds_msc22 = ? THEN 
                ASSIGN s_ttb_tbl.ds_msc22 = "".
                ASSIGN s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + string(i) + ","
                i = i + 1.
              END.
              ELSE DO:
                IF s_ttb_tbl.ds_msc22 = ? THEN 
                ASSIGN s_ttb_tbl.ds_msc22 = "".
                ASSIGN s_ttb_tbl.ds_msc22 = string(s_ttb_tbl.ds_recid) + "," 
                       + s_ttb_tbl.ds_msc22 + string(i) + ","
                i = i + 1.
              END.
          END.
        NEXT _loop.
      END.  
      CREATE column-id.
      assign
        column-id.col-name = TRIM(DICTDBG.GetFieldIds_buffer.field-name)
        column-id.col-id   = i
        i                  = i + 1.

        /* Shave the quotes off.                                          */
      if (LENGTH(quote, "character") = 1) AND SUBSTRING(column-id.col-name,1,1) = quote
       then assign
         column-id.col-name = SUBSTRING(column-id.col-name
                                 ,2
                                 ,LENGTH(column-id.col-name, "character") - 2
                                 , "character"
                                 ).

    end.  /*  for each DICTDBG.GetFieldIds_buffer */

    /* if there are any doubled-up quotes, replace them with one quote */
    dq_index = index(column-id.col-name, CHR(34) + CHR(34) ).
    REPEAT WHILE dq_index > 0:
         ASSIGN 
           SUBSTRING(column-id.col-name, dq_index, 2, "character") = CHR(34)
           dq_index = index(column-id.col-name, CHR(34) + CHR(34)). 
    END.

    CLOSE STORED-PROC DICTDBG.GetFieldIds.
    RUN  prodict/mss/mss_fix.p (table_spcl, OUTPUT spclvar-1, escp, bug1).
    RUN  prodict/mss/mss_fix.p (table_user, OUTPUT uservar-1, escp, bug8).
    RUN  prodict/mss/mss_fix.p (table_name, OUTPUT namevar-1, escp, no).
    RUN STORED-PROC DICTDBG.SQLColumns (spclvar-1, uservar-1, namevar-1, ?).

    assign field-position = 0
           warn_tablename = ?.

    for each DICTDBG.SQLColumns_buffer:

      /* 20031205-003
         If the table name has underscore (_), we may get records for
         different tables, since '_' may be a search pattern depending on
         the driver settings/version. So we need to filter out anything
         that is not from the table we want.
       */
      IF TRIM(namevar-1) NE TRIM(DICTDBG.SQLColumns_buffer.name) THEN
         NEXT.

      IF DICTDBG.SQLColumns_buffer.column-name begins "PROGRESS_RECID" 
       THEN DO:

         IF DICTDBG.SQLColumns_buffer.data-type = 4 /* int */ 
          THEN
            s_ttb_tbl.ds_msc15 = 1.
         IF DICTDBG.SQLColumns_buffer.data-type = -5 /* bigint */
          THEN
            s_ttb_tbl.ds_msc15 = 2.
      END.

      find first column-id
         where column-id.col-name = TRIM(DICTDBG.SQLColumns_buffer.column-name) NO-ERROR.

      IF NOT AVAILABLE column-id THEN NEXT.     
      assign field-position = column-id.col-id.
      
      assign
        fld-remark     = DICTDBG.SQLColumns_buffer.remarks
        fld-properties = "".
     

      if can-do (fld-properties, "P")
        then assign
          s_ttb_tbl.ds_recid = field-position
          s_ttb_tbl.ds_msc23 = TRIM(DICTDBG.SQLColumns_buffer.column-name). 

      if can-do (fld-properties, "S") OR 
        DICTDBG.SQLColumns_buffer.column-name BEGINS "_S#_"
         then do:
        assign
          shadow_col      = field-position
          shadow_col_name = ( if LENGTH(quote, "character") = 1
                               then quote + column-id.col-name + quote
                               else column-id.col-name
                          ).

        NEXT.
      end.

      if can-do (fld-properties, "N") then do:
        if s_ttb_tbl.ds_msc22 = ?
           then assign s_ttb_tbl.ds_msc22 = "".
        assign s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22
				        + STRING(field-position) + ",".
      end.

      if can-do (fld-properties, "I") then NEXT.

      if   LENGTH (array_name, "character") >    0 
              and TRIM(DICTDBG.SQLColumns_buffer.column-name) BEGINS array_name
              then NEXT.

      do:
        { prodict/mss/mss_typ.i DICTDBG.SQLColumns_buffer.data-type  bug29 }
        ASSIGN m1 = 0.
               isUnicodeType = (DICTDBG.SQLColumns_buffer.data-type <= -8 
                                AND DICTDBG.SQLColumns_buffer.data-type >= -10).

        IF l_dt <> "UNDEFINED" THEN DO:
           IF isUnicodeType THEN DO:
              /* if any of the types below are returned as unicode types, this is not the
                 right driver and we won't support it.
              */
              IF CAN-DO("date,time,datetime2,datetimeoffset", trim(DICTDBG.SQLColumns_buffer.type-name)) THEN
                  l_dt = "UNDEFINED".
           END.
           ELSE IF foreign_dbms_version > 9 THEN DO:
               /* don't support these types either - new in MSS 2008. 
                  (foreign_dbms_version = 10). If using an unsupported driver, 
                  they came through as varbinary, so we have to block them here.
               */
               IF CAN-DO("GEOMETRY,GEOGRAPHY", trim(DICTDBG.SQLColumns_buffer.type-name)) THEN
                   l_dt = "UNDEFINED".
            END.
        END.

        IF l_dt = "UNDEFINED" THEN DO:

          RUN error_handling
            ( 2, 
              s_ttb_tbl.ds_name, "" 
            ).
          RUN error_handling ( 3, "", "" ).

          FOR EACH s_ttb_fld WHERE s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):
            DELETE s_ttb_fld.
          END.
          DELETE s_ttb_tbl.
          CLOSE STORED-PROC DICTDBG.SQLColumns.
          FOR EACH column-id:
            DELETE column-id.
          END.
          NEXT _crtloop.
        END.
        /* if not SQL Server 2005 and up, give warning message on Unicode data types -8,-9,-10 */
        ELSE IF foreign_dbms_version < 9 AND isUnicodeType THEN DO:
            /* display message only once per table */
            IF warn_tablename NE s_ttb_tbl.ds_name THEN DO:
               ASSIGN warn_tablename = s_ttb_tbl.ds_name.
               /* WARNING: Table &1 has Unicode data type, which is supported only with MS SQL Server 2005 and up */
               RUN error_handling(7, s_ttb_tbl.ds_name, "").
            END.
        END.
        ELSE IF isUnicodeType THEN DO:
            IF DICTDB._Db._Db-xl-name NE "utf-8" AND NOT warn_codepage THEN DO:
               /* warn the user about the codepage mismatch */
               RUN error_handling(8, s_ttb_tbl.ds_name, "").
               RUN error_handling(9, "", "").
               ASSIGN warn_codepage = TRUE.
            END.
        END.

        if TRIM(DICTDBG.SQLColumns_buffer.column-name) MATCHES "*##1"
          and doextent then do:  /* Collect array elements & determine extent */

	      ASSIGN    m1         = 1
	                i          = LENGTH (TRIM(DICTDBG.SQLColumns_buffer.column-name), "character") - 1
	                array_name = SUBSTR (TRIM(DICTDBG.SQLColumns_buffer.column-name), 1, i, "character").

          RUN  prodict/mss/mss_fix.p
                 (table_spcl, OUTPUT spclvar-1,  escp, bug1).
          RUN  prodict/mss/mss_fix.p 
                (table_user,  OUTPUT uservar-1, escp, bug8).
          RUN  prodict/mss/mss_fix.p                              
                (table_name,  OUTPUT namevar-1,  escp, no).


          RUN STORED-PROC DICTDBG.SQLColumns A_proc_handle = PROC-HANDLE
		       (spclvar-1, uservar-1, namevar-1, ?).

	      for each A_col where PROC-HANDLE = A_proc_handle:

           /* 20031205-003
              If the table name has underscore (_), we may get records for
              different tables, since '_' may be a search pattern depending on
              the driver settings/version. So we need to filter out anything
              that is not from the table we want.
           */
           IF TRIM(namevar-1) NE TRIM(A_col.name) THEN
              NEXT.

	        if NOT A_col.column-name BEGINS array_name then NEXT.
	        assign m2 = INTEGER (SUBSTR (A_col.column-name
	                              , i + 1
	                              , LENGTH (A_col.column-name
	                                       , "character") - i
	                              , "character"
	                       )      ).
	        if m2 > m1 then assign m1 = m2.

	      end. /* EACH A_col */
	  
	      CLOSE STORED-PROC DICTDBG.SQLColumns where PROC-HANDLE = A_proc_handle.

        end. /* Collect array elements & determine extent */

        { prodict/mss/mss_pul.i 
           &data-type    = "l_dt"
           &order-offset = "4000"  /* make sure we go well beyond the end */
           &extent       = "m1"
        }

      end. /* DO */

      /* OE00162531: adding identity fields to non-updatable list */
      /* OE00181255: adding timestamp fields to non-updatable list */
      /* OE00183878: adding ROWGUID fields to non-updatable list */
      if DICTDBG.SQLColumns_buffer.column-name BEGINS "PROGRESS_RECID"
      then .
      else if ((s_ttb_fld.ds_msc24 EQ "identity") OR 
               (s_ttb_fld.ds_msc24 EQ "timestamp") OR
               (s_ttb_fld.ds_type = "ROWGUID") OR 
               isComputed(full_table_name, DICTDBG.SQLColumns_buffer.column-name)) THEN DO:
        if s_ttb_tbl.ds_msc22 = ? then 
           assign s_ttb_tbl.ds_msc22 = "".
        s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + string(s_ttb_fld.ds_stoff) + ",".
      end.

      if shadow_col > 0 then 
        assign s_ttb_fld.pro_case = FALSE  
               s_ttb_fld.ds_shd#  = shadow_col
               s_ttb_fld.ds_shdn  = shadow_col_name
               shadow_col         = -1
               shadow_col_name    = ? .
      ELSE IF DICTDB._Db._Db-Misc1[1] = 1 THEN
          ASSIGN s_ttb_fld.pro_case = FALSE.

    end.      /* for each SQLColumns_buffer */
    
    CLOSE STORED-PROC DICTDBG.SQLColumns.			
				    
    /*----------------------------- INDEXES ------------------------------*/

    RUN  prodict/mss/mss_fix.p (table_spcl, OUTPUT spclvar-1, ?, bug1).
    RUN  prodict/mss/mss_fix.p (table_user, OUTPUT uservar-1, ?, bug8).
    RUN  prodict/mss/mss_fix.p (table_name, OUTPUT namevar-1, ?, no).

    RUN STORED-PROC DICTDBG.SQLStatistics(spclvar-1, uservar-1, namevar-1).
 
    assign
      indn         = 1
      unique-prime = NO
      has_recid_idx = NO
      rowid_idx_name = ?.

    for each DICTDBG.SQLStatistics_buffer:
      IF DICTDBG.SQLStatistics_buffer.index-name BEGINS 'PKCE_' THEN NEXT.   
      /* Eliminate recid index and recid field */
      IF DICTDBG.SQLStatistics_buffer.index-name MATCHES '*progress_recid*' OR
         DICTDBG.SQLStatistics_buffer.Column-name MATCHES '*prgs_recid*' OR      
         DICTDBG.SQLStatistics_buffer.Column-name MATCHES '*progress_recid*'  THEN DO:
          /* just remember if we've found the index for the recid field */
          IF DICTDBG.SQLStatistics_buffer.index-name MATCHES '*progress_recid*' THEN DO:
             ASSIGN has_recid_idx = YES.
             IF DICTDBG.SQLStatistics_buffer.index-name MATCHES '*progress_recid' 
                AND DICTDBG.SQLStatistics_buffer.non-unique = 1 THEN 
                    rowid_idx_name = DICTDBG.SQLStatistics_buffer.index-name. 
          END.

          NEXT.
      END.
.
      /* Skip TBALE statistics.						*/
      if DICTDBG.SQLStatistics_buffer.type = 0 OR bug22 then NEXT. 
      
      assign comp-name   = DICTDBG.SQLStatistics_buffer.Column-name.

      if bug4 then do:
        RUN extract_comp_names 
          ( INPUT  comp-name,
            OUTPUT temp-comp-name
          ).
        RUN prodict/mss/mss_qe.p
          ( INPUT-OUTPUT temp-comp-name,
            OUTPUT comp-num
           ).
        assign comp-name = temp-comp-name.
      end.
      else assign comp-num = 1.

      REPEAT comp-ind = 1 to comp-num:

        find first s_ttb_fld 
          where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
            and   s_ttb_fld.ds_name = TRIM(ENTRY(comp-ind, comp-name)) 
          no-lock no-error.
        if NOT available s_ttb_fld then do:  /*  NOT available s_ttb_fld */

           find first column-id 
            where column-id.col-name = TRIM(ENTRY(comp-ind, comp-name))
    	     no-error.

           find first s_ttb_fld
            where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
              and   s_ttb_fld.ds_shd# = column-id.col-id
    	       no-lock no-error.

    	   IF NOT available s_ttb_fld then do: 
    	     /* If not PROGRESS RECID field - complain. */
	     if s_ttb_tbl.ds_recid <> column-id.col-id
	       then RUN error_handling(1, comp-name, "").
               /*WARNING: Column &1 is hidden; it cannot be an index component*/
	     else if DICTDBG.SQLStatistics_buffer.seq-in-index = 1
	              and (DICTDBG.SQLStatistics_buffer.non-unique = 0 OR bug19)
	         then	has_id_ix = yes. /* progress_recid has a unique index */
    	     NEXT.
	   end.        
        end.     /*  NOT available where s_ttb_fld */

        if NOT available s_ttb_idx
           OR s_ttb_idx.ds_name <> TRIM(DICTDBG.SQLStatistics_buffer.index-name)
           OR s_ttb_idx.ttb_tbl <> RECID(s_ttb_tbl)
              then do:  /* index non-existent -> create new index */

           if TERMINAL <> "" and NOT batch-mode
            then DISPLAY
                TRIM(DICTDBG.SQLStatistics_buffer.name) @ msg[5] 
                user_env[1]                             @ msg[6]
                with frame ds_make.

           {prodict/gate/gat_puli.i
              &for-idx-name = "SQLStatistics_buffer.index-name"
              &for-idx-nam2 = "SQLStatistics_buffer.index-name"
              &for-obj-name = "SQLStatistics_buffer.index-name"
              &frame        = "ds_make"
              &idx-uniq-cond = "(bug19
                          OR DICTDBG.SQLStatistics_buffer.non-unique = 0)"
            }                                  /* try to recreate index */

           ASSIGN s_ttb_idx.ds_idx_typ = SQLStatistics_buffer.type.
        end.     /* index non-existent -> create new index */


     /*-------------------------- INDEX-FIELDS --------------------------*/

        CREATE s_ttb_idf.
        ASSIGN s_ttb_idf.pro_abbr  = FALSE
               s_ttb_idf.pro_order = ( if bug4 and comp-num > 1
                                       then comp-ind
                                       else DICTDBG.SQLStatistics_buffer.seq-in-index
                                     )
               s_ttb_idf.ttb_fld   = RECID(s_ttb_fld)
               s_ttb_idf.ttb_idx   = RECID(s_ttb_idx).
       
        /* Setup the sql statement to determine is a descending index only versions aboove V7 SQL Server */
        ASSIGN tblname = TRIM(DICTDBG.SQLStatistics_buffer.OWNER) + "." + trim(DICTDBG.SQLStatistics_buffer.NAME)
               sqlstate =  "select indid from sysindexes where id = (OBJECT_ID('" + tblname + "')) and name = '" +
                             DICTDBG.SQLStatistics_buffer.index-name + "'". 
        
        /* Get the id number of the index*/
        RUN STORED-PROC DICTDBG.send-sql-statement stph1 = PROC-HANDLE  NO-ERROR ( sqlstate ).

        IF ERROR-STATUS:ERROR THEN DO: /* V7 MS SQL Server can't do this so suppress error and just set isasc = true*/
          ASSIGN isasc = TRUE.        
        END.
        ELSE DO:
          FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = stph1:
            ASSIGN idxidn = INTEGER(proc-text).
          END.
          CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = stph1.

          /* Get the property of the column to see if it is descending */
          ASSIGN sqlstate = "select indexkey_property(OBJECT_ID('" + tblname + "'), " + STRING(idxidn) + ", " + 
                             STRING(DICTDBG.SQLStatistics_buffer.seq-in-index) + ", 'IsDescending')".
          RUN STORED-PROC DICTDBG.send-sql-statement stph2 = PROC-HANDLE NO-ERROR ( sqlstate ).
          IF ERROR-STATUS:ERROR THEN DO: /* V7 MS SQL Server can't do this so suppress error and just set isasc = true*/
            ASSIGN isasc = TRUE.             
          END.
          ELSE DO:
            FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = stph2:
              IF INTEGER(SUBSTRING(proc-text,1,1)) > 0 THEN
                 ASSIGN isasc = FALSE.
              ELSE
                 ASSIGN isasc = TRUE.
            END.
            CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = stph2.
          END.
        END.
        ASSIGN  s_ttb_idf.pro_asc   = isasc.
      end.   /* REPEAT comp-ind = 1 to comp-num */
    
    end.   /* for each DICTDBG.SQLStatistics_buffer */
  
    CLOSE STORED-PROC DICTDBG.SQLStatistics.

    /*-------------------------- SQLSpecialColumns ------------*/
    find first s_ttb_idx 
                where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl) NO-ERROR.
    IF s_best = 2 AND AVAILABLE s_ttb_idx THEN               
    DO:
       FOR EACH s_ttb_splfld: DELETE s_ttb_splfld. END.
       RUN STORED-PROC DICTDBG.SQLSpecialColumns(spclvar-1, uservar-1, namevar-1).
        /* first argument - identifierType = 1 (SQL_BEST_ROWID)
           Fifth argument - Scope =0 (SQL_SCOPE_CURROW)
           Sixth argument - Nullable =0(SQL_NO_NULLS)
        */

       for each DICTDBG.SQLSpecialColumns_buffer:
           CREATE s_ttb_splfld.
           ASSIGN s_ttb_splfld.name  = DICTDBG.SQLSpecialColumns_buffer.Column-name.
       end.    /* for each DICTDBG.SQLSpecialColumns_buffer */

       CLOSE STORED-PROC DICTDBG.SQLSpecialColumns.

     IF CAN-FIND(FIRST s_ttb_splfld) THEN DO:
       for each s_ttb_idx
                where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl):
         assign found = true.
         for each s_ttb_splfld:
            find first s_ttb_fld
                  where s_ttb_fld.ds_name = s_ttb_splfld.name AND
                        s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl) NO-ERROR.
             
             IF NOT AVAILABLE s_ttb_fld THEN               
             DO:
              assign found = false.
              LEAVE. 
             END.

             find first s_ttb_idf 
                  where s_ttb_idf.ttb_fld = RECID(s_ttb_fld) AND
                        s_ttb_idf.ttb_idx = RECID(s_ttb_idx) NO-ERROR.
             IF NOT AVAILABLE s_ttb_idf THEN               
             DO:
              assign found = false.
              LEAVE. 
             END.
         END.
         IF found THEN LEAVE.
       END.
       if found THEN ASSIGN s_ttb_idx.ds_idx_typ = 2.
     END. /*  CAN-FIND(FIRST s_ttb_splfld)  */
    end.
/*-------------------------- SQLSpecialColumns -----End-------*/

    /* If there is a progress_recid without an index then we gently complain */
    if s_ttb_tbl.ds_recid > 0 AND NOT has_recid_idx /*and not has_id_ix*/ THEN DO:
       FIND FIRST s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl) NO-ERROR.
       IF NOT AVAILABLE s_ttb_idx 
        then do:
           RUN error_handling(5, s_ttb_tbl.ds_msc23, table_name).
       END.
                      /* "WARNING: No index for the RECID &1 field table &2". */
    END.

    /*------- Find a Field which doesn't participate in an index. ------*/

    assign
      s_ttb_tbl.ds_msc13 = ?
      prev-prior         = 0.
    
    for each s_ttb_fld
      where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):

       find first s_ttb_idf 
           where s_ttb_idf.ttb_fld = RECID(s_ttb_fld)
           no-error.
       ASSIGN itype = TRUE.

       if NOT available s_ttb_idf
          and ( s_ttb_tbl.ds_msc22 = ? 
           or    NOT can-do(s_ttb_tbl.ds_msc22,STRING(s_ttb_fld.ds_stoff))
               ) then do:  /* field is possible candidate */

           /*  20040513-022 Don't allow timestamp, text and image fields
               to be selected - set itype to FALSE.
           */
          case s_ttb_fld.ds_type:
	     when "CHAR"          then fld-prior = 4. 
	     when "NUMERIC"       then fld-prior = 3. 
	     when "DECIMAL"       then fld-prior = 3. 
	     when "INTEGER"       then fld-prior = 5. 
	     when "SMALLINT"      then fld-prior = 5. 
	     when "FLOAT"         then fld-prior = 3. 
	     when "REAL"          then fld-prior = 3. 
	     when "DOUBLE"        then fld-prior = 3. 
	     when "VARCHAR"       then fld-prior = 2. 
	     when "LONGVARCHAR"   then itype = FALSE. 
	     when "DATE"          then fld-prior = 5. 
	     when "TIME"          then fld-prior = 5. 
	     when "TIMESTAMP"     then fld-prior = 3. 
	     when "VARBINARY"     then itype = FALSE. 
	     when "LONGVARBINARY" then itype = FALSE. 
	     when "BINARY"        then itype = FALSE. 
	     when "BIGINT"        then fld-prior = 3. 
	     when "TINYINT"       then fld-prior = 5. 
	     when "BIT"           then fld-prior = 5. 
	     OTHERWISE                 fld-prior = 1.
          end case.
          if fld-prior > prev-prior AND itype THEN
            assign
       	         prev-prior         = fld-prior
                 s_ttb_tbl.ds_msc13 = s_ttb_fld.ds_stoff.
       end.     /* field is possible candidate */

    end.  /* for each s_ttb_fld */
    
    /* OE00195067 BEGIN */
    /*----------------------------- Constraints ------------------------------*/

        DEFINE VARIABLE tt-handle1 AS HANDLE.
        tt-handle1 = TEMP-TABLE s_ttb_con:HANDLE.
     
        RUN  prodict/mss/mss_fix.p (table_name, OUTPUT namevar-1, ?, no).
        RUN STORED-PROC DICTDBG._Constraint_Info LOAD-RESULT-INTO tt-handle1 ( namevar-1).

        FOR EACH s_ttb_con WHERE tab_name = namevar-1:
          IF const_name MATCHES "*DF__*" THEN NEXT. 
           IF INDEX(const_name,"##") > 0 
           THEN ASSIGN i = INDEX(const_name, "##") + 2.
           ELSE i = 1.       
             const_name        = substring(const_name,i,-1,"character").
            
           IF INDEX(par_key,"##") > 0 
           THEN ASSIGN i = INDEX(par_key, "##") + 2.
           ELSE i = 1.       
            par_key        = substring(par_key,i,-1,"character"). 
        END.

     /* OE00195067 END */  

    /*--------------------------- RECID-INDEX ----------------------------*/

    /* in Version 7.3 we needed a mandatory integer-field with a unique index
     * on it, to be used for RECID-functionality. Now we are able to use any
     * index, as long as it is unique.
     * In order to grant as much compatibility with previous versions as
     * possible, we now put both the old and the new version's info into
     * the required places. As long as there are indexes of "level" 0 or 4
     * selected, the schema can be used with a V7.3-client.
     * If another index gets selected, we put a message into the error-file
     * The new rules are:
     *    Level  Data-Types                andatory  unique   #(comp) misc2[1]
     *      1    integer only                 yes   &  yes  &   =1      a
     *      2    anything except date|float   yes   &  yes  &   =1      ax
     *      3    anything except float        yes   &  yes  &   =1      ax
     *      4    anything                     yes   &  yes  &   =1      ax
     *      5    integer only                 no    |  no   |   >1      u
     *      6    anything except date|float   no    |  no   |   >1      ux
     *      7    anything except float        no    |  no   |   >1      ux
     *      8    anything except date|float   no    |  no   |   >1      ux
     * a/u := automatically-selectable/user-definable
     * x   := NON V7.3-compatible
     * ( float can't be used for "="; date has some restrictions too )
    */
    if  s_ttb_tbl.ds_recid <= 0
      or s_ttb_tbl.ds_recid  = ?
      then do:  /* no progress_recid -> check indexes for ROWID usability */

         ASSIGN s_ttb_tbl.tmp_recid = RECID(s_ttb_tbl).
         IF useLegacyRanking THEN
            RUN prodict/mss/_clrank.p ( INPUT       s_best,
                                         INPUT        RECID(s_ttb_tbl),
                                         INPUT        ClustAsROWID
                                      ).
         ELSE
            RUN prodict/mss/_cnrank.p ( INPUT       s_best,
                                         INPUT        RECID(s_ttb_tbl),
                                         INPUT        uniquifyAddon,
                                         INPUT        mssrecidCompat,
                                         INPUT        mapmssdatetime,
                                         INPUT        callerid  /* 1-progress ranking , 2-pulled SH ranking */
                                      ).

          /* OE00164266 - set the PROGRESS_RECID size if it is an integer */
          find first s_ttb_fld
           where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
             and   ABSOLUTE(s_ttb_fld.ds_stoff) = ABSOLUTE(s_ttb_tbl.ds_recid)
    	      no-lock no-error.
          IF available s_ttb_fld then do: 
            if s_ttb_fld.ds_type = "INTEGER"
             then
               s_ttb_tbl.ds_msc15 = 1. /* RECID is 4 byte */
            if s_ttb_fld.ds_type = "BIGINT"
             then
               s_ttb_tbl.ds_msc15 = 2. /* RECID is 8 byte */
          END.
    end.     /* no progress_recid -> check indexes for ROWID usability */

    /* PROGRESS-RECID-field -> reset recid-info of all indexes */
    if has_id_ix then 
    for each s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl):
       assign s_ttb_idx.ds_msc21 = ?.
    end.
      
    for each column-id:
      delete column-id.
    end.

   /* FORCESEEK Implementation- Passing non-unique ROWID name in _Fil-misc2[5] */
   IF foreign_dbms_version GE 10 THEN DO:
   
   /* In case _Fil-misc1[1] contains a value greater than 0, we can safely assume 
   PROGRESS_RECID index is being used for ROWID- assign "progress_recid"  to
   _Fil-misc2[4] since we do not have any index# information for PROGRESS_RECID.
   In case _Fil-misc1[1] contains ? and_Fil-misc1[2] contains a value greater 
   than 0, we can be sure that _Fil-misc1[2] contains the Index number found 
   by dictionary that is unique which is used as RECID when PROGRESS_RECID
   is not generated- We will store this index name in _Fil-misc2[5]      */

   IF s_ttb_tbl.ds_recid NE ? and s_ttb_tbl.ds_recid GT 0 and has_recid_idx and rowid_idx_name NE ? THEN
        assign s_ttb_tbl.ds_msc25 =  rowid_idx_name. 
   ELSE
        assign s_ttb_tbl.ds_msc25 = ?.

   IF s_ttb_tbl.ds_rowid GT 0 and s_ttb_tbl.ds_rowid NE ? and s_ttb_tbl.ds_recid EQ 0  THEN DO:
       for each s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl): 
          if s_ttb_idx.pro_idx# = s_ttb_tbl.ds_rowid and s_ttb_idx.pro_uniq EQ FALSE THEN
             assign s_ttb_tbl.ds_msc25 = s_ttb_idx.ds_name.
          else 
             assign s_ttb_tbl.ds_msc25 = ?.
       END.
    END. /* if s_ttb_tbl.ds_rowid GT 0 and s_ttb_tbl.ds_rowid NE ? and s_ttb_tbl.ds_recid EQ 0 */
   END. /* End of IF foreign_dbms_version GE 10*/

  end. /* if <> procedure */
  ELSE DO:
  /******************************  Stored Procedure Records ****************/
     RUN STORED-PROC DICTDBG.SQLProcedures
                 (spclvar-1, uservar-1, namevar-1).
  

     for each DICTDBG.SQLProcs_buffer:

        /* 20031205-003
           If the proc name has underscore (_), we may get records for
           different procedures since '_' may be a search pattern depending on
           the driver settings/version. So we need to filter out anything
           that is not the procedure we are looking for.
        */
        IF TRIM(DICTDBG.SQLProcs_buffer.name) NE ? AND 
           /* if it has ";0" or ";1" at the end, don't use it to compare proc name */
           trim(namevar-1) NE SUBSTRING(TRIM(DICTDBG.SQLProcs_buffer.name),1,LENGTH(trim(namevar-1))) THEN
           NEXT.

        assign table_name = ( if TRIM(DICTDBG.SQLProcs_buffer.name) = ?
                              then "%"
                              else TRIM(DICTDBG.SQLProcs_buffer.name)
                             )
               table_spcl = ( if TRIM(DICTDBG.SQLProcs_buffer.qualifier) = ?
                              then "%"
                              else TRIM(DICTDBG.SQLProcs_buffer.qualifier)
                             )
               table_user = ( if TRIM(DICTDBG.SQLProcs_buffer.owner) = ?
                              then "%"
                              else TRIM(DICTDBG.SQLProcs_buffer.owner)
                             ).

     end.

     CLOSE STORED-PROC DICTDBG.SQLProcedures.

     /* this can happen if this is a table valued function */
     IF table_name = ? OR table_name = "" OR 
        substring(table_name,(length(table_name) - 1)) = ";0" THEN 
        NEXT.

     IF substring(table_name,(length(table_name) - 1)) = ";1" THEN
        ASSIGN table_name = substring(table_name,1,(length(table_name) - 2)).
     create s_ttb_tbl.
     ASSIGN gate-work.ttb-recid = RECID(s_ttb_tbl)
            s_ttb_tbl.ds_name   = table_name
            s_ttb_tbl.ds_recid  = 0
            s_ttb_tbl.ds_msc13 = 1
            s_ttb_tbl.ds_spcl   = ( if (table_spcl = "%" OR bug1) 
                                   then ?
                                   else table_spcl
                                   )
            s_ttb_tbl.ds_type   =  gate-work.gate-type
            s_ttb_tbl.ds_user   = ( if table_user = "%" or bug28
                                    then ?
                                    else table_user 
                                   )
            s_ttb_tbl.gate-work = RECID(gate-work)
            s_ttb_tbl.pro_desc  = ( if table_comment <> ""
                                    then table_comment 
                                    else s_ttb_tbl.pro_desc
                                   )                               
            s_ttb_tbl.pro_name  = gate-work.gate-prog.
 
     if TERMINAL <> "" and NOT batch-mode then 
       DISPLAY
            namevar @ msg[1]  "" @ msg[4]
            progvar @ msg[2]  "" @ msg[5]
            ""      @ msg[3]  "" @ msg[6]
       with frame ds_make.
  
     /*---------------------------- Parameters ------------------------------*/
      /* Get the ordinal number of parameters in the procedure.		*/
     assign table_spcl_1 = ( if (spclvar-1 = "%" or spclvar-1 = ?)
                            then ""
                            else spclvar
                            )
            spcl_len     = length(table_spcl_1)
 
            table_user_1 = ( if (uservar-1 = "%" or uservar-1 = ?)
                             then ""
                             else uservar
                            )
            user_len     = length(table_user_1)
            dot1         = ( if foreign_dbms = "Informix"
                             then ":"
                             else "."
                            )
            dot2         = ( if (table_spcl_1 <> "" OR table_user_1 <> "")
                             then "."
                             else ""
                           )
            table_len    = length(table_name)
            full_table_name   = table_spcl_1 + dot1
	 	             + table_user_1 + dot2 + table_name
            shadow_col        = -1
            array_name        = "".

     RUN prodict/mss/mss_fix.p (table_spcl, OUTPUT spclvar-1, escp, bug1).
     RUN prodict/mss/mss_fix.p (table_user, OUTPUT uservar-1, escp, bug8).
     RUN prodict/mss/mss_fix.p (table_name, OUTPUT namevar-1, escp, no).

     RUN STORED-PROC DICTDBG.SQLProcColumns (spclvar-1, uservar-1, namevar-1, ?).

     assign field-position = 0.
     assign err_sp_flag = FALSE.

     _col-loop:
     for each DICTDBG.SQLProcCols_buffer:

        /* 20031205-003
           If the proc name has underscore (_), we may get records for
           different procedures since '_' may be a search pattern depending on
           the driver settings/version. So we need to filter out anything
           that is not the procedure we are looking for.
        */
        /* if it has ";0" or ";1" at the end, don't use it to compare proc name */
        IF trim(namevar-1) NE SUBSTRING(TRIM(DICTDBG.SQLProcCols_buffer.name),1,LENGTH(trim(namevar-1))) THEN
           NEXT.

        assign field-position = field-position + 1
               fld-remark     = DICTDBG.SQLProcCols_buffer.remarks
               fld-properties = "".
    
        IF CAPS(DICTDBG.SQLProcCols_buffer.Column-name) = "RETURN_VALUE" 
          OR CAPS(DICTDBG.SQLProcCols_buffer.Column-name) = "@RETURN_VALUE"  THEN DO:
            assign field-position = field-position - 1.
            NEXT _col-loop.
        end.    
        if can-do (fld-properties, "P") then 
           assign s_ttb_tbl.ds_recid = field-position
                  s_ttb_tbl.ds_msc23 = TRIM(DICTDBG.SQLProcCols_buffer.column-name). 

        if can-do (fld-properties, "S") then do:
           assign shadow_col      = field-position
                  shadow_col_name = ( if LENGTH(quote, "character") = 1
                                      then quote + column-id.col-name + quote
                                      else column-id.col-name
                                     ).

           NEXT.
        end.

        if can-do (fld-properties, "N") then do:
           if s_ttb_tbl.ds_msc22 = ? then 
              assign s_ttb_tbl.ds_msc22 = "".
           assign s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22
	  			        + STRING(field-position) + ",".
        end.

        if can-do (fld-properties, "I") then NEXT.

        if LENGTH (array_name, "character")              >    0 
            and TRIM(DICTDBG.SQLProcCols_buffer.column-name) BEGINS array_name
            then NEXT.

        do:

           { prodict/mss/mss_typ.i DICTDBG.SQLProcCols_buffer.data-type  bug29 }
           ASSIGN m1 = 0.

           IF l_dt = "UNDEFINED" THEN DO:
              RUN error_handling
                ( 2, 
                  s_ttb_tbl.ds_name, "" 
                ).
              RUN error_handling ( 3, "", "" ).
    
              FOR EACH s_ttb_fld WHERE s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):
                DELETE s_ttb_fld.
              END.
              DELETE s_ttb_tbl.
              CLOSE STORED-PROC DICTDBG.SQLProcColumns.
              FOR EACH column-id:
                DELETE column-id.
              END.
              NEXT _crtloop.
           END.

           if TRIM(DICTDBG.SQLProcCols_buffer.column-name) MATCHES "*##1"
                 and doextent then do:  /* Collect array elements & determine extent */

	      assign
	         m1         = 1
	         i          = LENGTH (TRIM(DICTDBG.SQLProcCols_buffer.column-name), "character") - 1
	         array_name = SUBSTR (TRIM(DICTDBG.SQLProcCols_buffer.column-name), 1, i, "character").

             RUN  prodict/mss/mss_fix.p
                 (table_spcl, OUTPUT spclvar-1,  escp, bug1).
             RUN  prodict/mss/mss_fix.p 
                 (table_user,  OUTPUT uservar-1, escp, bug8).
             RUN  prodict/mss/mss_fix.p 
                 (table_name,  OUTPUT namevar-1,  escp, no).


             RUN STORED-PROC DICTDBG.SQLProcColumns P_proc_handle = PROC-HANDLE
		       (spclvar-1, uservar-1, namevar-1, ?).

	     for each P_col where PROC-HANDLE = P_proc_handle:

            /* 20031205-003
               If the proc name has underscore (_), we may get records for
               different procedures since '_' may be a search pattern depending on
               the driver settings/version. So we need to filter out anything
               that is not the procedure we are looking for.
            */
            /* if it has ";0" or ";1" at the end, don't use it to compare proc name */
            IF trim(namevar-1) NE SUBSTRING(TRIM(P_col.name),1,LENGTH(trim(namevar-1))) THEN
               NEXT.

	        if NOT P_col.column-name BEGINS array_name then NEXT.
	        assign m2 = INTEGER (SUBSTR (P_col.column-name
	                              , i + 1
	                              , LENGTH (P_col.column-name
	                              , "character") - i
	                              , "character"
	                                )      ).
	        if m2 > m1 then assign m1 = m2.

	     end. /* EACH P_col */
	  
	     CLOSE STORED-PROC DICTDBG.SQLProcColumns where PROC-HANDLE = P_proc_handle.

           end. /* Collect array elements & determine extent */

           { prodict/mss/mss_pulp.i 
               &data-type    = "l_dt"
               &order-offset = "4000"  /* make sure we go well beyond the end */
               &extent       = "m1"
            }

        end. /* DO */

        if   shadow_col > 0 then 
           assign s_ttb_fld.pro_case = FALSE  
                  s_ttb_fld.ds_shd#  = shadow_col
                  s_ttb_fld.ds_shdn  = shadow_col_name
                  shadow_col         = -1
                  shadow_col_name    = ? .
        ELSE IF DICTDB._Db._Db-misc1[1] = 1 THEN
            ASSIGN s_ttb_fld.pro_case = FALSE.

     end.      /* for each SQLProcCols_buffer */
    
     CLOSE STORED-PROC DICTDBG.SQLProcColumns.

   END. /* = PROCEDURE */  
end. /* end gate-work */

if change-dict-ver THEN do:
  find DICTDB._Db where RECID(_Db) = drec_db EXCLUSIVE-LOCK.
  /* update with new version information(of dictionary, client and server) received */
  DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver-new
                          + ",Client Ver #:"
                          + ds_clnt_vers
                          + ",Server Ver #:"
                          + ds_srvr_vers
                          + ",".
end.


IF NOT batch-mode
 then SESSION:IMMEDIATE-DISPLAY = no.

RUN adecomm/_setcurs.p ("").

IF NOT batch-mode
 then HIDE FRAME ds_make NO-PAUSE.

RETURN.




/*********************************************************************
* Copyright (C) 2006, 2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Procedure prodict/mss/_mss_sdb.p
   Created February 18, 2000
   Donna L. McMann
   
   This procedure assigns information to the _db record that is needed
   before processing is done via protomss.p  The bug flags were not
   being assigned early enough in the process for the DataServer to
   know what to do.
   
   History:  Added check for Old version of MSS D. McMann 04/24/00
   
             fernando   04/14/06  Unicode support
             fernando   07/19/06  Unicode support - MSS 2005 and up
             nagaraju   10/20/09  computed column support - MSS 2005 and up
             nagaraju   10/29/09  report error if computed column with MSS 2005 or earlier
             sgarg      08/18/11  OE00198733: Bug[17] should be OFF for MSS drivers
*/   

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/gate/odb_ctl.i }
&UNDEFINE DATASERVER

DEFINE VARIABLE driver-prefix	 AS CHARACTER NO-UNDO.
DEFINE VARIABLE escape_char      AS CHARACTER NO-UNDO.
DEFINE VARIABLE quote_char       AS CHARACTER NO-UNDO.
DEFINE VARIABLE i	             AS INTEGER   NO-UNDO.

FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.  
RUN STORED-PROC DICTDBG.GetInfo (0).

FOR EACH DICTDBG.GetInfo_buffer:
   IF (LENGTH(DICTDBG.GetInfo_buffer.escape_char,"character") < 1)
     THEN  escape_char = " ".
   ELSE  escape_char = DICTDBG.GetInfo_buffer.escape_char .
   IF (LENGTH(DICTDBG.GetInfo_buffer.quote_char,"character") < 1)
      THEN  quote_char = " ".
   ELSE  quote_char = DICTDBG.GetInfo_buffer.quote_char.

   IF INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2)) < 7 THEN
       RETURN "wrg-ver".

   /* for Unicode support, we only support SQL Server 2005 and up */
   IF user_env[32] = "MSSQLSRV9" THEN DO:
       IF INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2)) < 8 THEN
           RETURN "wrg-ver".
   END.
   ELSE IF user_env[32] = "MSSQLSRV10" THEN DO:
       /* must be version 10 (SQL Server 2008) */
       IF INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2)) < 10 THEN
           RETURN "wrg-ver".

       /* and using the SQL Native driver version 10 */
       IF (NOT DICTDBG.GetInfo_buffer.driver_name BEGINS "SQLNCLI") OR 
           INTEGER(ENTRY(1,DICTDBG.GetInfo_buffer.driver_version,".")) < 10 THEN
           RETURN "wrg-ver".
   END.
      /* for Computed column support, we only support SQL Server 2005 and up */
   ELSE IF ((NUM-ENTRIES(user_env[27]) > 1) AND (entry(2,user_env[27]) EQ "2")) THEN DO:
       IF INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2)) < 9 THEN
           RETURN "wrg-ver".
   END.

   ASSIGN DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name
          DICTDB._Db._Db-misc2[2] = DICTDBG.GetInfo_buffer.driver_version
          DICTDB._Db._Db-misc2[3] = escape_char + quote_char
          DICTDB._Db._Db-misc2[5] = DICTDBG.GetInfo_buffer.dbms_name + " " 
  			        + DICTDBG.GetInfo_buffer.dbms_version 
          DICTDB._Db._Db-misc2[6] = DICTDBG.GetInfo_buffer.odbc_version
          DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver
  		                          + ",Client Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_clnt
  		                          + ",Server Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_srvr
  		                          + ","
          DICTDB._Db._Db-misc2[8] = DICTDBG.GetInfo_buffer.dbms_name
          driver-prefix    = ( IF DICTDB._Db._Db-misc2[1] BEGINS "QE"
                              THEN SUBSTRING(DICTDB._Db._Db-misc2[1]
                                      ,1
                                      ,LENGTH(DICTDB._Db._Db-misc2[1]
                                              ,"character") - 6
                                      ,"character")
  		                       ELSE DICTDB._Db._Db-misc2[1] )
          DICTDB._Db._Db-misc2[4] = "".
        
  REPEAT i = 1 TO 80:
   IF ( CAN-DO(odbc-bug-list[i], driver-prefix) OR
         CAN-DO(odbc-bug-list[i], "ALL") ) AND
         NOT CAN-DO(odbc-bug-excld[i], driver-prefix) THEN
      ASSIGN DICTDB._Db._Db-misc2[4] = DICTDB._Db._Db-misc2[4]
                                   + string(i) + "," .
   END. 
END. 
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

./*-----------------------------------------------------------------------

File:
    prodict/mss/_mss_sys.p
    
Description:
    depending on the input code this routines either creates/updates
    the metaschema-info for the foreign db, or returns specifique info.

Input Parameter:
    system      a   add meta-schema tables
                c   can-delete this _db? (:= no userdefined tables?)
                f   supply list of foreign-names of foreign meta-schema
                p   supply list of progress-names of foreign meta-schema
                q   query for capabilities
                u   supply list of un{dump|load}able foreign object-types

Output Parameter:
    system      a       none
                c       "ok"  or  ""  for "can-delete"  or  "can't delete"
                f,p,u   list of objects
                q       list of allowed/supported functions/features
                
History:
      04/20/06    fernando    Added NOTTCACHE define - 20050930-006  
-----------------------------------------------------------------------*/


/*===========================  DEFINITIONS ============================*/
&GLOBAL-DEFINE NOTTCACHE 1
{ prodict/dictvar.i }

DEFINE INPUT        PARAMETER dbkey  AS RECID     NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER system AS CHARACTER NO-UNDO.

DEFINE VARIABLE               l_schema-ok   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE               l_sys-obj     AS CHARACTER NO-UNDO.
DEFINE VARIABLE               l_sys-obj-f   AS CHARACTER NO-UNDO.

/*=============================  TRIGGERS  ============================*/

/*=======================  INTERNAL PROCEDURES  =======================*/

/*=========================  INITIALIZATIONS  =========================*/

/* initialize system-objects list */
assign
  l_sys-obj   = {prodict/mss/mss_sys.i}
  l_sys-obj-f = "".
/* NOTE: If you add a new foreign-meta-schema table be sure to append
 *       its progress-name and foreign-name TO THE END of the lists
 *       above. This way we automatically upgrade old schemaholders
 *       with the new tables.
 */

assign
  l_schema-ok = available DICTDB._File OR dbkey = ?.

/*============================  MAIN CODE  ============================*/


/*
system = "f" for list of foreign-names of meta-schema-objects
-------------------------------------------------------------
*/
IF      system BEGINS "f"
 then assign system = l_sys-obj-f.


/*
system = "p" for list of progress-names of meta-schema-objects
--------------------------------------------------------------
*/
ELSE IF system BEGINS "p"
 then assign system = l_sys-obj.


/*
system = "a" for add system tables
----------------------------------
*/
ELSE IF system BEGINS "a" THEN DO: /* add meta-schema definitions */
  RUN adecomm/_setcurs.p ("WAIT").
  RUN "prodict/mss/_mss_crp.p" (dbkey).
  RUN adecomm/_setcurs.p ("").
END.


/*
system = "c" for can-remove system tables
-----------------------------------------
*/
ELSE IF system BEGINS "c" THEN DO: /* can remove entire schema? */
  /* return OK if the database contains no user files and can be deleted */
  FIND FIRST DICTDB._File
    WHERE DICTDB._File._Db-recid = dbkey
    AND   LOOKUP(DICTDB._File._File-name,l_sys-obj) = 0
    and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
    NO-ERROR.
  system = STRING(AVAILABLE DICTDB._File,"/ok").
END.


/*
system = "q" for query
----------------------
  ENTRY 1 = valid database options
            a=after_add, c=can_delete, d=do_delete, u=userid/passwd_supported
  ENTRY 2 = valid file options
            a=add, c=can_copy_fields, d=delete, f=chg_foreign_name,
            g=get_foreign_name, n=can_add_new_fields, o=get_ownername,
            r=rename, s=chg_foreign_size, t=chg_foreign_type
  ENTRY 3 = valid index options
            a=add, b=idxbuild, d=delete, i=inactivate_index,
            n=non-unique_indexes_allowed, r=rename, s=set_primary,
            u=change uniqueness_allowed, w=word_index, 
             #=index-number-to-be-generated
  ENTRY 4 = load size
  ENTRY 5 = db class and naming conventions
            0=progress_db 1=stand_alone_file 2=part_of_database
            l=logical_name_applies, p=physical_name_applies
  ENTRY 6 = max number index components
  ENTRY 7 = name of sysadmin user ("SA", "DBA", "SYSTEM", "MANAGER", etc.)
  ENTRY 8 = name of system tables ("SYS.*", etc.)
  ENTRY 9 = three-letter dictionary code
  ENTRY 10 = valid sequence options
            a=can_add, d=can_delete, m=can-modify-anything-beyond-name
            n=has_foreign_name o=has_owner, r=can_rename, s=seq_supported
  ENTRY 11 = default-value for code-page
*/
ELSE IF system BEGINS "q" THEN DO:
  system = "acdu,adgor,adnrsu#,100,2lp,16,?,?,mss,nors,iso8859-1".
END.


/*
system = "u" for unloadable/undumpable file types
-------------------------------------------------
*/
ELSE IF system BEGINS "u" THEN DO:
  system = "BUFFER,PROCEDURE".
END.

RETURN.
/*********************************************************************
* Copyright (C) 2006,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _mss_typ.p - mss-to-Progress datatype conversion subroutine */

/*
Pass parameters, and this routine will fill in the unknowns, as long as
io-pro-type or io-gate-type is input.

  in:  io-pro-type  = ? or Progress datatype
       io-length    = ? or _Fld-stlen; size, or 0 for variable length
       io-dtype     = ? or _Fld-stdtype; gate datatype code for _Fld-stdtype
       io-gate-type = ? or MSS datatype
  out: io-pro-type  = Progress datatype
       io-length    = _Fld-stlen
       io-dtype     = _Fld-stdtype
       io-gate-type = MSS datatype
       io-format    = suggested format

To get the list of progress types that can be mapped to a particular
gateway type:
  in:  io-pro-type  = "get-list"
       io-gate-type = ?
  out: io-pro-type = comma separated list of pro_types

To get the MSS-to-PROGRESS tables copied to the environment:
  in:  io-pro-type  = ?
       io-gate-type = ?
  out: user_env[11] = gate_desc
       user_env[12] = gate_type
       user_env[13] = gate_stlen
       user_env[14] = gate_stdtype
       user_env[15] = pro_type
       user_env[16] = gate_family
       user_env[17] = pro_format

  Note: gate_family is the data type family.  This indicates which data
  types can be changed to which other types - only types within the same
  family can be switched with each other.  0 = an orphan: cannot be changed.
 
 NOTES for gate_config: 
1) Standard character string must be first in table! 
2) All entries that are the same gateway type must be contiguous in the 
   table.
3) the format can contain either 
   * a specific format                                             OR 
   * {c,d,i,l,#,dt} for (character, date, integer, logical, decimal,datetime}
     to use the format created by the hardcoded algorithm in _xxx_mak.i   OR
 
 History:  D. McMann replaced "?" with "l" for logical data types 04/17/02
           D. McMann added format x(26) for timestamp 06/09/02
           D. McMann Removed unicode data types and guid
           fernando  04/14/06 Unicode support
           fernando  05/26/05 Added support for int64
           fernando  02/14/08 Added support for datetime
           knavneet   03/16/09  datetime-tz support for MSS
           knavneet   04/28/09  BLOB support for MSS (OE00178319)
           knavneet   05/27/09  OE00185197            
           sgarg      05/22/09  ROWGUID support for MSS
*/ 
&SCOPED-DEFINE GATE_CONFIG_ENTRIES 63
DEFINE VARIABLE gate-config AS CHARACTER EXTENT {&GATE_CONFIG_ENTRIES} NO-UNDO.
/* from prodict/dictvar.i */
DEFINE SHARED VARIABLE is-pre-101b-db  AS LOGICAL NO-UNDO.
{ prodict/user/uservar.i }

DEFINE INPUT-OUTPUT PARAMETER io-dtype     AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-length    AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-pro-type  AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-gate-type AS CHARACTER NO-UNDO.
DEFINE       OUTPUT PARAMETER io-format    AS CHARACTER NO-UNDO.

DEFINE              VARIABLE  c            AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_desc    AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_stdtype AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_stlen   AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_type    AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_family  AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  i            AS INTEGER   NO-UNDO.
DEFINE              VARIABLE  pro_format   AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  pro_type     AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  isDatetimeDefault  AS LOGICAL   NO-UNDO INIT NO.
DEFINE              VARIABLE  isLobDefault      AS LOGICAL   NO-UNDO INIT NO.
DEFINE              VARIABLE  isClobEnabled     AS LOGICAL   NO-UNDO INIT NO.
DEFINE              VARIABLE  isBlobEnabled     AS LOGICAL   NO-UNDO INIT NO.
DEFINE              VARIABLE  numEntries         AS INTEGER   NO-UNDO.

FUNCTION initGateConfig RETURN CHARACTER EXTENT {&GATE_CONFIG_ENTRIES}
 (INPUT isDatetimeDefault as logical, INPUT isLobDefault as logical, INPUT isClobEnabled as logical, INPUT isBlobEnabled as logical) FORWARD.

IF io-pro-type NE ? THEN DO:
   ASSIGN numEntries   = NUM-ENTRIES(io-pro-type).
          isDatetimeDefault = (IF ENTRY(1,io-pro-type) = "datetime_default" 
                               THEN YES ELSE NO).
   IF numEntries > 1 THEN DO:
      isLobDefault = (IF ENTRY(2,io-pro-type) = "lob_default" 
                      THEN YES ELSE NO ).
      if isLobDefault and numEntries > 3 then
      do:
        isClobEnabled = (IF ENTRY(3,io-pro-type) = "clob_default" 
                      THEN YES ELSE NO ).
        isBlobEnabled = (IF ENTRY(4,io-pro-type) = "blob_default"
                      THEN YES ELSE NO ).
      end.
      else if isLobDefault and numEntries = 3 then 
      do:
        IF ENTRY(3,io-pro-type) = "blob_default" THEN 
          ASSIGN isBlobEnabled = YES
                 isClobEnabled = NO.
        ELSE IF ENTRY(3,io-pro-type) = "clob_default" THEN 
          ASSIGN isBlobEnabled = NO
                 isClobEnabled = YES.
      end.
   END.

   /* must reset it in these special cases */
   IF isDatetimeDefault OR isLobDefault THEN
       io-pro-type = ?. 
END.

gate-config = initGateConfig (isDatetimeDefault, isLobDefault, isClobEnabled, isBlobEnabled ).

/* If we want the list of progress types that match a given gateway
   type, then just get that.  A gateway type that matches multiple
   Progress types are in contiguous entries in the gate-config table.
*/
IF io-gate-type <> ? AND io-pro-type = "get-list" THEN DO:
  DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
    IF TRIM(ENTRY(2,gate-config[i])) = io-gate-type THEN
       LEAVE.
  END.
  io-pro-type = "".
  DO WHILE TRIM(ENTRY(2,gate-config[i])) = io-gate-type:
    /* dont' allow int64 if a pre-10.1B schema holder */
    IF NOT is-pre-101b-db OR TRIM(ENTRY(5,gate-config[i])) NE "int64" THEN
        io-pro-type = io-pro-type + (IF io-pro-type = "" THEN "" ELSE ",") +
          	       	  TRIM(ENTRY(5,gate-config[i])).
    i = i + 1.
  END.
  RETURN.
END.


/* Compose comma delimited lists of each "column" of the gate-config 
   array (leaving just the format in gate-config itself).
*/
DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
  /* dont' allow int64 if a pre-10.1B schema holder */
  IF NOT is-pre-101b-db OR TRIM(ENTRY(5,gate-config[i])) NE "int64" THEN
      ASSIGN
        gate_desc      = gate_desc    + TRIM(ENTRY(1,gate-config[i])) + ","
        gate_type      = gate_type    + TRIM(ENTRY(2,gate-config[i])) + ","
        gate_stlen     = gate_stlen   + TRIM(ENTRY(3,gate-config[i])) + ","
        gate_stdtype   = gate_stdtype + TRIM(ENTRY(4,gate-config[i])) + ","
        pro_type       = pro_type     + TRIM(ENTRY(5,gate-config[i])) + ","
        gate_family    = gate_family  + TRIM(ENTRY(6,gate-config[i])) + ","
        gate-config[i] = SUBSTRING(gate-config[i]
                                  ,INDEX(gate-config[i],"|") + 1
                                  ,-1
                                  ,"character"
                                  )
        pro_format     = pro_format   + gate-config[i] + "|".
END.

IF io-gate-type = ? AND io-pro-type = ? THEN DO:
  ASSIGN
    user_env[11] = gate_desc
    user_env[12] = gate_type
    user_env[13] = gate_stlen
    user_env[14] = gate_stdtype
    user_env[15] = pro_type
    user_env[16] = gate_family
    user_env[17] = pro_format.

  RETURN.
END.
i = 0.

/* PROGRESS datatype -> MSS datatype (io-pro-type given, io-gate-type = ?) */
IF io-gate-type = ? THEN DO: 
  DO i = 1 TO NUM-ENTRIES(gate_type) - 1:
    IF io-pro-type = ENTRY(i,pro_type)
      AND INTEGER(ENTRY(i,gate_stdtype)) = io-dtype
      AND (INTEGER(ENTRY(i,gate_stlen))  = io-length
        OR INTEGER(ENTRY(i,gate_stlen))  = 0) THEN LEAVE.
  END.
  io-gate-type = ENTRY(i,gate_type).
END.
ELSE DO: /* io-gate-type given, io-pro-type may be ? */
   i = LOOKUP(io-gate-type,gate_type).
   IF io-pro-type  = ? THEN 
      io-pro-type = ENTRY(i,pro_type).
   ELSE 
      /* Make sure we have the entry that matches both io-pro-type AND
      	 io-gate-type.
      */
      IF io-pro-type <> ENTRY(i,pro_type) THEN
	DO i = i + 1 to NUM-ENTRIES(gate_type) - 1:
	   IF io-pro-type = ENTRY(i,pro_type) AND
	      io-gate-type = ENTRY(i,gate_type) THEN LEAVE.
	END.
END.

ASSIGN
  io-length   = (IF INTEGER(ENTRY(i,gate_stlen)) = 0 THEN io-length
                ELSE INTEGER(ENTRY(i,gate_stlen)))
  io-format   = (IF gate-config[i] = "d" THEN "99/99/99"
                ELSE IF gate-config[i] = "c" THEN
                  "x(" + STRING(IF io-length = 0 THEN 8 ELSE io-length) + ")"
                ELSE gate-config[i])
  io-dtype    = INTEGER(ENTRY(i,gate_stdtype)).

/* Function : initGateConfig
   Purpose  : initilize gate-config[]
   Input    : 1 - isDatetimeDefault as logical
              2 - isBlobDefault as logical
   RETURN   : Character extent */

FUNCTION initGateConfig RETURN CHARACTER EXTENT {&GATE_CONFIG_ENTRIES}
 (INPUT isDatetimeDefault as logical, INPUT isLobDefault as logical, INPUT isClobEnabled as logical, INPUT isBlobEnabled as logical):

DEFINE VARIABLE gate-config AS CHARACTER EXTENT {&GATE_CONFIG_ENTRIES} NO-UNDO.
/* Assign gate-config[i], where 'i' is the extent no., as:
gate-config[i] = "<description>, <datatype>, <sz>, <cd>, <pro type>, <fm>, <format>" */

ASSIGN
  gate-config[1] = "Char, Char, 0, 35, character,0, |c"
  gate-config[2] = "Nchar, Nchar, 0, 50, character,0, |c"
  gate-config[3] = "Time, Time, 0, 53, character,b, |x(16)"
  gate-config[4] = "Time, Time, 0, 53, datetime ,b, |dt"
  gate-config[5] = "Binary, Binary, 0, 38, character,0, |c"
  gate-config[6] = "Date, Date, 0, 43, date, c, |d"
  gate-config[7] = "Date, Date, 0, 43, datetime, c, |dt"
  gate-config[8] = "Date, Date, 0, 43, datetime-tz, c, |dtz"
  gate-config[9] = "Date, Date, 0, 43, character, c, |x(10)"
  gate-config[10] = "Numeric, Numeric, 0, 136,decimal, 1, |#"
  gate-config[11] = "Numeric, Numeric, 0, 136,integer, 1, |i"
  gate-config[12] = "Numeric, Numeric, 0, 136,int64, 1, |i"
  gate-config[13] = "Decimal, Decimal, 0, 236,decimal, 2, |#"
  gate-config[14] = "Decimal, Decimal, 0, 236,integer, 2, |i"
  gate-config[15] = "Decimal, Decimal, 0, 236,int64, 2, |i"
  gate-config[16] = "Integer, Integer, 0, 33, integer, 3, |i"
  gate-config[17] = "Integer, Integer, 0, 33, decimal, 3, |#"
  gate-config[18] = "Integer, Integer, 0, 33, logical, 3, |?"
  gate-config[19] = "Integer, Integer, 0, 33, int64, 3, |i"
  gate-config[20] = "Integer, Integer, 0, 33, recid, 3, |i"
  gate-config[21] = "Smallint, Smallint, 0, 32, integer, 4, |i"
  gate-config[22] = "Smallint, Smallint, 0, 32, decimal, 4, |#"
  gate-config[23] = "Smallint, Smallint, 0, 32, logical, 4, |l"
  gate-config[24] = "Smallint, Smallint, 0, 32, int64, 4, |i"
  gate-config[25] = "Float, Float, 0, 34, decimal, 5, |#"
  gate-config[26] = "Float, Float, 0, 34, integer, 5, |i"
  gate-config[27] = "Float, Float, 0, 34, int64, 5, |i"
  gate-config[28] = "Real, Real, 0, 48, decimal, 6, |#"
  gate-config[29] = "Real, Real, 0, 48, integer, 6, |i"
  gate-config[30] = "Real, Real, 0, 48, int64, 6, |i"
  gate-config[31] = "Double, Double, 0, 134,decimal, 7, |#"
  gate-config[32] = "Double, Double, 0, 134,integer, 7, |i"
  gate-config[33] = "Double, Double, 0, 134,int64, 7, |i"
  gate-config[34] = "Bigint, Bigint, 0, 234,int64, 8, |i"
  gate-config[35] = "Bigint, Bigint, 0, 234,decimal, 8, |#"
  gate-config[36] = "Bigint, Bigint, 0, 234,integer, 8, |i"
  gate-config[37] = "Tinyint, Tinyint, 0, 31, integer, 9, |->>9"
  gate-config[38] = "Tinyint, Tinyint, 0, 31, decimal, 9, |->>>>9"
  gate-config[39] = "Tinyint, Tinyint, 0, 31, logical, 9, |l"
  gate-config[40] = "Tinyint, Tinyint, 0, 31, int64, 9, |i"
  gate-config[41] = "Bit, Bit, 0, 41, logical, 0, |l"
  gate-config[42] = "Timestamp-tz, Timestamp-tz, 0, 54 ,datetime-tz, d,|dtz"
  gate-config[43] = "Timestamp-tz, Timestamp-tz, 0, 54 ,datetime, d,|dt"
  gate-config[44] = "Timestamp-tz, Timestamp-tz, 0, 54 ,date, d,|d"
  gate-config[45] = "Timestamp-tz, Timestamp-tz, 0, 54 ,character, d,|x(34)".

IF isDatetimeDefault THEN 
    ASSIGN
      gate-config[46] = "Timestamp, Timestamp, 0, 44, datetime, a, |dt"
      gate-config[47] = "Timestamp, Timestamp, 0, 44, date, a, |d".
ELSE
    ASSIGN
      gate-config[46] = "Timestamp, Timestamp, 0, 44, date, a, |d"
      gate-config[47] = "Timestamp, Timestamp, 0, 44, datetime, a, |dt".

ASSIGN
  gate-config[48] = "Timestamp, Timestamp, 0, 44, datetime-tz, a, |dtz"
  gate-config[49] = "Timestamp, Timestamp, 0, 44, character, a, |x(27)".

IF isLobDefault and isBlobEnabled and isClobEnabled THEN 
    ASSIGN
      gate-config[50] = "Longvarbinary, Longvarbinary,0, 40, BLOB,e, |c"
      gate-config[51] = "Longvarbinary, Longvarbinary,0, 40, character,e, |c"
      gate-config[52] = "Varbinary, Varbinary, 0, 39, BLOB,f, |c"
      gate-config[53] = "Varbinary, Varbinary, 0, 39, character,f, |c"
      gate-config[54] = "Longvarchar, Longvarchar, 0, 37, CLOB,g, |c"
      gate-config[55] = "Longvarchar, Longvarchar, 0, 37, character,g, |c"
      gate-config[56] = "Varchar, Varchar, 0, 36, CLOB,h, |c"
      gate-config[57] = "Varchar, Varchar, 0, 36, character,h, |c"
      gate-config[58] = "NLongvarchar, Nlongvarchar, 0, 52, CLOB,0, |c"
      gate-config[59] = "NLongvarchar, Nlongvarchar, 0, 52, character,0, |c"
      gate-config[60] = "NVarchar, Nvarchar, 0, 51, CLOB,i, |c"
      gate-config[61] = "NVarchar, Nvarchar, 0, 51, character,i, |c".
ELSE IF isLobDefault and isClobEnabled and NOT isBlobEnabled THEN 
    ASSIGN
      gate-config[50] = "Longvarbinary, Longvarbinary,0, 40, character,e, |c"
      gate-config[51] = "Longvarbinary, Longvarbinary,0, 40, BLOB,e, |c"
      gate-config[52] = "Varbinary, Varbinary, 0, 39, character,f, |c"
      gate-config[53] = "Varbinary, Varbinary, 0, 39, BLOB,f, |c"
      gate-config[54] = "Longvarchar, Longvarchar, 0, 37, CLOB,g, |c"
      gate-config[55] = "Longvarchar, Longvarchar, 0, 37, character,g, |c"
      gate-config[56] = "Varchar, Varchar, 0, 36, CLOB,h, |c"
      gate-config[57] = "Varchar, Varchar, 0, 36, character,h, |c"
      gate-config[58] = "NLongvarchar, Nlongvarchar, 0, 52, CLOB,0, |c"
      gate-config[59] = "NLongvarchar, Nlongvarchar, 0, 52, character,0, |c"
      gate-config[60] = "NVarchar, Nvarchar, 0, 51, CLOB,i, |c"
      gate-config[61] = "NVarchar, Nvarchar, 0, 51, character,i, |c".
ELSE IF isLobDefault and NOT isClobEnabled and isBlobEnabled THEN
    ASSIGN
      gate-config[50] = "Longvarbinary, Longvarbinary,0, 40, BLOB,e, |c"
      gate-config[51] = "Longvarbinary, Longvarbinary,0, 40, character,e, |c"
      gate-config[52] = "Varbinary, Varbinary, 0, 39, BLOB,f, |c"
      gate-config[53] = "Varbinary, Varbinary, 0, 39, character,f, |c"
      gate-config[54] = "Longvarchar, Longvarchar, 0, 37, character,g, |c"
      gate-config[55] = "Longvarchar, Longvarchar, 0, 37, CLOB,g, |c"
      gate-config[56] = "Varchar, Varchar, 0, 36, character,h, |c"
      gate-config[57] = "Varchar, Varchar, 0, 36, CLOB,h, |c"
      gate-config[58] = "NLongvarchar, Nlongvarchar, 0, 52, character,0, |c"
      gate-config[59] = "NLongvarchar, Nlongvarchar, 0, 52, CLOB,0, |c"
      gate-config[60] = "NVarchar, Nvarchar, 0, 51, character,i, |c"
      gate-config[61] = "NVarchar, Nvarchar, 0, 51, CLOB,i, |c".
ELSE 
    ASSIGN
      gate-config[50] = "Longvarbinary, Longvarbinary,0, 40, character,e, |c"
      gate-config[51] = "Longvarbinary, Longvarbinary,0, 40, BLOB,e, |c"
      gate-config[52] = "Varbinary, Varbinary, 0, 39, character,f, |c"
      gate-config[53] = "Varbinary, Varbinary, 0, 39, BLOB,f, |c"
      gate-config[54] = "Longvarchar, Longvarchar, 0, 37, character,g, |c"
      gate-config[55] = "Longvarchar, Longvarchar, 0, 37, CLOB,g, |c"
      gate-config[56] = "Varchar, Varchar, 0, 36, character,h, |c"
      gate-config[57] = "Varchar, Varchar, 0, 36, CLOB,h, |c"
      gate-config[58] = "NLongvarchar, Nlongvarchar, 0, 52, character,0, |c"
      gate-config[59] = "NLongvarchar, Nlongvarchar, 0, 52, CLOB,0, |c"
      gate-config[60] = "NVarchar, Nvarchar, 0, 51, character,i, |c"
      gate-config[61] = "NVarchar, Nvarchar, 0, 51, CLOB,i, |c".

/* Add any other entries here */
ASSIGN
  gate-config[62] = "ROWGUID, ROWGUID, 0, 55, character, 0, |x(36)". /* OE00196270 */
ASSIGN 
   gate-config[{&GATE_CONFIG_ENTRIES}] = ?. /* Please note that this should be the last value */

RETURN gate-config.
END FUNCTION.

RETURN.
/***********************************************************************
* Copyright (C) 2000,2010 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions           *
* contributed by participants of Possenet.                             *
*                                                                      *
************************************************************************/

/*----------------------------------------------------------------------------

File: _mssschg.p

    Created from _usrschg.p


Input-Parameters:
    none
    
Output-Parameters:
    none
    
Used/Modified Shared Objects:
    in:  user_env[1] = "add" or "upd"
         user_env[3] = dbtype to add or "" for any
                       MS Sql Srver 7, ORACLE  OR
                       ODBC (Sybase, SQLServer, DB2, Informix, MS SQL 6.5)
    out: user_env[2] = new DICTDB._Db._Db-name
         no other environment variables changed

History:
    D. McMann 06/18/01  Based on _usrschg.p 20010615-001
    moloney   07/21/21  Unicode requirements for schema holder database - added to CR#OE00147991
    sgarg     07/12/10  Disallow ? as case-insesitive entry (OE00198732)
                        

----------------------------------------------------------------------------*/
/*h-*/

/*==========================  DEFINITIONS ===========================*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE amode    AS LOGICAL            NO-UNDO. /*true=add,false=modify*/
DEFINE VARIABLE c        AS CHARACTER          NO-UNDO.
DEFINE VARIABLE codepage AS CHARACTER          NO-UNDO format "x(40)".
DEFINE VARIABLE collname AS CHARACTER          NO-UNDO FORMAT "x(40)".
DEFINE VARIABLE dblst    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE f_addr   AS CHARACTER          NO-UNDO.
DEFINE VARIABLE f_comm   AS CHARACTER          NO-UNDO.
DEFINE VARIABLE fmode    AS LOGICAL            NO-UNDO. /* part of gateway */
DEFINE VARIABLE i        AS INTEGER  INITIAL 0 NO-UNDO.
DEFINE VARIABLE j        AS INTEGER            NO-UNDO.
DEFINE VARIABLE okay     AS LOGICAL            NO-UNDO.
DEFINE VARIABLE ronly    AS LOGICAL            NO-UNDO. /* read only */
DEFINE VARIABLE x-l      AS LOGICAL            NO-UNDO. /* allow set ldb name */
DEFINE VARIABLE x-p      AS LOGICAL            NO-UNDO. /* allow set pdb name */
DEFINE VARIABLE canned   AS LOGICAL  INIT TRUE NO-UNDO.
DEFINE VARIABLE dname    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE dsource  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE dstitle  AS CHARACTER FORMAT "x(26)"    NO-UNDO.
DEFINE VARIABLE casesen  AS LOGICAL            NO-UNDO.
DEFINE VARIABLE olddb    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE olddbtyp AS CHARACTER          NO-UNDO.

/* LANGUAGE DEP  END.ENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 14 NO-UNDO INITIAL [
  /* 1*/ "You have to select a non-PROGRESS database to use this option.",
  /* 2*/ "None of the above information may be changed for this database.",
  /* 3*/ "(Cannot change Logical Name while database is Connected.)",
  /* 4*/ "Supported ODBC Data Sources:  ",
  /* 5*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 6*/ "You do not have permission to create foreign database definitions.",
  /* 7*/ "You do not have permission to view foreign database definitions.",
  /* 8*/ "You do not have permission to alter foreign database definitions.",
  /* 9*/ "There is currently a database using this name as a dbname or alias",
  /*10*/ "Internal Dictionary Error: inconsistent dbtype encountered.",
  /*11*/ "Logical Database Name may not be left blank or unknown.",
  /*12*/ "Connect parameters are required.",
  /*13*/ "ODBC Data Source Name is required.",
  /*14*/ "Oracle version must be either 7 or 8."
].
FORM
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN    
    SKIP ({&TFM_WID}) 
  &ENDIF
    DICTDB._Db._Db-name  FORMAT "x(18)" COLON 23 LABEL "Logical Database Name" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
   /* DICTDB._Db._Db-type  FORMAT "x(10)" COLON 23 LABEL "Server Type" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
     */
    codepage                     COLON 23 LABEL "Code Page" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
    collname                     COLON 23 LABEL "Collation" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
    casesen                      COLON 23 LABEL "Case Insensitive"  SKIP ({&VM_WIDG})
    new_lang[3]   FORMAT "x(63)" AT 2 NO-LABEL VIEW-AS TEXT SKIP ({&VM_WIDG})
    
    "Connection Parameters:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
    f_comm                   AT 2 NO-LABEL {&STDPH_EDITOR}
      VIEW-AS EDITOR 
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
               SIZE 65 BY 4
      &ELSE 
               SIZE 65 BY 3 SCROLLBAR-VERTICAL
      &ENDIF
    SKIP({&VM_WIDG})

    dstitle NO-LABEL VIEW-AS TEXT AT 2 SKIP ({&VM_WID})
    f_addr AT 2 FORMAT "x(256)" NO-LABEL VIEW-AS FILL-IN SIZE 65 BY 1
      {&STDPH_FILL} 

    {prodict/user/userbtns.i}
    WITH FRAME userschg ROW 1 CENTERED SIDE-LABELS
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX 
      TITLE "Create/Modify Database Record for MSS Schema".


/* LANGUAGE DEP  END.ENCIES   END. */ /*------------------------------------------*/

/*================================Triggers=================================*/
ON ANY-PRINTABLE OF casesen IN FRAME userschg 
DO:
    /* Disallow ? KEY EVENT in case-insensitive entry box during PULL */
    IF LAST-EVENT:LABEL = "?" THEN
    DO: 
        BELL. 
        RETURN NO-APPLY.  
    END.
END.

/*----- LEAVE of LOGICAL NAME -----*/
ON LEAVE OF DICTDB._Db._Db-name IN FRAME userschg DO:

    Define variable btn_ok   as logical initial true.
  
    /* If logical name was edited and name is in use: */
    dname = TRIM(INPUT FRAME userschg DICTDB._Db._Db-name).
    IF DICTDB._Db._Db-name ENTERED 
      THEN DO:  /* DICTDB._Db._Db-name ENTERED */
        IF LDBNAME(dname) <> ?
          THEN DO:
            MESSAGE new_lang[9] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RETURN NO-APPLY.
            END.
        ELSE IF user_env[1] = "chg"
          THEN DO:
            message "Changing the logical database name causes"  skip
                    "the Data Administration tool to close."     skip
                    "You can then continue working with the "    skip
                    "tool by restarting it."                     skip(1)
                    "Do you want to make the change?"
                    view-as alert-box QUESTION buttons yes-no 
                    update btn_ok.
            if btn_ok 
              THEN ASSIGN user_path = "*E".
              ELSE DO:
                DISPLAY dname @ DICTDB._Db._Db-name WITH FRAME userschg.
                RETURN NO-APPLY.
                END.
            END.
        END.    /* DICTDB._Db._Db-name ENTERED */
    END.

/*----- LEAVE of code-page -----*/
{prodict/gate/gat_cpvl.i
  &frame    = "userschg"
  &variable = "codepage"
  &adbtype  = "user_env[3]" 
  }  /* checks if codepage contains convertable code-page */
 

/*----- GO or OK -----*/
ON GO OF FRAME userschg DO:
  dname = TRIM(INPUT FRAME userschg DICTDB._Db._Db-name).
  IF dname = "" OR dname = ? THEN DO:
     MESSAGE new_lang[11] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     APPLY "ENTRY" TO DICTDB._Db._Db-name IN FRAME userschg.
     RETURN NO-APPLY.
  END.
  IF x-p AND (INPUT FRAME userschg f_addr = "" or 
              INPUT FRAME userschg f_addr = ?) THEN DO:
       MESSAGE new_lang[13] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       APPLY "ENTRY" TO f_addr IN FRAME userschg.
       RETURN NO-APPLY.      
  END.      
END.

/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME userschg
    APPLY "END-ERROR" TO FRAME userschg.


/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME userschg OR CHOOSE of btn_Help IN FRAME userschg DO:
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&Create_DataServer_Schema_Dlg_Box},
      	       	     	      INPUT ?).
    END.
&ENDIF

    /* ----- Cancel ------ */
ON 'choose':U OF btn_cancel IN FRAME userschg DO:
    ASSIGN canned = TRUE
           user_dbname = olddb
           user_dbtype =  olddbtyp.
    RETURN.
END.

/*============================Mainline Code===============================*/

ASSIGN
  amode    = (user_env[1] = "add")
  fmode    = (user_env[3] <> "")
  olddb    = user_dbname
  olddbtyp = user_dbtype
  dblst    = (IF fmode THEN user_env[3] ELSE SUBSTRING(GATEWAYS,10)).
             /* 10 = LENGTH("PROGRESS") + 2 */

ASSIGN dstitle = "ODBC Data Source Name: ".

 
{ prodict/dictgate.i &action=query &dbtype=dblst &dbrec=? &output=c }

x-p = INDEX(ENTRY(5,c),"p") > 0.

IF NOT amode
  THEN DO:
    FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-ERROR.
    IF NOT DICTDB._Db._Db-slave THEN i = 1. /* no DICTDB._Db rec */
    IF fmode AND dblst <> user_dbtype THEN i = 10. /* inconsistent dbtype */
    END.

if user_env[1] = "add" then do:
    { prodict/dictgate.i &action=query &dbtype=dblst &dbrec=? &output=codepage }
    assign codepage = ENTRY(11,codepage)
           collname = SESSION:CPCOLL
           casesen = TRUE.
END.
else  
  assign codepage = DICTDB._Db._Db-xl-name
         collname = (IF DICTDB._DB._Db-coll-name <> ? THEN DICTDB._DB._Db-coll-name
                             ELSE SESSION:CPCOLL)
         casesen = (IF DICTDB._Db._Db-misc1[1] = 1 THEN TRUE ELSE FALSE).



IF i > 0 THEN DO:
  MESSAGE new_lang[i] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
  END.

ASSIGN
  f_addr = (IF AVAILABLE DICTDB._Db THEN DICTDB._Db._Db-addr ELSE "")
  f_comm = (IF AVAILABLE DICTDB._Db THEN DICTDB._Db._Db-comm ELSE "").
 

DO FOR DICTDB._File:
  FIND DICTDB._File "_Db" WHERE _File._Owner = "PUB" NO-LOCK.
  IF amode AND NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[6] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
    END.
  IF NOT amode AND NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[7] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
    END.
  ASSIGN
    x-l   = amode OR NOT CONNECTED(DICTDB._Db._Db-name) /* can set ldb name? */
    ronly = NOT CAN-DO(_Can-write,USERID("DICTDB")).
  END.

{adecomm/okrun.i  
  &FRAME  = "FRAME userschg" 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  {&CAN_BTN}
  {&HLP_BTN}
}

ASSIGN f_comm:RETURN-INSERT in frame userschg = yes.

DISPLAY
  DICTDB._Db._Db-name WHEN AVAILABLE DICTDB._Db
  new_lang[3]  WHEN NOT x-l
  f_addr       WHEN x-p
  codepage
  collname
  dstitle
  casesen
  f_comm
  WITH FRAME userschg.

IF dict_rog OR ronly THEN DO:
    MESSAGE (IF dict_rog THEN new_lang[5] ELSE new_lang[8])
      VIEW-AS ALERT-BOX WARNING BUTTONS OK.
    ASSIGN  user_path = "".
    RETURN.      
END.  /* dict_rog OR ronly (we're in read-only mode - view only) */
      
  ELSE _trx: DO TRANSACTION WITH FRAME userschg:

    DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
     PROMPT-FOR
          DICTDB._Db._Db-name WHEN x-l   AND               NOT (dict_rog OR ronly)
          codepage            WHEN amode AND               NOT (dict_rog OR ronly)
          collname            WHEN amode AND               NOT (dict_rog OR ronly)
          casesen             WHEN amode  
          f_comm              WHEN                         NOT (dict_rog OR ronly)
          f_addr              WHEN x-p   AND               NOT (dict_rog OR ronly)
          btn_OK
          btn_Cancel
          {&HLP_BTN_NAME}.
     

      canned = false.
    END.

    IF canned THEN UNDO _trx, LEAVE _trx.

    IF amode
      THEN DO: /* create a new DICTDB._Db for a schema for a Non-PROGRESS db */
          
        CREATE DICTDB._Db.
        ASSIGN
          DICTDB._Db._Db-name    = INPUT DICTDB._Db._Db-name
          DICTDB._Db._Db-slave = TRUE
          DICTDB._Db._Db-type  = "MSS"
          DICTDB._Db._Db-addr  = ""
          DICTDB._Db._Db-comm  = ""
          DICTDB._Db._Db-misc1[1] = (IF INPUT casesen = TRUE THEN 1 
                                                ELSE 0)
          user_dbtype   = DICTDB._Db._Db-type.
        
        
        IF NOT fmode THEN 
          &IF "{&WINDOW-SYSTEM}" = "TTY"
            &THEN
                   user_path = "1=sys,_usrsget".
            &ELSE
                   user_path = "1=sys,_guisget".
            &ENDIF
        { prodict/dictgate.i &action=query &dbtype=DICTDB._Db._Db-type &dbrec=? &output=c }
        IF INDEX(ENTRY(1,c),"a") > 0
          THEN DO:
            { prodict/dictgate.i &action=add
              &dbtype=DICTDB._Db._Db-type &dbrec=RECID(DICTDB._Db) &output=c }
            END.
        END.   /* create a new DICTDB._Db for a schema for a Non-PROGRESS db */

    ASSIGN
      DICTDB._Db._Db-name    = INPUT DICTDB._Db._Db-name
      user_env[2]            = DICTDB._Db._Db-name
      DICTDB._Db._Db-addr    = (IF DICTDB._Db._Db-addr = ? THEN "" ELSE DICTDB._Db._Db-addr)
      DICTDB._Db._Db-comm    = TRIM(INPUT f_comm)
      /* Remove any line feeds (which we get on WINDOWS) */
      DICTDB._Db._Db-comm    = REPLACE(DICTDB._Db._Db-comm, CHR(13), "")
      user_dbname     = DICTDB._Db._Db-name
      .

   DICTDB._Db._Db-xl-name = if codepage = "<internal defaults apply>" 
                         then ? 
                         else codepage.
   DICTDB._Db._Db-coll-name = INPUT collname.

    IF x-p THEN DICTDB._Db._Db-addr = INPUT f_addr.

    { prodict/user/usercon.i }

 END.   /* _trx: do transaction */

RELEASE DICTDB._Db.   /* I'm not sure why we need this? (los) */

IF canned THEN user_path = "".
HIDE FRAME userschg NO-PAUSE.
RETURN.

/*====================================================================*/





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _snd_sql.p - SEND.SQL toMSS to create MSS objects. */

/*++


Component:  Protoxxx   (progress to foreign datamanager)

Purpose:    Read in SQL from a file created by _wrktgen.p
            and use SEND-SQL-STATEMENT stored procedure
            to perform each command inside foreign data manager. 

            NOTE: The output of this file can be adjusted 
                 by using the local environment variables 
                 and the dataserver dependent section at 
                 begining of the code.  

History:    
   D. McMann 03/31/00 Created from odb/_snd_sql.p

--*/


{ prodict/gate/_snd_sql.i }
/*********************************************************************
* Copyright (C) 2000, 2009 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _sndinfo.p - 

   History:  DLM Removed warning message about driver not being certified 11/23/98
   nagaraju 10/21/09 Support for computed column RECID in MSSDS - OE00186593 

*/
{ prodict/dictvar.i }
{ prodict/gate/odb_ctl.i }

DEFINE VARIABLE driver-prefix AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.

RUN STORED-PROC DICTDBG.CloseAllProcs.
FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.
RUN STORED-PROC DICTDBG.GetInfo (0).
FOR EACH DICTDBG.GetInfo_buffer:

  IF DICTDB._Db._Db-misc2[1] = ? THEN DO:
    ASSIGN
      DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name
      DICTDB._Db._Db-misc2[2] = DICTDBG.GetInfo_buffer.driver_version
      DICTDB._Db._Db-misc2[3] = (IF (LENGTH(DICTDBG.GetInfo_buffer.escape_char) < 1)
			 THEN " "
  			 ELSE
  			 DICTDBG.GetInfo_buffer.escape_char) +
        			 (IF (LENGTH(DICTDBG.GetInfo_buffer.quote_char)
				 < 1)
  			 THEN " "
  			 ELSE
  			 DICTDBG.GetInfo_buffer.quote_char) 
        DICTDB._Db._Db-misc2[5] = DICTDBG.GetInfo_buffer.dbms_name + " " +
  			 DICTDBG.GetInfo_buffer.dbms_version 
        DICTDB._Db._Db-misc2[6] = DICTDBG.GetInfo_buffer.odbc_version
        DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver  +
  		       ",Client Ver #:" + DICTDBG.GetInfo_buffer.prgrs_clnt  +
  		       ",Server Ver #:" + DICTDBG.GetInfo_buffer.prgrs_srvr  +
		       ",".

        driver-prefix = IF DICTDB._Db._Db-misc2[1] BEGINS "QE" THEN
  		      SUBSTRING(DICTDB._Db._Db-misc2[1], 1,
  				LENGTH(DICTDB._Db._Db-misc2[1]) - 6) ELSE
  		      DICTDB._Db._Db-misc2[1].

        DICTDB._Db._Db-misc2[4] = "".
        REPEAT i = 1 TO 80:
          DICTDB._Db._Db-misc2[4] = IF ( CAN-DO(odbc-bug-list[i], driver-prefix)
                                OR CAN-DO(odbc-bug-list[i], "ALL") )
                                AND NOT CAN-DO(odbc-bug-excld[i],
  					 driver-prefix)
                             THEN DICTDB._Db._Db-misc2[4] + string(i) + "," 
  			   ELSE DICTDB._Db._Db-misc2[4].
        END. /* REPEAT */

        END. /* _Db._Db-misc2[1] = ? DO */
    
    ELSE IF DICTDB._Db._Db-misc2[1] <> DICTDBG.GetInfo_buffer.driver_name THEN
    DO:
      MESSAGE
	    "The Schema Holder was not created with the ODBC driver you have"
	    "connected with." SKIP
	    "You may experience problems with this connection."
	    SKIP(1)
	    "Schema Holder: "  DICTDB._Db._Db-misc2[1] SKIP
	    "Current driver: " DICTDBG.GetInfo_buffer.driver_name
	    SKIP(1)
	    "Please consider recreating your schema holder using the current"
	    "ODBC driver."
	    VIEW-AS ALERT-BOX WARNING BUTTONS OK.
    END.
  END.
  CLOSE STORED-PROC DICTDBG.GetInfo.

  /* Refresh the bug info we just calculated.				*/
  RUN STORED-PROC DICTDBG.SendInfo (DICTDB._Db._Db-misc2[4]).
  CLOSE STORED-PROC DICTDBG.SendInfo.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Put an escape sequenve in front of meta-characters. */
DEFINE INPUT PARAMETER src AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER trgt AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER mss-escape AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ret-unknown AS LOGICAL NO-UNDO.

DEFINE VARIABLE strt AS INT INIT 1 NO-UNDO.
DEFINE VARIABLE ind AS INT NO-UNDO.
DEFINE VARIABLE escape-seq AS CHARACTER NO-UNDO.

/* Some drivers don't support % in the search pattern */
IF src = "%" OR ret-unknown THEN src = ?.

IF src = ? OR mss-escape = ? OR mss-escape = "" OR src = "%"
THEN DO:
  trgt = src.
  RETURN.
END.

escape-seq = mss-escape + "_".
REPEAT:
  ind = INDEX (SUBSTRING(src,strt), "_").

  IF ind = 0
    THEN LEAVE.

  SUBSTRING(src, ind + strt - 1, 1) = escape-seq.
  strt = strt + ind  + 1.
END.

escape-seq = mss-escape + "%".
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt), "%").

  IF ind = 0
    THEN LEAVE.

  SUBSTRING(src, ind + strt - 1, 1) = escape-seq.
  strt = strt + ind  + 1.
END.

trgt = src.

RETURN.



/*********************************************************************
* Copyright (C) 2007-2011 by Progress Software Corporation. All      *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/mss_pul.i

Description:
    creates the _field-definitions out of the ODBC-definitions
    
Text-Parameters:
    &data-type      Foreign data-type in PROGRESS-Notation
                    usually DICTDBG.SQLColumns_buffer.data-type
    &extent         in the range of 0 to n
    &order-offset   gets added to the _field._order
    
Included in:            
    prodict/mss/_mss_pul.p
    
History:
   D. McMann  03/31/00 Created from odb/odb_pul.i
   D. McMann  05/15/01 Added check for differences between precision and
                         length
   D. McMann  10/24/02 Added check for Identity field to remove mandatory flag
                       and mark _Field._Fld-Misc2[4] as "identity"
                       
   D. McMann  01/08/03 Added logic to find default value for initial value
   fernando   09/11/07 Fixing issue with Initial when not Unicode case - OE00157726
   knavneet   11/14/07 Fixing issue with numeric default for char column - OE00127261
   fernando   02/14/08 Support for datetime
   fernando   04/08/08 Handle MAX field with Native driver - OE00165897
   fernando   08/18/08 Check default value for date/time - OE00167581
   fernando   08/25/08 Increase column size for default processing
   Nagaraju   02/23/09 to handle timestamp field properly
   fernando   04/06/09 Support for SYSDATETIME as datetime2's default value
   sgarg      05/22/09 ROWGUID support for MSS
   knavneet   02/17/10 OE00131234 
   Nagaraju   05/04/10 change metadata sql to refer INFORMATION_SCHEMA.columns  - OE00197280
   sgarg      06/03/10 _Fld-Misc1[7] to store flag for TEXTPTR_LOB_TYPES
   musingh    03/30/11 Added logic to set the flag TEXTPTR_LOB_TYPES only for 
                       actual Legacy Server LOB types(text, ntext and image).
--------------------------------------------------------------------*/

DEFINE VARIABLE my_typ_unicode AS LOGICAL.

/* this code gets executed only for the first element of array-field   */
/* so extent-code of field is always ##1 (even with real extent >= 10) */
assign
  pnam = TRIM(DICTDBG.SQLColumns_buffer.Column-name)
  pnam = ( if {&extent} > 0 AND LENGTH (pnam, "character") > 3 /* Drop the "##1" */
             then SUBSTRING (pnam, 1, LENGTH (pnam, "character") - 3, "character")
             else pnam )
  fnam = pnam
  pnam = ( if s_ttb_tbl.ds_type = "PROCEDURE"
            and pnam begins "@"
            then substring(pnam,2,-1,"character")
            else pnam
         ).

RUN "prodict/gate/_gat_fnm.p" 
    ( INPUT        "FIELD",
      INPUT        RECID(s_ttb_tbl),
      INPUT-OUTPUT pnam).

if NOT SESSION:BATCH-MODE
 then DISPLAY
   TRIM(DICTDBG.SQLColumns_buffer.Column-name) @ msg[3]
   pnam                                        @ msg[4]
   WITH FRAME ds_make.
assign
  dtyp    = LOOKUP({&data-type},user_env[12])
  l_init  = ?
  ntyp    = ( if dtyp = 0
                then "undefined"
                else ENTRY(dtyp,user_env[15])
            )
  l_dcml  = 0
  isFileStream = ?.

  IF ntyp = "DATE" THEN DO:
      IF DICTDBG.SQLColumns_buffer.type-name = "datetime2" THEN DO:
          /* datetime2 default mapping is datetime, which is the next entry */
          dtyp = dtyp + 1.
          ntyp = ENTRY(dtyp,user_env[15]).
      END.
  END.

  IF LOOKUP({&data-type}, "VARBINARY,LONGVARBINARY") > 0 THEN DO:

     IF (ntyp = "BLOB") AND 
         DICTDBG.SQLColumns_buffer.PRECISION >= 1 AND 
         DICTDBG.SQLColumns_buffer.PRECISION <= 8000 THEN DO:
         /* default mapping is blob , but this is a varbinary(n) in which 
            case we don't support the blob mapping, so must change it to
            character (which is the next mapping).
         */
         dtyp = dtyp + 1.
         ntyp = ENTRY(dtyp,user_env[15]).    
     END.
     ELSE IF foreign_dbms_version > 9 THEN DO:
          /* if MSS 2008 and varbinary(max) field, need to find out if filestream
             is set for field so we don't default it to character in the schema
             image. 
          */
          /* OE00183878 - get 'is_filestream' value from sys.columns catalog view */
          ASSIGN sqlstate = "SELECT is_filestream FROM sys.columns where name =  '" + 
                      DICTDBG.SQLColumns_buffer.column-name + "' and object_id = (OBJECT_ID('" +
                      DICTDBG.SQLColumns_buffer.OWNER + "." + DICTDBG.SQLColumns_buffer.NAME + "'))".
        
          RUN STORED-PROC DICTDBG.send-sql-statement dfth1 = PROC-HANDLE NO-ERROR ( sqlstate ).
        
          IF ERROR-STATUS:ERROR THEN. /*Don't do anything inital value already set to unknown */
          ELSE DO:
            FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth1:
                ASSIGN isFileStream = proc-text. 
            END.
            CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
          END.
        
          /* if ntyp is not character, it must be blob, and we already have the right
             mapping, so don't need to do anything with it.
          */
          IF ntyp = "CHARACTER" AND isFileStream = '1' THEN DO:
              /* filestream only supported mapping is blob, which is the next entry */
              dtyp = dtyp + 1.
              ntyp = ENTRY(dtyp,user_env[15]).    
          END.
      END.
  END.
  ELSE IF LOOKUP({&data-type}, "VARCHAR,LONGVARCHAR,NVARCHAR,NLONGVARCHAR") > 0 THEN DO:
     /* Handle CLOBs separately as FILESTREAM is not supported for CLOBs. */
     IF (ntyp = "CLOB") AND 
         DICTDBG.SQLColumns_buffer.PRECISION >= 1 AND 
         DICTDBG.SQLColumns_buffer.PRECISION <= 8000 THEN DO:
         /* default mapping is clob, but this is a varchar (n) in which 
            case we don't support the clob mapping, so must change it to
            character (which is the next mapping).
         */
         dtyp = dtyp + 1.
         ntyp = ENTRY(dtyp,user_env[15]).
     END.
  END.

/* check if the column type is any of the Unicode data types */
ASSIGN my_typ_unicode =  ({&data-type} = "NVARCHAR" 
                          OR {&data-type} = "NCHAR"
                          OR {&data-type} = "NLONGVARCHAR").

/* To get the default value for the field, we need to see if one has been created in SQL Server */
/* only cast it to NVARCHAR if this is a Unicode type column, in which case
   we are assumed to have utf-8 as the schema codepage. Otherwise, we will only
   be able to read the first character out of the proc-text
*/
/* OE00168292 - use max column size for given type so we can handle big values */
ASSIGN sqlstate = "select CAST(T1.definition AS "  + 
      (IF my_typ_unicode THEN "nvarchar(4000)" ELSE "varchar(8000)") +
       ") from sys.default_constraints T1 INNER JOIN INFORMATION_SCHEMA.COLUMNS T2 " + 
       " ON COL_NAME(T1.parent_object_id, T1.parent_column_id) = T2.COLUMN_NAME " + 
       " WHERE T1.parent_object_id = (OBJECT_ID('" + DICTDBG.SQLColumns_buffer.OWNER + "." + 
       DICTDBG.SQLColumns_buffer.NAME + "')) AND " + 
       " T2.TABLE_NAME = '" + DICTDBG.SQLColumns_buffer.NAME + "' AND " + 
       " COL_NAME(T1.parent_object_id, T1.parent_column_id) = '" + DICTDBG.SQLColumns_buffer.column-name + "'".

esc-idx1 = 0.

RUN STORED-PROC DICTDBG.send-sql-statement dfth1 = PROC-HANDLE NO-ERROR ( sqlstate ).

IF ERROR-STATUS:ERROR THEN. /*Don't do anything inital value already set to unknown */
ELSE DO:
  FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth1:

     IF my_typ_unicode THEN /* check if initial has Unicode chars */
        esc-idx1 = INDEX(proc-text, "'(N''").

     IF esc-idx1 = 1 THEN DO:
         esc-idx1 = esc-idx1 + 5.
         esc-idx2 = R-INDEX(proc-text, "'')'").
         IF esc-idx1 > 0  AND esc-idx2 > esc-idx1 THEN 
                 l_init = SUBSTR(proc-text, esc-idx1, esc-idx2 - esc-idx1, "character").
     END. 
     ELSE /* non-Unicode case */
         ASSIGN l_init = proc-text. 

  END.
  CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
END.

IF l_init <> ? THEN DO:
  ASSIGN l_init = TRIM(l_init).
  /* OE00167581 - check default for date/time field */
  IF (ntyp = "DATE" OR ntyp = "DATETIME" OR ntyp = "DATETIME-TZ") AND 
      (INDEX(l_init,"GETDATE") = 0 AND INDEX(l_init,"SYSDATETIME") = 0) THEN
      ASSIGN l_init = ?. /* if not getdate/sysdatetime, we can't handle it */
  ELSE IF ntyp = "DATE" THEN 
      ASSIGN l_init = "TODAY".
  ELSE IF ntyp = "DATETIME" OR  ntyp = "DATETIME-TZ" THEN
      ASSIGN l_init = "NOW".
  /* OE00131234 - If a CHARACTER column in MSS database has a default of 
     NULL then l_init =  "'(NULL)'" */
  ELSE IF ntyp = "CHARACTER" AND l_init EQ "'(NULL)'" THEN
     ASSIGN l_init = ?.
  ELSE DO: 

      IF esc-idx1 = 0 THEN DO:
          /* if this is a function based default (in which case it won't contain
             parenthesis), we will not take it. We will
             assign the unknow value like we did in previous version 
          */
          IF INDEX(l_init, "(") > 0 THEN DO:
              IF ntyp = "character" AND SUBSTRING(l_init,2,1) = '~'' THEN 
                ASSIGN l_init = SUBSTRING(l_init, (INDEX(l_init, "(") + 3))
                       l_init = SUBSTRING(l_init, 1, (INDEX(l_init, ')') - 3)) .
              ELSE
                ASSIGN l_init = TRIM(TRIM(TRIM(TRIM(l_init,'~''),'('),')'),'~'').

              /* OE00186472 - don't allow the newid function */
              IF l_init BEGINS 'newid(' THEN
                 l_init = ?.
          END.
          ELSE
              ASSIGN l_init = ?.
      END.
  END.
END.

CREATE s_ttb_fld.

assign
  s_ttb_fld.pro_Desc    = fld-remark
  s_ttb_fld.pro_Extnt   = {&extent}
  s_ttb_fld.pro_name    = pnam
  s_ttb_fld.ttb_tbl     = RECID(s_ttb_tbl)
  s_ttb_fld.tmpfld_recid  = RECID(s_ttb_fld)
  s_ttb_fld.ds_prec    = DICTDBG.SQLColumns_buffer.Precision
  s_ttb_fld.ds_scale    = DICTDBG.SQLColumns_buffer.Scale
  s_ttb_fld.ds_lngth    = (IF DICTDBG.SQLColumns_buffer.LENGTH > DICTDBG.SQLColumns_buffer.PRECISION 
                              THEN DICTDBG.SQLColumns_buffer.Precision
                           ELSE DICTDBG.SQLColumns_buffer.LENGTH)
  s_ttb_fld.ds_radix    = DICTDBG.SQLColumns_buffer.Radix 
  s_ttb_fld.ds_msc23    = ( if (LENGTH(quote, "character") = 1)
                             then quote + fnam + quote
                             else ?
                          )
  s_ttb_fld.ds_msc24    = fld-properties
  s_ttb_fld.ds_stoff    = field-position
  s_ttb_fld.ds_name     = fnam
  s_ttb_fld.ds_type     = {&data-type}
  s_ttb_fld.pro_order   = field-position * 10 + 1000 
                              + {&order-offset}
 s_ttb_fld.pro_mand    = ( if CAN-DO(fld-properties, "N")
                                then false
                           else if (s_ttb_fld.ds_type = "ROWGUID") then
                                false
                           ELSE IF ((INDEX(DICTDBG.SQLColumns_buffer.Type-name,"identity") > 0) OR 
                                    (INDEX(DICTDBG.SQLColumns_buffer.Type-name,"timestamp") > 0)) THEN
                                FALSE
                           else (DICTDBG.SQLColumns_buffer.Nullable = 0)
                          ).

/* OE00165897
   When using the SQL Server Native driver, (MAX) columns are reported
   with precision and length as 0, and the regular data types (not the long type).
   The DataServer will set precision and length to 32000/16000 in this case,
   so we will do the same here.
*/
CASE {&data-type}:
    WHEN "VARBINARY" OR WHEN "VARCHAR" OR WHEN "NVARCHAR" THEN DO:
        IF s_ttb_fld.ds_lngth = 0  AND s_ttb_fld.ds_prec = 0 THEN DO:
           ASSIGN s_ttb_fld.ds_lngth = 32000
                  s_ttb_fld.ds_prec = (IF my_typ_unicode THEN 16000 ELSE 32000).
        END.
    END.
END CASE.

/* Check field to see if identity field and mark _field-Misc2[4] as "identity" */
 IF INDEX(DICTDBG.SQLColumns_buffer.Type-name,"identity") > 0 THEN
   ASSIGN s_ttb_fld.ds_msc24 = "identity"
          s_ttb_fld.ds_itype = 1.
 ELSE IF INDEX(DICTDBG.SQLColumns_buffer.Type-name,"timestamp") > 0 THEN
   ASSIGN s_ttb_fld.ds_msc24 = "timestamp".
 ELSE IF INDEX(DICTDBG.SQLColumns_buffer.Type-name,"datetime2") > 0 THEN
   ASSIGN s_ttb_fld.ds_msc24 = "datetime2".

 ELSE IF (INDEX(DICTDBG.SQLColumns_buffer.Type-name,"text")  > 0 OR 
          INDEX(DICTDBG.SQLColumns_buffer.Type-name,"image") > 0 OR
          INDEX(DICTDBG.SQLColumns_buffer.Type-name,"ntext") > 0 ) THEN
 DO:
 /* OE00218653
   SQLColumns ODBC API for SQL Server non-native drivers returns return "text"
   for varchar(max) and "image" for varbinary(max). Which makes it difficult to 
   distinguish between actual text and varchar(max) server types. So here check 
   the SS_DATA_TYPE returned by SQL Columns (for non-native driver) which is actual
   SQL Server data type and based on this set "ds_msc17" flag which will in turn
   set TEXTPTR_LOB_TYPES flag.
*/
     IF INDEX(DICTDB._Db._Db-misc2[4], "38") = 0 OR
        DICTDBG.SQLColumns_buffer.ss-data-type = 34 OR
        DICTDBG.SQLColumns_buffer.ss-data-type = 35 THEN
           ASSIGN s_ttb_fld.ds_msc17 = 1.
 END.
 ELSE IF isFileStream = '1' THEN
   ASSIGN s_ttb_fld.ds_msc24 = "filestream".


 IF s_ttb_Fld.ds_scale = ? THEN 
   ASSIGN s_ttb_Fld.ds_scale = 0.
   
 IF s_ttb_Fld.ds_radix = ? THEN 
   ASSIGN s_ttb_Fld.ds_radix = 0.
  
   
/*                                                             */
/* If the field is not updatable (fld-properties contains "N") */ 
/* then the field cannot be mandatory.                         */
/*                                                             */

{prodict/gate/gat_pul2.i
  &undo = "next"
  }

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/mss_pulp.i

Description:
    creates the _field-definitions out of the ODBC-definitions for
    stored procedures parameters.
    
Text-Parameters:
    &data-type      Foreign data-type in PROGRESS-Notation
                    usually DICTDBG.SQLProcCols_buffer.data-type
    &extent         in the range of 0 to n
    &order-offset   gets added to the _field._order
    
Included in:            
    prodict/mss/_mss_pul.p
    
History:
    D. McMann    03/31/00   abstracted from prodict/odb/odb_pulp.i
    sgarg        06/03/10   BLOB/CLOB support in Stored Proc
    musingh      07/01/11   Map varchar(n) to char, where 1<=n<=8000
    sgarg        03/07/12   Error handling for unsupported LOBs

--------------------------------------------------------------------*/

/* this code gets executed only for the first element of array-field   */
/* so extent-code of field is always ##1 (even with real extent >= 10) */

err_sp = "WARNING: You have used unsupported OUTPUT parameters in stored " +
         "procedure definition &1 that might result in run-time errors. " +
         "Please review your stored procedure definition or use error " +
         "handling in your application on the RUN STORED-PROCEDURE statement.".

assign
  pnam = TRIM(DICTDBG.SQLProcCols_buffer.Column-name)
  pnam = ( if {&extent} > 0 AND LENGTH (pnam, "character") > 4 /* Drop the "##1" */
             then SUBSTRING (pnam, 1, LENGTH (pnam, "character") - 3, "character")
             else pnam )
  fnam = pnam
  pnam = ( if s_ttb_tbl.ds_type = "PROCEDURE"
            and pnam begins "@"
            then substring(pnam,2,-1,"character")
            else pnam
         ).

RUN "prodict/gate/_gat_fnm.p" 
    ( INPUT        "FIELD",
      INPUT        RECID(s_ttb_tbl),
      INPUT-OUTPUT pnam).

if NOT SESSION:BATCH-MODE
 then DISPLAY
   TRIM(DICTDBG.SQLProcCols_buffer.Column-name) @ msg[3]
   pnam                                        @ msg[4]
   WITH FRAME ds_make.

assign
  dtyp    = LOOKUP({&data-type},user_env[12])
  l_init  = ?
  ntyp    = ( if dtyp = 0
                then "undefined"
                else ENTRY(dtyp,user_env[15])
            )
  l_dcml  = 0
  isOutput = ?.

  /* BLOB and CLOB can be handled together */
  IF LOOKUP({&data-type}, "VARBINARY,LONGVARBINARY,VARCHAR,LONGVARCHAR,NVARCHAR,NLONGVARCHAR") > 0 THEN DO:
     IF (ntyp = "BLOB" OR ntyp = "CLOB") AND 
         DICTDBG.SQLProcCols_buffer.PRECISION >= 1 AND 
         DICTDBG.SQLProcCols_buffer.PRECISION <= 8000 THEN DO:
         /* default mapping is blob or clob, but this is a varbinary(n) or varchar (n) in which 
            case we don't support the blob or clob mapping, so must change it to
            character (which is the next mapping).
         */
         dtyp = dtyp + 1.
         ntyp = ENTRY(dtyp,user_env[15]).    
     END.
  END.


/* OE00193877 - get 'is_output' value from sys.parameters catalog view. 
 * If BLOB or CLOB and output parameter, we want to mark _fld-misc17.
 * Get the output type for CHAR also, because the server LOB types can
 * also be pulled as CHAR and mapping can be changed to CLOB 
 * from field properties dialog.
 */

IF ntyp = "BLOB" OR ntyp = "CLOB" OR ntyp = "CHARACTER" THEN DO:
   IF LOOKUP({&data-type}, "LONGVARCHAR,LONGVARBINARY,NLONGVARCHAR") > 0 OR
      (LOOKUP({&data-type}, "VARCHAR,VARBINARY,NVARCHAR") > 0 AND 
       DICTDBG.SQLProcCols_buffer.Precision = 0  AND 
       DICTDBG.SQLProcCols_buffer.Length = 0) THEN DO:
      assign
      sqlstate = "SELECT is_output FROM sys.parameters where name =  '" + 
              DICTDBG.SQLProcCols_buffer.column-name + "' and object_id = (OBJECT_ID('" +
              DICTDBG.SQLProcCols_buffer.OWNER + "." + SUBSTRING(TRIM(DICTDBG.SQLProcCols_buffer.name),1,LENGTH(trim(namevar-1))) + "'))".
   
      RUN STORED-PROC DICTDBG.send-sql-statement dfth1 = PROC-HANDLE NO-ERROR ( sqlstate ).
   
      IF NOT ERROR-STATUS:ERROR THEN DO:
        FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth1:
         ASSIGN isOutput = proc-text. 
        END.
        CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
      END.
   END.
END.

  /* OE00203930: TEXT, IMAGE and NTEXT are not supported as Stored Procedure
   * output parameters. Could not find a way to put the error message 
   * concatenated using "+" operator  in err-msg array, so storing the
   * concatenated string in a variable and using that variable to write
   * the message in ds_upd.e, instead of call to error_handling.
   */
  IF NOT err_sp_flag AND LOOKUP({&data-type}, "LONGVARCHAR,LONGVARBINARY,NLONGVARCHAR") > 0 THEN DO:
     IF isOutput = "1" AND (ntyp = "CHARACTER" OR ntyp = "CLOB" or ntyp = "BLOB") THEN DO:
         IF (DICTDBG.SQLProcCols_buffer.type-name = "text" OR
             DICTDBG.SQLProcCols_buffer.type-name = "image" OR
             DICTDBG.SQLProcCols_buffer.type-name = "ntext") THEN DO:
               output stream s_stm_errors to ds_upd.e append.
               PUT stream s_stm_errors unformatted
                   SUBSTITUTE(err_sp, table_name)  skip.
               PUT STREAM s_stm_errors UNFORMATTED "" SKIP.
               output stream s_stm_errors close.

               /* Log the error message at procedure level, instead of 
                * parameter level.
                */ 
               assign err_sp_flag = TRUE.
         END.
     END.
  END.

CREATE s_ttb_fld.

assign
  s_ttb_fld.pro_Desc    = fld-remark
  s_ttb_fld.pro_Extnt   = {&extent}
  s_ttb_fld.pro_name    = pnam
  s_ttb_fld.ttb_tbl     = RECID(s_ttb_tbl)
  s_ttb_fld.ds_prec    = DICTDBG.SQLProcCols_buffer.Precision
  s_ttb_fld.ds_scale    = DICTDBG.SQLProcCols_buffer.Scale
  s_ttb_fld.ds_lngth    = DICTDBG.SQLProcCols_buffer.Length
  s_ttb_fld.ds_radix    = DICTDBG.SQLProcCols_buffer.Radix 
  s_ttb_fld.ds_msc17    = (if isOutput = '1' then INTEGER (isOutput)
                           else ?
                          )
  s_ttb_fld.ds_msc23    = ( if (LENGTH(quote, "character") = 1)
                             then quote + fnam + quote
                             else ?
                          )
  s_ttb_fld.ds_msc24    = fld-properties
  s_ttb_fld.ds_stoff    = field-position
  s_ttb_fld.ds_name     = fnam
  s_ttb_fld.ds_type     = {&data-type}
  s_ttb_fld.pro_order   = field-position * 10 + 1000 
                              + {&order-offset}
  s_ttb_fld.pro_mand    = ( if CAN-DO(fld-properties, "N")
                                then false
                                else (DICTDBG.SQLProcCols_buffer.Nullable = 0)
                          ).

  /* OE00235922 
    (Issue with CR# OE00165897 was also with stored procedure, hence put
    similar fix)
    
    When using the SQL Server Native driver, (MAX) columns are reported
    with precision and length as 0, and the regular data types (not the long type).
    The DataServer will set precision and length to 32000/16000 in this case,
    so we will do the same here.
   */
  CASE {&data-type}:
     WHEN "VARBINARY" OR WHEN "VARCHAR" OR WHEN "NVARCHAR" THEN DO:
        IF s_ttb_fld.ds_lngth = 0  AND s_ttb_fld.ds_prec = 0 THEN DO:
           ASSIGN s_ttb_fld.ds_lngth = 32000
                  s_ttb_fld.ds_prec = (IF my_typ_unicode THEN 16000 ELSE 32000).
        END.
    END.
  END CASE.

/*                                                             */
/* If the field is not updatable (fld-properties contains "N") */ 
/* then the field cannot be mandatory.                         */
/*                                                             */

{prodict/gate/gat_pul2.i
  &undo = "next"
  }

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Workaround for Q+E ODBC drivers - Create a comma seperated index comp list */

DEFINE INPUT-OUTPUT PARAM crnt AS CHAR.
DEFINE OUTPUT PARAM numcomp AS INT.

DEFINE VAR separ as int.
DEFINE VAR parrent AS int.
DEFINE VAR str-patt AS int.
DEFINE VAR ind AS int.
DEFINE VAR endlp AS logical.

IF crnt = ? THEN DO:
  numcomp = 0.
  RETURN.
END.

ind = 0.
endlp = no.
DO WHILE  NOT endlp AND crnt <> "":
  separ = INDEX(crnt, "+").
  ind = ind + 1.

  IF separ = 0 THEN DO:
    endlp = yes.
    NEXT. 
  END.
  SUBSTRING(crnt, separ, 1) = ",".

END.
numcomp = ind.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/mss_sys.i

Description:
    This string contains a comma-seperated list of the names of all
    system-objects for ODBC-based schemaholders, that are non-queryable.
    For example: Stored-Procedures, Buffers, ...
    This file gets used also from the report-builder -therefore it
    needs to be in a format that complies with C *and* PROGRESS
    
Text-Parameters:  
   none
                                     
--------------------------------------------------------------------*/
/*h-*/
"SQLTables,SQLTables_buffer,SQLColumns,SQLColumns_buffer,SQLStatistics,SQLStatistics_buffer,GetFieldIds,GetFieldIds_buffer,GetInfo,GetInfo_buffer,CloseAllProcs,SendInfo,PROC-TEXT-BUFFER,SEND-SQL-STATEMENT,SQLProcs_Buffer,SQLProcCols_Buffer,SQLSpecialColumns_buffer,SQLProcedures,SQLProcColumns,SQLSpecialColumns,_Constraint_Info"

/*------------------------------------------------------------------*/
/**************************************************************************
* Copyright (C) 2006,2009 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions             *
* contributed by participants of Possenet.                                *
*                                                                         *
**************************************************************************/

/* mss_typ.i - converts SQL data-type number to its datatype name */
/*
  {1} is  "DICTDBG.SQLColumns_buffer.data-type"
  
  History:  D. McMann removed n types
            fernando   04/14/06  Unicode support
            knavneet   03/16/09  datetime-tz support for MSS 
            sgarg      05/22/09  ROWGUID support for MSS
*/


IF      {1} =  1  THEN ASSIGN l_dt = "CHAR".
ELSE IF {1} =  2  THEN ASSIGN l_dt = "NUMERIC".
ELSE IF {1} =  3  THEN ASSIGN l_dt = "DECIMAL".
ELSE IF {1} =  4  THEN ASSIGN l_dt = "INTEGER".
ELSE IF {1} =  5   THEN ASSIGN l_dt = "SMALLINT".
ELSE IF {1} =  6  THEN ASSIGN l_dt = "FLOAT".
ELSE IF {1} =  7  THEN ASSIGN l_dt = "REAL".
ELSE IF {1} =  8  THEN ASSIGN l_dt = "DOUBLE".
ELSE IF {1} =  9  THEN ASSIGN l_dt = "DATE".
ELSE IF {1} =  10  THEN ASSIGN l_dt = "TIME".
ELSE IF {1} =  11  THEN ASSIGN l_dt = "TIMESTAMP".
ELSE IF {1} =  12  THEN ASSIGN l_dt = "VARCHAR".
ELSE IF {1} =  -1  THEN ASSIGN l_dt = "LONGVARCHAR".
ELSE IF {1} =  -2  THEN ASSIGN l_dt = "BINARY".
ELSE IF {1} =  -3  THEN ASSIGN l_dt = "VARBINARY".
ELSE IF {1} =  -4  THEN ASSIGN l_dt = "LONGVARBINARY".
ELSE IF {1} =  -5  THEN ASSIGN l_dt = "BIGINT".
ELSE IF {1} =  -6  THEN ASSIGN l_dt = "TINYINT".
ELSE IF {1} =  -7  THEN ASSIGN l_dt = "BIT".
ELSE IF {1} =  -8  THEN ASSIGN l_dt = "NCHAR".
ELSE IF {1} =  -9  THEN ASSIGN l_dt = "NVARCHAR".
ELSE IF {1} = -10  THEN ASSIGN l_dt = "NLONGVARCHAR".
ELSE IF {1} = -155 THEN ASSIGN l_dt = "TIMESTAMP-TZ".
ELSE IF {1} = -154 THEN ASSIGN l_dt = "TIME".
ELSE IF {1} = -11  THEN ASSIGN l_dt = "ROWGUID".
ELSE                    ASSIGN l_dt = "UNDEFINED".
/*********************************************************************
* Copyright (C) 2006,2008-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
    History:  D. McMann 03/03/99 Removed On-line from Informix
              D. McMann 02/01/00 Added sqlwidth variable
              D. McMann 06/18/01 Added case and collation variables
              fernando  04/14/06 Unicode support
              fernando  04/11/08 Support for new seq generator
              fernando  03/20/09 Support for datetime-tz
              Nagaraju  09/22/09 Support for Computed Columns
*/    

DEFINE {1} SHARED VARIABLE pro_dbname     AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE pro_conparms   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE osh_dbname     AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_dbname     AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_pdbname    AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_username   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_password   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_codepage   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_collname   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_incasesen  AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE mss_conparms   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE long-length    AS INTEGER   NO-UNDO.
DEFINE {1} SHARED VARIABLE movedata       AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE pcompatible    AS LOGICAL   NO-UNDO  INITIAL TRUE.
DEFINE {1} SHARED VARIABLE sqlwidth       AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE loadsql        AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE genrep         AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE rmvobj         AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE shadowcol      AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE descidx        AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE dflt           AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE iFmtOption     AS INTEGER   NO-UNDO
                                                    INITIAL 2.
DEFINE {1} SHARED VARIABLE lFormat        AS LOGICAL   NO-UNDO
                                                    INITIAL TRUE.
DEFINE {1} SHARED VARIABLE iRecidOption   AS INTEGER   NO-UNDO
                                                    INITIAL 2.
DEFINE {1} SHARED VARIABLE unicodeTypes   AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE lUniExpand     AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE newseq         AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE {1} SHARED VARIABLE mapMSSDatetime AS LOGICAL   NO-UNDO INITIAL TRUE.

DEFINE {1} SHARED STREAM dbg_stream.

DEFINE {1} SHARED VARIABLE stages 		    AS LOGICAL EXTENT 7 NO-UNDO.
DEFINE {1} SHARED VARIABLE stages_complete 	AS LOGICAL EXTENT 7 NO-UNDO.

/* OE00195067 BEGIN : New variable defnition for child migration frame */
DEFINE button s_btn_Advanced SIZE 24 by 1.125.
DEFINE {1} SHARED VARIABLE choiceUniquness     AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE choiceDefault       AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE migConstraint       AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE choiceRowid         AS INTEGER NO-UNDO INITIAL 1.
DEFINE {1} SHARED VARIABLE choiceSchema        AS INTEGER NO-UNDO.
DEFINE {1} SHARED VARIABLE recidCompat         AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE forRowidUniq        AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE ForRow	           AS LOGICAL NO-UNDO INITIAL TRUE.
DEFINE {1} SHARED VARIABLE selBestRowidIdx     AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE tryPimaryForRowid   AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE shdcol              AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE lExpand             AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE recid_verify        AS LOGICAL NO-UNDO.

/* OE00195067 END */

/*
 * Constants describing stage we are at.
 */ 
define {1} shared variable mss_create_sql	  as integer   initial 1.
define {1} shared variable mss_dump_data   	  as integer   initial 2.
define {1} shared variable mss_create_sh 	  as integer   initial 3. 
define {1} shared variable mss_create_objects as integer   initial 4.
define {1} shared variable mss_build_schema	  as integer   initial 5.
define {1} shared variable mss_fixup_schema	  as integer   initial 6.
define {1} shared variable mss_load_data	  as integer   initial 7. 
define {1} shared variable s_file-sel         as character initial "*". 
     

DEFINE {1} SHARED VARIABLE osh_conparms     AS CHARACTER NO-UNDO.
/*********************************************************************
* Copyright (C) 2006-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Procedure prodict/mss/protoms1.p

       user_env[5] = statement terminator
       user_env[10] = Maximum length of varchar
       user_env[11..18] = a string of how to convert PROGRESS datatypes:
               [11] = character  -> varchar, long varchar, text, memo, Sql_Varchar, Sql_Longvar
               [12] = date       -> date, datetime, Sql_Date
               [13] = logical    -> logical, bit
               [14] = integer    -> smallint, logical, tinyint, Sql_bit 
               [15] = decimal    -> money, decimal, currency, Sql_decimal
               [16] = decimal*   -> decimal, integer, number
               [17] = recid      -> recid, rowid
               [18] = char**     -> long varchar, memo, Sql_Longvar
               [19] = logical*** -> logical, tinyint              
       user_env[20] = character to use for unique name creation
       user_env[21] = create shawdow columns
       user_env[25] = create sequences,new sequence generator
       user_env[30] = write exit at end of SQL.
       user_env[33] = Use _Field._Width for size of field.
       user_env[34] = Create descending indices
      
       * = When the datatype is decimals and no decimals are present
      ** = Name of character field when max for regular char is exceeded
     *** = Logical fields which are key componets

   Created: 03/31/00 Used prodict/odb/protood1.p as model D. McMann
   History: 08/18/00 Incresed size of identifier max length
            08/29/00 Changed to alert-box for tty end message DLM
            10/25/05 Fixed X8OVERRIDE functionality 20051018-006. 
            04/14/06 Unicode support
            07/19/06 Unicode support - support only MSS 2005
            08/24/06 Add warning about non utf-8 codepage and unicode columns - 20060802-024
            03/21/07 Unicode requirements for schema holder database - added for CR#OE00147991
            04/11/08 Support for new seq generator
            02/12/09 Fix output for batch log file
            09/22/09 Computed column implementation - Nagaraju
            11/12/09 Remove numbers for radio-set options in MSSDS - Nagaraju
            06/21/11 Added screen variable for constraint migration - kmayur
            04/03/12 Fixed issue with DLC not getting set- rkumar 
*/    

&SCOPED-DEFINE UNICODE-MSG-1 "You have chosen to use Unicode data types but the DataServer schema codepage is not 'utf-8'"
&SCOPED-DEFINE UNICODE-MSG-2 "It is recommended that you set the codepage to utf-8 in this case to avoid data loss!"
&SCOPED-DEFINE UNICODE-MSG-3 "You have chosen to use Unicode data types but the schema holder database codepage is not 'utf-8'"
&SCOPED-DEFINE UNICODE-MSG-4 "You must build your schema holder database with a 'utf-8' code page"

{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i }

DEFINE VARIABLE cmd           AS CHARACTER           NO-UNDO.
DEFINE VARIABLE wait          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE create_h      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE db_exist      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO  NO-UNDO. 
DEFINE VARIABLE output_file   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE l_i           AS INTEGER             NO-UNDO.
DEFINE VARIABLE run_time      AS INTEGER             NO-UNDO.
DEFINE VARIABLE schname       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dlc_utf_edb   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE schdbcp       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE ClustAsROWID  AS LOGICAL             NO-UNDO INITIAL TRUE.
DEFINE VARIABLE mdrec_db      AS RECID               NO-UNDO.    
DEFINE VARIABLE lcompatible   AS LOGICAL             NO-UNDO.
DEFINE VARIABLE useLegacyRanking    AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE RankDesc      AS CHARACTER           NO-UNDO.

DEFINE STREAM strm.

/* PROCEDURE: prgs-ranking
 */
PROCEDURE prgs-ranking:

FIND FIRST DICTDB._Db WHERE _Db-local NO-LOCK.
ASSIGN mdrec_db      = RECID(DICTDB._Db).

/* Logic to decide whether to use legacy or new ranking logic */
if  user_env[27] = ?  OR user_env[27] = ""
  THEN ASSIGN lcompatible = true.
else if num-entries(user_env[27]) > 1
     then assign  /* more than one value in user_env[27] */
           lcompatible = ( entry(1,user_env[27]) BEGINS "y"
              or entry(1,user_env[27]) = ""
              ).
     else assign
            lcompatible = (user_env[27] BEGINS "y"). /* create recid fields/indexes */
IF (ENTRY(1,user_env[36]) = "y") OR (ENTRY(2,user_env[36]) = "y")  OR        
   (lcompatible AND ((NUM-ENTRIES(user_env[27]) >= 3) AND  /* U = For ROWID uniqueness, P = Prime ROWID */
                    ((ENTRY(3,user_env[27]) EQ "U") OR (ENTRY(3,user_env[27]) EQ "P")))
   )  
THEN  ASSIGN useLegacyRanking = FALSE.

ASSIGN user_env[42] = (IF genrep THEN "Y" ELSE "N") +   /* Generate ranking report */
                      (IF useLegacyRanking THEN ',L' ELSE ',N').

FOR EACH DICTDB._File  WHERE DICTDB._File._Db-recid = mdrec_db
                       AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                       AND (IF user_env[1] = "ALL"  THEN
                            NOT DICTDB._File._Hidden AND
                           (CAN-DO(_File._Can-read, user_env[9]) OR user_env[9] = "ALL")
                             ELSE
                               DICTDB._File._File-name = user_filename
                            ):
    Assign RankDesc = "".
    IF useLegacyRanking AND lcompatible THEN
       ASSIGN DICTDB._FILE._Fil-misc1[1] = 1. /* assign positive to indicate PROGRESS_RECID as ROWID */
    ELSE 
       RUN prodict/mss/_rankpdb.p ( INPUT RECID(DICTDB._File),
                               INPUT ClustAsROWID, INPUT RankDesc).
END.
IF ((NUM-ENTRIES(user_env[42]) >= 2) AND 
    UPPER(ENTRY(1,user_env[42])) = "Y" ) THEN
 RUN prodict/mss/_ctestr.p(INPUT "rnkreppdb.out",INPUT RankDesc).

END PROCEDURE.

/*------------------------------------------------------------------*/

assign batch_mode    = SESSION:BATCH-MODE
       run_time      = TIME.

IF batch_mode THEN DO:
   PUT STREAM logfile UNFORMATTED
       " " skip
       "{&PRO_DISPLAY_NAME} to MSS Log" skip(2)
       "Original {&PRO_DISPLAY_NAME} Database:            " pro_dbname skip
       "Other {&PRO_DISPLAY_NAME} DB Connect Parameters : " pro_conparms  skip
       "Logical Database Name:                 " mss_pdbname SKIP
       "ODBC Data Source Name:                 " mss_dbname SKIP
       "{&PRO_DISPLAY_NAME} Schema Holder Name:           " osh_dbname skip
       "MSS Username:                         " mss_username skip
       "Maximum Varchar Length:               " long-length SKIP       
       "Codepage for Schema Image:            " mss_codepage SKIP
       "Collation Name:                       " mss_collname SKIP    
       "Insensitive:                          " mss_incasesen SKIP   
       "Create RECID Field :                  " pcompatible skip
       "Create RECID using             :      " (IF iRecidOption = 2 THEN
                                                    "Computed Column"
                                                 ELSE  "Trigger")
                                                  SKIP

       "Field Width Calculation Based on:      " (IF iFmtOption = 1 THEN
                                                    "_Field._Width field"
                                                  ELSE IF (lFormat = FALSE) THEN
                                                    "Calculation"
                                                  ELSE "_Field._Format field")
                                                  SKIP
       "Create Objects in MSS:                " loadsql skip
       "Moved Data to MSS:                    " movedata SKIP
       "Create Shadow Columns:                " shadowcol SKIP       
       "Include Defaults:                     " dflt SKIP       
       "Use Revised Sequence Generator:       " newseq SKIP
       "Map to MSS Datetime Type:             " mapMSSDatetime SKIP.

        IF OS-GETENV("UNICODETYPES") NE ? THEN
            PUT STREAM logfile UNFORMATTED
                  "Unicode Types:                        " unicodeTypes skip
                  "Expand Width (utf-8):                 " lUniExpand skip(2).
END.

IF loadsql THEN DO:
  ASSIGN stages[mss_create_sql] = TRUE
         stages[mss_build_schema] = TRUE
         stages[mss_fixup_schema] = TRUE
         stages[mss_create_objects] = TRUE.
  
  IF not batch_mode THEN
     HIDE MESSAGE NO-PAUSE.
  ASSIGN schname = osh_dbname + ".db".
  IF search (schname) <> ? THEN do:
    connect VALUE(osh_dbname) -1 no-error.
    if ERROR-STATUS:ERROR then do:
      IF not batch_mode THEN DO:
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            MESSAGE "Can't connect to Database " osh_dbname.
        &ELSE
            MESSAGE "Can't connect to Database " osh_dbname
              VIEW-AS ALERT-BOX ERROR.
        &ENDIF.
      END.      
      ELSE 
          PUT STREAM logfile UNFORMATTED 
               "Can't connect to Database " osh_dbname skip(2).
      UNDO, RETURN error.
    end.
  end.

  IF CONNECTED (osh_dbname) THEN DO:

    /* Get the physical schema holder database codepage */
    REPEAT l_i = 1 TO NUM-DBS:

      IF LDBNAME(l_i) = osh_dbname THEN
          schdbcp = UPPER(TRIM(DBCODEPAGE(l_i))).
    END. 

    ASSIGN rmvobj   = FALSE
           create_h = FALSE
           stages[mss_create_sh] = FALSE.
           
    CREATE ALIAS DICTDB2 FOR DATABASE value(osh_dbname).
    ASSIGN db_exist = FALSE.
    RUN "prodict/misc/_tstsh.p" (INPUT mss_pdbname, OUTPUT db_exist).
    IF db_exist THEN DO:
      IF not batch_mode THEN DO:
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           MESSAGE "Logical Database name " mss_pdbname " already exists in schema holder " 
                  osh_dbname.
        &ELSE 
           MESSAGE "Logical Database name " mss_pdbname " already exists in schema holder " 
      	               osh_dbname VIEW-AS ALERT-BOX ERROR.
        &ENDIF
      END. 	                  	           
      ELSE 
         PUT STREAM logfile UNFORMATTED 
            "Logical Database name " mss_pdbname " already exists in schema holder " 
            osh_dbname skip(2).
      DISCONNECT VALUE(osh_dbname).
      UNDO, RETURN "indb".
    END. 
    DISCONNECT VALUE (osh_dbname).
    
  END. 
  ELSE
    ASSIGN create_h = TRUE
           rmvobj   = TRUE.
           
  IF mss_dbname = pro_dbname OR mss_pdbname = osh_dbname THEN DO:
    IF batch_mode THEN 
       PUT STREAM logfile UNFORMATTED 
               "Logical Database Name " mss_pdbname 
               " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name"
                skip(2).
    ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           MESSAGE "Logical Database Name " mss_pdbname 
             " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name".
      &ELSE
           MESSAGE "Logical Database name " mss_pdbname 
             " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name"
             VIEW-AS ALERT-BOX ERROR.
      &ENDIF
    END.             
    UNDO, RETURN error.
  END.
END.

ASSIGN user_dbname  = mss_dbname
     /*  mss_pdbname  = mss_dbname */
       user_env[1]  = "ALL"
       user_env[2]  = osh_dbname
       user_env[3]  = ""
       user_env[4]  = "n"
       user_env[5]  = "go"
       user_env[6]  = "y"
       user_env[7]  = (IF dflt THEN "y" ELSE "n")
       user_env[8]  = "y"
       user_env[9]  = "ALL"
       user_env[10] = string(long-length)
       user_env[11] = (IF unicodeTypes THEN "nvarchar" ELSE "varchar" )
       user_env[12] = (IF mapMSSDatetime THEN "datetime" ELSE "date")
       user_env[13] = "tinyint"
       user_env[14] = "integer"
       user_env[15] = "decimal(18,5)"
       user_env[16] = "decimal"
       user_env[17] = "integer"
       user_env[18] = (IF unicodeTypes THEN "nvarchar(max)" ELSE "text")
       user_env[19] = "tinyint"
       user_env[20] = "##"  
       user_env[21] = (IF shadowcol THEN "y" ELSE "n")
       user_env[22] = "MSS"
       user_env[23] = "30"
       user_env[24] = "15"
       /* first y is for sequence support.
          second entry is for new sequence generator 
          third entry is for use newer datatime types 
       */
       user_env[25] = "y" + (IF newseq THEN ",y" ELSE ",n") + 
                      (IF mapMSSDatetime THEN ',n' ELSE ',y')
       user_env[26] = mss_username
       user_env[28] = "128"
       user_env[29] = "128"            
       user_env[30] = "y"
       user_env[31] = "-- ** "
       user_env[32] = "MSSQLSRV7".
       user_env[37] = "PP". /* PP - Pull as part of Push *
                             * IP - Independent PULL operation */
       user_env[38] = choiceUniquness . /* 195067 */
       user_env[39] = choiceDefault . /* 195067 */       
       /* user_env[42] = (IF genrep THEN "y" ELSE "n") . * Generate ranking report */       


IF pcompatible THEN 
   ASSIGN user_env[27] = "y" + "," + STRING(iRecidOption) +
         (IF forRowidUniq THEN ',U' ELSE IF choiceRowid = 1 THEN ',D' ELSE ',P').
/* D -> Default functionality "ROWID" ,P -> Prime ROWID ,U -> ROWID uniqueness */
ELSE
   ASSIGN user_env[27] = "no".

IF (iFmtOption = 1) THEN 
  ASSIGN user_env[33] = "y".
ELSE IF (lFormat = FALSE) THEN
  ASSIGN user_env[33] = "n".
ELSE
  ASSIGN user_env[33] = "?".

IF descidx THEN 
   ASSIGN user_env[34] = "y".
ELSE
   ASSIGN user_env[34] = "n".
        
IF lUniExpand THEN 
   ASSIGN user_env[35] = "y".
ELSE
   ASSIGN user_env[35] = "n".

 /* first y is for Migrate Constraints.
   second entry is Try Primary for ROWID.
   third entry is RECID compatibility.
   fourth entry is Select 'BEST' ROWID index.
 */
ASSIGN user_env[36] = (IF migConstraint THEN "y" ELSE "n") +
               (IF tryPimaryForRowid THEN ",y" ELSE ",n") +
               (IF recidCompat THEN ",y" ELSE ",n"). 
IF selBestRowidIdx THEN 
    ASSIGN user_env[36] = user_env[36] + ",y" + "," + STRING(choiceSchema).
ELSE ASSIGN user_env[36] = user_env[36] + ",n".
IF movedata THEN ASSIGN user_env[36] = user_env[36] + ",y".
            ELSE ASSIGN user_env[36] = user_env[36] + ",n".

RUN prgs-ranking. 
IF movedata THEN
  ASSIGN stages[mss_dump_data] = TRUE
         stages[mss_load_data] = TRUE.

    /* md0: creates SQL */
RUN "prodict/mss/_mss_md0.p".

/*
IF not stages[mss_create_sh] THEN LEAVE.
*/
IF loadsql THEN DO:

  /* check if unicode types and non utf-8 codepage and give warning */
  IF unicodeTypes AND TRIM(mss_codepage) NE "utf-8" THEN DO:
     IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED {&UNICODE-MSG-1} SKIP {&UNICODE-MSG-2} SKIP.
     ELSE
        MESSAGE {&UNICODE-MSG-1} SKIP {&UNICODE-MSG-2} VIEW-AS ALERT-BOX INFO BUTTONS OK.
  END.


  IF create_h THEN DO:
    IF batch_mode THEN DO:
      PUT STREAM logfile UNFORMATTED
              " " skip
              "-- ++ " skip
              "-- Creating empty schema holder " skip
              "-- -- " skip(2).
    END.

    IF unicodeTypes OR TRIM(mss_codepage) = "utf-8" THEN DO:
        if OPSYS = "Win32":U then 
           GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE dlc_utf_edb. 
        if (dlc_utf_edb = ? or dlc_utf_edb EQ "") then
           dlc_utf_edb = OS-GETENV("DLC").
        dlc_utf_edb = dlc_utf_edb + "/prolang/utf/empty".
        CREATE DATABASE osh_dbname FROM dlc_utf_edb. 
    END.
    ELSE
        CREATE DATABASE osh_dbname FROM "EMPTY".
  END.
  ELSE DO:
    IF unicodeTypes THEN DO:
      IF ( schdbcp <> "UTF-8" ) THEN DO:
        IF batch_mode THEN
          PUT STREAM logfile UNFORMATTED {&UNICODE-MSG-3} SKIP {&UNICODE-MSG-4} SKIP.
        ELSE
          MESSAGE {&UNICODE-MSG-3} SKIP {&UNICODE-MSG-4} VIEW-AS ALERT-BOX INFO BUTTONS OK.
        UNDO, RETURN "undo".
      END.
    END.
  END.  

  IF NOT batch_mode THEN
    HIDE FRAME table-wait NO-PAUSE.
  
  ASSIGN stages_complete[mss_create_sh] = TRUE
         stages[mss_create_objects]     = TRUE.
    
  /* md1: creates SI and MSS-Schema using send-sql.p
   *      pulls schema into SI
   *      beautifies SI by comparing it and matching it up with 
   *            the original progress-db
   */

  /* consider for computed columns */
  IF pcompatible AND iRecidOption = 2 THEN
     ASSIGN user_env[32] = "MSSQLSRV9" .

  /* let's set the mss version based on unicodeTypes so _mss_md1 checks the correct version
     for Unicode data types. Do the same for 2008 types (that also checks the driver).
  */
  IF mapMSSDatetime THEN
     ASSIGN user_env[32] = (IF unicodeTypes THEN "MSSQLSRV9" ELSE "MSSQLSRV7").
  ELSE
     ASSIGN user_env[32] = "MSSQLSRV10".

  RUN "prodict/mss/_mss_md1.p".

  IF RETURN-VALUE = "wrg-ver" THEN
    RETURN "wrg-ver".
  
  ELSE IF RETURN-VALUE = "undo" THEN
    RETURN "undo".

  IF batch_mode and NOT logfile_open THEN DO:
    OUTPUT TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
    logfile_open = true.
  END.

  /* See if we were successful. */

  IF NOT CONNECTED (mss_pdbname) THEN DO:
    cmd = "Error creating MSS Database - Check logfile " + osh_dbname + 
      	  ".log".
    IF NOT Batch_mode THEN
      MESSAGE cmd.
    ELSE
      PUT STREAM logfile UNFORMATTED  cmd.  
    UNDO, RETURN error.
  END.

  ASSIGN cmd = "c" + mss_pdbname + ".p".

  OUTPUT STREAM strm TO VALUE (cmd) NO-MAP.

  PUT STREAM strm UNFORMATTED "CONNECT " osh_dbname " -1." SKIP.

  IF mss_conparms <> ? THEN DO:
    IF INDEX(mss_conparms,"@") <> 0 THEN 
         mss_username = mss_username + mss_conparms. 
  END. 
  
  IF mss_username = "" or mss_username = ? THEN
     PUT STREAM strm UNFORMATTED " CONNECT " mss_dbname " -ld " mss_pdbname
        " -dt MSS" .
  ELSE IF mss_password = "" or mss_password = ? THEN
     PUT STREAM strm UNFORMATTED "CONNECT " mss_dbname " -ld ~"" mss_pdbname
        "~" -dt MSS -U ~"" mss_username "~"".
  ELSE 
     PUT STREAM strm UNFORMATTED "CONNECT " mss_dbname " -ld ~"" mss_pdbname
        "~" -dt MSS -U ~"" mss_username "~" -P ~"" mss_password "~"".
 
  IF mss_conparms <> ? THEN DO:
    IF INDEX(mss_conparms,"@") = 0 THEN 
         PUT STREAM strm UNFORMATTED " " mss_conparms.
  END.

  PUT STREAM strm UNFORMATTED "." SKIP.

  OUTPUT STREAM strm CLOSE.

  IF movedata THEN 
  _mvdt:
  DO:
    IF NOT CONNECTED(mss_pdbname) THEN DO:
      IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED
          "Database" mss_dbname " not connected.  Unable to load data."  SKIP.
       ELSE
         MESSAGE "Database" mss_dbname " NOT connected.  Unable to load data." SKIP
           VIEW-AS ALERT-BOX.
       LEAVE _mvdt.    
    END.        
    IF batch_mode THEN
       PUT STREAM logfile UNFORMATTED
           "-- ++ " skip
           "-- Loading data into the MSS database. " skip
           "-- -- " skip(2).
    ELSE
      DISPLAY  " " SKIP 
               "   Loading data into the MSS Database.  " SKIP(2)
        WITH FRAME ld-dt NO-LABELS THREE-D CENTERED ROW 5 
          TITLE "Moving Data".
    RUN "prodict/mss/_mss_md9.p".

    DISCONNECT VALUE (osh_dbname).
  END.  
end.
IF NOT batch_mode and loadsql THEN 
      MESSAGE "Run pro -p " cmd " to connect to new MSS database."
            VIEW-AS ALERT-BOX INFORMATION.
  
ELSE IF batch_mode THEN DO:

   IF NOT logfile_open THEN DO:
      OUTPUT STREAM logfile TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
      logfile_open = true.
   END.

   PUT STREAM logfile UNFORMATTED
       " "           skip
       "-- ++ "      skip
       "-- ProToMSS Complete in " STRING(TIME - run_time,"HH:MM:SS")  skip
       "-- -- "      skip(2).
   if loadsql then
       PUT STREAM logfile UNFORMATTED
          " "                                   skip 
          "Run pro -p " cmd
          " to connect to new MSS database." skip.
END.

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2006-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Created:  D. McMann 03/28/00 PROTOMSSQL Utiity to migrate a Progress
                                database via ODBC to  MS SQL Server 7 
             D. McMann 04/12/00 Added long path name for Progress Database
             D. McMann 06/07/00 Changed frame layout for UNIX
             D. McMann 07/19/00 Added specific help topic for MSS
             D. McMann 06/18/01 Added case and collation options
             D. McMann 09/18/02 Changed label for _Width
             D. McMann 10/23/02 Changed BLANK to PASSWORD-FIELD
             D. McMann 12/30/02 Removed DESC Index since they are now
                                supported in MS SQL Server
             fernando  04/14/06 Unicode support
             fernando  07/19/06 Unicode support - restrict UI
             moloney   03/21/07 Unicode requirements for schema holder database - added to CR#OE00147991
             fernando  08/10/07 Removed UI restriction for Unicode support
             fernando  04/11/08 New sequence generator support
             fernando  02/12/09 Adding var SHADOWCOL/CRTDEFAULT for batch mode
             fernando  03/20/09 Support for 2008 datetime types
             Nagaraju  09/18/09 Support for Computed columns
             Nagaraju  11/12/09 Remove numbers for radio-set options in MSSDS
             sgarg     07/12/10 Disallow ? as case-insesitive entry (OE00198732)
             kmayur    06/21/11 screen chnages for constraint migration - OE00195067
*/            


{ prodict/user/uservar.i NEW }
{ prodict/mss/mssvar.i NEW }

DEFINE VARIABLE cmd           AS CHARACTER                NO-UNDO.
DEFINE VARIABLE wait          AS CHARACTER                NO-UNDO.
DEFINE VARIABLE create_h      AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE db_exist      AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.
DEFINE VARIABLE old-dictdb    AS CHARACTER                NO-UNDO.  
DEFINE VARIABLE output_file   AS CHARACTER                NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER                NO-UNDO.
DEFINE VARIABLE tmp_str1      AS CHARACTER                NO-UNDO.
DEFINE VARIABLE run_time      AS INTEGER                  NO-UNDO.
DEFINE VARIABLE i             AS INTEGER                  NO-UNDO.
DEFINE VARIABLE err-rtn       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE redo          AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE wrg-ver       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE s_res         AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE redoblk       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE mvdta         AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE cFormat       AS CHARACTER INITIAL "For field widths use:"
                                           FORMAT "x(21)" NO-UNDO.
DEFINE VARIABLE cRecid        AS CHARACTER INITIAL "For Create RECID use:"
                                           FORMAT "x(22)" NO-UNDO.

DEFINE STREAM   strm.

batch_mode = SESSION:BATCH-MODE.

FORM
  pro_dbname   FORMAT "x({&PATH_WIDG})"  view-as fill-in size 32 by 1 
    LABEL "Original {&PRO_DISPLAY_NAME} Database" colon 36 SKIP({&VM_WID}) 
  pro_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
    LABEL "Connect Parameters for {&PRO_DISPLAY_NAME}" colon 36 SKIP({&VM_WID})
  osh_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Name of Schema Holder Database" colon 36 SKIP({&VM_WID})
  mss_pdbname  FORMAT "x(32)" VIEW-AS FILL-IN SIZE 32 BY 1
    LABEL "Logical Database Name" COLON 36 SKIP({&VM_WID}) 
  mss_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "ODBC Data Source Name" colon 36 SKIP({&VM_WID})
  mss_username FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Username" colon 36 SKIP({&VM_WID})
  mss_password FORMAT "x(32)"  PASSWORD-FIELD
        view-as fill-in size 32 by 1 
        LABEL "User's Password" colon 36 SKIP({&VM_WID})
  mss_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
     LABEL "Connect Parameters" colon 36 SKIP({&VM_WID})
      long-length LABEL " Maximum Varchar Length"  COLON 36 SKIP({&VM_WID})
  mss_codepage FORMAT "x(32)"  view-as fill-in size 15 by 1
     LABEL "Codepage"  COLON 36 SKIP({&VM_WID}) 
  mss_collname FORMAT "x(32)"  view-as fill-in size 15 by 1
  LABEL "Collation"  COLON 36 SKIP({&VM_WID})  
  mss_incasesen  LABEL "Insensitive" COLON 36 SKIP({&VM_WID})
  loadsql   view-as toggle-box label "Load SQL" AT 5 
  genrep    view-as toggle-box label "Generate Rank Report" AT 38 SKIP({&VM_WID})
  movedata  view-as toggle-box label "Move Data" AT 5 
  s_btn_Advanced label "Advanced..." AT 50 SKIP({&VM_WID})

        {prodict/user/userbtns.i}
  WITH FRAME x ROW 1 CENTERED SIDE-labels OVERLAY
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF
  TITLE "{&PRO_DISPLAY_NAME} DB to MS SQL Server Conversion".

FORM
  wait FORMAT "x" LABEL
  "Creating tables - Please wait"
  WITH FRAME table-wait ROW SCREEN-LINES - 2 COLUMN 1 NO-BOX OVERLAY
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF.

    /* PROCEDURES */
PROCEDURE cleanup:  
  IF NUM-DBS > 1 THEN DO:   
    IF rmvobj THEN DO:
        DISCONNECT VALUE(osh_dbname).
        RUN prodict/misc/_clproto.p (INPUT osh_dbname, INPUT pro_dbname).
    END.
    ELSE DO:       
      CREATE ALIAS DICTDB FOR DATABASE VALUE(osh_dbname).
      RUN prodict/misc/_del-db.p (INPUT mss_dbname, INPUT osh_dbname, 
                                  INPUT pro_dbname).       
    END.
  END.
END PROCEDURE.

PROCEDURE fill_long_length:

 IF long-length = 8000 THEN
     ASSIGN long-length:SCREEN-VALUE IN FRAME x = "8000"
            mss_codepage = session:cpinternal
            mss_codepage:SCREEN-VALUE IN FRAME x= session:cpinternal.
            
 ELSE
     ASSIGN long-length:SCREEN-VALUE IN FRAME x = "4000"
            mss_codepage = "utf-8"
            mss_codepage:SCREEN-VALUE IN FRAME x = "utf-8".
            
END PROCEDURE.

ON WINDOW-CLOSE of FRAME x
   APPLY "END-ERROR" to FRAME x.
   
ON VALUE-CHANGED of loadsql IN FRAME x DO:
  IF SELF:screen-value = "yes" THEN 
     movedata:sensitive in frame x = YES.
  ELSE DO:
     movedata:screen-value in frame x = "no".
     movedata = false.
     movedata:sensitive in frame x = NO.
  END.   
END. 

ON VALUE-CHANGED of mss_incasesen IN FRAME x DO:
  IF SELF:screen-value = "no" THEN DO:
    ASSIGN  
           shdcol = TRUE.
    END.       
  ELSE DO:
     ASSIGN 
           shdcol =FALSE.
  END.           
END.

ON ANY-PRINTABLE OF mss_incasesen IN FRAME x 
DO:
    /* Disallow ? KEY EVENT in case-insensitive entry box during migration */
    IF LAST-EVENT:LABEL = "?" THEN
    DO: 
        BELL. 
        RETURN NO-APPLY.  
    END.
END.

ON LEAVE OF long-length IN FRAME X DO:
   IF unicodeTypes = FALSE AND INTEGER(long-length:SCREEN-VALUE IN FRAME x) > 8000 THEN DO:  
    MESSAGE "The maximun length for a varchar is 8000" VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.
  ELSE IF unicodeTypes = TRUE AND INTEGER(long-length:SCREEN-VALUE IN FRAME x) > 4000 THEN DO: 
    MESSAGE "The maximun length for a nvarchar is 4000" VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.

END.

&IF "{&WINDOW-SYSTEM}"<> "TTY" &THEN   
/*----- HELP in PROGRESS DB to MS SQL Server 7 Database -----*/
on CHOOSE of btn_Help in frame x
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&PROGRESS_DB_to_SQL_Dlg_Box},
                             INPUT ?).
&ENDIF

IF LDBNAME ("DICTDB") <> ? THEN
  ASSIGN pro_dbname = LDBNAME ("DICTDB").

IF NOT batch_mode THEN DO:
   {adecomm/okrun.i  
       &FRAME  = "FRAME x" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
   }
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME x = yes.
   &ENDIF
END.

/* initialize variables */
ASSIGN pcompatible = YES
       run_time = TIME
       iRecidOption = 1.

IF OS-GETENV("PRODBNAME")   <> ? THEN
  pro_dbname   = OS-GETENV("PRODBNAME").
 
IF OS-GETENV("PROCONPARMS")   <> ? THEN
  pro_conparms = OS-GETENV("PROCONPARMS").
IF OS-GETENV("SHDBNAME")    <> ? THEN
  osh_dbname   = OS-GETENV("SHDBNAME").
IF OS-GETENV("MSSDBNAME")   <> ? THEN
  mss_dbname   = OS-GETENV("MSSDBNAME"). 
IF OS-GETENV("MSSPDBNAME")   <> ? THEN
  mss_pdbname   = OS-GETENV("MSSPDBNAME").  
IF OS-GETENV("MSSUSERNAME") <> ? THEN
  mss_username = OS-GETENV("MSSUSERNAME").
IF OS-GETENV("MSSPASSWORD") <> ? THEN
  mss_password = OS-GETENV("MSSPASSWORD").
IF OS-GETENV("MSSCONPARMS") <> ? THEN
  mss_conparms = OS-GETENV("MSSCONPARMS").

IF OS-GETENV("MSSCODEPAGE") <> ? THEN
  mss_codepage = OS-GETENV("MSSCODEPAGE").
ELSE
  ASSIGN mss_codepage = session:cpinternal.

IF OS-GETENV("MSSCOLLNAME") <> ? THEN
  mss_collname = OS-GETENV("MSSCOLLNAME").
ELSE
  ASSIGN mss_collname = session:CPCOLL.

IF OS-GETENV("MSSCASESEN") <> ? THEN DO:
   ASSIGN tmp_str = OS-GETENV("MSSCASESEN").
  IF  tmp_str BEGINS "Y" THEN
    ASSIGN mss_incasesen = FALSE.
  ELSE
    ASSIGN mss_incasesen = TRUE.
           
END.
ELSE
    ASSIGN mss_incasesen = TRUE.

IF NOT mss_incasesen AND OS-GETENV("SHADOWCOL") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("SHADOWCOL").
  IF tmp_str BEGINS "Y" then 
    ASSIGN shadowcol = TRUE
           shdcol = TRUE.
  ELSE 
   ASSIGN  shadowcol = FALSE
           shdcol = FALSE.
END. 
ELSE
  ASSIGN shadowcol = FALSE.

IF OS-GETENV("VARLENGTH") <> ? THEN
  long-length = integer(OS-GETENV("VARLENGTH")).
ELSE
  long-length = 8000.

IF OS-GETENV("MOVEDATA")    <> ? THEN
  tmp_str      = OS-GETENV("MOVEDATA").
IF tmp_str BEGINS "Y" THEN movedata = TRUE.

IF OS-GETENV("LOADSQL") <> ? THEN DO:
  tmp_str      = OS-GETENV("LOADSQL").
  IF tmp_str BEGINS "Y" then loadsql = TRUE.
  ELSE loadsql = FALSE.
END. 
ELSE 
  loadsql = TRUE.

IF OS-GETENV("UNICODETYPES")  <> ? THEN DO:

  tmp_str      = OS-GETENV("UNICODETYPES").

  IF tmp_str BEGINS "Y" THEN DO:
      ASSIGN unicodeTypes = TRUE.
      /* for unicode support, maximum length is 4000 */
      IF long-length > 4000 THEN
          ASSIGN long-length = 4000.
      /* if MSSCODEPAGE was not specified, default codepage to 'utf-8' */
      IF OS-GETENV("MSSCODEPAGE") = ? THEN
         ASSIGN mss_codepage = 'utf-8'.
      tmp_str      = OS-GETENV("UNICODE_EXPAND").
      IF tmp_str BEGINS "Y" THEN
          lUniExpand = YES.
  END.
END.  
ASSIGN  descidx = TRUE.

IF OS-GETENV("MIGRATECONSTR")   <> ? 
  THEN DO:
   tmp_str = OS-GETENV("MIGRATECONSTR").
   IF tmp_str BEGINS "y" 
     THEN migConstraint = yes.
     ELSE migConstraint = no.
  END.
  ELSE migConstraint = no.

IF OS-GETENV("UNIQUECONSTR")   <> ?
 THEN DO:
  tmp_str      = OS-GETENV("UNIQUECONSTR").
  IF tmp_str BEGINS "y" 
    THEN choiceUniquness = "2".
    ELSE choiceUniquness = "1".
 END.   
    ELSE  choiceUniquness = "1".
    
IF OS-GETENV("CRTDEFAULT") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("CRTDEFAULT").
  IF tmp_str BEGINS "Y" then
     dflt = TRUE.
  ELSE
     dflt = FALSE.
END. 
ELSE 
  ASSIGN dflt = FALSE.

IF OS-GETENV("DFLTCONSTR") <> ? AND dflt
  THEN DO:
  tmp_str      = OS-GETENV("DFLTCONSTR").
  IF tmp_str BEGINS "y"
  THEN choiceDefault = "2".
    ELSE choiceDefault = "1".
 END.   
  ELSE  choiceDefault = "1".
    
tmp_str = OS-GETENV("MSSREVSEQGEN").
IF tmp_str <> ? AND tmp_str BEGINS "N" THEN
   newseq = FALSE.

tmp_str = OS-GETENV("MAPMSSDATETIME").
IF tmp_str <> ? AND tmp_str BEGINS "N" THEN
   mapMSSDatetime = FALSE.

IF OS-GETENV("SQLWIDTH") <> ? THEN DO:
  tmp_str = OS-GETENV("SQLWIDTH").
  IF tmp_str BEGINS "Y" THEN 
    iFmtOption = 1. 
  ELSE 
    iFmtOption = 2.
END. 
ELSE 
  iFmtOption = 2.
  
IF OS-GETENV("EXPANDX8") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("EXPANDX8").
  IF tmp_str BEGINS "Y" THEN 
    ASSIGN lExpand = TRUE
           lFormat = FALSE.
  ELSE 
    ASSIGN lExpand = FALSE
           lFormat = TRUE.
END. 
ELSE
  ASSIGN lExpand = TRUE
         lFormat = FALSE.  

IF OS-GETENV("MAPOEPRIMARY") <> ? THEN DO:       
  ASSIGN tmp_str  = OS-GETENV("MAPOEPRIMARY").
  IF tmp_str BEGINS "Y" THEN 
     ASSIGN  tryPimaryForRowid = TRUE.
  ELSE 
     ASSIGN  tryPimaryForRowid = FALSE. 
END.

IF OS-GETENV("RECIDONLY") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("RECIDONLY").
  IF tmp_str BEGINS "Y" THEN 
     ASSIGN  recid_verify = TRUE.
  ELSE 
     ASSIGN  recid_verify = FALSE.
END.

IF OS-GETENV("RECIDCOMPAT") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("RECIDCOMPAT").
  IF tmp_str BEGINS "Y" THEN 
     ASSIGN  recidCompat = TRUE.
  ELSE 
     ASSIGN  recidCompat = FALSE.
END.

IF OS-GETENV("GENRANKRPT") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("GENRANKRPT").
  IF ((tmp_str = "1") OR (tmp_str BEGINS "Y")) THEN 
     ASSIGN  genrep = TRUE.
  ELSE 
     ASSIGN  genrep = FALSE.
END.

IF OS-GETENV("COMPATIBLE") <> ?  THEN DO:
   tmp_str      = OS-GETENV("COMPATIBLE").
   IF ((tmp_str = "1") OR (tmp_str BEGINS "Y")) THEN DO:
       iRecidOption = 1. 
   END.
   ELSE IF tmp_str = "2"  THEN DO:
       iRecidOption = 2. 
   END.
   
   IF ((tmp_str = "1") OR (tmp_str BEGINS "Y") OR (tmp_str = "2")) THEN DO:      
     selBestRowidIdx = FALSE.
     IF OS-GETENV("GENROWID") <> ?  THEN DO:
        tmp_str1      = OS-GETENV("GENROWID").
        IF ((tmp_str1 = "1") OR (tmp_str1 BEGINS "Y")) THEN DO:
            ForRow = TRUE.
            choiceRowid = 1. 
        END.
        ELSE IF tmp_str1 = "2"  THEN DO:
            ForRow = TRUE.
            choiceRowid = 2. 
        END.
     END.
     ELSE IF OS-GETENV("GENUNIQROWID") <> ? THEN DO:       
        ASSIGN tmp_str1  = OS-GETENV("GENUNIQROWID").
        IF tmp_str1 BEGINS "Y" THEN DO: 
             forRowidUniq = TRUE.
             ForRow = FALSE.
        END.     
        ELSE 
             forRowidUniq = FALSE. 
     END.
     ELSE DO:
             ForRow = TRUE.
             choiceRowid = 1.      
     END.        
   END.
   ELSE DO:
         pcompatible = FALSE.
         ForRow = FALSE.
         forRowidUniq = FALSE.
         selBestRowidIdx = TRUE.
         choiceSchema = 1.
   END.
END. 

IF OS-GETENV("GETBESTROWID") <> ?  THEN DO:
   tmp_str      = OS-GETENV("GETBESTROWID").
   IF ((tmp_str = "1") OR (tmp_str BEGINS "Y")) THEN DO:
       selBestRowidIdx = TRUE.
       choiceSchema = 1. 
   END.
   ELSE IF tmp_str = "2"  THEN DO:
       selBestRowidIdx = TRUE.
       choiceSchema = 2. 
   END.
   ELSE 
       selBestRowidIdx = FALSE.
END.

if   pro_dbname   = ldbname("DICTDB") and pro_conparms = "" THEN
  assign pro_conparms = "<current working database>".

IF PROGRESS EQ "COMPILE-ENCRYPT" THEN
    ASSIGN mvdta = FALSE.
ELSE
    ASSIGN mvdta = TRUE.

ON CHOOSE OF s_btn_Advanced in frame x
DO:
  run prodict/mss/protomss1.p. 
  RUN fill_long_length.
END. 

main-blk:
DO ON ERROR UNDO main-blk, RETRY main-blk:
  IF redo THEN
     RUN cleanup.
 
  IF logfile_open THEN DO:
     OUTPUT STREAM logfile CLOSE.
     logfile_open = FALSE.
  END.

  IF wrg-ver THEN DO:
    IF NOT mapMSSDatetime THEN
       MESSAGE "You unselected 'Map MSS Datetime Type' but have tried to connect to a version of" SKIP
               "MS SQL Server prior to 2008 or is not using a driver that supports the alternative mapping" SKIP
               "data types (date, datetime2, datetimeoffset)." SKIP
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ELSE IF unicodeTypes THEN
       MESSAGE "Unicode support for the DataServer for MS SQL Server was designed to work" SKIP
               "with Versions 2005 and above. You have tried to connect to a prior version" SKIP
               "of MS SQL Server. " SKIP
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ELSE IF iRecidOption = 2 THEN
       MESSAGE "Create RECID using Computed column support for the DataServer for MS SQL Server was " SKIP
               "designed to work with Versions 2005 and above. You have tried to connect to a prior " SKIP
               "versionof MS SQL Server. " SKIP
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ELSE
       MESSAGE "The DataServer for MS SQL Server was designed to work with Versions 7 " SKIP
               "and above.  You have tried to connect to a prior version of MS SQL Server. " SKIP
               "The DataServer for ODBC supports that version and must be used to perform " SKIP
               "this function. " SKIP(1)
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.

    RETURN.
  END.
    
  IF redoblk THEN DO:
      MESSAGE "You have received error messages from the client stating why" SKIP
              "the process was stopped.  Correct the errors and try again." SKIP
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  END.
  
  /*
   * if this is not batch mode, allow override of environment variables.
   */
  
IF NOT batch_mode THEN 
  _updtvar: 
  DO WHILE TRUE:
  /*   lUniExpand:SENSITIVE = NO.

     DISPLAY cFormat lExpand cRecid WITH FRAME X. */
     UPDATE pro_dbname
        pro_conparms
        osh_dbname
        mss_pdbname
        mss_dbname
        mss_username
        mss_password
        mss_conparms
        long-length
        mss_codepage
        mss_collname
        mss_incasesen
        loadsql
        genrep
        movedata WHEN mvdta = TRUE
        s_btn_Advanced
        btn_OK btn_Cancel 
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            btn_Help
        &ENDIF
        WITH FRAME x.     

    IF pro_conparms = "<current working database>" THEN
      ASSIGN pro_conparms = "".

    IF loadsql THEN DO:
      IF Osh_dbname = "" OR osh_dbname = ? THEN DO:
        MESSAGE "Schema holder database Name is required." 
             VIEW-AS ALERT-BOX ERROR.    
        NEXT _updtvar.
      END.
       IF mss_pdbname = "" OR mss_pdbname = ? THEN DO:
        MESSAGE "Logical Database Name is required."  
            VIEW-AS ALERT-BOX ERROR.  
        NEXT _updtvar.
      END.
      IF mss_dbname = "" OR mss_dbname = ? THEN DO:
        MESSAGE "ODBC Data Source Name is required."  
            VIEW-AS ALERT-BOX ERROR.  
        NEXT _updtvar.
      END.
    END.      
    LEAVE _updtvar.
  END.
  
  IF osh_dbname <> "" AND osh_dbname <> ? THEN
      output_file = osh_dbname + ".log".
  ELSE
      output_file = "protomss.log". 
             
  OUTPUT STREAM logfile TO VALUE(output_file) NO-ECHO NO-MAP UNBUFFERED. 
  logfile_open = true. 
  IF pro_dbname = "" OR pro_dbname = ? THEN DO:
    PUT STREAM logfile UNFORMATTED "{&PRO_DISPLAY_NAME} Database name is required." SKIP.
    ASSIGN err-rtn = TRUE.
  END.
  ELSE DO:
      IF LDBNAME ("DICTDB") <> pro_dbname THEN DO:
        ASSIGN old-dictdb = LDBNAME("DICTDB").
        IF NOT CONNECTED(pro_dbname) THEN
          CONNECT VALUE (pro_dbname) VALUE (pro_conparms) -1 NO-ERROR.              
    
        IF ERROR-STATUS:ERROR OR NOT CONNECTED (pro_dbname) THEN DO:
          DO i = 1 TO  ERROR-STATUS:NUM-MESSAGES:
            IF batch_mode THEN
              PUT STREAM logfile UNFORMATTED ERROR-STATUS:GET-MESSAGE(i) skip.
            ELSE
              MESSAGE ERROR-STATUS:GET-MESSAGE(i).
          END.
          IF batch_mode THEN
             PUT STREAM logfile UNFORMATTED "Unable to connect to {&PRO_DISPLAY_NAME} database"
             skip.
          ELSE DO:
            &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                MESSAGE "Unable to connect to {&PRO_DISPLAY_NAME} database".
            &ELSE
               MESSAGE "Unable to connect to {&PRO_DISPLAY_NAME} database" 
               VIEW-AS ALERT-BOX ERROR.
            &ENDIF
          END.            
          ASSIGN err-rtn = TRUE.
        END.
        ELSE DO:
          CREATE ALIAS DICTDB FOR DATABASE VALUE(pro_dbname).
        end.  
      END.
      ELSE
        ASSIGN old-dictdb = LDBNAME("DICTDB").
  END.

  IF loadsql THEN DO:
    IF Osh_dbname = "" OR osh_dbname = ? THEN DO:
       PUT STREAM logfile UNFORMATTED  "Schema holder Database Name is required." SKIP.   
       ASSIGN err-rtn = TRUE.        
    END.
    IF mss_dbname = "" OR mss_dbname = ? THEN DO:
       PUT STREAM logfile UNFORMATTED "ODBC data source name is required." SKIP.   
       ASSIGN err-rtn = TRUE.
    END.
  END.      
  IF err-rtn THEN RETURN.
  ASSIGN redo = TRUE.

  RUN prodict/mss/protoms1.p.
  IF RETURN-VALUE = "indb" THEN DO:
    ASSIGN redo = FALSE.
    UNDO, RETRY.
  END.
  ELSE IF RETURN-VALUE = "wrg-ver" THEN DO:
    ASSIGN wrg-ver = TRUE.
    UNDO, RETRY.
  END.
  ELSE IF RETURN-VALUE = "undo" THEN DO:
    ASSIGN redoblk = TRUE.
    UNDO, RETRY.
  END.
  /*
   * If this is batch mode, make sure we close the output file we
   * opened above.
  */
  IF logfile_open
    THEN OUTPUT STREAM logfile CLOSE.
 
  IF CONNECTED (osh_dbname) THEN 
     DISCONNECT VALUE (osh_dbname).

  IF pro_dbname <> old-dictdb THEN DO:
    DISCONNECT VALUE(pro_dbname).
    IF old-dictdb NE ? THEN
       CREATE ALIAS DICTDB FOR DATABASE VALUE(old-dictdb).   
  END.
END.

/*********************************************************************
* Copyright (C) 2005-2006,2008-2010,2011 by Progress Software        *
* Corporation. All rights reserved.  Prior versions of this work may *
* contain portions contributed by participants of Possenet.          *
*                                                                    *
*********************************************************************/
/* Procedure: prodict/mss/_gendsql.p

     Created: Donna L. McMann
              12/03/02
              
              Creates an incremental sql script to be loaded into MS SQL Server
              and an incremental df to be loaded into the MSS Schema holder
              
     History: 20030805-021 Added logic for duplicate field names
              20030805-026 Added output of QUALIFIER and RECID-FLD-NAME in df.
                           Quoted name was missing for new fields.
              20030807-011 Duplicate index names, foreign position and adding/dropping
                           field with same name
              20031007-008 10/10/03 Added logic for multiple extents at end of file for foreign position
              Added CAPS for case insensitive search for _file _index for name
              02/08/05    Added support for turning on/off x(8) override to x(30) - depending on
                          value stored in sqlwidth 
              04/17/06  fernando Unicode support
              06/12/06  fernando Added support for int64
              07/19/06  fernando Unicode support - support only MSS 2005    
              10/13/06  fernando Fix qualifier name if not the same as DSN - 20061005-002   
                                 Add dsrv-precision to new char fields - 20061005-003       
              01/28/08 fernando  Fix foreign attributes for logical field. Made foreign-owner and
                                 foreign-name lowercase - OE00164229
              02/22/08 fernando  Support for datetime
              04/21/08 fernando  Support for new sequence generator
              04/22/08 fernando  Handle foreign-name of TEXT/NVARCHAR(MAX) properly in .df 
                                 and update of sequence - OE00167691 
              05/12/08 fernando  Handle duplicate field names being added - OE00166402
              05/21/08 rohit     Added code for delta sql changes for new seq generator for MSS
              06/09/08 rohit     Fixed bugs OE00169475/169635/169699 related to new sequence generator for MSS
              08/25/08 fernando  Keep progres_recid index name consistent with migration code - OE00133695
              09/28/08 knavneet  Added error handling code to the sequence generator - OE00172741
              10/22/08 fernando  Fix for mandatory and and null columns with default - OE00175772
              12/02/08 fernando  Fix for logical and sqlwidth, plus fix for field-misc22  - OE00177587
                                 Properly handle sql-width for extent fields - OE00176198
                                 Handle case where index is re-added - OE00177558
              04/03/09 fernando  Support for datetime-tz and 2008 date time data types
              04/28/09 knavneet BLOB support for MSS (OE00178319)
              07/15/09 nmanchal Trigger changes for MSS(OE00178470)
              07/15/09 nmanchal Trigger changes for MSS(OE00178470) to remove WITH NOWAIT
              09/23/09 Nagaraju Implementation of Computed columns for RECID (OE00186593)
              02/11/10 fernando Fix issue with sql generated for old sequence generator
              06/02/10 sgarg    CLOB support for MSS (OE00193877)
              06/17/10 rkumar   Fix issue with incorrect sql generated when _For-owner is ?
              08/11/11 rkamboj  Fix issue assigment error with data direct driver for MSS.
              09/25/11 kmayur   Delta sql support for constraint feature              
              07/18/12 musingh  Fix issue with FOREIGN-POS generatation (OE00222952)
              08/03/13 ushrivas Fix for Delta .DF sets FOREIGN-POS 0 causing Load Aborted error(OE00230825)
              07/05/13 sdash    Added Logical DB validation in a Schema Holder while using delta SQL utility.
                                Supported batch mode delta SQL Utility.
              12/04/13 sgarg    Fix for empty string ("") INITIAL value, does not generate SQL (OE00241307)

If the user wants to have a DEFAULT value of blank for VARCHAR fields, 
an environmental variable BLANKDEFAULT can be set to "YES" and the code will
put the DEFAULT ' ' syntax on the definition for a new field. 
              
*/              
{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i }

DEFINE VARIABLE iarg          AS CHARACTER             NO-UNDO. 
DEFINE VARIABLE ikwd          AS CHARACTER             NO-UNDO. 
DEFINE VARIABLE imod          AS CHARACTER             NO-UNDO. 
DEFINE VARIABLE ipos          AS INTEGER               NO-UNDO. 
DEFINE VARIABLE ilin          AS CHARACTER EXTENT 256  NO-UNDO.
DEFINE VARIABLE ilin1          AS CHARACTER EXTENT 256  NO-UNDO.
DEFINE VARIABLE a             AS INTEGER               NO-UNDO.
DEFINE VARIABLE i             AS INTEGER               NO-UNDO.
DEFINE VARIABLE j             AS INTEGER               NO-UNDO.
DEFINE VARIABLE k             AS INTEGER               NO-UNDO.
DEFINE VARIABLE u             AS INTEGER               NO-UNDO.
DEFINE VARIABLE z             AS INTEGER               NO-UNDO.
DEFINE VARIABLE iobj          AS CHARACTER             NO-UNDO. /* d,t,f,i */
DEFINE VARIABLE inot          AS LOGICAL               NO-UNDO.
DEFINE VARIABLE inum          AS INTEGER               NO-UNDO.
DEFINE VARIABLE all_digits    AS INTEGER               NO-UNDO. 
DEFINE VARIABLE dec_point     AS INTEGER               NO-UNDO. 
DEFINE VARIABLE pos           AS INTEGER               NO-UNDO.
DEFINE VARIABLE idx-number    AS INTEGER               NO-UNDO.
DEFINE VARIABLE lvar          AS CHARACTER EXTENT 10   NO-UNDO.
DEFINE VARIABLE lvar#         AS INTEGER               NO-UNDO.
DEFINE VARIABLE sqlout        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dfout         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE startdf       AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE addtable      AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE alt-table     AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE tablename     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE forname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fortype       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dffortype     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fieldname     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fieldtype     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE idbtyp        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE xlate         AS LOGICAL               NO-UNDO.
DEFINE VARIABLE nbrchar       AS INTEGER               NO-UNDO.
DEFINE VARIABLE lngth         AS INTEGER               NO-UNDO.
DEFINE VARIABLE left_paren    AS INTEGER               NO-UNDO.
DEFINE VARIABLE right_paren   AS INTEGER               NO-UNDO.
DEFINE VARIABLE lnum          AS INTEGER               NO-UNDO.
DEFINE VARIABLE endline       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE idxline       AS CHARACTER  INITIAL ?  NO-UNDO.
DEFINE VARIABLE idxname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE wordidx       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE wordfile      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE shw-fld       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE p-r-index     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE seqname       AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE seq-type      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE seq-line      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE init          AS CHARACTER             NO-UNDO INIT ?.
DEFINE VARIABLE incre         AS CHARACTER             NO-UNDO INIT ?.
DEFINE VARIABLE cyc           AS CHARACTER             NO-UNDO INIT ?.
DEFINE VARIABLE minval        AS CHARACTER             NO-UNDO INIT ?.
DEFINE VARIABLE maxval        AS CHARACTER             NO-UNDO INIT ?.
DEFINE VARIABLE dbrecid       AS RECID                 NO-UNDO.
DEFINE VARIABLE fldnum        AS INTEGER               NO-UNDO.
DEFINE VARIABLE shw-col       AS INTEGER               NO-UNDO.
DEFINE VARIABLE df-idx        AS CHARACTER EXTENT 6    NO-UNDO.
DEFINE VARIABLE is-unique     AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE new-ord       AS INTEGER INITIAL 1     NO-UNDO.
DEFINE VARIABLE dropped-fld   AS LOGICAL               NO-UNDO.
DEFINE VARIABLE transname     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dupfield      AS LOGICAL               NO-UNDO.
DEFINE VARIABLE oq-string     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE minwidth      AS INTEGER               NO-UNDO.
DEFINE VARIABLE dfseq         AS INTEGER INITIAL 1     NO-UNDO.
DEFINE VARIABLE for-init      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE comment_chars AS CHARACTER             NO-UNDO.
DEFINE VARIABLE col-text      AS INTEGER               NO-UNDO.
DEFINE VARIABLE comment-out   AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE newstoff      AS INTEGER               NO-UNDO.
DEFINE VARIABLE efile         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE rntbl         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE recididx      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE trigname      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE varlngth      AS INTEGER               NO-UNDO.
DEFINE VARIABLE recidident    AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dftname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE unsptdt       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE qualname      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE large_seq     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE lnewSeq       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE dfLongType    AS CHARACTER             NO-UNDO.
DEFINE VARIABLE seqt_prefix   AS CHARACTER             NO-UNDO INITIAL "_SEQT_". /* new sequence generator for MSS */
DEFINE VARIABLE seqp_prefix   AS CHARACTER             NO-UNDO INITIAL "_SEQP_". /* new sequence generator for MSS */
DEFINE VARIABLE foreign_seq_name     AS CHARACTER      NO-UNDO.                  /* new sequence generator for MSS */
DEFINE VARIABLE check_seqtmgr AS LOGICAL INITIAL FALSE NO-UNDO.                  /* new sequence generator for MSS */
DEFINE VARIABLE old_incr_val  AS INTEGER               NO-UNDO.			 /* new sequence generator for MSS */
DEFINE VARIABLE old_init_val  AS INTEGER               NO-UNDO.			 /* new sequence generator for MSS */
DEFINE VARIABLE newseq_upd    AS LOGICAL               NO-UNDO INITIAL FALSE.	 /* new sequence generator for MSS */
DEFINE VARIABLE other-seq-tab        AS CHARACTER      NO-UNDO. /* OE00170189 */
DEFINE VARIABLE other-seq-proc       AS CHARACTER      NO-UNDO. /* OE00170189 */
DEFINE VARIABLE isSQLNCLI     AS LOGICAL               NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE blankdefault  AS LOGICAL               NO-UNDO INITIAL FALSE.
DEFINE VARIABLE useoedflt     AS LOGICAL               NO-UNDO INITIAL FALSE.
DEFINE VARIABLE tmp_str       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE maxValue      AS INTEGER               NO-UNDO.
DEFINE VARIABLE useComputedColumn AS LOGICAL            NO-UNDO.
define variable bug7             as logical no-undo.
define variable quote            as character no-undo.

DEFINE VARIABLE conline       AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conline1      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conline2      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE conidx        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fldcon        AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE is_check      AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE con-number    AS INTEGER               NO-UNDO.
DEFINE VARIABLE pos-comma     AS INTEGER               NO-UNDO.
DEFINE VARIABLE df-con        AS CHARACTER EXTENT 7    NO-UNDO.
DEFINE VARIABLE con-fld-name  AS CHARACTER             NO-UNDO.
DEFINE VARIABLE con-ty        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE par-tab       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE par-index     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE con-actn      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE newline       AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE VARIABLE create_shadow_col     AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE VARIABLE is-idx-comp   AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE tmp_ilin2       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE tmp_df_line      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE tmp_df_line_int      AS INTEGER           NO-UNDO.

DEFINE VARIABLE misc11     AS LOGICAL               NO-UNDO INITIAL TRUE.

batch_mode = SESSION:BATCH-MODE.

DEFINE TEMP-TABLE con-index NO-UNDO
  FIELD con-table    LIKE _file._File-name
  FIELD idx-name     LIKE _Index._Index-name
  FIELD idx-fld-name LIKE _field._Field-name
  FIELD fidx-name    LIKE _Index._Index-name.

DEFINE TEMP-TABLE con-type NO-UNDO  
  FIELD con-tab      LIKE _file._File-name  
  FIELD idx-nam      LIKE _Index._Index-name
  FIELD type     LIKE _Constraint._Con-type.
  
DEFINE TEMP-TABLE df-info NO-UNDO
    FIELD df-seq  AS INTEGER
    FIELD df-line AS CHARACTER
    FIELD df-tbl  AS CHARACTER
    FIELD df-fld  AS CHARACTER
    INDEX rt-line IS PRIMARY df-seq.

DEFINE TEMP-TABLE sql-info NO-UNDO
  FIELD line-num AS INTEGER
  FIELD line     AS CHARACTER
  FIELD tblname  AS CHARACTER
  FIELD fldname  AS CHARACTER
  INDEX tbl-line IS PRIMARY tblname line-num ASCENDING
  INDEX fname tblname fldname. 
  
DEFINE TEMP-TABLE new-obj NO-UNDO
  FIELD add-type AS CHARACTER
  FIELD tbl-name AS CHARACTER
  FIELD fld-name AS CHARACTER
  FIELD for-name AS CHARACTER
  FIELD for-type AS CHARACTER
  FIELD prg-name AS CHARACTER
  FIELD n-order  AS INTEGER
  FIELD mand     AS LOGICAL
  FIELD iExtents AS INTEGER
  FIELD iMaxWidth AS INTEGER
  INDEX add-rec IS PRIMARY add-type tbl-name n-order prg-name.

DEFINE TEMP-TABLE rename-obj NO-UNDO
  FIELD rename-type AS CHARACTER
  FIELD t-name      AS CHARACTER
  FIELD old-name    AS CHARACTER
  FIELD new-name    AS CHARACTER
  FIELD dsv-name    AS CHARACTER.

DEFINE TEMP-TABLE drop-field NO-UNDO
  FIELD f-name      AS CHARACTER
  FIELD of-table    AS CHARACTER
  FIELD drop-f-name AS CHARACTER.  

DEFINE TEMP-TABLE new-position NO-UNDO
  FIELD table-np    AS CHARACTER
  FIELD old-pos     AS INTEGER
  FIELD new-pos     AS INTEGER
  FIELD extent#     AS INTEGER
  FIELD shadow      AS INTEGER
  FIELD field-np    AS CHARACTER
  FIELD dropped     AS LOGICAL INITIAL FALSE
  INDEX fld-pos IS PRIMARY table-np old-pos.

DEFINE TEMP-TABLE alt-info NO-UNDO
  FIELD a-line-num AS INTEGER
  FIELD a-line     AS CHARACTER
  FIELD a-tblname  AS CHARACTER
  FIELD a-fldname  AS CHARACTER
  INDEX tbl-line IS PRIMARY a-tblname a-line-num ASCENDING
  INDEX fname a-tblname a-fldname. 
  
DEFINE TEMP-TABLE shad-col NO-UNDO
  FIELD s-fld-name AS CHARACTER
  FIELD s-tbl-name AS CHARACTER
  FIELD p-fld-name AS CHARACTER
  FIELD col-num    AS INTEGER.

DEFINE TEMP-TABLE fld-cache NO-UNDO
  FIELD fld-name           AS CHARACTER
  FIELD is-case-sensitive  AS LOGICAL INITIAL FALSE
  FIELD is-mandatory  AS LOGICAL INITIAL FALSE
  FIELD fld-typ-char        AS LOGICAL INITIAL FALSE
  FIELD tab-name           AS CHARACTER
  FIELD opr-type           AS CHARACTER.
  
DEFINE TEMP-TABLE idx-cache NO-UNDO
  FIELD idx-name         AS CHARACTER
  FIELD is-primary       AS LOGICAL INITIAL FALSE
  FIELD is-unique1       AS LOGICAL INITIAL FALSE
  FIELD itab-name        AS CHARACTER
  FIELD idx-fld1         AS CHARACTER
  FIELD opr-type         AS CHARACTER. 

DEFINE TEMP-TABLE idxfld-cache NO-UNDO
  FIELD idx-fld2         AS CHARACTER
  FIELD idxname1         AS CHARACTER
  FIELD tab-name1        AS CHARACTER.
    
DEFINE TEMP-TABLE verify-table NO-UNDO
  FIELD tnew-name LIKE _File._File-name
  INDEX trun-name IS UNIQUE tnew-name.

DEFINE TEMP-TABLE verify-field NO-UNDO
  FIELD f-table   LIKE _file._File-name
  FIELD fnew-name LIKE _field._Field-name
  INDEX frun-name IS UNIQUE f-table fnew-name.
  
DEFINE TEMP-TABLE verify-index NO-UNDO
  FIELD inew-name LIKE _index._index-name
  INDEX trun-name IS UNIQUE inew-name.  

DEFINE TEMP-TABLE verify-con NO-UNDO
  FIELD cnew-name LIKE _constraint._con-name
  INDEX trun-name IS UNIQUE cnew-name.
  
DEFINE TEMP-TABLE warntext NO-UNDO
   FIELD wname AS CHARACTER
   INDEX wnamel wname.

DEFINE BUFFER n-obj FOR new-obj.
    
DEFINE STREAM todf.
DEFINE STREAM tosql.

FORM
  SKIP(1)
  tablename LABEL "Working on" FORMAT "x(32)" AT 3
  SKIP(1)
  WITH FRAME working 
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D &ENDIF TITLE "Generate Scripts" .
    
FUNCTION getMaxValue RETURNS INTEGER (INPUT pcInput AS CHARACTER) FORWARD.

/* Internal Procedure */

/* PROCEDURE: updateNewFields
 * Write additional .df lines for updating FIELD-MISC22 and FOREGIN-POS, if specified
 * by caller.
 */

IF shadowcol THEN DO:

    INPUT FROM VALUE(user_env[1]).
    load_loop:
    REPEAT ON ERROR UNDO,RETRY ON ENDKEY UNDO, LEAVE:
    
    ASSIGN ilin1 = ?.
    IMPORT ilin1.


    IF  ilin1[1] = "ADD"  AND  ilin1[2] = "FIELD" THEN DO:

       create fld-cache.
       DO i =1 to 7:
   
       IF i =1 THEN DO:
            ASSIGN fld-name= ilin1[3].
                   tab-name = ilin1[5].
       end.
    
       else do:
            ASSIGN ilin1 = ?.
            import ilin1.
            if ilin1[1] = "CASE-SENSITIVE" THEN
                 ASSIGN is-case-sensitive = yes.
            if ilin1[1] = "MANDATORY" THEN
                 ASSIGN is-mandatory = yes.
           
       END.
        if ilin1[7] = "CHARACTER" THEN
                 ASSIGN fld-typ-char = yes.
       END.
  
    END.
    IF  ilin1[1] = "ADD"  and  ilin1[2] = "INDEX" THEN DO:

         create idx-cache.
         do i =1 to 7: 
  
         IF newline THEN
         leave.
         if i =1 then do:
              ASSIGN  idx-name= ilin1[3].
                      itab-name = ilin1[5].
         end.
         else do:
              ASSIGN ilin1 = ?.
              import ilin1.
              if ilin1[1] = "UNIQUE" THEN
              ASSIGN is-unique1 = yes.
       
              if ilin1[1] = "PRIMARY" THEN
                   ASSIGN is-primary = yes.
        
              if ilin1[1] = "INDEX-FIELD" THEN do:
                  create idxfld-cache.
                         ASSIGN idx-fld2 = ilin1[2].
                         idxname1= idx-name.
                         tab-name1 = itab-name.
              end.
              IF ilin1[1] = ? THEN
                  newline = yes.
        
         END.
         END. 
         newline = no.
     END.

END.
END.


PROCEDURE create_shadow:    
  ASSIGN fortype = new-obj.for-type
         forname = new-obj.for-name.
                              
  FIND new-obj where new-obj.add-type = "F"
                 AND new-obj.tbl-name = tablename
                 AND new-obj.fld-name = "_S#_" + fieldname
                 NO-ERROR.                                                                              
  
  IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */ 
                                                                              
    CREATE shad-col.
    ASSIGN s-fld-name = "_S#_" + forname
           p-fld-name = fieldname
           s-tbl-name = tablename
           col-num = shw-col.                
 
    CREATE new-obj.
    ASSIGN new-obj.add-type = "F"
           new-obj.tbl-name = tablename
           new-obj.n-order = new-ord
           new-ord = new-ord + 1
           new-obj.for-name = "_S#_" + forname
           new-obj.fld-name = "_S#_" + fieldname
           new-obj.prg-name = fieldname
           new-obj.for-type = fortype. 
    
                                                        
  END.                                 
END PROCEDURE.


PROCEDURE updateNewFields:
    DEFINE INPUT PARAMETER ptblname AS CHAR NO-UNDO.
    DEFINE INPUT PARAMETER pforpos AS INT NO-UNDO.

    DEFINE VARIABLE extnt AS LOGICAL NO-UNDO.

    FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = ptblname:                                                     
      IF INDEX(new-obj.for-name , "##") <> 0 THEN DO: 

        IF SUBSTRING(new-obj.for-name, (LENGTH(new-obj.for-name) - 2), 3) = "##1" THEN
          ASSIGN extnt = FALSE.

        IF for-name BEGINS "_S#_" THEN 
          ASSIGN extnt = FALSE.  
        ELSE IF NOT extnt THEN DO:   
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tbl-name
                 df-info.df-fld = fieldname
                 df-line = 'UPDATE FIELD "' + prg-name  + '" OF "' + tbl-name + '"'.

          /* see if caller passed this */
          IF pforpos <> ? THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tbl-name
                     df-info.df-fld = fieldname
                     df-line = '  FOREIGN-POS ' + string(pforpos).
          END.

          /* be consistent with the schema pull */
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = new-obj.tbl-name
                 df-info.df-fld = fieldname
                 df-line = '  FIELD-MISC22 ' + (IF new-obj.mand = YES THEN '"N"' ELSE '"Y"').

          IF for-name BEGINS "A##" THEN
            ASSIGN extnt = false.
          ELSE 
            ASSIGN extnt = true.
        END. 
      END.
      ELSE DO:
         IF shadowcol THEN DO:
            IF new-obj.for-name <> "_S#_" + new-obj.prg-name THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tbl-name
                   df-info.df-fld = fieldname
                   df-line = 'UPDATE FIELD "' + prg-name + '" OF "' + tbl-name + '"'.
            END.
         END.
         ELSE DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tbl-name
                   df-info.df-fld = fieldname
                   df-line = 'UPDATE FIELD "' + prg-name + '" OF "' + tbl-name + '"'.
        END.

        /* see if caller passed this */
        IF pforpos <> ? THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tbl-name
                   df-info.df-fld = fieldname
                   df-line = '  FOREIGN-POS ' + STRING(pforpos).
        END.

        /* be consistent with the schema pull */
     
        IF NOT shadowcol THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-obj.tbl-name
               df-info.df-fld = fieldname
               df-line = '  FIELD-MISC22 ' + (IF new-obj.mand = YES THEN '"N"' ELSE '"Y"').
        END.
        ELSE DO:
           IF new-obj.for-name <> "_S#_" + new-obj.prg-name THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-obj.tbl-name
                     df-info.df-fld = fieldname
                     df-line = '  FIELD-MISC22 ' + (IF new-obj.mand = YES THEN '"N"' ELSE '"Y"').
        END.


        END.
    
        ASSIGN extnt = FALSE.   
      END.                  

      /* see if caller passed this */
      IF pforpos <> ? THEN
         ASSIGN pforpos = pforpos + 1.
    END.
END.


PROCEDURE write-tbl-sql:     
  DEFINE VARIABLE dftblname   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE forpos      AS INTEGER                     NO-UNDO.
  DEFINE VARIABLE recidname   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE recidpos    AS INTEGER                     NO-UNDO.

  ASSIGN col-text = 0
         comment_chars = ""
         comment-out = FALSE
         unsptdt = FALSE.

  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename
                      AND DICTDB._File._Owner = "_FOREIGN"
                      NO-ERROR.   

  IF AVAILABLE DICTDB._File  THEN DO:
    FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = tablename:  
      IF new-obj.for-type = " UNSUPPORTED" THEN
        ASSIGN unsptdt = TRUE.
    END.
  END.
  ELSE DO:
    FIND FIRST new-obj WHERE add-type = "T"
                         AND tbl-name = tablename
                          NO-ERROR.
   FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = tablename:  
      IF new-obj.for-type = " UNSUPPORTED" THEN
        ASSIGN unsptdt = TRUE.
      END.
  END.
  IF unsptdt THEN DO:
    ASSIGN comment_chars = "-- ** "
           comment-out = TRUE.
    
    ASSIGN efile = tablename + ".e".
    OUTPUT TO VALUE(efile) APPEND.
    PUT UNFORMATTED tablename " had columns with unsupported data types." SKIP
                   "The sql was commented out and no information was" SKIP
                    "outputed to the {&PRO_DISPLAY_NAME} DF File." SKIP
                    " " SKIP.
    OUTPUT CLOSE.      
  END.
  IF dropped-fld THEN
      RUN new-for-position.

  FOR EACH sql-info BREAK BY tblname BY line-num:  
    IF FIRST-OF(tblname) THEN DO:
      IF pcompatible THEN DO:
        FIND FIRST new-obj WHERE add-type = "T"
                             AND tbl-name = tblname
                             NO-ERROR.
        IF AVAILABLE new-obj THEN DO:
          ASSIGN p-r-index = for-name.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = 'UPDATE TABLE "' + tblname + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = "  PROGRESS-RECID " + string(fldnum + 1).
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname.

          IF useComputedColumn THEN DO:
             /*  we put recid, recid_ident_ and recid_alt_ on the list */
             df-line = '  HIDDEN-FLDS "' + string(fldnum + 1) + ','
                       + string(fldnum + 2) + ',' 
                       + string(fldnum + 3) + ',"'.
          END.
          ELSE
             df-line = '  HIDDEN-FLDS "' + string(fldnum + 2) + ',"'.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = '  QUALIFIER "' + qualname + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = '  RECID-FLD-NAME "PROGRESS_RECID"'.
        END.
      END.
      ELSE DO:
        FIND FIRST new-obj WHERE add-type = "T"
                             AND tbl-name = tblname
                             NO-ERROR.
        IF AVAILABLE new-obj THEN DO:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = 'UPDATE TABLE "' + tblname + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = '  QUALIFIER "' + qualname + '"'.
        END.
      END.

      FIND DICTDB._File WHERE DICTDB._File._File-name = tblname
                          AND DICTDB._File._Owner = "_FOREIGN"
                          NO-ERROR.   
      FIND FIRST new-obj WHERE add-type = "T"
                             AND tbl-name = tblname
                             NO-ERROR.

      IF AVAILABLE DICTDB._File AND NOT AVAILABLE new-obj THEN DO: /* adding new fields to file not dropping it */     
        /* If progress-recid not a specific field but one the user has selected. */
        IF DICTDB._File._fil-misc1[1] < 0  THEN DO:
          FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Fld-stoff = (DICTDB._File._Fil-misc1[1] * -1)
               NO-ERROR.
          IF AVAILABLE DICTDB._Field THEN     
            ASSIGN recidname = DICTDB._Field._Field-name.
        END.
        ELSE 
          ASSIGN recidname = "progress_recid"
                 recidident = "progress_recid_ident_".
        
        ASSIGN forpos = 1.

        FOR EACH DICTDB._field OF DICTDB._file BREAK BY _File-recid BY _fld-stoff: 
          IF forpos < DICTDB._field._fld-stoff THEN 
            ASSIGN forpos = DICTDB._field._fld-stoff.
          IF DICTDB._Field._Fld-Misc1[5] > forpos THEN
            ASSIGN forpos = DICTDB._Field._Fld-Misc1[5].
          IF LAST-OF(_File-recid) THEN DO:
            IF DICTDB._field._extent > 0 THEN
              ASSIGN forpos = forpos + (DICTDB._Field._Extent - 1).
          END.
        END.
               
        IF DICTDB._File._Fil-Misc1[1] > forpos THEN
            ASSIGN forpos = DICTDB._File._Fil-Misc1[1] + 1.

        maxValue = getMaxValue(DICTDB._File._Fil-Misc2[2]).
        IF maxValue > forpos THEN
            ASSIGN forpos = maxValue.

        /* update forpos and field-misc22 for new fields */
        RUN updateNewFields (INPUT sql-info.tblname, INPUT forpos).

      END.        
      ELSE DO: /* Have a new file here */
        ASSIGN forpos = 1.

        /* update forpos and field-misc22 for new fields */
        RUN updateNewFields (INPUT sql-info.tblname, INPUT forpos).

      END.
    END.                                       
    IF line-num < 2 THEN
      PUT STREAM tosql UNFORMATTED comment_chars line SKIP.          
    ELSE DO:          
        FIND FIRST new-obj WHERE new-obj.add-type = "F"
                           AND new-obj.tbl-name = tblname 
                           AND new-obj.fld-name = fldname NO-ERROR.

        IF AVAILABLE new-obj THEN DO: 
            /* OE00175772
               if mandatory, add 'not null' clause for new fields. If not mandatory and has
               default value, add 'with values' to get existing records updated with default
               value
            */
            IF new-obj.mand = YES THEN
               ASSIGN sql-info.line = sql-info.line + " NOT NULL".
            ELSE  ASSIGN sql-info.line = sql-info.line + " NULL".
        END.

        IF NOT LAST-OF(tblname) THEN DO:      
          PUT STREAM tosql UNFORMATTED comment_chars line "," SKIP.
        END.
        ELSE DO:          
          PUT STREAM tosql UNFORMATTED comment_chars line ")" SKIP.
          PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
        END.
    END.         
    DELETE sql-info.
  END.

  FOR EACH alt-info BREAK BY a-tblname BY a-line-num:

    IF FIRST-OF(a-tblname) THEN
      /* need to generate FIELD-MISC22 for new fields */
      RUN updateNewFields(INPUT alt-info.a-tblname, INPUT ?).

    IF FIRST-OF(a-tblname) THEN
      PUT STREAM tosql UNFORMATTED comment_chars a-line  SKIP.
    ELSE DO:          
        FIND FIRST new-obj WHERE new-obj.add-type = "F"
                           AND new-obj.tbl-name = a-tblname 
                           AND new-obj.fld-name = a-fldname NO-ERROR.
   

        IF AVAILABLE new-obj THEN  DO:
            /* OE00175772
               if mandatory, add 'not null' clause for new fields. If not mandatory and has
               default value, add 'with values' to get existing records updated with default
               value
            */
            IF new-obj.mand = YES THEN
               ASSIGN alt-info.a-line = alt-info.a-line + " NOT NULL".
            ELSE IF dflt AND INDEX(alt-info.a-line," DEFAULT") <> 0 THEN
                ASSIGN alt-info.a-line = alt-info.a-line + " WITH VALUES".
        END.

        IF NOT LAST-OF(a-tblname) THEN 
          PUT STREAM tosql UNFORMATTED comment_chars a-line ","  SKIP.
        ELSE DO:          
          PUT STREAM tosql UNFORMATTED  comment_chars a-line   SKIP.       
          PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
        END.
    END.         
    DELETE alt-info.
  END.
    
  IF pcompatible AND addtable THEN DO:
    ASSIGN recididx = p-r-index
           trigname = "_TI_" + recididx
           /* OE00133695 - use #_# for recid index */
           p-r-index = p-r-index + "#_#progress_recid ON " + mss_username + "." + p-r-index.
    IF NOT useComputedColumn  THEN DO:
      trigname = "_TI_" + recididx.
    
      PUT STREAM tosql UNFORMATTED   
        comment_chars "create trigger " trigname " ON " mss_username "." recididx " for insert as" SKIP
        comment_chars " RAISERROR (N'PSC-init',0,1) " SKIP    
        comment_chars " SET XACT_ABORT ON " SKIP    
        comment_chars " SET LOCK_TIMEOUT -1 " SKIP    
        comment_chars "    if  ( select PROGRESS_RECID from inserted) is NULL " SKIP
        comment_chars "    begin" SKIP
        comment_chars "        update t set PROGRESS_RECID = i.IDENTITYCOL " SKIP
        comment_chars "         from " recididx " t  JOIN inserted i ON " skip
        comment_chars "         t.PROGRESS_RECID_IDENT_ = i.PROGRESS_RECID_IDENT_" SKIP
        comment_chars "        select convert (bigint, @@identity)" SKIP
        comment_chars "    end" SKIP    
        comment_chars " SET XACT_ABORT OFF " SKIP    
        comment_chars " RAISERROR (N'PSC-end',0,1) " SKIP.    
    
      PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).


      PUT STREAM tosql UNFORMATTED comment_chars
        "CREATE UNIQUE INDEX " p-r-index "(PROGRESS_RECID)" SKIP.
      PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).

      ASSIGN p-r-index = recididx
             /* OE00133695 - use #_# for recid index */
             p-r-index = p-r-index + "#_#progress_recid_ident_ ON " + mss_username + "." + p-r-index.
      PUT STREAM tosql UNFORMATTED comment_chars
        "CREATE UNIQUE INDEX " p-r-index "(PROGRESS_RECID_IDENT_)" SKIP.
      PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).          
    END.
  END.    
  
  ASSIGN addtable      = FALSE
         alt-table     = FALSE
         lnum          = 0.

  IF comment-out THEN DO:
       /* Delete all df info for this table */
    FOR EACH df-info WHERE df-tbl = tablename:
      DELETE df-info.
    END.
  END.

END PROCEDURE.

PROCEDURE write-con-sql:
    IF conline = ? OR conline = "" THEN LEAVE.
    IF fldcon = TRUE THEN
       PUT STREAM tosql UNFORMATTED comment_chars conline  SKIP.
    ELSE
       PUT STREAM tosql UNFORMATTED comment_chars conline ")"  SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
   
    ASSIGN conline = ?
            fldcon = FALSE.      
           
END.    
    
PROCEDURE write-idx-sql:
  IF idxline = ? OR idxline = "" THEN LEAVE.
        
   IF pcompatible AND is-unique = FALSE AND misc11 THEN 
         ASSIGN idxline = idxline + ", PROGRESS_RECID".

  PUT STREAM tosql UNFORMATTED comment_chars idxline ")"  SKIP.
  PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
    
  ASSIGN idxline = ?
         idxname = ?
         is-unique = FALSE
         wordidx = FALSE
         wordfile = ?.  
  
  FOR EACH shad-col:
 
    FIND FIRST df-info WHERE df-info.df-tbl = s-tbl-name
                         AND df-info.df-fld = p-fld-name
                         AND df-line BEGINS '  FOREIGN-POS '
                         NO-ERROR.
    IF AVAILABLE df-info THEN DO: 
       tmp_df_line =  substring (df-line ,14).
       tmp_df_line_int = INTEGER(tmp_df_line) - 1.
    END.

    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = s-tbl-name
           df-line = 'UPDATE FIELD "' + p-fld-name + '" OF "' + s-tbl-name + '"'.
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = s-tbl-name
           df-line = '  SHADOW-COL "' + string(tmp_df_line_int) + '"'.
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = s-tbl-name
           df-line = "  FIELD-MISC15 " + string(tmp_df_line_int).
    DELETE shad-col.
  END.                                 
END PROCEDURE.

PROCEDURE write-seq-sql:

  DEFINE VARIABLE isAppend AS LOGICAL.

  IF seq-line = ? OR seq-line = "" THEN LEAVE.
  /* Delete sequence */
  IF seq-type = "d"  THEN 
    PUT STREAM tosql UNFORMATTED seq-line SKIP(1) "go" SKIP(1).
  /* add sequence */
  ELSE IF seq-type = "a" THEN DO:
    PUT STREAM tosql UNFORMATTED 
           "if (select name from sysobjects where name = '"seqt_prefix forname "' and" skip
           "    uid = (select uid from sysusers " SKIP
           "           where sid = (select sid from master.dbo.syslogins" skip 
           "                        where UPPER(name) = UPPER('"mss_username "'))))" skip
           "is not NULL" skip
           "drop table " seqt_prefix forname skip. 
    
    IF seqt_prefix = "_SEQT_REV_" THEN 
       ASSIGN other-seq-tab = "_SEQT_".
    ELSE 
       ASSIGN other-seq-tab = "_SEQT_REV_".
	
    IF seqt_prefix = "_SEQT_" THEN 
     PUT STREAM tosql UNFORMATTED 
        "if exists (select name from dbo.sysobjects where id = object_id(N'_SEQT_REV_SEQTMGR') " skip
        "   and OBJECTPROPERTY(id, N'IsTable') = 1) " skip
        "      if (select seq_name from _SEQT_REV_SEQTMGR where seq_name = '" forname "') " skip
        "          is not NULL" skip
        "             delete from _SEQT_REV_SEQTMGR where seq_name = '" forname "' " skip

        "if exists (select name from dbo.sysobjects where id = object_id(N'_SEQT_REV_SEQTMGR') " skip
        "   and OBJECTPROPERTY(id, N'IsTable') = 1) " skip
        "     if (select seq_name from _SEQT_REV_SEQTMGR) is NULL " skip
	    "         drop table _SEQT_REV_SEQTMGR " skip. /* processing SEQTMGR table */
	     
     PUT STREAM tosql UNFORMATTED 
           "if (select name from sysobjects where name = '"other-seq-tab forname "' and" skip
           "    uid = (select uid from sysusers " SKIP
           "           where sid = (select sid from master.dbo.syslogins" skip 
           "                        where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           "is not NULL" skip
           "drop table " other-seq-tab forname skip. 
	
     PUT STREAM tosql UNFORMATTED "go" SKIP(1).

     PUT STREAM tosql UNFORMATTED 
           "if (select name from sysobjects where name = '"seqp_prefix forname "' and" skip
           "           uid = (select uid from sysusers " SKIP
           "                  where sid = (select sid from master.dbo.syslogins" skip 
           "                               where UPPER(name) = UPPER('" mss_username "'))))" skip
           " is not NULL" skip
           " drop procedure " seqp_prefix forname SKIP. 
    
    IF seqp_prefix = "_SEQP_REV_" THEN 
       ASSIGN other-seq-proc = "_SEQP_".
    ELSE 
       ASSIGN other-seq-proc = "_SEQP_REV_".
        
     PUT STREAM tosql UNFORMATTED 
           "if (select name from sysobjects where name = '"other-seq-proc forname "' and" skip
           "           uid = (select uid from sysusers " SKIP
           "                  where sid = (select sid from master.dbo.syslogins" skip 
           "                               where UPPER(name) = UPPER('" user_env[26] "'))))" skip
           " is not NULL" skip
           "    drop procedure " other-seq-proc forname skip. 

    PUT STREAM tosql UNFORMATTED "go" SKIP(1).

    /* creating SEQT_REV_SEQTMGR table for revised sequence generator for MSS if one does not exist. */
     IF lnewSeq AND NOT check_seqtmgr THEN DO:
       put stream tosql unformatted 
	  " if not exists (select * from dbo.sysobjects where id = object_id(N'_SEQT_REV_SEQTMGR') " skip
	  "    and OBJECTPROPERTY(id, N'IsTable') = 1)" skip
          "create table _SEQT_REV_SEQTMGR (" skip
          "        seq_name varchar(30) not null, " skip
	  "        initial_value bigint, " skip
	  "        increment_value bigint, " skip
	  "        upper_limit bigint, " skip
	  "        cycle bit not null )" skip 
          " " skip.
	ASSIGN check_seqtmgr = TRUE.
     END. /* end of SEQTMGR */

     PUT STREAM tosql UNFORMATTED "go" SKIP(1).

  IF NOT lnewSeq THEN DO:
     PUT STREAM tosql UNFORMATTED seq-line "(" SKIP.
     PUT STREAM tosql UNFORMATTED "  initial_value   bigint NULL," SKIP.
     PUT STREAM tosql UNFORMATTED "  increment_value bigint NULL," SKIP.
     PUT STREAM tosql UNFORMATTED "  upper_limit     bigint NULL," SKIP.
     PUT STREAM tosql UNFORMATTED "  current_value   bigint NULL," SKIP.
     PUT STREAM tosql UNFORMATTED "  cycle           BIT NOT NULL)" SKIP(1).
     PUT STREAM tosql UNFORMATTED "insert into _SEQT_" forname SKIP.
     PUT STREAM tosql UNFORMATTED "(initial_value, increment_value, upper_limit, current_value, cycle)" SKIP.
     PUT STREAM tosql UNFORMATTED "values(" init "," incre ",".
     IF maxval = ? THEN
       PUT STREAM tosql UNFORMATTED (IF large_seq THEN "9223372036854775807," ELSE "2147483647,") init "," cyc ")" SKIP.
     ELSE
       PUT STREAM tosql UNFORMATTED  maxval "," init "," cyc ")" SKIP. 
  END.
  ELSE DO:
        PUT STREAM tosql UNFORMATTED seq-line "(" SKIP.
        PUT STREAM tosql UNFORMATTED "  current_value bigint identity(" init "," incre ") primary key," SKIP.
        PUT STREAM tosql UNFORMATTED "  seq_val int)" SKIP.
        PUT STREAM tosql UNFORMATTED "insert into _SEQT_REV_SEQTMGR " SKIP.
        PUT STREAM tosql UNFORMATTED "(seq_name, initial_value, increment_value, upper_limit, cycle)" SKIP.
        PUT STREAM tosql UNFORMATTED "values('" forname "'," init "," incre ",".
        IF maxval = ? THEN
           PUT STREAM tosql UNFORMATTED (IF large_seq THEN "9223372036854775807," ELSE "2147483647,") cyc ")" SKIP.
	ELSE
           PUT STREAM tosql UNFORMATTED  maxval "," cyc ")" SKIP. 
    END.

    PUT STREAM tosql UNFORMATTED "go" SKIP(1).
    
    /* Create the procedure to keep sequence numbers */
    IF NOT lnewSeq THEN DO:
       /* this is the default version of the sequence generator */

       PUT STREAM tosql unformatted 
           "create procedure _SEQP_" forname " (@op int, @val bigint output) as " skip
           "begin"  skip 
           "    /* " skip 
           "     * Current-Value function " skip 
           "     */" skip
           "    SET XACT_ABORT ON " skip
           "    declare @err int " skip
           "    if @op = 0 " skip 
           "    begin" skip 
           "        begin transaction" skip 
           "        select @val = (select current_value from _SEQT_" forname ")" skip 
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "        commit transaction" skip
           "        return 0" skip
           "    end" skip 
           "    " skip 
           "    /*" skip  
           "     * Next-Value function " skip 
           "     */" skip 
           "    else if @op = 1" skip 
           "    begin" skip 
           "        declare @cur_val  bigint" skip 
           "        declare @last_val bigint" skip 
           "        declare @inc_val  bigint" skip 
           " " skip 
           "        begin transaction" skip 
           " " skip 
           "        /* perform a 'no-op' update to ensure exclusive lock */" skip 
           "        update _SEQT_" forname " set initial_value = initial_value" skip
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           " " skip 
           "        select @cur_val = (select current_value from _SEQT_" forname ")" skip
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "        select @last_val = (select upper_limit from _SEQT_" forname ")" skip
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "        select @inc_val  = (select increment_value from _SEQT_" forname ")" skip 
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           " " skip 
           "        /*" skip 
           "         * if the next value will pass the upper limit, then either" skip
           "         * wrap or return a range violation" skip 
           "         */ " skip 
           "        if  @inc_val > 0 and @cur_val + @inc_val > @last_val  or @inc_val < 0 and @cur_val + @inc_val < @last_val " skip  
           "        begin" skip 
           "            if (select cycle from _SEQT_" forname ") = 0 /* non-cycling sequence */" skip 
           "            begin " skip 
           "                SET @err = @@error " skip
           "                if @err <> 0 goto Err " skip
           "                select @val = @cur_val" skip
           "                commit transaction" skip 
           "                return -1" skip 
           "            end" skip 
           "            else " skip
           "            BEGIN " skip
           "                 select @val = (select initial_value from _SEQT_" forname ")" skip
           "                 SET @err = @@error " skip
           "                 if @err <> 0 goto Err " skip
           "            END " skip
           "        end" skip 
           "        else " skip 
           "             select @val = @cur_val + @inc_val" skip 
           " " skip 
           " " skip 
           "        update _SEQT_" forname " set current_value = @val" skip
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           " " skip 
           " " skip 
           "        commit transaction" skip 
           "        return 0" skip 
           "    end" skip 
           "    else " SKIP
           "    /*" skip  
           "     * Set Current-Value function " skip 
           "     */" skip
           "    if @op = 2 " SKIP
           "    begin " SKIP
           "      begin transaction " SKIP
           "      update _SEQT_" forname " set current_value = @val" SKIP
           "        SET @err = @@error " skip
           "        if @err <> 0 goto Err " skip
           "      commit transaction " SKIP
           "      return 0 " SKIP
           "   end " SKIP           
           "    else " skip 
           "        return -2" skip 
           "   Err: " skip
           "       rollback " skip
           "       return @err " skip
           "end " skip 
           " "   skip. 
     END.
     ELSE DO:
         /* here we will create the revised version of the sequence generator procedure */
      put stream tosql unformatted 
           "create procedure _SEQP_REV_" forname " (@op int, @val bigint output) as " skip
           " begin " skip 
           "    DECLARE @err int " skip
           "    /* " skip 
           "     * Current-Value function " skip 
           "     */" skip
           "    if @op = 0 " skip 
           "    begin" skip
           "     BEGIN TRAN " skip
           "       set @val = ident_current('_SEQT_REV_" forname "')" skip 
           "       SET @err = @err " skip
           "       if @err <> 0 goto Err " skip
           "     commit transaction " skip
           "     return " skip
           "    end" skip
           "    " skip  
           "    /*" skip  
           "     * Next-Value function " skip 
           "     */" skip 
           "    else if @op = 1" skip 
           "    begin" skip 
           "     BEGIN TRAN " skip
           "        declare @ini_val  bigint" skip 
           "        declare @inc_val  bigint" skip 
           "        declare @upper_limit  bigint" skip 
           "        declare @cycle  bit" skip
           "        /* get upper limit and cycle info from _seqt_rev_seqtmgr */" skip 
           " " skip 
           "   select @upper_limit = upper_limit, " skip
           "          @inc_val = increment_value, " skip 
           "          @cycle = cycle, " skip
           "          @ini_val = initial_value " skip 
           "          from _seqt_rev_seqtmgr where seq_name = '" forname "'" skip
           "    SET @err = @err " skip
           "    if @err <> 0 goto Err " skip
           " " skip 
           "        /*" skip 
           "         * get current value from sequence table " skip
           "         */" skip 
           " " skip
           "       set @val = ident_current('_SEQT_REV_" forname "')" skip 
           "       SET @err = @err " skip
           "       if @err <> 0 goto Err " skip
           "        if (@inc_val > 0 and @upper_limit - @val < @inc_val) or (@inc_val < 0 and @upper_limit + @val > @inc_val) " skip  
           "     begin " skip 
           "         if @cycle != 0 " skip 
           "           begin " skip 
           "             DBCC CHECKIDENT ('_SEQT_REV_" forname "', RESEED, @ini_val) " SKIP
           "             SET @err = @err " skip
           "             if @err <> 0 goto Err " skip
           "             set @val = ident_current('_SEQT_REV_" forname "')" skip 
           "             SET @err = @err " skip
           "             if @err <> 0 goto Err " skip
           "           end" skip 
           "         else " skip 
           "          BEGIN  " skip
           "           commit transaction " skip
           "           return -1 " skip
           "          END " skip
           "     end" skip 
           "        else " skip 
           "     begin" skip
           "        insert into _SEQT_REV_" forname " (seq_val) values (@val) " skip
           "        SET @err = @err " skip
           "        if @err <> 0 goto Err " skip
           "        set @val = scope_identity() " skip
           "        SET @err = @err " skip
           "        if @err <> 0 goto Err " skip
           "        delete from _SEQT_REV_" forname skip 
           "        SET @err = @err " skip
           "        if @err <> 0 goto Err " skip
           "     end" skip 
           "   commit transaction " skip
           "   return " skip
           "   end" skip
           "    else " skip
           "    /*" skip  
           "     * Set Current-Value function: Reseed the identity with passed value " skip 
           "     */" skip
           "    if @op = 2 " skip
           "    begin " skip
           "     BEGIN TRAN " skip
           "      DBCC CHECKIDENT ('_SEQT_REV_" forname "', RESEED, @val) " skip
           "      SET @err = @err " skip
           "      if @err <> 0 goto Err " skip
           "     COMMIT TRAN " skip
           "     return " skip
           "    end " skip           
           "    else " skip 
           "        return -2" skip 
           " Err: " skip
           "   rollback " skip
           "   return @err "
           " end " skip          
           " "   skip. 
      END.

     PUT STREAM tosql UNFORMATTED "go" SKIP(1).

    IF init <> ? AND init <> "" THEN DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  INITIAL " + init.
    END.
 
    IF incre <> ? AND incre <> "" THEN DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  INCREMENT " + incre.
    END.
    IF cyc <> ? AND cyc <> "" THEN DO:
      IF cyc = "1" THEN 
        ASSIGN cyc = "yes".
      ELSE
        ASSIGN cyc = "no".  

      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  CYCLE-ON-LIMIT " + cyc.
    END.
    
    IF minval <> ? AND minval <> "" THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-line = "  MIN-VAL " + minval.
    END.

    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1.
    IF maxval = ? THEN
      ASSIGN df-line = "  MAX-VAL ? ".            
    ELSE
      ASSIGN df-line = "  MAX-VAL " + maxval.
    
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-line = '  FOREIGN-OWNER "' + LOWER(mss_username) + '"'.
    
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-line = '  SEQ-MISC3 ' + LOWER(mss_username) + ','.

    IF NOT lnewSeq THEN
        df-line = df-line + "_SEQP_" + forname.
    ELSE
        df-line = df-line + "_SEQP_REV_" + forname.

    ASSIGN df-line = df-line + ",@op,@val,".

  END.
  /* update sequence table */
  ELSE DO:
    /* OE00167691 - handle update of sequence properly. seq-line already has the
       start of the command. Here we will just add the fields to be changed in the
       table created to support sequences.
    */
   IF INIT <> ? OR incre <> ? OR maxval <> ? OR cyc <> ? THEN DO:

       IF init <> ? THEN DO:
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-line = "  INITIAL " + init
                  seq-line = seq-line + "initial_value = " + init
                  isAppend = YES. /* remember that we need to append to the list */
       END.

       IF incre <> ? THEN DO:
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-line = "  INCREMENT " + incre
                  seq-line = seq-line + (IF isAppend THEN ", " ELSE "") +
                            "increment_value = " + incre
                  isAppend = YES. /* remember that we need to append to the list */

       END.

       IF maxval <> ? THEN DO:
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  seq-line = seq-line + (IF isAppend THEN ", " ELSE "") +
                            "upper_limit = " + maxval
                  isAppend = YES. /* remember that we need to append to the list */

           IF maxval = "?" THEN
             ASSIGN df-line = "  MAX-VAL ? ".            
           ELSE
             ASSIGN df-line = "  MAX-VAL " + maxval.

       END.

       IF cyc <> ? THEN DO:
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  seq-line = seq-line + (IF isAppend THEN ", " ELSE "") +
                             "cycle = " + cyc
                  isAppend = YES. /* remember that we need to append to the list */


          /* OE00170190 - wait until here to change cyc to yes/no */
          IF cyc = "1" THEN 
             ASSIGN cyc = "yes".
          ELSE
             ASSIGN cyc = "no".  

          ASSIGN  df-line = "  CYCLE-ON-LIMIT " + cyc.
       END.

       IF maxval NE ? AND init NE ? THEN DO:
           /* if changing max and init alert user about change current_value too */
           ASSIGN efile = seqname + ".e".
           OUTPUT TO value(efile) APPEND.
           PUT UNFORMATTED seqname " had a change to Initial and/or Upper value " SKIP
                          "so you may need to manually change the current_value if the current" skip
                          "value is out of bounds." SKIP(1).
           OUTPUT CLOSE.
       END.
       
       PUT STREAM tosql UNFORMATTED seq-line SKIP.
       
        IF (newseq_upd  AND (init NE ? OR incre NE ? )) THEN DO:
       	    PUT STREAM tosql UNFORMATTED "DROP TABLE _SEQT_REV_" seqname SKIP(1)
					 "CREATE TABLE _SEQT_REV_" seqname "(" SKIP
				         "  current_value bigint identity(" .
	    IF (init NE ? AND incre NE ? ) THEN 
		    PUT STREAM tosql UNFORMATTED init "," incre.
	    ELSE IF incre NE ? THEN 
		    PUT STREAM tosql UNFORMATTED old_init_val "," incre.
	    ELSE IF init NE ? THEN 
		    PUT STREAM tosql UNFORMATTED init "," old_incr_val.
	    PUT STREAM tosql UNFORMATTED ") primary key, seq_val int)" skip.
	    ASSIGN newseq_upd = FALSE.
	END.

       PUT STREAM tosql UNFORMATTED "go" SKIP(1).
    END.
  END.

  ASSIGN seq-type = ?
         seq-line = ?
         seqname = ?
         init = ?
         maxval = ?
         minval = ?
         incre = ?
         cyc = ?.                 
END PROCEDURE.

PROCEDURE create-new-obj:
  DEFINE INPUT PARAMETER atype   AS CHARACTER.
  DEFINE INPUT PARAMETER ext-num AS CHARACTER.
  
  IF atype = "T" THEN DO:
    CREATE new-obj.
    ASSIGN add-type = "T"
           tbl-name = ilin[3]
           for-name = forname.
  END. 
  ELSE IF atype = "F" THEN DO:    
    CREATE new-obj.
    ASSIGN add-type = "F"
           n-order = new-ord
           new-ord = new-ord + 1
           tbl-name = tablename
           fld-name = fieldname
           for-type = fortype
           mand = NO
           prg-name = (IF ilin[3] <> ? THEN ilin[3]
                       ELSE fieldname).
    IF ext-num = ? THEN
      ASSIGN for-name = fieldname.       
    ELSE
      ASSIGN for-name = fieldname + "##" + ext-num.  

  END. 
  ELSE IF atype = "I" THEN DO:
     CREATE new-obj.
     ASSIGN add-type = "I"
            tbl-name = ilin[5]
            for-name = forname
            prg-name = ilin[3].
  END.       
  
  ELSE IF atype = "C" THEN DO:
     CREATE new-obj.
     ASSIGN add-type = "C"
            tbl-name = ilin[5]
            for-name = forname
            prg-name = ilin[3].
  END.         
END PROCEDURE. 


PROCEDURE new-obj-idx:           
  ASSIGN fortype = new-obj.for-type
         forname = new-obj.for-name.
                              
  FIND new-obj where new-obj.add-type = "F"
                 AND new-obj.tbl-name = tablename
                 AND new-obj.fld-name = "_S#_" + ilin[2]
                 NO-ERROR.                                                                              
  
  IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */ 
                                                            
    ASSIGN shw-col = 0.                               
                            
    FOR EACH new-Obj WHERE add-type = "F"
                       AND tbl-name = tablename:
      ASSIGN shw-col = shw-col + 1.
    END.
    IF pcompatible AND NOT addtable THEN
      ASSIGN shw-col = shw-col + 2.
    ELSE  
      ASSIGN shw-col = shw-col + 1.
                                                                                              
    CREATE shad-col.
    ASSIGN s-fld-name = "_S#_" + forname
           p-fld-name = ilin[2]
           s-tbl-name = tablename
           col-num = shw-col.                
 
    CREATE new-obj.
    ASSIGN new-obj.add-type = "F"
           new-obj.tbl-name = tablename
           new-obj.n-order = new-ord
           new-ord = new-ord + 1
           new-obj.for-name = "_S#_" + forname
           new-obj.fld-name = "_S#_" + ilin[2]
           new-obj.prg-name = ilin[2]
           new-obj.for-type = fortype. 
    
    FIND n-obj WHERE n-obj.add-type = "t"
                 AND n-obj.tbl-name = tablename.
                              
    PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + mss_username + "." + n-obj.for-name SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars " ADD " new-obj.for-name  " " new-obj.for-type SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).                                                          
  END.                                 
END PROCEDURE.

PROCEDURE get-position:

  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  IF NOT AVAILABLE DICTDB._File THEN 
    FIND rename-obj WHERE rename-type = "T"
                      AND t-name = tablename
                      NO-ERROR.
  IF AVAILABLE rename-obj THEN
    FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR. 
  IF AVAILABLE DICTDB._File THEN DO:
    ASSIGN i = 0.

    FOR EACH DICTDB._field OF DICTDB._file BREAK BY _File-recid BY _fld-stoff: 
      IF i < DICTDB._field._fld-stoff THEN 
        ASSIGN i = DICTDB._field._fld-stoff.
      IF DICTDB._Field._Fld-Misc1[5] > i THEN
         ASSIGN i = DICTDB._Field._Fld-Misc1[5].
      IF LAST-OF(_File-recid) THEN DO:
        IF DICTDB._field._extent > 0 THEN
          ASSIGN i = i + (DICTDB._Field._Extent - 1).
      END.
    END.

    IF i < DICTDB._File._Fil-misc1[1] THEN
        ASSIGN i = DICTDB._File._Fil-misc1[1].
    
    maxValue = getMaxValue(DICTDB._File._Fil-misc2[2]).
    IF i < maxValue THEN
        ASSIGN i = maxValue.

    FOR EACH new-obj WHERE new-obj.add-type = "F"
                       AND new-obj.tbl-name = tablename:                      
      ASSIGN i = i + 1.
    END.
    FIND FIRST df-info WHERE df-info.df-tbl = tablename
                         AND df-info.df-fld = fieldname
                         AND df-line BEGINS '  FOREIGN-POS '
                         NO-ERROR.
    IF AVAILABLE df-info THEN.
    ELSE DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-info.df-tbl = tablename
             df-info.df-fld = fieldname
             df-line = '  FOREIGN-POS ' + STRING(i).  
    END.
  END.   
END PROCEDURE.  

PROCEDURE new-for-position:
  DEFINE VARIABLE recidname AS CHARACTER NO-UNDO.
  DEFINE VARIABLE forpos    AS INTEGER   NO-UNDO.

  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename
                      AND DICTDB._File._Owner = "_FOREIGN"
                      NO-ERROR.          
  IF NOT AVAILABLE DICTDB._File THEN DO:
    FIND FIRST rename-obj WHERE rename-obj.new-name = tablename 
                            AND rename-obj.rename-type = "t" NO-ERROR.
    IF AVAILABLE rename-obj THEN DO:
      ASSIGN rntbl = tablename.
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
    END.
  END.
  ELSE
    ASSIGN rntbl = tablename.

  IF AVAILABLE DICTDB._File THEN DO:
    IF DICTDB._File._fil-misc1[1] < 0   THEN DO:
      FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Fld-stoff = (DICTDB._File._Fil-misc1[1] * -1)
               NO-ERROR.
      IF AVAILABLE DICTDB._Field THEN     
         ASSIGN recidname = DICTDB._Field._Field-name
                recidident = ?.
    END.
    ELSE DO:
    
      ASSIGN recidname = "progress_recid"
             recidident = "progress_recid_ident".
    END.
    
    IF recidname = "progress_recid" THEN DO:
      CREATE new-position.
      ASSIGN new-position.table-np = rntbl
             new-position.field-np = recidname
             new-position.old-pos  = DICTDB._File._Fil-Misc1[1]
             new-position.shadow   = 0
             new-position.extent#  = 0.
    END.

    IF recidident <> ? THEN DO:
      /* This is actually for hidden fields now. 
         It used to be that only the ident column was hidden, but now any 
         non-updatable column goes in _fil-misc2[2]. So we put its name as
         the ident column, but it could be any column, and we will make 
         the pos be the highest position on the list.
      */
      CREATE new-position.
      ASSIGN new-position.table-np = rntbl
             new-position.field-np = recidident
             new-position.old-pos  = getMaxValue(DICTDB._File._Fil-Misc2[2])
             new-position.shadow   = 0
             new-position.extent#  = 0.
    END.

    FOR EACH DICTDB._Field OF DICTDB._File:      
      CREATE new-position.
      ASSIGN new-position.table-np = rntbl
             new-position.field-np = DICTDB._Field._Field-name
             new-position.old-pos  = DICTDB._Field._Fld-stoff
             new-position.shadow   = (IF DICTDB._Field._Fld-Misc1[5] > 0 THEN
                                       DICTDB._Field._Fld-Misc1[5]
                                      ELSE 0)
             new-position.extent#  = (IF DICTDB._Field._Extent > 0 THEN
                                          DICTDB._Field._Extent
                                       ELSE 0).
      FIND FIRST rename-obj WHERE rename-obj.t-name = rntbl 
                            AND rename-obj.rename-type = "f" 
                            AND rename-obj.old-name = new-position.field-np NO-ERROR.
       IF AVAILABLE rename-obj THEN
           ASSIGN new-position.field-np = rename-obj.new-name.
    END.

    ASSIGN forpos = 0.
    FOR EACH new-position WHERE table-np = rntbl:

      FIND FIRST drop-field WHERE drop-field.of-table = new-position.table-np
                              AND drop-field.f-name = new-position.field-np NO-ERROR.

      IF AVAILABLE drop-field THEN DO:
        ASSIGN new-position.dropped = TRUE
               forpos = forpos + (IF new-position.extent# = 0 THEN 1
                                  ELSE new-position.extent#). 
         IF new-position.shadow <> 0 THEN
                  forpos = forpos + 1.  
      END.     
      ELSE DO:
        IF new-position.shadow <> 0 THEN
          ASSIGN new-position.shadow = new-position.shadow - forpos
                 new-position.new-pos = new-position.old-pos - forpos.
        ELSE
          ASSIGN new-position.new-pos = new-position.old-pos - forpos.   
      END.      
    END.

    /* Now assigns the forpos equal to the last new-pos  */
    FIND LAST new-position WHERE table-np = rntbl
                             AND new-position.dropped = FALSE.
   
    /* IF last field is an extent field */
    IF new-position.extent# <> 0 THEN 
        ASSIGN forpos = new-position.new-pos + new-position.extent#.
    ELSE
        ASSIGN forpos = new-position.new-pos + 1.

    _newloop:
    FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = rntbl:

      IF INDEX(new-obj.for-name, "##") <> 0 THEN DO:
       IF SUBSTRING(new-obj.for-name, LENGTH(new-obj.for-name) - 2) = "##1" THEN DO:
          CREATE new-position.
          ASSIGN new-position.table-np = rntbl
                 new-position.field-np = prg-name
                 new-position.new-pos  = forpos.
               
          FOR EACH n-obj WHERE n-obj.prg-name BEGINS SUBSTRING(new-obj.prg-name, 1, LENGTH(new-position.field-np) - 3):
            ASSIGN forpos = forpos + 1.
          END.
          NEXT _newloop.
        END.        
      END.
      ELSE IF new-obj.for-name BEGINS "_S#_" THEN DO:
         ASSIGN forpos = forpos + 1.
         NEXT _newloop.
      END.
      ELSE DO:
        CREATE new-position.
        ASSIGN new-position.table-np = rntbl
               new-position.field-np = new-obj.prg-name.

     /*   FIND FIRST n-obj WHERE n-obj.prg-name BEGINS SUBSTRING(new-obj.prg-name, 3) NO-ERROR. */

        FIND FIRST n-obj WHERE n-obj.prg-name = new-obj.prg-name AND new-obj.for-name BEGINS "_S#_" NO-ERROR.

        IF AVAILABLE n-obj  THEN
             ASSIGN new-position.shadow = forpos
                    forpos = forpos + 1
                    new-position.new-pos = forpos
                    forpos = forpos + 1.
        ELSE
          ASSIGN new-position.new-pos  = forpos    
                 forpos                = forpos + 1.
      END.
    END.
    
    FOR EACH new-position WHERE table-np = rntbl
                            AND new-position.dropped = FALSE:

      IF new-position.field-np = recidname THEN DO:
         IF recidname = "progress_recid" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-position.table-np
                     df-line = 'UPDATE TABLE "' + rntbl + '"'.
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-position.table-np
                     df-line = '  PROGRESS-RECID ' + STRING( new-position.new-pos).
         END.
         ELSE DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-position.table-np
                     df-line = 'UPDATE TABLE "' + rntbl + '"'.
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-position.table-np
                     df-line = '  PROGRESS-RECID ' + STRING( new-position.new-pos * -1).
        END.

        /* if user has chosen a field instead of creating the recid field put out df info */
         IF new-position.field-np <> "progress_recid" THEN DO:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = new-position.table-np
                 df-info.df-fld = new-position.field-np
                 df-line = 'UPDATE FIELD "' + new-position.field-np  + '" OF "' + new-position.table-np + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = new-position.table-np
                 df-info.df-fld = new-position.field-np
                 df-line = '  FOREIGN-POS ' + string(new-position.new-pos).
        END.
      END.
      ELSE IF new-position.field-np = recidident THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-line = 'UPDATE TABLE "' + rntbl + '"'.
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-line = '  HIDDEN-FLDS ' + STRING( new-position.new-pos).
      END.
      ELSE DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-info.df-fld = new-position.field-np
               df-line = 'UPDATE FIELD "' + new-position.field-np  + '" OF "' + new-position.table-np + '"'.
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-info.df-fld = new-position.field-np
               df-line = '  FOREIGN-POS ' + string(new-position.new-pos).  

        IF new-position.shadow <> 0 THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = new-position.table-np
                   df-info.df-fld = new-position.field-np
                   df-line = 'UPDATE FIELD "' + new-position.field-np  + '" OF "' + new-position.table-np + '"'.
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-info.df-tbl = new-position.table-np
                  df-info.df-fld = new-position.field-np
                  df-line = '  FIELD-MISC15 ' + string (new-position.shadow) .
        END.
     
      END.  
    END.
  END.
  ASSIGN dropped-fld = FALSE.
END PROCEDURE.

PROCEDURE dctquot:

  DEFINE INPUT  PARAMETER inline  AS CHARACTER            NO-UNDO.
  DEFINE INPUT  PARAMETER quotype AS CHARACTER            NO-UNDO.
  DEFINE OUTPUT PARAMETER outline AS CHARACTER INITIAL "" NO-UNDO.
  DEFINE        VARIABLE  i       AS INTEGER              NO-UNDO.

  IF INDEX(inline,quotype) > 0 THEN
    DO i = 1 TO LENGTH(inline):
       outline = outline + (IF SUBSTRING(inline,i,1) = quotype
                 THEN quotype + quotype ELSE SUBSTRING(inline,i,1)).
    END.
  ELSE
    outline = inline.

  outline = (IF outline = ? THEN "?" ELSE quotype + outline + quotype).

END PROCEDURE.

PROCEDURE create-idx-field:
  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  IF NOT AVAILABLE DICTDB._FILE THEN DO:               
    FIND rename-obj WHERE rename-type = "T"   
                      AND new-name = tablename
                      NO-ERROR.
    IF AVAILABLE rename-obj THEN 
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.            
  END.        

  IF AVAILABLE DICTDB._File THEN DO:        
    FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = ilin[2] NO-ERROR.
    IF AVAILABLE DICTDB._Field THEN DO:
    ASSIGN con-fld-name = DICTDB._Field._For-name.
      IF NOT shadowcol THEN DO:
        IF INDEX(idxline, "(") = 0 THEN
          ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
        ELSE
          ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name.            
      END.
      ELSE DO: 
        IF DICTDB._Field._Data-type <> "Character" THEN DO: 
          IF INDEX(idxline, "(") = 0 THEN
            ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
          ELSE
           ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name.  
        END.     
        ELSE IF DICTDB._Field._Data-type = "Character" THEN DO:                                    
          IF (DICTDB._Field._Fld-misc2[5] <> ? and DICTDB._Field._Fld-misc2[5] <> "") OR
            CAN-FIND(new-obj where new-obj.add-type = "F"
                               AND new-obj.tbl-name = tablename
                               AND new-obj.fld-name = "_S#_" + ilin[2]) THEN DO: /* shawdow column exists in file */
            ASSIGN con-fld-name = "_S#_" + DICTDB._Field._For-name. 
            IF INDEX(idxline, "(") = 0 THEN
              ASSIGN idxline = idxline + "(_S#_" + DICTDB._Field._For-name.
            ELSE
              ASSIGN idxline = idxline + ", _S#_" + DICTDB._Field._For-name.  

          END.                    
          ELSE DO: /* shawdow not in original file see if already created */     
            FIND FIRST new-obj where new-obj.add-type = "F"
                                 AND new-obj.tbl-name = tablename
                                 AND new-obj.prg-name = ilin[2]
                                 AND new-obj.fld-name BEGINS "_S#_" 
                                 NO-ERROR.
                                        
            IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */        
              ASSIGN shw-col = 0.
                             
              FOR EACH DICTDB._Field OF DICTDB._FILE NO-LOCK:
                IF DICTDB._Field._Extent = 0 THEN                   
                  ASSIGN shw-col = shw-col + 1.
                ELSE
                  ASSIGN shw-col = shw-col + DICTDB._Field._Extent. 
              
                IF DICTDB._Field._Fld-Misc1[5] <> ? AND DICTDB._Field._Fld-Misc1[5] <> 0 THEN
                  ASSIGN shw-col = shw-col + 1.
              END.
              IF shw-col < DICTDB._File._Fil-Misc1[1] THEN
                ASSIGN shw-col = DICTDB._File._Fil-misc1[1].

              maxValue = getMaxValue(DICTDB._File._Fil-Misc2[2]).
              IF shw-col < maxValue THEN
                ASSIGN shw-col = maxValue.
              FOR EACH new-Obj WHERE new-obj.add-type = "F"
                                 AND new-obj.tbl-name = tablename:
                ASSIGN shw-col = shw-col + 1.
              END.               

              ASSIGN shw-col = shw-col + 1.  
             
              FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = ilin[2] NO-ERROR.
             
              CREATE shad-col.
              ASSIGN p-fld-name = ilin[2]
                     s-tbl-name = tablename
                     col-num = shw-col
                     s-fld-name = "_S#_" + DICTDB._Field._For-name
                     j = DICTDB._Field._Fld-Misc1[3].
                              
              CREATE new-obj.
              ASSIGN new-obj.add-type = "F"
                     new-obj.tbl-name = tablename
                     new-obj.n-order = new-ord
                     new-ord = new-ord + 1
                     new-obj.fld-name = "_S#_" + DICTDB._Field._For-name
                     new-obj.prg-name = ilin[2]
                     new-obj.for-name = "_S#_" + DICTDB._Field._For-name. 
                         
              PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-owner + "." + DICTDB._File._For-name SKIP.
                
              IF j < varlngth THEN DO:                                   
                PUT STREAM tosql UNFORMATTED comment_chars "  ADD " + new-obj.fld-name + " " + /*"VARCHAR("*/
                                             user_env[11] + "("  + STRING(j) + ");" SKIP(1).
                ASSIGN new-obj.for-type =  /*"VARCHAR(" */ user_env[11] + "(" + STRING(j) + ")".  
              END.      
              ELSE DO:
                PUT STREAM tosql UNFORMATTED comment_chars "  ADD " new-obj.fld-name /*" TEXT"*/ " " user_env[18] SKIP.
                PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
                ASSIGN new-obj.for-type =  dfLongType /*"TEXT"*/.
              END.     
              ASSIGN con-fld-name = new-obj.fld-name.              
              IF INDEX(idxline, "(") = 0 THEN
                ASSIGN idxline = idxline + "(" + new-obj.fld-name.
              ELSE
                ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                  
            END.                                 
            ELSE DO: /* Available new-obj for shawdow */
              ASSIGN con-fld-name = new-obj.fld-name.
              IF INDEX(idxline, "(") = 0 THEN
                ASSIGN idxline = idxline + "(" + new-obj.fld-name.
              ELSE
                ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                                   
            END.                        
          END. /* shawdow not in existing file */
        END.
        IF ilin[3] BEGINS "DESC"  THEN
          ASSIGN idxline = idxline + " DESC ".
      END.        
    END. /* end available field */ 
    ELSE DO: /* Not available field see if renamed field */   

      FIND rename-obj WHERE rename-type = "F" 
                        AND t-name = tablename
                        AND new-name = ilin[2] NO-ERROR.                                    
      IF AVAILABLE rename-obj THEN DO:      
        FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name NO-ERROR.                   
        IF AVAILABLE DICTDB._Field THEN DO:
          ASSIGN con-fld-name = DICTDB._Field._For-name.        
          IF NOT shadowcol THEN DO:
            IF INDEX(idxline, "(") = 0 THEN
                ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
              ELSE
                ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name.            
          END.
          ELSE DO:
            IF DICTDB._Field._Data-type = "Character" THEN DO: 
              IF (DICTDB._Field._Fld-misc2[5] <> ? and DICTDB._Field._Fld-misc2[5] <> "") OR
                 CAN-FIND(new-obj where new-obj.add-type = "F"
                                    AND new-obj.tbl-name = tablename
                                    AND new-obj.fld-name = "_S#_" + DICTDB._Field._For-name) THEN DO: 
                ASSIGN con-fld-name =  "_S#_" + dsv-name.                                                       
                IF INDEX(idxline, "(") = 0 THEN
                  ASSIGN idxline = idxline + "(_S#_" + dsv-name.
                ELSE
                  ASSIGN idxline = idxline + ", _S#_" + dsv-name.                          
              END.
              ELSE DO: /* shawdow not in file see if already created */                      
                FIND new-obj where new-obj.add-type = "F"
                               AND new-obj.tbl-name = tablename
                               AND new-obj.fld-name = "_S#_" + DICTDB._Field._For-name
                               NO-ERROR.
                                 
                IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */              
                  ASSIGN shw-col = 0.
                      
                  FOR EACH DICTDB._Field OF DICTDB._FILE NO-LOCK:
                    IF DICTDB._Field._Extent = 0 THEN                   
                      ASSIGN shw-col = shw-col + 1.
                    ELSE
                      ASSIGN shw-col = shw-col + DICTDB._Field._Extent. 
                    IF DICTDB._Field._Fld-Misc1[5] <> ? AND DICTDB._Field._Fld-Misc1[5] <> 0 THEN
                      ASSIGN shw-col = shw-col + 1.
                  END.
                  IF shw-col < DICTDB._File._Fil-Misc1[1] THEN
                    ASSIGN shw-col = DICTDB._File._Fil-Misc1[1].

                  maxValue = getMaxValue(DICTDB._File._Fil-Misc2[2]).
                  IF shw-col < maxValue THEN
                    ASSIGN shw-col = maxValue.

                  FOR EACH new-Obj WHERE new-obj.add-type = "F"
                                     AND new-obj.tbl-name = tablename:
                    ASSIGN shw-col = shw-col + 1.
                  END.
                 
                  ASSIGN shw-col = shw-col + 1.
                                                                                              
                  FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name.
             
                  CREATE shad-col.
                  ASSIGN p-fld-name = ilin[2]
                         s-tbl-name = tablename
                         col-num = shw-col
                         s-fld-name = "_S#_" + DICTDB._Field._For-name
                         j = DICTDB._Field._Fld-Misc1[3].
                  
                  CREATE new-obj.
                  ASSIGN new-obj.add-type = "F"
                         new-obj.tbl-name = tablename
                         new-obj.n-order = new-ord
                         new-ord = new-ord + 1
                         new-obj.fld-name = "_S#_" + DICTDB._Field._For-name
                         new-obj.prg-name = ilin[2]
                         new-obj.for-name = "_S#_" + DICTDB._Field._For-name. 
                   
                  PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-owner + "." + DICTDB._File._For-name SKIP.

                  IF j < varlngth THEN DO:                    
                    PUT STREAM tosql UNFORMATTED comment_chars "  ADD " new-obj.fld-name /*" VARCHAR("*/ " " user_env[11] "("
                                   STRING(j)  ");" SKIP(1).
                    ASSIGN new-obj.for-type = /*"VARCHAR("*/ user_env[11] + "(" + STRING(j) + ")".  
                  END.      
                  ELSE DO:
                    PUT STREAM tosql UNFORMATTED comment_chars " ADD " new-obj.fld-name /*" TEXT"*/ " "  user_env[18] SKIP.
                    PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
                    ASSIGN new-obj.for-type = dfLongType /*"TEXT"*/.
                  END.     
                END.              
                ELSE DO: /* Available new-obj for shawdow */
                  ASSIGN con-fld-name =  new-obj.fld-name.                 
                  IF INDEX(idxline, "(") = 0 THEN
                    ASSIGN idxline = idxline + "(" + new-obj.fld-name.
                  ELSE
                    ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                                   
                END.                    
              END. /* shawdow not in existing file */
            END. /* End available field that is a character. */
            ELSE DO:
              ASSIGN con-fld-name =  DICTDB._Field._For-name.          
              IF INDEX(idxline, "(") = 0 THEN
                ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
              ELSE
                ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name. 
            END.      
          END.
          IF ilin[3] BEGINS "DESC"  THEN
            ASSIGN idxline = idxline + " DESC ".
        END.
      END. /* End of rename object */
      ELSE DO:
   
          FIND FIRST new-obj WHERE new-obj.add-type = "F"
                   AND new-obj.tbl-name = tablename
                   AND new-obj.prg-name = ilin[2]
                               NO-ERROR. 
          tmp_ilin2 =  ilin[2].                    
          IF AVAILABLE new-obj THEN DO:
              IF SUBSTRING(new-obj.for-type,2,7) = "VARCHAR" OR SUBSTRING(new-obj.for-type,2,8) = "NVARCHAR" THEN DO:
                 IF NOT shadowcol THEN DO:
                     ASSIGN con-fld-name = new-obj.for-name.           
                     IF INDEX(idxline, "(") = 0 THEN
                        ASSIGN idxline = idxline + "(" + new-obj.for-name.
                     ELSE
                        ASSIGN idxline = idxline + ", " + new-obj.for-name.          
                 END.
                 ELSE DO:
                    FIND fld-cache where fld-cache.fld-name = tmp_ilin2
                       AND fld-cache.tab-name  = tablename
                       NO-ERROR.
                    IF is-case-sensitive THEN        
                       FIND new-obj where new-obj.add-type = "F"
                           AND new-obj.tbl-name = tablename
                           AND new-obj.prg-name =  tmp_ilin2
                           NO-ERROR.
                    ELSE
                       FIND new-obj where new-obj.add-type = "F"
                            AND new-obj.tbl-name = tablename
                            AND new-obj.for-name = "_S#_" + tmp_ilin2
                            NO-ERROR.

                    ASSIGN con-fld-name = new-obj.for-name.             
                    IF INDEX(idxline, "(") = 0 THEN
                        ASSIGN idxline = idxline + "(" + new-obj.for-name.
                    ELSE
                        ASSIGN idxline = idxline + ", " + new-obj.for-name.  
                 END.
              END.
              ELSE DO:
                 ASSIGN con-fld-name = new-obj.for-name.         
                 IF INDEX(idxline, "(") = 0 THEN
                    ASSIGN idxline = idxline + "(" + new-obj.for-name.
                 ELSE
                    ASSIGN idxline = idxline + ", " + new-obj.for-name.
              END.
              IF ilin[3] BEGINS "DESC"  THEN
                 ASSIGN idxline = idxline + " DESC".
           END. 

      END.  /* end of new-obj */ 
                       
    END. /* Not available field */
  END. /* End of available file */
  ELSE DO:  /* Dealing with new table */
    FIND FIRST new-obj WHERE new-obj.add-type = "F"
                   AND new-obj.tbl-name = tablename
                   AND new-obj.prg-name = ilin[2]
                               NO-ERROR.                     
    IF AVAILABLE new-obj THEN DO:
      IF SUBSTRING(new-obj.for-type,2,7) = "VARCHAR" OR SUBSTRING(new-obj.for-type,2,8) = "NVARCHAR" THEN DO:
        IF NOT shadowcol THEN DO:
          ASSIGN con-fld-name = new-obj.for-name.           
          IF INDEX(idxline, "(") = 0 THEN
            ASSIGN idxline = idxline + "(" + new-obj.for-name.
          ELSE
            ASSIGN idxline = idxline + ", " + new-obj.for-name.          
        END.
        ELSE DO:
          RUN new-obj-idx.
          ASSIGN con-fld-name = new-obj.for-name.             
          IF INDEX(idxline, "(") = 0 THEN
            ASSIGN idxline = idxline + "(" + new-obj.for-name.
          ELSE
            ASSIGN idxline = idxline + ", " + new-obj.for-name.  
        END.
      END.
      ELSE DO:
        ASSIGN con-fld-name = new-obj.for-name.         
        IF INDEX(idxline, "(") = 0 THEN
          ASSIGN idxline = idxline + "(" + new-obj.for-name.
        ELSE
          ASSIGN idxline = idxline + ", " + new-obj.for-name.
      END.
      IF ilin[3] BEGINS "DESC"  THEN
              ASSIGN idxline = idxline + " DESC".
    END. 
  END.
  IF conline = ? THEN DO:
  CREATE df-info.
  ASSIGN df-info.df-seq = dfseq
         dfseq = dfseq + 1
         df-info.df-tbl = tablename
         df-line = "  " + ilin[1] + ' "' + ilin[2] + '" '.  
  DO j = 3 TO 5:
    IF ilin[j] <> ? THEN     
      ASSIGN df-info.df-line = df-info.df-line + ilin[j] + " ".
    ELSE 
      ASSIGN j = 6. 
  END. 
  
    CREATE  con-index.
    ASSIGN  con-table = tablename
            idx-name  = idxname
            idx-fld-name = con-fld-name
            fidx-name = forname.                                                              
  END.
END PROCEDURE.

PROCEDURE create-con-field:
  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  IF NOT AVAILABLE DICTDB._FILE THEN DO:               
    FIND rename-obj WHERE rename-type = "T"   
                      AND new-name = tablename
                      NO-ERROR.
    IF AVAILABLE rename-obj THEN 
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.            
  END.        

  IF AVAILABLE DICTDB._File THEN DO:        
    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = conidx NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN DO:               
      FIND rename-obj WHERE rename-type = "I"
                      AND t-name = tablename   
                      AND new-name = conidx
                      NO-ERROR.
      IF AVAILABLE rename-obj THEN 
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.            
    END.        
    IF AVAILABLE DICTDB._Index THEN DO:
      FOR EACH DICTDB._Index-Field OF DICTDB._Index:
        FIND DICTDB._Field OF DICTDB._Index-Field NO-ERROR.
        IF AVAILABLE DICTDB._Field THEN DO:
               IF INDEX(conline, "(") = 0 THEN
                   conline = conline + "(" + DICTDB._Field._For-Name.
               ELSE
                   conline = conline + ", " + DICTDB._Field._For-Name.           
        END.                          
      END.
    END.  
    ELSE DO:
     FIND FIRST new-obj WHERE new-obj.add-type = "I"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.prg-name = conidx
                                        NO-ERROR.
       IF AVAILABLE new-obj THEN DO:
           FOR EACH con-index WHERE con-table = tablename AND idx-name = conidx:    
               IF INDEX(conline, "(") = 0 THEN
                   conline = conline + "(" + idx-fld-name.
               ELSE
                   conline = conline + ", " + idx-fld-name.              
           END.                                 
       END. 
       ELSE DO:
         IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "Parent index for the Foreign constraint is not available.".
          &ELSE
              MESSAGE "Parent index for the Foreign constraint is not available " VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
         END.
	 ELSE
              PUT STREAM logfile UNFORMATTED "Parent index for the Foreign constraint is not available." skip(1).
       END.
    END.
  END.
  ELSE DO:
     FIND FIRST new-obj WHERE new-obj.add-type = "I"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.prg-name = conidx
                                        NO-ERROR.
       IF AVAILABLE new-obj THEN DO:
           FOR EACH con-index WHERE con-table = tablename AND idx-name = conidx:    
               IF INDEX(conline, "(") = 0 THEN
                   conline = conline + "(" + idx-fld-name.
               ELSE
                   conline = conline + ", " + idx-fld-name.              
           END.                                 
       END. 
       ELSE DO:
        IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "Parent index for the Foreign constraint is not available.".
          &ELSE
              MESSAGE "Parent index for the Foreign constraint is not available " VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
         END.
	 ELSE
	 PUT STREAM logfile UNFORMATTED "Parent index for the Foreign constraint is not available " SKIP.
       END.
   END. 
END PROCEDURE.

PROCEDURE create-for-con:
  ASSIGN tablename = par-tab.
  
  FIND DICTDB._File WHERE DICTDB._File._File-name = par-tab NO-ERROR.      
  IF AVAILABLE DICTDB._File THEN 
      ASSIGN conline = conline + ") REFERENCES " + DICTDB._File._For-owner + "." + DICTDB._File._For-name + "(".
  ELSE DO:
    FIND FIRST rename-obj WHERE rename-type = "T"
         AND rename-obj.new-name = par-tab
         NO-ERROR.
    IF AVAILABLE rename-obj THEN 
       ASSIGN conline = conline + ") REFERENCES " +  mss_username + "." + dsv-name + "(".
       FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.                      
  END.

  IF AVAILABLE DICTDB._File THEN DO:
    FIND DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC"
               OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "U" NO-ERROR.
    IF AVAILABLE DICTDB._Constraint THEN DO:
            FIND DICTDB._Index OF DICTDB._Constraint WHERE DICTDB._Index._Index-Name = par-index  NO-ERROR.
            IF AVAILABLE DICTDB._Index THEN DO:
               ASSIGN conidx = DICTDB._Index._Index-Name.               
               RUN create-con-field.
            END.   
    END.
    
    ELSE DO:
           FIND FIRST new-obj WHERE new-obj.add-type = "C"
                      AND new-obj.tbl-name = par-tab
                      NO-ERROR.  
           IF AVAILABLE new-obj THEN DO:
              FIND con-type WHERE con-type.con-tab = par-tab AND con-type.idx-nam = par-index
                            AND  (con-type.type = "P" OR con-type.type = "U") NO-ERROR.
               IF AVAILABLE con-type THEN DO:
                  ASSIGN conidx = con-type.idx-nam.
                  RUN create-con-field.      
               END.               
           END.            
           ELSE DO:
            IF NOT batch_mode THEN DO:
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                  MESSAGE "parent table does not have a primary constraint. ".
              &ELSE
                  MESSAGE "parent table does not have a primary constraint " view-as alert-box.
             &ENDIF.
            END.
	    ELSE DO:
              PUT STREAM logfile UNFORMATTED "parent table does not have a primary constraint. ".
              RETURN.
            END.
           END.
    END.   
  
  END.
  ELSE DO:
           FIND FIRST new-obj WHERE new-obj.add-type = "T"
                     AND new-obj.tbl-name = par-tab
                      NO-ERROR.
           IF AVAILABLE new-obj THEN
               ASSIGN conline = conline + ") REFERENCES " +  mss_username + "." + new-obj.for-name + "(". 

           FIND FIRST new-obj WHERE new-obj.add-type = "C"
                      AND new-obj.tbl-name = par-tab
                      NO-ERROR.  
           IF AVAILABLE new-obj THEN DO:
              FIND con-type WHERE con-type.con-tab = par-tab AND con-type.idx-nam = par-index
                            AND  (con-type.type = "P" OR con-type.type = "U") NO-ERROR.
               IF AVAILABLE con-type THEN DO:
                  ASSIGN conidx = con-type.idx-nam.
                  RUN create-con-field.      
               END.               
           END.            
           ELSE DO:
	     IF NOT batch_mode THEN DO:
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                  MESSAGE "parent table does not have a primary constraint. ".
              &ELSE
                  MESSAGE "parent table does not have a primary constraint " view-as alert-box.
             &ENDIF.
             END.
             ELSE 
                  PUT STREAM logfile UNFORMATTED "parent table does not have a primary constraint. ".
	   END.
  END.
  assign conline1 = substring(conline, 1, index(conline,"REFERENCES") + 10).
  assign conline2 = substring(conline, index(conline,"REFERENCES") + 11, -1).
  pos-comma = index(conline2,",").
  assign conline = conline1 + " " + substring(conline2, 1, pos-comma - 1) + substring(conline2,pos-comma + 2, -1).  
END PROCEDURE.

PROCEDURE process-sql-width.
  DEFINE INPUT PARAMETER ptablename AS CHAR NO-UNDO.
  DEFINE INPUT PARAMETER pfieldname AS CHAR NO-UNDO.
  DEFINE INPUT PARAMETER pValue     AS INT  NO-UNDO.

  DEFINE VARIABLE iValue            AS INT       NO-UNDO.
  DEFINE VARIABLE cWidth            AS CHARACTER NO-UNDO.
  DEFINE VARIABLE defInfo           AS CHARACTER NO-UNDO.
  DEFINE VARIABLE defInfoOff        AS INTEGER   NO-UNDO.
  DEFINE VARIABLE has_default_in_field_name AS LOGICAL   NO-UNDO.

  if pfieldname matches "*default_*" or pfieldname matches "*_default*" then
     assign has_default_in_field_name = TRUE.

  FIND FIRST new-obj WHERE new-obj.add-type = "F"
                 AND new-obj.tbl-name = ptablename
                 AND new-obj.fld-name = pfieldname
                 NO-LOCK NO-ERROR. 

  IF NOT AVAILABLE new-obj
     OR new-obj.for-type = " UNSUPPORTED" THEN RETURN.

  /* save it away if not set */
  IF new-obj.iMaxWidth = 0 THEN
     new-obj.iMaxWidth = pValue.

  IF (new-obj.for-type BEGINS " VARCHAR" OR
      new-obj.for-type BEGINS " NVARCHAR" OR
      new-obj.for-type BEGINS " DECIMAL") AND
     (new-obj.for-type <> " VARCHAR(MAX)" AND
      new-obj.for-type <> " NVARCHAR(MAX)") THEN DO:

    /* this is the width value for the column size */
    ASSIGN iValue = pValue.

    /* if field has extents, take that into account */
    IF new-obj.iExtents > 0 THEN
       ASSIGN iValue = ((iValue - (new-obj.iExtents * 2)) / new-obj.iExtents).

    IF SUBSTRING(new-obj.for-type,1,8) = " DECIMAL" THEN DO:
        IF iValue > 28 THEN
           ASSIGN iValue = 28.
    END.
    /* expand length - unicode support */
    ELSE IF user_env[35] = "y" THEN
       ASSIGN iValue = iValue * 2.

    ASSIGN cWidth = STRING(iValue).

    FIND df-info WHERE df-info.df-tbl = ptablename
                   AND df-info.df-fld = pfieldname
                   AND df-info.df-line BEGINS "  FORMAT".

    IF alt-table THEN DO:               
      /* there may be more than one if this is for an extent field */
      FOR EACH alt-info WHERE a-tblname = ptablename
                      AND a-fldname = pfieldname 
                      AND NOT a-line BEGINS "ALTER":

        IF has_default_in_field_name EQ FALSE and INDEX(alt-info.a-line,"DEFAULT") <> 0 THEN
           ASSIGN defInfoOff = INDEX(alt-info.a-line,"DEFAULT")
               defInfo = SUBSTRING(alt-info.a-line, defInfoOff).
        ELSE
           ASSIGN defInfo = "".

        IF new-obj.for-type BEGINS " VARCHAR" OR new-obj.for-type BEGINS " NVARCHAR" THEN DO:  
          IF iValue < varlngth THEN
            ASSIGN new-obj.for-type = /*" VARCHAR("*/ " " + user_env[11] + "(" + cWidth + ")"
                   alt-info.a-line = ENTRY(1,alt-info.a-line, " ") /* the field name */
                                     + /*" VARCHAR("*/ " " + user_env[11] 
                                     + "(" + cWidth + ") " + defInfo
                   df-info.df-line = "  FORMAT " + '"x(' + cWidth + ')"'.
          ELSE DO: 
            ASSIGN new-obj.for-type = /*" TEXT"*/ " " + user_env[18]
                   alt-info.a-line = ENTRY(1,alt-info.a-line, " ") /* the field name */
                                     + /*" TEXT"*/ " " + user_env[18].

            /* There is no format statement for a text */
            IF AVAILABLE df-info THEN
               DELETE df-info.
          END.                        
        END.
        ELSE DO:
          ASSIGN left_paren = INDEX(alt-info.a-line, "(")
                 right_paren = INDEX(alt-info.a-line, ")")
                 j = INDEX(alt-info.a-line, ",").

          ASSIGN new-obj.for-type = " DECIMAL (" + cWidth + ","
                                    + SUBSTRING(alt-info.a-line, j + 1, right_paren - j)
                 alt-info.a-line = ENTRY(1,alt-info.a-line, " ") /* the field name */
                                   + " DECIMAL (" + cWidth + ","
                                   + SUBSTRING(alt-info.a-line, j + 1, right_paren - j) + " " + defInfo.
        END.                    
      END.
    END.
    ELSE DO:
      /* there may be more than one if this is for an extent field */
      FOR EACH sql-info WHERE tblname = ptablename
                      AND fldname = pfieldname 
                      AND LINE BEGINS pfieldname:
      
        IF has_default_in_field_name EQ FALSE and INDEX(line,"DEFAULT") <> 0 THEN 
            ASSIGN defInfoOff = INDEX(sql-info.line,"DEFAULT")
                   defInfo = SUBSTRING(sql-info.line, defInfoOff).
          ELSE
            ASSIGN defInfo = "".

        IF new-obj.for-type BEGINS " VARCHAR" OR new-obj.for-type BEGINS " NVARCHAR" THEN DO:    
          IF iValue < varlngth THEN
            ASSIGN new-obj.for-type = /*" VARCHAR("*/ " " + user_env[11] + "(" + cWidth + ")"
                   sql-info.line = ENTRY(1,sql-info.line, " ") /* the field name */
                                   + /*" VARCHAR("*/ " " + user_env[11] 
                                   + "(" + cWidth + ") " + defInfo
                   df-info.df-line = "  FORMAT " + '"x(' + cWidth + ')"'.
          ELSE DO:                      
            ASSIGN new-obj.for-type = /*" TEXT"*/ " " + user_env[18]
                   sql-info.line = ENTRY(1,sql-info.line, " ") /* the field name */
                                   + /*" TEXT"*/  " " + user_env[18].

            /* There is no format statement for a text */
            IF AVAILABLE df-info THEN
               DELETE df-info.                       
          END.                        
        END.                    
        ELSE DO:
          ASSIGN left_paren = INDEX(sql-info.line, "(")
                 right_paren = INDEX(sql-info.line, ")")
                 j = INDEX(sql-info.line, ",").
          ASSIGN new-obj.for-type = " DECIMAL (" + cWidth + ","
                                    + SUBSTRING(LINE, j + 1, right_paren - j)
                 sql-info.line = ENTRY(1,sql-info.line, " ") /* the field name */
                                 + " DECIMAL (" + cWidth + ","
                                 + SUBSTRING(LINE, j + 1, right_paren - j) + " " + defInfo.
        END.
      END.
    END.

    /* now fix up the info related to the column length */
    FIND df-info WHERE df-info.df-tbl = ptablename
                   AND df-info.df-fld = pfieldname
                   AND df-info.df-line BEGINS "  FIELD-MISC13".
    ASSIGN df-info.df-line = "  FIELD-MISC13 " + cWidth.
    FIND df-info WHERE df-info.df-tbl = ptablename
                   AND df-info.df-fld = pfieldname
                   AND df-info.df-line BEGINS "  FOREIGN-MAXIMUM".
    ASSIGN df-info.df-line = "  FOREIGN-MAXIMUM " + cWidth.                  
    FIND df-info WHERE df-info.df-tbl = ptablename
                   AND df-info.df-fld = pfieldname
                   AND df-info.df-line BEGINS "  DSRVR-PRECISION " NO-ERROR.
    IF AVAILABLE df-info THEN
       ASSIGN df-info.df-line = "  DSRVR-PRECISION " + cWidth.                  
  END.                

END.


/*======================== Mainline =================================== */   

IF OS-GETENV("BLANKDEFAULT") <> ? THEN
  tmp_str   = OS-GETENV("BLANKDEFAULT").
IF tmp_str BEGINS "Y" THEN
  ASSIGN blankdefault = TRUE.

IF OS-GETENV("_USE_OE_CHAR_DFLT_INIT") BEGINS "Y" THEN
  ASSIGN useoedflt = TRUE.

ASSIGN ilin = ?
       ipos = 0
       dfout = osh_dbname + ".df"
       sqlout = mss_dbname + ".sql"
       idbtyp = (IF user_env[32] = ? THEN user_env[22] ELSE user_env[32])
       xlate  = (user_env[8] BEGINS "y")
       minwidth = 30
       varlngth = INTEGER(user_env[10]) + 1
       /* OE00167691 - the foreign type in the df for TEXT is not TEXT */
       dfLongType = (IF user_env[18] = "TEXT" THEN "LONGVARCHAR" ELSE "NLONGVARCHAR").  

IF NUM-ENTRIES(user_env[27]) > 1 AND entry(2,user_env[27]) EQ "2" THEN
    useComputedColumn = YES.

/* for new sequence generator support. If it's set, it will be the
   second entry
*/
IF NUM-ENTRIES(user_env[25]) > 1 AND 
   ENTRY(2,user_env[25]) BEGINS "Y" THEN
   ASSIGN lnewSeq = TRUE
          seqt_prefix = "_SEQT_REV_"
          seqp_prefix = "_SEQP_REV_".  
	  
OUTPUT STREAM todf TO VALUE(dfout) NO-ECHO NO-MAP.
OUTPUT STREAM tosql TO VALUE(sqlout) NO-ECHO NO-MAP.

INPUT FROM VALUE(user_env[1]).              

IF NOT batch_mode THEN
 ASSIGN SESSION:IMMEDIATE-DISPLAY = yes.

RUN adecomm/_setcurs.p ("WAIT").

/* find out if source db supports large sequences */
FIND FIRST _Db WHERE _db._db-name = ?.
IF _DB._Db-res1[1] = 1 THEN
   large_seq = YES.

FIND FIRST _Db WHERE _db._db-name = mss_dbname NO-ERROR.
IF AVAILABLE(_Db) THEN DO:
    ASSIGN dbrecid = RECID(_Db)
           qualname = _Db._Db-addr.

  /* Unicode types is only supported for MS SQL Server 2005 and up */
  IF unicodeTypes THEN DO:
      IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(_Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) < 9 THEN DO:
	 IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "Unicode support for the DataServer for MS SQL Server was designed to work" SKIP
                 "with Versions 2005 and above. Do not use the 'Unicode Types' option." SKIP
          &ELSE
             MESSAGE "Unicode support for the DataServer for MS SQL Server was designed to work" SKIP
                 "with Versions 2005 and above. Do not use the 'Unicode Types' option." SKIP
                 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          &ENDIF.
        END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "Unicode support for the DataServer for MS SQL Server was designed to work" SKIP
                 "with Versions 2005 and above. Do not use the 'Unicode Types' option." SKIP.

         OUTPUT STREAM todf CLOSE.
         OUTPUT STREAM tosql CLOSE.

         RUN adecomm/_setcurs.p ("").

         RETURN.
      END.
  END.
  assign bug7  = can-do(_Db._Db-misc2[4], "7")
         quote = SUBSTRING(_Db._Db-misc2[3],2,1, "character")
         quote = ( if (quote = " " OR bug7)
                then ""
                else quote
          ).
  IF ( _Db._db-misc2[1] BEGINS "SQLNCLI") THEN 
      ASSIGN isSQLNCLI = YES.

  IF NOT mapMSSDatetime THEN DO:
      IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(_Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) < 10 THEN DO:
         IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "You selected 'Use Newer Datetime Types' but the version stored in the schema holder is" SKIP
                 "for a version earlier than MSS 2008. Do not use that option." SKIP.
          &ELSE
             MESSAGE "You selected 'Use Newer Datetime Types' but the version stored in the schema holder is" SKIP
                 "for a version earlier than MSS 2008. Do not use that option." SKIP
                 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          &ENDIF.
       END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "You selected 'Use Newer Datetime Types' but the version stored in the schema holder is" SKIP
                 "for a version earlier than MSS 2008. Do not use that option." SKIP.

         OUTPUT STREAM todf CLOSE.
         OUTPUT STREAM tosql CLOSE.

         RUN adecomm/_setcurs.p ("").

         RETURN.
      END.

      IF (NOT isSQLNCLI) OR INTEGER(ENTRY(1,_Db._db-misc2[2],".")) < 10 THEN DO:
          IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "You selected 'Use Newer Datetime Types' but the ODBC driver does not support" SKIP
                  "those types. Do not use that option." SKIP.
          &ELSE
             MESSAGE "You selected 'Use Newer Datetime Types' but the ODBC driver does not support" SKIP
                  "those types. Do not use that option." SKIP
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          &ENDIF.
       END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "You selected 'Use Newer Datetime Types' but the ODBC driver does not support" SKIP
                  "those types. Do not use that option." SKIP.

          OUTPUT STREAM todf CLOSE.
          OUTPUT STREAM tosql CLOSE.

          RUN adecomm/_setcurs.p ("").

          RETURN.
      END.
  END.
  
END.

/* 20061005-002
   The qualifier name may not be the same as the dsn name, which is what
   is stored in _Db._Db-addr. Search all tables in the schema holder for the
   current schema and check if the name is different.
*/

ASSIGN imod = ?.
/* look only on the current schema */
FIND FIRST DICTDB._Db WHERE DICTDB._Db._Db-name = mss_dbname NO-ERROR.
IF AVAILABLE DICTDB._Db THEN DO:
    search_loop:
    FOR EACH DICTDB._File OF DICTDB._Db WHERE DICTDB._File._Owner = "_FOREIGN" 
        AND DICTDB._File._Fil-misc2[1] NE ? AND 
        DICTDB._File._Fil-misc2[1] NE qualname NO-LOCK:
    
        /* the first one, remember it */
        IF imod = ? THEN
            ASSIGN imod = DICTDB._File._Fil-misc2[1].
        ELSE IF imod NE DICTDB._File._Fil-misc2[1] THEN DO:
            /* if we found some other value, then this schema must have
               tables from different databases, so we can't pick any,
               leave the value already assigned above.
            */
            ASSIGN imod = ?.
            LEAVE search_loop.
        END.
    END.
    
    IF imod NE ? THEN
        ASSIGN qualname = imod
               imod = ?.
END.

DO ON STOP UNDO, LEAVE:
    /* when IMPORT hits the end, it generates ENDKEY.  This is how loop ends */
  load_loop:
  REPEAT ON ERROR UNDO,RETRY ON ENDKEY UNDO, LEAVE:
       /* Pop the top token off the top and move all the other tokens up one 
         so that ilin[1] is the next token to process.
       */
    ASSIGN ilin = ?.
    IMPORT ilin.

    IF ilin[1] = ? THEN NEXT.    
    ASSIGN inum = 3.
        /* set the action mode */
    CASE ilin[1]:
      WHEN "ADD":u    OR WHEN "CREATE":u OR WHEN "NEW":u  THEN imod = "a":u.
      WHEN "UPDATE":u OR WHEN "MODIFY":u OR WHEN "ALTER":u OR 
                                          WHEN "CHANGE":u THEN imod = "m":u.
      WHEN "DELETE":u OR WHEN "DROP":u OR WHEN "REMOVE":u THEN imod = "d":u.
      WHEN "RENAME":u                                     THEN imod = "r":u.
    END CASE.

    IF ilin[1] = "ADD"    OR ilin[1] = "CREATE" OR ilin[1] = "NEW"    OR
       ilin[1] = "UPDATE" OR ilin[1] = "MODIFY" OR ilin[1] = "ALTER" OR 
       ilin[1] = "CHANGE" OR ilin[1] = "DELETE" OR ilin[1] = "DROP" OR 
       ilin[1] = "REMOVE" OR ilin[1] = "RENAME" THEN DO:
        /* set the object type */
      CASE ilin[2]:
        WHEN "DATABASE":u OR WHEN "CONNECT":u THEN iobj = "d":u.
        WHEN "FILE":u     OR WHEN "TABLE":u   THEN ASSIGN iobj = "t":u.                  
        WHEN "FIELD":u    OR WHEN "COLUMN":u THEN ASSIGN iobj = "f":u.        
        WHEN "INDEX":u    OR WHEN "KEY":u THEN ASSIGN iobj = "i":u.                      
        WHEN "SEQUENCE":u                 THEN ASSIGN iobj = "s":u.
        WHEN "CONSTRAINT":u                 THEN ASSIGN iobj = "c":u.                
      END CASE.
    END.
    /* This code is here only for when the index syntax is
        ADD/UPDATE [UNIQUE] [PRIMARY] [INACTIVE] INDEX name 
    */

    IF ilin[1] = "UPDATE" AND
       (ilin[2] <> "DATABASE" AND
        ilin[2] <> "FILE" AND
        ilin[2] <> "FIELD" AND
        ilin[2] <> "INDEX") THEN DO:
      IF CAN-DO("INDEX,KEY":u,ilin[3]) THEN 
        ASSIGN iobj    = "i":u.             
      ELSE IF CAN-DO("INDEX,KEY",ilin[4]) THEN
        ASSIGN iobj    = "i".          
      ELSE IF CAN-DO("INDEX,KEY",ilin[5]) THEN
        ASSIGN iobj    = "i".             
    END.
    
    IF iobj = "d"  or startdf THEN DO: 
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "UPDATE DATABASE " + '"' + mss_dbname + '"'. 
      ASSIGN startdf = FALSE.
    END.  
          
    IF iobj = "t" THEN DO:
      IF imod = "d" THEN DO:
        IF tablename <> ? AND tablename <> ilin[3] THEN 
          RUN write-tbl-sql.            
                         
       IF idxline <> ? THEN 
          RUN write-idx-sql.

       IF seq-line <> ? THEN
          RUN write-seq-sql.

        IF conline <> ? THEN
          RUN write-con-sql.
          
       IF tablename <> ilin[3] THEN
         ASSIGN tablename = ilin[3]
                 comment_chars = ""
                 comment-out = FALSE.
      IF NOT batch_mode THEN DO:
        IF tablename <> ? THEN                             
          DISPLAY tablename WITH FRAME working.
      END.
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[3]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
        IF AVAILABLE DICTDB._File THEN DO:
          PUT STREAM tosql UNFORMATTED comment_chars "DROP TABLE " DICTDB._File._For-name SKIP.
          PUT STREAM tosql UNFORMATTED  user_env[5] SKIP(1).
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = DICTDB._File._File-name
                 df-line = "DROP TABLE " + '"' + DICTDB._File._File-name + '"'.
        END.
        ELSE DO:
	IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains DROP TABLE " ilin[3]  SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
          &ELSE
            MESSAGE "The Delta DF File contains DROP TABLE " ilin[3]  SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
       END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP TABLE " ilin[3]  SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
          RETURN.
        END.
        ASSIGN ilin = ?.
      END. /* End delete table */

      /* Rename table */
      ELSE IF imod = "r" THEN DO:
        IF tablename <> ? AND tablename <> ilin[5] THEN 
          Run write-tbl-sql.                      
        
        IF idxline <> ? THEN 
          RUN write-idx-sql.
        
        IF seq-line <> ? THEN
          RUN write-seq-sql. 

        IF conline <> ? THEN
          RUN write-con-sql.
          
        IF tablename <> ilin[5] THEN
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE.
       IF NOT batch_mode THEN DO:
        IF tablename <> ? THEN                              
          DISPLAY tablename WITH FRAME working.       
       END.
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[3]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
 
        IF AVAILABLE DICTDB._File THEN DO:     
          ASSIGN idx-number = 0.
          FOR EACH DICTDB._Index OF DICTDB._File:
            IF idx-number < DICTDB._Index._Idx-num THEN
              ASSIGN idx-number = DICTDB._Index._Idx-num.
          END.
          ASSIGN idx-number = idx-number + 1.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = ilin[5]
                 df-line = "RENAME TABLE " + '"' + DICTDB._File._File-name + '" TO "' + ilin[5] + '"'.          
          
          CREATE rename-obj.
          ASSIGN rename-type = "T"
                 t-name = ilin[5]
                 old-name = DICTDB._File._File-name
                 new-name = ilin[5].
                  
          IF LENGTH(DICTDB._File._For-name) > 4 AND SUBSTRING(DICTDB._File._For-name, (LENGTH(DICTDB._File._For-name) - 4)) <> "_V##" THEN
            ASSIGN dsv-name = DICTDB._File._For-name.
          ELSE 
              ASSIGN dsv-name = SUBSTRING(DICTDB._File._For-name, 1,(LENGTH(DICTDB._File._For-name) -  4)).                   
        END.
        ELSE DO:
	IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains RENAME TABLE" ilin[3] SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
          &ELSE
              MESSAGE "The Delta DF File contains RENAME TABLE" ilin[3] SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
       END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "The Delta DF File contains RENAME TABLE" ilin[3] SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
          RETURN.
        END.
        ASSIGN ilin = ?. 
      END. /* End Rename Table */
      
      /* Add new table */
      ELSE IF imod = "a" THEN DO:  
        IF ilin[1] = "ADD" AND ilin[2] = "TABLE" THEN DO: 
          RUN write-tbl-sql.
          
          IF idxline <> ? THEN 
             RUN write-idx-sql.

          IF seq-line <> ? THEN
            RUN write-seq-sql.
         
          IF conline <> ? THEN
            RUN write-con-sql.
          
          ASSIGN addtable = TRUE
                 tablename = ilin[3]
                 fldnum = 0
                 idx-number = 1
                 comment_chars = ""
                 comment-out = FALSE
                 misc11 = TRUE.
                                                                                        
          FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = tablename
                                    AND DICTDB._File._Owner = "_FOREIGN"
                                    NO-LOCK NO-ERROR.
          IF AVAILABLE DICTDB._File THEN DO:
	  IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains ADD TABLE" ilin[3] SKIP
                  "and table already exists in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
          &ELSE
             MESSAGE "The Delta DF File contains ADD TABLE" ilin[3] SKIP
                  "and table already exists in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
          END. 
          ELSE
	  PUT STREAM logfile UNFORMATTED  "The Delta DF File contains ADD TABLE" ilin[3] SKIP
                  "and table already exists in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
            RETURN.
          END.

          IF xlate THEN DO:       
            ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
          END.
          ELSE IF LENGTH(ilin[3]) > INTEGER(user_env[29]) THEN DO:   
            ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
          END.
          ELSE
            ASSIGN forname = ilin[3].
 
          _verify-table:
          DO WHILE TRUE:

            FIND FIRST verify-table WHERE verify-table.tnew-name = forname NO-ERROR.
            FIND FIRST DICTDB._File WHERE CAPS(DICTDB._File._For-name) = CAPS(forname) NO-ERROR.
            
            IF AVAILABLE verify-table OR AVAILABLE DICTDB._File THEN DO:
              DO a = 1 TO 999:
                IF a = 1 THEN
                  ASSIGN forname = forname + STRING(a).
                ELSE
                  ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - LENGTH(STRING(a))) + STRING(a). 
                IF CAN-FIND(FIRST DICTDB._File WHERE DICTDB._File._For-name = forname) THEN NEXT.
                ELSE IF CAN-FIND(FIRST verify-table WHERE verify-table.tnew-name = forname) THEN NEXT.
                ELSE DO:
                  CREATE verify-table.
                  ASSIGN verify-table.tnew-name = forname.
                  LEAVE _verify-table.
                END.
              END.
            END.                
            ELSE DO:
              CREATE verify-table.
              ASSIGN verify-table.tnew-name = forname.
              LEAVE _verify-table.
            END.
          END.

          RUN create-new-obj (INPUT "T", INPUT ?).
	  IF NOT batch_mode THEN DO:
           IF tablename <> ? THEN    
            DISPLAY tablename WITH FRAME working.   
	  END.
          IF pcompatible THEN DO: 
            IF NOT useComputedColumn THEN DO:
              CREATE sql-info.
              ASSIGN line-num = 5000
                   line = "PROGRESS_RECID BIGINT NULL"  
                   tblname = ilin[3]
                   fldname = "PROGRESS_RECID".     
            END.          
            ELSE DO:
              CREATE sql-info.
              ASSIGN line-num = 5000
                   line = "PROGRESS_RECID AS CASE WHEN PROGRESS_RECID_ALT_ IS NULL THEN  PROGRESS_RECID_IDENT_ ELSE  PROGRESS_RECID_ALT_ END PERSISTED NOT NULL"  
                   tblname = ilin[3]
                   fldname = "PROGRESS_RECID".     
            END.          

            CREATE sql-info.
            ASSIGN line-num = 5001
                 line = "PROGRESS_RECID_IDENT_ BIGINT identity"  
                 tblname = ilin[3]
                 fldname = "PROGRESS_RECID_INDENT".

            IF useComputedColumn THEN DO:
              CREATE sql-info.
              ASSIGN line-num = 5002
                   line = "PROGRESS_RECID_ALT_ BIGINT NULL DEFAULT NULL"  
                   tblname = ilin[3]
                   fldname = "PROGRESS_RECID_ALT".

              CREATE sql-info.
              ASSIGN line-num = 5003
                   line = " CONSTRAINT " + forname + "#_#progress_recid UNIQUE (PROGRESS_RECID) " 
                   tblname = ilin[3].
/*                   fldname = "PROGRESS_RECID_".*/
            END.

          END.          
            
          CREATE sql-info.
          ASSIGN line-num = -8
                 line = "if (select name from sysobjects where name = '" + forname + "'"
                 tblname = ilin[3].
            
          CREATE sql-info.
          ASSIGN line-num = -7
                 line = "and type = 'U' and uid = (select uid from sysusers " 
                 tblname = ilin[3].

          CREATE sql-info.
          ASSIGN line-num = -6
                 line = "where sid = (select sid from master.dbo.syslogins " 
                 tblname = ilin[3].

          CREATE sql-info.
          ASSIGN line-num = -5
                 line = "where UPPER(name) = UPPER('" + mss_username + "'))))"
                 tblname = ilin[3].
          CREATE sql-info.
          ASSIGN line-num = -4
                 line = "is not NULL drop table " + forname 
                 tblname = ilin[3].
          CREATE sql-info.
          ASSIGN line-num = -3
                 line = "go" 
                 tblname = ilin[3].
          CREATE sql-info.
          ASSIGN line-num = -2
                 line = " " 
                 tblname = ilin[3].

          CREATE sql-info.
          ASSIGN lnum = 1 
                 line-num = lnum
                 line = 'CREATE TABLE ' + mss_username + '.' + forname +  ' ('
                 tblname = ilin[3].
                
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = '  FOREIGN-NAME "' + LOWER(forname) + '"'.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = '  FOREIGN-TYPE "TABLE" '.
          IF mss_username <> "" THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line = '  FOREIGN-OWNER "' + LOWER(mss_username) + '"'.
          END.
        END.
        ELSE DO:          
          CASE ilin[1]:
            WHEN "AREA" THEN . /* Don't assign the Area it will default to 6 */
            WHEN "CAN-INSERT" OR WHEN "CAN-READ" OR WHEN "CAN-WRITE" OR
            WHEN "CAN-UPDATE" OR WHEN "CAN-DELETE" OR WHEN "CAN-DUMP" OR
            WHEN "CAN-LOAD" OR WHEN "CAN-SELECT" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "LABEL" OR WHEN "LABEL-SA" OR WHEN "DESCRIPTION" OR WHEN "VALEXP" OR
            WHEN "VALMSG" OR WHEN "VALMSG-SA" THEN DO:
              RUN dctquot (ilin[2], '"',OUTPUT oq-string).
              IF LENGTH(oq-string) > 0 THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = "  " + ilin[1] + " " + oq-string.
              END.
            END.
 
            WHEN "FROZEN" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "HIDDEN" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "DUMP-NAME" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "FILE-TRIGGER" OR WHEN "TABLE-TRIGGER" THEN DO:             
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                              ilin[3] + " ". 
             IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].            
             IF ilin[5] <> ? THEN 
                 ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.             
             IF ilin[6] <> ? THEN 
                 ASSIGN df-line = df-line + ilin[6].            
             IF ilin[7] <> ? THEN
                 ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
            END.
          END CASE. 
        END.
        ASSIGN ilin = ?.
      END. /* End Add Table section */
      
      /* Update or modify table attributes are for df only */
      ELSE DO: 
        IF ilin[1] = "UPDATE" THEN DO: 
          IF tablename <> ? AND tablename <> ilin[3] THEN 
            RUN write-tbl-sql.                     
         
          FIND DICTDB._File where DICTDB._File._File-name = ilin[3] NO-ERROR.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            FIND rename-obj WHERE rename-type = "T"
                              AND new-name = ilin[3] NO-ERROR.
            IF AVAILABLE rename-obj THEN
              FIND DICTDB._File where DICTDB._File._File-name = old-name NO-ERROR.
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            /* see if it's a new table */
            FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[3] 
                                     AND new-obj.add-type = "T" NO-ERROR.

            IF NOT AVAILABLE new-obj THEN DO:
	       IF NOT batch_mode THEN DO:
                  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                     MESSAGE "The Delta DF File contains UPDATE TABLE" ilin[3] SKIP
                        "and table does not exist in the schema holder." SKIP
                        "This process is being aborted."  SKIP (1).
                  &ELSE
                     MESSAGE "The Delta DF File contains UPDATE TABLE" ilin[3] SKIP
                        "and table does not exist in the schema holder." SKIP
                        "This process is being aborted."  SKIP (1)
                        VIEW-AS ALERT-BOX ERROR.
                 &ENDIF.
                END. 
                ELSE
	           PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE TABLE" ilin[3] SKIP
                        "and table does not exist in the schema holder." SKIP
                        "This process is being aborted."  SKIP (1).
                RETURN.
            END.
          END.
          IF AVAILABLE DICTDB._File THEN DO:
            ASSIGN idx-number = 0.
            FOR EACH DICTDB._Index OF DICTDB._File:
              IF idx-number < DICTDB._Index._Idx-num THEN
                ASSIGN idx-number = DICTDB._Index._Idx-num.
            END.
            IF idx-number > 0 THEN
              ASSIGN idx-number = idx-number + 1.
          END.
          IF idxline <> ? THEN 
            RUN write-idx-sql.
          
          IF seq-line <> ? THEN
            RUN write-seq-sql.

          IF conline <> ? THEN
            RUN write-con-sql.
                    
          IF tablename <> ilin[3] THEN
            ASSIGN tablename = ilin[3]
                   comment_chars = ""
                   comment-out = FALSE.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '"'.
        END.  
        IF NOT batch_mode THEN DO:
         IF tablename <> ? THEN                             
          DISPLAY tablename WITH FRAME working.
        END.   
        CASE ilin[1]:
          WHEN "LABEL"  OR WHEN "LABEL-SA" OR WHEN "DESCRIPTION" OR
          WHEN "VALEXP" OR WHEN "VALMSG"   OR WHEN "VALMSG-SA"   OR
          WHEN "DUMP-NAME" THEN DO:            
            RUN dctquot (ilin[2], '"',OUTPUT oq-string).
            IF ilin[2] = ? THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + " ?".
            END.               
            ELSE IF LENGTH(oq-string) > 0 THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + " " + oq-string.
            END.
          END.
          WHEN "FROZEN"  OR WHEN "HIDDEN" THEN DO:
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-info.df-tbl = tablename
                  df-line = "  " + ilin[1].
          END.
          WHEN "FILE-TRIGGER" OR WHEN "TABLE-TRIGGER"  THEN DO:            
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                              ilin[3] + " ". 
             IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].             
             IF ilin[5] <> ? THEN 
                 ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.             
             IF ilin[6] <> ? THEN 
                 ASSIGN df-line = df-line + ilin[6].             
             IF ilin[7] <> ? THEN
                 ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
          END.
        END CASE. 
        ASSIGN ilin = ?.
      END.                                    
    END.  /* End TABLE Section */
    
    IF iobj = "f" THEN DO:               
                         
      IF imod = "d" THEN DO:
        IF tablename <> ? AND tablename <> ilin[5] THEN 
          RUN write-tbl-sql.                 
        
        IF idxline <> ? THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
      
        IF conline <> ? THEN
          RUN write-con-sql.
     
        IF tablename <> ilin[5] THEN
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE.
       IF NOT batch_mode THEN DO:
        IF tablename <> ? THEN  
          DISPLAY tablename WITH FRAME working.
       END.   
                
        FIND FIRST rename-obj WHERE rename-type = "T"
                                AND new-name = ilin[5]
                                NO-ERROR.
        IF NOT AVAILABLE rename-obj THEN
          FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                    AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
        ELSE FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = rename-obj.old-name
                                       AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
        IF NOT AVAILABLE DICTDB._File THEN DO:
	IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains DROP FIELD for table" ilin[5] SKIP
                   "and table does not exist in the schema holder." SKIP
                   "This process is being aborted."  SKIP (1).
          &ELSE
              MESSAGE "The Delta DF File contains DROP FIELD for table" ilin[5] SKIP
                   "and table does not exist in the schema holder." SKIP
                   "This process is being aborted."  SKIP (1)
                VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
       END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP FIELD for table" ilin[5] SKIP
                   "and table does not exist in the schema holder." SKIP
                   "This process is being aborted."  SKIP (1).
           RETURN.
        END.
        IF AVAILABLE DICTDB._File THEN DO:
          FIND FIRST rename-obj WHERE rename-type = "F"
                                  AND t-name = ilin[5]
                                  AND new-name = ilin[3]
                                  NO-ERROR.
          IF AVAILABLE rename-obj THEN
            FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name NO-ERROR.
          ELSE
            FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = ilin[3] NO-ERROR.
            
          IF NOT AVAILABLE DICTDB._Field THEN DO:
	   IF NOT batch_mode THEN DO:
             &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains DROP FIELD" ilin[3] "for table" SKIP
                    ilin[5] "and field does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
             &ELSE
              MESSAGE "The Delta DF File contains DROP FIELD" ilin[3] "for table" SKIP
                    ilin[5] "and field does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                VIEW-AS ALERT-BOX ERROR.
             &ENDIF.
           END. 
          ELSE
	    PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP FIELD" ilin[3] "for table" SKIP
                    ilin[5] "and field does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
            RETURN.
          END.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line =  ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                            ilin[4] + ' "' + ilin[5] + '"'.
       
          ASSIGN dropped-fld = TRUE.

          IF AVAILABLE DICTDB._Field THEN DO:
            IF DICTDB._Field._Extent = 0 THEN DO:
              /* Get the first 15 or less start of name */
              ASSIGN dftname = "DF__" + 
                               (IF LENGTH(DICTDB._File._For-name) < 9 THEN DICTDB._File._For-name 
                                ELSE SUBSTRING(DICTDB._File._For-name, 1, 9))
                     dftname = dftname + "__".
              /* Get part of column name and append to dftname */
              ASSIGN dftname = dftname + SUBSTRING(DICTDB._Field._For-name, 1, (20 - LENGTH(dftname))).

              /*Must drop the default constraint before the field can be dropped */
              PUT STREAM tosql UNFORMATTED comment_chars "DECLARE @Name varchar(50)" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "DECLARE def_cursor CURSOR FOR select name from sysobjects where parent_obj = "
                    " OBJECT_ID('" DICTDB._File._For-owner "." DICTDB._File._For-Name "')" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "and xtype = 'D'" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "and substring(name, 1," LENGTH(dftname) ") = '" dftname "'" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "OPEN def_cursor" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "FETCH NEXT FROM def_cursor INTO @Name" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "IF @@FETCH_STATUS = 0 BEGIN" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars " exec('Alter table " DICTDB._File._For-owner "." DICTDB._File._For-Name " drop constraint ' + @Name + '')" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "END" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "CLOSE def_cursor" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "DEALLOCATE def_cursor" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP.

              PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-owner "." DICTDB._File._For-name + 
                               " DROP COLUMN " + DICTDB._Field._For-name SKIP.

              IF _fld-misc2[5] <> ? THEN
              PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-owner "." DICTDB._File._For-name + 
                               " DROP COLUMN " + DICTDB._Field._fld-misc2[5] SKIP.

              PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
              CREATE drop-field.
              ASSIGN f-name = ilin[3]
                     of-table = ilin[5]
                     dropped-fld = TRUE.

              FIND FIRST rename-obj WHERE rename-type = "F"
                                      AND t-name = ilin[5]
                                      AND new-name = ilin[3]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN
                ASSIGN drop-f-name = old-name.
              ELSE                       
                ASSIGN drop-f-name = ilin[3].
            END.
            ELSE DO u = 1 TO DICTDB._Field._Extent:
              /* Get the first 15 or less start of name */
              ASSIGN dftname = "DF__" + 
                               (IF LENGTH(DICTDB._File._For-name) < 9 THEN DICTDB._File._For-name 
                                ELSE SUBSTRING(DICTDB._File._For-name, 1, 9))
                     dftname = dftname + "__".
              /* Get part of column name and append to dftname */
              ASSIGN dftname = dftname + SUBSTRING(DICTDB._Field._For-name, 1, (20 - LENGTH(dftname))).

              /*Must drop the default constraint before the field can be dropped */
              PUT STREAM tosql UNFORMATTED comment_chars "DECLARE @Name varchar(50)" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "DECLARE def_cursor CURSOR FOR select name from sysobjects where parent_obj = "
                    " OBJECT_ID('" DICTDB._File._For-owner "." DICTDB._File._For-Name "')" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "and xtype = 'D'" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "and substring(name, 1," LENGTH(dftname) ") = '" dftname "'" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "OPEN def_cursor" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "FETCH NEXT FROM def_cursor INTO @Name" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "IF @@FETCH_STATUS = 0 BEGIN" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars " exec('Alter table " DICTDB._File._For-owner "." DICTDB._File._For-Name " drop constraint ' + @Name + '')" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "END" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "CLOSE def_cursor" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "DEALLOCATE def_cursor" SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP.

              PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " DICTDB._File._For-owner "." DICTDB._File._For-Name  
                      " DROP COLUMN " DICTDB._Field._For-name "##" string(u) SKIP.  
              PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP.
              IF u = 1 THEN DO:
                CREATE drop-field.
                ASSIGN f-name = ilin[3]
                       of-table = ilin[5]
                       dropped-fld = TRUE.
           
                FIND FIRST rename-obj WHERE rename-type = "F"
                                        AND t-name = ilin[5]
                                        AND new-name = ilin[3]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN
                  ASSIGN drop-f-name = old-name.
                ELSE                       
                  ASSIGN drop-f-name = ilin[3].
              END.
            END.
            PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.
          END.
        END.
        ASSIGN ilin = ?.
      END. /* End delete field */ 
                
      /* Rename field in schema holder only */          
      ELSE IF imod = "r" THEN DO:
        IF tablename <> ? AND tablename <> ilin[5] THEN 
          RUN write-tbl-sql.
                            
        IF idxline <> ? THEN 
          RUN write-idx-sql.
        
        IF seq-line <> ? THEN
          RUN write-seq-sql.
      
        IF conline <> ? THEN
          RUN write-con-sql.
     
        IF tablename <> ilin[5] THEN
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE.
      IF NOT batch_mode THEN DO:
        IF tablename <> ? THEN
          DISPLAY tablename WITH FRAME working.
      END.
        FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.       
        IF AVAILABLE DICTDB._File THEN DO:
          FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                             NO-ERROR.
          IF AVAILABLE DICTDB._Field THEN DO:                                   
            CREATE rename-obj.
            ASSIGN rename-type = "F"
                   t-name = ilin[5]
                   old-name = ilin[3]
                   new-name = ilin[7]
                   dsv-name = DICTDB._Field._For-name.
          END.
          ELSE DO:
            FIND rename-obj WHERE rename-type = "F"
                              AND t-name = ilin[5]
                              AND new-name = ilin[3]
                              NO-ERROR.
            IF AVAILABLE rename-obj THEN 
              ASSIGN new-name = ilin[7].         
          END.
        END.    
        ELSE DO:       
          _rename-loop:
          FOR EACH rename-obj WHERE rename-type = "T"
                                AND new-name = ilin[5]:
          
            FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
            IF AVAILABLE DICTDB._File THEN 
              LEAVE _rename-loop.
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
	    IF NOT batch_mode THEN DO:
             &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                MESSAGE "The Delta DF File contains RENAME FIELD for table" ilin[5] SKIP
                     "and table does not exist in the schema holder." SKIP
                     "This process is being aborted."  SKIP (1).
             &ELSE
                MESSAGE "The Delta DF File contains RENAME FIELD for table" ilin[5] SKIP
                     "and table does not exist in the schema holder." SKIP
                     "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
             &ENDIF.
             END. 
             ELSE
	          PUT STREAM logfile UNFORMATTED "The Delta DF File contains RENAME FIELD for table" ilin[5] SKIP
                     "and table does not exist in the schema holder." SKIP
                     "This process is being aborted."  SKIP (1).
             RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN DO:               
            FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                             NO-ERROR.
            IF AVAILABLE DICTDB._Field THEN DO:                                   
              CREATE rename-obj.
              ASSIGN rename-type = "F"
                     t-name = ilin[5]
                     old-name = ilin[3]
                     new-name = ilin[7]
                     dsv-name = DICTDB._Field._For-name.                  
            END.
            ELSE DO:
              FIND rename-obj WHERE rename-type = "F"
                                AND t-name = tablename
                                AND new-name = ilin[3]
                                  NO-ERROR.
              IF NOT AVAILABLE rename-obj THEN DO:           
                FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = old-name
                                               NO-ERROR.
                IF NOT AVAILABLE DICTDB._Field THEN DO:
		IF NOT batch_mode THEN DO:
                  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                   MESSAGE "The Delta DF File contains RENAME FIELD" ilin[3] "for table" ilin[5] SKIP
                          "and field does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
                  &ELSE
                    MESSAGE "The Delta DF File contains RENAME FIELD" ilin[3] "for table" ilin[5] SKIP
                          "and field does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                     VIEW-AS ALERT-BOX ERROR.
                  &ENDIF.
                 END. 
                 ELSE
	           PUT STREAM logfile UNFORMATTED "The Delta DF File contains RENAME FIELD" ilin[3] "for table" ilin[5] SKIP
                          "and field does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
                  RETURN.
                END.
                IF AVAILABLE DICTDB._Field THEN DO:
                  CREATE rename-obj.                                                   
                  ASSIGN rename-type = "F"
                         t-name = tablename
                         old-name = DICTDB._Field._Field-name
                         new-name = ilin[7]
                         dsv-name = DICTDB._Field._For-name.
                END.
              END.
            END.
          END.
        END.
        IF ilin[1] <> ? THEN do:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                           ilin[4] + ' "' + ilin[5] + '" ' + ilin[6] + ' "' + ilin[7] + '"'.
        END.  
        ASSIGN ilin = ?.             
      END.
      
      /* Add field */            
      ELSE IF imod = "a" THEN DO:
        IF ilin[1] = "ADD" AND ilin[2] = "FIELD" THEN DO:  

           /* Verify we are working the same table */
          IF tablename <> ? AND tablename <> ilin[5] THEN 
            RUN write-tbl-sql.                        

          IF idxline <> ? THEN 
            RUN write-idx-sql.
          
          IF seq-line <> ? THEN
            RUN write-seq-sql.
      
          IF conline <> ? THEN
            RUN write-con-sql.
     
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE.
         IF NOT batch_mode THEN DO:
          IF tablename <> ? THEN       
            DISPLAY tablename WITH FRAME WORKING.                       
         END.
          FIND rename-obj WHERE rename-type = "F"
                            AND old-name = ilin[3]
                            AND t-name = ilin[5]
                            NO-ERROR.
          IF AVAILABLE rename-obj THEN 
            ASSIGN fieldname = "a##" + SUBSTRING(ilin[3], 1, (INTEGER(user_env[29]) - 3)).             
          ELSE DO:
            ASSIGN fieldname = ilin[3].

            /* if not a renamed field, check if it's not a field name that already exists
               in the schema.
            */
            FIND FIRST DICTDB._File WHERE DICTDB._File._file-name = tablename NO-ERROR.
            IF AVAILABLE DICTDB._File THEN DO:
               FIND FIRST DICTDB._Field OF DICTDB._File WHERE _Field-Name = fieldname NO-ERROR.
               IF AVAILABLE DICTDB._Field THEN DO:
                   IF NOT batch_mode THEN DO:
                &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                     MESSAGE "The Delta DF File contains ADD FIELD" ilin[3] "for table" tablename SKIP
                           "and field already exists in the schema holder." SKIP
                           "This process is being aborted."  SKIP (1).
               &ELSE
                     MESSAGE "The Delta DF File contains ADD FIELD" ilin[3] "for table" tablename SKIP
                           "and field already exists in the schema holder." SKIP
                           "This process is being aborted."  SKIP (1)
                   VIEW-AS ALERT-BOX ERROR.
               &ENDIF.
               END. 
               ELSE
	             PUT STREAM logfile UNFORMATTED "The Delta DF File contains ADD FIELD" ilin[3] "for table" tablename SKIP
                           "and field already exists in the schema holder." SKIP
                           "This process is being aborted."  SKIP (1).
                   RETURN.
               END.
            END.
          END.
          
          IF xlate THEN DO:           
            IF LENGTH(fieldname) > INTEGER(user_env[29]) THEN DO: 
              IF fieldname BEGINS "a##" THEN                   
                ASSIGN fieldname = SUBSTRING(fieldname, 4, (INTEGER(user_env[29]) - 3)) + "," + idbtyp + "," + user_env[29]
                       dupfield = TRUE.
              ELSE
                ASSIGN fieldname = SUBSTRING(fieldname, 1, (INTEGER(user_env[29]))) + "," + idbtyp + "," + user_env[29]
                       dupfield = FALSE.
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT fieldname).
              IF dupfield THEN
                ASSIGN fieldname = "A##" + fieldname
                       dupfield = FALSE.
            END.
            ELSE DO:  
              IF fieldname BEGINS "a##" THEN
                ASSIGN fieldname = SUBSTRING(fieldname,4) + "," + idbtyp + "," + user_env[29]
                       dupfield = TRUE.
              ELSE 
                ASSIGN fieldname = fieldname + "," + idbtyp + "," + user_env[29]
                       dupfield = FALSE.
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT fieldname).
              IF dupfield THEN
                ASSIGN fieldname = "A##" + fieldname
                       dupfield = FALSE.
            END.
          END.   
                                           
           _verify-field:
          DO WHILE TRUE:

            FIND FIRST verify-field WHERE verify-field.f-table = tablename
                                      AND verify-field.fnew-name = fieldname NO-ERROR.
            FIND FIRST DICTDB._File WHERE DICTDB._File._file-name = tablename NO-ERROR.
            IF AVAILABLE DICTDB._File THEN
                FIND FIRST DICTDB._Field WHERE DICTDB._Field._File-recid = RECID(DICTDB._File)
                                           AND DICTDB._Field._For-name = fieldname NO-ERROR.
            IF AVAILABLE verify-field OR AVAILABLE DICTDB._Field THEN DO:
              DO a = 1 TO 999:
                IF a = 1 THEN
                  ASSIGN fieldname = fieldname + STRING(a).
                ELSE
                  ASSIGN fieldname = SUBSTRING(fieldname, 1, LENGTH(fieldname) - LENGTH(STRING(a))) + STRING(a). 
                IF CAN-FIND(FIRST DICTDB._Field WHERE DICTDB._Field._File-recid = RECID(DICTDB._File)
                                                  AND DICTDB._Field._For-name = fieldname) THEN NEXT.
                ELSE IF CAN-FIND(FIRST verify-field WHERE verify-field.f-table = tablename
                                                      AND verify-field.fnew-name = fieldname) THEN NEXT.
                ELSE DO:
                  CREATE verify-field.
                  ASSIGN verify-field.f-table = tablename
                         verify-field.fnew-name = fieldname.
                  LEAVE _verify-field.
                END.
              END.
            END.                
            ELSE DO:
              CREATE verify-field.
              ASSIGN verify-field.f-table = tablename
                     verify-field.fnew-name = fieldname.
              LEAVE _verify-field.
            END.
          END.



          ASSIGN fieldtype = ilin[7].
     
          IF NOT addtable THEN DO: 
            IF NOT alt-table THEN DO:                                                
              FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
              IF AVAILABLE DICTDB._File THEN DO: 
                ASSIGN forname = (If DICTDB._File._For-owner <> ? then DICTDB._File._For-owner + "." else "") 
                                 +  DICTDB._File._For-Name. /* OE00198255 */
                
                CREATE alt-info.
                ASSIGN lnum = 1
                       a-line-num = lnum
                       a-line = "ALTER TABLE " + forname + " ADD" 
                       a-tblname = ilin[5]
                       a-fldname = fieldname.                       
              END.          
              ELSE IF NOT AVAILABLE DICTDB._File THEN DO:
                FIND rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5] NO-ERROR.


                IF AVAILABLE rename-obj THEN DO:
                  FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
                  IF NOT AVAILABLE DICTDB._File THEN DO:
                    IF NOT batch_mode THEN DO:
                          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                               MESSAGE "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                                "and table does not exist in the schema holder." SKIP
                                "This process is being aborted."  SKIP (1).
                          &ELSE
                            MESSAGE "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                            "and table does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                             VIEW-AS ALERT-BOX ERROR.
                          &ENDIF.
                 END. 
                 ELSE
	                PUT STREAM logfile UNFORMATTED "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                            "and table does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                    RETURN.
                  END.         
                  ASSIGN forname = (If DICTDB._File._For-owner <> ? then DICTDB._File._For-owner + "." else "") 
                                   +  DICTDB._File._For-Name /* OE00198255 */
                         fieldtype = ilin[7].
                  CREATE alt-info.
                  ASSIGN lnum = 1
                         a-line-num = lnum
                         a-line = "ALTER TABLE " + forname + " ADD"
                         a-tblname = ilin[5]
                         a-fldname = fieldname.
                            
                END.
                ELSE DO:
		IF NOT batch_mode THEN DO:
                  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                      MESSAGE "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                            "and table does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                  &ELSE
                      MESSAGE "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                            "and table does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                 &ENDIF.
               END. 
               ELSE
	             PUT STREAM logfile UNFORMATTED "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                            "and table does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                  RETURN.    
                END.
              END.
              ASSIGN alt-table = TRUE.
            END.
          END.          
          
          RUN create-new-obj (INPUT "F", INPUT ?).          
          ASSIGN fldnum = fldnum + 1.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                           ilin[4] + ' "' + ilin[5] + '" ' + ilin[6] + ' ' + ilin[7].
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = '  FOREIGN-NAME "' + LOWER(fieldname) + '"'. 

          if (LENGTH(quote, "character") = 1) THEN 
          DO:
             CREATE df-info.
             ASSIGN df-info.df-seq = dfseq
                    dfseq = dfseq + 1
                    df-info.df-tbl = tablename
				    df-line = '  QUOTED-NAME ' + quote + CAPS(fieldname) + quote.
                   /* df-line = '  QUOTED-NAME """' + CAPS(fieldname) + '"""'. */
          END.
        END. /* End first line of add field */                      
        ELSE DO:
          CASE ilin[1]:
            WHEN "FORMAT" THEN DO:
              FIND new-obj WHERE new-obj.add-type = "F"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.fld-name = fieldname
                             NO-LOCK NO-ERROR. 
                              
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname.

              IF sqlwidth AND (new-obj.for-type = " VARCHAR" OR new-obj.for-type = " NVARCHAR") THEN
                ASSIGN df-line = "  " + ilin[1] + ' "'.
              ELSE
                ASSIGN df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.

              IF available new-obj THEN DO:
                IF alt-table THEN DO:
                  CREATE alt-info.
                  ASSIGN lnum = lnum + 1
                         a-line-num = lnum
                         a-tblname = tablename
                         a-fldname = fieldname.
                END.
                ELSE DO:         
                  CREATE sql-info.
                  ASSIGN lnum = lnum + 1
                         line-num = lnum
                         tblname = tablename
                         fldname = fieldname.
                         
                END.
              END.              
              IF fieldtype = "character" THEN DO:
                ASSIGN nbrchar = 0 
                       lngth = LENGTH(ilin[2], "character").  
                IF INDEX(ilin[2], "(") > 1 THEN DO:
                  ASSIGN left_paren = INDEX(ilin[2], "(")
                         right_paren = INDEX(ilin[2], ")")
                         lngth = right_paren - (left_paren + 1)        
                         j = INTEGER(SUBSTRING(ilin[2], left_paren + 1, lngth)).  
                  /* user can turn off the x(8) override */
                  IF j = 8 AND sqlwidth = FALSE THEN j = minwidth.
                END.  
                ELSE DO:           
                  DO z = 1 to lngth:        
                    IF SUBSTRING(ilin[2],z,1) = "9" OR
                       SUBSTRING(ilin[2],z,1) = "N" OR   
                       SUBSTRING(ilin[2],z,1) = "A" OR    
                       SUBSTRING(ilin[2],z,1) = "x" OR
                       SUBSTRING(ilin[2],z,1) = "!"   THEN
                         ASSIGN nbrchar = nbrchar + 1.
                  END.         
                  IF nbrchar > 0 THEN
                    ASSIGN j = nbrchar.
                  ELSE
                    ASSIGN j = lngth.   
                  /* user can turn off the x(8) override */
                  IF j = 8 AND sqlwidth = FALSE THEN j = minwidth.
                END.       

                /* expand length - unicode support */
                IF user_env[35] = "y" THEN
                    j = j * 2.

                IF j < varlngth THEN DO:              
                  IF AVAILABLE new-obj THEN
                    ASSIGN new-obj.for-type = /*" VARCHAR("*/ " " + user_env[11] + "(" + STRING(j) + ")" 
                           dffortype = user_env[11]. /*"VARCHAR"*/
                END.
                ELSE  /* >  */                     
                  IF AVAILABLE new-obj THEN
                    ASSIGN new-obj.for-type = " " + user_env[18] /*" TEXT"*/
                           dffortype = /*"TEXT"*/ dfLongType.                       
                
                ASSIGN lngth = j.   
              END. /* Character datatype */
              ELSE IF fieldtype = "integer" THEN DO: 
                IF AVAILABLE new-obj THEN
                  ASSIGN new-obj.for-type = " INTEGER"
                         dffortype = "INTEGER"
                         lngth = 22.
              END.
              ELSE IF fieldtype = "int64" THEN DO:
                  IF AVAILABLE new-obj THEN
                       ASSIGN new-obj.for-type = " BIGINT"
                         dffortype = "BIGINT"
                         lngth = 22.
              END.
              ELSE IF fieldtype = "decimal" THEN DO:                    
                ASSIGN lngth = LENGTH(ilin[2], "character")
                       all_digits = 0
                       dec_point = 0.
                     /* First, count all the digits in the format. */
                DO pos = 1 to lngth:
                  if (SUBSTRING(ilin[2], pos, 1) = ">") OR 
                     (SUBSTRING(ilin[2], pos, 1) = "<") OR  
                     (SUBSTRING(ilin[2], pos, 1) = "*") OR  
                     (SUBSTRING(ilin[2], pos, 1) = "z") OR 
                     (SUBSTRING(ilin[2], pos, 1) = "Z") OR
                     (SUBSTRING(ilin[2], pos, 1) = "9") THEN
                         ASSIGN all_digits = all_digits + 1.   
                  ELSE IF (SUBSTRING(ilin[2],pos,1)) = "."  THEN
                      ASSIGN dec_point = all_digits + 1.            
                END.
                IF AVAILABLE new-obj THEN DO:
                  IF dec_point > 0 THEN
                    ASSIGN new-obj.for-type = " DECIMAL (" + string(all_digits) + "," +
                                    string(all_digits - dec_point + 1) + ")".
                  ELSE
                    ASSIGN new-obj.for-type = " DECIMAL (" + string(all_digits) + ",0)".

                  ASSIGN dffortype = "DECIMAL"
                         lngth = 22
                         dec_point = (IF dec_point > 0 THEN all_digits - (dec_point - 1)
                                      ELSE 0) .
                END.
              END.
              ELSE if (fieldtype = "date" OR fieldtype = "datetime") AND
                   AVAILABLE new-obj THEN DO:
                IF mapMSSDatetime THEN
                    ASSIGN new-obj.for-type = " DATETIME"
                           dffortype = "TIMESTAMP"
                           lngth     = 16  /*length*/
                           all_digits = 23 /*precision*/
                           dec_point = 3.  /*scale*/
                ELSE DO:
                    if fieldtype = "date" THEN
                        ASSIGN new-obj.for-type = " DATE"
                               dffortype = "DATE"
                               lngth     = 6  /*length*/
                               all_digits = 10 /*precision*/
                               dec_point = 0.  /*scale*/
                    ELSE /* datetime */
                        ASSIGN new-obj.for-type = " DATETIME2(3)"
                               dffortype = "TIMESTAMP"
                               lngth     = 16  /*length*/
                               all_digits = 23 /*precision*/
                               dec_point = 3.  /*scale*/
                END.
              END.
              ELSE IF fieldtype = "datetime-tz" AND NOT mapMSSDatetime AND
                   AVAILABLE new-obj THEN DO:
                   ASSIGN new-obj.for-type = " DATETIMEOFFSET(3)"
                          dffortype = "TIMESTAMP-TZ"
                          lngth     = 20  /*length*/
                          all_digits = 30 /*precision*/
                          dec_point = 3.  /*scale*/
              END.
              ELSE IF fieldtype = "logical" AND AVAILABLE new-obj THEN
                /*OE00164229 - logical should map to tinyint */
                ASSIGN new-obj.for-type = " TINYINT"
                       dffortype = "TINYINT"
                       lngth = 1
                       dec_point = 0
                       all_digits = 3.
              ELSE IF fieldtype = "blob" AND  AVAILABLE new-obj THEN DO:
                  ASSIGN new-obj.for-type = " varbinary(max)".
                  IF isSQLNCLI THEN 
                  /* SQL Server Native driver reports varbinary(max) as Varbinary 
                  with length and precision as 0 which is set to 32K in mss_pul.i.*/
                      ASSIGN dffortype = "Varbinary" 
                              lngth = 32000      /*length*/
                              all_digits = 32000 /*precision*/
                              dec_point = 0.     /*scale*/
                  ELSE
                  /* Non Native drivers report varbinary(max) as Longvarbinary 
                  with length and precision as 2147483647  */
                      ASSIGN dffortype = "Longvarbinary" 
                              lngth = 2147483647      /*length*/
                              all_digits = 2147483647 /*precision*/
                              dec_point = 0.          /*scale*/
              END.
              ELSE IF fieldtype = "clob" AND  AVAILABLE new-obj THEN DO:
                IF unicodeTypes THEN DO:
                  ASSIGN new-obj.for-type = " nvarchar(max)".
                  IF isSQLNCLI THEN 
                  /* SQL Server Native driver reports nvarchar(max) as Nvarchar 
                  with length and precision as 0 which is set to 32K in mss_pul.i.*/
                      ASSIGN dffortype = "NVarchar" 
                             lngth = 32000      /*length*/
                             all_digits = 16000 /*precision*/
                             dec_point = 0.     /*scale*/
                  ELSE
                  /* Non Native drivers report nvarchar(max) as Nlongvarchar 
                  with length 2147483647 and precision as 1073741824  */
                      ASSIGN dffortype = "Longvarchar" 
                              lngth = 2147483647      /*length*/
                              all_digits = 1073741823 /*precision*/
                              dec_point = 0.          /*scale*/
                END.
                ELSE DO:
                  ASSIGN new-obj.for-type = " varchar(max)".
                  IF isSQLNCLI THEN 
                  /* SQL Server Native driver reports varchar(max) as Varchar 
                  with length and precision as 0 which is set to 32K in mss_pul.i.*/
                      ASSIGN dffortype = "Varchar" 
                             lngth = 32000      /*length*/
                             all_digits = 32000 /*precision*/
                             dec_point = 0.     /*scale*/
                  ELSE
                  /* Non Native drivers report varchar(max) as Longvarchar 
                  with length and precision as 2147483647  */
                      ASSIGN dffortype = "Longvarchar" 
                              lngth = 2147483647      /*length*/
                              all_digits = 2147483647 /*precision*/
                              dec_point = 0.          /*scale*/
                END.
              END.
              ELSE IF fieldtype = "Recid" AND AVAILABLE new-obj THEN
                ASSIGN new-obj.for-type = " INTEGER"
                       dffortype = "INTEGER"
                       lngth = 22. 
              ELSE IF new-obj.for-type = "" OR new-obj.for-type = ? THEN
                ASSIGN new-obj.for-type = " UNSUPPORTED".
             
              IF AVAILABLE sql-info THEN 
                ASSIGN line = fieldname + new-obj.for-type.                        
              ELSE IF AVAILABLE alt-info THEN DO:   
         
                IF shadowcol THEN DO:
                    FIND FIRST idxfld-cache WHERE idxfld-cache.tab-name1 = tablename AND idxfld-cache.idx-fld2 = fieldname  NO-ERROR.
                        IF AVAILABLE idxfld-cache THEN 
                           FIND FIRST fld-cache WHERE fld-cache.fld-name = idxfld-cache.idx-fld2 and fld-cache.tab-name = idxfld-cache.tab-name1 NO-ERROR.
                           IF AVAILABLE fld-cache  THEN DO:
                               IF is-case-sensitive THEN
                               create_shadow_col = FALSE.
                               ELSE
                               create_shadow_col = TRUE.
                           END.
                    IF create_shadow_col AND fieldtype EQ "CHARACTER" THEN DO:
                       RUN create_shadow.                       
                       ASSIGN   a-line = new-obj.for-name + new-obj.for-type 
                                a-tblname = tablename
                                a-fldname = new-obj.fld-name.
                        
                        CREATE alt-info.
                        ASSIGN lnum = lnum + 1
                               a-line-num = lnum
                               a-tblname = tablename
                               a-fldname = fieldname.
                    END.
               END.

                ASSIGN a-line = fieldname + new-obj.for-type .
                RUN get-position.
              END.    
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line = '  FOREIGN-TYPE "' + dffortype + '"'.
              
              IF all_digits <> 0 THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = "  DSRVR-PRECISION " + STRING(all_digits).
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-info.df-fld = fieldname
                       df-line = "  FIELD-MISC12 " + STRING(dec_point).
              END.
                
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line = "  FIELD-MISC13 " + STRING(lngth).
                 
              /* OE00164229 - don't set this for logical */
              IF fieldtype NE "logical" AND NOT fieldtype BEGINS  "date" THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  FOREIGN-MAXIMUM " + string(lngth).
              END.

              /* 20061005-003 - missing this for character fields */
              IF fieldtype = "character" THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  DSRVR-PRECISION " + string(lngth).
              END.

              IF AVAILABLE new-obj AND fieldtype = "datetime" AND
                  NOT mapMSSDatetime THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  FIELD-MISC24 " + QUOTER("datetime2").
              END.

			  /* OE00217757 Fix:
			  While generating SQL for 'CLOB' fiels, the information for CLOB-CODEPAGE, CLOB-COLLATION and
			  CLOB-TYPE are to be added to the definitions. */
              IF fieldtype = "Clob" THEN DO: /* TEMPORARY */
                  FIND FIRST DICTDB._Db WHERE DICTDB._Db._Db-type = "MSS".
				  
				  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = '  CLOB-CODEPAGE "' + DICTDB._Db._Db-xl-name + '"'. 

                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = '  CLOB-COLLATION "' 
                                + (IF DICTDB._Db._Db-coll-name = ? 
                                      THEN "basic" ELSE DICTDB._Db._Db-coll-name) + '"'.

                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  CLOB-TYPE 1". /* using db codepage */
              END.

              ASSIGN all_digits = 0
                     dec_point  = 0
                     lngth = 0.            
            END. /* WHEN FORMAT */                           
            WHEN "QUOTED-NAME"     OR WHEN "FIELD-MISC21"  OR WHEN "FIELD-MISC23"    OR 
            WHEN "FIELD-MISC24"    OR WHEN "FIELD-MISC25"  OR WHEN "FIELD-MISC26"    OR 
            WHEN "FIELD-MISC27"    OR WHEN "FIELD-MISC28"  OR WHEN "MISC-PROPERTIES" OR 
            WHEN "SHADOW-NAME"     OR WHEN "DESC"          OR WHEN "DESCRIPTION"     OR 
            WHEN "CAN-READ"        OR WHEN "CAN-SELECT"    OR WHEN "CAN-WRITE"       OR 
            WHEN "CAN-UPDATE"      OR WHEN "NULL"          OR WHEN "FORMAT-SA"       OR 
            WHEN "LABEL"           OR WHEN "LABEL-SA"      OR WHEN "COLUMN-LABEL"    OR 
            WHEN "COLUMN-LABEL-SA" OR WHEN "INITIAL-SA"    OR WHEN "VALEXP"          OR 
            WHEN "VALMSG"          OR WHEN "VALMSG-SA"     OR WHEN "VIEW-AS"         OR 
            WHEN "HELP"            OR WHEN "HELP-SA"       THEN DO:    
              IF ilin[2] <> "" AND ilin[2] <> ? THEN DO:
                RUN dctquot (ilin[2], '"',OUTPUT oq-string).
                IF LENGTH(oq-string) > 0 THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " " + oq-string.
                END.
              END.
            END.
            WHEN "INITIAL" THEN DO:
              FIND new-obj WHERE new-obj.add-type = "F"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.fld-name = fieldname
                             NO-LOCK NO-ERROR. 
                               
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename.
              IF ilin[2] <> ? THEN
                ASSIGN df-line = "  " + ilin[1] + '  "' + ilin[2] + '"'.
              ELSE
                ASSIGN df-line = "  " + ilin[1] + " ?".

              IF dflt AND AVAILABLE new-obj THEN DO:
                
                  IF alt-table THEN DO:   
                    IF AVAILABLE alt-info THEN DO: 
                      IF a-tblname <> tablename AND
                         a-fldname <> fieldname THEN                  
                      FIND alt-info WHERE a-tblname = tablename
                                      AND a-fldname = fieldname
                                      NO-ERROR.
                    END.
                    ELSE 
                      FIND alt-info WHERE a-tblname = tablename
                                      AND a-fldname = fieldname
                                      NO-ERROR.
                  END.
                  ELSE          
                    FIND sql-info WHERE tblname = tablename
                                    AND fldname = fieldname
                                    NO-ERROR.
 
                  ASSIGN for-init = "".

                  /* If BLANKDEFAULT env. variable is not set, then add a  DEFAULT '' phrase in
                   * the SQL for empty string INITIAL value. This will make sure that the existing
                   * records are not set to NULL. Keep BLANKDEFAULT for backward compatibility.
                   */
                  IF (ilin[2] = "" OR ilin[2] = ? OR ilin[2] = "?") AND
                     (new-obj.For-type BEGINS " VARCHAR" OR new-obj.For-type BEGINS " NVARCHAR") THEN DO:
                     IF blankdefault THEN 
                        ASSIGN for-init = " DEFAULT ' '".
                     ELSE DO:
                        IF (ilin[2] = "" AND useoedflt) THEN
                             ASSIGN for-init = " DEFAULT ''".
                        /*
                        No need to make changes for ? INITIAL value, as existing records are 
                        always filled with NULLs
                        ELSE IF (ilin[2] = ? OR ilin[2] = "?") THEN
                              ASSIGN for-init = " DEFAULT NULL".
                        */
                     END.
                  END.
                  ELSE IF ilin[2] <> "" AND ilin[2] <> ? AND ilin[2] <> "?" THEN DO:

                   /* Character */ 
                  IF new-obj.for-type BEGINS " VARCHAR" OR new-obj.for-type BEGINS " NVARCHAR" THEN 
                    ASSIGN for-init = " DEFAULT '" + ilin[2] + "'".                                
                  ELSE IF new-obj.for-type BEGINS " INTEGER" OR  new-obj.for-type BEGINS " DECIMAL"
                       OR new-obj.for-type BEGINS " TINYINT" THEN DO:  
                    /* logical no or false */
                    IF ilin[2] BEGINS "N" OR ilin[2] BEGINS "F" THEN
                      ASSIGN for-init = " DEFAULT 0 ".
                    /* logical yes or true */
                    ELSE IF ilin[2] BEGINS "Y" OR ilin[2] BEGINS "T" THEN
                      ASSIGN for-init = " DEFAULT 1 ".
                    /* integer */
                    ELSE IF INDEX(ilin[2], ",") = 0 AND LOOKUP(substring(ilin[2], 1,1), "1,2,3,4,5,6,7,8,9,0") <> 0 THEN
                       ASSIGN for-init = " DEFAULT " + ilin[2].
                    /* decimal, remove formatting */
                    ELSE IF INDEX(ilin[2], ",") > 0 THEN DO:
                      ASSIGN for-init = ilin[2].
                      DO k = 1 TO LENGTH(ilin[2]):
                        IF INDEX(for-init, ",") > 0 THEN
                          ASSIGN for-init = SUBSTRING(for-init, 1, (INDEX(for-init, ",") - 1)) +  
                                            SUBSTRING(for-init, (INDEX(for-init, ",") + 1)).
                        ELSE
                          ASSIGN k = LENGTH(ilin[2]).
                      END.
                      ASSIGN for-init = " DEFAULT " + for-init.
                    END.                    
                  END.
                  /* date */
                  ELSE IF new-obj.for-type BEGINS " DATE" THEN DO:
                    IF UPPER(ilin[2]) = "TODAY" OR 
                       UPPER(ilin[2]) = "NOW" THEN DO:
                        
                        IF new-obj.for-type BEGINS " DATETIMEOFFSET" THEN DO:
                           ASSIGN for-init = " DEFAULT SYSDATETIMEOFFSET()".
                        END.
                        ELSE DO: 
                           IF new-obj.for-type BEGINS " DATETIME2" THEN
                               ASSIGN for-init = " DEFAULT SYSDATETIME()".
                           ELSE
                               ASSIGN for-init = " DEFAULT GETDATE()".
                        END.
                    END.
                  END.              
                END.
                IF for-init NE "" THEN DO:
                    IF AVAILABLE sql-info THEN 
                      ASSIGN LINE = LINE + for-init.
                    ELSE IF AVAILABLE alt-info THEN 
                      ASSIGN a-line = a-line + for-init. 
                END.
              END.
            END.
            WHEN "EXTENT"  THEN DO:

              IF ilin[2] <> "0" THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " "  + ilin[2].
             
                FIND FIRST sql-info WHERE tblname = tablename
                                      AND fldname = fieldname 
                                      AND line-num > 1 
                                      AND line <> "" NO-ERROR.
                IF AVAILABLE sql-info THEN DO:                    
                  IF (LENGTH(fieldname) + length(ilin[2]) + 2) < integer(user_env[29]) THEN DO:             
                    ASSIGN endline = SUBSTRING(line,(length(fieldname)+ 1))
                           line = SUBSTRING(line, 1, length(fieldname)) +
                                     "##1" + endline.

                    FIND new-obj WHERE new-obj.add-type = "F"
                                   AND new-obj.tbl-name = tablename
                                   AND new-obj.fld-name = fieldname
                                   NO-ERROR.
                    IF AVAILABLE new-obj THEN
                      ASSIGN new-obj.for-name = new-obj.for-name + "##1"
                             fortype = new-obj.for-type
                             new-obj.iExtents = INTEGER(ilin[2]).
                      
                    DO i = 2 TO INTEGER(ilin[2]):
                      CREATE sql-info.
                      ASSIGN lnum = lnum + 1
                             line-num = lnum
                             tblname = tablename
                             fldname = fieldname
                             line = fieldname + "##" + STRING(i) +  endline.  
                                                              
                      RUN create-new-obj (INPUT "F", INPUT STRING(i)).    
                      ASSIGN fldnum = fldnum + 1.
                    END.
                  END.
                  ELSE DO:
                    ASSIGN forname = substring(line,1,(INTEGER(user_env[29]) - length(ilin[2]) - 2 )) + "##"
                           endline = SUBSTRING(line,(length(fieldname) + 1))
                           line = forname + "1 " + endline.
                    
                    FIND new-obj WHERE new-obj.add-type = "F"
                                   AND new-obj.tbl-name = tablename
                                   AND new-obj.fld-name = fieldname
                                   NO-ERROR.
                    IF AVAILABLE new-obj THEN
                      ASSIGN new-obj.for-name = forname + "1"
                             fortype = new-obj.for-type
                             new-obj.iExtents = INTEGER(ilin[2]).                
                                                                                                   
                    DO i = 2 TO INTEGER(ilin[2]):
                      CREATE sql-info.
                      ASSIGN lnum = lnum + 1
                             line-num = lnum
                             tblname = tablename
                             fldname = fieldname
                             line = forname + STRING(i) + endline.   
                                       
                      RUN create-new-obj (INPUT "F", INPUT STRING(i)).                                         
                    END.
                  END.
                END.
                ELSE DO:
                  FIND FIRST alt-info WHERE a-tblname = tablename
                                        AND a-fldname = fieldname 
                                        AND a-line-num > 1 
                                        AND a-line <> "" NO-ERROR.
                  IF AVAILABLE alt-info THEN DO:  
                    FIND new-obj WHERE new-obj.add-type = "F"
                                   AND new-obj.tbl-name = tablename
                                   AND new-obj.fld-name = fieldname
                                   NO-ERROR.
                    IF AVAILABLE new-obj THEN
                        ASSIGN new-obj.for-name = new-obj.for-name + "##1"
                               new-obj.iExtents = INTEGER(ilin[2]).
                                                      
                    IF (LENGTH(fieldname) + length(ilin[2]) + 2) < integer(user_env[29]) THEN DO:
               
                      ASSIGN endline = SUBSTRING(a-line,(length(fieldname)+ 1))
                             a-line = fieldname + "##1" + endline.                 
                 
                      DO i = 2 TO INTEGER(ilin[2]):
                        CREATE alt-info.
                        ASSIGN lnum = lnum + 1
                               a-line-num = lnum
                               a-tblname = tablename
                               a-fldname = fieldname
                               a-line = fieldname + "##" + STRING(i) +  endline. 
                    
                        RUN create-new-obj (INPUT "F", INPUT STRING(i)).                                                                                        
                      END.
                    END.
                    ELSE DO:                   
                      ASSIGN forname = substring(a-line,4,(INTEGER(user_env[29]) - length(ilin[2]) - 2 )) + "##"
                             endline = SUBSTRING(a-line,(length(fieldname) + 5))
                             a-line = forname + "1 " + endline.
                  
                      DO i = 2 TO INTEGER(ilin[2]):
                        CREATE alt-info.
                        ASSIGN lnum = lnum + 1
                               a-line-num = lnum
                               a-tblname = tablename
                               a-fldname = fieldname
                               a-line = forname + STRING(i) + endline. 
                                            
                        RUN create-new-obj (INPUT "F", INPUT STRING(i)).                                                                                                                 
                      END.
                    END.
                  END.
                END.

                IF sqlwidth THEN DO:
                    /* if we processed sql-width prior to extent, need to adjust colum size now */
                    FIND FIRST new-obj WHERE new-obj.add-type = "F"
                                       AND new-obj.tbl-name = tablename
                                       AND new-obj.fld-name = fieldname
                                       AND new-obj.iExtents > 0 NO-ERROR.

                    IF AVAILABLE new-obj AND new-obj.iMaxWidth > 0 THEN
                       RUN process-sql-width(INPUT tablename, INPUT fieldname, INPUT new-obj.iMaxWidth).
                END.
              END.               
            ASSIGN fortype = "".
            END. /* WHEN EXTENT */
                 
            WHEN "ORDER"           OR WHEN "FIELD-MISC11"  OR WHEN "FIELD-MISC12"      OR 
            WHEN "FIELD-MISC13"    OR WHEN "FIELD-MISC14"  OR WHEN "FIELD-MISC15"      OR
            WHEN "FIELD-MISC16"    OR WHEN "FIELD-MISC17"  OR WHEN "FIELD-MISC18"      OR
            WHEN "DECIMALS"        OR WHEN "POSITION" THEN DO:
              IF ilin[2] <> ? THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " " + ilin[2].
              END.
            END.
            WHEN "LENGTH" THEN DO:
              IF ilin[2] <> "0" THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " " + ilin[2].
              END.
            END.
            WHEN "MANDATORY" OR WHEN "CASE-SENSITIVE" OR WHEN "NOT-CASE-SENSITIVE" OR
            WHEN "NULL-ALLOWED" THEN DO:

                IF ilin[1] = "MANDATORY" THEN DO:
                   /* if extent, will have more records for the same field name,
                      so need to find first.
                   */
                   FIND FIRST new-obj WHERE new-obj.add-type = "F"
                       AND new-obj.tbl-name = tablename
                       AND new-obj.fld-name = fieldname
                       NO-LOCK NO-ERROR. 

                   /* if it's mandatory for a new field */
                   IF AVAILABLE new-obj THEN
                       ASSIGN new-obj.mand = YES.
                END.

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line =  "  " + ilin[1].
            END.                                          
            WHEN "FIELD-TRIGGER"  THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                               ilin[3] + " ". 
              IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].             
              IF ilin[5] <> ? THEN 
                ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.              
              IF ilin[6] <> ? THEN 
                ASSIGN df-line = df-line + ilin[6].             
              IF ilin[7] <> ? THEN
                ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
            END.
            WHEN "SQL-WIDTH" OR WHEN "MAX-WIDTH" THEN DO:
              IF sqlwidth THEN
                  RUN process-sql-width(INPUT tablename, INPUT fieldname, INPUT INT(ilin[2])).
            END.
          END CASE.
        END. /* End subsequent lines of add field */       

        ASSIGN ilin = ?.
      END.
      ELSE DO:  /* imod = m */
        IF ilin[1] = "UPDATE" THEN DO:       
          IF tablename <> ? AND tablename <> ilin[5] THEN 
            RUN write-tbl-sql.               
          
          IF idxline <> ? THEN 
            RUN write-idx-sql.
 
          IF seq-line <> ? THEN
            RUN write-seq-sql.
      
          IF conline <> ? THEN
            RUN write-con-sql.
     
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE
                   fieldtype = ?.

          IF fieldname <> ilin[3] THEN
            ASSIGN fieldname = ilin[3].

          FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.       
          IF AVAILABLE DICTDB._File THEN DO:
            FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                                     NO-ERROR.
            IF NOT AVAILABLE DICTDB._Field THEN DO:
              FIND rename-obj WHERE rename-type = "F"
                                AND t-name = ilin[5]
                                AND new-name = ilin[3]
                                  NO-ERROR.
              IF AVAILABLE rename-obj THEN 
                FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name
                                               NO-ERROR.
              IF NOT AVAILABLE DICTDB._Field THEN DO:
                  /* check if it's a new field */
                  FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5]
                                     AND new-obj.add-type = "F" 
                                     AND new-obj.fld-name = ilin[3] NO-ERROR.

                  IF NOT AVAILABLE new-obj THEN DO:
		    IF NOT batch_mode THEN DO:
                     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                             MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                            "and field does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                    &ELSE
                            MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                            "and field does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
                    &ENDIF.
                    END. 
                        ELSE
	                   PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                            "and field does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                    RETURN.
                  END.
              END.
            END.
            IF AVAILABLE DICTDB._Field THEN
               ASSIGN fieldtype = DICTDB._Field._data-type.
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            _ren-loop:
            FOR EACH rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5]:
          
              FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
              IF AVAILABLE DICTDB._File THEN 
                LEAVE _ren-loop.
            END.
            IF NOT AVAILABLE DICTDB._File THEN DO:
              /* see if it's a new table */
              FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5] 
                                       AND new-obj.add-type = "T" NO-ERROR.

              IF NOT AVAILABLE new-obj THEN DO:
                 IF NOT batch_mode THEN DO:
                    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                              MESSAGE "The Delta DF File contains UPDATE FIELD for table" ilin[5] SKIP
                         "and table does not exist in the schema holder." SKIP
                         "This process is being aborted."  SKIP (1).
                     &ELSE
                          MESSAGE "The Delta DF File contains UPDATE FIELD for table" ilin[5] SKIP
                         "and table does not exist in the schema holder." SKIP
                         "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                     &ENDIF.
                      END. 
                      ELSE
	               PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE FIELD for table" ilin[5] SKIP
                         "and table does not exist in the schema holder." SKIP
                         "This process is being aborted."  SKIP (1).
                 RETURN.
              END.
              ELSE DO:
                 /* new table, make sure it's a new field too */
                 FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5]
                                    AND new-obj.add-type = "F" 
                                    AND new-obj.fld-name = ilin[3] NO-ERROR.
                 IF NOT AVAILABLE new-obj THEN DO:
                      IF NOT batch_mode THEN DO:
                       &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                          MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                             "and field does not exist in the schema holder or in the .df." SKIP
                             "This process is being aborted."  SKIP (1).
                       &ELSE
                           MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                             "and field does not exist in the schema holder or in the .df." SKIP
                             "This process is being aborted."  SKIP (1)
                             VIEW-AS ALERT-BOX ERROR.
                        &ENDIF.
                    END. 
                     ELSE
	                   PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                             "and field does not exist in the schema holder or in the .df." SKIP
                             "This process is being aborted."  SKIP (1).
                     RETURN.
                 END.
             END.
            END.
            ELSE DO:
              FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                                     NO-ERROR.
              IF NOT AVAILABLE DICTDB._Field THEN DO:
                FIND rename-obj WHERE rename-type = "F"
                                  AND t-name = ilin[5]
                                  AND new-name = ilin[3]
                                  NO-ERROR.
                IF AVAILABLE rename-obj THEN 
                  FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = old-name
                                               NO-ERROR.
              END.
              IF NOT AVAILABLE DICTDB._Field THEN DO:
                  /* check if it's a new field */
                  FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5]
                                     AND new-obj.add-type = "F" 
                                     AND new-obj.fld-name = ilin[3] NO-ERROR.

                  IF NOT AVAILABLE new-obj THEN DO:
		  IF NOT batch_mode THEN DO:
                    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                        MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                            "and field does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                    &ELSE
                        MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                            "and field does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                            VIEW-AS ALERT-BOX ERROR.
                    &ENDIF.
                  END. 
                  ELSE
                      PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE FIELD" ilin[3] 
		            "for table" ilin[5] SKIP
                            "and field does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                   RETURN.
                  END.
              END.
            END.

            IF AVAILABLE DICTDB._Field THEN
               ASSIGN fieldtype = DICTDB._Field._data-type.
          END.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-info.df-tbl = tablename
                  df-info.df-fld = fieldname
                  df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                            ilin[4] + ' "' + ilin[5] + '"'.

          /* handle int->int64 type change */
          IF ilin[6] = "AS" AND ilin[7] = "int64" THEN DO:

                /* we will just change the definition in the .df to be BIGINT.
                   but will need to drop the field (and indexes) nd re-add them
                   in SQL Server since it's a type change 
                */

                /* check if field is part of any index and delete them */
                FOR EACH DICTDB._Index OF DICTDB._File 
                     WHERE DICTDB._File._For-owner NE ? AND DICTDB._File._For-owner NE "" NO-LOCK:
                    
                    FIND FIRST DICTDB._Index-field OF DICTDB._Index 
                         WHERE DICTDB._Index-field._field-recid = RECID(DICTDB._Field) NO-LOCK NO-ERROR.
                    IF AVAILABLE DICTDB._Index-field THEN
                       PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._File._For-owner "." DICTDB._File._For-name "." DICTDB._Index._For-name SKIP "go" SKIP(1).           
                END.

                /* now alter the field's type */
                IF DICTDB._Field._Extent > 0 THEN DO:
                    DO i = 1 TO DICTDB._Field._Extent:
                       PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " DICTDB._File._For-owner "." DICTDB._File._For-name 
                                                " ALTER COLUMN " DICTDB._Field._For-name "##" STRING(i) " BIGINT" SKIP "go" SKIP(1).           
                    END.
                END.
                ELSE DO:
                    PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " DICTDB._File._For-owner "." DICTDB._File._For-name 
                        " ALTER COLUMN " DICTDB._Field._For-name " BIGINT" SKIP "go" SKIP(1).           
                END.

                /* now recreate indexes if they were deleted above */
                FOR EACH DICTDB._Index OF DICTDB._File 
                    WHERE DICTDB._File._For-owner NE ? AND DICTDB._File._For-owner NE "" NO-LOCK:
                    
                    /* go through all indexes for the current table, and find the ones that
                       contain this field.
                    */
                    FIND FIRST DICTDB._Index-field OF DICTDB._Index 
                         WHERE DICTDB._Index-field._field-recid = RECID(DICTDB._Field) NO-LOCK NO-ERROR.

                    IF AVAILABLE DICTDB._Index-field THEN DO:
                    
                       ASSIGN is-unique = DICTDB._Index._Unique
                              u = 0.

                       idxline = "CREATE" + (IF is-unique THEN " UNIQUE" ELSE "")
                                  + " INDEX " + DICTDB._Index._For-name + " ON " 
                                  + DICTDB._File._For-owner + "." + DICTDB._File._For-name + " (".
                       
                       FOR EACH DICTDB._Index-field OF DICTDB._Index NO-LOCK BY DICTDB._Index-field._Index-seq:
                           /* add field to sql statement. Since this is an integer field, don't
                              need to worry about shadow columns.
                           */
                           FIND FIRST DICTDB._Field WHERE RECID(DICTDB._Field) = DICTDB._Index-field._field-recid NO-LOCK.

                           idxline = idxline + (IF u > 0 THEN ", " ELSE "") + DICTDB._Field._For-name
                               + (IF NOT DICTDB._Index-field._Ascending THEN " DESC " ELSE "") .

                           ASSIGN u = 1.

                       END.

                       IF pcompatible AND is-unique = FALSE THEN 
                          ASSIGN idxline = idxline + ", PROGRESS_RECID".

                       PUT STREAM tosql UNFORMATTED comment_chars idxline ")"  SKIP.
                       PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).

                       ASSIGN idxline = "".

                       /* now point again at the _Field for the field been changed */
                       FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3] NO-LOCK.
                    END.
                END.

              /* handle .df changes */
              dfseq = dfseq + 1.

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                      dfseq = dfseq + 1
                      df-info.df-tbl = tablename
                      df-info.df-fld = fieldname
                      df-line = '  FOREIGN-TYPE "BIGINT"'.

              dfseq = dfseq + 1.

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                      dfseq = dfseq + 1
                      df-info.df-tbl = tablename
                      df-info.df-fld = fieldname
                      df-line = "  DSRVR-PRECISION 19".

              dfseq = dfseq + 1.

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                      dfseq = dfseq + 1
                      df-info.df-tbl = tablename
                      df-info.df-fld = fieldname
                      df-line = "  DSRVR-LENGTH 8".
          END.

        END.

        CASE ilin[1]:
          WHEN "FORMAT" THEN DO: /* skip changes in format because MSS is already created */             
             /* if this is a logical field, we can change the format, since it won't
                mean a change in MSS - also, if the format has changed for a logical field,
                it means that the INITIAL may have also changed, in which case we will
                generate a bad .df - we will fail to load it if INITIAL has changed, but
                FORMAT hasn't changed.
             */        
            
             IF fieldtype = "logical" THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line =  "  " + ilin[1] + ' "' + ilin[2] + '"'.
             END.
             ELSE DO:
                 ASSIGN efile = tablename + ".e".
                 OUTPUT TO value(efile) APPEND.
                 PUT UNFORMATTED fieldname " in " tablename " had a change to FORMAT which was not passed to the" SKIP
                                "df file and no ALTER TABLE statement was created to change field size." SKIP(1).
                 OUTPUT CLOSE.
             END.
          END.
          WHEN "SQL-WIDTH" OR WHEN "MAX-WIDTH" THEN DO:
            IF sqlwidth THEN DO:
              ASSIGN efile = tablename + ".e".
              OUTPUT TO value(efile) APPEND.
              PUT UNFORMATTED fieldname " in " tablename " had a change to WIDTH which was not passed to the" SKIP
                              "df file and no ALTER TABLE statement was created to change field size." SKIP(1).
              OUTPUT CLOSE.
            END.
          END.
          WHEN "DESC"            OR WHEN "DESCRIPTION"      OR WHEN "CAN-READ"        OR 
          WHEN "CAN-SELECT"      OR WHEN "CAN-WRITE"        OR WHEN "CAN-UPDATE"      OR
          WHEN "FORMAT-SA"       OR WHEN "LABEL"            OR WHEN "LABEL-SA"        OR 
          WHEN "COLUMN-LABEL"    OR WHEN "COLUMN-LABEL-SA"  OR WHEN "INITIAL-SA"      OR 
          WHEN "VALEXP"          OR WHEN "VALMSG"           OR WHEN "VALMSG-SA"       OR 
          WHEN "VIEW-AS"         OR WHEN "HELP"             OR WHEN "HELP-SA"         OR
          WHEN "QUOTED-NAME"     OR WHEN "FIELD-MISC21"     OR WHEN "FIELD-MISC23"    OR            
          WHEN "FIELD-MISC24"    OR WHEN "FIELD-MISC25"     OR WHEN "FIELD-MISC26"    OR 
          WHEN "FIELD-MISC27"    OR WHEN "FIELD-MISC28"     OR WHEN "MISC-PROPERTIES" OR 
          WHEN "SHADOW-NAME"     OR WHEN "INITIAL" THEN DO:
            IF ilin[2] = ? THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line =  "  " + ilin[1] + " ?".
            END.                                                                
            ELSE DO:
              RUN dctquot (ilin[2], '"',OUTPUT oq-string).
              IF LENGTH(oq-string) > 0 THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-info.df-fld = fieldname
                       df-line =  "  " + ilin[1] + " " + oq-string.
              END.       
            END.              
          END.
          
          WHEN "POSITION"     OR WHEN "LENGTH"       OR WHEN "SCALE"        OR
          WHEN "ORDER"        OR WHEN "FOREIGN-CODE" OR WHEN "FIELD-MISC11" OR 
          WHEN "FIELD-MISC12" OR WHEN "FIELD-MISC13" OR WHEN "FIELD-MISC14" OR 
          WHEN "FIELD-MISC15" OR WHEN "FIELD-MISC16" OR WHEN "FIELD-MISC17" OR 
          WHEN "FIELD-MISC18" THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-info.df-fld = fieldname
                   df-line =  "  " + ilin[1] + " " + ilin[2].
          END.
          WHEN "MANDATORY" THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-info.df-fld = fieldname
                   df-line =  "  " + ilin[1].
          END.
          WHEN "FIELD-TRIGGER"  THEN  DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-info.df-fld = fieldname
                   df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                              ilin[3] + " ". 
             IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].
             
             IF ilin[5] <> ? THEN 
                 ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.
             
             IF ilin[6] <> ? THEN 
                 ASSIGN df-line = df-line + ilin[6].
             
             IF ilin[7] <> ? THEN
                 ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
          END.
        END CASE.
        ASSIGN ilin = ?.
      END. /* end update */                    
    END. /* End of object = field */
    ELSE IF iobj = "i" THEN DO:  
      /* Drop an index */
      IF imod = "d" THEN DO:
        RUN write-tbl-sql.
       
        IF idxline <> ? THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
      
        IF conline <> ? THEN
          RUN write-con-sql.
     
        IF tablename <> ilin[5] THEN 
          ASSIGN tablename = ilin[5]
                 idxname = ilin[3]
                 comment_chars = ""
                 comment-out = FALSE.
       
 
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.                                  
        IF AVAILABLE DICTDB._File THEN DO:
          FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[3] NO-ERROR.
          IF AVAILABLE DICTDB._Index THEN DO:
            PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._File._For-owner "." DICTDB._File._For-name "." DICTDB._Index._For-name SKIP.
            PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "DROP INDEX " + '"' + DICTDB._Index._Index-name +
                              '"' + " ON " + '"' + ilin[5] + '"'. 

             IF DICTDB._Index._idx-num EQ DICTDB._File._fil-misc1[2] then do:
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-tbl = tablename
                           df-line = 'UPDATE TABLE "' + tablename + '"'.
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-tbl = tablename
                           df-line = "  FILE-MISC12 " + "?".
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-tbl = tablename
                           df-line = 'UPDATE TABLE "' + tablename + '"'.
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-tbl = tablename
                           df-line = "  PROGRESS-RECID " + string(0).
             END.
          END.
          ELSE DO:
            FIND FIRST rename-obj WHERE rename-type = "I"
                                    and t-name = ilin[5]
                                    AND new-name = ilin[3]
                                    NO-ERROR.
            IF AVAILABLE rename-obj THEN DO:  
              IF new-name BEGINS "temp-we" THEN DO:              
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                                  ilin[4] + ' "' + ilin[5] + '" '.
              END.
              ELSE DO:
                FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
                IF AVAILABLE DICTDB._Index THEN DO:
                  /* Only put out the df info since if we renamed we have already dropped. */
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' + ilin[4] +
                                   ' "' + ilin[5] + '" '.
                END.
                IF NOT AVAILABLE DICTDB._Index THEN DO:
		IF NOT batch_mode THEN DO:
		  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                      MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
		   &ELSE
                     MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                          VIEW-AS ALERT-BOX ERROR.
		  &ENDIF.
               END. 
               ELSE
	            PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
                  RETURN.
                END.
              END.               
            END.
            ELSE DO:
	    IF NOT batch_mode THEN DO:
            &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
             &ELSE
                 MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                          VIEW-AS ALERT-BOX ERROR.
            &ENDIF.
           END. 
           ELSE
	       PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                    "and index does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
              RETURN.
            END.
          END.
        END.
        ELSE DO:
          FIND FIRST rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5]
                                  NO-ERROR.
                                                                 
          IF AVAILABLE rename-obj THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = old-name
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
            IF NOT AVAILABLE DICTDB._File THEN DO:
	    IF NOT batch_mode THEN DO:
               &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                 MESSAGE "The Delta DF File contains DROP INDEX for table" ilin[5] SKIP
                      "and table does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1).
              &ELSE
                  MESSAGE "The Delta DF File contains DROP INDEX for table" ilin[5] SKIP
                      "and table does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
              &ENDIF.
          END. 
           ELSE
	         PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP INDEX for table" ilin[5] SKIP
                      "and table does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1).
              RETURN.
            END.
            IF AVAILABLE DICTDB._File THEN DO:
              FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[3] NO-ERROR.
              IF AVAILABLE DICTDB._Index THEN DO:
                PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._File._For-owner "." DICTDB._File._For-name "." DICTDB._Index._For-name SKIP.
                PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' + ilin[4] +
                                 ' "' + ilin[5] + '" '.
              END.
              ELSE DO:
                FIND FIRST rename-obj WHERE rename-type = "I"
                                        and t-name = old-name
                                        AND new-name = ilin[3]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN DO:
                  FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
                  IF NOT AVAILABLE DICTDB._Index THEN DO:
                  IF NOT batch_mode THEN DO:
		     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                        MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                            "and index does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                     &ELSE
                          MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                            "and index does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                     &ENDIF.
                  END. 
                   ELSE
	              PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                            "and index does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                    RETURN.
                  END.
                  IF AVAILABLE DICTDB._Index THEN DO:
                    /* only put to df because if we renamed first, we have dropped and added already in sql */
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                                     ilin[4] + ' "' + ilin[5] + '" '.
                  END.
                END.
                ELSE DO:
                  IF ilin[3] BEGINS "temp-we" THEN DO:
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                                     ilin[4] + ' "' + ilin[5] + '" '.
                  END.
                END.                  
              END.              
            END.  
          END.
        END.        
        ASSIGN ilin = ?.
      END. /* End delete index */                
      IF imod = "a" THEN DO:
      
        IF ilin[1] = "ADD" and ilin[2] = "INDEX" THEN DO: 
            ASSIGN misc11 = TRUE.    
          
          RUN write-tbl-sql.
                                 
          IF idxline <> ? THEN 
            RUN write-idx-sql.
            
          IF seq-line <> ? THEN
            RUN write-seq-sql.
      
          IF conline <> ? THEN
            RUN write-con-sql.
     
            ASSIGN wordidx = FALSE
                   wordfile = ?
                   is-unique = FALSE.
          
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE.

          ASSIGN transname = ilin[3]
                 idxname = ilin[3].
          IF xlate THEN DO:          
            ASSIGN transname = transname  + "," + idbtyp + "," + user_env[28].          
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT transname).
          END. 
          ASSIGN transname = transname.              
          IF user_env[6] = "Y" THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.
            IF AVAILABLE DICTDB._File THEN DO:  
              ASSIGN idx-number = 0.
              FOR EACH DICTDB._Index OF DICTDB._File:
                IF idx-number < DICTDB._Index._Idx-num THEN
                  ASSIGN idx-number = DICTDB._Index._Idx-num.
              END.
              FOR EACH n-obj WHERE n-obj.tbl-name = ilin[5]
                               AND n-obj.add-type = "I":
                  ASSIGN idx-number = idx-number + 1.
              END.
              ASSIGN idx-number = idx-number + 1.          
              forname = DICTDB._File._For-name.
              IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                  ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                ELSE DO:
                  ASSIGN forname = transname.
                  REPEAT:
                    forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                    IF LENGTH(forname) + 2 <= INTEGER(user_env[28]) THEN LEAVE.
                  END.
                  ASSIGN forname =  forname + "##".
                END.
              END.
              ELSE 
                ASSIGN forname = DICTDB._File._For-name + "##" + transname.
              
               _verify-index:
              DO WHILE TRUE:
                FIND FIRST verify-index WHERE verify-index.inew-name = forname NO-ERROR.
                FIND FIRST DICTDB._Index WHERE CAPS(DICTDB._Index._For-name) = CAPS(forname)
                                           AND DICTDB._Index._File-recid = RECID(DICTDB._File) NO-ERROR.

                IF AVAILABLE verify-Index OR AVAILABLE DICTDB._Index THEN DO:
                   /* OE00177558 - check if we found an index that was renamed */
                   IF NOT AVAILABLE verify-Index THEN DO:
                       FIND FIRST rename-obj WHERE rename-type = "I"
                            and t-name = ilin[5]
                            AND old-name = ilin[3]
                            NO-ERROR.
                       /* assuming that we are the only ones that would use 'temp-' to
                          rename index, re-add it and delete the renamed version.
                       */
                       IF AVAILABLE rename-obj AND rename-obj.new-name BEGINS "temp-" THEN DO:         
                          IF CAN-FIND (FIRST DICTDB._Index OF DICTDB._File 
                                       WHERE DICTDB._Index._Index-name = old-name) THEN DO:
                              CREATE verify-index.
                              ASSIGN verify-index.inew-name = forname.
                              LEAVE _verify-index.
                          END.
                       END.
                  END.

                  DO a = 1 TO 999:
                    IF a = 1 THEN
                      ASSIGN forname = forname + STRING(a).
                    ELSE
                      ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - LENGTH(STRING(a))) + STRING(a). 
                    IF CAN-FIND(FIRST DICTDB._Index WHERE DICTDB._Index._File-recid = RECID(DICTDB._File)
                                                  AND DICTDB._Index._For-name = forname) THEN NEXT.
                    ELSE IF CAN-FIND(FIRST verify-index WHERE verify-index.inew-name = forname) THEN NEXT.
                    ELSE DO:
                      CREATE verify-index.
                      ASSIGN verify-index.inew-name = forname.
                      LEAVE _verify-index.
                    END.
                  END.
                END.
                ELSE DO:
                  CREATE verify-index.
                  ASSIGN verify-index.inew-name = forname.
                  LEAVE _verify-index.
                END.
              END.
            END. 
            ELSE DO:
              FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
              IF AVAILABLE new-obj THEN DO:
                ASSIGN forname = new-obj.for-name. 
                IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                  IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                    ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                  ELSE DO:
                    ASSIGN forname = transname.
                    REPEAT:
                      forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                      IF LENGTH(forname) + 2 <= INTEGER(user_env[28]) THEN LEAVE.
                    END.
                    ASSIGN forname =  forname + "##".
                  END.
                END.
                ELSE ASSIGN forname = forname + "##" + transname.
                 
                _verify-new-index:
                DO WHILE TRUE:
                  FIND FIRST verify-index WHERE verify-index.inew-name = forname NO-ERROR.
                  FIND FIRST n-obj WHERE n-obj.for-name = forname 
                                       AND n-obj.tbl-name = ilin[5]
                                       AND n-obj.add-type = "I" NO-ERROR.
                  IF AVAILABLE verify-Index OR AVAILABLE n-obj THEN
                    ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - 1).
                  ELSE DO:
                    CREATE verify-index.
                    ASSIGN verify-index.inew-name = forname.
                    LEAVE _verify-new-index.
                  END.
                END.
              END.
              ELSE DO:
                FIND FIRST rename-obj WHERE rename-type = "T"
                                        AND rename-obj.new-name = ilin[5]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN DO: 
                  FIND DICTDB._File WHERE DICTDB._File._File-name = rename-obj.old-name.
                  IF AVAILABLE DICTDB._File THEN DO:
                    ASSIGN idx-number = 0.
                    FOR EACH DICTDB._Index OF DICTDB._File:
                      IF idx-number < DICTDB._Index._Idx-num THEN
                        ASSIGN idx-number = DICTDB._Index._Idx-num.
                    END.
                    FOR EACH n-obj WHERE n-obj.tbl-name = ilin[5]
                                    AND n-obj.add-type = "I":
                       ASSIGN idx-number = idx-number + 1.
                    END.
                    ASSIGN idx-number = idx-number + 1.
                  END.
                  ASSIGN forname = dsv-name.                        
                  IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                    IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                      ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                    ELSE DO:
                      ASSIGN forname = transname.
                      REPEAT:
                        forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                        IF LENGTH(forname) + 2 < INTEGER(user_env[28]) THEN LEAVE.
                      END.
                      ASSIGN forname =  forname + "##".
                    END.
                  END.
                  ELSE
                    ASSIGN forname = forname + "##" + transname. 
                END.
              END.                                       
            END. 
          END.
          ELSE
            ASSIGN forname = transname.
          
          IF AVAILABLE DICTDB._File THEN DO:
              ASSIGN idxline = "CREATE INDEX " + forname + " ON " + DICTDB._File._For-owner + "." + DICTDB._File._For-name.
              IF NOT DICTDB._File._fil-misc1[1] > 0 THEN ASSIGN  misc11 = FALSE.
          END.
          ELSE DO:
            FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
            IF AVAILABLE new-obj THEN
               ASSIGN idxline = "CREATE INDEX " + forname + " ON " + mss_username + "." + new-obj.for-name. 
            ELSE DO:
              FIND FIRST rename-obj WHERE rename-type = "T"
                                      AND rename-obj.new-name = ilin[5]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN 
                   ASSIGN idxline = "CREATE INDEX " + forname + " ON " + mss_username + "." + dsv-name.                           
            END.
          END.
          ASSIGN df-idx[1] = 'ADD INDEX "' + ilin[3] + '" ON "' + ilin[5] + '"'
                 df-idx[2] = "  INDEX-NUM " + STRING(idx-number)
                 idx-number = idx-number + 1.

          FIND FIRST rename-obj WHERE rename-type = "I"
                                  and t-name = ilin[5]
                                  AND old-name = ilin[3]
                                  NO-ERROR.
          IF AVAILABLE rename-obj THEN DO:         
            FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
            IF AVAILABLE DICTDB._Index THEN 
              PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._File._For-owner "." DICTDB._File._For-name "." DICTDB._Index._For-name SKIP "go" SKIP(1).           
          END.
          IF NOT AVAILABLE DICTDB._File AND NOT AVAILABLE rename-obj AND NOT AVAILABLE new-obj THEN DO:
	  IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains ADD INDEX for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1).
          &ELSE
             MESSAGE "The Delta DF File contains ADD INDEX for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
          END. 
           ELSE
	      PUT STREAM logfile UNFORMATTED "The Delta DF File contains ADD INDEX for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1).
            RETURN.
          END.

          RUN create-new-obj (INPUT "I", INPUT ?). 
          ASSIGN ilin = ?.
        END.  /* End of add index line */
        ELSE DO:           
          CASE ilin[1]:
            WHEN "UNIQUE" THEN 
              ASSIGN idxline = SUBSTRING(idxline, 1, 7) + "UNIQUE " + SUBSTRING(idxline,8)
                     df-idx[3] = "  " + ilin[1]
                     is-unique = TRUE.             
            WHEN "INACTIVE" THEN 
              ASSIGN df-idx[4] = "  " + ilin[1].
            WHEN "PRIMARY"  THEN
              ASSIGN df-idx[5] = "  " + ilin[1]. 
            WHEN "DESC" OR WHEN "DESCRIPTION" THEN  DO:
              RUN dctquot (ilin[2], '"',OUTPUT oq-string).  
              IF LENGTH(oq-string) > 0 THEN
                ASSIGN df-idx[6] = "  " + ilin[1] + " " + oq-string.
            END.
            WHEN "WORD" THEN DO: /* Skip, work indexes not supported */   
              ASSIGN efile = tablename + ".e".
              OUTPUT TO value(efile) APPEND.
              PUT UNFORMATTED idxname " in " tablename " is a word index and will not be contained in the" SKIP
                             "df file and no CREATE INDEX statement was generated in the sql file." SKIP(1).
              OUTPUT CLOSE.
              ASSIGN idxline = ?
                     wordidx = TRUE
                     wordfile = idxname
                     df-idx = ?.
            END.
            WHEN "INDEX-FIELD" OR WHEN "KEY-FIELD" THEN DO:   
              IF wordidx THEN NEXT.
              ELSE IF df-idx[1] <> ? THEN DO:
                DO i = 1 TO 6:
                  IF df-idx[i] <> ? THEN DO:
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = df-idx[i].
                  END.
                END.
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = "  FOREIGN-NAME " + '"' + LOWER(forname) + '"'.

                ASSIGN df-idx = ?.
              END.   
              RUN create-idx-field.
            END.
          END CASE.
          ASSIGN ilin = ?.
        END. /* End of other attributes of add index */       
      END. /* End of add index */
      
      /* Rename Index */
      ELSE IF imod = "r" THEN DO:     
        RUN write-tbl-sql.
        
        IF idxline <> ? AND idxname <> ilin[5] THEN 
          RUN write-idx-sql.
        
        IF seq-line <> ? THEN
          RUN write-seq-sql.
      
        IF conline <> ? THEN
          RUN write-con-sql.
     
        ASSIGN tablename = ilin[7]
               idxname = ilin[5]
               comment_chars = ""
               comment-out = FALSE.

        IF ilin[1] <> ? THEN DO:
          FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[7] NO-ERROR.  
              
          IF NOT AVAILABLE DICTDB._File THEN DO:
            FIND rename-obj WHERE rename-type = "T"
                              AND rename-obj.new-name = ilin[7]
                              NO-ERROR.
                             
            IF AVAILABLE rename-obj THEN
              FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR. 
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
	     IF NOT batch_mode THEN DO:
                &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                   MESSAGE "The Delta DF File contains RENAME INDEX for table" ilin[7] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
               &ELSE
                    MESSAGE "The Delta DF File contains RENAME INDEX for table" ilin[7] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
                &ENDIF.
            END. 
            ELSE
	         PUT STREAM logfile UNFORMATTED "The Delta DF File contains RENAME INDEX for table" ilin[7] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
            RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN 
            FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[3] NO-ERROR. 
          
          IF AVAILABLE DICTDB._Index THEN DO:                                                
            CREATE rename-obj.
            ASSIGN rename-type = "I"
                   t-name = ilin[7]
                   old-name = ilin[3]
                   rename-obj.new-name = ilin[5].

            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line = ilin[1] + ' ' + ilin[2] + ' "' + ilin[3] + '" ' +
                             ilin[4] + ' "' + ilin[5] + '" ' + ilin[6] + ' "' +
                             ilin[7] + '"'.
          END.
          ELSE DO:
            IF NOT batch_mode THEN DO:
               &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains RENAME INDEX" ilin[3] "for table" ilin[7] SKIP
                    "and index does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
               &ELSE
              MESSAGE "The Delta DF File contains RENAME INDEX" ilin[3] "for table" ilin[7] SKIP
                    "and index does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
              &ENDIF.
           END. 
           ELSE
	     PUT STREAM logfile UNFORMATTED "The Delta DF File contains RENAME INDEX" ilin[3] "for table" ilin[7] SKIP
                    "and index does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
            RETURN.
          END.
        END.                              
        ASSIGN ilin = ?.  
      END.
      /* Update Index */
      ELSE DO:
        IF idxline <> ?  THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
      
        IF conline <> ? THEN
          RUN write-con-sql.
     
        /* only update if primary is changing since word indexes can't be primary */
        IF ilin[2] = "PRIMARY" THEN DO:   
          FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[6] NO-ERROR.  
              
          IF NOT AVAILABLE DICTDB._File THEN DO:
            FIND rename-obj WHERE rename-type = "T"
                              AND rename-obj.new-name = ilin[6]
                              NO-ERROR.
                             
            IF AVAILABLE rename-obj THEN
              FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR. 
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
             IF NOT batch_mode THEN DO:
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                  MESSAGE "The Delta DF File contains UPDATE PRIMARY INDEX for table" ilin[6] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
              &ELSE
                   MESSAGE "The Delta DF File contains UPDATE PRIMARY INDEX for table" ilin[6] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
              &ENDIF.
             END. 
              ELSE
	     PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE PRIMARY INDEX for table" ilin[6] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
            RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN 
            FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[4] NO-ERROR. 
          
          IF NOT AVAILABLE DICTDB._Index THEN DO:                                                
            FIND rename-obj WHERE rename-type = "I"
                              AND rename-obj.new-name = ilin[4]
                              NO-ERROR.
            IF AVAILABLE rename-obj THEN
              FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
            IF NOT AVAILABLE DICTDB._Index THEN DO:
              /* check if the index is being created as well */
              FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[6] AND 
                                       new-obj.add-type = "I" AND
                                       new-obj.prg-name = ilin[4] NO-ERROR.
              IF NOT AVAILABLE new-obj THEN DO:
	      IF NOT batch_mode THEN DO:
                     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                          MESSAGE "The Delta DF File contains UPDATE PRIMARY INDEX" ilin[4] "for table" ilin[6] SKIP
                              "and index does not exist in the schema holder." SKIP
                              "This process is being aborted."  SKIP (1).
                      &ELSE
                             MESSAGE "The Delta DF File contains UPDATE PRIMARY INDEX" ilin[4] "for table" ilin[6] SKIP
                              "and index does not exist in the schema holder." SKIP
                              "This process is being aborted."  SKIP (1)
                            VIEW-AS ALERT-BOX ERROR.
                      &ENDIF.
                    END. 
                     ELSE
	               PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE PRIMARY INDEX" ilin[4] "for table" ilin[6] SKIP
                              "and index does not exist in the schema holder." SKIP
                              "This process is being aborted."  SKIP (1).

                  RETURN.
              END.
            END.
          END.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ?.
          DO i = 1 TO 9: 
            IF ilin[i] <> "" AND ilin[i] <> ? THEN DO:  
              IF df-line = ? THEN 
                ASSIGN df-line = ilin[i] + " ".                        
              ELSE 
                ASSIGN df-line = df-line + ilin[i] + " ".
            END.
          END.
        END.
      END.                  
    END. /* End of index processing */
    IF iobj = "s" THEN DO: 
      IF tablename <> ? THEN 
        RUN write-tbl-sql.
   
      RUN write-idx-sql.

      ASSIGN tablename = ?
             comment_chars = ""
             comment-out = FALSE.

      IF imod = "d" THEN DO:  
        IF ilin[3] <> seqname AND seqname <> ? THEN 
          RUN write-seq-sql.  
            
        ASSIGN seqname = ilin[3].
        IF NOT batch_mode THEN
         DISPLAY seqname @ tablename WITH FRAME WORKING.          
        
        IF xlate THEN DO:       
          ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
          RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
        END.
        ELSE IF LENGTH(ilin[3]) > INTEGER(user_env[29]) THEN DO:   
          ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
          RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
        END.
        ELSE
          ASSIGN forname = ilin[3].
       
	/* For update and delete - decision is based on foreign name , not lnewSeq */
	      
        FIND DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = dbrecid
                                AND DICTDB._Sequence._Seq-name = ilin[3]
                                NO-ERROR.
	IF AVAILABLE _Sequence THEN DO:        
           /* new sequences in MSS- drop row from SEQTMGR table and write out the line */
	   IF _Sequence._Seq-misc[1] BEGINS "_SEQT_REV_" THEN 
              /* Remove row from _SEQT_REV_SEQTMGR table */  
	        ASSIGN seq-line = "delete from _SEQT_REV_SEQTMGR where seq_name = '" + forname + "' "
				    + "                      " 
				    + " DROP TABLE _SEQT_REV_" + forname 
	               seq-type = "d"
		       seqname = ilin[3].
	  ELSE 
	  /* first drop the table and write out the line */
                ASSIGN seq-line = "DROP TABLE _SEQT_" + forname  
                       seq-type = "d"
                       seqname = ilin[3].
          RUN write-seq-sql. 

          /* Now drop the associated procedure */
          IF _Sequence._Seq-misc[1] BEGINS "_SEQT_REV_" then 
	     ASSIGN seq-line = "DROP PROCEDURE _SEQP_REV_" + forname 
                    seq-type = "d"
                    seqname = ilin[3].
          else 
	  ASSIGN seq-line = "DROP PROCEDURE _SEQP_" + forname 
                 seq-type = "d"
                 seqname = ilin[3].

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '"'.
        END.
        ELSE DO:
	IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains DROP SEQUENCE" ilin[3] SKIP
                    "and sequence does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
          &ELSE
             MESSAGE "The Delta DF File contains DROP SEQUENCE" ilin[3] SKIP
                    "and sequence does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
        END. 
        ELSE
	PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP SEQUENCE" ilin[3] SKIP
                    "and sequence does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1).
          RETURN.
        END.
      END.
      ELSE IF imod = "a"  OR imod = "m" THEN DO: 

        CASE ilin[1]:
          WHEN "ADD" THEN DO:
	   IF NOT batch_mode THEN
            DISPLAY ilin[3] @ tablename WITH FRAME WORKING.
            IF seq-line <> ? THEN
              RUN write-seq-sql.
            IF xlate THEN DO:       
              ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
            END.
            ELSE IF LENGTH(ilin[3]) > INTEGER(user_env[29]) THEN DO:   
              ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
            END.
            ELSE
              ASSIGN forname = ilin[3].
            
	    /* new sequence generator for MSS */
            IF lnewSeq THEN
                 ASSIGN seq-line = "CREATE TABLE " + mss_username + "." + "_SEQT_REV_" + forname
                        seq-type = "a"
                        seqname = ilin[3].
            ELSE 
		ASSIGN seq-line = "CREATE TABLE " + mss_username + "." + "_SEQT_" + forname
                       seq-type = "a"
                       seqname = ilin[3].

	    CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-line = 'ADD SEQUENCE "' + ilin[3] + '"'.
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-line = '  FOREIGN-NAME "' + LOWER(forname) + '"'.

          END.
         
          WHEN "UPDATE" THEN DO:         
            IF seqname <> ? THEN 
              RUN write-seq-sql.
            IF NOT batch_mode THEN
            DISPLAY ilin[3] @ tablename WITH FRAME WORKING.  
            FIND FIRST DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = dbrecid
                                          AND DICTDB._Sequence._Seq-name = ilin[3]
                                          NO-ERROR.
            IF NOT AVAILABLE _Sequence THEN DO:
	    IF NOT batch_mode THEN DO:
               &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                  MESSAGE "The Delta DF File contains UPDATE SEQUENCE" ilin[3] SKIP
                      "and sequence does not exist in the schema holder." SKIP
                       "This process is being aborted."  SKIP (1).
              &ELSE
                   MESSAGE "The Delta DF File contains UPDATE SEQUENCE" ilin[3] SKIP
                      "and sequence does not exist in the schema holder." SKIP
                       "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
              &ENDIF.
            END. 
            ELSE
	         PUT STREAM logfile UNFORMATTED "The Delta DF File contains UPDATE SEQUENCE" ilin[3] SKIP
                      "and sequence does not exist in the schema holder." SKIP
                       "This process is being aborted."  SKIP (1).
              RETURN.
            END.
            ELSE DO: 
	      IF _Sequence._Seq-misc[1] BEGINS "_SEQT_REV_" THEN DO:
		  /* new sequence generator- On update, drop old _SEQT_REV table and create again with new values */
		 ASSIGN seq-line = "update _SEQT_REV_SEQTMGR set "
                        seq-type = "u"
                        seqname = ilin[3]
		 	old_incr_val = _Sequence._Seq-Incr
			old_init_val = _Sequence._Seq-Init
			newseq_upd   = TRUE.
	      END.
              ELSE 
                 ASSIGN seq-line = "update " + _Sequence._Seq-misc[2] + "." + _Sequence._Seq-misc[1] + " set  "
                        seq-type = "u".
                        seqname = ilin[3].

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-line = 'UPDATE SEQUENCE "' + ilin[3] + '"'.                  
            END.          
          END.
          WHEN "INITIAL" THEN
            ASSIGN init = ilin[2].         
          WHEN "INCREMENT" THEN
            ASSIGN incre = ilin[2].
          WHEN "CYCLE-ON-LIMIT" THEN DO:
            IF ilin[2] = "no" THEN
              ASSIGN cyc = "0".
            ELSE
              ASSIGN cyc = "1".
          END.
          WHEN "MIN-VAL" THEN 
              ASSIGN minval = ilin[2].
          WHEN "MAX-VAL" THEN DO:
              ASSIGN maxval = ilin[2].
          END.
        END CASE.
      END.
      /* Rename sequence in schema holder only */          
      ELSE IF imod = "r" THEN DO:
        IF seq-line <> ? THEN
           RUN write-seq-sql.
           
        FIND FIRST DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = dbrecid
                                      AND DICTDB._Sequence._Seq-name = ilin[3]
                                      NO-ERROR.
        IF NOT AVAILABLE _Sequence THEN DO:
         IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The Delta DF File contains RENAME SEQUENCE" ilin[3] SKIP
                  "and sequence does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).
          &ELSE
             MESSAGE "The Delta DF File contains RENAME SEQUENCE" ilin[3] SKIP
                  "and sequence does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
               VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
         END. 
        ELSE
	    PUT STREAM logfile UNFORMATTED "The Delta DF File contains RENAME SEQUENCE" ilin[3] SKIP
                  "and sequence does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1).

          RETURN.
        END.
      IF NOT batch_mode THEN
        DISPLAY ilin[3] @ tablename WITH FRAME WORKING.
        
        IF ilin[1] <> ? THEN do:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                           ilin[4] + ' "' + ilin[5] + '"'.
        END.  
      END.
    END.
    ELSE IF iobj = "c" THEN DO:  
      /* Drop a constraint */
      IF imod = "d" THEN DO:
        RUN write-tbl-sql.
       
        IF idxline <> ? THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
        
        IF conline <> ? THEN
          RUN write-con-sql.  

        IF tablename <> ilin[5] THEN 
          ASSIGN tablename = ilin[5]
                 conname = ilin[3]
                 comment_chars = ""
                 comment-out = FALSE.
       
 
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.                                  
        IF AVAILABLE DICTDB._File THEN DO:
          FIND DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-name = ilin[3] NO-ERROR.
          IF AVAILABLE DICTDB._Constraint THEN DO:
            PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " DICTDB._File._For-owner "." DICTDB._File._For-name " DROP CONSTRAINT "  DICTDB._Constraint._For-name SKIP.
            PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "DROP CONSTRAINT " + '"' + DICTDB._Constraint._Con-name +
                              '"' + " ON " + '"' + ilin[5] + '"'.           
          END.
          ELSE DO:
	    IF NOT batch_mode THEN DO:
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                     MESSAGE "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                          "and constraint does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
             &ELSE
                     MESSAGE "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                          "and constraint does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
             &ENDIF.
          END. 
         ELSE
	          PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                          "and constraint does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1).
              RETURN.
          END.
        END.
        ELSE DO:
          FIND FIRST rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5]
                                  NO-ERROR.
                                                                 
          IF AVAILABLE rename-obj THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = old-name
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
            IF NOT AVAILABLE DICTDB._File THEN DO:
	    IF NOT batch_mode THEN DO:
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                  MESSAGE "The Delta DF File contains DROP CONSTRAINT for table" ilin[5] SKIP
                      "and table does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1).
             &ELSE
                 MESSAGE "The Delta DF File contains DROP CONSTRAINT for table" ilin[5] SKIP
                      "and table does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
              &ENDIF.
          END. 
           ELSE
	     PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP CONSTRAINT for table" ilin[5] SKIP
                      "and table does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1).
              RETURN.
            END.
            IF AVAILABLE DICTDB._File THEN DO:
               FIND DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-name = ilin[3] NO-ERROR.
               IF AVAILABLE DICTDB._Constraint THEN DO:
                  PUT STREAM tosql UNFORMATTED comment_chars " ALTER TABLE " DICTDB._File._For-owner "." DICTDB._File._For-name " DROP CONSTRAINT "  DICTDB._Constraint._For-name SKIP.
                  PUT STREAM tosql UNFORMATTED comment_chars "go" SKIP(1).
                 CREATE df-info.
                 ASSIGN df-info.df-seq = dfseq
                        dfseq = dfseq + 1
                        df-info.df-tbl = tablename
                        df-line =  "DROP CONSTRAINT " + '"' + DICTDB._Constraint._Con-name +
                                   '"' + " ON " + '"' + ilin[5] + '"'.           
               END.
               ELSE DO:
	       IF NOT batch_mode THEN DO:
                 &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                       MESSAGE "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                            "and constraint does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                  &ELSE
                       MESSAGE "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                            "and constraint does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                     &ENDIF.
                    END. 
                   ELSE
	                PUT STREAM logfile UNFORMATTED "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                            "and constraint does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1).
                    RETURN.
               END.

            END.  
          END.
        END.        
        ASSIGN conline = ?.
      END. /* End delete constraint */ 
      IF imod = "a" THEN DO:
        IF ilin[1] = "ADD" and ilin[2] = "CONSTRAINT" THEN DO:     

          RUN write-tbl-sql.
                                 
          IF idxline <> ? THEN 
            RUN write-idx-sql.
            
          IF seq-line <> ? THEN
            RUN write-seq-sql.

          IF conline <> ? THEN
            RUN write-con-sql.
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE.

          ASSIGN transname = ilin[3]
                 conname = ilin[3].
          IF xlate THEN DO:          
            ASSIGN transname = transname  + "," + idbtyp + "," + user_env[28].          
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT transname).
          END. 
          ASSIGN transname = transname.              
          IF user_env[6] = "Y" THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.
            IF AVAILABLE DICTDB._File THEN DO:  
              ASSIGN con-number = 0.
              FOR EACH DICTDB._Constraint OF DICTDB._File:
                IF con-number < DICTDB._Constraint._Con-num THEN
                  ASSIGN con-number = DICTDB._Constraint._Con-num.
              END.
              FOR EACH n-obj WHERE n-obj.tbl-name = ilin[5]
                               AND n-obj.add-type = "C":
                  ASSIGN con-number = con-number + 1.
              END.
              ASSIGN con-number = con-number + 1.          
                     forname = transname.
         
               _verify-con:
              DO WHILE TRUE:
                FIND FIRST verify-con WHERE verify-con.cnew-name = forname NO-ERROR.
                FIND FIRST DICTDB._Constraint WHERE CAPS(DICTDB._Constraint._For-name) = CAPS(forname)
                                           AND DICTDB._Constraint._File-recid = RECID(DICTDB._File) NO-ERROR.

                IF AVAILABLE verify-con OR AVAILABLE DICTDB._Constraint THEN DO:
                  DO a = 1 TO 999:
                    IF a = 1 THEN
                      ASSIGN forname = forname + STRING(a).
                    ELSE
                      ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - LENGTH(STRING(a))) + STRING(a). 
                    IF CAN-FIND(FIRST DICTDB._Constraint WHERE DICTDB._Constraint._File-recid = RECID(DICTDB._File)
                                                  AND DICTDB._Constraint._For-name = forname) THEN NEXT.
                    ELSE IF CAN-FIND(FIRST verify-con WHERE verify-con.cnew-name = forname) THEN NEXT.
                    ELSE DO:
                      CREATE verify-con.
                      ASSIGN verify-con.cnew-name = forname.
                      LEAVE _verify-con.
                    END.
                  END.
                END.
                ELSE DO:
                  CREATE verify-con.
                  ASSIGN verify-con.cnew-name = forname.
                  LEAVE _verify-con.
                END.
              END.
            END. 
            ELSE DO:
              FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
              IF AVAILABLE new-obj THEN DO:
              ASSIGN forname = transname.                 
                _verify-new-con:
                DO WHILE TRUE:
                  FIND FIRST verify-con WHERE verify-con.cnew-name = forname NO-ERROR.
                  FIND FIRST n-obj WHERE n-obj.for-name = forname 
                                       AND n-obj.tbl-name = ilin[5]
                                       AND n-obj.add-type = "C" NO-ERROR.
                  IF AVAILABLE verify-con OR AVAILABLE n-obj THEN
                    ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - 1).
                  ELSE DO:
                    CREATE verify-con.
                    ASSIGN verify-con.cnew-name = forname.
                    LEAVE _verify-new-con.
                  END.
                END.
              END.
              ELSE DO:
                FIND FIRST rename-obj WHERE rename-type = "T"
                                        AND rename-obj.new-name = ilin[5]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN DO: 
                  FIND DICTDB._File WHERE DICTDB._File._File-name = rename-obj.old-name.
                  IF AVAILABLE DICTDB._File THEN DO:
                    ASSIGN con-number = 0.
                    FOR EACH DICTDB._Constraint OF DICTDB._File:
                      IF con-number < DICTDB._Constraint._Con-num THEN
                        ASSIGN con-number = DICTDB._Constraint._Con-num.
                    END.
                    FOR EACH n-obj WHERE n-obj.tbl-name = ilin[5]
                                    AND n-obj.add-type = "C":
                       ASSIGN con-number = con-number + 1.
                    END.
                    ASSIGN con-number = con-number + 1.
                  END.
                END.
              END.                                       
            END. 
          END.
          ELSE
            ASSIGN forname = transname.
          
          IF AVAILABLE DICTDB._File THEN 
              ASSIGN conline = "ALTER TABLE " + DICTDB._File._For-owner + "." + DICTDB._File._For-name + " ADD CONSTRAINT " + forname.
          ELSE DO:
            FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
            IF AVAILABLE new-obj THEN
               ASSIGN conline = "ALTER TABLE " +  mss_username + "." + new-obj.for-name + " ADD CONSTRAINT " + forname. 
            ELSE DO:
              FIND FIRST rename-obj WHERE rename-type = "T"
                                      AND rename-obj.new-name = ilin[5]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN 
                   ASSIGN conline = "ALTER TABLE " +  mss_username + "." + dsv-name + " ADD CONSTRAINT " + forname.                      
            END.
          END.
          ASSIGN df-con[1] = 'ADD CONSTRAINT "' + ilin[3] + '" ON "' + ilin[5] + '"'
                 con-number = con-number + 1.

          IF NOT AVAILABLE DICTDB._File AND NOT AVAILABLE rename-obj AND NOT AVAILABLE new-obj THEN DO:
           IF NOT batch_mode THEN DO:
             &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
                MESSAGE "The Delta DF File contains ADD CONSTRAINT for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1).
            &ELSE
                 MESSAGE "The Delta DF File contains ADD CONSTRAINT for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
             &ENDIF.
              END. 
           ELSE
	           PUT STREAM logfile UNFORMATTED "The Delta DF File contains ADD CONSTRAINT for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1).
            RETURN.
          END.

          RUN create-new-obj (INPUT "C", INPUT ?). 
          ASSIGN ilin = ?.
        END.  /* End of add constraint line */
        ELSE DO:          
          CASE ilin[1]:
            WHEN "PRIMARY" THEN 
              ASSIGN conline = conline + " PRIMARY KEY NONCLUSTERED"
                     df-con[2] = "  " + ilin[1]
                     con-ty = "P".
            WHEN "PRIMARY-CLUSTERED" THEN 
              ASSIGN conline = conline + " PRIMARY KEY "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "P".
            WHEN "UNIQUE" THEN 
              ASSIGN conline = conline + " UNIQUE "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "U".
            WHEN "CLUSTERED" THEN
              ASSIGN conline = conline + " CLUSTERED "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "CL".
            WHEN "FOREIGN-KEY" THEN 
              ASSIGN conline = conline + " FOREIGN KEY "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "F".
            WHEN "CHECK" THEN 
              ASSIGN conline = conline + " CHECK "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "C".
            WHEN "DEFAULT" THEN 
              ASSIGN conline = conline + " DEFAULT "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "D".                                                                          
            WHEN "INACTIVE" THEN 
              ASSIGN conline = ?
                     df-con[3] = "  " + ilin[1].
            WHEN "ACTIVE" THEN 
              ASSIGN df-con[3] = "  " + ilin[1].              
            WHEN "CONSTRAINT-INDEX" THEN DO:
              ASSIGN df-con[4] = "  " + ilin[1] + " " + '"' + ilin[2] + '"'
                     conidx = ilin[2]
                     fldcon = FALSE.
                     CREATE con-type.
                     ASSIGN con-type.con-tab = tablename   
                            con-type.idx-nam = ilin[2] 
                            con-type.type    = con-ty.   
                     RUN create-con-field.
                     
                     IF df-con[1] <> ? AND con-ty <> "F" AND con-ty <> "CL" THEN DO:
                       DO i = 1 TO 6:
                          IF df-con[i] <> ? THEN DO:
                            CREATE df-info.
                            ASSIGN df-info.df-seq = dfseq
                                   dfseq = dfseq + 1
                                   df-info.df-tbl = tablename
                                   df-line = df-con[i].
                           END.
                       END.
                       ASSIGN df-con = ?.
                     END.
               IF con-ty = "CL"  THEN 
                              ASSIGN conline = ?
                                      df-con = ? .                      
            END.                
          
            WHEN "CONSTRAINT-FIELD" THEN DO:
              ASSIGN df-con[4] = "  " + ilin[1] + " " + '"' + ilin[2] + '"'.
              RUN create-idx-field. /* this procedure is being used to fetch the field name for constraint definition */
              ASSIGN idxline = ?.                         
            END.
           
            WHEN "CONSTRAINT-EXPR" THEN DO:
              IF con-ty = "C" THEN
                  ASSIGN conline = conline + " (" + replace(ilin[2],"-","_") + ")".
              ELSE
                  ASSIGN conline = conline + " " + replace(ilin[2],"-","_") + " FOR " + con-fld-name.                  
              
              ASSIGN df-con[5] = "  " + ilin[1] + ' "' + ilin[2] + '"'                     
                     fldcon = TRUE.                   
            
              IF df-con[1] <> ? THEN DO:
                DO i = 1 TO 6:
                 IF df-con[i] <> ? THEN DO:
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = df-con[i].
                 END.
                END.
              END. 
              ASSIGN df-con = ?.                
            END.        

            WHEN "PARENT-TABLE" THEN DO:          
              ASSIGN par-tab = ilin[2].
              ASSIGN df-con[5] = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "PARENT-INDEX" THEN DO:
              ASSIGN df-con[6] = "  " + ilin[1] + ' "' + ilin[2] + '"'
                     par-index = ilin[2].
              RUN create-for-con.
            END.
            WHEN "CONSTRAINT-ACTION" THEN DO:
              ASSIGN df-con[7] = "  " + ilin[1] + ' "' + ilin[2] + '"'
                     con-actn  = ilin[2]
                     fldcon = TRUE.              
              IF df-con[1] <> ? THEN DO:
                 DO i = 1 TO 7:
                    IF df-con[i] <> ? THEN DO:
                     CREATE df-info.
                     ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = df-con[i].
                    END.
                 END.
               END.
               IF con-actn <> "NONE" THEN ASSIGN conline = conline + ") ON DELETE " + con-actn.
               ELSE ASSIGN conline = conline + ")".
                 ASSIGN df-con = ?.
            END.
          
          END CASE.
        END. /* End of other attributes of add constraint */ 
      END. /* End of add constraint */
    END.                
  END.
END.

/* flush out last line of script */
RUN write-tbl-sql.
RUN write-idx-sql.
RUN write-seq-sql.
RUN write-con-sql.

IF user_env[2] = "yes" THEN DO:    
  FOR EACH df-info:     
    IF SUBSTRING(df-line,1,1) <> " " THEN
      PUT STREAM todf UNFORMATTED " " SKIP.
    PUT STREAM todf UNFORMATTED df-line SKIP.
  END.

  ASSIGN user_env[5] = SESSION:CPSTREAM.
  
 /* adds trailer with code-page-entry to end of file */ 
 {prodict/dump/dmptrail.i
        &entries      = " "
        &seek-stream  = "todf"
        &stream       = "stream todf"
        }   
        
  OUTPUT STREAM todf CLOSE.  
  OUTPUT STREAM tosql CLOSE. 
  IF NOT batch_mode THEN DO:
     HIDE FRAME working NO-PAUSE.
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE  "The following files have been created:" SKIP(1)
                 "  MS SQL Server Script:  " sqlout  SKIP
                 "     PROGRESS DF File:  " dfout SKIP(1)
                 "If the delta.df contained any drop statements," SKIP
                 "data will be lost from the SQL Server Database." SKIP 
                 "Check for warnings in <table name>.e files " SKIP.
          &ELSE
               MESSAGE "The following files have been created:" SKIP(1)
                "  MS SQL Server Script:  " sqlout  SKIP
                "     PROGRESS DF File:  " dfout SKIP(1)
                "If the delta.df contained any drop statements," SKIP
                "data will be lost from the SQL Server Database." SKIP 
                "Check for warnings in <table name>.e files " SKIP          
                VIEW-AS ALERT-BOX INFORMATION. 
          &ENDIF.
      END. 
      ELSE
	  PUT STREAM logfile UNFORMATTED "The following files have been created:" SKIP(1)
          "  MS SQL Server Script:  " sqlout  SKIP
          "     PROGRESS DF File:  " dfout SKIP(1)
          "If the delta.df contained any drop statements," SKIP
          "data will be lost from the SQL Server Database." SKIP 
          "Check for warnings in <table name>.e files " SKIP.

END.
ELSE do:
  OUTPUT STREAM todf CLOSE.
  OUTPUT STREAM tosql CLOSE.
  OS-DELETE VALUE(dfout).
  IF NOT batch_mode THEN
   HIDE FRAME working NO-PAUSE.
  
    IF NOT batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
              MESSAGE "The following file has been created: " SKIP(1)
               "MS SQL Server Script: " sqlout SKIP(1)
              "If the delta.df contained any drop statements," SKIP
              "data will be lost from the SQL Server Database." SKIP 
              "Check for warnings in <table name>.e files " SKIP.
          &ELSE
              MESSAGE "The following file has been created: " SKIP(1)
               "MS SQL Server Script: " sqlout SKIP(1)
              "If the delta.df contained any drop statements," SKIP
              "data will be lost from the SQL Server Database." SKIP 
              "Check for warnings in <table name>.e files " SKIP
               VIEW-AS ALERT-BOX INFORMATION.
          &ENDIF.
       END. 
       ELSE
	    PUT STREAM logfile UNFORMATTED "The following file has been created: " SKIP(1)
               "MS SQL Server Script: " sqlout SKIP(1)
              "If the delta.df contained any drop statements," SKIP
              "data will be lost from the SQL Server Database." SKIP 
              "Check for warnings in <table name>.e files " SKIP.

END.
RUN adecomm/_setcurs.p ("").
 
RETURN.


/* Receives comma-separated list of numbers and returns the highest value */
FUNCTION getMaxValue RETURNS INTEGER (INPUT pcInput AS CHARACTER):
    DEFINE VARIABLE numEntries AS INTEGER NO-UNDO.
    DEFINE VARIABLE this_i     AS INTEGER NO-UNDO.
    DEFINE VARIABLE this_j     AS INTEGER NO-UNDO.
    DEFINE VARIABLE this_max   AS INTEGER NO-UNDO.

    ASSIGN numEntries = NUM-ENTRIES(pcInput).

    IF numEntries < 2 THEN 
        RETURN INTEGER(pcInput).

    REPEAT this_i = 1 TO numEntries:
        this_j = INTEGER(ENTRY(this_i, pcInput)).
        IF this_j > this_max THEN
            this_max = this_j.
    END.

    RETURN this_max.
    
END FUNCTION.
/*********************************************************************
* Copyright (C) 2006-2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Procedure _mss_inc.p
   Donna L. McMann
   
   Created 12/03/02 Initial procedure for the MSS Incremental Df Utility
   
   fernando   04/17/06 Unicode support
   fernando   07/19/06 Unicode support - restrict UI   
   fernando   08/10/07 Removed UI restriction for Unicode support  
   fernando   01/22/08 Check if codepage is utf-8 before allowing unicode types 
   fernando   04/21/08 Support for new sequence generator
   fernando   03/28/09 Support for datetime-tz
   Nagaraju   09/23/09 Implementation for Computed columns
   Nagaraju   11/12/09 Remove numbers for radio-set options in MSSDS
      sdash   05/07/13 Added Logical DB validation in a Schema Holder.
                       Added logging mechanism.
*/   

{ prodict/user/uservar.i NEW }
{ prodict/mss/mssvar.i NEW }
{ prodict/misc/filesbtn.i }

DEFINE SHARED VARIABLE select_dbname   AS CHARACTER     NO-UNDO.
DEFINE VARIABLE dflt_dbname    AS CHARACTER             NO-UNDO.
DEFINE VARIABLE create_df     AS LOGICAL INITIAL TRUE   NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL FALSE  NO-UNDO. 
DEFINE VARIABLE output_file   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE df-file       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE i             AS INTEGER                NO-UNDO.
DEFINE VARIABLE schdbcon      AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE conparms      AS CHARACTER              NO-UNDO.
DEFINE VARIABLE l_curr-db     AS INTEGER INITIAL 1      NO-UNDO.
DEFINE VARIABLE l_dbnr        AS INTEGER                NO-UNDO.
DEFINE VARIABLE cFormat       AS CHARACTER 
                              INITIAL "For field widths use:"
                              FORMAT "x(21)" NO-UNDO.
DEFINE VARIABLE cRecid        AS CHARACTER 
                              INITIAL "For Create RECID use:"
                              FORMAT "x(22)" NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE s_res         AS LOGICAL                NO-UNDO.
DEFINE VARIABLE hasUniSupport AS LOGICAL                NO-UNDO.
DEFINE VARIABLE has2008Support AS LOGICAL               NO-UNDO.
DEFINE VARIABLE hasCompColSupport AS LOGICAL            NO-UNDO.
DEFINE VARIABLE l             AS LOGICAL                NO-UNDO.
DEFINE VARIABLE trgr          AS LOGICAL                NO-UNDO.
DEFINE VARIABLE cmptdcol      AS LOGICAL                NO-UNDO.
DEFINE VARIABLE wdth          AS LOGICAL                NO-UNDO.
DEFINE VARIABLE ablfmt        AS LOGICAL                NO-UNDO.

batch_mode = SESSION:BATCH-MODE.

output_file= "deltsql.log".
OUTPUT STREAM logfile TO VALUE(output_file) NO-ECHO NO-MAP UNBUFFERED.
logfile_open = true. 

FORM
  " "   SKIP 
    df-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Delta DF File" colon  15
  btn_File SKIP SKIP({&VM_WIDG})
  osh_dbname   FORMAT "x(256)"  view-as fill-in size 32 by 1 
    LABEL "Schema Holder Database" colon 35 SKIP({&VM_WID}) 
  mss_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
    LABEL "Connect Parameters for Schema" colon 35 SKIP({&VM_WID})
  mss_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Logical Name for MSS Database" colon 35 SKIP({&VM_WID})   
  mss_username    FORMAT "x(32)"  VIEW-AS FILL-IN SIZE 32 BY 1
    LABEL "MSS Object Owner Name" COLON 35 SKIP({&VM_WID})    
  long-length LABEL " Maximum Varchar Length"  COLON 35 SKIP({&VM_WIDG})
  SPACE(3) pcompatible view-as toggle-box LABEL "Create RECID Field"  
  SPACE(10) shadowcol VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" SKIP({&VM_WID})
  SPACE (3) dflt VIEW-AS TOGGLE-BOX LABEL "Include Default" 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(13) &ELSE SPACE (14) &ENDIF
  create_df view-as toggle-box LABEL "Create Schema Holder Delta DF" SKIP({&VM_WID})
  SPACE(3) unicodeTypes view-as toggle-box LABEL "Use Unicode Types " 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(10) &ELSE SPACE (9) &ENDIF
  lUniExpand VIEW-AS TOGGLE-BOX LABEL "Expand Width (utf-8)" SKIP({&VM_WID})
  SPACE (3) mapMSSDatetime VIEW-AS TOGGLE-BOX LABEL "Map to MSS 'Datetime' Type"
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(2) &ELSE SPACE (1) &ENDIF
  newseq   view-as toggle-box label "Use Revised Sequence Generator"
  SKIP({&VM_WID}) SPACE(2) cFormat VIEW-AS TEXT NO-LABEL  
  iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                             "ABL Format", 2
                                 HORIZONTAL NO-LABEL 
  lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30" AT 54 SKIP({&VM_WID})
  SPACE(2) cRecid VIEW-AS TEXT NO-LABEL  
  iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS "Trigger", 1,
                                             "Computed Column", 2
                                 HORIZONTAL NO-LABEL SKIP({&VM_WID})

	     {prodict/user/userbtns.i}
  WITH FRAME read-df ROW 2 CENTERED SIDE-labels 
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF
  TITLE "Delta df to MS SQL Server Conversion".

/*=============================Triggers===============================*/

/*----- ON GO or OK -----*/
ON GO OF FRAME read-df
DO:
  IF (df-file:SCREEN-VALUE IN FRAME read-df = ? OR
      df-file:SCREEN-VALUE IN FRAME read-df = "") THEN DO:
    MESSAGE "Delta DF File is required. " VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO df-file IN FRAME read-df.
    RETURN NO-APPLY.
  END.

  IF SEARCH(df-file:SCREEN-VALUE IN FRAME read-df) = ? THEN DO:
    MESSAGE "Can not find a file of this name.  Try again." 
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO df-file IN FRAME read-df.
    RETURN NO-APPLY.
  END.
  ELSE
    ASSIGN df-file = df-file:SCREEN-VALUE IN FRAME read-df.

  IF osh_dbname:SCREEN-VALUE IN FRAME read-df = "" OR 
              osh_dbname:SCREEN-VALUE IN FRAME read-df = ? THEN DO:
    MESSAGE "Schema Holder Name is required."  VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO osh_dbname IN FRAME read-df.
    RETURN NO-APPLY. 
  END.
  
  IF mss_username:SCREEN-VALUE IN FRAME read-df = "" OR 
              mss_username:SCREEN-VALUE IN FRAME read-df = ? THEN DO:
    MESSAGE "MSS Object Owner Name is required."  VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO mss_username IN FRAME read-df.
    RETURN NO-APPLY. 
  END.

  REPEAT l_dbnr = 1 to NUM-DBS:
    IF LDBNAME("DICTDB") = LDBNAME(l_dbnr)
     THEN ASSIGN l_curr-db = l_dbnr.
  END.
  
  DO i = 1 TO NUM-DBS:
    IF PDBNAME(i) = osh_dbname:SCREEN-VALUE IN FRAME read-df OR 
       LDBNAME(i) = osh_dbname:SCREEN-VALUE IN FRAME read-df THEN DO:
      ASSIGN schdbcon = TRUE.
      CREATE ALIAS DICTDB FOR DATABASE 
         VALUE(LDBNAME(osh_dbname:SCREEN-VALUE IN FRAME read-df)).
    END.
  END.
  IF NOT schdbcon THEN DO:
    ASSIGN conparms = mss_conparms:SCREEN-VALUE IN FRAME read-df +  
                            " -ld schdb".
    CONNECT VALUE(osh_dbname:SCREEN-VALUE IN FRAME read-df) 
            VALUE(conparms) NO-ERROR.
    IF NOT CONNECTED(LDBNAME(osh_dbname:SCREEN-VALUE IN FRAME read-df)) THEN DO:
      MESSAGE osh_dbname:SCREEN-VALUE IN FRAME read-df
         " can not be connected using entered connect parameters."
        VIEW-AS ALERT-BOX ERROR.
      APPLY "ENTRY" to osh_dbname IN FRAME read-df.
      RETURN NO-APPLY.
     END.
  END.
  l = no.
  IF mss_dbname:screen-value IN FRAME read-df = ? OR 
     mss_dbname:screen-value IN FRAME read-df = "" THEN DO:

     MESSAGE "Logical database cannot be left blank.  Default will be restored." 
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     ASSIGN mss_dbname:SCREEN-VALUE = dflt_dbname. 
     RETURN NO-APPLY.
  END.
  FIND FIRST DICTDB._Db WHERE _Db._Db-name = mss_dbname:screen-value NO-ERROR.
  IF AVAILABLE(_Db) THEN DO:
     APPLY "ENTRY" to mss_dbname IN FRAME read-df.
     l = yes.
  END.
  FIND FIRST DICTDB._File where DICTDB._File._Db-recid = RECID(DICTDB._Db) NO-LOCK NO-ERROR. 
  IF NOT AVAILABLE DICTDB._File THEN DO:
     MESSAGE "Logical database cannot is empty.  Do you want to continue?" 
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     ASSIGN mss_dbname:SCREEN-VALUE = dflt_dbname. 
     RETURN NO-APPLY.
  END.
  IF l THEN DO:
     ASSIGN mss_dbname = DICTDB._Db._Db-name
            shadowcol = (IF _Db-misc1[1] = 0 THEN TRUE ELSE FALSE)
            hasUniSupport = (DICTDB._Db._Db-xl-name = "utf-8")
            has2008Support = NO.

     /* To support computed columns, check for MSS 2005 or higher */
     IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 9 THEN 
         hasCompColSupport = YES.

     /* if SQL 2008 and above and native Driver 10, let user select 2008 types */
     IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 10 THEN DO:
       IF (DICTDB._Db._db-misc2[1] BEGINS "SQLNCLI") AND INTEGER(ENTRY(1,DICTDB._Db._db-misc2[2],".")) >= 10 THEN
            has2008Support = YES.
     END.
  END. 
  ELSE DO: 
     MESSAGE "Logical database " mss_dbname:screen-value " does not exist in schema holder " osh_dbname VIEW-AS ALERT-BOX ERROR.
     RETURN NO-APPLY.
  END.
END.

/*----- HELP in MSS Incremental Utility FRAME read-df -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
on HELP of frame read-df or CHOOSE of btn_Help in frame read-df
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Incremental_Schema_Migration_Dlg_Box},
                             INPUT ?).
&ENDIF

on WINDOW-CLOSE of frame read-df
   apply "END-ERROR" to frame read-df.

ON LEAVE OF df-file in frame read-df
   df-file:screen-value in frame read-df = 
        TRIM(df-file:screen-value in frame read-df).

ON CHOOSE OF btn_File in frame read-df DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT df-file:handle in frame read-df /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT "*.df"                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.

ON VALUE-CHANGED OF iFmtOption IN FRAME read-df DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lFormat:CHECKED   = FALSE
           lFormat:SENSITIVE = FALSE.
  ELSE
    ASSIGN lFormat:CHECKED   = TRUE
           lFormat:SENSITIVE = TRUE.
END. 

ON LEAVE OF long-length IN FRAME read-df DO:
  IF (unicodeTypes:SCREEN-VALUE = "no") AND INTEGER(long-length:SCREEN-VALUE) > 8000 THEN DO:  
    MESSAGE "The maximum length for a varchar is 8000" VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.
  ELSE IF unicodeTypes:SCREEN-VALUE = "yes" AND INTEGER(long-length:SCREEN-VALUE) > 4000 THEN DO:  
    MESSAGE "The maximum length for a nvarchar is 4000" VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.

END.

ON VALUE-CHANGED OF pcompatible IN FRAME read-df DO:
  IF SELF:SCREEN-VALUE = "no" THEN
     ASSIGN iRecidOption:SCREEN-VALUE = "1"
            iRecidOption:SENSITIVE = FALSE.
  ELSE
     ASSIGN iRecidOption:SCREEN-VALUE = "1"
            iRecidOption:SENSITIVE = TRUE.
END. 

ON VALUE-CHANGED OF unicodeTypes IN FRAME read-df DO:
 IF SELF:screen-value = "no" THEN
     ASSIGN long-length:SCREEN-VALUE = "8000"
            lUniExpand:SCREEN-VALUE = "no"
            lUniExpand:SENSITIVE = NO.
 ELSE
     ASSIGN long-length:SCREEN-VALUE = "4000"
            lUniExpand:SENSITIVE = YES
            s_res = lUniExpand:MOVE-AFTER-TAB-ITEM(unicodeTypes:HANDLE).
END.

/*==========================Mainline code=============================*/        

{adecomm/okrun.i  
    &FRAME  = "FRAME read-df" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
}

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME read-df = yes.
&ENDIF

IF LDBNAME("DICTDB") <> ? THEN DO:
  FOR EACH DICTDB._DB NO-LOCK:
    IF DICTDB._Db._Db-type = "PROGRESS" THEN
      ASSIGN osh_dbname = LDBNAME ("DICTDB")
             mss_conparms = "<current working database>".
    /* If no select_dbname, select the last logical DB of schema holder with type = MSS */
    ELSE IF DICTDB._Db._Db-type = "MSS" THEN DO:
     IF select_dbname = "" OR select_dbname = DICTDB._Db._Db-name THEN DO:
      ASSIGN mss_dbname = DICTDB._Db._Db-name
             shadowcol = (IF _Db-misc1[1] = 0 THEN TRUE ELSE FALSE)
             hasUniSupport = (DICTDB._Db._Db-xl-name = "utf-8")
             has2008Support = NO.

      /* To support computed columns, check for MSS 2005 or higher */
      IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 9 THEN 
          hasCompColSupport = YES.

      /* if SQL 2008 and above and native Driver 10, let user select 2008 types */
      IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 10 THEN DO:
         IF (DICTDB._Db._db-misc2[1] BEGINS "SQLNCLI") AND INTEGER(ENTRY(1,DICTDB._Db._db-misc2[2],".")) >= 10 THEN
             has2008Support = YES.
      END.
    END.
    ASSIGN dflt_dbname = mss_dbname.
   END.
  END.
END.

ASSIGN pcompatible = TRUE
       long-length = 8000
       iRecidOption = 1.       

DISPLAY cFormat lFormat mapMSSDatetime cRecid WITH FRAME read-df.

UPDATE df-file 
       btn_file
       osh_dbname
       mss_conparms
       mss_dbname
       mss_username
       long-length
       pcompatible
       shadowcol WHEN shadowcol = TRUE
       dflt
       create_df
       unicodeTypes WHEN hasUniSupport 
       lUniExpand WHEN unicodeTypes
       mapMSSDatetime WHEN has2008Support
       newseq
       iFmtOption
       lFormat WHEN iFmtOption = 2
       iRecidOption WHEN hasCompColSupport
       btn_OK btn_Cancel
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            btn_Help
       &ENDIF
  WITH FRAME read-df.
       
IF unicodeTypes:SCREEN-VALUE ="yes" THEN
   ASSIGN unicodeTypes = YES.
IF lUniExpand:SCREEN-VALUE ="yes" THEN
   ASSIGN lUniExpand = YES.

IF (iRecidOption= 1) then
  ASSIGN trgr = TRUE
        cmptdcol = FALSE.
ELSE 
  ASSIGN cmptdcol = TRUE
	trgr = FALSE.

IF (iFmtOption= 1) then
  ASSIGN wdth = TRUE
      ablfmt = FALSE.
ELSE
  ASSIGN wdth = FALSE
        ablfmt = TRUE.

   PUT STREAM logfile UNFORMATTED
       " " skip
       "Delta df to MS SQL Server Conversion Parameters" skip(2)
       "Delta DF File:                          " df-file skip
       "Schema Holder Database:                 " osh_dbname skip
       "Connect Parameters fo Schema:           " mss_conparms skip
       "Logical Name for MSS Database:          " mss_dbname SKIP
       "MSS Object Owner Name:                  " mss_username SKIP
       "Maximum Varchar Length:                 " long-length skip
       "Create RECID Field:                     " pcompatible SKIP
       "Create Shadow Columns:                  " shadowcol SKIP
       "Include Default:                        " dflt SKIP
       "Create Schema Holder Delta DF:          " create_df SKIP
       "Use Unicode Types:                      " unicodeTypes SKIP
       "Expand Width (utf-8):                   " lUniExpand SKIP
       "Map to MSS 'Datetime' Type:             " mapMSSDatetime SKIP
       "Use Revised Sequence Generator:         " newseq SKIP
       "For Field width use                     "  skip
       "                         Width:         " wdth SKIP
       "                    ABL Format:         " ablfmt SKIP
       "             Expand x(8) to 30:         " lFormat SKIP 
       "For Create RECID use                    " SKIP
       "                       Trigger:         " trgr SKIP
       "               Computed Column:         " cmptdcol SKIP(3).

ASSIGN user_env[1]  = df-file
       user_env[3]  = ""
       user_env[4]  = "n"
       user_env[5]  = "go"
       user_env[6]  = "y"
       user_env[7]  = (IF dflt THEN "y" ELSE "n")
       user_env[8]  = "y"
       user_env[9]  = "ALL"
       user_env[10] = string(long-length)
       user_env[11] = (IF unicodeTypes THEN "NVARCHAR" ELSE "VARCHAR" ) 
       user_env[12] = "datetime"
       user_env[13] = "tinyint"
       user_env[14] = "integer"
       user_env[15] = "decimal(18,5)"
       user_env[16] = "decimal"
       user_env[17] = "integer"
       user_env[18] = (IF unicodeTypes THEN "NVARCHAR(MAX)" ELSE "TEXT")
       user_env[19] = "tinyint"
       user_env[20] = "##"  
       user_env[21] = (IF shadowcol THEN "y" ELSE "n")
       user_env[22] = "MSS"
       user_env[23] = "30"
       user_env[24] = "15"
       /* first y is for sequence support.
          second entry is for new sequence generator */
       user_env[25] = "y" + (IF newseq THEN ",y" ELSE ",n")
       user_env[28] = "128"
       user_env[29] = "128"            
       user_env[30] = "y"
       user_env[31] = "-- ** "
       user_env[32] = "MSSQLSRV7".
    
IF lUniExpand THEN 
   ASSIGN user_env[35] = "y".
ELSE
   ASSIGN user_env[35] = "n".

IF pcompatible THEN 
   ASSIGN user_env[27] = "y" + "," + STRING(iRecidOption).
ELSE
   ASSIGN user_env[27] = "no".

IF iFmtOption = 1 THEN 
    ASSIGN sqlwidth = TRUE. /* Use _Width field for size */
ELSE IF (lFormat = FALSE) THEN
    ASSIGN sqlwidth = ?. /* Use _Format field for size */
ELSE
    ASSIGN sqlwidth = FALSE. /* Calculate size */

/* create df for schema holder */
IF create_df THEN
  ASSIGN user_env[2] = "yes".
ELSE
  ASSIGN user_env[2] = "no".

RUN prodict/mss/_gendsql.p.
 
IF NOT schdbcon THEN 
   DISCONNECT DICTDB. 
ELSE DO:
  IF LDBNAME(l_curr-db) = ? THEN
    DELETE ALIAS DICTDB.
  ELSE
    RUN adecomm/_setalia.p
        ( INPUT l_curr-db
        ).
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: procbfrpul.p

Description:   
   This file creates the procedure to pull constraint info during independent 
   pull operation.

HISTORY
Author: Kumar Mayur

Date Created: 06/21/2011

          kmayur  22/2/2012   OE00217787- compatibility for MSS 2000
----------------------------------------------------------------------------*/
Define var sql1 as char.
define var h1 as int.

Define var sql2 as char.
define var h2 as int.

sql1 = "IF EXISTS (SELECT * FROM sysobjects WHERE type = 'P' AND name = '_Constraint_Info') ".
sql1 = sql1 + "BEGIN ".
sql1 = sql1 + "DROP Procedure _Constraint_Info ".
sql1 = sql1 + "END ".

RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE NO-ERROR (sql1).
IF ERROR-STATUS:ERROR THEN .
ELSE IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
    CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h1.
END.
ELSE DO:
 CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h1.
END.

sql2 = "CREATE PROCEDURE _Constraint_Info @table_name varchar(80) AS ".

sql2 =  sql2 + "CREATE TABLE #tmp(Table_Name Varchar(80),Column_Name Varchar(80),Constr_Name varchar(120) ,Const_type Varchar(80), ".
sql2 =  sql2 +  "Def_check_Exp Varchar(8000),Parent_Key Varchar(120),Parnt_Key_Num Integer,Indx_Num Integer,Indx_Name Varchar(80), par_tab Varchar(80)) ".


sql2 = sql2 +  "INSERT INTO #tmp     
        select  t.name , c.name ,o.name , o.xtype,cols.COLUMN_DEFAULT ,NULL ,NULL ,NULL ,NULL ,NULL
        from syscolumns c
        inner join sysobjects o  
        on o.id = c.cdefault 
        inner join sysobjects t     
        on c.id = t.id and t.name = @table_name
        inner join INFORMATION_SCHEMA.COLUMNS cols
        on c.name = cols.COLUMN_NAME and cols.TABLE_NAME = @table_name ".

sql2 = sql2 + "INSERT INTO #tmp
        select   columns.TABLE_NAME,  columns.COLUMN_NAME, checks.CONSTRAINT_NAME,'C',  checks.CHECK_CLAUSE, NULL ,NULL ,NULL ,NULL ,NULL
        from INFORMATION_SCHEMA.COLUMNS columns 
        inner join  INFORMATION_SCHEMA.CONSTRAINT_COLUMN_USAGE  usage 
        on  columns.COLUMN_NAME = usage.COLUMN_NAME 
        and columns.TABLE_NAME = usage.TABLE_NAME
        and columns.TABLE_NAME = @table_name
        inner join INFORMATION_SCHEMA.CHECK_CONSTRAINTS  checks 
        on usage.CONSTRAINT_NAME = checks.CONSTRAINT_NAME  ".

sql2 = sql2 + "INSERT INTO #tmp
        select  tt.name,c.name  ,i.name , 'CLUSTERED' ,NULL,NULL ,NULL ,NULL ,NULL ,NULL from
        sysindexes i 
        inner join sysindexkeys ic on i.indid = 1
        and ic.indid = i.indid and i.id = ic.id 
        inner join syscolumns c on c.colorder = ic.colid and c.id = ic.id 
        inner join  sysobjects tt on tt.id = c.id where tt.name = @table_name  ".

sql2 = sql2 + "INSERT INTO #tmp
        select  c.TABLE_NAME  , c.COLUMN_NAME, pk.CONSTRAINT_NAME , pk.CONSTRAINT_TYPE ,NULL,NULL ,NULL ,NULL ,NULL ,NULL
	    from INFORMATION_SCHEMA.TABLE_CONSTRAINTS pk ,
	    INFORMATION_SCHEMA.KEY_COLUMN_USAGE c
	    where  
	    (pk.CONSTRAINT_TYPE = 'PRIMARY KEY' OR pk.CONSTRAINT_TYPE = 'UNIQUE')
	    and c.TABLE_NAME = pk.TABLE_NAME 
	    and c.TABLE_NAME = @table_name
	    and	c.CONSTRAINT_NAME = pk.CONSTRAINT_NAME  ".

sql2 = sql2 + "create table _prgrstmptable(Parent_tab varchar(80),Unique_key varchar(80),col_name varchar(80), constr_name varchar(120))  ".
 
sql2 = sql2 + "INSERT INTO _prgrstmptable   
        select tt.name,rc.UNIQUE_CONSTRAINT_NAME    , c.name, rc.CONSTRAINT_NAME from
        sysindexes i 
        inner join sysindexkeys ic on i.indid = ic.indid
        and i.id = ic.id 
        inner join INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS rc on rc.UNIQUE_CONSTRAINT_NAME = i.name 
        inner join syscolumns c on c.colorder = ic.colid and c.id = ic.id 
        inner join  sysobjects tt on tt.id = c.id ".

sql2 =  sql2 + " INSERT INTO #tmp
        select distinct c.TABLE_NAME  , c.COLUMN_NAME  ,pk.CONSTRAINT_NAME ,
        pk.CONSTRAINT_TYPE , NULL,  _prgrstmptable.Unique_key ,NULL ,NULL ,NULL , _prgrstmptable.Parent_tab
        from 	INFORMATION_SCHEMA.TABLE_CONSTRAINTS pk,INFORMATION_SCHEMA.KEY_COLUMN_USAGE c,_prgrstmptable
        where pk.TABLE_NAME = c.TABLE_NAME 
        and  pk.TABLE_NAME = @table_name
        and  pk.CONSTRAINT_TYPE = 'FOREIGN KEY'  
	    and	 c.CONSTRAINT_NAME = pk.CONSTRAINT_NAME 
	    and  _prgrstmptable.constr_name = c.CONSTRAINT_NAME  ".

sql2 =  sql2 + " DROP TABLE _prgrstmptable ".
	    
sql2 = sql2 + "SELECT * FROM #tmp ".
sql2 = sql2 + "go ".

RUN STORED-PROC DICTDBG.send-sql-statement h2 = PROC-HANDLE NO-ERROR (sql2).
IF ERROR-STATUS:ERROR THEN .
ELSE IF ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
    CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h2.
END.
ELSE DO:
 CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h2.
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: protomss1.p

Description:   
   This file contains the user interface for the split migration window 
   for openEdge to MS SQL Server Migration
 
Author: Kumar Mayur

Date Created: 06/20/2011 

History:


----------------------------------------------------------------------------*/


&Scoped-define FRAME-NAME DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS mig_cnst TOGGLE-7 TOGGLE-8 TOGGLE-9 ~
RADIO-SET-5 TOGGLE-13 RADIO-SET-6 BUTTON-1 BUTTON-2 BUTTON-3 
&Scoped-Define DISPLAYED-OBJECTS mig_cnst TOGGLE-7 TOGGLE-8 TOGGLE-9 ~
RADIO-SET-5 TOGGLE-13 RADIO-SET-6 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* ***********************  Control Definitions  ********************** */

{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i  }




DEFINE VARIABLE tmp_str       AS CHARACTER                NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.

batch_mode = SESSION:BATCH-MODE.
/* Definitions of the field level widgets                               */
DEFINE BUTTON butt-ok
     LABEL "OK" 
     SIZE 10 BY 1.

DEFINE BUTTON butt-cancel
     LABEL "Cancel" 
     SIZE 10 BY 1.

DEFINE BUTTON butt-help 
     LABEL "Help" 
     SIZE 10 BY 1.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  SIZE 75 BY 5.5.     
     &ELSE SIZE 75 BY 7.5. &ENDIF.
     
DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  SIZE 75 BY 1.9.     
     &ELSE SIZE 75 BY 4 . &ENDIF.

&IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL FGCOLOR 7
     SIZE 74 BY 1.4. 
&ENDIF.     

DEFINE VARIABLE text1      AS CHARACTER 
                           INITIAL "Apply Uniqueness as:"
                           FORMAT "x(21)" NO-UNDO.
DEFINE VARIABLE text2      AS CHARACTER 
                           INITIAL "Create RECID Field using"
                           FORMAT "x(30)" NO-UNDO.   
DEFINE VARIABLE text3      AS CHARACTER 
                           INITIAL "Using"
                           FORMAT "x(8)" NO-UNDO.    
DEFINE VARIABLE text4      AS CHARACTER 
                           INITIAL "For field widths use"
                           FORMAT "x(22)" NO-UNDO.              
DEFINE VARIABLE s_res         AS LOGICAL                  NO-UNDO.

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME DEFAULT-FRAME
     migConstraint view-as toggle-box label "Migrate Constraints" AT 2 SKIP({&VM_WIDG})
     SPACE(2)    
     tryPimaryForRowid view-as toggle-box LABEL "Try Primary for ROWID" AT 2
     recidCompat view-as toggle-box LABEL "Maintain RECID compatibility" AT 35 SKIP({&VM_WID})
     text2 VIEW-AS TEXT NO-LABEL AT 2
     iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS
        "Trigger", 1,
        "Computed column", 2
        HORIZONTAL AT 33 NO-LABEL SKIP({&VM_WID})
     ForRow view-as toggle-box LABEL "For" AT 8 
     choiceRowid VIEW-AS RADIO-SET RADIO-BUTTONS 
        "ROWID", 1,
        "Prime ROWID", 2
        HORIZONTAL AT 17 NO-LABEL SKIP({&VM_WID})
     ForRowidUniq view-as toggle-box LABEL "For ROWID Uniqueness" AT 8 SKIP({&VM_WID})
     selBestRowidIdx view-as toggle-box LABEL "Select 'Best' ROWID Index"  AT 2 SKIP({&VM_WID})
     text3 VIEW-AS TEXT NO-LABEL AT 8
     choiceSchema VIEW-AS RADIO-SET RADIO-BUTTONS
        "OE Schema", 1,
        "Foreign schema", 2
        HORIZONTAL AT 28 NO-LABEL SKIP({&VM_WIDG})
     SPACE(2)
     mapMSSDatetime view-as toggle-box LABEL "Map to MSS 'Datetime' Type"  AT 2 
     shadowcol view-as toggle-box label "Create Shadow Column" AT 38 SKIP({&VM_WID})
     newseq view-as toggle-box LABEL  "Use revised sequence Generator"  AT 2 SKIP({&VM_WIDG})
     SPACE(2)         
     unicodeTypes view-as toggle-box LABEL "Use Unicode Types"  AT 2 
     lUniExpand view-as toggle-box LABEL "Expand Width(utf-8)" AT 36 SKIP({&VM_WID})
     text4 VIEW-AS TEXT NO-LABEL AT 2 
     iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS
         "Width", 1,
         "ABL Format", 2
         HORIZONTAL AT 24 NO-LABEL 
     lExpand view-as toggle-box LABEL "Expand x(8) to 30"  AT 53 SKIP({&VM_WIDG})
     
     SPACE(2)
     text1 VIEW-AS TEXT NO-LABEL AT 2       
     choiceUniquness VIEW-AS RADIO-SET RADIO-BUTTONS
         "Index Attributes", "1",
         "Constraints", "2"
         HORIZONTAL NO-LABEL AT 23 SKIP({&VM_WID})
     dflt  view-as toggle-box LABEL "Include Default" AT 2 SKIP({&VM_WID})
    
     "Apply Defaults as:" VIEW-AS TEXT AT 2
     choiceDefault VIEW-AS RADIO-SET RADIO-BUTTONS 
        "Field Attributes", "1",
        "Constraints", "2"
        HORIZONTAL AT 20 NO-LABEL SKIP({&VM_WIDG})
       
     butt-ok AT 3 WIDGET-ID 22
     butt-cancel AT 14 WIDGET-ID 24
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
         butt-help AT 26
     &ENDIF
     
    RECT-1 AT ROW 2.2 COL 1 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-2 AT ROW 10.3 COL 1   
     &ELSE RECT-2 AT ROW 12.1 COL 1 &ENDIF

    &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-3 AT ROW 15.5 COL 2 &ENDIF                   
 
    WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
    VIEW-AS DIALOG-BOX TITLE "OpenEdge To MS SQL Server Conversion Advanced Options".

IF not recid_verify THEN
  ASSIGN recidCompat:hidden in frame DEFAULT-FRAME = TRUE.

ON CHOOSE OF butt-ok IN FRAME DEFAULT-FRAME 
DO:

   Assign migConstraint = (migConstraint:SCREEN-VALUE = "yes").

   ASSIGN tryPimaryForRowid  = (tryPimaryForRowid:SCREEN-VALUE  = "yes").
   ASSIGN recidCompat = (recidCompat:SCREEN-VALUE  = "yes").
   ASSIGN ForRow  = (ForRow:SCREEN-VALUE  = "yes").
   ASSIGN ForRowidUniq  = (ForRowidUniq:SCREEN-VALUE  = "yes").
   ASSIGN selBestRowidIdx  = (selBestRowidIdx:SCREEN-VALUE  = "yes").
   ASSIGN choiceRowid = INTEGER(choiceRowid:SCREEN-VALUE).
   ASSIGN iRecidOption = INTEGER(iRecidOption:SCREEN-VALUE).
   ASSIGN choiceSchema = INTEGER(choiceSchema:SCREEN-VALUE).
   IF NOT (ForRowidUniq OR ForRow) THEN 
   ASSIGN iRecidOption = 0
            pcompatible = FALSE.
   IF (ForRowidUniq OR ForRow) THEN ASSIGN pcompatible = TRUE. 
   Assign dflt = (dflt:SCREEN-VALUE = "yes").
   Assign mapMSSDatetime = (mapMSSDatetime:SCREEN-VALUE = "yes" ).
   Assign newseq = (newseq:SCREEN-VALUE = "yes" ). 
   ASSIGN choiceDefault = choiceDefault:screen-value.
   ASSIGN choiceUniquness = choiceUniquness:screen-value.
   ASSIGN shadowcol = (shadowcol:SCREEN-VALUE = "yes").
   ASSIGN lUniExpand = (lUniExpand:SCREEN-VALUE ="yes").
   ASSIGN iFmtOption = INTEGER(iFmtOption:SCREEN-VALUE).
   ASSIGN lExpand = (lExpand:SCREEN-VALUE = "yes" ).
   
   IF iFmtOption = 1 THEN
      ASSIGN lFormat = ?
             iFmtOption = 1.
   ELSE 
      ASSIGN lFormat = (NOT lExpand)
             iFmtOption = 2.

   IF unicodeTypes:SCREEN-VALUE ="yes" THEN
       ASSIGN long-length = 4000
              unicodeTypes = TRUE.
   ELSE 
   ASSIGN  long-length = 8000
           unicodeTypes = FALSE.
   
   APPLY "CLOSE":U TO THIS-PROCEDURE.
   APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
END.

ON CHOOSE OF butt-cancel in frame DEFAULT-FRAME 
DO:  
   APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
END.

ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME 
DO:
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
END. 

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME DEFAULT-FRAME OR CHOOSE OF butt-help IN FRAME DEFAULT-FRAME
 DO:   
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&OpenEdge_DB_to_MS_SQL_Advanced_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

ON VALUE-CHANGED OF iFmtOption IN FRAME DEFAULT-FRAME DO:
  IF SELF:SCREEN-VALUE = "2" THEN
    ASSIGN lExpand:SENSITIVE = TRUE
           lExpand:CHECKED   = TRUE
           lFormat           = FALSE.
  ELSE ASSIGN lExpand:SENSITIVE = FALSE
              lExpand:CHECKED   = FALSE
              lFormat           = TRUE. 
END.

IF shdcol = YES
  THEN DO:
  ASSIGN  
           shadowcol:SENSITIVE IN FRAME DEFAULT-FRAME  = TRUE
           s_res = shadowcol:MOVE-BEFORE-TAB-ITEM(dflt:HANDLE).
  END.
  ELSE DO:
  ASSIGN 
           shadowcol:SENSITIVE IN FRAME DEFAULT-FRAME = FALSE
           shadowcol:CHECKED IN FRAME DEFAULT-FRAME = NO. 
  END.

ON VALUE-CHANGED OF dflt IN FRAME DEFAULT-FRAME DO:
 IF dflt:screen-value = "no" THEN
     ASSIGN choiceDefault:SENSITIVE = NO.
 ELSE
     ASSIGN choiceDefault:SENSITIVE = YES.
END.
 
ON VALUE-CHANGED OF unicodeTypes IN FRAME DEFAULT-FRAME DO:
 IF SELF:screen-value = "no" THEN
     ASSIGN
            lUniExpand:SCREEN-VALUE = "no"
            lUniExpand:SENSITIVE = NO.
 ELSE
     ASSIGN lUniExpand:SENSITIVE = YES
            s_res = lUniExpand:MOVE-AFTER-TAB-ITEM(unicodeTypes:HANDLE).
END.

ON VALUE-CHANGED OF tryPimaryForRowid IN FRAME DEFAULT-FRAME DO:
  IF SELF:SCREEN-VALUE = "no" THEN DO:
    IF selBestRowidIdx:SCREEN-VALUE = "no" THEN
       ASSIGN ForRowidUniq:SENSITIVE   = FALSE
           ForRowidUniq:SCREEN-VALUE   = "no".
  END.
  ELSE DO:
       IF ForRow:screen-value   = "no"  THEN 
          ASSIGN ForRowidUniq:SENSITIVE   = TRUE.
       IF ForRowidUniq:screen-value   = "no"  THEN 
          ASSIGN forRow:SENSITIVE   = TRUE.
  END.
  IF ForRow:SCREEN-VALUE = "yes" THEN
     ASSIGN ForRow:SENSITIVE   = TRUE.
  ELSE ASSIGN ForRow:SENSITIVE   = FALSE.
  IF selBestRowidIdx:SCREEN-VALUE = "yes" THEN
     ASSIGN selBestRowidIdx:SENSITIVE   = TRUE.
  ELSE ASSIGN selBestRowidIdx:SENSITIVE   = FALSE.
END.

ON VALUE-CHANGED OF migConstraint IN FRAME DEFAULT-FRAME DO:
  IF SELF:SCREEN-VALUE = "no" THEN DO:
    IF selBestRowidIdx:screen-value   = "no" THEN DO:
       ASSIGN ForRow:SENSITIVE   = TRUE.
       IF ForRow:screen-value   = "no"  THEN 
          ASSIGN selBestRowidIdx:SENSITIVE   = TRUE
                 iRecidOption:SENSITIVE   = FALSE.
       ELSE ASSIGN iRecidOption:SENSITIVE   = TRUE.
    END.
    ELSE selBestRowidIdx:SENSITIVE   = TRUE.
  END.
END.
/* Initialize RECID logic */
ON VALUE-CHANGED OF ForRow IN FRAME DEFAULT-FRAME DO:
 IF SELF:screen-value = "yes" THEN DO:
     ASSIGN ForRowidUniq:SCREEN-VALUE   = "no"
            ForRowidUniq:SENSITIVE   = FALSE
            iRecidOption:SENSITIVE   = TRUE
            choiceRowid:SENSITIVE   = TRUE
            selBestRowidIdx:SENSITIVE   = FALSE
            selBestRowidIdx:SCREEN-VALUE   = "no"
            choiceSchema:SENSITIVE   = FALSE.
 END.
 ELSE DO:
   ForRow:SENSITIVE   = FALSE.
   ASSIGN selBestRowidIdx:SENSITIVE   = TRUE
         selBestRowidIdx:SCREEN-VALUE   = "yes"
         choiceSchema:SENSITIVE   = TRUE
         iRecidOption:SENSITIVE   = FALSE
         choiceRowid:SCREEN-VALUE   = "0"
         ForRowidUniq:SENSITIVE   = TRUE.
         choiceRowid:SENSITIVE   = FALSE.
 END.
END.

ON VALUE-CHANGED OF ForRowidUniq IN FRAME DEFAULT-FRAME DO:
 IF SELF:screen-value = "yes" THEN DO:
     ASSIGN forRow:SCREEN-VALUE   = "no"
            forRow:SENSITIVE   = FALSE
            choiceRowid:SENSITIVE   = FALSE
            iRecidOption:SENSITIVE   = TRUE
            selBestRowidIdx:SENSITIVE   = FALSE
            selBestRowidIdx:SCREEN-VALUE   = "yes"
            choiceSchema:SENSITIVE   = FALSE.
            choiceSchema:SCREEN-VALUE = "1".
 END.
 ELSE DO:
    selBestRowidIdx:SENSITIVE   = TRUE.
    IF selBestRowidIdx:screen-value = "no"  THEN
       ASSIGN forRow:SENSITIVE   = TRUE.
    ELSE
       choiceSchema:SENSITIVE   = TRUE.
    iRecidOption:SENSITIVE   = FALSE.
 END.
END.

ON VALUE-CHANGED OF selBestRowidIdx IN FRAME DEFAULT-FRAME DO:
 IF SELF:screen-value = "yes" THEN DO:
    ASSIGN forRow:SENSITIVE   = FALSE
           choiceRowid:SENSITIVE   = FALSE
           choiceSchema:SENSITIVE   = TRUE
           forRow:SCREEN-VALUE   = "no"
           ForRowidUniq:SENSITIVE = TRUE.
    IF ForRowidUniq:screen-value = "yes"  THEN
       ASSIGN choiceSchema:SENSITIVE    = FALSE
              choiceSchema:SCREEN-VALUE = "1".
 END.
 ELSE DO:
    ASSIGN selBestRowidIdx:SENSITIVE   = FALSE
           ForRowidUniq:SCREEN-VALUE   = "no"
           ForRowidUniq:SENSITIVE   = FALSE
           ForRow:SENSITIVE   = TRUE
           ForRow:SCREEN-VALUE   = "yes"
           choiceRowid:SENSITIVE   = TRUE
           iRecidOption:SENSITIVE   = TRUE
           choiceSchema:SENSITIVE   = FALSE.
 END.
END.

IF NOT batch_mode THEN
  DO: 
   DISPLAY text1 text2 text3 text4 WITH FRAME DEFAULT-FRAME.
   UPDATE
        migConstraint
        tryPimaryForRowid
        recidCompat WHEN recid_verify = TRUE
        iRecidOption
        ForRow  WHEN ForRowidUniq = FALSE
        choiceRowid WHEN ForRow = TRUE
        ForRowidUniq WHEN ForRow = FALSE
        selBestRowidIdx WHEN ForRow = FALSE
        choiceSchema WHEN selBestRowidIdx = TRUE 
              
        mapMSSDatetime
        shadowcol WHEN shdcol = YES  
        newseq
        unicodeTypes
        lUniExpand WHEN unicodeTypes = TRUE
        iFmtOption 
        lExpand WHEN iFmtOption = 2  
         
        choiceUniquness
        dflt
        choiceDefault WHEN dflt = TRUE
        butt-ok butt-cancel
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            butt-help
        &ENDIF              	        
        WITH FRAME DEFAULT-FRAME. 
        
        ASSIGN recidCompat = (recidCompat:SCREEN-VALUE  = "yes").
        ASSIGN iRecidOption = INTEGER(iRecidOption:SCREEN-VALUE).
        ASSIGN ForRow  = (ForRow:SCREEN-VALUE  = "yes").
        ASSIGN ForRowidUniq  = (ForRowidUniq:SCREEN-VALUE  = "yes").
        ASSIGN selBestRowidIdx  = (selBestRowidIdx:SCREEN-VALUE  = "yes").
        ASSIGN choiceRowid = INTEGER(choiceRowid:SCREEN-VALUE).
        ASSIGN choiceSchema = INTEGER(choiceSchema:SCREEN-VALUE).
        IF NOT (ForRowidUniq OR ForRow) THEN 
        ASSIGN iRecidOption = 0
              pcompatible = FALSE.
        IF (ForRowidUniq OR ForRow) THEN ASSIGN pcompatible = TRUE. 
   
        ASSIGN choiceDefault = choiceDefault:screen-value.
        ASSIGN shadowcol = (shadowcol:SCREEN-VALUE = "yes").
        ASSIGN lUniExpand = (lUniExpand:SCREEN-VALUE ="yes").
        ASSIGN iFmtOption = INTEGER(iFmtOption:SCREEN-VALUE).
   
        IF iFmtOption = 1 THEN
            ASSIGN lFormat = ?
                   iFmtOption = 1.
        ELSE 
            ASSIGN lFormat = (NOT lExpand)
                   iFmtOption = 2.

        IF unicodeTypes:SCREEN-VALUE ="yes" THEN
            ASSIGN long-length = 4000
                   unicodeTypes = TRUE.
        ELSE 
             ASSIGN long-length = 8000
                    unicodeTypes = FALSE.
 END.
/*--------------------------------------------------------------------
 
File: prodict/mss/_genrowid.p
 
Description:
    wrapper to prodict/mss/genrowid.i, which generates constraint entries in original
    PROGRESS-DB based on ROWID's selected in SI 
 
 
Input-Parameters:
    none
 
Output-Parameters:
    none
 
History:
    06/11   ashukla    created
 
 
--------------------------------------------------------------------*/
/*h-*/
 
/*----------------------------  DEFINES  ---------------------------*/
 
{ prodict/mss/mssvar.i NEW }
{ prodict/mss/genrowid.i
  &edb-type = "MSS"}

/***********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights      *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/


/*--------------------------------------------------------------------

File: prodict/mss/genrowid.i

Description:
    wrapper to prodict/mss/genrowid.p, which fix-up an original PROGRESS-DB
    to add _constraints based on ROWID's selected in MSS SI
    

Textual-Parameter:
    &edb-type   { MS SQL Server }

Output-Parameters:
    none
    
History:
    06/11   ashukla   created

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define variable l_overwrite     as logical   INIT NO NO-UNDO.
define variable l_file          as character NO-UNDO.
define variable l_for-db        as character format "x(12)" NO-UNDO.
define variable l_pro-db        as character format "x(12)" NO-UNDO.
define variable l_db-type       as character format "x(20)" NO-UNDO.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }


                /*## UI-Part ##*/
form
  SKIP ({&TFM_WID})
  l_pro-db      colon 22 label "Original {&PRO_DISPLAY_NAME} DB" FORMAT "x({&PATH_WIDG})"
    VIEW-AS FILL-IN SIZE 40 BY 1
    help "Name of the original {&PRO_DISPLAY_NAME} DB"  {&STDPH_FILL}  SKIP ({&VM_WID})
  l_for-db      colon 22 label "Schema Image"
    help "Name of the SI to fix-up to match the {&PRO_DISPLAY_NAME} DB"
       {&STDPH_FILL}  SKIP ({&VM_WID})

   &if "{&edb-type}" = " "
            &then
      l_db-type     colon 22 label "DB Type"
        view-as radio-set horizontal radio-buttons 
    "MS SQL Server","MS SQL Server","ORACLE","ORACLE" 
            &endif
  l_overwrite LABEL "Overwrite existing constraints."  view-as TOGGLE-BOX
                  at 2  skip({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME l_frm_beauty ROW 5 CENTERED SIDE-LABELS
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX title "Generate Constraints from ROWID".
                /*## UI-Part ##*/

/*===============================Triggers==================================*/
 
  /*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  on HELP of frame l_frm_beauty OR CHOOSE of btn_Help in frame l_frm_beauty
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                 	     	     INPUT {&Adjust_Schema_dialog_box},
        	       	     	     INPUT ?).
&ENDIF


ON WINDOW-CLOSE OF FRAME l_frm_beauty
DO:
    APPLY "END-ERROR" TO FRAME l_frm_beauty.
END.
  
/*------------------------  INT.-PROCEDURES  -----------------------*/

/*------------------------  INITIALIZATIONS  -----------------------*/

/* format of l_file:
 *  { **all** 
 *  | { <comma-separated list of tables> | **all** } ; 
 *    { <comma-separated list of sequences> | **all** } ;
 *    { <comma-separated list of views> | **all** } 
 *  }
 */

assign
  l_file    = "**all**"
        &if "{&edb-type}" = "**ODBC**"
            &then
  l_db-type = entry(lookup(user_env[22],"mss,s10")
                   ,"MS SQL Server,SYBASE-10")
            &else
  l_db-type = "{&edb-type}"
            &endif
  l_for-db  = user_dbname
  l_pro-db  = ( if   ldbname("DICTDB2") <> ?
                 and dbtype ("DICTDB2") =  "PROGRESS"
                  then ldbname("DICTDB2")
                  else ?
              )
  .

/*---------------------------  MAIN-CODE  --------------------------*/
{adecomm/okrun.i  
  &FRAME  = "FRAME l_frm_beauty " 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  {&CAN_BTN}
  {&HLP_BTN}
}
                /*## UI-Part ##*/
update
  l_pro-db
  l_for-db
        &if "{&edb-type}" = " "
            &then
  l_db-type
            &endif
  l_overwrite
  btn_OK
  btn_Cancel
   {&HLP_BTN_NAME}
  with frame l_frm_beauty.
                /*## UI-Part ##*/

if LDBNAME("DICTDB2") <> l_pro-db
 then do:
  create alias DICTDB2 for database value(l_pro-db) no-error.
  end.

if LDBNAME("DICTDB") <> SDBNAME(l_for-db)
 then do:
  create alias DICTDB for database value(sdbname(l_for-db)) no-error.
  end.

if LDBNAME("DICTDB2") = ?
 or ldbname("DICTDB") = ?
 then do:
    MESSAGE "You must be connected to both the Original {&PRO_DISPLAY_NAME} Database" SKIP
            "and the Schema Holder before running this option." SKIP
    VIEW-AS ALERT-BOX.
    leave.
END.
if LDBNAME("DICTDB2") = LDBNAME("DICTDB")
then do:
   message "The Original {&PRO_DISPLAY_NAME} DB cannot be the same as" skip
           "the Schema Image DB."
           view-as alert-box.
   undo,retry.
end.

/* This routine returns the recid of the foreign database.  We do not want to
   reference the database directly here because the schema will be cached and
   we will not see the modifications that have been made the the adjust
   schema routine.
*/
run prodict/gate/beauty1.p(input l_pro-db, output drec_db).
assign
  user_env[25] = l_file.

ASSIGN l_overwrite      = (l_overwrite:SCREEN-VALUE IN FRAME l_frm_beauty = "yes").

RUN prodict/mss/genrowid.p (l_db-type, l_overwrite ).

/* in order to get the schema-chache recreated we switch the alias */
create alias DICTDB for database value(l_pro-db).
/* if this is not enough, we need to actually call some routine
 * that uses the alias?
 */
/**/
 output to x.p.
 put "for each DICTDB._File: end.".
 output close.
 run x.p.
/**/
create alias DICTDB for database value(sdbname(l_for-db)).
run x.p.

OS-DELETE x.p. 
/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/*
File: prodict/mss/genrowid.p
      invoved from wrapper file prodict/mss/genrowid.i  

History: 
       ashukla 06/11     Created
*/  

DEFINE INPUT PARAMETER p_edbtype AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER l_overwrite AS logical NO-UNDO.


DEFINE VARIABLE msg              AS CHARACTER NO-UNDO.
DEFINE VARIABLE idbtype          AS CHARACTER NO-UNDO.
DEFINE VARIABLE cons_name        AS CHARACTER NO-UNDO.
DEFINE VARIABLE cons_desc        AS CHARACTER NO-UNDO INITIAL "Generated from SI ROWID".
DEFINE VARIABLE cons_type        AS CHARACTER NO-UNDO. 
DEFINE VARIABLE l_con-num        AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_files          AS CHARACTER NO-UNDO.
DEFINE VARIABLE a                AS INTEGER   NO-UNDO.
DEFINE VARIABLE max_id_length    AS INTEGER   NO-UNDO INITIAL 128.
DEFINE VARIABLE mandatory        AS LOGICAL   NO-UNDO INITIAL TRUE.

{ prodict/dictvar.i }
{ prodict/mss/mssvar.i } /* temp */
{ prodict/user/uservar.i }

/* DICTDB2 is original progress database.
 * DICTDB is newly created schema holder.
*/


/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
FORM
  SKIP(1)
  msg FORMAT "x(35)" LABEL "  Processing File" SKIP
  SKIP(1)
  WITH FRAME mss_fix ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  TITLE " Generating Constraint From MSS SI ROWID".
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

IF NOT SESSION:BATCH-MODE  
 then assign SESSION:IMMEDIATE-DISPLAY = yes.

/* Current implementation processes all tables. l_file can be a ; separated list to process
   only selective tables.
*/
 ASSIGN l_files = "**all**".

 idbtype = { adecomm/ds_type.i
                &direction = "ETOI"
                &from-type = "p_edbtype"
                }.


/*------------------------------------------------------------------*/
/*------------------------       FILE       ------------------------*/
/*------------------------------------------------------------------*/

FOR EACH DICTDB._File WHERE DICTDB._File._Owner = "_FOREIGN" 
                         AND DICTDB._File._Tbl-type = "T"
                         AND ( l_files = "**all**"
                               or lookup(DICTDB._File._File-name,l_files) <> 0):
  ASSIGN l_con-num = 0. 
  IF DICTDB._File._File-name BEGINS "_" THEN NEXT.  
  
 
  FIND DICTDB2._File WHERE DICTDB2._File._File-name = DICTDB._File._File-name 
                      and DICTDB2._File._DB-recid = drec_db 
                      and DICTDB2._File._Owner = "PUB" NO-ERROR.

  IF NOT AVAILABLE DICTDB2._File THEN 
  FIND DICTDB2._File WHERE DICTDB2._File._For-name = DICTDB._File._File-name 
                      and DICTDB2._File._DB-recid = drec_db 
                      and DICTDB2._File._Owner = "PUB" NO-ERROR.
                      
  IF NOT AVAILABLE DICTDB2._File THEN NEXT.
/*
Progress Table : DICTDB2._File._File-name
Schema Holder Table name : DICTDB._File._File-name
*/
/*------------------------------------------------------------------*/
/*------------------------  generate CONSTRAINTS     ---------------*/
/*------------------------------------------------------------------*/

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB._File._File-name @ msg 
         WITH FRAME mss_fix.

     FIND FIRST DICTDB2._CONSTRAINT OF DICTDB2._File  WHERE 
                               (DICTDB2._Constraint._Con-Type = "P" OR DICTDB2._Constraint._Con-Type = "PC" OR
                                DICTDB2._Constraint._Con-Type = "MP" OR DICTDB2._Constraint._Con-Type = "M") 
                            AND DICTDB2._Constraint._Con-Status <>  "O"
     NO-ERROR.
    
     IF AVAILABLE DICTDB2._CONSTRAINT THEN DO:
       IF l_overwrite THEN DO:
          assign DICTDB2._CONSTRAINT._Con-Status   = "O"
                 DICTDB2._CONSTRAINT._Con-Desc     = "Retired by system utility".
       END.
       ELSE NEXT.
     END.

      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._idx-num = DICTDB._File._Fil-misc1[2]
      NO-ERROR.

      IF AVAILABLE DICTDB._Index 
      THEN DO:
        FIND DICTDB2._Index OF DICTDB2._File WHERE DICTDB2._Index._Index-name = DICTDB._Index._Index-name
        NO-ERROR.
        FOR EACH DICTDB2._Index-field OF DICTDB2._Index:
            IF CAN-FIND(DICTDB2._Field WHERE RECID(DICTDB2._Field) = DICTDB2._Index-field._Field-Recid 
                        AND DICTDB2._Field._Mandatory EQ FALSE ) THEN ASSIGN mandatory = FALSE. 
        END.
        IF mandatory THEN  ASSIGN cons_type = "P". ELSE ASSIGN cons_type = "M".

        ASSIGN cons_name = "_PKC_" + DICTDB2._File._File-Name + "_" + DICTDB2._Index._Index-name.
      /*  need to truncate name if too big */
       IF length(cons_name) > max_id_length then cons_name = substring(cons_name,1,max_id_length).
       
        _verify-cons:
        DO WHILE TRUE:
        find DICTDB2._Constraint WHERE DICTDB2._Constraint._Con-Name = cons_name NO-ERROR.
        IF NOT AVAILABLE DICTDB2._Constraint THEN DO:
           LEAVE _verify-cons.
        END.
        ELSE DO:
          DO a = 1 TO 999:
             ASSIGN cons_name = SUBSTRING(cons_name, 1, LENGTH(cons_name) - LENGTH(STRING(a))) + STRING(a).
             IF CAN-FIND( DICTDB2._Constraint WHERE DICTDB2._Constraint._Con-Name = cons_name ) THEN NEXT.
             ELSE LEAVE _verify-cons.
          END.
        END.
        END.  /* end DO WHILE TRUE: */

        for each DICTDB2._Constraint:
          IF l_con-num < DICTDB2._Constraint._con-num THEN
             ASSIGN l_con-num = DICTDB2._Constraint._con-num.
        END. 
        l_con-num  = l_con-num + 1.

        CREATE DICTDB2._Constraint.
        ASSIGN
           DICTDB2._Constraint._File-recid   = RECID (DICTDB2._File)
           DICTDB2._Constraint._db-recid     = drec_db
           DICTDB2._Constraint._Index-recid  = RECID (DICTDB2._Index)
           DICTDB2._Constraint._Con-Desc     = cons_desc 
           DICTDB2._constraint._con-num      = l_con-num 
           DICTDB2._Constraint._Con-Name     = cons_name
           DICTDB2._Constraint._For-Name     = cons_name
           DICTDB2._Constraint._Con-Type     = cons_type
           DICTDB2._Constraint._Con-Status   = "N"
           DICTDB2._Constraint._Con-Active   = TRUE.
      END.
      ASSIGN mandatory = FALSE.  /* re-initialize */
END. /* each DICTDB._File */


IF NOT SESSION:BATCH-MODE THEN 
    HIDE FRAME mss_fix NO-PAUSE.

IF NOT SESSION:BATCH-MODE  
 then assign SESSION:IMMEDIATE-DISPLAY = no.

RETURN.

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _mss_act.p

Description:   
   This file contains the form for activation and deactivation of Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/admnhlp.i }
{prodict/user/uservar.i}

DEFINE {1} BUTTON OK_BUT  
     LABEL "OK" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CANCEL_BUT 
     LABEL "Cancel" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON HELP_BUT 
     LABEL "Help" 
     SIZE 13 BY 1.
     
&IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL FGCOLOR 7
     SIZE 53 BY 1.4. 
&ENDIF.
     
DEFINE VARIABLE RADIO-SET-1 AS char 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "Activate", "1",
          "Deactivate", "2"
     SIZE 32 BY 1.91 NO-UNDO.
     
DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     LABEL "Constraint type  ." 
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "ALL","PRIMARY","CLUSTERED","UNIQUE","FOREIGN KEY","DEFAULT", "CHECK" 
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.
  

DEFINE FRAME DEFAULT-FRAME
     RADIO-SET-1 AT ROW 1.4 COL 4 NO-LABEL WIDGET-ID 2
     Constrainttype AT ROW 4.05 COL 20 COLON-ALIGNED WIDGET-ID 6
     OK_BUT AT ROW 6.5 COL 3 WIDGET-ID 8
     CANCEL_BUT AT ROW 6.5 COL 17 WIDGET-ID 10
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  HELP_BUT AT ROW 6.5 COL 40 &ENDIF
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-1 AT ROW 6.3 COL 2 &ENDIF    
     WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 57 BY 10.05 WIDGET-ID 100
     VIEW-AS DIALOG-BOX TITLE "Activate/Deactivate Constraint Definitions".


ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
END.

ON CHOOSE OF OK_BUT IN FRAME DEFAULT-FRAME
  DO:     
       IF user_dbtype    NE "MSS" then 
	   RUN SAVE.
	   RUN CHECK_DEL.	  
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.
  
ON CHOOSE OF CANCEL_BUT IN FRAME DEFAULT-FRAME
  DO:     
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.   

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME DEFAULT-FRAME OR CHOOSE OF HELP_BUT IN FRAME DEFAULT-FRAME
 DO:   
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&DataServer_Activate_Deactivate_Constraint_Definitions_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

RADIO-SET-1 = RADIO-SET-1:screen-value.

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.


PROCEDURE enable_UI :

  DISPLAY Constrainttype RADIO-SET-1 OK_BUT CANCEL_BUT 
  WITH FRAME DEFAULT-FRAME.
  ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL".
  ENABLE Constrainttype RADIO-SET-1 OK_BUT CANCEL_BUT
          &IF "{&WINDOW-SYSTEM}" <> "TTY"
          &THEN HELP_BUT  
          &ENDIF          
      WITH FRAME DEFAULT-FRAME.
 
END PROCEDURE.

PROCEDURE SAVE:
    
   IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL"  THEN
   DO:
       FOR EACH DICTDB._constraint EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN 
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
    
   IF  Constrainttype:SCREEN-VALUE="PRIMARY"  THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "P" OR DICTDB._constraint._con-type = "PC" 
                     OR DICTDB._constraint._con-type = "MP" :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN   
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.  
     
   IF Constrainttype:SCREEN-VALUE= "UNIQUE" THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "U" EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
   
   IF Constrainttype:SCREEN-VALUE= "CLUSTERED" THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "M" EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
   
   IF Constrainttype:SCREEN-VALUE= "CHECK"  THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "C" EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
    
   IF Constrainttype:SCREEN-VALUE= "DEFAULT"  THEN
   DO:
       FOR EACH DICTDB._constraint WHERE  DICTDB._constraint._con-type = "D"  EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN 
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
 
   IF Constrainttype:SCREEN-VALUE= "FOREIGN KEY"  THEN 
   DO:
       FOR EACH DICTDB._constraint WHERE  DICTDB._constraint._con-type = "F"  EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
   
END PROCEDURE.

PROCEDURE CHECK_DEL:

    FOR EACH DICTDB._constraint WHERE ( DICTDB._constraint._Con-Status = "O" OR  DICTDB._constraint._Con-Status = "D"):
        ASSIGN DICTDB._constraint._con-active = False.
    END.    
END.

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _msc_del.p

Description:   
   This file contains the form for the deletion of Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/admnhlp.i }

DEFINE BUTTON OK_BUT 
     LABEL "OK" 
     SIZE 13 BY 1.

DEFINE BUTTON CANCEL_BUT 
     LABEL "Cancel" 
     SIZE 13 BY 1.

DEFINE BUTTON HELP_BUT 
     LABEL "Help" 
     SIZE 13 BY 1.

&IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL FGCOLOR 7
     SIZE 53 BY 1.4. 
&ENDIF.

DEFINE VARIABLE ans AS logical.
DEFINE STREAM   constlog.
DEFINE VARIABLE cnstrpt_name       AS CHARACTER   NO-UNDO.
DEFINE BUFFER   CON_DICTDB         FOR DICTDB._Constraint.

DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     LABEL "Constraint type  ." 
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "ALL","PRIMARY","CLUSTERED","UNIQUE","FOREIGN KEY","DEFAULT", "CHECK"
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.

DEFINE FRAME DEFAULT-FRAME
   
     Constrainttype AT ROW 2 COL 20 COLON-ALIGNED WIDGET-ID 6
     OK_BUT  AT ROW 5.5 COL 3 WIDGET-ID 8
     CANCEL_BUT AT ROW 5.5 COL 17 WIDGET-ID 10
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  HELP_BUT AT ROW 5.5 COL 40 &ENDIF 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-1 AT ROW 5.3 COL 2 &ENDIF 
     WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 57 BY 8.05 WIDGET-ID 100
     VIEW-AS DIALOG-BOX TITLE "Delete Constraint Definitions".

ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
END.

ON CHOOSE OF OK_BUT IN FRAME DEFAULT-FRAME
  DO:          
	   RUN SAVE.
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.
  
ON CHOOSE OF CANCEL_BUT IN FRAME DEFAULT-FRAME
  DO:     
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.   

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME DEFAULT-FRAME OR CHOOSE OF HELP_BUT IN FRAME DEFAULT-FRAME
 DO:   
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&MS_SQL_Server_DataServer_Delete_Constraints_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.


PROCEDURE enable_UI :
  DISPLAY  Constrainttype 
      WITH FRAME DEFAULT-FRAME.
      ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL".
  
  ENABLE Constrainttype OK_BUT CANCEL_BUT 
          &IF "{&WINDOW-SYSTEM}" <> "TTY"
          &THEN HELP_BUT  
          &ENDIF            
      WITH FRAME DEFAULT-FRAME.
 
END PROCEDURE.

PROCEDURE SAVE:

ASSIGN cnstrpt_name = "constraint.lg".
OUTPUT STREAM constlog TO VALUE(cnstrpt_name) UNBUFFERED APPEND NO-ECHO NO-MAP.

  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL"  
  THEN DO :
    MESSAGE "Are you sure you want to delete all constraints from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
        FOR EACH DICTDB._constraint EXCLUSIVE-LOCK :
            DELETE DICTDB._constraint.
	    END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "PRIMARY"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Primary constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "PC" 
              OR DICTDB._constraint._con-type = "P" OR DICTDB._constraint._con-type = "MP" EXCLUSIVE-LOCK :
            IF CAN-FIND (FIRST CON_DICTDB WHERE CON_DICTDB._Index-Parent-Recid = DICTDB._Constraint._Index-Recid 
                        AND (CON_DICTDB._Con-Status <> "O" AND CON_DICTDB._Con-Status <> "D"))
            THEN          
              PUT STREAM constlog UNFORMATTED " cannot delete constraint " + DICTDB._constraint._con-Name + " as it is referenced by a foreign key"  SKIP.
            ELSE   
	          DELETE DICTDB._constraint.
         END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "CLUSTERED"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Clustered constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "M" EXCLUSIVE-LOCK :
	         DELETE DICTDB._constraint.
         END.
  END. 
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "UNIQUE"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Unique constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "U" EXCLUSIVE-LOCK :
            IF CAN-FIND (FIRST CON_DICTDB WHERE CON_DICTDB._Index-Parent-Recid = DICTDB._Constraint._Index-Recid 
                     AND (CON_DICTDB._Con-Status <> "O" OR CON_DICTDB._Con-Status <> "D"))
            THEN          
              PUT STREAM constlog UNFORMATTED " cannot delete constraint " + DICTDB._constraint._con-Name + " as it is referenced by a foreign key"  SKIP.
            ELSE   
	          DELETE DICTDB._constraint.
         END.
  END. 
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "CHECK"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Check constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "C" EXCLUSIVE-LOCK :
	         DELETE DICTDB._constraint.
         END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "DEFAULT"
  THEN DO:
    MESSAGE "Are you sure you want to delete all Default constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "D" EXCLUSIVE-LOCK :
	         DELETE DICTDB._constraint.
         END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "FOREIGN KEY"
  THEN DO:
    MESSAGE "Are you sure you want to delete all Foreign constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "F" EXCLUSIVE-LOCK :
	         DELETE DICTDB._constraint.
         END.
  END. 
OUTPUT STREAM constlog  CLOSE.  
END.

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _msc_viw.p

Description:   
   This file contains the form for View Maintain Foreign Constraints in MSS.

HISTORY
Author: Uttam Shrivastava 

Date Created: 11/25/2011
----------------------------------------------------------------------------*/
{prodict/user/uservar.i }
{prodict/mss/key/viewmnt.i NEW}

Define var access as logical NO-UNDO.
Define FRAME frame_const. 
Define {1} var sTbLbl2          as char NO-UNDO init "Tables".
Define {1} var cnstLbl2         as char NO-UNDO INIT "Constraints" .
Define {1} var TblRecId         as recid    NO-UNDO. 
Define {1} var Show_Hidden_Tbls as logical init no  NO-UNDO.


DEFINE BUTTON btnCreate 
     LABEL "C&reate Constraint..." 
     SIZE 22 BY 1.3.

DEFINE BUTTON btnProps  
     LABEL "Constraint &Properties..." 
     SIZE 24 BY 1.3.

DEFINE BUTTON s_btnDelete  
     LABEL "De&lete Constraint" 
     SIZE 22 BY 1.3.
DEFINE VARIABLE is_error    AS LOGICAL.
DEFINE VARIABLE c_lst_Cnsts AS CHARACTER.
DEFINE VARIABLE c_lstTbls   AS CHARACTER.
DEFINE VARIABLE tbl_fill    AS CHARACTER FORMAT "X(256)":U.
DEFINE VARIABLE cnst_fill   AS CHARACTER FORMAT "X(256)":U.

DEFINE FRAME frame_const
     sTbLbl2  AT ROW 2 COL 7  NO-LABEL format "x(28)" view-as TEXT
     cnstLbl2 AT ROW 2 COL 46 NO-LABEL format "x(28)" view-as TEXT
     tbl_fill AT ROW 2.7 COL 7 NO-LABEL VIEW-AS FILL-IN SIZE 28 BY .9
     c_lstTbls AT ROW 3.86 COL 7 NO-LABEL VIEW-AS SELECTION-LIST SIZE 28 BY 6 SINGLE 
                                   SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     cnst_fill AT ROW 2.7 COL 46 NO-LABEL VIEW-AS FILL-IN SIZE 28 BY .9
     c_lst_Cnsts AT ROW 3.86 COL 46 NO-LABEL VIEW-AS SELECTION-LIST SINGLE 
                                   SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL SIZE 28 BY 6
     btnCreate AT ROW 12 COL 4 
     btnProps AT ROW 12 COL 28.5 
     s_btnDelete AT ROW 12 COL 55 
     
    WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 3 ROW 1
         SIZE 80 BY 16
         view-as DIALOG-BOX TITLE "View/Maintain Foreign Constraint Definitions" .
      
ASSIGN cnstLbl2:screen-value IN FRAME frame_const = cnstLbl2.
ASSIGN sTbLbl2:screen-value IN FRAME frame_const = sTbLbl2  .

ON CHOOSE OF btnCreate IN FRAME frame_const
   DO:
      IF NOT is_error THEN DO:
          IF c_table_name = "" OR c_table_name = "?" THEN MESSAGE "No table selected, please select a table" VIEW-AS ALERT-BOX ERROR.
          ELSE DO:
              FIND FIRST DICTDB._index OF DICTDB._file WHERE DICTDB._file._file-name = c_table_name 
                                                            AND DICTDB._File._Db-Recid = DbRecid NO-LOCK NO-ERROR. 
              IF DICTDB._Index._Index-name = "default" THEN 
                          MESSAGE " An index is required before creating a constraint, create an index before proceeding" VIEW-AS ALERT-BOX ERROR.
              ELSE RUN prodict/mss/key/constraint.p.    
          END.
          RUN fill_constraint.
       END.   
       ELSE MESSAGE "Please select a valid table" VIEW-AS ALERT-BOX ERROR.  
   END.

ON CHOOSE OF btnProps IN FRAME frame_const 
   DO:
      IF NOT is_error THEN DO:
          constr_name = cnst_fill:screen-value.
          IF constr_name = "" OR constr_name = "?" THEN MESSAGE "No constraint selected, please select a constraint" VIEW-AS ALERT-BOX ERROR.
          ELSE RUN prodict/mss/key/modcons.p.
          RUN fill_constraint.
      END. 
      ELSE MESSAGE "Please select a valid constraint" VIEW-AS ALERT-BOX ERROR.    
   END.       

ON CHOOSE OF s_btnDelete IN FRAME frame_const 
   DO:
      IF NOT is_error THEN DO:
          constr_name = cnst_fill:screen-value.
          IF constr_name = "" OR constr_name = "?" THEN MESSAGE "No constraint selected, please select a constraint" VIEW-AS ALERT-BOX ERROR.
          ELSE RUN prodict/mss/key/del_con.p.
          RUN fill_constraint.
       END.   
       ELSE MESSAGE "Please select a valid constraint" VIEW-AS ALERT-BOX ERROR. 
   END.         

ON WINDOW-CLOSE OF FRAME frame_const
   DO:
        APPLY "END-ERROR" TO FRAME frame_const.
   END.

ON LEAVE OF cnst_fill IN FRAME frame_const
DO:
   define var lst_val as char NO-UNDO.
    
   lst_val = c_lst_Cnsts:screen-value IN FRAME frame_const.
   IF lst_val = ? THEN ASSIGN lst_val="".
   IF lst_val BEGINS SELF:screen-value THEN DO:
      cnst_fill:screen-value IN FRAME frame_const = lst_val.
      is_error = FALSE.
   END.   
   ELSE DO:
       is_error = TRUE.
   END.    
END.

ON VALUE-CHANGED OF c_lstTbls IN FRAME frame_const
DO:
   /* Reflect selection in fill-in. */
   IF SELF:screen-value = ? THEN
      Tbl_Fill:screen-value IN FRAME frame_const = "".
   ELSE 
      Tbl_Fill:screen-value in  FRAME frame_const = SELF:screen-value.
   ASSIGN is_error = FALSE.   
   RUN fill_constraint.
END.

ON VALUE-CHANGED OF c_lst_Cnsts  IN FRAME frame_const
DO:
   /* Reflect selection in fill-in. */
   IF SELF:screen-value = ? THEN
      cnst_fill:screen-value IN FRAME frame_const = "".
   ELSE 
      cnst_fill:screen-value in  FRAME frame_const = SELF:screen-value.
   ASSIGN is_error = FALSE.   
END.
     

PROCEDURE fill_constraint:
   c_table_name = c_lstTbls:screen-value IN FRAME frame_const.   
   c_lst_Cnsts:list-items IN FRAME frame_const = "".  
   FIND FIRST DICTDB._File WHERE DICTDB._File._File-Name =  c_table_name AND DICTDB._FIle._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE(DICTDB._File) THEN
   DO :
     TblRecId = RECID(DICTDB._File).       
     FOR EACH _constraint WHERE _File-recid = TblRecId AND _Constraint._Db-Recid = DbRecId NO-LOCK:
        IF _constraint._Con-Status = "N" OR _constraint._Con-Status = "C" OR _constraint._Con-Status = "M" 
            THEN c_lst_Cnsts:ADD-LAST(_con-name) IN FRAME frame_const.
        END.	
     END.
     
     IF c_lst_Cnsts:NUM-ITEMS > 0 
     THEN cnst_fill = c_lst_Cnsts:entry(1) IN FRAME frame_const.
     ELSE cnst_fill = "".
     ASSIGN c_lst_Cnsts:screen-value IN FRAME frame_const = cnst_fill.
            cnst_fill:screen-value IN FRAME frame_const   = cnst_fill.
       
END PROCEDURE.

ON LEAVE OF tbl_fill IN FRAME frame_const
DO:
   define var lst_val as char NO-UNDO.
 
   /* If the value entered in the fill-in prefix-matches a value in the
      select list, reset it's value to be the full selection list value. 
      Otherwise, we'll leave it alone. */
   lst_val = c_lstTbls:screen-value IN FRAME frame_const.
   IF lst_val BEGINS SELF:screen-value THEN DO:
      tbl_fill:screen-value IN FRAME frame_const = lst_val.
      ASSIGN is_error = FALSE.
   END.   
   ELSE DO:
       ASSIGN is_error = TRUE.
   END.    
   RUN fill_constraint.
END.

{prodict/mss/key/fillin.i &Frame  = "FRAME frame_const"
                     &CBFill = "Tbl_Fill"
                     &CBList = "c_lstTbls"
                     &CBInit = """"}

{prodict/mss/key/fillin.i &Frame  = "FRAME frame_const"
                     &CBFill = "cnst_fill"
                     &CBList = "c_lst_Cnsts"
                     &CBInit = """"}

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
   RUN enable_UI.
   FIND FIRST DICTDB._Db WHERE DICTDB._Db._Db-Name = user_dbname NO-LOCK NO-ERROR.
   IF AVAILABLE (DICTDB._Db)
   THEN DO:
      ASSIGN DbRecId = RECID(DICTDB._Db)
             cDbType = user_dbtype.
   END.
   ELSE DO:
      FIND LAST DICTDB._Db.
         ASSIGN DbRecId = RECID(DICTDB._Db)
                cDbType  = user_dbtype.
   END.
   run adecomm/_tbllist.p 
      	    (INPUT  c_lstTbls:HANDLE IN FRAME frame_const,
      	     INPUT  Show_Hidden_Tbls,
      	     INPUT  DbRecId,
      	     INPUT  "",
             INPUT  " " , /* all foreign types allowed (hutegger 95/06) */
                   /* BUFFER,FUNCTION,PACKAGE,PROCEDURE,SEQUENCE,VIEW", */
      	     OUTPUT access).
  
    IF c_lstTbls:NUM-ITEMS > 0 THEN tbl_fill = c_lstTbls:entry(1) IN FRAME frame_const.
       c_lstTbls:screen-value IN FRAME frame_const = tbl_fill.
       tbl_fill:screen-value IN FRAME frame_const = tbl_fill.

   RUN fill_constraint.   

   IF cDbType = "MSS" OR cDbType = "ORACLE" THEN DO:
       DISABLE  s_btnDelete WITH FRAME frame_const.
       DISABLE  btnCreate WITH FRAME frame_const.
   END.
   
   IF NOT THIS-PROCEDURE:PERSISTENT THEN
   WAIT-FOR CLOSE OF THIS-PROCEDURE. 
END.

PROCEDURE enable_UI :
  DISPLAY c_lst_Cnsts c_lstTbls tbl_fill cnst_fill
      WITH FRAME frame_const.
  ENABLE c_lst_Cnsts c_lstTbls btnCreate btnProps s_btnDelete tbl_fill cnst_fill
      WITH FRAME frame_const.
END PROCEDURE./*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: check.i

Description:   
   This file contains the form for creating check Constraints.

Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/default.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-CHECK FOR 
      temp2 SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-CHECK
  QUERY BROWSE-CHECK NO-LOCK DISPLAY
      temp2.fld FORMAT "x(33)":U
      temp2.chk FORMAT "x(33)":U

  WITH NO-ROW-MARKERS SEPARATORS 
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN SIZE 75 BY 3.32 FIT-LAST-COLUMN.
  &ELSE SIZE 75 BY 6 FIT-LAST-COLUMN.
  &ENDIF
  /*    DEFINATION FOR CHECK FRAME  */  
&Scoped-define FRAME-NAME frame_check
&Scoped-define BROWSE-NAME BROWSE-CHECK
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHECK temp2.fld temp2.chk 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHECK 
&Scoped-define QUERY-STRING-BROWSE-CHECK FOR EACH temp2 NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-CHECK OPEN QUERY BROWSE-CHECK FOR EACH temp2 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHECK temp2
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHECK temp2

        
        DEF VAR chintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE chQuery  AS HANDLE.
        DEFINE VARIABLE chBrowse AS HANDLE.
        DEFINE VARIABLE chBuffer AS HANDLE.
        DEFINE VARIABLE chField  AS HANDLE.
        DEFINE VARIABLE chField1 AS HANDLE.
        DEFINE VARIABLE chField2 AS HANDLE.
        DEFINE VARIABLE chField3 AS HANDLE.
        
        chBrowse = BROWSE BROWSE-CHECK:HANDLE. /* Browse-3 is browser name */
        chQuery  = chBrowse:QUERY.
        chBuffer = chQuery:GET-BUFFER-HANDLE(1).    
    
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 2.6 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 6.3 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 7.1 COL 14 NO-LABEL
     VALIDATE AT ROW 9.2 COL 14 NO-LABEL
     DESC_EDIT AT ROW 11.8 COL 14 NO-LABEL
     msg AT ROW 14 COL 2 WIDGET-ID 4  NO-LABEL
    
     OK_BUT AT ROW 15 COL 3
     CREATE_BUT AT ROW 15 COL 17
     CANCEL_BUT AT ROW 15 COL 31
     HELP_BUT AT ROW 15 COL 60
     "Constraint" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.3 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.9 COL 2 WIDGET-ID 38 
     "Validation" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.4 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10 COL 2 WIDGET-ID 38
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12 COL 2 WIDGET-ID 38              

     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 15.14 WIDGET-ID 100.
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 3.2 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 9 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 10.4 COL 2 
     VALIDATE AT ROW 13.4 COL 2.3
     DESC_EDIT AT ROW 16.4 COL 2 WIDGET-ID 36
    
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30  
    
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 11.4 COL 2 WIDGET-ID 38
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 14.4 COL 2 WIDGET-ID 38
     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
    &ENDIF       
                          
 ASSIGN 
      
       BROWSE-CHECK:COLUMN-RESIZABLE IN FRAME frame_check        = TRUE.        


ON CHOOSE OF OK_BUT IN FRAME frame_check
  DO:          
     ASSIGN is-saved = FALSE.
     
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
      RUN check_save.
      IF is-saved THEN
      APPLY "CLOSE":U TO THIS-PROCEDURE.
         RETURN NO-APPLY.                   
     END.
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_check
 DO:
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE RUN check_save.
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_check
  DO:     
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END.  

ON VALUE-CHANGED OF BROWSE-CHECK IN FRAME frame_check
  DO:
      RUN Fetch_Check_Name.
  END. 

ON ENTRY OF name IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
 END.

ON ENTRY OF EXPRESSION IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
END. 

PROCEDURE Fetch_Check_Name:
 
  DO chintSub = 1 TO chBrowse:NUM-SELECTED-ROWS : 
     
     
     chBrowse:FETCH-SELECTED-ROW(chintSub).

     chField  = chBuffer:BUFFER-FIELD( "fld" ).
     chField1 = chBuffer:BUFFER-FIELD( "chk" ).
     chField2 = chBuffer:BUFFER-FIELD( "rec" ).
     chField3 = chBuffer:BUFFER-FIELD( "exp" ).
         
     ASSIGN Selected_Idx = chField:BUFFER-VALUE.
  
  END.
  ASSIGN VALIDATE:SCREEN-VALUE IN FRAME frame_check = chField3:BUFFER-VALUE.
  ASSIGN EXPRESSION:SCREEN-VALUE IN FRAME frame_check = chField1:BUFFER-VALUE. 
run Create_Const_Name.
END PROCEDURE.  

PROCEDURE check :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_check~
           ~{&OPEN-QUERY-BROWSE-CHECK}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           
           HIDE FRAME frame_unique.
           HIDE FRAME frame_default.
           VIEW FRAME frame_check. 
           DISPLAY NAME BROWSE-CHECK Active DESC_EDIT EXPRESSION  VALIDATE 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF
                    WITH FRAME frame_check.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_check ="yes".
           ENABLE name BROWSE-CHECK Active DESC_EDIT EXPRESSION
                  OK_BUT CREATE_BUT CANCEL_BUT 
                  &IF "{&WINDOW-SYSTEM}" <> "TTY"
                  &THEN HELP_BUT  
                  &ENDIF
                  WITH FRAME frame_check.
           {&OPEN-BROWSERS-IN-QUERY-frame_check}
           RUN Fetch_Check_Name.
END PROCEDURE.

PROCEDURE check_save:

    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_check 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:
          num = num + 1.
          CREATE DICTDB._Constraint.
          ASSIGN _Con-Type = "C"
               _Con-Name = name:SCREEN-VALUE IN FRAME frame_check
               _For-Name = "".
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_check = "yes" 
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_check
               _File-recid = file_rec
               _Con-Status = "N"
               _Con-Expr = EXPRESSION:SCREEN-VALUE IN FRAME frame_check
               _Field-recid = chField2:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
       RUN FILL_TEMP2.
       RUN check.
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="Constraint Created".  &ENDIF 
     ASSIGN is-saved = TRUE.           
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.               
         
END.  

PROCEDURE check_validate:
        FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Field-Recid = chField2:BUFFER-VALUE AND DICTDB._Constraint._Con-Type = "C"
        AND DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O" AND DICTDB._constraint._Db-Recid = DbRecid
        NO-LOCK NO-ERROR.
        IF AVAILABLE (DICTDB._Constraint)
        THEN DISABLE OK_BUT CREATE_BUT WITH FRAME frame_check.
        ELSE ENABLE OK_BUT CREATE_BUT WITH FRAME frame_check.
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: clust.i

Description:   
   This file contains the form for clustered Constraints.

Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/primary.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-CLUSTERED FOR 
      temp SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-CLUSTERED
  QUERY BROWSE-CLUSTERED NO-LOCK DISPLAY
      temp.ind FORMAT "x(16)":U
      temp.pri FORMAT "x(8)":U
      temp.uni FORMAT "x(8)":U
      temp.clu FORMAT "x(8)":U
      temp.man FORMAT "x(10)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF

/*    DEFINATION FOR CLUSTERED FRAME  */  

&Scoped-define FRAME-NAME frame_clustered

&Scoped-define BROWSE-NAME BROWSE-CLUSTERED
&Scoped-define FIELDS-IN-QUERY-BROWSE-CLUSTERED temp.pri temp.uni temp.ind temp.clu temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CLUSTERED 
&Scoped-define QUERY-STRING-BROWSE-CLUSTERED FOR EACH temp NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-CLUSTERED OPEN QUERY BROWSE-CLUSTERED FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CLUSTERED temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CLUSTERED temp

        
        DEF VAR cintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE cQuery AS HANDLE.
        DEFINE VARIABLE cBrowse AS HANDLE.
        DEFINE VARIABLE cBuffer AS HANDLE.
        DEFINE VARIABLE cField AS HANDLE.
        DEFINE VARIABLE cField1 AS HANDLE.
        DEFINE VARIABLE cField2 AS HANDLE.
        DEFINE VARIABLE cField3 AS HANDLE.
        DEFINE VARIABLE cField4 AS HANDLE.
        DEFINE VARIABLE cField5 AS HANDLE.

        cBrowse = BROWSE BROWSE-CLUSTERED:HANDLE. /* Browse-3 is browser name */
        cQuery  = cBrowse:QUERY.
        cBuffer = cQuery:GET-BUFFER-HANDLE(1).    
    
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CLUSTERED AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     Primary AT ROW 8.6 COL 24 WIDGET-ID 42
     Clustered AT ROW 8.6 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_clustered
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16  WIDGET-ID 100.
                  
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CLUSTERED AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     Primary AT ROW 13 COL 24 WIDGET-ID 42
     Clustered AT ROW 13 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
          
     WITH FRAME frame_clustered
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21  WIDGET-ID 100.
     &ENDIF       

 ASSIGN BROWSE-CLUSTERED:COLUMN-RESIZABLE IN FRAME frame_clustered  = TRUE .        


ON CHOOSE OF OK_BUT IN FRAME frame_clustered
  DO:          
       ASSIGN is-saved = FALSE.
       RUN check_clust_save.
      IF is-saved THEN
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.        
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_clustered
 DO:
       RUN check_clust_save.
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_clustered
  DO:     
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END.  

ON VALUE-CHANGED OF BROWSE-CLUSTERED IN FRAME frame_clustered
  DO:
      RUN Fetch_Clustered_Name.
      RUN clust_validate.
  END. 

ON ENTRY OF name IN FRAME frame_clustered
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_clustered ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_clustered
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_clustered ="". 
  &ENDIF
END. 

PROCEDURE Fetch_Clustered_Name:
 
  DO cintSub = 1 TO cBrowse:NUM-SELECTED-ROWS : 
     
     
           cBrowse:FETCH-SELECTED-ROW(cintSub).

           cField  = cBuffer:BUFFER-FIELD( "ind" ).
           cField1 = cBuffer:BUFFER-FIELD( "pri" ).
           cField2 = cBuffer:BUFFER-FIELD( "clu" ).
           cField3 = cBuffer:BUFFER-FIELD( "uni" ).
           cField4 = cBuffer:BUFFER-FIELD( "man" ).
           cField5 = cBuffer:BUFFER-FIELD( "rec" ).

           ASSIGN Selected_Idx = cField:BUFFER-VALUE.
  
  END.
run Create_Const_Name.
END PROCEDURE.  

PROCEDURE clustered :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_clustered ~
           ~{&OPEN-QUERY-BROWSE-CLUSTERED}
           
           HIDE FRAME frame_primary.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_unique.  
           HIDE FRAME frame_default.  
           HIDE FRAME frame_check.  
           VIEW FRAME frame_clustered.
           DISPLAY NAME BROWSE-CLUSTERED Active Primary Clustered DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_clustered.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_clustered ="yes".
           ENABLE NAME BROWSE-CLUSTERED Active Primary DESC_EDIT2 
                  OK_BUT CREATE_BUT CANCEL_BUT 
                  &IF "{&WINDOW-SYSTEM}" <> "TTY"
                  &THEN HELP_BUT  
                  &ENDIF
                  WITH FRAME frame_clustered.
            {&OPEN-BROWSERS-IN-QUERY-frame_clustered}
            RUN Fetch_Clustered_Name.
            RUN clust_validate.
END PROCEDURE.

PROCEDURE clust_save:
          num = num + 1.
          CREATE DICTDB._Constraint.
          IF Primary:SCREEN-VALUE IN FRAME frame_clustered = "yes"
           THEN ASSIGN _Con-Type = "MP".
           ELSE ASSIGN _Con-Type = "M".
          ASSIGN _Con-Name = name:SCREEN-VALUE IN FRAME frame_clustered
                 _For-Name = "".
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_clustered = "yes"
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_clustered
               _File-recid = file_rec
               _Con-Status = "N"
               _Index-recid = cField5:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
          RUN TEMP1.
          RUN clustered. 
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
          ASSIGN msg:SCREEN-VALUE IN FRAME frame_clustered ="Constraint Created".  &ENDIF 
     ASSIGN is-saved = TRUE.                         
END.          

PROCEDURE clust_validate:
          IF CAN-FIND (DICTDB._Constraint WHERE DICTDB._Constraint._File-Recid = file_rec AND (DICTDB._Constraint._Con-Type = "P"  OR
                       DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP"))
          THEN DO:
               IF cField:BUFFER-VALUE = "C" OR cField1:BUFFER-VALUE = "I , C"
                  THEN ASSIGN Primary:SCREEN-VALUE IN FRAME frame_clustered ="yes".
               ELSE  ASSIGN Primary:SCREEN-VALUE IN FRAME frame_clustered ="no".  
               DISABLE Primary WITH FRAME frame_clustered.
          END.      
          ELSE              
          DO:
              IF temp.man = "  I" THEN
                  ENABLE Primary WITH FRAME frame_clustered.
              ELSE
                  DISABLE Primary WITH FRAME frame_clustered.
          END.
                  
END PROCEDURE.

PROCEDURE check_clust_save:
    IF CAN-FIND (DICTDB._Constraint WHERE DICTDB._Constraint._File-Recid = file_rec AND (DICTDB._Constraint._Con-Type = "M"  OR
          DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP")AND DICTDB._Constraint._Con-Status <> "D" 
                          AND DICTDB._Constraint._Con-Status <> "O")
    THEN  MESSAGE " Clustered constraint already exists in this table" VIEW-AS ALERT-BOX ERROR.
    
    ELSE DO:
       IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_clustered 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
       THEN DO:
           IF cField:BUFFER-VALUE = "C" OR cField1:BUFFER-VALUE = "I , C" THEN DO:
             MESSAGE "As you are trying to create a Clustered constraint on an existing Primary non clustered constraint," SKIP
                     "the primary non clustered constraint will be deleted and a new Primary Clustered constraint" SKIP
                     "will be created, do you want to proceed ?" VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
             IF ans = YES THEN DO:
             FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-recid = cField5:BUFFER-VALUE  AND 
                   DICTDB._Constraint._Con-Type = "P" EXCLUSIVE-LOCK NO-ERROR.
                   IF AVAILABLE DICTDB._Constraint THEN DELETE DICTDB._Constraint.          
               RUN clust_save. 
             END.
           END.
           ELSE  RUN clust_save.   
       END.       
       ELSE MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.                                        
    END.    
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: constraint.i

Description:   
   This file contains the forms the base file for creation of Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/mss/key/viewmnt.i  }

DEFINE {1} TEMP-TABLE temp NO-UNDO
    FIELD ind AS CHAR LABEL "Index"
    FIELD pri AS CHAR LABEL "Primary"
    FIELD uni AS CHAR LABEL "Unique"
    FIELD clu AS CHAR LABEL "Clustered"
    FIELD man AS CHAR LABEL "All Columns Mandatory"
    FIELD rec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp2 NO-UNDO
    FIELD fld AS CHAR LABEL "Field"
    FIELD ini AS CHAR LABEL "Initial Value"
    FIELD chk AS CHAR LABEL "Constraint Expression"
    FIELD rec AS RECID LABEL "REC ID"
    FIELD cdf AS CHAR LABEL "Constraint Expression"
    FIELD exp AS CHAR LABEL "valid" .

DEFINE {1} TEMP-TABLE temp-parent NO-UNDO  
    FIELD ptb AS CHAR LABEL "Parent Table"
    FIELD pidx AS CHAR LABEL "Parent Index"
    FIELD prec AS RECID LABEL "REC ID".


DEFINE {1} TEMP-TABLE temp-parent1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "Number".
   

DEFINE {1} TEMP-TABLE temp-child NO-UNDO
    FIELD cidx AS CHAR LABEL "Child Index"
    FIELD crec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp-child1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "NUMBER".
      
    
DEFINE {1} VARIABLE  file_rec       AS RECID     NO-UNDO.
DEFINE {1} VARIABLE  mandatory      AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  A              AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  num            AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  Par_Idx        AS CHAR      NO-UNDO.
DEFINE {1} VARiable  Selected_Idx   AS CHAR      NO-UNDO.
DEFINE {1} VARIABLE  is-saved       AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE {1} VARIABLE  ans            AS LOGICAL   NO-UNDO INITIAL FALSE.

DEFINE {1} BUTTON OK_BUT  
     LABEL "&OK" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CREATE_BUT 
     LABEL "&Create" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CANCEL_BUT 
     LABEL "Ca&ncel" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON HELP_BUT 
     LABEL "&Help" 
     SIZE 13 BY 1.

DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Type." 
     &ELSE   LABEL "Constraint Type" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 4
     LIST-ITEMS "PRIMARY","CLUSTERED","UNIQUE","FOREIGN KEY","DEFAULT", "CHECK" 
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.

DEFINE VARIABLE child AS CHARACTER FORMAT "X(12)":U 
     LABEL "Child Table" 
     VIEW-AS FILL-IN 
     SIZE 14 BY .92 NO-UNDO.
     
DEFINE {1} VARIABLE EXPRESSION AS CHARACTER
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Constraint ."  
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Constraint." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF     

DEFINE {1} VARIABLE VALIDATE AS CHARACTER 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Validation ." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Validation." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF

DEFINE {1} VARIABLE DESC_EDIT AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 3 NO-UNDO.
     &ENDIF
     
DEFINE {1} VARIABLE DESC_EDIT2 AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 4.3 NO-UNDO.
     &ENDIF     


DEFINE {1} VARIABLE name AS CHARACTER FORMAT "X(80)":U 
     LABEL "Constraint &Name" 
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.
     
DEFINE {1} VARIABLE msg AS CHARACTER FORMAT "X(80)":U 
     LABEL ""
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.

DEFINE {1} VARIABLE Active AS LOGICAL INITIAL no 
     LABEL "Active" 
     VIEW-AS TOGGLE-BOX
     SIZE 11 BY .81 NO-UNDO.

DEFINE {1} VARIABLE Primary AS LOGICAL INITIAL no 
     LABEL "Primary" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE {1} VARIABLE Clustered AS LOGICAL INITIAL no 
     LABEL "Clustered" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

Define {1} var s_Status as char  FORMAT "X(12)":U 
     LABEL "" 
          VIEW-AS FILL-IN 
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE {1} FRAME DEFAULT-FRAME
   &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN Constrainttype AT ROW 1.4 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ELSE Constrainttype AT ROW 1.95 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ENDIF   
   WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         &IF "{&WINDOW-SYSTEM}" <> "TTY"
         &THEN SIZE 82 BY 19 WIDGET-ID 100
         &ELSE SIZE 82 BY 24 WIDGET-ID 100
         &ENDIF
         
         VIEW-AS DIALOG-BOX 
         TITLE "Create Foreign Constraint Definition for " + c_table_name .
DEFINE {1} FRAME frame_primary.
DEFINE {1} FRAME frame_foreign.
DEFINE {1} FRAME frame_clustered.
DEFINE {1} FRAME frame_unique.
DEFINE {1} FRAME frame_default.
DEFINE {1} FRAME frame_check.


ASSIGN FRAME frame_clustered:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_primary:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_foreign:FRAME = FRAME DEFAULT-FRAME:HANDLE   
       FRAME frame_unique:FRAME = FRAME DEFAULT-FRAME:HANDLE.
       FRAME frame_default:FRAME = FRAME DEFAULT-FRAME:HANDLE.
       FRAME frame_check:FRAME = FRAME DEFAULT-FRAME:HANDLE.

ASSIGN num = 0.
FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Db-Recid = DbRecId:
    IF DICTDB._Constraint._Con-Num > num 
     THEN ASSIGN num = DICTDB._Constraint._Con-Num. 
END.

PROCEDURE TEMP1:

EMPTY TEMP-TABLE temp.

FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._File._Db-Recid = DbRecId NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND _Index._Wordidx <> 1 NO-LOCK:
       CREATE temp.
       ASSIGN ind = DICTDB._index._index-name.
              IF _unique = YES
              THEN ASSIGN uni = "I".
              IF DICTDB._File._Prime-Index = RECID(DICTDB._Index) 
              THEN ASSIGN pri = "I".
              A = RECID(DICTDB._index).
              FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Index-recid = A AND DICTDB._Constraint._Con-Status <> "D" 
                                                               AND DICTDB._Constraint._Con-Status <> "O":
                            
                IF (DICTDB._Constraint._Con-Type = "M" OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "PC")
                   THEN ASSIGN clu ="C" .
                IF (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "PC")               
                   THEN DO:
                   IF pri <> "" THEN pri = pri + " , C".
                                     ELSE pri = "C".
                   END.
                IF (DICTDB._Constraint._Con-Type = "U")
                   THEN DO:
                   IF uni <> "" THEN uni = uni + " , C".
                                     ELSE uni = "C".  
                   END.
               END.    
              ASSIGN mandatory = 0.
              ASSIGN rec = RECID(DICTDB._index).
              FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid = A:
                  FIND FIRST DICTDB._Field where DICTDB._index-field._Field-Recid = RECID(DICTDB._Field).
                  IF DICTDB._Field._Mandatory = NO THEN ASSIGN mandatory = 1.
              END.
              IF mandatory = 0 THEN ASSIGN man = "  I".    
   END.
END.
END PROCEDURE.

PROCEDURE FILL_TEMP2:
EMPTY TEMP-TABLE temp2.
FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._file._Db-Recid = DbRecId NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._Field WHERE DICTDB._Field._file-recid = file_rec NO-LOCK:
      CREATE temp2.
      ASSIGN fld = DICTDB._Field._Field-Name
             ini = DICTDB._Field._Initial
             rec = RECID(DICTDB._Field)
             exp = DICTDB._Field._Valexp
             chk = "".
      A = RECID(DICTDB._Field).
      FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Field-Recid = A AND DICTDB._Constraint._Con-Type = "C"      
           AND DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O":
        IF AVAILABLE(DICTDB._Constraint)  
        THEN DO:
          ASSIGN chk = DICTDB._Constraint._Con-Expr.
        END.  
      END.  
      
      FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Field-Recid = A AND DICTDB._Constraint._Con-Type = "D" 
          AND DICTDB._Constraint._Con-Status <> "D"  AND DICTDB._Constraint._Con-Status <> "O" NO-LOCK NO-ERROR.
        IF AVAILABLE(DICTDB._Constraint)  
        THEN ASSIGN cdf = DICTDB._Constraint._Con-Expr.
   END.
END.      
END PROCEDURE.


/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: constraint.p

Description:   
   This file contains the form defination for creation of Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/mss/key/foreign.i }

&Scoped-define SELF-NAME Constrainttype

 
  ON VALUE-CHANGED OF Constrainttype IN FRAME DEFAULT-FRAME
  DO:
      RUN TEMP1.
      RUN FILL_TEMP2.
      IF Constrainttype:SCREEN-VALUE="PRIMARY" THEN
      DO:
         RUN primary.                 
      END.          
      
      IF Constrainttype:SCREEN-VALUE="CLUSTERED" THEN
      DO:    
         RUN clustered.
      END. 
      
      IF Constrainttype:SCREEN-VALUE="FOREIGN KEY" THEN
      DO:
           RUN foreign.
      END. 
      
      IF Constrainttype:SCREEN-VALUE="UNIQUE" THEN
      DO:  
           RUN unique.
      END.
   
      IF Constrainttype:SCREEN-VALUE="DEFAULT" THEN
      DO:          
           RUN default.
      END.
 
      IF Constrainttype:SCREEN-VALUE="CHECK" THEN
      DO:  
         RUN check.    
      END.      


  END.
ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME frame_primary.
    APPLY "END-ERROR" TO FRAME frame_clustered.
    APPLY "END-ERROR" TO FRAME frame_unique.
    APPLY "END-ERROR" TO FRAME frame_foreign.
    APPLY "END-ERROR" TO FRAME frame_default.
    APPLY "END-ERROR" TO FRAME frame_check.
END.  

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME frame_primary OR HELP OF FRAME frame_clustered OR HELP OF FRAME frame_unique OR HELP OF FRAME frame_foreign
  OR HELP OF FRAME frame_default  OR HELP OF FRAME frame_check
  OR CHOOSE of HELP_BUT IN FRAME frame_primary  OR CHOOSE of HELP_BUT IN FRAME frame_clustered 
  OR CHOOSE of HELP_BUT IN FRAME frame_unique   OR CHOOSE of HELP_BUT IN FRAME frame_foreign  
  OR CHOOSE of HELP_BUT IN FRAME frame_default  OR CHOOSE of HELP_BUT IN FRAME frame_check
 DO:   
    
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&MS_SQL_Server_Data_Server_Create_Constraints_Dialog}, 
      	       	     	      INPUT ?).
 END.
&ENDIF


MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
    
  ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
  
    
    
END.

PROCEDURE enable_UI :
  DISPLAY Constrainttype 
      WITH FRAME DEFAULT-FRAME.
  ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME ="PRIMARY".
  ENABLE Constrainttype 
      WITH FRAME DEFAULT-FRAME. 
  RUN TEMP1.
  RUN primary. 
 

END PROCEDURE.
           

PROCEDURE Create_Const_Name:
 DEF VAR L_Idx_Type as CHAR No-UNDO.
 DEF VAR N_Idx_Type as CHAR No-UNDO.
 DEF VAR L_Idx_Type1 as CHAR No-UNDO.
 DEF VAR N_Idx_Type1 as CHAR No-UNDO.
 L_Idx_Type = Constrainttype:screen-value in frame DEFAULT-FRAME.
 IF L_Idx_Type = "Primary" THEN
    Assign L_Idx_Type = "_PKC_"
           N_Idx_Type = "P".
           
 IF L_Idx_Type = "Clustered" THEN
    Assign L_Idx_Type = "_CKC_"
           N_Idx_Type = "M".
 
  IF L_Idx_Type = "Unique" THEN
    Assign L_Idx_Type = "_UKC_"
           N_Idx_Type = "U".
 
  IF L_Idx_Type = "Default" THEN
    Assign L_Idx_Type = "_DC_"
           N_Idx_Type = "D".
           
   IF L_Idx_Type = "Check" THEN
    Assign L_Idx_Type = "_CC_"
           N_Idx_Type = "C".

   IF L_Idx_Type = "FOREIGN KEY" THEN
     Assign L_Idx_Type = "_FKC_"
           N_Idx_Type = "F".


 
 IF N_Idx_Type = "F" THEN 
    L_Idx_Type = L_Idx_Type +  Par_Idx + "-" + Selected_Idx + "-" + "idx".
 ELSE
    L_Idx_Type = L_Idx_Type + c_table_name + "-" + Selected_Idx + "-" + "idx". 

 IF N_Idx_Type = "P" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_primary = L_Idx_Type.
 
 IF N_Idx_Type = "M" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_clustered = L_Idx_Type.
   
 IF N_Idx_Type = "U" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_unique = L_Idx_Type.
   
 IF N_Idx_Type = "D" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_default = L_Idx_Type.
   
  IF N_Idx_Type = "C" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_check = L_Idx_Type. 
  
  IF N_Idx_Type = "F" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_foreign = L_Idx_Type. 

  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="".
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="".  
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="".
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="".  
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="".  
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_clustered ="".   
  &ENDIF

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: default.i

Description:   
   This file contains the form for default Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/unique.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-DEFAULT FOR 
      temp2 SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-DEFAULT
  QUERY BROWSE-DEFAULT NO-LOCK DISPLAY
      temp2.fld FORMAT "x(22)":U
      temp2.ini FORMAT "x(22)":U
      temp2.cdf FORMAT "x(250)":U

  WITH NO-ROW-MARKERS SEPARATORS 
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN SIZE 75 BY  4.52 FIT-LAST-COLUMN.
  &ELSE SIZE 75 BY 7 FIT-LAST-COLUMN.
  &ENDIF      

/*    DEFINATION FOR DEFAULT FRAME  */  

&Scoped-define FRAME-NAME frame_default 
&Scoped-define BROWSE-NAME BROWSE-DEFAULT
&Scoped-define FIELDS-IN-QUERY-BROWSE-DEFAULT temp2.fld temp2.ini 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-DEFAULT 
&Scoped-define QUERY-STRING-BROWSE-DEFAULT FOR EACH temp2 NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-DEFAULT OPEN QUERY BROWSE-DEFAULT FOR EACH temp2 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-DEFAULT temp2
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-DEFAULT temp2


        DEF VAR dintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE dQuery AS HANDLE.
        DEFINE VARIABLE dBrowse AS HANDLE.
        DEFINE VARIABLE dBuffer AS HANDLE.
        DEFINE VARIABLE dField AS HANDLE.
        DEFINE VARIABLE dField1 AS HANDLE.
        DEFINE VARIABLE dField2 AS HANDLE.
        DEFINE VARIABLE dField3 AS HANDLE.

        dBrowse = BROWSE BROWSE-DEFAULT:HANDLE. /* Browse-3 is browser name */
        dQuery  = dBrowse:QUERY.
        dBuffer = dQuery:GET-BUFFER-HANDLE(1).    
    
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN   
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-DEFAULT AT ROW 2.8 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 7.9 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 8.9 COL 14  NO-LABEL
     DESC_EDIT AT ROW 11.5 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 13.7 COL 2 WIDGET-ID 4 NO-LABEL
    
     OK_BUT AT ROW 15 COL 3
     CREATE_BUT AT ROW 15 COL 17
     CANCEL_BUT AT ROW 15 COL 31
     HELP_BUT AT ROW 15 COL 60
     "Constraint" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.1 COL 2 WIDGET-ID 38     
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.7 COL 2 WIDGET-ID 38
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 11.7 COL 2 WIDGET-ID 38          
     WITH FRAME frame_default
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 15.14 WIDGET-ID 100.
     
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-DEFAULT AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 11 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 12.5 COL 2 
     DESC_EDIT AT ROW 16 COL 2 WIDGET-ID 36
    
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 13.5 COL 2 WIDGET-ID 38
     WITH FRAME frame_default
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
     &ENDIF        
                          
 ASSIGN BROWSE-DEFAULT:COLUMN-RESIZABLE IN FRAME frame_default        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_default
  DO:          
     ASSIGN is-saved = FALSE.

     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_default = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_default = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
	   RUN default_save.
       IF is-saved THEN
        APPLY "CLOSE":U TO THIS-PROCEDURE.
        RETURN NO-APPLY.         
     END.
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_default
 DO:
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_default = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_default = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE RUN default_save.
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_default
  DO:     
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END.  

ON VALUE-CHANGED OF BROWSE-DEFAULT IN FRAME frame_default
  DO:
       RUN Fetch_Default_Name.
  END. 

ON ENTRY OF name IN FRAME frame_default
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="". 
  &ENDIF
 END.

ON ENTRY OF EXPRESSION IN FRAME frame_default
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT IN FRAME frame_default
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="". 
  &ENDIF
END. 

PROCEDURE Fetch_Default_Name:
 
  DO dintSub = 1 TO dBrowse:NUM-SELECTED-ROWS : 
     
     
           dBrowse:FETCH-SELECTED-ROW(dintSub).

           dField  = dBuffer:BUFFER-FIELD( "fld" ).
           dField1 = dBuffer:BUFFER-FIELD( "ini" ).
           dField2 = dBuffer:BUFFER-FIELD( "rec" ).
           dField3 = dBuffer:BUFFER-FIELD( "cdf" ).

           ASSIGN Selected_Idx = dField:BUFFER-VALUE.
           
  END.
  IF dfield3:BUFFER-VALUE <> ""
  THEN ASSIGN EXPRESSION:SCREEN-VALUE IN FRAME frame_default = dfield3:BUFFER-VALUE.
  ELSE ASSIGN EXPRESSION:SCREEN-VALUE IN FRAME frame_default = dfield1:BUFFER-VALUE.

run Create_Const_Name.
RUN default_validate.

END PROCEDURE.  

PROCEDURE default :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_default ~
           ~{&OPEN-QUERY-BROWSE-DEFAULT}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           
           HIDE FRAME frame_unique.
           HIDE FRAME frame_check.
           VIEW FRAME frame_default. 
           DISPLAY name BROWSE-DEFAULT Active DESC_EDIT EXPRESSION 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_default.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_default ="yes".
           ENABLE  name BROWSE-DEFAULT Active DESC_EDIT EXPRESSION 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF
                    WITH FRAME frame_default.
             {&OPEN-BROWSERS-IN-QUERY-frame_default}
           RUN Fetch_Default_Name.
END PROCEDURE.

PROCEDURE default_save:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_default 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:
          num = num + 1.
          IF dfield1:BUFFER-VALUE <> EXPRESSION:SCREEN-VALUE IN FRAME frame_default
          THEN message "Default Constraint added for the field " dfield:BUFFER-VALUE " but the server-side " skip
                       "constraint value is different from the Progress default value"  view-as alert-box INFORMATION.
          
          CREATE DICTDB._Constraint.
          ASSIGN _Con-Type = "D"
               _Con-Name = name:SCREEN-VALUE IN FRAME frame_default
               _For-Name = "".
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_default = "yes" 
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_default
               _File-recid = file_rec
               _Con-Status = "N"
               _Con-Expr = EXPRESSION:SCREEN-VALUE IN FRAME frame_default
               _Field-recid = dfield2:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
       RUN FILL_TEMP2.
       RUN default.  
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="Constraint Created".  &ENDIF  
     ASSIGN is-saved = TRUE.            
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.                                             
END PROCEDURE.          

PROCEDURE default_validate:
          
          FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Field-recid = dfield2:BUFFER-VALUE AND DICTDB._Constraint._Con-Type = "D"
          AND DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O" AND DICTDB._constraint._Db-Recid = DbRecid
          NO-LOCK NO-ERROR.
          IF AVAILABLE (DICTDB._Constraint)
          THEN DO:
                DISABLE OK_BUT CREATE_BUT WITH FRAME frame_default.
               END.
          ELSE 
               ENABLE OK_BUT CREATE_BUT WITH FRAME frame_default.
         
END PROCEDURE.         
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: del_con.p

Description:   
   This file contains the procedure for the deletion of a selected constraint.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/mss/key/viewmnt.i}

DEFINE STREAM   constlog.
DEFINE VARIABLE cnstrpt_name       AS CHARACTER   NO-UNDO.
DEFINE BUFFER   CON_DICTDB         FOR DICTDB._Constraint.

FIND FIRST DICTDB._File where DICTDB._File._File-Name = c_table_name AND DICTDB._File._Db-Recid = DbRecid EXCLUSIVE-LOCK NO-ERROR.

FOR EACH Dictdb._constraint OF DICTDB._File  WHERE Dictdb._constraint._Con-Name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid
                                EXCLUSIVE-LOCK:

ASSIGN cnstrpt_name = "constraint.lg".
OUTPUT STREAM constlog TO VALUE(cnstrpt_name) UNBUFFERED APPEND NO-ECHO NO-MAP.
  
  IF (DICTDB._Constraint._con-type = "PC" OR DICTDB._Constraint._con-type = "P" OR
                         DICTDB._Constraint._con-type = "U" OR DICTDB._Constraint._con-type = "MP") 
  THEN DO:
   IF CAN-FIND (FIRST CON_DICTDB WHERE CON_DICTDB._Index-Parent-Recid = DICTDB._Constraint._Index-Recid 
                 AND (CON_DICTDB._Con-Status <> "O" AND CON_DICTDB._Con-Status <> "D"))
   THEN DO:
    MESSAGE "Unable to delete as " constr_name " is referenced by a Foreign Key" VIEW-AS ALERT-BOX ERROR.
    PUT STREAM constlog UNFORMATTED " cannot delete constraint " + constr_name + " as it is referenced by a foreign key"  SKIP.
   END. 
   ELSE DO:
     IF Dictdb._constraint._Con-Status  = "N" OR  Dictdb._constraint._Con-Status  = "C"
       THEN DELETE Dictdb._constraint.

     ELSE IF Dictdb._constraint._Con-Status = "M"
       THEN ASSIGN Dictdb._constraint._Con-Status = "D"
                   Dictdb._constraint._Con-Active = FALSE. 
    END.
  END.
  ELSE DO:
     IF Dictdb._constraint._Con-Status  = "N" OR  Dictdb._constraint._Con-Status  = "C"
       THEN DELETE Dictdb._constraint.

     ELSE IF Dictdb._constraint._Con-Status = "M"
       THEN ASSIGN Dictdb._constraint._Con-Status = "D"
                   Dictdb._constraint._Con-Active = FALSE.    
  END. 
  
OUTPUT STREAM constlog  CLOSE.           
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: constraint.i

Description:   
   This file contains the logic for populating a list item.

HISTORY
Author: Kumar Mayur

Date Created:09/25/2011
----------------------------------------------------------------------------*/ 
 
/*------------------------------Triggers--------------------------------*/
 

/*----- ON ANY-PRINTABLE (ASCII) of FILL -----*/
on ANY-PRINTABLE of {&CBFill} in {&Frame}
do:
   define var fill_val  as char	    NO-UNDO. /* Fill-in value */
   define var curr_val  as char     NO-UNDO. /* Current value of select-list */
   define var lst_val   as char	    NO-UNDO. /* Value of a select list item */
   define var ix      	as integer  NO-UNDO. /* Loop index */
   define var start  	as integer  NO-UNDO. /* Index into select list */
   define var found     as logical  NO-UNDO. /* Did we find a prefix match? */
 
   curr_val = {&CBList}:screen-value in {&Frame}.
   if curr_val = ? then return.  /* return if list is empty. */
 
   /* See if we can find a prefix match between the fill-in value,
      including the character the user just typed, and a select list item.
      If there is no match then the selection is left as is.  Otherwise,
      the selection is changed.
      Add the key just typed to get the value to be matched. The last key
      typed won't be in the fill-in yet until we return from this trigger. */
 
   assign
      fill_val = (if SELF:AUTO-ZAP then CHR(LASTKEY) 
      	       	                   else SELF:screen-value + CHR(LASTKEY))
      found = false
      /* Start searching from the currently selected item */
      start = {&CBList}:lookup(curr_val) in {&Frame}.  
 
   do ix = start to {&CBList}:NUM-ITEMS in {&Frame} while NOT found:
      lst_val = {&CBList}:ENTRY(ix) in {&Frame}.
      if lst_val BEGINS fill_val then
         found = true.
   end.
 
   /* If we haven't found a match yet, wrap around to the top of the
      list and continue searching. */
   do ix = 1 to start - 1 while NOT found:
      lst_val = {&CBList}:ENTRY(ix) in {&Frame}.
      if lst_val BEGINS fill_val then
         found = true.
   end.
 
   if found then
   do:
      /* If we found a match other than the one already selected,
      	 set selection and make sure this item's in view.  Then notify
      	 application. */
 
      if lst_val <> curr_val then
      do:
	 {&CBList}:screen-value in {&Frame} = lst_val.
	 run adecomm/_scroll.p (INPUT {&CBList}:HANDLE in {&Frame}, 
			       INPUT lst_val).
 
	 /* Notify application of selection change. Since I can't apply
	    an event to myself (the fill widget), apply to the list */
	 apply "U1" to {&CBList} in {&Frame}.
      end.
   end.
end.
 

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: foreign.i

Description:   
   This file contains the form for Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/check.i }

/* Query definitions                                                    */
DEFINE {1} VARIABLE modf AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Action." 
     &ELSE   LABEL "Con Action" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "NONE","CASCADE","SET NULL","SET DEFAULT" 
     DROP-DOWN-LIST
     SIZE 19 BY 1 NO-UNDO.
     
DEFINE  VARIABLE counter AS INTEGER NO-UNDO.
DEFINE  VARIABLE flg     AS LOGICAL NO-UNDO.
DEFINE {1} QUERY BROWSE-PAR FOR 
      temp-parent SCROLLING.

DEFINE {1} QUERY BROWSE-PAR1 FOR 
      temp-parent1 SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD FOR 
      temp-child SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD1 FOR 
      temp-child1 SCROLLING.

/* Browse definitions                                                   */

DEFINE {1} BROWSE BROWSE-PAR
    QUERY BROWSE-PAR NO-LOCK DISPLAY
       temp-parent.ptb  FORMAT "x(14)":U
       temp-parent.pidx FORMAT "x(14)":U
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

 DEFINE BROWSE BROWSE-PAR1
    QUERY BROWSE-PAR1 NO-LOCK DISPLAY
       temp-parent1.idxn FORMAT "x(13)":U
       temp-parent1.ctyp FORMAT "x(8)":U
       temp-parent1.fldl 
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD
    QUERY BROWSE-CHILD NO-LOCK DISPLAY
       temp-child.cidx FORMAT "x(30)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD1
    QUERY BROWSE-CHILD1 NO-LOCK DISPLAY
       temp-child1.idxn FORMAT "x(13)":U
       temp-child1.ctyp FORMAT "x(8)":U
       temp-child1.fldl   
    
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

&Scoped-define FRAME-NAME frame_foreign 

/* Definitions for BROWSE BROWSE-PAR                                      */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR temp-parent.ptb temp-parent.pidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR 
&Scoped-define QUERY-STRING-BROWSE-PAR FOR EACH temp-parent NO-LOCK. 
&Scoped-define OPEN-QUERY-BROWSE-PAR OPEN QUERY BROWSE-PAR FOR EACH temp-parent NO-LOCK .
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR temp-parent
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR temp-parent




/* Definitions for BROWSE BROWSE-PAR1                                     */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR1
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR1  temp-parent1.idxn temp-parent1.ctyp temp-parent1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR1
&Scoped-define QUERY-STRING-BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-PAR1 OPEN QUERY BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR1 temp-parent1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR1 temp-parent1


/* Definitions for BROWSE BROWSE-CHILD                                      */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD temp-child.cidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD 
&Scoped-define QUERY-STRING-BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD OPEN QUERY BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD temp-child
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD temp-child

/* Definitions for BROWSE BROWSE-CHILD1                                     */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD1  temp-child1.idxn  temp-child1.ctyp temp-child1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD1 
&Scoped-define QUERY-STRING-BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD1  OPEN QUERY BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD1  temp-child1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD1  temp-child1
  

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.1 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.1 COL 43 WIDGET-ID 300
     BROWSE-CHILD AT ROW 7.6 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 7.6 COL 43 WIDGET-ID 500   
     child AT ROW 6.6 COL 12 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 11.4 COL 2 WIDGET-ID 40
     modf   AT ROW 11.3 COL 43
     DESC_EDIT AT ROW 12.4 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 14.4 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 15.3 COL 3
     CREATE_BUT AT ROW 15.3 COL 17
     CANCEL_BUT AT ROW 15.3 COL 31
     HELP_BUT AT ROW 15.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12.6 COL 2 WIDGET-ID 38
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.3 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 6.7 COL 43 WIDGET-ID 600          
     "* = Primary Constraint" VIEW-AS TEXT
          SIZE 24 BY .62 AT ROW 2.3 COL 16 WIDGET-ID 600
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
              
     &ELSE
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.4 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.4 COL 39 WIDGET-ID 300
     BROWSE-CHILD AT ROW 10 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 10 COL 39 WIDGET-ID 500   
     child AT ROW 9 COL 13.4 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 16 COL 2 WIDGET-ID 40
     modf   AT ROW 16 COL 43
     DESC_EDIT AT ROW 17.3 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20.3 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20.3 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20.3 COL 52 WIDGET-ID 30
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 9 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.4 COL 43 WIDGET-ID 600          
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
     &ENDIF
 ASSIGN       
       BROWSE-PAR:COLUMN-RESIZABLE IN FRAME frame_foreign       = TRUE            
       BROWSE-PAR1:COLUMN-RESIZABLE IN FRAME frame_foreign      = TRUE       
       BROWSE-CHILD:COLUMN-RESIZABLE IN FRAME frame_foreign     = TRUE      
       BROWSE-CHILD1:COLUMN-RESIZABLE IN FRAME frame_foreign    = TRUE.     
 
 DEF VAR fnintSub AS INTEGER NO-UNDO.
 DEF VAR chldintSub AS INTEGER NO-UNDO.
 DEF VAR tbllist AS INTEGER NO-UNDO.
 DEF VAR pirec AS INTEGER NO-UNDO.
 DEF VAR cirec AS INTEGER NO-UNDO.

        DEFINE VARIABLE fnQuery AS HANDLE.
        DEFINE VARIABLE fnBrowse AS HANDLE.
        DEFINE VARIABLE fnBuffer AS HANDLE.
        DEFINE VARIABLE fnField AS HANDLE.
        DEFINE VARIABLE fnField1 AS HANDLE.
        DEFINE VARIABLE fnField2 AS HANDLE.
        
	    DEFINE VARIABLE chldQuery AS HANDLE.
        DEFINE VARIABLE chldBrowse AS HANDLE.
        DEFINE VARIABLE chldBuffer AS HANDLE.
        DEFINE VARIABLE chldField1 AS HANDLE.
	    DEFINE VARIABLE chldField2 AS HANDLE.
        
ON CHOOSE OF OK_BUT IN FRAME frame_foreign
  DO:          
          ASSIGN is-saved = FALSE.
          RUN validate_foreign.
     IF is-saved THEN
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.        
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_foreign
 DO:
          RUN validate_foreign.
 END. 

ON CHOOSE OF CANCEL_BUT IN FRAME frame_foreign
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END. 
   
ON VALUE-CHANGED OF BROWSE-PAR IN FRAME frame_foreign /* Browse 1 */
DO:
  RUN Fill_Parent_Record.
  RUN Fetch_Foreign_Name.
END.

ON VALUE-CHANGED OF BROWSE-CHILD IN FRAME frame_foreign /* Browse 2 */
DO:
  RUN Fill_Child_Info.
  RUN Fetch_Foreign_Name.

END.

ON ENTRY OF DESC_EDIT IN FRAME frame_foreign
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="". 
  &ENDIF
END. 

ON ENTRY OF name IN FRAME frame_foreign
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="". 
  &ENDIF
 END.
       
PROCEDURE foreign :
   &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_foreign 

     HIDE FRAME frame_clustered.
     HIDE FRAME frame_primary.   
     HIDE FRAME frame_unique.    
     HIDE FRAME frame_default.    
     HIDE FRAME frame_check.    
     VIEW FRAME frame_foreign.
     DISPLAY name BROWSE-PAR  BROWSE-PAR1  child BROWSE-CHILD BROWSE-CHILD1 Active modf DESC_EDIT 
                    &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF
          WITH FRAME frame_foreign.
     ASSIGN child:SCREEN-VALUE IN FRAME frame_foreign = c_table_name.
     ASSIGN Active:SCREEN-VALUE IN FRAME frame_foreign ="yes".
     ASSIGN modf:SCREEN-VALUE IN FRAME frame_foreign ="NONE".
     ENABLE  name BROWSE-PAR  BROWSE-PAR1   BROWSE-CHILD BROWSE-CHILD1 Active modf DESC_EDIT
                  OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF
     WITH FRAME frame_foreign.
    {&OPEN-BROWSERS-IN-QUERY-frame_foreign}

RUN Fill_Par_Table_Index.
RUN Fill_Parent_Record.
RUN Fill_Child_Index.
RUN Fill_Child_Info. 
RUN Fetch_Foreign_Name.


  
END PROCEDURE.

PROCEDURE Fill_Par_Table_Index:
   EMPTY TEMP-TABLE temp-parent.
   FOR EACH DICTDB._file WHERE DICTDB._file._Db-Recid = DbRecId:
              FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = RECID(DICTDB._file) NO-LOCK:
               
               ASSIGN pirec = RECID(DICTDB._index).
               FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = pirec AND 
               (DICTDB._Constraint._Con-Type = "U" OR DICTDB._Constraint._Con-Type = "P" OR
                DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" ) NO-LOCK NO-ERROR.
               IF AVAILABLE (DICTDB._Constraint) THEN
               DO:
               CREATE temp-parent.
               IF (DICTDB._Constraint._Con-Type <> "U" )
               THEN
                    ASSIGN temp-parent.ptb = "*" + DICTDB._file._file-name .
               ELSE 
                    ASSIGN temp-parent.ptb = DICTDB._file._file-name.
                    
               ASSIGN   temp-parent.pidx = DICTDB._Index._Index-name
                        temp-parent.prec = pirec.
               END.
	      END.
    END.
    
{&OPEN-QUERY-BROWSE-PAR}
END PROCEDURE.



PROCEDURE Fill_Parent_Record:

    fnBrowse = BROWSE BROWSE-PAR:HANDLE. 
    fnQuery  = fnBrowse:QUERY.
    fnBuffer = fnQuery:GET-BUFFER-HANDLE(1). 
    
    DO fnintSub = 1 TO fnBrowse:NUM-SELECTED-ROWS:
           fnBrowse:FETCH-SELECTED-ROW(fnintSub).
           fnField  = fnBuffer:BUFFER-FIELD( "ptb" ).
	       fnField1 = fnBuffer:BUFFER-FIELD( "pidx" ).
	       fnField2 = fnBuffer:BUFFER-FIELD( "prec" ).
    END.
  IF CAN-FIND (FIRST temp-parent) THEN
      ASSIGN Par_Idx = fnField1:BUFFER-VALUE.
  ELSE MESSAGE " No Primary or Unique constraint(s) have been defined, Foreign Key cannot be created " view-as alert-box warning.    
  EMPTY TEMP-TABLE temp-parent1.
  counter = 0.
  FIND FIRST _file WHERE _file._file-name = TRIM(fnField:BUFFER-VALUE) AND DICTDB._file._Db-Recid = DbRecId NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = fnField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  fnField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.
      counter = counter + 1.
      CREATE temp-parent1.
      ASSIGN            temp-parent1.idxn = DICTDB._FIELD._Field-name 
                        temp-parent1.ctyp = DICTDB._FIELD._Data-Type
		                temp-parent1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER")
		                temp-parent1.fnum = counter.

  END.
    {&OPEN-QUERY-BROWSE-PAR1} 

END PROCEDURE.

PROCEDURE Fill_Child_Index:
EMPTY TEMP-TABLE temp-child.
FOR EACH DICTDB._file where DICTDB._file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._file._Db-Recid = DbRecId:
 file_rec = RECID(DICTDB._file).
              FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND DICTDB._index._wordidx <> 1 NO-LOCK:
               CREATE temp-child.
	       ASSIGN 
	             temp-child.cidx = DICTDB._Index._Index-name
	             temp-child.crec = RECID(DICTDB._index).
	       END.
	        
 END.
 {&OPEN-QUERY-BROWSE-CHILD}
 END PROCEDURE.


PROCEDURE Fill_Child_Info:

    chldBrowse = BROWSE BROWSE-CHILD:HANDLE. 
    chldQuery  = chldBrowse:QUERY.
    chldBuffer = chldQuery:GET-BUFFER-HANDLE(1).

    DO chldintSub = 1 TO chldBrowse:NUM-SELECTED-ROWS:
           chldBrowse:FETCH-SELECTED-ROW(chldintSub).
	       chldField1 = chldBuffer:BUFFER-FIELD( "cidx" ).
	       chldField2 = chldBuffer:BUFFER-FIELD( "crec" ).
    END.

  EMPTY TEMP-TABLE temp-child1.
  counter = 0.
  
  FIND FIRST _file WHERE _file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._file._Db-Recid = DbRecId NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = chldField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  chldField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.

      CREATE temp-child1.
      counter = counter + 1.
      ASSIGN            temp-child1.idxn = DICTDB._FIELD._Field-name 
                        temp-child1.ctyp = DICTDB._FIELD._Data-Type
		                temp-child1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER")
		                temp-child1.fnum = counter.

      END.
  
  {&OPEN-QUERY-BROWSE-CHILD1}


	  
END PROCEDURE.


PROCEDURE Fetch_Foreign_Name:
   chldBrowse = BROWSE BROWSE-CHILD:HANDLE. 
   chldQuery  = chldBrowse:QUERY.
   chldBuffer = chldQuery:GET-BUFFER-HANDLE(1).

   DO chldintSub = 1 TO chldBrowse:NUM-SELECTED-ROWS:
           chldBrowse:FETCH-SELECTED-ROW(chldintSub).
	       chldField1 = chldBuffer:BUFFER-FIELD( "cidx" ).
	       chldField2 = chldBuffer:BUFFER-FIELD( "crec" ).
   
     
     ASSIGN Selected_Idx = chldField1:BUFFER-VALUE.
   END.
run Create_Const_Name.
END PROCEDURE.
 
PROCEDURE foreign_save:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_foreign 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:
       num = num + 1.
       CREATE DICTDB._Constraint.
       ASSIGN _Con-Type = "F"
              _Con-Name = name:SCREEN-VALUE IN FRAME frame_foreign
              _For-Name = "".
       IF ACTIVE:SCREEN-VALUE IN FRAME frame_foreign = "yes" 
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
       ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_foreign 
              _con-misc2[1] = modf:SCREEN-VALUE IN FRAME frame_foreign               
              _File-recid = file_rec
              _Con-Status = "N"
              _Index-recid = chldField2:BUFFER-VALUE
              _Index-parent-recid = fnField2:BUFFER-VALUE
              _Con-Num = num
              _db-recid = DbRecId.
       RUN TEMP1.
       RUN foreign.
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="Constraint Created".  &ENDIF  
     ASSIGN is-saved = TRUE.            
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.                
END.

PROCEDURE validate_foreign:
        
        assign flg=TRUE.
        FOR EACH temp-child1:
          FIND FIRST temp-parent1 WHERE Temp-parent1.fnum = temp-child1.fnum NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (temp-parent1) THEN DO:
             MESSAGE "Number of fields do not match" VIEW-AS ALERT-BOX ERROR. 
             ASSIGN flg = FALSE.
          END. 
          ELSE DO:
          IF Temp-parent1.ctyp <> temp-child1.ctyp AND flg = TRUE
           THEN DO:
              MESSAGE "Field Types do not match" VIEW-AS ALERT-BOX ERROR.
              flg = FALSE.
           END.
          END. 
        END.
        
        FOR EACH temp-parent1:
          FIND FIRST temp-child1 WHERE Temp-parent1.fnum = temp-child1.fnum NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (temp-child1) THEN DO:
             MESSAGE "Number of fields do not match" VIEW-AS ALERT-BOX ERROR. 
             ASSIGN flg = FALSE.
          END. 
          ELSE DO:
          IF temp-child1.ctyp <> temp-parent1.ctyp AND flg = TRUE
           THEN DO:
              MESSAGE "Field Types do not match" VIEW-AS ALERT-BOX ERROR.
              flg = FALSE.
           END.
          END. 
        END.          
        
        IF flg THEN DO:        
           RUN foreign_save.     
        END.   
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modcheck.i

Description:   
   This file contains the form for modification of Check Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/user/uservar.i}
{prodict/mss/key/moddef.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-CHECK FOR 
      temp2 SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-CHECK
  QUERY BROWSE-CHECK NO-LOCK DISPLAY
      temp2.fld FORMAT "x(33)":U
      temp2.chk FORMAT "x(33)":U

  WITH NO-ROW-MARKERS SEPARATORS 
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN SIZE 75 BY 3.32 FIT-LAST-COLUMN.
  &ELSE SIZE 75 BY 6 FIT-LAST-COLUMN.
  &ENDIF
  /*    DEFINATION FOR CHECK FRAME  */  
&Scoped-define FRAME-NAME frame_check
&Scoped-define BROWSE-NAME BROWSE-CHECK
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHECK temp2.fld temp2.chk 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHECK 
&Scoped-define QUERY-STRING-BROWSE-CHECK FOR EACH temp2 NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-CHECK OPEN QUERY BROWSE-CHECK FOR EACH temp2 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHECK temp2
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHECK temp2

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 2.6 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 6.3 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 7.1 COL 14 NO-LABEL
     VALIDATE AT ROW 9.2 COL 14 NO-LABEL
     DESC_EDIT AT ROW 11.8 COL 14 NO-LABEL
     msg AT ROW 14 COL 2 WIDGET-ID 4  NO-LABEL
    
     OK_BUT AT ROW 15 COL 3
     CREATE_BUT AT ROW 15 COL 17
     CANCEL_BUT AT ROW 15 COL 31
     HELP_BUT AT ROW 15 COL 60
     "Constraint" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.3 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.9 COL 2 WIDGET-ID 38 
     "Validation" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.4 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.1 COL 2 WIDGET-ID 38
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12 COL 2 WIDGET-ID 38      

     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 3.2 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 9 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 10.4 COL 2 
     VALIDATE AT ROW 13.4 COL 2.3
     DESC_EDIT AT ROW 16.4 COL 2 WIDGET-ID 36
    
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30  
    
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 11.4 COL 2 WIDGET-ID 38
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 14.4 COL 2 WIDGET-ID 38
     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
    &ENDIF       
                          
 ASSIGN BROWSE-CHECK:COLUMN-RESIZABLE IN FRAME frame_check = TRUE.         

ON CHOOSE OF OK_BUT IN FRAME frame_check
  DO:          
      IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
      THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
      ELSE DO:
        RUN check_save.
        APPLY "CLOSE":U TO THIS-PROCEDURE.
        RETURN NO-APPLY.                   
      END.
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_check
 DO:
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
       RUN check_save.
       RUN FILL_TEMP2.
       RUN check.
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF 
     END.  
 END. 
 
ON ENTRY OF EXPRESSION IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
END. 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_check
  DO:     
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END.  

PROCEDURE check :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_check~
           ~{&OPEN-QUERY-BROWSE-CHECK}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           
           HIDE FRAME frame_unique.
           HIDE FRAME frame_default.
           VIEW FRAME frame_check. 
           DISPLAY NAME BROWSE-CHECK Active DESC_EDIT EXPRESSION  VALIDATE 
                          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF
                    WITH FRAME frame_check.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_check =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_check ="yes".
           IF chek <> "" THEN EXPRESSION:SCREEN-VALUE IN FRAME frame_check = chek.
           ASSIGN DESC_EDIT:SCREEN-VALUE IN FRAME frame_check = descrip.
         
           IF user_dbtype    NE "MSS" then 
           ENABLE BROWSE-CHECK Active DESC_EDIT EXPRESSION
                    OK_BUT CREATE_BUT CANCEL_BUT  
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                    WITH FRAME frame_check.
           ELSE
           ENABLE BROWSE-CHECK DESC_EDIT 
                    OK_BUT CREATE_BUT CANCEL_BUT  
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                    WITH FRAME frame_check.
           {&OPEN-BROWSERS-IN-QUERY-frame_check}
           
        FIND FIRST  DICTDB._constraint where DICTDB._constraint._con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid 
                                                                             NO-LOCK NO-ERROR.
        FOR EACH temp2 WHERE rec = DICTDB._constraint._field-recid NO-LOCK:
           curr-rec = ROWID(temp2).
           REPOSITION BROWSE-CHECK TO ROWID curr-rec.
        END.
                   
END PROCEDURE.

PROCEDURE check_save:
    FOR EACH DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecId:
      IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check <> _Con-Expr THEN 
      MESSAGE "Check Constraint expression changed" VIEW-AS ALERT-BOX INFORMATION.
      IF ACTIVE:SCREEN-VALUE IN FRAME frame_check = "yes" THEN
      ASSIGN _Con-Active = TRUE.
      ELSE ASSIGN _Con-Active = FALSE.
      ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_check. 
      ASSIGN _Con-Status = "C"
            _Con-Expr = EXPRESSION:SCREEN-VALUE IN FRAME frame_check.         
    END.  
END.          
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modclus.i

Description:   
   This file contains the form for modification of clustered Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/modpri.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-CLUSTERED FOR 
      temp SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-CLUSTERED
  QUERY BROWSE-CLUSTERED NO-LOCK DISPLAY
      temp.ind FORMAT "x(16)":U
      temp.pri FORMAT "x(8)":U
      temp.uni FORMAT "x(8)":U
      temp.clu FORMAT "x(8)":U
      temp.man FORMAT "x(10)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF

/*    DEFINATION FOR CLUSTERED FRAME  */  

&Scoped-define FRAME-NAME frame_clustered

&Scoped-define BROWSE-NAME BROWSE-CLUSTERED
&Scoped-define FIELDS-IN-QUERY-BROWSE-CLUSTERED temp.pri temp.uni temp.ind temp.clu temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CLUSTERED 
&Scoped-define QUERY-STRING-BROWSE-CLUSTERED FOR EACH temp NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-CLUSTERED OPEN QUERY BROWSE-CLUSTERED FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CLUSTERED temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CLUSTERED temp

        
        DEF VAR cintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE cQuery AS HANDLE.
        DEFINE VARIABLE cBrowse AS HANDLE.
        DEFINE VARIABLE cBuffer AS HANDLE.
        DEFINE VARIABLE cField AS HANDLE.
        DEFINE VARIABLE cField1 AS HANDLE.
        DEFINE VARIABLE cField2 AS HANDLE.
        DEFINE VARIABLE cField3 AS HANDLE.
        DEFINE VARIABLE cField4 AS HANDLE.
        DEFINE VARIABLE cField5 AS HANDLE.

        cBrowse = BROWSE BROWSE-CLUSTERED:HANDLE. /* Browse-3 is browser name */
        cQuery  = cBrowse:QUERY.
        cBuffer = cQuery:GET-BUFFER-HANDLE(1).    

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CLUSTERED AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     Primary AT ROW 8.6 COL 24 WIDGET-ID 42
     Clustered AT ROW 8.6 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_clustered
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16  WIDGET-ID 100.
                  
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CLUSTERED AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     Primary AT ROW 13 COL 24 WIDGET-ID 42
     Clustered AT ROW 13 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
          
     WITH FRAME frame_clustered
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21  WIDGET-ID 100.
     &ENDIF             
                       
 ASSIGN BROWSE-CLUSTERED:COLUMN-RESIZABLE IN FRAME frame_clustered        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_clustered
  DO:          
          RUN clust_save.
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.        
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_clustered
 DO:
          RUN clust_save.
          RUN TEMP1.
          RUN clustered.
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
          ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF  
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_clustered
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.  

ON ENTRY OF DESC_EDIT2 IN FRAME frame_clustered
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_clustered ="". 
  &ENDIF
END. 

ON VALUE-CHANGED OF BROWSE-CLUSTERED IN FRAME frame_clustered
  DO:
      DO cintSub = 1 TO cBrowse:NUM-SELECTED-ROWS : 
     
     
           cBrowse:FETCH-SELECTED-ROW(cintSub).

           cField  = cBuffer:BUFFER-FIELD( "ind" ).
           cField1 = cBuffer:BUFFER-FIELD( "pri" ).
           cField2 = cBuffer:BUFFER-FIELD( "clu" ).
           cField3 = cBuffer:BUFFER-FIELD( "uni" ).
           cField4 = cBuffer:BUFFER-FIELD( "man" ).
           cField5 = cBuffer:BUFFER-FIELD( "rec" ).

           ASSIGN Selected_Idx = cField:BUFFER-VALUE.
  
     END.
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
     ASSIGN msg:SCREEN-VALUE IN FRAME frame_clustered ="". 
     &ENDIF
     RUN valid_clus.
  END. 

PROCEDURE clustered :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_clustered ~
           ~{&OPEN-QUERY-BROWSE-CLUSTERED}
           
           HIDE FRAME frame_primary.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_unique.  
           HIDE FRAME frame_default.  
           HIDE FRAME frame_check.  
           VIEW FRAME frame_clustered.
           DISPLAY NAME BROWSE-CLUSTERED Active Primary Clustered DESC_EDIT2
                  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF
                   WITH FRAME frame_clustered.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_clustered =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_clustered ="yes".
           ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_clustered ="yes".           
           ASSIGN DESC_EDIT2:SCREEN-VALUE IN FRAME frame_clustered = descrip.

           IF user_dbtype    NE "MSS" then
              ENABLE  BROWSE-CLUSTERED Active DESC_EDIT2 
                  OK_BUT CREATE_BUT CANCEL_BUT  
                  &IF "{&WINDOW-SYSTEM}" <> "TTY"
                  &THEN HELP_BUT  
                  &ENDIF 
                  WITH FRAME frame_clustered.
           ELSE
                ENABLE  BROWSE-CLUSTERED DESC_EDIT2 
                  OK_BUT CREATE_BUT CANCEL_BUT  
                  &IF "{&WINDOW-SYSTEM}" <> "TTY"
                  &THEN HELP_BUT  
                  &ENDIF 
                  WITH FRAME frame_clustered.
            {&OPEN-BROWSERS-IN-QUERY-frame_clustered}

        FIND FIRST DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid NO-LOCK NO-ERROR.
        FOR EACH temp WHERE rec = DICTDB._constraint._index-recid NO-LOCK:
           curr-rec = ROWID(temp).
           REPOSITION BROWSE-CLUSTERED TO ROWID curr-rec.
        END.
             
END PROCEDURE.

PROCEDURE clust_save:
          FOR EACH DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid:
             IF ACTIVE:SCREEN-VALUE IN FRAME frame_clustered = "yes" THEN
             ASSIGN _Con-Active = TRUE.
             ELSE ASSIGN _Con-Active = FALSE.
             ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_clustered. 
             ASSIGN _Con-Status = "C".                     
          END.  
END.

PROCEDURE valid_clus:
          IF CAN-FIND (DICTDB._Constraint WHERE DICTDB._Constraint._File-Recid = file_rec AND (DICTDB._Constraint._Con-Type = "P"  OR
                       DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP"))
          THEN DO:
               IF cField1:BUFFER-VALUE = "C" OR cField1:BUFFER-VALUE = "I , C"
                  THEN ASSIGN Primary:SCREEN-VALUE IN FRAME frame_clustered ="yes".
               ELSE  ASSIGN Primary:SCREEN-VALUE IN FRAME frame_clustered ="no".  
               DISABLE Primary WITH FRAME frame_clustered.
          END. 
        IF cField2:BUFFER-VALUE = "I , C"  OR cField2:BUFFER-VALUE = "C"
        THEN ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_clustered ="yes".
        ELSE ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_clustered ="no".
        DISABLE Clustered WITH FRAME frame_clustered.     
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modcons.i

Description:   
   This file contains the forms the base code for modification of Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/viewmnt.i  }

DEFINE {1} TEMP-TABLE temp NO-UNDO
    FIELD ind AS CHAR LABEL "Index"
    FIELD pri AS CHAR LABEL "Primary"
    FIELD uni AS CHAR LABEL "Unique"
    FIELD clu AS CHAR LABEL "Clustered"
    FIELD man AS CHAR LABEL "All Columns Mandatory"
    FIELD rec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp2 NO-UNDO
    FIELD fld AS CHAR LABEL "Field"
    FIELD ini AS CHAR LABEL "Initial Value"
    FIELD chk AS CHAR LABEL "Constraint Expression"
    FIELD rec AS RECID LABEL "REC ID"
    FIELD cdf AS CHAR LABEL "Constraint Expression".

DEFINE {1} TEMP-TABLE temp-parent NO-UNDO  
    FIELD ptb AS CHAR LABEL "Parent Table"
    FIELD pidx AS CHAR LABEL "Parent Index"
    FIELD prec AS RECID LABEL "REC ID".


DEFINE {1} TEMP-TABLE temp-parent1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "Number".
   

DEFINE {1} TEMP-TABLE temp-child NO-UNDO
    FIELD cidx AS CHAR LABEL "Child Index"
    FIELD crec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp-child1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "NUMBER".
      
DEFINE {1} VARIABLE  file_rec AS RECID   NO-UNDO.
DEFINE {1} VARIABLE  mandatory AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  A   AS INTEGER NO-UNDO.
DEFINE {1} VARIABLE  I   AS INTEGER NO-UNDO.
DEFINE {1} VARIABLE  Par_Idx AS CHAR NO-UNDO.
DEFine {1} VARiable  Selected_Idx as CHAR NO-UNDO.
DEFine {1} VARiable  act as CHAR NO-UNDO.
DEFine {1} VARiable  chek as CHAR NO-UNDO.
DEFine {1} VARiable  descrip as CHAR NO-UNDO.
DEFINE {1} VARIABLE  const_type AS CHAR NO-UNDO.
DEFINE {1} VARIABLE  curr-rec AS ROWID  NO-UNDO.

DEFINE {1} BUTTON OK_BUT  
     LABEL "&OK" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CREATE_BUT 
     LABEL "&Save" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CANCEL_BUT 
     LABEL "&Cancel" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON HELP_BUT 
     LABEL "&Help" 
     SIZE 13 BY 1.

DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Type." 
     &ELSE   LABEL "Constraint Type" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 4
     LIST-ITEMS "PRIMARY","CLUSTERED","UNIQUE","FOREIGN KEY","DEFAULT", "CHECK" 
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.

DEFINE VARIABLE child AS CHARACTER FORMAT "X(12)":U 
     LABEL "Child Table" 
     VIEW-AS FILL-IN 
     SIZE 14 BY .92 NO-UNDO.
     
DEFINE {1} VARIABLE EXPRESSION AS CHARACTER
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Constraint ."  
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Constraint." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF     

DEFINE {1} VARIABLE VALIDATE AS CHARACTER 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Validation ." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Validation." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF

DEFINE {1} VARIABLE DESC_EDIT AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 3 NO-UNDO.
     &ENDIF
     
DEFINE {1} VARIABLE DESC_EDIT2 AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 4.3 NO-UNDO.
     &ENDIF     

     
DEFINE {1} VARIABLE msg AS CHARACTER FORMAT "X(80)":U 
     LABEL ""
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.
     
DEFINE {1} VARIABLE name AS CHARACTER FORMAT "X(80)":U 
     LABEL "Constraint &Name" 
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.

DEFINE {1} VARIABLE Active AS LOGICAL INITIAL no 
     LABEL "Active" 
     VIEW-AS TOGGLE-BOX
     SIZE 11 BY .81 NO-UNDO.

DEFINE {1} VARIABLE Primary AS LOGICAL INITIAL no 
     LABEL "Primary" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE {1} VARIABLE Clustered AS LOGICAL INITIAL no 
     LABEL "Clustered" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE {1} FRAME DEFAULT-FRAME
   &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN Constrainttype AT ROW 1.4 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ELSE Constrainttype AT ROW 1.95 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ENDIF
   WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         &IF "{&WINDOW-SYSTEM}" <> "TTY"
         &THEN SIZE 82 BY 19 WIDGET-ID 100
         &ELSE SIZE 82 BY 24 WIDGET-ID 100
         &ENDIF
         
         VIEW-AS DIALOG-BOX 
         TITLE "Modify Foreign Constraint Definition for " + c_table_name .
         
DEFINE {1} FRAME frame_primary.
DEFINE {1} FRAME frame_foreign.
DEFINE {1} FRAME frame_clustered.
DEFINE {1} FRAME frame_unique.
DEFINE {1} FRAME frame_default.
DEFINE {1} FRAME frame_check.


ASSIGN FRAME frame_clustered:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_primary:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_foreign:FRAME = FRAME DEFAULT-FRAME:HANDLE   
       FRAME frame_unique:FRAME = FRAME DEFAULT-FRAME:HANDLE.
       FRAME frame_default:FRAME = FRAME DEFAULT-FRAME:HANDLE.
       FRAME frame_check:FRAME = FRAME DEFAULT-FRAME:HANDLE.

PROCEDURE TEMP1:

EMPTY TEMP-TABLE temp.

FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._file._Db-Recid = DbRecId NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND _Index._Wordidx <> 1 NO-LOCK:
       CREATE temp.
       ASSIGN ind = DICTDB._index._index-name.
              IF _unique = YES
              THEN ASSIGN uni = "I".
              IF DICTDB._File._Prime-Index = RECID(DICTDB._Index) 
              THEN ASSIGN pri = "I".
              A = RECID(DICTDB._index).
              FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Index-recid = A AND DICTDB._Constraint._Con-Status <> "D"
                                                       AND DICTDB._Constraint._Con-Status <> "O":
                            
                IF (DICTDB._Constraint._Con-Type = "M" OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "PC")
                   THEN ASSIGN clu ="C" .
                IF (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "PC")               
                   THEN DO:
                   IF pri <> "" THEN pri = pri + " , C".
                                     ELSE pri = "C".
                   END.
                IF (DICTDB._Constraint._Con-Type = "U")
                   THEN DO:
                   IF uni <> "" THEN uni = uni + " , C".
                                     ELSE uni = "C".  
                   END.
               END.    
              ASSIGN mandatory = 0.
              ASSIGN rec = RECID(DICTDB._index).
              FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid = A:
                  FIND FIRST DICTDB._Field where DICTDB._index-field._Field-Recid = RECID(DICTDB._Field).
                  IF DICTDB._Field._Mandatory = NO THEN ASSIGN mandatory = 1.
              END.
              IF mandatory = 0 THEN ASSIGN man = "  I".    
   END.
END.
  FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND 
           DICTDB._Constraint._Con-status <> "O" AND DICTDB._Constraint._Con-status <> "D" 
                                  AND DICTDB._Constraint._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE DICTDB._Constraint THEN DO:
     ASSIGN act = "n".
     ASSIGN chek = DICTDB._Constraint._Con-Expr. 
     ASSIGN descrip =  DICTDB._Constraint._con-desc. 
     IF DICTDB._Constraint._con-active = TRUE THEN ASSIGN act = "t".
   END.
END PROCEDURE.

PROCEDURE FILL_TEMP2:
EMPTY TEMP-TABLE temp2.
FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._file._Db-Recid = DbRecId NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._Field WHERE DICTDB._Field._file-recid = file_rec NO-LOCK:
      CREATE temp2.
      ASSIGN fld = DICTDB._Field._Field-Name
             ini = DICTDB._Field._Initial
             rec = RECID(DICTDB._Field).
      A = RECID(DICTDB._Field).
      FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND DICTDB._Constraint._Field-Recid = A 
      AND DICTDB._Constraint._Con-Type = "C" AND DICTDB._Constraint._Con-Status <> "D" 
                                                          AND DICTDB._Constraint._Con-Status <> "O"  NO-LOCK NO-ERROR.
        IF AVAILABLE(DICTDB._Constraint)  
        THEN ASSIGN chk = DICTDB._Constraint._Con-Expr.
      
      FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Field-Recid = A AND DICTDB._Constraint._Con-Type = "D"
          AND DICTDB._Constraint._Con-Status <> "D"  AND DICTDB._Constraint._Con-Status <> "O" NO-LOCK NO-ERROR.
        IF AVAILABLE(DICTDB._Constraint)  
        THEN ASSIGN cdf = DICTDB._Constraint._Con-Expr.
   END.
END.  
  FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND 
           DICTDB._Constraint._Con-status <> "O" AND DICTDB._Constraint._Con-status <> "D" 
                                  AND DICTDB._Constraint._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE DICTDB._Constraint THEN DO:
     ASSIGN act = "n".
     ASSIGN chek = DICTDB._Constraint._Con-Expr. 
     ASSIGN descrip =  DICTDB._Constraint._con-desc. 
     IF DICTDB._Constraint._con-active = TRUE THEN ASSIGN act = "t".
  END.    
END PROCEDURE.


  FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecId NO-LOCK:
     IF (DICTDB._Constraint._con-type = "PC" OR DICTDB._Constraint._con-type = "P" OR
            DICTDB._Constraint._con-type = "MP") THEN ASSIGN const_type ="PRIMARY".
     IF DICTDB._Constraint._con-type = "M" THEN ASSIGN const_type ="CLUSTERED".
     IF DICTDB._Constraint._con-type = "C" THEN ASSIGN const_type ="CHECK".
     IF DICTDB._Constraint._con-type = "U" THEN ASSIGN const_type ="UNIQUE".
     IF DICTDB._Constraint._con-type = "F" THEN ASSIGN const_type ="FOREIGN KEY".
     IF DICTDB._Constraint._con-type = "D" THEN ASSIGN const_type ="DEFAULT".
  END. 
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modcons.p

Description:   
   This file contains the form for modification Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/modforg.i }

&Scoped-define SELF-NAME Constrainttype


ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME frame_primary.
    APPLY "END-ERROR" TO FRAME frame_clustered.
    APPLY "END-ERROR" TO FRAME frame_unique.
    APPLY "END-ERROR" TO FRAME frame_foreign.
    APPLY "END-ERROR" TO FRAME frame_default.
    APPLY "END-ERROR" TO FRAME frame_check.
END.  

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME frame_primary OR HELP OF FRAME frame_clustered OR HELP OF FRAME frame_unique OR HELP OF FRAME frame_foreign
  OR HELP OF FRAME frame_default  OR HELP OF FRAME frame_check
  OR CHOOSE of HELP_BUT IN FRAME frame_primary  OR CHOOSE of HELP_BUT IN FRAME frame_clustered 
  OR CHOOSE of HELP_BUT IN FRAME frame_unique   OR CHOOSE of HELP_BUT IN FRAME frame_foreign  
  OR CHOOSE of HELP_BUT IN FRAME frame_default  OR CHOOSE of HELP_BUT IN FRAME frame_check
 DO:   
    
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&MS_SQL_Server_DataServer_View_Modify_Contraint_Properties_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
 
  RUN enable_UI.  
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
    
  ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
  
    
    
END.

PROCEDURE enable_UI :
  DISPLAY Constrainttype 
      WITH FRAME DEFAULT-FRAME.
  ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME =const_type.
  FIND FIRST _Constraint WHERE _Constraint._Con-Name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid.
    
     RUN TEMP1.
     RUN FILL_TEMP2.
     
     IF  const_type ="PRIMARY" THEN RUN primary.
     IF  const_type ="CLUSTERED" THEN RUN clustered.
     IF  const_type ="CHECK" THEN RUN check.
     IF  const_type ="UNIQUE" THEN RUN unique.
     IF  const_type ="FOREIGN KEY" THEN RUN foreign.
     IF  const_type ="DEFAULT" THEN RUN default.

   IF cDbType = "MSS" OR cDbType = "ORACLE" THEN DO:
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT2 WITH FRAME frame_primary.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT2 WITH FRAME frame_clustered.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT2 WITH FRAME frame_unique.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT WITH FRAME frame_foreign.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT WITH FRAME frame_default.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT WITH FRAME frame_check.
   END. 

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: moddef.i

Description:   
   This file contains the form for modification of default Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/mss/key/moduni.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-DEFAULT FOR 
      temp2 SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-DEFAULT
  QUERY BROWSE-DEFAULT NO-LOCK DISPLAY
      temp2.fld FORMAT "x(22)":U
      temp2.ini FORMAT "x(22)":U
      temp2.cdf FORMAT "x(22)":U

  WITH NO-ROW-MARKERS SEPARATORS 
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN SIZE 75 BY  4.52 FIT-LAST-COLUMN.
  &ELSE SIZE 75 BY 7 FIT-LAST-COLUMN.
  &ENDIF      

/*    DEFINATION FOR DEFAULT FRAME  */  

&Scoped-define FRAME-NAME frame_default 
&Scoped-define BROWSE-NAME BROWSE-DEFAULT
&Scoped-define FIELDS-IN-QUERY-BROWSE-DEFAULT temp2.fld temp2.ini 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-DEFAULT 
&Scoped-define QUERY-STRING-BROWSE-DEFAULT FOR EACH temp2 NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-DEFAULT OPEN QUERY BROWSE-DEFAULT FOR EACH temp2 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-DEFAULT temp2
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-DEFAULT temp2

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN   
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-DEFAULT AT ROW 2.8 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 7.9 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 8.9 COL 14 NO-LABEL
     DESC_EDIT AT ROW 11.5 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 13.7 COL 2 WIDGET-ID 4 NO-LABEL
    
     OK_BUT AT ROW 15 COL 3
     CREATE_BUT AT ROW 15 COL 17
     CANCEL_BUT AT ROW 15 COL 31
     HELP_BUT AT ROW 15 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 11.7 COL 2 WIDGET-ID 38
     "Constraint" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.1 COL 2 WIDGET-ID 38
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.8 COL 2 WIDGET-ID 38
     WITH FRAME frame_default
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
     
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-DEFAULT AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 11 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 12.5 COL 2 
     DESC_EDIT AT ROW 16 COL 2 WIDGET-ID 36
    
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 13.5 COL 2 WIDGET-ID 38
     WITH FRAME frame_default
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
     &ENDIF        
                          
 ASSIGN BROWSE-DEFAULT:COLUMN-RESIZABLE IN FRAME frame_default        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_default
  DO:          
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_default = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_default = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
          RUN default_save.
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.         
     END.     
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_default
 DO:
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_default = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_default = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
          RUN default_save.
          RUN FILL_TEMP2.
          RUN default.
     END.      
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_default
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.  

ON ENTRY OF EXPRESSION IN FRAME frame_default
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT IN FRAME frame_default
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_default ="". 
  &ENDIF
END. 
 
PROCEDURE default :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_default ~
           ~{&OPEN-QUERY-BROWSE-DEFAULT}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           
           HIDE FRAME frame_unique.
           HIDE FRAME frame_check.
           VIEW FRAME frame_default. 
           DISPLAY name BROWSE-DEFAULT Active DESC_EDIT EXPRESSION 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_default.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_default =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_default ="yes".
           IF chek <> "" THEN EXPRESSION:SCREEN-VALUE IN FRAME frame_default = chek.
           ASSIGN DESC_EDIT:SCREEN-VALUE IN FRAME frame_default = descrip.

           IF user_dbtype    NE "MSS" then
              ENABLE   BROWSE-DEFAULT Active DESC_EDIT EXPRESSION 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                    WITH FRAME frame_default.
           ELSE
               ENABLE   BROWSE-DEFAULT DESC_EDIT 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                    WITH FRAME frame_default.
             {&OPEN-BROWSERS-IN-QUERY-frame_default}
        FIND FIRST DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid NO-LOCK NO-ERROR.
        FOR EACH temp2 WHERE rec = DICTDB._constraint._field-recid NO-LOCK:
           curr-rec = ROWID(temp2).
           REPOSITION BROWSE-DEFAULT TO ROWID curr-rec.
        END.               
END PROCEDURE.

PROCEDURE default_save:
     FOR EACH DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid:
         IF EXPRESSION:SCREEN-VALUE IN FRAME frame_default <> DICTDB._constraint._Con-Expr AND
            EXPRESSION:SCREEN-VALUE IN FRAME frame_default <> ""
         THEN DO:
          MESSAGE "Default constraint expression changed" VIEW-AS ALERT-BOX INFORMATION.
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_default= "yes" THEN
          ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_default. 
          ASSIGN _Con-Status = "C"
                 _Con-Expr = EXPRESSION:SCREEN-VALUE IN FRAME frame_default.   
                 
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
          ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF                                    
         END.
     END.  
END.   
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modforg.i

Description:   
   This file contains the form for modification of Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/mss/key/modcheck.i }

DEFINE {1} VARIABLE modf AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Action." 
     &ELSE   LABEL "Con Action" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "NONE","CASCADE","SET NULL","SET DEFAULT" 
     DROP-DOWN-LIST
     SIZE 19 BY 1 NO-UNDO.
     
DEFINE  VARIABLE counter AS INTEGER NO-UNDO.
DEFINE  VARIABLE flg     AS LOGICAL NO-UNDO.
DEFINE {1} QUERY BROWSE-PAR FOR 
      temp-parent SCROLLING.

DEFINE {1} QUERY BROWSE-PAR1 FOR 
      temp-parent1 SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD FOR 
      temp-child SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD1 FOR 
      temp-child1 SCROLLING.

/* Browse definitions                                                   */

DEFINE {1} BROWSE BROWSE-PAR
    QUERY BROWSE-PAR NO-LOCK DISPLAY
       temp-parent.ptb  FORMAT "x(14)":U
       temp-parent.pidx FORMAT "x(14)":U
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

 DEFINE BROWSE BROWSE-PAR1
    QUERY BROWSE-PAR1 NO-LOCK DISPLAY
       temp-parent1.idxn FORMAT "x(13)":U
       temp-parent1.ctyp FORMAT "x(8)":U
       temp-parent1.fldl 
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD
    QUERY BROWSE-CHILD NO-LOCK DISPLAY
       temp-child.cidx FORMAT "x(30)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD1
    QUERY BROWSE-CHILD1 NO-LOCK DISPLAY
       temp-child1.idxn FORMAT "x(13)":U
       temp-child1.ctyp FORMAT "x(8)":U
       temp-child1.fldl   
    
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

&Scoped-define FRAME-NAME frame_foreign 

/* Definitions for BROWSE BROWSE-PAR                                      */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR temp-parent.ptb temp-parent.pidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR 
&Scoped-define QUERY-STRING-BROWSE-PAR FOR EACH temp-parent NO-LOCK. 
&Scoped-define OPEN-QUERY-BROWSE-PAR OPEN QUERY BROWSE-PAR FOR EACH temp-parent NO-LOCK .
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR temp-parent
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR temp-parent




/* Definitions for BROWSE BROWSE-PAR1                                     */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR1
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR1  temp-parent1.idxn temp-parent1.ctyp temp-parent1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR1
&Scoped-define QUERY-STRING-BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-PAR1 OPEN QUERY BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR1 temp-parent1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR1 temp-parent1


/* Definitions for BROWSE BROWSE-CHILD                                      */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD temp-child.cidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD 
&Scoped-define QUERY-STRING-BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD OPEN QUERY BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD temp-child
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD temp-child

/* Definitions for BROWSE BROWSE-CHILD1                                     */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD1  temp-child1.idxn  temp-child1.ctyp temp-child1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD1 
&Scoped-define QUERY-STRING-BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD1  OPEN QUERY BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD1  temp-child1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD1  temp-child1
  

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.1 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.1 COL 43 WIDGET-ID 300
     BROWSE-CHILD AT ROW 7.6 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 7.6 COL 43 WIDGET-ID 500   
     child AT ROW 6.6 COL 12 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 11.4 COL 2 WIDGET-ID 40
     modf   AT ROW 11.3 COL 43
     DESC_EDIT AT ROW 12.4 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 14.4 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 15.3 COL 3
     CREATE_BUT AT ROW 15.3 COL 17
     CANCEL_BUT AT ROW 15.3 COL 31
     HELP_BUT AT ROW 15.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12.6 COL 2 WIDGET-ID 38
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.3 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 6.7 COL 43 WIDGET-ID 600          
     "# = Virtual Index" VIEW-AS TEXT
          SIZE 24 BY .69 AT ROW 11.4 COL 16 WIDGET-ID 600        
     "* = Primary Constraint" VIEW-AS TEXT
          SIZE 24 BY .62 AT ROW 2.3 COL 16 WIDGET-ID 600
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
              
     &ELSE
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.4 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.4 COL 39 WIDGET-ID 300
     BROWSE-CHILD AT ROW 10 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 10 COL 39 WIDGET-ID 500   
     child AT ROW 9 COL 13.4 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 16 COL 2 WIDGET-ID 40
     modf   AT ROW 16 COL 43
     DESC_EDIT AT ROW 17.3 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20.3 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20.3 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20.3 COL 52 WIDGET-ID 30
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 9 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.4 COL 43 WIDGET-ID 600          
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
     &ENDIF
     
 ASSIGN       
     BROWSE-PAR:COLUMN-RESIZABLE IN FRAME frame_foreign       = TRUE   
     BROWSE-PAR1:COLUMN-RESIZABLE IN FRAME frame_foreign      = TRUE
     BROWSE-CHILD:COLUMN-RESIZABLE IN FRAME frame_foreign     = TRUE
     BROWSE-CHILD1:COLUMN-RESIZABLE IN FRAME frame_foreign    = TRUE.       
 
 DEF VAR fnintSub AS INTEGER NO-UNDO.
 DEF VAR chldintSub AS INTEGER NO-UNDO.
 DEF VAR tbllist AS INTEGER NO-UNDO.
 DEF VAR pirec AS INTEGER NO-UNDO.
 DEF VAR cirec AS INTEGER NO-UNDO.

        DEFINE VARIABLE fnQuery AS HANDLE.
        DEFINE VARIABLE fnBrowse AS HANDLE.
        DEFINE VARIABLE fnBuffer AS HANDLE.
        DEFINE VARIABLE fnField AS HANDLE.
        DEFINE VARIABLE fnField1 AS HANDLE.
        DEFINE VARIABLE fnField2 AS HANDLE.
        
	    DEFINE VARIABLE chldQuery AS HANDLE.
        DEFINE VARIABLE chldBrowse AS HANDLE.
        DEFINE VARIABLE chldBuffer AS HANDLE.
        DEFINE VARIABLE chldField1 AS HANDLE.
	    DEFINE VARIABLE chldField2 AS HANDLE.
        
ON CHOOSE OF OK_BUT IN FRAME frame_foreign
DO:          
    RUN foreign_save.
    APPLY "CLOSE":U TO THIS-PROCEDURE.
    RETURN NO-APPLY.        
END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_foreign
DO:
    RUN foreign_save.
    RUN TEMP1.
    RUN foreign.
    &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
    ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF     
END. 

ON CHOOSE OF CANCEL_BUT IN FRAME frame_foreign
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END. 
   
ON VALUE-CHANGED OF BROWSE-PAR IN FRAME frame_foreign /* Browse 1 */
DO:
    RUN Fill_Parent_Record.
END.

ON VALUE-CHANGED OF BROWSE-CHILD IN FRAME frame_foreign /* Browse 2 */
DO:
    RUN Fill_Child_Info.
END.

ON ENTRY OF DESC_EDIT IN FRAME frame_foreign
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="". 
  &ENDIF
END. 
       
PROCEDURE foreign :
   &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_foreign 

     HIDE FRAME frame_clustered.
     HIDE FRAME frame_primary.   
     HIDE FRAME frame_unique.    
     HIDE FRAME frame_default.    
     HIDE FRAME frame_check.    
     VIEW FRAME frame_foreign.
     DISPLAY name BROWSE-PAR  BROWSE-PAR1  child BROWSE-CHILD BROWSE-CHILD1 Active modf DESC_EDIT 
          WITH FRAME frame_foreign.
     ASSIGN child:SCREEN-VALUE IN FRAME frame_foreign = c_table_name.
     ASSIGN name:SCREEN-VALUE IN FRAME frame_foreign = constr_name.
     FIND FIRST  DICTDB._constraint where DICTDB._constraint._con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
     IF AVAILABLE DICTDB._constraint THEN DO:
       ASSIGN modf:SCREEN-VALUE IN FRAME frame_foreign = DICTDB._constraint._Con-Misc2[1].
     END.   
     IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_foreign ="yes".
     ASSIGN DESC_EDIT:SCREEN-VALUE IN FRAME frame_foreign = descrip.
   
     IF user_dbtype    NE "MSS" then
         ENABLE  BROWSE-PAR  BROWSE-PAR1   BROWSE-CHILD BROWSE-CHILD1 Active DESC_EDIT
                  OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
         WITH FRAME frame_foreign.
     ELSE
         ENABLE  BROWSE-PAR  BROWSE-PAR1   BROWSE-CHILD BROWSE-CHILD1 DESC_EDIT
                  OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
         WITH FRAME frame_foreign.
    {&OPEN-BROWSERS-IN-QUERY-frame_foreign}

  RUN Fill_Par_Table_Index.
  RUN Fill_Parent_Record.
  RUN Fill_Child_Index.
  RUN Fill_Child_Info. 
  
END PROCEDURE.

PROCEDURE Fill_Par_Table_Index:
  EMPTY TEMP-TABLE temp-parent.
  FOR EACH DICTDB._file WHERE DICTDB._File._Db-Recid = DbRecId:
      FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = RECID(DICTDB._file) NO-LOCK:
               
         ASSIGN pirec = RECID(DICTDB._index).
         FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = pirec AND 
              (DICTDB._Constraint._Con-Type = "U" OR DICTDB._Constraint._Con-Type = "P" OR
                DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" ) NO-LOCK NO-ERROR.
         IF AVAILABLE (DICTDB._Constraint) THEN
         DO:
            CREATE temp-parent. 
            IF (DICTDB._Constraint._Con-Type <> "U" )
            THEN
               ASSIGN temp-parent.ptb = "*" + DICTDB._file._file-name.
            ELSE 
               ASSIGN temp-parent.ptb = DICTDB._file._file-name.            
               ASSIGN   temp-parent.pidx = DICTDB._Index._Index-name
                        temp-parent.prec = pirec.
         END.
	  END.
   END.
    
{&OPEN-QUERY-BROWSE-PAR}


   FIND FIRST  DICTDB._constraint where _con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE DICTDB._constraint THEN DO:
      FIND FIRST temp-parent WHERE temp-parent.prec = DICTDB._constraint._index-parent-recid NO-LOCK NO-ERROR.
      IF AVAILABLE temp-parent THEN DO:
         curr-rec = ROWID(temp-parent).
         REPOSITION BROWSE-PAR TO ROWID curr-rec.
      END.
      ELSE DO:
        FIND FIRST DICTDB._index WHERE RECID(DICTDB._index) = DICTDB._constraint._index-parent-recid NO-LOCK NO-ERROR.
        FIND FIRST DICTDB._file WHERE RECID(DICTDB._File) = DICTDB._index._File-Recid.
           CREATE temp-parent. 
           ASSIGN temp-parent.ptb  = DICTDB._file._file-name           
                  temp-parent.pidx = DICTDB._Index._Index-name
                  temp-parent.prec = INTEGER( RECID(DICTDB._index)).       

         FIND FIRST temp-parent WHERE temp-parent.prec = DICTDB._constraint._index-parent-recid NO-LOCK NO-ERROR.
         IF AVAILABLE temp-parent THEN DO:
            curr-rec = ROWID(temp-parent).
            {&OPEN-QUERY-BROWSE-PAR}        
            REPOSITION BROWSE-PAR TO ROWID curr-rec.
         END.
      END.
   END.
     
END PROCEDURE.



PROCEDURE Fill_Parent_Record:

    fnBrowse = BROWSE BROWSE-PAR:HANDLE. 
    fnQuery  = fnBrowse:QUERY.
    fnBuffer = fnQuery:GET-BUFFER-HANDLE(1). 
    
    DO fnintSub = 1 TO fnBrowse:NUM-SELECTED-ROWS:
           fnBrowse:FETCH-SELECTED-ROW(fnintSub).
           fnField  = fnBuffer:BUFFER-FIELD( "ptb" ).
	       fnField1 = fnBuffer:BUFFER-FIELD( "pidx" ).
	       fnField2 = fnBuffer:BUFFER-FIELD( "prec" ).
    END.
  ASSIGN Par_Idx = fnField1:BUFFER-VALUE.
  EMPTY TEMP-TABLE temp-parent1.
 
  FIND FIRST _file WHERE _file._file-name = TRIM(fnField:BUFFER-VALUE) AND DICTDB._File._Db-Recid = DbRecid NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = fnField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  fnField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.
      CREATE temp-parent1.
      ASSIGN            temp-parent1.idxn = DICTDB._FIELD._Field-name 
                        temp-parent1.ctyp = DICTDB._FIELD._Data-Type
		                temp-parent1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER").

  END.
    {&OPEN-QUERY-BROWSE-PAR1} 

END PROCEDURE.

PROCEDURE Fill_Child_Index:

EMPTY TEMP-TABLE temp-child.
FOR EACH DICTDB._file where DICTDB._file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._File._Db-Recid = DbRecId:
 file_rec = RECID(DICTDB._file).
           FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND DICTDB._index._wordidx <> 1 NO-LOCK:
             CREATE temp-child.
	         ASSIGN 
	           temp-child.cidx = DICTDB._Index._Index-name
	           temp-child.crec = RECID(DICTDB._index).
	       END.
	        
 END.
  {&OPEN-QUERY-BROWSE-CHILD}
 FIND FIRST  DICTDB._constraint where DICTDB._constraint._con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid 
                                                  NO-LOCK NO-ERROR.
 IF AVAILABLE DICTDB._constraint THEN DO:
   FIND FIRST temp-child WHERE crec = DICTDB._constraint._index-recid NO-LOCK NO-ERROR.
   IF AVAILABLE temp-child THEN DO:
      curr-rec = ROWID(temp-child).
      REPOSITION BROWSE-CHILD TO ROWID curr-rec.
   END.
   ELSE DO:
      CREATE temp-child.
	  ASSIGN 
	    temp-child.cidx = "#" + constr_name 
	    temp-child.crec = 0.  
	    curr-rec = ROWID(temp-child).
	    {&OPEN-QUERY-BROWSE-CHILD}
      REPOSITION BROWSE-CHILD TO ROWID curr-rec.     
   END.
 END.

END PROCEDURE.


PROCEDURE Fill_Child_Info:

    chldBrowse = BROWSE BROWSE-CHILD:HANDLE. 
    chldQuery  = chldBrowse:QUERY.
    chldBuffer = chldQuery:GET-BUFFER-HANDLE(1).

    DO chldintSub = 1 TO chldBrowse:NUM-SELECTED-ROWS:
           chldBrowse:FETCH-SELECTED-ROW(chldintSub).
	       chldField1 = chldBuffer:BUFFER-FIELD( "cidx" ).
	       chldField2 = chldBuffer:BUFFER-FIELD( "crec" ).
    END.

  EMPTY TEMP-TABLE temp-child1.
  IF chldField2:BUFFER-VALUE <> 0
  THEN DO:
  FIND FIRST DICTDB._file WHERE DICTDB._file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign 
    AND DICTDB._File._Db-Recid = DbRecid NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = chldField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
    FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  chldField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.

      CREATE temp-child1.

      ASSIGN            temp-child1.idxn = DICTDB._FIELD._Field-name 
                        temp-child1.ctyp = DICTDB._FIELD._Data-Type
		                temp-child1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER").

    END.
  END.
  ELSE DO:
  FIND FIRST DICTDB._constraint WHERE DICTDB._constraint._con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
      FOR EACH DICTDB._constraint-Keys WHERE DICTDB._constraint-Keys._Con-Recid   = RECID(DICTDB._constraint):
       FIND FIRST DICTDB._field of DICTDB._constraint-Keys NO-LOCK NO-ERROR.
       CREATE temp-child1.

       ASSIGN           temp-child1.idxn = DICTDB._FIELD._Field-name 
                        temp-child1.ctyp = DICTDB._FIELD._Data-Type
		                temp-child1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER").

     END.
  END.
  {&OPEN-QUERY-BROWSE-CHILD1}  
END PROCEDURE.
 
PROCEDURE foreign_save:
    FOR EACH _constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid:
       IF ACTIVE:SCREEN-VALUE IN FRAME frame_foreign = "yes" THEN
        ASSIGN _Con-Active = TRUE.
        ELSE ASSIGN _Con-Active = FALSE.
        ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_foreign.
        ASSIGN _Con-Status = "C".         
    END.  
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modpri.i

Description:   
   This file contains the form for modification of Primary Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/modcons.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-PRIMARY FOR 
      temp SCROLLING.
      
            /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-PRIMARY
  QUERY BROWSE-PRIMARY NO-LOCK DISPLAY
      temp.ind FORMAT "x(16)":U
      temp.pri FORMAT "x(8)":U
      temp.uni FORMAT "x(8)":U
      temp.clu FORMAT "x(8)":U
      temp.man FORMAT "x(10)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR PRIAMRY FRAME  */    
&Scoped-define FRAME-NAME frame_primary 
  
&Scoped-define BROWSE-NAME BROWSE-PRIMARY
&Scoped-define FIELDS-IN-QUERY-BROWSE-PRIMARY temp.pri temp.uni temp.ind temp.clu temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PRIMARY 
&Scoped-define QUERY-STRING-BROWSE-PRIMARY FOR EACH temp NO-LOCK.     
&Scoped-define OPEN-QUERY-BROWSE-PRIMARY OPEN QUERY BROWSE-PRIMARY FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PRIMARY temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PRIMARY temp    

        DEF VAR pintSub AS INTEGER NO-UNDO.
        DEFINE VARIABLE pQuery AS HANDLE.
        DEFINE VARIABLE pBrowse AS HANDLE.
        DEFINE VARIABLE pBuffer AS HANDLE.
        DEFINE VARIABLE pField AS HANDLE.
        DEFINE VARIABLE pField1 AS HANDLE.
        DEFINE VARIABLE pField2 AS HANDLE.
        DEFINE VARIABLE pField3 AS HANDLE.
        DEFINE VARIABLE pField4 AS HANDLE.
        DEFINE VARIABLE pField5 AS HANDLE.
                
        pBrowse = BROWSE BROWSE-PRIMARY:HANDLE. 
        pQuery  = pBrowse:QUERY.
        pBuffer = pQuery:GET-BUFFER-HANDLE(1).

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     Primary AT ROW 8.6 COL 24 WIDGET-ID 42
     Clustered AT ROW 8.6 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600 
 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16  WIDGET-ID 100.
     
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     Primary AT ROW 13 COL 24 WIDGET-ID 42
     Clustered AT ROW 13 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 79 BY 21  WIDGET-ID 100.
    &ENDIF              
                      
 ASSIGN BROWSE-PRIMARY:COLUMN-RESIZABLE IN FRAME frame_primary        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_primary
  DO:  
         RUN primary_save.          
         APPLY "CLOSE":U TO THIS-PROCEDURE.
         RETURN NO-APPLY.      
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_primary
 DO:
          RUN primary_save.
          RUN TEMP1.
          RUN primary.
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
          ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF 
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_primary
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END. 
  
ON VALUE-CHANGED OF BROWSE-PRIMARY IN FRAME frame_primary
  DO:
          RUN fetch_pri.
  END.   

ON ENTRY OF DESC_EDIT2 IN FRAME frame_primary
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
  &ENDIF
END.

PROCEDURE fetch_pri:
     DO pintSub = 1 TO pBrowse:NUM-SELECTED-ROWS : 

        pBrowse:FETCH-SELECTED-ROW(pintSub).

        pField  = pBuffer:BUFFER-FIELD( "ind" ).
        pField1 = pBuffer:BUFFER-FIELD( "pri" ).
        pField2 = pBuffer:BUFFER-FIELD( "clu" ).
        pField3 = pBuffer:BUFFER-FIELD( "uni" ).
        pField4 = pBuffer:BUFFER-FIELD( "man" ).
        pField5 = pBuffer:BUFFER-FIELD( "rec" ).
           
        ASSIGN Selected_Idx = pField:BUFFER-VALUE. 
     END.
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
     ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
     &ENDIF     
     RUN valid_pri.
END.  
PROCEDURE primary :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_primary ~
           ~{&OPEN-QUERY-BROWSE-PRIMARY}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_unique.     
           HIDE FRAME frame_default.     
           HIDE FRAME frame_check.     
           VIEW FRAME frame_primary.
           DISPLAY  name BROWSE-PRIMARY Active Primary Clustered DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_primary.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_primary =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_primary ="yes".
           ASSIGN DESC_EDIT2:SCREEN-VALUE IN FRAME frame_primary = descrip.
           ASSIGN primary:SCREEN-VALUE IN FRAME frame_primary = "yes".   

           IF user_dbtype    NE "MSS" then             
               ENABLE  BROWSE-PRIMARY Active DESC_EDIT2 
                 OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF   
                  WITH FRAME frame_primary.
           ELSE
                ENABLE  BROWSE-PRIMARY DESC_EDIT2 
                 OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF   
                  WITH FRAME frame_primary.
          {&OPEN-BROWSERS-IN-QUERY-frame_primary}
          FIND FIRST DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid NO-LOCK NO-ERROR.
          FOR EACH temp WHERE rec = DICTDB._constraint._index-recid NO-LOCK:
             curr-rec = ROWID(temp).
             REPOSITION BROWSE-PRIMARY TO ROWID curr-rec.
          END.          
          RUN fetch_pri.
END PROCEDURE.

PROCEDURE primary_save:
           FOR EACH _constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid:
             IF ACTIVE:SCREEN-VALUE IN FRAME frame_primary = "yes" THEN
             ASSIGN _Con-Active = TRUE.
             ELSE ASSIGN _Con-Active = FALSE. 
             ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_primary. 
             ASSIGN _Con-Status = "C".                    
           END.  
END PROCEDURE.           

PROCEDURE valid_pri:
        IF pField2:BUFFER-VALUE = "C"
        THEN DO:
           ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_primary ="yes".
           DISABLE Clustered WITH FRAME frame_primary.
        END.
        ELSE DO: 
           ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_primary ="no".
           DISABLE Clustered WITH FRAME frame_primary.
        END.
        IF pField1:BUFFER-VALUE = "I , C"  OR pField1:BUFFER-VALUE = "C"
        THEN ASSIGN Primary:SCREEN-VALUE IN FRAME frame_primary ="yes".
        ELSE ASSIGN Primary:SCREEN-VALUE IN FRAME frame_primary ="no".
        DISABLE Primary WITH FRAME frame_primary.
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: moduni.i

Description:   
   This file contains the form for modification of unique Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/modclus.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-UNIQUE FOR 
      temp SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-UNIQUE
  QUERY BROWSE-UNIQUE NO-LOCK DISPLAY
      temp.ind FORMAT "x(16)":U
      temp.pri FORMAT "x(8)":U
      temp.uni FORMAT "x(8)":U
      temp.clu FORMAT "x(8)":U
      temp.man FORMAT "x(10)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR UNIQUE FRAME  */  
&Scoped-define FRAME-NAME frame_unique 
&Scoped-define BROWSE-NAME BROWSE-UNIQUE
&Scoped-define FIELDS-IN-QUERY-BROWSE-UNIQUE temp.pri temp.uni temp.ind temp.clu temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-UNIQUE 
&Scoped-define QUERY-STRING-BROWSE-UNIQUE FOR EACH temp NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-UNIQUE OPEN QUERY BROWSE-UNIQUE FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-UNIQUE temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-UNIQUE temp
        
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
     
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.   
     &ENDIF                  
                      
 ASSIGN BROWSE-UNIQUE:COLUMN-RESIZABLE IN FRAME frame_unique        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_unique
  DO: 
          RUN unique_save.
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.         
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_unique
 DO:
          RUN unique_save.
          RUN TEMP1.
          RUN unique.
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
          ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF 
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_unique
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_unique
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="". 
  &ENDIF
END.

PROCEDURE unique :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_unique ~
           ~{&OPEN-QUERY-BROWSE-UNIQUE}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary.  
           HIDE FRAME frame_default.  
           HIDE FRAME frame_check.  
           VIEW FRAME frame_unique.
           DISPLAY name BROWSE-UNIQUE Active DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                    WITH FRAME frame_unique.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_unique =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_unique ="yes".
           ASSIGN DESC_EDIT2:SCREEN-VALUE IN FRAME frame_unique = descrip.

           IF user_dbtype    NE "MSS" then  
              ENABLE BROWSE-UNIQUE Active DESC_EDIT2 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                  WITH FRAME frame_unique.
           ELSE
               ENABLE BROWSE-UNIQUE DESC_EDIT2 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                  WITH FRAME frame_unique.

            {&OPEN-BROWSERS-IN-QUERY-frame_unique}
        FIND FIRST  DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid NO-LOCK NO-ERROR.
        FOR EACH temp WHERE rec = DICTDB._constraint._index-recid NO-LOCK:
           curr-rec = ROWID(temp).
           REPOSITION BROWSE-UNIQUE TO ROWID curr-rec.
        END.  
END PROCEDURE.

PROCEDURE unique_save:
           
           FOR EACH DICTDB._constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid =DbRecid:
             IF ACTIVE:SCREEN-VALUE IN FRAME frame_unique = "yes" THEN
             ASSIGN _Con-Active = TRUE.
             ELSE ASSIGN _Con-Active = FALSE. 
             ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_unique. 
             ASSIGN _Con-Status = "C".                    
           END.  
END.          
          
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: primary.i

Description:   
   This file contains the form for Primary Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/constraint.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-PRIMARY FOR 
      temp SCROLLING.
      
            /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-PRIMARY
  QUERY BROWSE-PRIMARY NO-LOCK DISPLAY
      temp.ind FORMAT "x(16)":U
      temp.pri FORMAT "x(8)":U
      temp.uni FORMAT "x(8)":U
      temp.clu FORMAT "x(8)":U
      temp.man FORMAT "x(10)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR PRIAMRY FRAME  */    
&Scoped-define FRAME-NAME frame_primary 
  
&Scoped-define BROWSE-NAME BROWSE-PRIMARY
&Scoped-define FIELDS-IN-QUERY-BROWSE-PRIMARY temp.pri temp.uni temp.ind temp.clu temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PRIMARY 
&Scoped-define QUERY-STRING-BROWSE-PRIMARY FOR EACH temp NO-LOCK.     
&Scoped-define OPEN-QUERY-BROWSE-PRIMARY OPEN QUERY BROWSE-PRIMARY FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PRIMARY temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PRIMARY temp    

        DEF VAR pri_chk_clus AS INTEGER NO-UNDO.
        DEF VAR pintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE pQuery AS HANDLE.
        DEFINE VARIABLE pBrowse AS HANDLE.
        DEFINE VARIABLE pBuffer AS HANDLE.
        DEFINE VARIABLE pField AS HANDLE.
        DEFINE VARIABLE pField1 AS HANDLE.
        DEFINE VARIABLE pField2 AS HANDLE.
        DEFINE VARIABLE pField3 AS HANDLE.
        DEFINE VARIABLE pField4 AS HANDLE.
        DEFINE VARIABLE pField5 AS HANDLE.
                
        pBrowse = BROWSE BROWSE-PRIMARY:HANDLE. 
        pQuery  = pBrowse:QUERY.
        pBuffer = pQuery:GET-BUFFER-HANDLE(1).
  
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     Primary AT ROW 8.6 COL 24 WIDGET-ID 42
     Clustered AT ROW 8.6 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16  WIDGET-ID 100.
     
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     Primary AT ROW 13 COL 24 WIDGET-ID 42
     Clustered AT ROW 13 COL 47 WIDGET-ID 44
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 79 BY 21  WIDGET-ID 100.
    &ENDIF              
 ASSIGN BROWSE-PRIMARY:COLUMN-RESIZABLE IN FRAME frame_primary        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_primary
  DO:     
       ASSIGN is-saved = FALSE.
       RUN check_primary_save.
      IF is-saved THEN
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_primary
 DO:
       RUN check_primary_save.
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_primary
  DO:     
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END. 
  
ON VALUE-CHANGED OF BROWSE-PRIMARY IN FRAME frame_primary
  DO:
      RUN Fetch_Primary_Name.
      RUN primary_validate.
  END.   

ON ENTRY OF name IN FRAME frame_primary
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_primary
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
  &ENDIF
END.
 
PROCEDURE Fetch_Primary_Name:
 
  DO pintSub = 1 TO pBrowse:NUM-SELECTED-ROWS : 
     
     
           pBrowse:FETCH-SELECTED-ROW(pintSub).

           pField  = pBuffer:BUFFER-FIELD( "ind" ).
           pField1 = pBuffer:BUFFER-FIELD( "pri" ).
           pField2 = pBuffer:BUFFER-FIELD( "clu" ).
           pField3 = pBuffer:BUFFER-FIELD( "uni" ).
           pField4 = pBuffer:BUFFER-FIELD( "man" ).
           pField5 = pBuffer:BUFFER-FIELD( "rec" ).
           
           ASSIGN Selected_Idx = pField:BUFFER-VALUE.
  
  END.
run Create_Const_Name.
END PROCEDURE.

PROCEDURE primary :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_primary ~
           ~{&OPEN-QUERY-BROWSE-PRIMARY}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_unique.     
           HIDE FRAME frame_default.     
           HIDE FRAME frame_check.     
           VIEW FRAME frame_primary.
           DISPLAY  name BROWSE-PRIMARY Active Primary Clustered DESC_EDIT2
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_primary.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_primary ="yes".
           ENABLE  name BROWSE-PRIMARY Active Clustered DESC_EDIT2 
                 OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF
                 WITH FRAME frame_primary.
          {&OPEN-BROWSERS-IN-QUERY-frame_primary}
          
          FIND FIRST temp WHERE clu = "C" NO-LOCK NO-ERROR.
          IF AVAILABLE (temp) 
          THEN DO:
            DISABLE Clustered WITH FRAME frame_primary.
            ASSIGN pri_chk_clus = 0.
          END.
          ELSE ASSIGN pri_chk_clus = 1.
          
          RUN Fetch_Primary_Name.
          RUN primary_validate.
END PROCEDURE.

PROCEDURE primary_save:
           num = num + 1.
           CREATE DICTDB._Constraint.
           IF Clustered:SCREEN-VALUE IN FRAME frame_primary = "yes"
           THEN ASSIGN _Con-Type = "PC".
           ELSE ASSIGN _Con-Type = "P".
           ASSIGN   _Con-Name = name:SCREEN-VALUE IN FRAME frame_primary
                    _For-Name = "".
           IF ACTIVE:SCREEN-VALUE IN FRAME frame_primary = "yes" THEN
           ASSIGN _Con-Active = TRUE.
           ELSE _Con-Active = FALSE.
           ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_primary
               _File-recid = file_rec
               _Con-Status = "N"
               _Index-recid = pField5:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
         RUN TEMP1.
         RUN primary.
         &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
         ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="Constraint Created". &ENDIF  
     ASSIGN is-saved = TRUE.     
END PROCEDURE.           

PROCEDURE primary_validate:
           
           IF pri_chk_clus = 0 
           THEN DO:
              IF pField2:BUFFER-VALUE = "C" 
              THEN DO:
                 ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_primary ="yes".
                 DISABLE Clustered WITH FRAME frame_primary.
              END.
              ELSE DO: 
                  ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_primary ="no".
                  DISABLE Clustered WITH FRAME frame_primary.
              END.
           END.           
           ELSE  DO:
                 ENABLE Clustered WITH FRAME frame_primary.
                 ASSIGN Clustered:SCREEN-VALUE IN FRAME frame_primary ="yes".
           END.
           
        IF pField1:BUFFER-VALUE = "I , C"  OR pField1:BUFFER-VALUE = "C"
        THEN ASSIGN Primary:SCREEN-VALUE IN FRAME frame_primary ="yes".
        ELSE ASSIGN Primary:SCREEN-VALUE IN FRAME frame_primary ="no".
        DISABLE Primary WITH FRAME frame_primary.
END PROCEDURE.

PROCEDURE check_primary_save:
         
    IF trim(temp.man) <> "I"  OR index(trim(temp.uni),"I") = 0 THEN
      MESSAGE "All columns of the Index should be Mandatory and Only Unique indexes are eligible candidates." VIEW-AS ALERT-BOX ERROR. 
    ELSE DO: 
    FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._File-Recid = file_rec
         AND (DICTDB._Constraint._Con-Type = "P"  OR DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" )
         AND Dictdb._constraint._Con-Status <> "D"  AND DICTDB._Constraint._Con-Status <> "O" NO-LOCK NO-ERROR.
         IF AVAILABLE (DICTDB._Constraint)THEN 
         DO:
               MESSAGE "Primary constraint already exists in this table" VIEW-AS ALERT-BOX ERROR.
         END.               
         ELSE DO:
           IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_primary 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
           THEN DO:         
            IF pField3:BUFFER-VALUE = "I , C" OR pField3:BUFFER-VALUE = "C" THEN DO:
                MESSAGE "Unique constraint already exists on this Index, Primary constraint cannot be" SKIP
                     "created on the same Index" VIEW-AS ALERT-BOX ERROR.
            END.
            ELSE DO:
             IF pField2:BUFFER-VALUE = "C" THEN DO:
             MESSAGE "As you are trying to create a Primary constraint on an existing Clustered constraint," SKIP
                     "the clustered constraint will be deleted and a new Primary Clustered constraint" SKIP
                     "will be created, do you want to proceed ?"VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
               IF ans = YES THEN DO:
                   FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-recid = pField5:BUFFER-VALUE  AND 
                   DICTDB._Constraint._Con-Type = "M" EXCLUSIVE-LOCK NO-ERROR.
                   IF AVAILABLE DICTDB._Constraint THEN DELETE DICTDB._Constraint. 
                   RUN primary_save.
               END.
             END.
             ELSE RUN primary_save.       
            END.
           END. 
           ELSE  MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR. 
         END.          
   END.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: unique.i

Description:   
   This file contains the form for unique Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/mss/key/clust.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-UNIQUE FOR 
      temp SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-UNIQUE
  QUERY BROWSE-UNIQUE NO-LOCK DISPLAY
      temp.ind FORMAT "x(16)":U
      temp.pri FORMAT "x(8)":U
      temp.uni FORMAT "x(8)":U
      temp.clu FORMAT "x(8)":U
      temp.man FORMAT "x(10)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR UNIQUE FRAME  */  
&Scoped-define FRAME-NAME frame_unique 
&Scoped-define BROWSE-NAME BROWSE-UNIQUE
&Scoped-define FIELDS-IN-QUERY-BROWSE-UNIQUE temp.pri temp.uni temp.ind temp.clu temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-UNIQUE 
&Scoped-define QUERY-STRING-BROWSE-UNIQUE FOR EACH temp NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-UNIQUE OPEN QUERY BROWSE-UNIQUE FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-UNIQUE temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-UNIQUE temp
        
        DEF VAR uintSub AS INTEGER NO-UNDO.
        DEF VAR irec AS INTEGER   NO-UNDO.

        DEFINE VARIABLE uQuery AS HANDLE.
        DEFINE VARIABLE uBrowse AS HANDLE.
        DEFINE VARIABLE uBuffer AS HANDLE.
        DEFINE VARIABLE uField AS HANDLE.
        DEFINE VARIABLE uField1 AS HANDLE.
        DEFINE VARIABLE uField2 AS HANDLE.
        DEFINE VARIABLE uField3 AS HANDLE.
        DEFINE VARIABLE uField4 AS HANDLE.
        DEFINE VARIABLE uField5 AS HANDLE.
        
        uBrowse = BROWSE BROWSE-UNIQUE:HANDLE. /* Browse-3 is browser name */
        uQuery  = uBrowse:QUERY.
        uBuffer = uQuery:GET-BUFFER-HANDLE(1).    
    
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
     
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.   
     &ENDIF                  
 ASSIGN BROWSE-UNIQUE:COLUMN-RESIZABLE IN FRAME frame_unique        = TRUE.         
 

ON CHOOSE OF OK_BUT IN FRAME frame_unique
  DO: 
          ASSIGN is-saved = FALSE.
          RUN unique_save.
     IF is-saved THEN
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.         
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_unique
 DO:
          RUN unique_save. 
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_unique
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.
    
  ON VALUE-CHANGED OF BROWSE-UNIQUE IN FRAME frame_unique
  DO:
      
      RUN unique_validate.
      RUN Fetch_Unique_Name.
  END. 

ON ENTRY OF name IN FRAME frame_unique
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_unique
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="". 
  &ENDIF
END.

PROCEDURE Fetch_Unique_Name:
 
  DO uintSub = 1 TO uBrowse:NUM-SELECTED-ROWS : 
     
     
           uBrowse:FETCH-SELECTED-ROW(uintSub).

           uField  = uBuffer:BUFFER-FIELD( "ind" ).
           uField1 = uBuffer:BUFFER-FIELD( "pri" ).
           uField2 = uBuffer:BUFFER-FIELD( "clu" ).
           uField3 = uBuffer:BUFFER-FIELD( "uni" ).
           uField4 = uBuffer:BUFFER-FIELD( "man" ).
           uField5 = uBuffer:BUFFER-FIELD( "rec" ).
           
           ASSIGN Selected_Idx = uField:BUFFER-VALUE.
  
  END.
run Create_Const_Name.
END PROCEDURE.  

PROCEDURE unique :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_unique ~
           ~{&OPEN-QUERY-BROWSE-UNIQUE}
           
           HIDE FRAME frame_clustered.
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary.  
           HIDE FRAME frame_default.  
           HIDE FRAME frame_check.  
           VIEW FRAME frame_unique.
           DISPLAY name BROWSE-UNIQUE Active DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                    WITH FRAME frame_unique.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_unique ="yes".
           ENABLE name BROWSE-UNIQUE Active DESC_EDIT2 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                  WITH FRAME frame_unique.
            {&OPEN-BROWSERS-IN-QUERY-frame_unique}
           
           RUN Fetch_Unique_Name.           
           RUN unique_validate.
END PROCEDURE.

PROCEDURE unique_save:
 IF index(trim(temp.uni),"I") = 0 THEN
    MESSAGE "Only Unique indexes are eligible candidates." VIEW-AS ALERT-BOX ERROR.
 ELSE DO:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_unique 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:          
          num = num + 1.
          CREATE DICTDB._Constraint.
          ASSIGN _Con-Type = "U"
               _Con-Name = name:SCREEN-VALUE IN FRAME frame_unique
               _For-Name = "".
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_unique = "yes"
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_unique
               _File-recid = file_rec
               _Con-Status = "N"
               _Index-recid = uField5:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
       RUN TEMP1.
       RUN unique.    
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="Constraint Created".  &ENDIF  
     ASSIGN is-saved = TRUE.              
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.                 
  END.
END.          
          
PROCEDURE unique_validate:
         
    FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = uField5:BUFFER-VALUE AND(DICTDB._Constraint._con-type = "U" OR
         DICTDB._Constraint._con-type = "P" OR DICTDB._Constraint._con-type = "PC" OR DICTDB._Constraint._con-type = "MP")
         AND (DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O") AND DICTDB._constraint._Db-Recid = DbRecid
    NO-LOCK NO-ERROR.
    IF AVAILABLE (DICTDB._Constraint) 
    THEN DO:
       DISABLE OK_BUT WITH FRAME frame_unique.
       DISABLE CREATE_BUT WITH FRAME frame_unique.
    END.   
    ELSE
       ENABLE  OK_BUT CREATE_BUT WITH FRAME frame_unique.
END.         
          
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: viewmnt.i

Description:   
   This file contains variables for View Maintain Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/admnhlp.i }

Define {1} shared variable c_table_name   as character NO-UNDO.
Define {1} shared variable constr_name  as character NO-UNDO.
Define {1} shared variable DbRecId      as recid    NO-UNDO.       
Define {1} shared variable cDbType          as char NO-UNDO./*********************************************************************
* Copyright (C)	2013 by	Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions	     *
* contributed by participants of Possenet.			     *
*								     *
*********************************************************************/

/*
Created:   sdash   27/02/2013	schpullmss is the Batch	PULL Utility which
			      pulls to Progress	database via MS	SQL Server.
*/

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/user/uservar.i NEW}
{ prodict/dictvar.i NEW}
{ prodict/mss/mssvar.i NEW}
DEFINE VARIABLE	input-db       AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	olddb	       AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	batch_mode    AS LOGICAL INITIAL NO	  NO-UNDO.
DEFINE VARIABLE	err-rtn	      AS LOGICAL INITIAL FALSE	  NO-UNDO.
DEFINE VARIABLE	db_exist      AS LOGICAL		  NO-UNDO.
DEFINE VARIABLE	wait	      AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	tmp_str	      AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	msg_prefix    AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	msg_suffix    AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	mss_prefix    AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	dlc_utf_edb   AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	i	      AS INTEGER		  NO-UNDO.
DEFINE VARIABLE	md1_conparms  AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	casesen	      AS LOGICAL		  NO-UNDO.
DEFINE VARIABLE	output_file   AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	redo	      AS LOGICAL		  NO-UNDO.
DEFINE VARIABLE	old-dictdb    AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	createdb      AS CHARACTER		  NO-UNDO.
DEFINE VARIABLE	connection_string      AS CHARACTER	  NO-UNDO.
DEFINE VARIABLE	wrg-ver	      AS LOGICAL INITIAL FALSE	  NO-UNDO.
DEFINE VARIABLE	redoblk	      AS LOGICAL INITIAL FALSE	  NO-UNDO.

output_file= "schpullmss.log".
OUTPUT STREAM logfile TO VALUE(output_file) NO-ECHO NO-MAP UNBUFFERED.
logfile_open = true. 

batch_mode = SESSION:BATCH-MODE.
										
FORM
osh_dbname   FORMAT "x(256)"  view-as fill-in size 32 by 1
    LABEL "Name	of Schema Holder Database" colon 36 SKIP ({&VM_WID}) 
osh_conparms FORMAT "x(256)" view-as fill-in size 32 by	1 
    LABEL "Conn	Params for schema holder" colon	36 SKIP	({&VM_WID})
mss_pdbname  FORMAT "x(32)" VIEW-AS FILL-IN SIZE 32 BY 1	
    LABEL "Logical Database Name" COLON	36 SKIP({&VM_WID}) 
mss_dbname   FORMAT "x(32)"  view-as fill-in size 32 by	1 
    LABEL "ODBC	Data Source Name" colon	36 SKIP	({&VM_WID}) 
mss_username  FORMAT "x(32)" VIEW-AS FILL-IN SIZE 32 BY	1	
    LABEL "Username" COLON 36 SKIP({&VM_WID}) 
mss_password   FORMAT "x(32)" PASSWORD-FIELD view-as fill-in size 32 by	1 
    LABEL "User's Password" colon 36 SKIP ({&VM_WID}) 
mss_conparms FORMAT "x(256)" view-as fill-in size 32 by	1 
    LABEL "Conn	Params for logical database" colon 36 SKIP ({&VM_WID})
mss_codepage FORMAT "x(32)" view-as fill-in size 15 by 1
    LABEL "Codepage" colon 36 SKIP({&VM_WID})
mss_collname FORMAT "x(32)"  view-as fill-in size 15 by	1
    LABEL "Collation"  COLON 36	SKIP({&VM_WID})	 
mss_incasesen  LABEL "Insensitive" COLON 36 SKIP({&VM_WID})
    {prodict/user/userbtns.i}
WITH FRAME x ROW 1 CENTERED SIDE-labels	OVERLAY
  DEFAULT-BUTTON btn_OK	CANCEL-BUTTON btn_Cancel
   &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN VIEW-AS DIALOG-BOX 
   &ENDIF 
   TITLE "{&PRO_DISPLAY_NAME} MS SQL Server Schema Pull".

FORM
  wait FORMAT "x" LABEL
  "Connecting -	Please wait"
  WITH FRAME table-wait	ROW SCREEN-LINES - 2 COLUMN 1 NO-BOX OVERLAY
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN	VIEW-AS	DIALOG-BOX &ENDIF.

ON WINDOW-CLOSE	of FRAME x
   APPLY "END-ERROR" to	FRAME x.

/*  TBD:NEW HELP ID FOR	THIS SCREEN  */
&IF "{&WINDOW-SYSTEM}"<> "TTY" &THEN   
on CHOOSE of btn_Help in frame x
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
			     INPUT {&PROGRESS_DB_to_SQL_Dlg_Box},
			     INPUT ?).
&ENDIF

IF LDBNAME ("DICTDB") <> ? THEN
  ASSIGN osh_dbname = LDBNAME ("DICTDB").

IF LDBNAME ("DICTDBG") <> ? THEN
  ASSIGN mss_pdbname = LDBNAME ("DICTDBG").

IF NOT batch_mode THEN DO:
   {adecomm/okrun.i  
       &FRAME  = "FRAME	x" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
   }
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME x = yes.
  &ENDIF
END.

 IF OS-GETENV("SHDBNAME") <> ? THEN
  osh_dbname   = OS-GETENV("SHDBNAME").

 IF OS-GETENV("SHCONPARMS")   <> ? THEN
  osh_conparms = OS-GETENV("SHCONPARMS").
  ELSE
  ASSIGN osh_conparms = "<schema holder	of current working database>".

  IF OS-GETENV("MSSPDBNAME")   <> ? THEN
  mss_pdbname =	OS-GETENV("MSSPDBNAME").

 IF OS-GETENV("MSSDBNAME")   <>	? THEN
  mss_dbname   = OS-GETENV("MSSDBNAME").

 IF OS-GETENV("MSSUSERNAME") <>	? THEN
  mss_username = OS-GETENV("MSSUSERNAME").

 IF OS-GETENV("MSSPASSWORD") <>	? THEN
  mss_password = OS-GETENV("MSSPASSWORD").

 IF OS-GETENV("MSSCONPARMS") <>	? THEN
  mss_conparms = OS-GETENV("MSSCONPARMS").
 ELSE
  mss_conparms = "<current working database>".

 IF OS-GETENV("MSSCODEPAGE") <>	? THEN 
  mss_codepage = OS-GETENV("MSSCODEPAGE").
 ELSE
  ASSIGN mss_codepage =	session:cpinternal.

 IF OS-GETENV("MSSCOLLNAME") <>	? THEN 
     mss_collname = OS-GETENV("MSSCOLLNAME").
ELSE
     ASSIGN mss_collname = session:CPCOLL.

 IF OS-GETENV("MSSCASESEN") <> ? THEN DO:
     ASSIGN tmp_str = OS-GETENV("MSSCASESEN").
  IF tmp_str BEGINS "Y"	THEN 
     ASSIGN mss_incasesen = FALSE.
  ELSE
     ASSIGN mss_incasesen = TRUE.
END.
 ELSE
     ASSIGN mss_incasesen = TRUE.

/* Make assignments now that use of DICTDB/DICTDBG have	been validated */
IF LDBNAME ("DICTDBG") <> ? THEN DO:
   IF NOT batch_mode THEN DO:
	 &IF "{&WINDOW-SYSTEM}"	= "TTY"	&THEN 
	   ASSIGN mss_pdbname =	LDBNAME("DICTDBG")
		  mss_conparms = "<current working database>"
		  mss_dbname = PDBNAME("DICTDBG")
		  mss_username = ""
		  mss_password = ""
		  osh_dbname = SDBNAME("DICTDBG")
		  osh_conparms = "<schema holder of current working database>".
	 &ENDIF.
    END.
 END.

/* If this is not batch	mode, allow override of	environment variables. */
IF NOT batch_mode THEN DO:
  _updtvar:
  DO WHILE TRUE:
     UPDATE osh_dbname
	osh_conparms
	mss_pdbname
	mss_dbname
	mss_username
	mss_password
	mss_conparms
	mss_codepage
	mss_collname
	mss_incasesen
	btn_OK btn_Cancel 
	&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
	    btn_Help
	&ENDIF
	WITH FRAME x.
    IF osh_dbname = "" OR osh_dbname = ? THEN DO:
	MESSAGE "Schema holder database Name is required." VIEW-AS ALERT-BOX ERROR.
	NEXT _updtvar.
      END.
    IF mss_pdbname = "" OR mss_pdbname = ? THEN DO:
	MESSAGE "Logical Database Name is required." VIEW-AS ALERT-BOX ERROR.
	NEXT _updtvar.
      END.
    IF mss_dbname = "" OR mss_dbname = ? THEN DO:
	MESSAGE "ODBC Data Source Name is required." VIEW-AS ALERT-BOX ERROR.
	NEXT _updtvar.
      END.
    LEAVE _updtvar.
  END.
END.

 ASSIGN input-db = osh_dbname.

/*If no env. var set for logical database*/
IF mss_pdbname = "" OR mss_pdbname = ? THEN DO:
    IF LDBNAME("DICTDBG") <> ? THEN DO:
	
	/* Connected logical db must be MSS database type */ 
	IF DBTYPE("DICTDBG") <> "MSS" THEN DO:
	   IF batch_mode THEN
	     PUT STREAM logfile UNFORMATTED "Database type for Logical Database " mss_pdbname " is not MSS." skip(1).
	   ELSE DO:
	         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	              PUT STREAM logfile UNFORMATTED "Database type for Logical Database" mss_pdbname "is not MSS." skip(1).
	         &ELSE
	              MESSAGE "Database type for Logical Database " mss_pdbname "is not MSS." VIEW-AS ALERT-BOX ERROR.
	         &ENDIF.
	   END.
	   UNDO, RETURN error.
	END.
	
	/* set message prefix if there are missing parameters */
	msg_prefix = "Missing Prameter". 
	IF osh_dbname <> "" AND osh_dbname <> ? THEN 
	    msg_suffix = "Schema Holder Database Name.".
	
	IF osh_conparms <> "" AND osh_conparms <> ? THEN DO:
	    IF msg_prefix <> ? THEN msg_prefix = msg_prefix + ", ".
	    mss_prefix = msg_prefix + "Schema Holder Connection	Parameters.".
	END.
	
	IF mss_conparms <> "" AND mss_conparms <> ? THEN DO:
	    IF msg_prefix <> ? THEN msg_prefix = msg_prefix + ", ".
	    mss_prefix = msg_prefix + "Logical Database Connection Parameters.".
	END.
	
	IF mss_username	<> "" AND mss_username <> ? THEN DO:
	    IF msg_prefix <> ? THEN msg_prefix = msg_prefix + ", ".
	    mss_prefix = msg_prefix + "Foreign database user name.".
	END.
	
	IF mss_password	<> "" AND mss_password <> ? THEN DO:
	    IF msg_prefix <> ? THEN msg_prefix = msg_prefix + ", ".
	    mss_prefix = msg_prefix + "Foreign database password.".
	END.
	
	IF mss_dbname <> "" AND mss_dbname <> ? THEN DO:
	    IF msg_prefix <> ? THEN msg_prefix = msg_prefix + ", ".
	    mss_prefix = msg_prefix + "ODBC Data Source Name.".
	END.

	IF batch_mode THEN
	     PUT STREAM logfile UNFORMATTED msg_prefix + ": should not be set without specifying a logical database name." SKIP(1).
	ELSE DO:
	     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	         MESSAGE msg_prefix + ": should not be set without specifying a logical database name." SKIP(1).
	     &ELSE
	         MESSAGE msg_prefix + ": should not be set without specifying a logical database name." VIEW-AS ALERT-BOX ERROR.
	     &ENDIF.
	END.
        UNDO, RETURN error.
   END.
   ELSE DO:
	IF batch_mode THEN
	     PUT STREAM logfile UNFORMATTED "Logical database name must be specified if logical database is not the current working database." skip(1).
	ELSE DO:
	     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	       MESSAGE "Logical database name must be specified if logical database is not the current working database." skip(1).
	     &ELSE
	       MESSAGE "Logical database name must be specified if logical database is not the current working database." VIEW-AS ALERT-BOX ERROR.
	     &ENDIF.
	END.
        UNDO, RETURN error.
   END.
END.

/* If no env. var. set for schema holder database */
IF osh_dbname = "" OR osh_dbname = ? THEN DO:
    IF LDBNAME("DICTDB") <> ? THEN DO:
      IF osh_conparms <> "" AND osh_conparms <> ? THEN DO:
	/* Accept DICTDB only if no connect parameters are specified */ 
	IF batch_mode THEN
	      PUT STREAM logfile UNFORMATTED "Schema holder connection parameters should not be set without specifying a schema holder database name." skip(1).
	ELSE DO:
	    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
	      PUT STREAM logfile UNFORMATTED "Schema holder connection parameters should not be set without specifying a schema holder database name." skip(1).
	    &ELSE
	      MESSAGE "Schema holder connection parameters should not be set without specifying a schema holder database name." VIEW-AS ALERT-BOX ERROR.
	    &ENDIF.
	END.
	UNDO, RETURN error.
      END.
    END.
    ELSE DO:
        /*Must have a specified schema holder database name without a DICTDB*/
        IF batch_mode THEN
             PUT STREAM logfile UNFORMATTED "Schema holder database name must be specified if there is no current working database." skip(1).
        ELSE DO:
	   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
	     PUT STREAM logfile UNFORMATTED "Schema holder database name must be specified if there is no current working database." skip(1).
	   &ELSE
	     MESSAGE "Schema holder database name must be specified if there is no current working database." VIEW-AS ALERT-BOX ERROR.
	   &ENDIF.
        END.
        UNDO, RETURN error.
    END.
END.

/* At this point there is no connected schema holder nor can one be chosen from connected dbs */
 IF LDBNAME("DICTDB") = ? THEN DO:
   /* If there are no connected dbs, A schema holder must be specified */
   IF osh_dbname = "" OR osh_dbname = ? THEN DO:
	IF batch_mode THEN
	     PUT STREAM logfile UNFORMATTED "Schema holder datbabase must be specified if no existing connections can be used for it" skip(1).
	ELSE DO:
	   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
	     MESSAGE "Schema holder database must be specified if no existing connections can be used for it" skip(1).
	   &ELSE
	     MESSAGE "Schema holder database must be specified if no existing connections can be used for it" VIEW-AS ALERT-BOX ERROR.
	   &ENDIF.
	END.
	UNDO, RETURN error.
   END.
   ELSE DO:  /* If schema holder if specified, search if there is a database with the specified name */
      /* If name has no .db suffix, add it. Needed for search to work correctly.*/
      IF LENGTH(osh_dbname) < 3 THEN 
          osh_dbname = osh_dbname + ".db".
      ELSE IF SUBSTRING(osh_dbname, LENGTH(osh_dbname) - 2) = ".db" THEN
          osh_dbname = osh_dbname + ".db".
      ELSE 
          osh_dbname = osh_dbname + ".db".

      /* If the database does not exist, create it */
      IF SEARCH(osh_dbname) = ? THEN DO:
      /* Need to define a "dlc_utf_edg" AS CHARACTER */
          IF (TRIM(mss_codepage) = "utf-8") THEN DO:
              IF OPSYS = "Win32":U THEN 
                 GET-KEY-VALUE SECTION "Startup":U KEY "DLC":U VALUE dlc_utf_edb. 
                 IF (dlc_utf_edb = ? or dlc_utf_edb EQ "") THEN 
                    dlc_utf_edb = OS-GETENV("DLC").
                 dlc_utf_edb = dlc_utf_edb + "/prolang/utf/empty".
                 CREATE DATABASE osh_dbname FROM dlc_utf_edb.
                 osh_dbname = input-db.
                 PUT STREAM logfile UNFORMATTED osh_dbname " is the empty UTF-8 type schema holder database created." skip(1).
           END.
           ELSE DO:
               CREATE DATABASE osh_dbname FROM "empty".
               osh_dbname = input-db.
               PUT STREAM logfile UNFORMATTED osh_dbname " is the empty schema holder database created." skip(1).
           END.
      END.
      ELSE
         osh_dbname = input-db.
   END.
END.

/* At this point, if osh_dbname is still empty, its an error */
 IF osh_dbname = "" OR osh_dbname = ? THEN DO:
      PUT STREAM logfile UNFORMATTED SKIP.
      ASSIGN err-rtn = TRUE.
      IF batch_mode THEN
            PUT STREAM logfile UNFORMATTED "Schema holder Database Name is required."skip(1).
      ELSE DO:
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            MESSAGE "Schema holder Database Name is required." skip(1).
         &ELSE
            MESSAGE "Schema holder Database Name is required." VIEW-AS ALERT-BOX ERROR.
         &ENDIF
      END.
      UNDO, RETURN error.
 END.

 /* validity check on schema holder */
 IF DBTYPE(osh_dbname) <> "PROGRESS" THEN DO:
    IF "{&WINDOW-SYSTEM}" = "TTY" THEN 
       MESSAGE "Schema holder database " osh_dbname " should be PROGRESS database type, not " DBTYPE(osh_dbname) VIEW-AS ALERT-BOX ERROR.
 END.

/* Name conflict */
IF mss_pdbname = osh_dbname THEN DO:
   IF batch_mode THEN 
      PUT STREAM logfile UNFORMATTED "Logical Database Name " mss_pdbname " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name" skip(1).
   ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
         MESSAGE "Logical Database Name " mss_pdbname " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name" skip(1).
      &ELSE
         MESSAGE "Logical Database name " mss_pdbname " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name" VIEW-AS ALERT-BOX ERROR.
      &ENDIF
   END.
   UNDO, RETURN error.
END.

IF osh_conparms =  "<schema holder of current working database>" THEN
 ASSIGN osh_conparms = "".

IF mss_conparms = "<current working database>" THEN
 ASSIGN mss_conparms = "".

 IF osh_dbname = "" OR osh_dbname = ? THEN DO:
   PUT STREAM logfile UNFORMATTED osh_dbname " Database name is required." SKIP.
   ASSIGN err-rtn = TRUE.
 END.
 ELSE DO:
   IF NOT CONNECTED(osh_dbname) THEN
     CONNECT VALUE (osh_dbname) VALUE (osh_conparms) VALUE (mss_conparms) NO-ERROR.

   IF ERROR-STATUS:ERROR OR NOT CONNECTED (osh_dbname) THEN DO:
     DO i = 1 TO  ERROR-STATUS:NUM-MESSAGES:
         IF batch_mode THEN
           PUT STREAM logfile UNFORMATTED ERROR-STATUS:GET-MESSAGE(i) skip(1).
         ELSE
           MESSAGE ERROR-STATUS:GET-MESSAGE(i) skip(1).
     END.
     IF batch_mode THEN
           PUT STREAM logfile UNFORMATTED "Unable to connect to " osh_dbname "database" skip(1).
     ELSE DO:
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
           MESSAGE "Unable to connect to "osh_dbname "database." skip(1).
         &ELSE
           MESSAGE "Unable to connect to " osh_dbname "database" VIEW-AS ALERT-BOX ERROR.
         &ENDIF
     END.
     ASSIGN err-rtn = TRUE.
   END.
   ELSE 
     CREATE ALIAS DICTDB FOR DATABASE VALUE(osh_dbname) NO-ERROR.
 END.

DISCONNECT VALUE(LDBNAME("DICTDB")).

 IF err-rtn THEN RETURN.
  ASSIGN redo = TRUE.

 RUN prodict/mss/schmsstopro.p.

 IF RETURN-VALUE = "indb" THEN DO:
    ASSIGN redo = FALSE.
    UNDO, RETRY.
 END.
 ELSE IF RETURN-VALUE = "wrg-ver" THEN DO:
    ASSIGN wrg-ver = TRUE.
    UNDO, RETRY.
 END.
 ELSE IF RETURN-VALUE = "undo" THEN DO:
    ASSIGN redoblk = TRUE.
    UNDO, RETRY.
 END.

IF logfile_open
THEN OUTPUT STREAM logfile CLOSE.
/***********************************************************************
* Copyright (C) 2000,2006,2011,2013 by Progress Software Corporation.  *
* All rights reserved.  Prior versions of this work may contain        *
* portions contributed by participants of Possenet.                    *
*                                                                      *
***********************************************************************/

/*
Created:   sdash   27/02/2013   schpullmss is the Batch PULL Utility which
                              pulls to Progress database via MS SQL Server.
*/

&SCOPED-DEFINE UNICODE-MSG-1 "You have chosen to use Unicode data types but the DataServer schema codepage is not 'utf-8'"
&SCOPED-DEFINE UNICODE-MSG-2 "It is recommended that you set the codepage to utf-8 in this case to avoid data loss!"
&SCOPED-DEFINE UNICODE-MSG-3 "You have chosen to use Unicode data types but the schema holder database codepage is not 'utf-8'"
&SCOPED-DEFINE UNICODE-MSG-4 "You must build your schema holder database with a 'utf-8' code page"

{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i }

DEFINE VARIABLE cmd           AS CHARACTER           NO-UNDO.
DEFINE VARIABLE wait          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE create_h      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE db_exist      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO  NO-UNDO.
DEFINE VARIABLE output_file   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE l_i           AS INTEGER             NO-UNDO.
DEFINE VARIABLE run_time      AS INTEGER             NO-UNDO.
DEFINE VARIABLE schname       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dlc_utf_edb   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE schdbcp       AS CHARACTER           NO-UNDO.
DEFINE STREAM strm.

ASSIGN
     batch_mode    = SESSION:BATCH-MODE
     run_time      = TIME.

ASSIGN loadsql = TRUE.

IF loadsql THEN 
ASSIGN stages[mss_create_sql] = TRUE
         stages[mss_build_schema] = TRUE
         stages[mss_fixup_schema] = TRUE
         stages[mss_create_objects] = TRUE.

ASSIGN create_h = TRUE
       rmvobj   = TRUE.

ASSIGN user_dbname  = mss_dbname
       user_env[1]  = "ALL"
       user_env[2]  = osh_dbname
       user_env[22] = "MSS"
       user_env[26] = mss_username
       user_env[37] = "IP"
       user_env[32] = "MSSQLSRV7".
	
IF loadsql THEN DO:
  /* check if unicode types and non utf-8 codepage and give warning */
  IF unicodeTypes AND TRIM(mss_codepage) NE "utf-8" THEN DO:
     IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED {&UNICODE-MSG-1} SKIP {&UNICODE-MSG-2} SKIP.
     ELSE
        MESSAGE {&UNICODE-MSG-1} SKIP {&UNICODE-MSG-2} VIEW-AS ALERT-BOX INFO BUTTONS OK.
  END.

  IF NOT batch_mode THEN
    HIDE FRAME table-wait NO-PAUSE.
  
  ASSIGN stages_complete[mss_create_sh] = TRUE
         stages[mss_create_objects]     = TRUE.
    
  /* consider for computed columns */
  IF pcompatible AND iRecidOption = 2 THEN
     ASSIGN user_env[32] = "MSSQLSRV9" .

  /* let's set the mss version based on unicodeTypes so _mss_md1 checks the correct version
     for Unicode data types. Do the same for 2008 types (that also checks the driver).
  */
  IF mapMSSDatetime THEN
     ASSIGN user_env[32] = (IF unicodeTypes THEN "MSSQLSRV9" ELSE "MSSQLSRV7").
  ELSE
     ASSIGN user_env[32] = "MSSQLSRV10".

  RUN "prodict/mss/schconnect.p".

  IF RETURN-VALUE = "wrg-ver" THEN
    RETURN "wrg-ver".
  
  ELSE IF RETURN-VALUE = "undo" THEN
    RETURN "undo".

  IF batch_mode and NOT logfile_open THEN DO:
    OUTPUT TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
    logfile_open = true.
  END.

  /* See if we were successful. */

  IF NOT CONNECTED (mss_pdbname) THEN DO:
    cmd = "Error creating MSS Database - Check logfile " + osh_dbname + 
      	  ".log".
    IF NOT Batch_mode THEN
      MESSAGE cmd.
    ELSE
      PUT STREAM logfile UNFORMATTED  cmd.  
    UNDO, RETURN error.
  END.

  ASSIGN cmd = "c" + mss_pdbname + ".p".

  OUTPUT STREAM strm TO VALUE (cmd) NO-MAP.

  PUT STREAM strm UNFORMATTED "CONNECT " osh_dbname " -1." SKIP.

  IF mss_conparms <> ? THEN DO:
    IF INDEX(mss_conparms,"@") <> 0 THEN 
         mss_username = mss_username + mss_conparms. 
  END. 
  
  IF mss_username = "" or mss_username = ? THEN
     PUT STREAM strm UNFORMATTED " CONNECT " mss_dbname " -ld " mss_pdbname
        " -dt MSS" .
  ELSE IF mss_password = "" or mss_password = ? THEN
     PUT STREAM strm UNFORMATTED "CONNECT " mss_dbname " -ld ~"" mss_pdbname
        "~" -dt MSS -U ~"" mss_username "~"".
  ELSE 
     PUT STREAM strm UNFORMATTED "CONNECT " mss_dbname " -ld ~"" mss_pdbname
        "~" -dt MSS -U ~"" mss_username "~" -P ~"" mss_password "~"".
 
  IF mss_conparms <> ? THEN DO:
    IF INDEX(mss_conparms,"@") = 0 THEN 
         PUT STREAM strm UNFORMATTED " " mss_conparms.
  END.

  PUT STREAM strm UNFORMATTED "." SKIP.

  OUTPUT STREAM strm CLOSE.

  IF movedata THEN 
  _mvdt:
  DO:
    IF NOT CONNECTED(mss_pdbname) THEN DO:
      IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED
          "Database" mss_dbname " not connected.  Unable to load data."  SKIP.
       ELSE
         MESSAGE "Database" mss_dbname " NOT connected.  Unable to load data." SKIP
           VIEW-AS ALERT-BOX.
       LEAVE _mvdt.    
    END.        
    IF batch_mode THEN
       PUT STREAM logfile UNFORMATTED
           "-- ++ " skip
           "-- Loading data into the MSS database. " skip
           "-- -- " skip(2).
    ELSE
      DISPLAY  " " SKIP 
               "   Loading data into the MSS Database.  " SKIP(2)
        WITH FRAME ld-dt NO-LABELS THREE-D CENTERED ROW 5 
          TITLE "Moving Data".
    RUN "prodict/mss/_mss_md9.p".

    DISCONNECT VALUE (osh_dbname).
  END.  
end.

PUT STREAM logfile UNFORMATTED
       " "           skip
       "-- ++ "      skip
       "-- Schema Pull Complete in " STRING(TIME - run_time,"HH:MM:SS")  skip
       "-- -- "      skip(2).

IF NOT logfile_open THEN DO:
      OUTPUT STREAM logfile TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
      logfile_open = true.
   END.
   /***********************************************************************
* Copyright (C) 2000,2006,2011,2013 by Progress Software Corporation.  *
* All rights reserved.  Prior versions of this work may contain        *
* portions contributed by participants of Possenet.                    *
*                                                                      *
***********************************************************************/

/*
Created:   sdash   27/02/2013   schpullmss is the Batch PULL Utility which
                              pulls to Progress database via MS SQL Server.
*/

&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i NEW }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE DATASERVER

{ prodict/user/uservar.i }
{ prodict/user/userhue.i NEW }
{ prodict/user/userhdr.f NEW }
{ prodict/mss/mssvar.i }

DEFINE VARIABLE c            AS CHARACTER NO-UNDO.
DEFINE VARIABLE i            AS INTEGER   NO-UNDO.
DEFINE VARIABLE j            AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_debug      AS logical   NO-UNDO INIT FALSE.
DEFINE VARIABLE md1_conparms AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp1        AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp2        AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp3        AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save22 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save25 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save28 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save29 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save5 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save26 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save31 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save36 AS CHARACTER NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.
DEFINE VARIABLE connection_string as CHARACTER NO-UNDO.
DEFINE VARIABLE p_obj_name            AS CHARACTER NO-UNDO.
DEFINE VARIABLE p_obj_owner            AS CHARACTER NO-UNDO.
DEFINE VARIABLE p_qual            AS CHARACTER NO-UNDO.
DEFINE VARIABLE tmp_str1          AS CHARACTER NO-UNDO.
DEFINE VARIABLE ClustAsROWID     AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE OSchema       AS CHARACTER NO-UNDO.
DEFINE VARIABLE FSchema       AS CHARACTER NO-UNDO.

batch_mode = SESSION:BATCH-MODE.

IF OS-GETENV("MSSOBJNAME") <> ? THEN
    ASSIGN p_obj_name = OS-GETENV("MSSOBJNAME").

IF OS-GETENV("MSSOBJOWNER") <> ? THEN
    ASSIGN p_obj_owner = OS-GETENV("MSSOBJOWNER").

IF OS-GETENV("MSSOBJQUALIFIER") <> ? THEN
    ASSIGN p_qual = OS-GETENV("MSSOBJQUALIFIER").
 
 IF OS-GETENV("MAPOEDATETIME") <> ? THEN DO:
  tmp_str1 = OS-GETENV("MAPOEDATETIME").
   IF ((tmp_str1 <> ?) AND (tmp_str1 BEGINS "Y")) THEN DO:
   s_datetime = TRUE.
   END.
END.

IF OS-GETENV("MAPTOLOB") <> ? THEN DO:
   tmp_str1 = OS-GETENV("MAPTOLOB").
   IF  (tmp_str1 BEGINS "B") THEN DO:
       s_lob = TRUE.
       s_blobtype = TRUE.
       s_clobtype = FALSE.
   END.
   ELSE IF (tmp_str1 BEGINS "C") THEN DO:
       s_lob = TRUE.
       s_blobtype = FALSE.
       s_clobtype = TRUE.
   END.
   ELSE IF ((tmp_str1 <> "L") OR (tmp_str1 BEGINS "Y")) THEN DO:
       s_lob = TRUE.
       s_blobtype = TRUE.
       s_clobtype = TRUE.
   END.
END.
ELSE DO:
       s_lob = FALSE.
       s_blobtype = FALSE.
       s_clobtype = FALSE.
END.

IF OS-GETENV("MAPTOROWID") <> ? THEN DO:
  tmp_str1 = OS-GETENV("MAPTOROWID").
    IF ((tmp_str1 <> ?) AND (tmp_str1 BEGINS "Y")) THEN DO:
    ASSIGN s_primary = TRUE.
    END.
    ELSE
    ASSIGN s_primary = FALSE.
END.

IF OS-GETENV("GETBESTROWID") <> ? THEN DO:
   tmp_str1 = OS-GETENV("GETBESTROWID").
   IF ((tmp_str1 = "1") OR (tmp_str1 BEGINS "Y")) THEN DO:
       ASSIGN ClustAsROWID = TRUE.
       s_best = 1.
   END.
   ELSE IF (tmp_str1 = "2")  THEN DO:
       ASSIGN ClustAsROWID = TRUE.
       s_best = 2.
   END.
   ELSE DO: 
       ASSIGN ClustAsROWID = FALSE.
   END.
END.

 IF osh_conparms = ""  THEN
      ASSIGN osh_conparms = "<schema holder of current working database>".

 IF mss_conparms = "" THEN
      ASSIGN mss_conparms = "<current working database>".

 IF (s_best = 1 ) THEN 
    ASSIGN OSchema = "yes"
           FSchema = "no".
 ELSE
    ASSIGN OSchema = "no"
          FSchema = "yes".

   PUT STREAM logfile UNFORMATTED
       " " skip
       "MSS to Schema Holder Log" skip(2)
       "Name of Schema Holder Database:         " osh_dbname skip
       "Conn. parameters for schema Holder:     " osh_conparms skip
       "Logical Database Name:                  " mss_pdbname SKIP
       "ODBC Data Source Name:                  " mss_dbname SKIP
       "MSS Username:                           " mss_username skip
       "Conn. parameters for logical DB:        " mss_conparms skip
       "Codepage for Schema Image:              " mss_codepage SKIP
       "Collation Name:                         " mss_collname SKIP
       "Insensitive:                            " mss_incasesen SKIP
       "Object Name:                            " p_obj_name SKIP
       "Object Owner:                           " p_obj_owner SKIP
       "Object Qualifier                        " p_qual SKIP
       "Default to OpenEdge DATETIME            " s_datetime SKIP
       "Default to OpenEdge LOB for:            " s_lob SKIP
       "                              CLOB      " s_clobtype SKIP
       "                              BLOB      " s_blobtype SKIP
       "Dsg. Primary/Clustred index as ROWID:   " s_primary SKIP
       "Select 'Best' ROWID Index Using:        " ClustAsROWID SKIP
       "                         OE Schema      " OSchema SKIP
       "                    Foreign schema      " FSchema SKIP.	

 IF osh_conparms =  "<schema holder of current working database>" THEN
      ASSIGN osh_conparms = "".

 IF mss_conparms = "<current working database>" THEN
      ASSIGN mss_conparms = "".

PROCEDURE connect-schdb:
  IF connection_string = "" OR connection_string = ? THEN 
    CONNECT  VALUE (mss_dbname)
       -dt VALUE (user_dbtype)
       -ld VALUE (mss_pdbname).

  ELSE IF mss_password = "" or mss_password = ? THEN 
    CONNECT  VALUE (mss_dbname)
         -dt VALUE (user_dbtype)
         -ld VALUE (mss_pdbname)
             VALUE (connection_string).
  ELSE 
    CONNECT  VALUE (mss_dbname)
      -dt VALUE (user_dbtype)
      -ld VALUE (mss_pdbname)
          VALUE (connection_string) 
      -P  VALUE (mss_password).

  CREATE ALIAS "DICTDBG" FOR DATABASE VALUE (mss_pdbname) NO-ERROR.
END.

/* connect up the database to work with */
CONNECT VALUE (osh_dbname) VALUE (osh_conparms) VALUE (mss_conparms).
CREATE ALIAS "DICTDB" FOR DATABASE VALUE (osh_dbname).

/* create _db record and load MSS definitions */

RUN prodict/mss/_mss_md2.p.

ASSIGN
user_dbtype = "MSS".
md1_conparms = mss_conparms.

IF md1_conparms = "" OR md1_conparms = ? THEN
  md1_conparms = "-Dsrv PRGRS_PROC_TRAN,1".
ELSE 
  md1_conparms = md1_conparms + " -Dsrv PRGRS_PROC_TRAN,1".

IF md1_conparms <> "" and md1_conparms <> ? THEN DO:
  IF mss_username <> "" AND mss_username <> ? THEN
     ASSIGN connection_string = "-U " + mss_username + " " + md1_conparms.
  ELSE
     ASSIGN connection_string = md1_conparms.
END.        
ELSE DO:
  IF mss_username <> "" AND mss_username <> ? THEN
     connection_string = "-U " + mss_username.
END.     

/* Save the user_env variables we will need later.  _mss_pul.p
     reinitializes user_env 
*/

ASSIGN
    user_env_save22 = user_env[22]
    user_env_save28 = user_env[28]
    user_env_save29 = user_env[29]
    user_env_save5  = user_env[5]
    user_env_save26 = user_env[26]
    user_env_save31 = user_env[31]
    user_env_save36 = user_env[36].

IF not stages[mss_create_objects] THEN RETURN.

/* connect to MSS database */
/* disconnect-connect is to reload schema cache */
DISCONNECT VALUE (osh_dbname).
CONNECT VALUE (osh_dbname) VALUE (osh_conparms) VALUE (mss_conparms).
RUN connect-schdb.
IF PDBNAME("DICTDBG") = ? THEN
  RETURN "undo".

RUN prodict/mss/_mss_sdb.p.

IF RETURN-VALUE = "wrg-ver" THEN DO:
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    ASSIGN user_path = "*N,1=sys,_usrsget".
  &ELSE
    ASSIGN user_path = "*N,1=sys,_guisget".
  &ENDIF   
  RETURN "wrg-ver".
END.

/* Discconnect again so _db updates are available */
DISCONNECT VALUE (osh_dbname).
CONNECT VALUE (osh_dbname) VALUE (osh_conparms) VALUE (mss_conparms).

/* Reconnect the schema holder */
RUN connect-schdb.

RUN "prodict/mss/_sndinfo.p".

IF SESSION:BATCH-MODE and NOT logfile_open THEN DO:
   OUTPUT STREAM logfile TO VALUE(user_env[2] + ".log") 
       APPEND UNBUFFERED NO-ECHO NO-MAP.
   logfile_open = true.
END.

stages_complete[mss_create_objects] = TRUE.
IF not stages[mss_build_schema] THEN RETURN.

IF SESSION:BATCH-MODE AND logfile_open THEN DO:
   PUT STREAM logfile UNFORMATTED
       " " skip 
       "-- ++ " skip
       "-- Getting List of Objects from foreign DB Schema" skip
       "-- -- " skip(2).
    PUT STREAM logfile UNFORMATTED
      "Object Type" at 14
      "Object Owner" at 28
      "Object Name" at 44 skip(1).
   END.
/*
** Create a list of all the appropriate objects we want from
** the MS Sql Server database.
*/

ASSIGN
  s_name-hlp   = "*"
  s_owner-hlp  = "%%%" + mss_username
  s_qual-hlp   = "*"
  s_type-hlp   = "*".

  IF SESSION:BATCH-MODE THEN
    /* Updated 12 Fields in user_env[25] */
             user_env[25] = "AUTO," + p_obj_name + "," + p_obj_owner + "," +  "*," + p_qual + ","
	                                + string(s_datetime) + ","+ string(s_primary) + ","
                                        + string(s_lob) + "," + string(s_blobtype) + "," 
					+ string(s_clobtype) + "," + string(ClustAsROWID) + "," 
					+ string(s_best).
  ELSE
   /* Updated 9 Fields in user_env[25] */
    user_env[25] = p_obj_name + "," + p_obj_owner + "," + p_qual + ","
                    + string(s_datetime) + ","+ string(s_primary) + ","
                    + string(s_lob) + "," + string(s_blobtype) + ","
		    + string(s_clobtype) + "," + string(s_best).  

RUN prodict/mss/_mss_get.p.


/* Create a procedure for pulling constraints */
RUN prodict/mss/procbfrpul.p.

/* Pull objects from MSS.*/
RUN prodict/mss/_mss_pul.p.

IF SESSION:BATCH-MODE AND logfile_open THEN 
   PUT STREAM logfile UNFORMATTED
       " " skip 
       "-- ++ " skip
       "-- Importing Objects into the {&PRO_DISPLAY_NAME} Schema Holder." skip
       "-- -- " skip(2).

/* Create objects in the schema holder to match objects in MSS. */
RUN prodict/gate/_gat_cro.p.

RETURN.
/*********************************************************************
* Copyright (C) 2006-2013 by Progress Software Corporation.          *
* All rights reserved.Prior versions of this work may contain        *
* portions contributed by participants of Possenet.                  *
*                                                                    *
*********************************************************************/

/* Procedure deltasql.p - sdash
   Created 03/13/13 Initial procedure for the MSS Incremental Df Utility
*/

{ prodict/user/uservar.i new }
{ prodict/mss/mssvar.i new }
{ prodict/misc/filesbtn.i new }

DEFINE NEW SHARED VARIABLE select_dbname  AS CHARACTER    NO-UNDO.
DEFINE NEW SHARED VARIABLE dflt_dbname    AS CHARACTER    NO-UNDO.
DEFINE NEW SHARED VARIABLE envshadowcol   AS CHARACTER    NO-UNDO.
DEFINE NEW SHARED VARIABLE scol      AS LOGICAL           NO-UNDO.
DEFINE VARIABLE old_oshdbname   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE old_connparms   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE ientry           AS INTEGER             NO-UNDO.
DEFINE VARIABLE cEntry           AS CHARACTER           NO-UNDO.
DEFINE VARIABLE connParam        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE found-ldb        AS LOGICAL             NO-UNDO.
DEFINE VARIABLE l                AS LOGICAL             NO-UNDO.

DEFINE VARIABLE create_df     AS LOGICAL INITIAL TRUE   NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL FALSE  NO-UNDO. 
DEFINE VARIABLE output_file   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE df-file       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE i             AS INTEGER                NO-UNDO.
DEFINE VARIABLE schdbcon      AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE conparms      AS CHARACTER              NO-UNDO.
DEFINE VARIABLE l_curr-db     AS INTEGER INITIAL 1      NO-UNDO.
DEFINE VARIABLE l_dbnr        AS INTEGER                NO-UNDO.
DEFINE VARIABLE cFormat       AS CHARACTER 
                              INITIAL "For field widths use:"
                              FORMAT "x(21)" NO-UNDO.
DEFINE VARIABLE cRecid        AS CHARACTER 
                              INITIAL "For Create RECID use:"
                              FORMAT "x(22)" NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE s_res         AS LOGICAL                NO-UNDO.
DEFINE VARIABLE hasUniSupport AS LOGICAL                NO-UNDO.
DEFINE VARIABLE has2008Support AS LOGICAL               NO-UNDO.
DEFINE VARIABLE hasCompColSupport AS LOGICAL            NO-UNDO.
DEFINE VARIABLE err-rtn       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE crtdltadf     AS CHARACTER              NO-UNDO.
DEFINE VARIABLE mssdttime     AS CHARACTER              NO-UNDO.
DEFINE VARIABLE seqgen        AS CHARACTER              NO-UNDO.
DEFINE VARIABLE sqlwdth       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE expnd8        AS CHARACTER              NO-UNDO.
DEFINE VARIABLE crtdflt       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE cmptble       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE ucodetypes    AS CHARACTER              NO-UNDO.
DEFINE VARIABLE ucodeexpnd    AS CHARACTER              NO-UNDO.
DEFINE VARIABLE cmptble1      AS LOGICAL                NO-UNDO.
DEFINE VARIABLE cmptble2      AS LOGICAL                NO-UNDO.
DEFINE VARIABLE wdth          AS LOGICAL                NO-UNDO.
DEFINE VARIABLE ablfmt        AS LOGICAL                NO-UNDO.

batch_mode = SESSION:BATCH-MODE.
SESSION:SUPPRESS-WARNINGS = TRUE.

output_file= "deltasqlutil.log".
OUTPUT STREAM logfile TO VALUE(output_file) NO-ECHO NO-MAP UNBUFFERED.
logfile_open = true. 

FORM
  " "   SKIP 
    df-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Delta DF File" colon  15
  btn_File SKIP SKIP({&VM_WIDG})
  osh_dbname   FORMAT "x(256)"  view-as fill-in size 32 by 1 
    LABEL "Schema Holder Database" colon 35 SKIP({&VM_WID}) 
  mss_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
    LABEL "Connect Parameters for Schema" colon 35 SKIP({&VM_WID})
  mss_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Logical Name for MSS Database" colon 35 SKIP({&VM_WID})   
  mss_username    FORMAT "x(32)"  VIEW-AS FILL-IN SIZE 32 BY 1
    LABEL "MSS Object Owner Name" COLON 35 SKIP({&VM_WID})    
  long-length LABEL " Maximum Varchar Length"  COLON 35 SKIP({&VM_WIDG})
  SPACE(3) pcompatible view-as toggle-box LABEL "Create RECID Field"  
  SPACE(10) shadowcol VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" SKIP({&VM_WID})
  SPACE (3) dflt VIEW-AS TOGGLE-BOX LABEL "Include Default" 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(13) &ELSE SPACE (14) &ENDIF
  create_df view-as toggle-box LABEL "Create Schema Holder Delta DF" SKIP({&VM_WID})
  SPACE(3) unicodeTypes view-as toggle-box LABEL "Use Unicode Types " 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(10) &ELSE SPACE (9) &ENDIF
  lUniExpand VIEW-AS TOGGLE-BOX LABEL "Expand Width (utf-8)" SKIP({&VM_WID})
  SPACE (3) mapMSSDatetime VIEW-AS TOGGLE-BOX LABEL "Map to MSS 'Datetime' Type"
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(2) &ELSE SPACE (1) &ENDIF
  newseq   view-as toggle-box label "Use Revised Sequence Generator"
  SKIP({&VM_WID}) SPACE(2) cFormat VIEW-AS TEXT NO-LABEL  
  iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                             "ABL Format", 2
                                 HORIZONTAL NO-LABEL 
  lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30" AT 54 SKIP({&VM_WID})
  SPACE(2) cRecid VIEW-AS TEXT NO-LABEL  
  iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS "Trigger", 1,
                                             "Computed Column", 2
                                 HORIZONTAL NO-LABEL SKIP({&VM_WID})
             {prodict/user/userbtns.i}
  WITH FRAME read-df ROW 2 CENTERED SIDE-labels 
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF
  TITLE "Delta df to MS SQL Server Conversion".
 
/*=============================Triggers===============================*/

/*----- ON GO or OK -----*/
ON GO OF FRAME read-df
DO:
  IF (df-file:SCREEN-VALUE IN FRAME read-df = ? OR
      df-file:SCREEN-VALUE IN FRAME read-df = "") THEN DO:
    MESSAGE "Delta DF File is required. " VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO df-file IN FRAME read-df.
    RETURN NO-APPLY.
  END.

  IF SEARCH(df-file:SCREEN-VALUE IN FRAME read-df) = ? THEN DO:
    MESSAGE "Can not find a file of this name.  Try again." 
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO df-file IN FRAME read-df.
    RETURN NO-APPLY.
  END.
  ELSE
    ASSIGN df-file = df-file:SCREEN-VALUE IN FRAME read-df.

  IF osh_dbname:SCREEN-VALUE IN FRAME read-df = "" OR 
              osh_dbname:SCREEN-VALUE IN FRAME read-df = ? THEN DO:
    MESSAGE "Schema Holder Name is required."  VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO osh_dbname IN FRAME read-df.
    RETURN NO-APPLY. 
  END.
  
  IF mss_username:SCREEN-VALUE IN FRAME read-df = "" OR 
              mss_username:SCREEN-VALUE IN FRAME read-df = ? THEN DO:
    MESSAGE "MSS Object Owner Name is required."  VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO mss_username IN FRAME read-df.
    RETURN NO-APPLY. 
  END.

  REPEAT l_dbnr = 1 to NUM-DBS:
    IF LDBNAME("DICTDB") = LDBNAME(l_dbnr)
     THEN ASSIGN l_curr-db = l_dbnr.
  END.
 
  DO i = 1 TO NUM-DBS:
    IF PDBNAME(i) = osh_dbname:SCREEN-VALUE IN FRAME read-df OR 
       LDBNAME(i) = osh_dbname:SCREEN-VALUE IN FRAME read-df THEN DO:
      ASSIGN schdbcon = TRUE.
      CREATE ALIAS DICTDB FOR DATABASE 
         VALUE(LDBNAME(osh_dbname:SCREEN-VALUE IN FRAME read-df)).
    END.
  END.

  IF NOT schdbcon THEN DO:
   ASSIGN osh_dbname = osh_dbname:SCREEN-VALUE IN FRAME read-df
          mss_dbname = mss_dbname:SCREEN-VALUE IN FRAME read-df.
      CONNECT VALUE(osh_dbname) VALUE(mss_conparms) NO-ERROR.
      RUN prodict/mss/deltaconnect.p.
      IF NOT CONNECTED(LDBNAME(osh_dbname:SCREEN-VALUE IN FRAME read-df)) THEN DO:
        MESSAGE osh_dbname:SCREEN-VALUE IN FRAME read-df
         " can not be connected using entered connect parameters."
        VIEW-AS ALERT-BOX ERROR.
      APPLY "ENTRY" to osh_dbname IN FRAME read-df.
      RETURN NO-APPLY.
     END.
  END.

 IF mss_dbname <> ? THEN DO:
   ASSIGN mss_dbname:SCREEN-VALUE = mss_dbname.
   APPLY "ENTRY" TO mss_dbname IN FRAME read-df.
 END.

  IF mss_dbname:screen-value IN FRAME read-df = ? OR 
     mss_dbname:screen-value IN FRAME read-df = "" THEN DO:
     ASSIGN mss_dbname:SCREEN-VALUE = mss_dbname.
     APPLY "ENTRY" TO mss_dbname IN FRAME read-df.
  END.

END.  /*End of ON GO trigger */

ON CHOOSE OF btn_File in frame read-df DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT df-file:handle in frame read-df /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT "*.df"                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.

     IF shadowcol = TRUE THEN DO:
        ASSIGN shadowcol:CHECKED   = TRUE
               shadowcol:SENSITIVE = TRUE.
         RETURN NO-APPLY.
     END.

ON VALUE-CHANGED OF iFmtOption IN FRAME read-df DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lFormat:CHECKED   = FALSE
           lFormat:SENSITIVE = FALSE.
  ELSE
    ASSIGN lFormat:CHECKED   = TRUE
           lFormat:SENSITIVE = TRUE.
END. 

ON LEAVE OF long-length IN FRAME read-df DO:
  IF (unicodeTypes:SCREEN-VALUE = "no") AND 
        INTEGER(long-length:SCREEN-VALUE) > 8000 THEN DO:  
    MESSAGE "The maximum length for a varchar is 8000" VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.
  ELSE IF unicodeTypes:SCREEN-VALUE = "yes" AND 
       INTEGER(long-length:SCREEN-VALUE) > 4000 THEN DO:  
    MESSAGE "The maximum length for a nvarchar is 4000" VIEW-AS ALERT-BOX ERROR.
    RETURN NO-APPLY.
  END.
END.

ON VALUE-CHANGED OF pcompatible IN FRAME read-df DO:
  IF SELF:SCREEN-VALUE = "no" THEN
     ASSIGN iRecidOption:SCREEN-VALUE = "1"
            iRecidOption:SENSITIVE = FALSE.
  ELSE
     ASSIGN iRecidOption:SCREEN-VALUE = "1"
            iRecidOption:SENSITIVE = TRUE.
END. 

ON VALUE-CHANGED OF unicodeTypes IN FRAME read-df DO:
 IF SELF:screen-value = "no" THEN
     ASSIGN long-length:SCREEN-VALUE = "8000"
            lUniExpand:SCREEN-VALUE = "no"
            lUniExpand:SENSITIVE = NO.
 ELSE
     ASSIGN long-length:SCREEN-VALUE = "4000"
            lUniExpand:SENSITIVE = YES
            s_res = lUniExpand:MOVE-AFTER-TAB-ITEM(unicodeTypes:HANDLE).
END.

ON WINDOW-CLOSE of frame read-df
   apply "END-ERROR" to frame read-df.

ON LEAVE OF df-file in frame read-df
   df-file:screen-value in frame read-df = 
        TRIM(df-file:screen-value in frame read-df).

/*----- HELP in MSS Incremental Utility FRAME read-df -----*/
IF NOT batch_mode THEN DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   on HELP of frame read-df or CHOOSE of btn_Help in frame read-df
      RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Incremental_Schema_Migration_Dlg_Box},
                             INPUT ?).
  &ENDIF
END.

IF NOT batch_mode THEN DO:
   {adecomm/okrun.i  
       &FRAME  = "FRAME read-df" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
   }
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME read-df = yes.
   &ENDIF
END.

/*==========================Mainline code=============================*/

ASSIGN iRecidOption = 0.

IF OS-GETENV("DELTADFNAME") <> ? THEN
  df-file   = OS-GETENV("DELTADFNAME").

IF OS-GETENV("SHDBNAME") <> ? THEN
  osh_dbname   = OS-GETENV("SHDBNAME").

 IF OS-GETENV("MSSCONPARMS") <> ? THEN
  mss_conparms   = OS-GETENV("MSSCONPARMS").

 IF OS-GETENV("MSSDBNAME") <> ? THEN
  mss_dbname   = OS-GETENV("MSSDBNAME").

IF OS-GETENV("MSSUSERNAME") <> ? THEN
  mss_username  = OS-GETENV("MSSUSERNAME").

IF OS-GETENV("CRTDELTADF") <> ? THEN DO:
crtdltadf = OS-GETENV("CRTDELTADF").
  IF crtdltadf BEGINS "Y" THEN 
    create_df = TRUE.
  ELSE 
   create_df = FALSE.
END.
ELSE
  create_df = TRUE.

IF OS-GETENV("MSSREVSEQGEN") <> ? THEN DO:
seqgen = OS-GETENV("MSSREVSEQGEN").
  IF (seqgen <> ?) AND (seqgen BEGINS "N") THEN
   newseq = FALSE.
  ELSE
   newseq = TRUE.
END.
ELSE
   newseq = TRUE.

IF OS-GETENV("SQLWIDTH") <> ? THEN DO:
  sqlwdth = OS-GETENV("SQLWIDTH").
  IF ((sqlwdth BEGINS "Y") OR (sqlwdth = "1")) THEN 
    iFmtOption = 1.
  ELSE 
    iFmtOption = 2.
END. 
ELSE 
   iFmtOption = 2.

IF OS-GETENV("EXPANDX8") <> ? THEN DO:
  ASSIGN expnd8  = OS-GETENV("EXPANDX8").
  IF expnd8 BEGINS "Y" THEN 
    ASSIGN lExpand = FALSE
           lFormat = TRUE.
  ELSE 
    ASSIGN lExpand = TRUE
           lFormat = FALSE.
END. 
ELSE
   ASSIGN lExpand = FALSE
         lFormat = TRUE.

IF OS-GETENV("CRTDEFAULT") <> ? THEN DO:
  ASSIGN crtdflt = OS-GETENV("CRTDEFAULT").
  IF crtdflt BEGINS "Y" THEN 
    ASSIGN dflt = TRUE.
    ELSE
     dflt = FALSE.
    END. 
  ELSE 
  ASSIGN dflt = FALSE.

IF OS-GETENV("VARLENGTH") <> ? THEN
  long-length = integer(OS-GETENV("VARLENGTH")).
ELSE
  long-length = 8000.

IF OS-GETENV("UNICODETYPES")  <> ? THEN DO:
  ucodetypes = OS-GETENV("UNICODETYPES").
  IF ucodetypes BEGINS "Y" THEN DO:
      ASSIGN unicodeTypes = TRUE
             long-length = 4000.
        ucodeexpnd = OS-GETENV("UNICODE_EXPAND").
        IF ucodeexpnd BEGINS "Y" THEN
        lUniExpand = YES.
  END.
  ELSE IF ucodetypes BEGINS "N" THEN
       ASSIGN long-length = 8000
              lUniExpand = FALSE
	       unicodeTypes = NO.
END.
ELSE 
     ASSIGN long-length = 8000
            lUniExpand = FALSE
	    unicodeTypes = NO.

IF OS-GETENV("COMPATIBLE") <> ?  THEN DO:
   cmptble  = OS-GETENV("COMPATIBLE").
     IF ((cmptble = "1") OR (cmptble BEGINS "Y")) THEN
       ASSIGN pcompatible=TRUE
              iRecidOption = 1. 
     ELSE IF (cmptble = "2")  THEN
          ASSIGN pcompatible=TRUE
          iRecidOption = 2.
     ELSE IF (cmptble BEGINS "N") THEN DO:
       ASSIGN  pcompatible=FALSE
               pcompatible:SCREEN-VALUE = "NO"
               iRecidOption:SCREEN-VALUE = "1". 
     END.
 END.
 ELSE
    ASSIGN
     pcompatible=TRUE
     iRecidOption = 1.

IF ((unicodeTypes = TRUE ) AND (INTEGER(long-length) > 4000)) THEN DO:  
    PUT STREAM logfile UNFORMATTED  "The maximum length for a nvarchar is 4000" skip(1).
    RETURN NO-APPLY.
END.
ELSE IF (unicodeTypes = FALSE ) AND (INTEGER(long-length) > 8000) THEN DO:  
    PUT STREAM logfile UNFORMATTED  "The maximum length for a varchar is 8000" skip(1).
    RETURN NO-APPLY.
 END.

IF batch_mode THEN DO:
 IF df-file  = ? OR df-file  = "" THEN DO:
  PUT STREAM logfile UNFORMATTED "Delta DF File is required." skip(1).
   RETURN NO-APPLY.
   END.

 IF SEARCH(df-file) = ? THEN DO:
  PUT STREAM logfile UNFORMATTED "Can not find a file of this name. Try again." skip(1).
   RETURN NO-APPLY.
     END.

 IF (osh_dbname = ?)  OR (osh_dbname  ="") THEN DO:
  PUT STREAM logfile UNFORMATTED "Schema Holder name is required." skip(1).
  RETURN NO-APPLY.
  END.

 IF (mss_conparms = ?)  OR (mss_conparms  ="") THEN DO:
 PUT STREAM logfile UNFORMATTED " Can not be connected using entered connect parameters." skip(1).
  RETURN NO-APPLY.
 END.

 IF mss_username  = ? OR mss_username  = "" THEN DO: 
  PUT STREAM logfile UNFORMATTED "MSS Object Owner Name is required." skip(1).
  RETURN NO-APPLY.
  END.
END.

IF batch_mode THEN DO:
 IF NOT CONNECTED(osh_dbname) THEN
  CONNECT VALUE (osh_dbname) VALUE (mss_conparms) NO-ERROR.
  CREATE ALIAS "DICTDB" FOR DATABASE VALUE(osh_dbname) NO-ERROR.
  RUN prodict/mss/deltaconnect.p.
END.

IF OS-GETENV("SHADOWCOL") <> ? THEN 
  ASSIGN envshadowcol  = OS-GETENV("SHADOWCOL").

IF OS-GETENV("MAPMSSDATETIME") <> ? THEN DO:
mssdttime = OS-GETENV("MAPMSSDATETIME").
 IF (mssdttime <> ?) AND (mssdttime BEGINS "N") THEN
   mapMSSDatetime = FALSE.
END.
ELSE
   mapMSSDatetime = TRUE.

 IF NOT batch_mode THEN DO:
 DISPLAY cFormat lFormat mapMSSDatetime cRecid WITH FRAME read-df.
 UPDATE df-file 
       btn_file
       osh_dbname
       mss_conparms
       mss_dbname
       mss_username
       long-length
       pcompatible
       shadowcol WHEN shadowcol = TRUE
       dflt
       create_df
       cFormat
       cRecid
       unicodeTypes WHEN hasUniSupport
       lUniExpand WHEN unicodeTypes
       mapMSSDatetime WHEN has2008Support
       newseq
       iFmtOption
       lFormat WHEN iFmtOption = 2
       iRecidOption WHEN (pcompatible AND hasCompColSupport)
       btn_OK btn_Cancel
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            btn_Help
       &ENDIF
     WITH FRAME read-df.
END.

IF unicodeTypes:SCREEN-VALUE ="yes" THEN
   ASSIGN unicodeTypes = YES.
IF lUniExpand:SCREEN-VALUE ="yes" THEN
   ASSIGN lUniExpand = YES. 

IF (iRecidOption= 1) then
  ASSIGN cmptble1 = TRUE
        cmptble2 = FALSE.
ELSE 
  ASSIGN cmptble2 = TRUE
	cmptble1 = FALSE.

IF (iFmtOption= 1) then
  ASSIGN wdth = TRUE
      ablfmt = FALSE.
ELSE
  ASSIGN wdth = FALSE
        ablfmt = TRUE.

   PUT STREAM logfile UNFORMATTED
       " " skip
       "Delta df to MS SQL Server Conversion" skip(2)
       "Delta DF File:                          " df-file skip
       "Schema Holder Database:                 " osh_dbname skip
       "Connect Parameters fo Schema:           " mss_conparms skip
       "Logical Name for MSS Database:          " mss_dbname SKIP
       "MSS Object Owner Name:                  " mss_username SKIP
       "Maximum Varchar Length:                 " long-length skip
       "Create RECID Field:                     " pcompatible SKIP
       "Create Shadow Columns:                  " shadowcol SKIP
       "Include Default:                        " dflt SKIP
       "Create Schema Holder Delta DF:          " create_df SKIP
       "Use Unicode Types:                      " unicodeTypes SKIP
       "Expand Width (utf-8):                   " lExpand SKIP
       "Map to MSS 'Datetime' Type:             " mapMSSDatetime SKIP
       "Use Revised Sequence Generator:         " newseq SKIP
       "For Field width use                     "  skip
       "                         Width:         " wdth SKIP
       "                    ABL Format:         " ablfmt SKIP
       "             Expand x(8) to 30:         " lFormat SKIP 
       "For Create RECID use                    " SKIP
       "                       Trigger:         " cmptble1 SKIP
       "               Computed Column:         " cmptble2 SKIP(3).

ASSIGN user_env[1]  = df-file
       user_env[3]  = ""
       user_env[4]  = "n"
       user_env[5]  = "go"
       user_env[6]  = "y"
       user_env[7]  = (IF dflt THEN "y" ELSE "n")
       user_env[8]  = "y"
       user_env[9]  = "ALL"
       user_env[10] = string(long-length)
       user_env[11] = (IF unicodeTypes THEN "NVARCHAR" ELSE "VARCHAR" ) 
       user_env[12] = "datetime"
       user_env[13] = "tinyint"
       user_env[14] = "integer"
       user_env[15] = "decimal(18,5)"
       user_env[16] = "decimal"
       user_env[17] = "integer"
       user_env[18] = (IF unicodeTypes THEN "NVARCHAR(MAX)" ELSE "TEXT")
       user_env[19] = "tinyint"
       user_env[20] = "##"  
       user_env[21] = (IF shadowcol THEN "y" ELSE "n")
       user_env[22] = "MSS"
       user_env[23] = "30"
       user_env[24] = "15"
       /* first y is for sequence support.
          second entry is for new sequence generator */
       user_env[25] = "y" + (IF newseq THEN ",y" ELSE ",n")
       user_env[28] = "128"
       user_env[29] = "128"            
       user_env[30] = "y"
       user_env[31] = "-- ** "
       user_env[32] = "MSSQLSRV7".
    
IF lUniExpand THEN 
   ASSIGN user_env[35] = "y".
ELSE
   ASSIGN user_env[35] = "n".

IF pcompatible THEN 
   ASSIGN user_env[27] = "y" + "," + STRING(iRecidOption).
ELSE
   ASSIGN user_env[27] = "no".

IF iFmtOption = 1 THEN 
    ASSIGN sqlwidth = TRUE. /* Use _Width field for size */
ELSE IF (lFormat = FALSE) THEN
    ASSIGN sqlwidth = ?. /* Use _Format field for size */
ELSE
    ASSIGN sqlwidth = FALSE. /* Calculate size */

/* create df for schema holder */
IF create_df THEN
  ASSIGN user_env[2] = "yes".
ELSE
  ASSIGN user_env[2] = "no".

RUN prodict/mss/_gendsql.p.
 
IF NOT schdbcon THEN 
   DISCONNECT DICTDB. 
ELSE DO:
  IF LDBNAME(l_curr-db) = ? THEN
    DELETE ALIAS DICTDB.
  ELSE
    RUN adecomm/_setalia.p
        ( INPUT l_curr-db
        ).
END./*********************************************************************
* Copyright (C) 2006-2013 by Progress Software Corporation.          *
* All rights reserved.Prior versions of this work may contain        *
* portions contributed by participants of Possenet.                  *
*                                                                    *
*********************************************************************/

/* Procedure deltaconnect.p - sdash
   Created 03/13/13 Initial procedure for the MSS Incremental Df Utility
*/

{ prodict/user/uservar.i  }
{ prodict/mss/mssvar.i  }
{ prodict/misc/filesbtn.i }

DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE hasUniSupport AS LOGICAL                NO-UNDO.
DEFINE VARIABLE has2008Support AS LOGICAL               NO-UNDO.
DEFINE VARIABLE hasCompColSupport AS LOGICAL            NO-UNDO.
DEFINE VARIABLE dflt_dbname      AS CHARACTER           NO-UNDO.
DEFINE NEW SHARED VARIABLE select_dbname  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE l                AS LOGICAL             NO-UNDO.
DEFINE VARIABLE l_dbnr        AS INTEGER                NO-UNDO.
DEFINE VARIABLE l_curr-db     AS INTEGER INITIAL 1      NO-UNDO.
DEFINE  SHARED VARIABLE scol      AS LOGICAL            NO-UNDO.
DEFINE  SHARED VARIABLE envshadowcol      AS CHARACTER  NO-UNDO.
DEFINE  NEW SHARED VARIABLE migshadowcol  AS LOGICAL    NO-UNDO.

batch_mode = SESSION:BATCH-MODE.

IF LDBNAME("DICTDB") <> ? THEN DO:
 FIND FIRST DICTDB._Db WHERE _Db._Db-name = mss_dbname NO-ERROR.
  IF AVAILABLE(_Db) THEN 
     l = yes.
END.

IF LDBNAME("DICTDB") <> ? THEN DO:
  FOR EACH DICTDB._DB NO-LOCK:
    IF DICTDB._Db._Db-type = "PROGRESS" THEN
      ASSIGN osh_dbname = LDBNAME ("DICTDB")
             mss_conparms = "<current working database>".
    /* If no select_dbname, select the last logical DB of schema holder with type = MSS */
    ELSE IF DICTDB._Db._Db-type = "MSS" THEN DO:
     IF l THEN DO:
      ASSIGN mss_dbname = DICTDB._Db._Db-name
             migshadowcol = (IF _Db-misc1[1] = 0 THEN TRUE ELSE FALSE)
             hasUniSupport = (DICTDB._Db._Db-xl-name = "utf-8")
             has2008Support = NO.
      /* To support computed columns, check for MSS 2005 or higher */
      IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 9 THEN 
          hasCompColSupport = YES.
      /* if SQL 2008 and above and native Driver 10, let user select 2008 types */
      IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 10 THEN DO:
         IF (DICTDB._Db._db-misc2[1] BEGINS "SQLNCLI") AND INTEGER(ENTRY(1,DICTDB._Db._db-misc2[2],".")) >= 10 THEN
             has2008Support = YES.
      END.
     END.
     ELSE DO:
         IF (mss_dbname <> ?) AND (mss_dbname  <> "") THEN DO:
              IF not batch_mode THEN DO:
               &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                PUT STREAM logfile UNFORMATTED "Logical database " mss_dbname " does not exist in schema holder" osh_dbname 
                ", Default will be restored." skip(1).
               &ELSE
               MESSAGE "Logical database " mss_dbname " does not exist in schema holder" osh_dbname 
               ", Default will be restored." VIEW-AS ALERT-BOX ERROR.
               &ENDIF.
               END.      
              ELSE DO:
               PUT STREAM logfile UNFORMATTED "Logical database " mss_dbname " does not exist in schema holder" osh_dbname 
               ", Default will be restored." skip(1).
          END.
     END.
     ELSE IF (mss_dbname = ?) OR (mss_dbname  = "") THEN DO:
        IF not batch_mode THEN DO:
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
          PUT STREAM logfile UNFORMATTED  "Logical database cannot be left blank. Default will be restored." SKIP(1).
          &ELSE
          MESSAGE "Logical database cannot be left blank. Default will be restored." VIEW-AS ALERT-BOX ERROR.
          &ENDIF.
          END.
        ELSE DO:
          PUT STREAM logfile UNFORMATTED  "Logical database cannot be left blank. Default will be restored." SKIP(1).
        END.
     END.   
     ASSIGN mss_dbname = DICTDB._Db._Db-name
             migshadowcol = (IF _Db-misc1[1] = 0 THEN TRUE ELSE FALSE)
             hasUniSupport = (DICTDB._Db._Db-xl-name = "utf-8")
             has2008Support = NO.
         /* To support computed columns, check for MSS 2005 or higher */
          IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 9 THEN 
             hasCompColSupport = YES.
         /* if SQL 2008 and above and native Driver 10, let user select 2008 types */
          IF INTEGER(SUBSTRING(ENTRY(NUM-ENTRIES(DICTDB._Db._Db-misc2[5], " ":U),_Db._Db-misc2[5], " ":U),1,2)) >= 10 THEN DO:
             IF (DICTDB._Db._db-misc2[1] BEGINS "SQLNCLI") AND INTEGER(ENTRY(1,DICTDB._Db._db-misc2[2],".")) >= 10 THEN
             has2008Support = YES.
           END.
       END.
    END.
  END.
END.

IF (migshadowcol = TRUE) AND (envshadowcol BEGINS "Y")THEN 
    ASSIGN shadowcol = TRUE
   envshadowcol = "FALSE".
 ELSE IF (migshadowcol = TRUE) AND (envshadowcol BEGINS "N") THEN 
   ASSIGN shadowcol = FALSE
    envshadowcol = "FALSE".
 ELSE IF (migshadowcol = TRUE) THEN
   ASSIGN shadowcol = TRUE
   envshadowcol = "FALSE".
ELSE IF (migshadowcol = FALSE) THEN
   ASSIGN shadowcol = FALSE
    envshadowcol = "FALSE".

/*********************************************************************
* Copyright (C) 2013 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/_clrank.p

Description:
    Legacy Index ranking for rowid selection
    
Text-Parameters:
    tmp_best      Migration option "select best rowid" 
    tbl_recid     Target Table's recid
    ClustAsROWID  Clustered Index available for selection as ROWID ?
    
Output-Parameters:
  _File fields:
        s_ttb_tbl.ds_recid INTEGER -> Updated with PROGRESS_RECID position, if it exist's in table.
        s_ttb_tbl.ds_msc23 CHAR    -> "PROGRESS_RECID" field name is stored here.
        s_ttb_tbl.ds_rowid INTEGER -> Updated with ROWID designated progress index serial number.
        s_ttb_idx.ds_msc21 CHAR    -> ROWID qualifications i.e "rux"

Included in:            
    prodict/mss/_mss_pul.p
    prodict/mss/_rankpdb.p
    
History:
    Anil Shukla  05/29/13   Created

--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/
&SCOPED-DEFINE xxDS_DEBUG                   DEBUG /**/
&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES


define input parameter tmp_best as INTEGER no-undo.
define input parameter tbl_recid as RECID no-undo.
define input parameter ClustAsROWID as LOGICAL no-undo.

define variable l_matrix  as character no-undo initial
                      "a,ax,ax,ax,u,ux,ux,ux".


/* this code accepts temp tables and does ranking for rowid selection   */
/*--------------------------- RECID-INDEX ----------------------------*/
    /* in Version 7.3 we needed a mandatory integer-field with a unique index
     * on it, to be used for RECID-functionality. Now we are able to use any
     * index, as long as it is unique.
     * In order to grant as much compatibility with previous versions as
     * possible, we now put both the old and the new version's info into
     * the required places. As long as there are indexes of "level" 0 or 4
     * selected, the schema can be used with a V7.3-client.
     * If another index gets selected, we put a message into the error-file
     * The new rules are:
     *    Level  Data-Types                andatory  unique   #(comp) misc2[1]
     *      1    integer only                 yes   &  yes  &   =1      a
     *      2    anything except date|float   yes   &  yes  &   =1      ax
     *      3    anything except float        yes   &  yes  &   =1      ax
     *      4    anything                     yes   &  yes  &   =1      ax
     *      5    integer only                 no    |  no   |   >1      u
     *      6    anything except date|float   no    |  no   |   >1      ux
     *      7    anything except float        no    |  no   |   >1      ux
     *      8    anything except date|float   no    |  no   |   >1      ux
     * a/u := automatically-selectable/user-definable
     * x   := NON V7.3-compatible
     * ( float can't be used for "="; date has some restrictions too )
    */
 
       /* check all indexes and calculate their usability-level */
    find first s_ttb_tbl where  s_ttb_tbl.tmp_recid = tbl_recid.
       for each s_ttb_idx
          where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid:

         for each s_ttb_idf 
            where s_ttb_idf.ttb_idx = s_ttb_idx.idx_recid:

           find first s_ttb_fld 
              where s_ttb_fld.tmpfld_recid = s_ttb_idf.ttb_fld.
           assign
              s_ttb_idx.hlp_fld#   = s_ttb_idx.hlp_fld# + 1
              s_ttb_idx.hlp_dtype# = maximum(s_ttb_idx.hlp_dtype#,
                          integer(string((s_ttb_fld.ds_type <> "integer"),"1/0")),
                          integer(string((s_ttb_fld.pro_type = "date"   ),"2/0")),
                          integer(string((s_ttb_fld.ds_type  = "float"  ),"3/0")) 
                                     )
              s_ttb_idx.hlp_mand   = s_ttb_idx.hlp_mand and s_ttb_fld.pro_mand.
              s_ttb_idx.hlp_fstoff = s_ttb_fld.ds_stoff * -1.
              s_ttb_idx.hlp_msc23  = ( if s_ttb_fld.ds_msc23 <> ?
                                      then s_ttb_fld.ds_msc23 
                                      else s_ttb_fld.ds_name
                                      ).
                                 
         end.  /* for each s_ttb_idfs of s_ttb_idx */
         
         if s_ttb_idx.ds_idx_typ = 1 AND
            ClustAsROWID THEN  /* This is a clustered index */
              assign s_ttb_idx.hlp_dtype# = 1
                     s_ttb_idx.hlp_level  = 1.
         ELSE DO:
         IF tmp_best <> 2 THEN assign s_ttb_idx.ds_idx_typ = 3.  /* DANGER:manupulated statement  */
         assign
            s_ttb_idx.hlp_dtype# = ( if ( s_ttb_idx.hlp_dtype# = 0
                                    and s_ttb_idx.hlp_fld#   > 1 )
                                    then 1
                                    else s_ttb_idx.hlp_dtype#
                                    )
            s_ttb_idx.hlp_level  = ( if ( s_ttb_idx.hlp_mand = TRUE 
                                    and s_ttb_idx.pro_uniq = TRUE )
                                    then 1
                                    else 5
                                    ) 
                                    + s_ttb_idx.hlp_dtype#.
          END.
       end. /* for each s_ttb_idx */

       /* assign correct i-misc2[1]-values and select index */
       for each s_ttb_idx where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid
             break by s_ttb_idx.ds_idx_typ
                   by s_ttb_idx.hlp_slctd descending
                   by s_ttb_idx.hlp_level:

          if s_ttb_idx.hlp_slctd   /* previousely selected RowID index */
               and s_ttb_idx.hlp_level <> 0
               and s_ttb_idx.hlp_level <> 4
               then do: /* select it but schema NOT compatible with V7.3 anymore*/
             assign
                s_ttb_idx.ds_msc21 = "r" 
                                     + entry(s_ttb_idx.hlp_level,l_matrix)
               s_ttb_tbl.ds_recid = ?
               s_ttb_tbl.ds_msc23 = ?
               s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
          end.    /* select it but schema NOT compatible with V7.3 anymore*/
          else if first(s_ttb_idx.hlp_slctd)
                 and s_ttb_idx.hlp_level <= 4
                 then assign /* select this index */
                    s_ttb_idx.ds_msc21 = "ra"
                    s_ttb_tbl.ds_recid = s_ttb_idx.hlp_fstoff
                    s_ttb_tbl.ds_msc23 = s_ttb_idx.hlp_msc23
                    s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
          else assign
              s_ttb_idx.ds_msc21 = entry(s_ttb_idx.hlp_level,l_matrix).
       end.     /* for each s_ttb_idx */

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2013 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/_cnrank.p

Description:
    New Index ranking for rowid selection
    
Text-Parameters:
    tmp_best      Migration option "select best rowid" 
    tbl_recid     Target Table's recid
    uniquifyAddon Add on to indicate foced uniqification 
    mssrecidCompat Migration option - whether index should be recid compatible.
    mapmssdatetime Migration selection to calculate field size.
    callerid       1-progress ranking , 2-pulled SH ranking
    
Output-Parameters:
        s_ttb_tbl.ds_recid   
        s_ttb_tbl.ds_msc23 
        s_ttb_tbl.ds_rowid 
        s_ttb_idx.ds_msc21

Included in:            
    prodict/mss/_mss_pul.p
    prodict/mss/_rankpdb.p

    
History:
    Anil Shukla  05/29/13   Created
    Sachin Garg  06/09/13   OE00225738: Exclusions for RECID function support

--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/
{ prodict/user/uservar.i }

&SCOPED-DEFINE NOTTCACHE 1
&SCOPED-DEFINE xxDS_DEBUG                   DEBUG /**/
&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE NOTTCACHE

define input parameter tmp_best as INTEGER no-undo.
define input parameter tbl_recid as RECID no-undo.
define input parameter uniquifyAddon as INTEGER no-undo.
define input parameter mssrecidCompat as LOGICAL no-undo.
define input parameter mapmssdatetime as LOGICAL no-undo.
define input parameter callerid as INTEGER no-undo. /* 1-progress ranking , 2-pulled SH ranking */

define variable l_matrix  as character no-undo initial
                      "a,ax,ax,ax,ax,ax,u,ux,ux,ux".
define variable n_matrix  as character no-undo initial ?.
define variable Adjustlevel as INTEGER no-undo INITIAL 0.
define variable expday as INTEGER no-undo INITIAL 0.
define variable remainder as INTEGER no-undo INITIAL 0.
define variable multiplr as INTEGER no-undo INITIAL 0.
define variable pkfound  as LOGICAL no-undo INITIAL FALSE.
define variable V3compat as CHARACTER no-undo INITIAL 
       "1,2,3,7,8,12,13,14,18,19,23,24,25,29,30,34,35,36,40,41,45,46,47,51,52,56,57,58,62,63".

/* PROCEDURE: SH-calc-fldsize
 */
PROCEDURE SH-calc-fldsize:
DEFINE OUTPUT PARAMETER odatasize AS INTEGER NO-UNDO.
DEFINE VARIABLE j                   AS INTEGER    NO-UNDO.

CASE UPPER(s_ttb_fld.pro_type):
     WHEN "INTEGER" OR WHEN "RECID" THEN DO:
        odatasize = 4. 
     END.
     WHEN "INT64" THEN odatasize = 8. 
     WHEN "DATE" THEN DO:
       IF mapmssdatetime THEN odatasize = 8. /* MSS - Datetime */
       ELSE odatasize = 3. /* MSS - DATE */
      END.
     WHEN "DATETIME" THEN odatasize = 7.  /* datetime2(3) */
     WHEN "DATETIME-TZ" THEN odatasize = 9. 
     WHEN "LOGICAL" THEN odatasize = 1.  /* it's tinyint of sql server */
     WHEN "DECIMAL" THEN DO:
      assign j = s_ttb_fld.ds_lngth.
      IF j >= 1 AND j <= 9 then odatasize = 5.
      ELSE IF j >= 10 AND j <= 19 then odatasize = 9.
      ELSE IF j >= 20 AND j <= 28 then odatasize = 13.
      ELSE odatasize = 17.
     END.
     WHEN "CHARACTER" THEN DO:
       assign odatasize = s_ttb_fld.ds_lngth.
     END.
     OTHERWISE odatasize = 0.
END CASE.

RETURN.
END PROCEDURE.

/* this code accepts temp tables and does ranking for rowid selection   */
/*--------------------------- RECID-INDEX ----------------------------*/
    /* in Version 7.3 we needed a mandatory integer-field with a unique index
     * on it, to be used for RECID-functionality. Now we are able to use any
     * index, as long as it is unique.
     * In order to grant as much compatibility with previous versions as
     * possible, we now put both the old and the new version's info into
     * the required places. As long as there are indexes of "level" 0 or 4
     * selected, the schema can be used with a V7.3-client.
     * If another index gets selected, we put a message into the error-file
     * The new rules are:
     *    Level  Data-Types                andatory  unique   #(comp) misc2[1]
     *      1    integer only                 yes   &  yes  &   =1      a
     *      2    anything except date|float   yes   &  yes  &   =1      ax
     *      3    anything except float        yes   &  yes  &   =1      ax
     *      4    anything                     yes   &  yes  &   =1      ax
     *      5    integer only                 no    |  no   |   >1      u
     *      6    anything except date|float   no    |  no   |   >1      ux
     *      7    anything except float        no    |  no   |   >1      ux
     *      8    anything except date|float   no    |  no   |   >1      ux
     * a/u := automatically-selectable/user-definable
     * x   := NON V7.3-compatible v := Uniqueness Enforced  n := Uniqueness missing
     * m := mandatory missing   c:= RECID compatible index
     * ( float can't be used for "="; date has some restrictions too )
    */
 
    /* check all indexes and calculate their usability-level */
    find first s_ttb_tbl where  s_ttb_tbl.tmp_recid = tbl_recid.
       for each s_ttb_idx
          where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid:
            assign 
		s_ttb_idx.hlp_fld# = 0
		s_ttb_idx.hlp_dtype# = 0
		s_ttb_idx.hlp_level = 0
		s_ttb_idx.hlp_idxsize = 0
		s_ttb_idx.ds_msc21 = ""
		s_ttb_idx.key_wt# = 0.
       end.


/* Calculate field sizes of the table fields */
     IF callerid = 2 THEN DO:
       FOR EACH s_ttb_fld WHERE s_ttb_fld.ttb_tbl = tbl_recid:
          RUN SH-calc-fldsize ( OUTPUT s_ttb_fld.fld_size ).
       end.
     END.

       for each s_ttb_idx
          where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid:
        
         assign n_matrix = ?.
         for each s_ttb_idf 
            where s_ttb_idf.ttb_idx = s_ttb_idx.idx_recid:

           find first s_ttb_fld 
              where s_ttb_fld.tmpfld_recid = s_ttb_idf.ttb_fld.
                  
           assign
              s_ttb_idx.hlp_fld#   = s_ttb_idx.hlp_fld# + 1
              s_ttb_idx.hlp_dtype# = maximum(s_ttb_idx.hlp_dtype#,
                          integer(string((s_ttb_fld.ds_type <> "integer"),"3/0")),
                          integer(string((s_ttb_fld.pro_type = "date" ),"4/0")),
                          integer(string((s_ttb_fld.pro_type = "datetime" ),"4/0")),
                          integer(string((s_ttb_fld.pro_type = "datetime-tz" ),"4/0")),
                          integer(string((s_ttb_fld.ds_type  = "float"  ),"5/0")) 
                                     )
              s_ttb_idx.hlp_mand   = s_ttb_idx.hlp_mand and s_ttb_fld.pro_mand.
              s_ttb_idx.hlp_fstoff = s_ttb_fld.ds_stoff * -1.
              s_ttb_idx.hlp_msc23  = ( if s_ttb_fld.ds_msc23 <> ?
                                      then s_ttb_fld.ds_msc23 
                                      else s_ttb_fld.ds_name
                                      ).
              s_ttb_idx.hlp_idxsize# = s_ttb_idx.hlp_idxsize# + s_ttb_fld.fld_size.
              if s_ttb_fld.ds_type = "BIGINT" then
                 assign s_ttb_idx.hlp_dtype# = s_ttb_idx.hlp_dtype# - 2.
         end.  /* for each s_ttb_idfs of s_ttb_idx */
         
            if s_ttb_idx.hlp_fld#   > 1 then do:
	       IF s_ttb_idx.hlp_dtype# = 0 THEN  DO: 
                  IF s_ttb_idx.hlp_fld# = 2 THEN assign s_ttb_idx.hlp_dtype# = 2.  /* int,int */
                  ELSE assign s_ttb_idx.hlp_dtype# = 6.
	       END.
               ELSE IF s_ttb_idx.hlp_dtype# = 1 THEN assign s_ttb_idx.hlp_dtype# = s_ttb_idx.hlp_dtype# + 6.
               ELSE assign s_ttb_idx.hlp_dtype# = s_ttb_idx.hlp_dtype# + 5.
            end.
         IF s_ttb_idx.pro_uniq = TRUE THEN Adjustlevel = uniquifyAddon.
         ELSE Adjustlevel = 44.
         assign
           s_ttb_idx.hlp_level  = ( if ( s_ttb_idx.hlp_mand = TRUE )
                                    then 1
                                    else 12
                                    ) 
                                    + s_ttb_idx.hlp_dtype#
                                    + Adjustlevel.
         assign
           expday = TRUNCATE(s_ttb_idx.hlp_idxsize# / 8, 0)
           remainder = s_ttb_idx.hlp_idxsize# MOD 8.
         assign multiplr = expday + ( IF remainder > 0 then 1 else 0).  
         assign  
           s_ttb_idx.key_wt#  = ( s_ttb_idx.hlp_level + s_ttb_idx.hlp_fld# ) * multiplr.
      
         if s_ttb_idx.pro_uniq then do:
           if uniquifyAddon = 22 then s_ttb_idx.ds_msc21 = s_ttb_idx.ds_msc21 + "v". /*enforced uniqness */
         end.
         else s_ttb_idx.ds_msc21 = s_ttb_idx.ds_msc21 + "n". /* uniqueness missing */

         if not s_ttb_idx.hlp_mand then
           s_ttb_idx.ds_msc21 = s_ttb_idx.ds_msc21 + "m". /* mandatory missing */
       end. /* for each s_ttb_idx */

       /* assign correct i-misc2[1]-values and select index */
       for each s_ttb_idx where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid
             break by s_ttb_idx.pro_uniq descending
                   by s_ttb_idx.ds_idx_typ
                   by s_ttb_idx.hlp_slctd descending
                   by s_ttb_idx.hlp_level
                   by s_ttb_idx.key_wt#
                   by s_ttb_idx.pro_prim descending:
          if s_ttb_idx.hlp_slctd   /* previousely selected RowID index */
               and s_ttb_idx.hlp_level <> 0
               and s_ttb_idx.hlp_level <> 4
               and s_ttb_idx.hlp_level <= 6
               then do: /* select it but schema NOT compatible with V7.3 anymore*/
             assign
                s_ttb_idx.ds_msc21 = "r" 
                                     + entry(s_ttb_idx.hlp_level,l_matrix)
               s_ttb_tbl.ds_recid = ?
               s_ttb_tbl.ds_msc23 = ?
               s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
          end.    /* select it but schema NOT compatible with V7.3 anymore*/
          else if first(s_ttb_idx.hlp_slctd)
                 and s_ttb_idx.hlp_level <= 6
                 then assign /* select this index */
                    s_ttb_idx.ds_msc21 = "r"
                                        + entry(s_ttb_idx.hlp_level,l_matrix)
                    s_ttb_tbl.ds_recid = s_ttb_idx.hlp_fstoff
                    s_ttb_tbl.ds_msc23 = s_ttb_idx.hlp_msc23
                    s_ttb_tbl.ds_msc16 = ( if (s_ttb_idx.hlp_fld# > 1 or
                                               s_ttb_idx.hlp_dtype# > 1)
                                           then 1
                                           else ?
                                         )
/*
                    s_ttb_tbl.ds_recid = ( if (s_ttb_idx.hlp_fld# > 1 or
                                                s_ttb_idx.hlp_dtype# > 1)
                                           then 0
                                           else s_ttb_idx.hlp_fstoff
                                          )
                    s_ttb_tbl.ds_msc23 = ( if (s_ttb_idx.hlp_fld# > 1 or
                                                s_ttb_idx.hlp_dtype# > 1)
                                           then ?
                                           else s_ttb_idx.hlp_msc23
                                          )
*/
                    s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
          else DO:
               assign n_matrix = ( if ( ( s_ttb_idx.hlp_level >= 12 and
                                          s_ttb_idx.hlp_level <= 17 ) OR
                                        s_ttb_idx.hlp_level <= 6 )
                                      
                                then "a"
                                else "u"
                              ).
               IF LOOKUP(STRING(s_ttb_idx.hlp_level),V3compat) = 0 THEN
                  assign n_matrix = n_matrix + "x".
             
               assign s_ttb_idx.ds_msc21 = n_matrix + s_ttb_idx.ds_msc21.
          end.

            /* OE00225738: multi component index or single componnet
             * index but non binary type are not eligible for RECID 
             * function support.
             */
          IF s_ttb_idx.hlp_fld# <= 2 and (s_ttb_idx.hlp_level <= 3 OR
             (s_ttb_idx.hlp_level >= 12 AND s_ttb_idx.hlp_level <= 14 )) THEN 
            assign s_ttb_idx.ds_msc21 = s_ttb_idx.ds_msc21 + "c".  /* RECID compatible index */
          IF s_ttb_idx.pro_uniq THEN DO:
             IF s_ttb_idx.hlp_mand AND NOT pkfound THEN
                assign pkfound = TRUE
                       s_ttb_idx.ds_msc21 = s_ttb_idx.ds_msc21 + "p". /* Primary key candidate */
             IF s_ttb_idx.pro_prim AND s_ttb_idx.pro_uniq_bkp <> s_ttb_idx.pro_uniq AND
                s_ttb_idx.ds_idx_typ = 1 AND index(s_ttb_idx.ds_msc21,"v") = 0 THEN 
                  s_ttb_idx.ds_msc21 = s_ttb_idx.ds_msc21 + "v". /*enforced uniqness on OE PK */
          END.
       end.     /* for each s_ttb_idx */

   FOR EACH s_ttb_idx where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid
             break by s_ttb_idx.pro_uniq descending
                   by s_ttb_idx.ds_idx_typ
                   by s_ttb_idx.hlp_level
                   by s_ttb_idx.key_wt#
                   by s_ttb_idx.pro_prim descending:
       
       IF mssrecidCompat THEN DO:
          IF substring(s_ttb_idx.ds_msc21,1,1) = "r" THEN DO:
             IF INDEX(s_ttb_idx.ds_msc21,"c") <> 0 THEN  LEAVE. /* RECID comaptible */
             ELSE DO:
                 /* ---- Remove "r" and Replace 'a' with 'u'*/
                assign s_ttb_idx.ds_msc21 = substring(s_ttb_idx.ds_msc21,2,LENGTH(s_ttb_idx.ds_msc21)).
                assign s_ttb_tbl.ds_recid = ?
                       s_ttb_tbl.ds_msc23 = ?
                       s_ttb_tbl.ds_rowid = ?.
               /*
                IF INDEX(s_ttb_idx.ds_msc21,"a") <> 0 THEN 
                    assign s_ttb_idx.ds_msc21 = replace(s_ttb_idx.ds_msc21, "a","u").
               */
             END.
          END. 
          ELSE DO: 
             IF INDEX(s_ttb_idx.ds_msc21,"c") <> 0 THEN DO: /* RECID compatible but no "r" */
               /** --- Add "r" **/
                 assign s_ttb_idx.ds_msc21 = "r" + s_ttb_idx.ds_msc21
                        s_ttb_tbl.ds_recid = s_ttb_idx.hlp_fstoff
                        s_ttb_tbl.ds_msc23 = s_ttb_idx.hlp_msc23
                        s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
               /*
                 IF INDEX(s_ttb_idx.ds_msc21,"u") <> 0 THEN 
                    assign s_ttb_idx.ds_msc21 = replace(s_ttb_idx.ds_msc21, "u","a").
               */
                 LEAVE.   
             END. 
          END.
       END.
       ELSE DO:
         IF substring(s_ttb_idx.ds_msc21,1,1) <> "r" THEN DO: 
           IF( ( s_ttb_idx.ds_idx_typ = 1 AND s_ttb_idx.pro_uniq ) OR 
               INDEX(s_ttb_idx.ds_msc21,"n") = 0 OR  /* is Unique already */
               INDEX(s_ttb_idx.ds_msc21,"v") <> 0 )  /* OR uniqueness enforced */
           THEN DO:
             assign s_ttb_idx.ds_msc21 = "r" + s_ttb_idx.ds_msc21
                    s_ttb_tbl.ds_recid = s_ttb_idx.hlp_fstoff
                    s_ttb_tbl.ds_msc23 = s_ttb_idx.hlp_msc23
                    s_ttb_tbl.ds_msc16 = ( if (s_ttb_idx.hlp_fld# > 1 or
                                               s_ttb_idx.hlp_dtype# > 1)
                                           then 1
                                           else ?
                                         )
/*
                    s_ttb_tbl.ds_recid = ( if (s_ttb_idx.hlp_fld# > 1 or
                                                s_ttb_idx.hlp_dtype# > 1)
                                           then 0
                                           else s_ttb_idx.hlp_fstoff
                                          )
                    s_ttb_tbl.ds_msc23 = ( if (s_ttb_idx.hlp_fld# > 1 or
                                                s_ttb_idx.hlp_dtype# > 1)
                                           then ?
                                           else s_ttb_idx.hlp_msc23
                                          )
*/
                    s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
             IF INDEX(s_ttb_idx.ds_msc21,"u") <> 0 THEN
                assign s_ttb_idx.ds_msc21 = replace(s_ttb_idx.ds_msc21, "u","a").
           END.
         END.
         LEAVE.
       END.
   END.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2013 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/_ctestr.p

Description:
    Generates Migration and Ranking report 

Text-Parameters:
    s_rank_rep  report file name.

Included in:
   prodict/mss/protoms1.p

History:
    Anil Shukla  05/29/13   Created
--------------------------------------------------------------------*/
{ prodict/user/uservar.i }
{ prodict/mss/mssvar.i }

/* ----------------------------- DEFINES -----------------------------*/
DEFINE INPUT PARAMETER outfile as CHARACTER no-undo.
DEFINE INPUT PARAMETER RankDesc as CHARACTER no-undo.

DEFINE stream s_rank_rep.
DEFINE  VARIABLE i1 AS INTEGER INITIAL 0.
DEFINE  VARIABLE VAR1 AS LOGICAL INITIAL FALSE.
DEFINE  VARIABLE lcompatible AS LOGICAL  INITIAL FALSE. 
DEFINE  VARIABLE l-INFOR AS LOGICAL INITIAL FALSE.
DEFINE  VARIABLE tmp_str AS CHARACTER NO-UNDO.

OUTPUT stream s_rank_rep to VALUE(outfile). 

/* dump "Migration" screen options for reference */
PUT STREAM s_rank_rep UNFORMATTED SKIP "     Migration window selections     Date:" NOW SKIP.
PUT STREAM s_rank_rep UNFORMATTED "--------------------------------------------------------------  " SKIP.

PUT STREAM s_rank_rep UNFORMATTED "Original OpenEdge Database:     " pro_dbname SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Connect Parameters for OpenEdge:" pro_conparms SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Name of Schema Holder Database: " osh_dbname SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Logical Database Name:          " mss_pdbname SKIP.
PUT STREAM s_rank_rep UNFORMATTED "ODBC Data Source Name:          " mss_dbname SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Username:                       " mss_username SKIP.
PUT STREAM s_rank_rep UNFORMATTED "User's Password:                ***** " SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Connect Parameters:             " mss_conparms SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Maximum Varchar Length:         " long-length SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Codepage:   " mss_codepage SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Collation:  " mss_collname SKIP.
PUT STREAM s_rank_rep UNFORMATTED "Insensitive:" mss_incasesen SKIP(1).

IF loadsql THEN PUT STREAM s_rank_rep UNFORMATTED "[X] " .
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] " .
PUT STREAM s_rank_rep UNFORMATTED "Load SQL       ".
IF genrep THEN PUT STREAM s_rank_rep UNFORMATTED "[X] " .
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] " .
PUT STREAM s_rank_rep UNFORMATTED "Generate Rank Report" SKIP.
IF movedata THEN PUT STREAM s_rank_rep UNFORMATTED "[X] " .
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] " .
PUT STREAM s_rank_rep UNFORMATTED "Move Data" SKIP.
PUT STREAM s_rank_rep UNFORMATTED "--------------------------------------------------------------  " SKIP(2).

/* dump "Advanced" screen options for reference */
PUT STREAM s_rank_rep UNFORMATTED SKIP "  ********* Advanced window selections *********  " SKIP.

IF (UPPER(ENTRY(1,user_env[36])) = "Y") THEN PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "[X] " .
ELSE PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "[ ] " .
PUT STREAM s_rank_rep UNFORMATTED "Migrate Constraints" SKIP.

PUT STREAM s_rank_rep UNFORMATTED "-------------------------------------------------------------  " SKIP.
IF (UPPER(ENTRY(2,user_env[36])) = "Y") THEN PUT STREAM s_rank_rep UNFORMATTED  "[X] ".
ELSE PUT STREAM s_rank_rep UNFORMATTED  "[ ] ".
PUT STREAM s_rank_rep UNFORMATTED "Try Primary for ROWID    ".

IF (UPPER(ENTRY(3,user_env[36])) = "Y") THEN PUT STREAM s_rank_rep UNFORMATTED "(X) " .
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] " .
PUT STREAM s_rank_rep UNFORMATTED "Maintain RECID compatibility" SKIP.

IF user_env[27] = ?  OR user_env[27] = "" THEN ASSIGN lcompatible = true.
ELSE IF num-entries(user_env[27]) > 1 THEN
     assign lcompatible = ( entry(1,user_env[27]) BEGINS "y"
              or entry(1,user_env[27]) = "" ).
else assign lcompatible = (user_env[27] BEGINS "y").

IF lcompatible THEN DO:
  IF ( (NUM-ENTRIES(user_env[27]) >= 2) AND ENTRY(2,user_env[27]) EQ "1" ) THEN
    PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "Create RECID Field using  (X) Trigger   ( ) Computed Column" SKIP.
  ELSE 
    PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "Create RECID Field using  ( ) Trigger   (X) Computed Column" SKIP.
  IF NUM-ENTRIES(user_env[27]) >= 3 THEN DO:
    IF ((ENTRY(3,user_env[27]) EQ "D" ) OR (ENTRY(3,user_env[27]) EQ "P") ) THEN DO:
       PUT STREAM s_rank_rep UNFORMATTED "  [X] For " .
       IF (ENTRY(3,user_env[27]) EQ "D" ) THEN 
         PUT STREAM s_rank_rep UNFORMATTED "   (X) ROWID   ( ) Prime ROWID " SKIP.
       ELSE
         PUT STREAM s_rank_rep UNFORMATTED "   ( ) ROWID   (X) Prime ROWID " SKIP.
       PUT STREAM s_rank_rep UNFORMATTED "  [ ] For ROWID Uniqueness" SKIP. 
    END.
    ELSE DO:
       PUT STREAM s_rank_rep UNFORMATTED "  [ ] For  ( ) ROWID   ( ) Prime ROWID " SKIP.
       PUT STREAM s_rank_rep UNFORMATTED "  [X] For ROWID Uniqueness" SKIP. 
    END.
  END.
END. 

IF NUM-ENTRIES(user_env[36]) >= 4 AND (UPPER(ENTRY(4,user_env[36])) EQ "Y" ) THEN DO: 
  PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "[X] Select Best ROWID Index"  SKIP.
  PUT STREAM s_rank_rep UNFORMATTED "    USING     " .
  IF ENTRY(5,user_env[36]) EQ "1" THEN
     PUT STREAM s_rank_rep UNFORMATTED "(X) OE Schema  ( ) Foreign Schema" SKIP.
  ELSE
     PUT STREAM s_rank_rep UNFORMATTED "( ) OE Schema  (X) Foreign Schema" SKIP.
END.

PUT STREAM s_rank_rep UNFORMATTED "--------------------------------------------------------------  " SKIP.
IF user_env[12]  = "datetime" THEN PUT STREAM s_rank_rep UNFORMATTED "[X] Map to MSS 'Datetime' Type".
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] Map to MSS 'Datetime' Type".

IF UPPER(user_env[21]) = "Y" THEN PUT STREAM s_rank_rep UNFORMATTED "    [X] Create Shadow Column" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "    [ ] Create Shadow Column" SKIP.

IF NUM-ENTRIES(user_env[25]) >= 2 AND (UPPER(ENTRY(2,user_env[25])) EQ "Y" ) THEN 
     PUT STREAM s_rank_rep UNFORMATTED "[X] Use revised sequence Generator" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] Use revised sequence Generator" SKIP.

PUT STREAM s_rank_rep UNFORMATTED "--------------------------------------------------------------  " SKIP.
IF user_env[11]  = "nvarchar" THEN PUT STREAM s_rank_rep UNFORMATTED "[X] Use Unicode Types".
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] Use Unicode Types".
IF UPPER(user_env[35]) = "Y" THEN PUT STREAM s_rank_rep UNFORMATTED "      [X] Expand Width(utf-8)" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "      [ ] Expand Width(utf-8)" SKIP.
IF UPPER(user_env[33]) = "Y" THEN 
   PUT STREAM s_rank_rep UNFORMATTED "For field widths use  (X) Width  ( ) ABL Format" .
ELSE PUT STREAM s_rank_rep UNFORMATTED "For field widths use  ( ) Width  (X) ABL Format" .
IF lExpand THEN PUT STREAM s_rank_rep UNFORMATTED "   [X] Expand x(8) to 30" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "   [ ] Expand x(8) to 30" SKIP.
PUT STREAM s_rank_rep UNFORMATTED "--------------------------------------------------------------  " SKIP.

IF UPPER(user_env[38]) = "1" THEN 
   PUT STREAM s_rank_rep UNFORMATTED "Apply Uniqueness as: (X) Index Attributes  ( ) Constraints" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "Apply Uniqueness as: ( ) Index Attributes  (X) Constraints" SKIP.

IF UPPER(user_env[7]) = "Y" THEN PUT STREAM s_rank_rep UNFORMATTED "(X) Include Default" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "[ ] Include Default" SKIP.

IF UPPER(user_env[39]) = "1" THEN 
   PUT STREAM s_rank_rep UNFORMATTED "Apply Defaults as: (X) Field Attributes  ( ) Constraints" SKIP.
ELSE PUT STREAM s_rank_rep UNFORMATTED "Apply Defaults as: ( ) Field Attributes  (X) Constraints" SKIP.

PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "  ********* ******************************** *********  " SKIP.
/* end of "Advanced" screen options */
IF OS-GETENV("OE_INFOR_OPTS") <> ? 
THEN DO:
     tmp_str = OS-GETENV("OE_INFOR_OPTS").

     IF tmp_str BEGINS "Y" THEN
      ASSIGN l-INFOR = TRUE.
END.
IF l-INFOR THEN DO : 

PUT STREAM s_rank_rep UNFORMATTED SKIP(2) "************* Ranking Information ************ *********  " SKIP.

IF ((NUM-ENTRIES(user_env[42]) >= 2) AND
    UPPER(ENTRY(2,user_env[42])) = "L" ) THEN 
  PUT STREAM s_rank_rep UNFORMATTED "   Ranking Happened using Legacy ranking Algorithm." SKIP.
ELSE 
  PUT STREAM s_rank_rep UNFORMATTED "   Ranking Happened using NEW ranking Algorithm." SKIP.


FOR EACH DICTDB._File WHERE NOT DICTDB._FILE._Hidden AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN"):
PUT STREAM s_rank_rep UNFORMATTED SKIP(2)"    =========================================================    " SKIP.

  IF NOT CAN-FIND( FIRST DICTDB._INDEX WHERE DICTDB._INDEX._File-recid = RECID(DICTDB._FILE) AND 
             DICTDB._Index._Index-name <> "default" ) THEN
     assign i1 = 0. 
  ELSE assign i1 = DICTDB._FILE._Prime-index.

      PUT STREAM s_rank_rep UNFORMATTED "Table Name: " UPPER(DICTDB._FILE._File-name) FORMAT "x(15)" 
        "Prime Index ID:" i1 SKIP 
      "MISC1[1] :" DICTDB._FILE._Fil-misc1[1] FORMAT   "->>9"
      "              Misc1[2]:" DICTDB._FILE._Fil-misc1[2] FORMAT   "->>9" SKIP
      "MISC2[4] :" DICTDB._FILE._Fil-misc2[4] FORMAT "x(15)"
      "   MISC2[5]:" DICTDB._FILE._Fil-misc2[5]  FORMAT "x(25)" SKIP
       "MISC1[5] :" DICTDB._FILE._Fil-misc1[5] FORMAT   "->>9"
    .
  IF DICTDB._FILE._Fil-misc1[1] > 0 THEN
      PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "This table has PROGRESS_RECID column as ROWID" SKIP(1). 
  ELSE IF DICTDB._File._Fil-misc1[2] > 0 THEN
      PUT STREAM s_rank_rep UNFORMATTED SKIP(1) "Index Serial# " DICTDB._FILE._Fil-misc1[2] FORMAT   "->>9" 
          " Selected as ROWID candidate." SKIP(1). 
  ELSE
      PUT STREAM s_rank_rep UNFORMATTED  SKIP(1) "      ******  NO ROWID Designated  ****** " SKIP(1). 

FIND FIRST DICTDB._INDEX WHERE DICTDB._INDEX._File-recid = RECID(DICTDB._FILE) AND DICTDB._Index._Index-name <> "default" NO-ERROR. 
IF AVAILABLE DICTDB._INDEX THEN DO: 

   PUT STREAM s_rank_rep UNFORMATTED SKIP "-----------   ALL INDEXES of table " UPPER(DICTDB._FILE._File-name) FORMAT "x(15)" "----------------------" SKIP.

   PUT STREAM s_rank_rep UNFORMATTED 
       "Index Sr#  Unique  Index-recid      Index Name          Column#  Ranking+" SKIP.
   PUT STREAM s_rank_rep UNFORMATTED "------------------------------------------------------------------------" SKIP.

   FOR EACH DICTDB._Index WHERE DICTDB._INDEX._File-recid = RECID(DICTDB._FILE) AND  
                                DICTDB._Index._Index-name <> "default" BY DICTDB._Index._idx-num:
       ASSIGN VAR1 =  DICTDB._Index._Unique.
       PUT STREAM s_rank_rep UNFORMATTED 
           DICTDB._INDEX._idx-num FORMAT   "->>>>>9" "    " VAR1  FORMAT "yes/no" "   " RECID(DICTDB._INDEX) FORMAT   "->>>>>9" 
           "            " DICTDB._INDEX._Index-name  FORMAT "x(20)" "  " DICTDB._INDEX._num-comp FORMAT   "->>9" "    " 
           DICTDB._INDEX._I-misc2[1] FORMAT "x(5)" .
       IF substring(DICTDB._INDEX._I-misc2[1],1,1) EQ "r" THEN
          PUT STREAM s_rank_rep UNFORMATTED "- Auto selected ROWID.".
       PUT STREAM s_rank_rep UNFORMATTED SKIP.
   END.
   PUT STREAM s_rank_rep UNFORMATTED " +Ranking - a:Automatically Selectable, u:User-definable, x:Non-V7.3 compatible, v:Uniqueness Enforced." SKIP.
   PUT STREAM s_rank_rep UNFORMATTED " +Ranking - n:Uniqueness missing, m:Mandatory missing, c-RECID compatible index." SKIP(2).
END.

IF ((NUM-ENTRIES(user_env[42]) >= 2) AND UPPER(ENTRY(2,user_env[42])) = "N" ) THEN 
   PUT STREAM s_rank_rep UNFORMATTED RankDesc SKIP.
  
END.
END.
PUT STREAM s_rank_rep UNFORMATTED SKIP(2)"++++++++++ END OF REPORT ++++++++++ " NOW SKIP.

OUTPUT STREAM s_rank_rep CLOSE.
/*********************************************************************
* Copyright (C) 2013 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/mss/_rankpdb.p

Description:
    creates PROGRESS DB index ranking for rowid selection
    
Text-Parameters:
    Table recid
    uniquifyAddon add on value to indicate enforced uniqueness
    
Output-Parameters:
    DICTDB._File._Fil-misc1[2] as ttb_tbl_rowid

Included in:            
    prodict/mss/protoms1.p
    
History:
    Anil Shukla  05/29/13   Created

--------------------------------------------------------------------*/
/*h-*/
&SCOPED-DEFINE NOTTCACHE 1
&SCOPED-DEFINE xxDS_DEBUG                 DEBUG 
&SCOPED-DEFINE DATASERVER                 YES 
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
 { prodict/dictvar.i NEW }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE NOTTCACHE

{ prodict/user/uservar.i }

/*----------------------------  DEFINES  ---------------------------*/
define input parameter itbl_recid as RECID no-undo.
define input parameter ClustAsROWID as LOGICAL no-undo.
define input parameter RankDesc as CHARACTER no-undo.

DEFINE VARIABLE compatible          AS LOGICAL    NO-UNDO.
DEFINE VARIABLE migConstraint       AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE msstryp             AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mssrecidCompat      AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mapmssdatetime      AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE callerid            AS INTEGER    NO-UNDO INITIAL 1.
DEFINE VARIABLE mssOptRowid         AS CHARACTER  NO-UNDO INITIAL "".
DEFINE VARIABLE mssselBestRowidIdx  AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE msschoiceSchema     AS INTEGER    NO-UNDO.
DEFINE VARIABLE mssclus_explct      AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE keyCreated          AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE parse2              AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE RecidAsRowid        AS LOGICAL    NO-UNDO INITIAL FALSE. 
DEFINE VARIABLE uniquifyAddon       as INTEGER    NO-UNDO INITIAL 0.
DEFINE VARIABLE keyExist            AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE NonUnikCC           AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE pk_unique           AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE restorReqd          AS LOGICAL    NO-UNDO INITIAL FALSE.
DEFINE VARIABLE mdrec_db            AS RECID      NO-UNDO.

DEFINE VARIABLE s_tmp_best          AS INTEGER    NO-UNDO INITIAL 0. 

/* PROCEDURE: calc-fldsize
 */
PROCEDURE calc-fldsize:
DEFINE OUTPUT PARAMETER odatasize AS INTEGER NO-UNDO.
DEFINE VARIABLE left_paren          AS INTEGER    NO-UNDO.
DEFINE VARIABLE right_paren         AS INTEGER    NO-UNDO.
DEFINE VARIABLE lngth               AS INTEGER    NO-UNDO.
DEFINE VARIABLE j                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE z                   AS INTEGER    NO-UNDO.
DEFINE VARIABLE chrlong             AS INTEGER    NO-UNDO INITIAL 240.
DEFINE VARIABLE nbrchar             AS INTEGER    NO-UNDO INITIAL 240.
DEFINE VARIABLE dummy         AS CHARACTER  NO-UNDO INITIAL "".
DEFINE VARIABLE dummyint         AS INTEGER  NO-UNDO.

CASE UPPER(s_ttb_fld.pro_type):
     WHEN "INTEGER" OR WHEN "RECID" THEN DO:
        odatasize = 4. 
     END.
     WHEN "INT64" THEN odatasize = 8. 
     WHEN "DATE" THEN DO:
       IF NUM-ENTRIES(user_env[25]) > 2 AND ENTRY(3,user_env[25]) BEGINS "N" THEN odatasize = 8. /* MSS - Datetime */
       ELSE odatasize = 3. /* MSS - DATE */
      END.
     WHEN "DATETIME" THEN odatasize = 7.  /* datetime2(3) */
     WHEN "DATETIME-TZ" THEN odatasize = 9. 
     WHEN "LOGICAL" THEN odatasize = 1.  /* it's tinyint of sql server */
     WHEN "DECIMAL" THEN DO:
      assign dummyint = DICTDB._Field._Width.
      IF user_env[33] = "y" THEN DO: /* sqlwidth = ON */
         IF DICTDB._Field._Width > 28 THEN ASSIGN j = 28.
         ELSE ASSIGN j = DICTDB._Field._Width.
         IF j < DICTDB._Field._Decimals THEN ASSIGN j = DICTDB._Field._Decimals.
      END.
      ELSE DO:
         ASSIGN z = 1
                j = 0.
       /* get count of significant digits stopping at ".".
        * only count elements that can be considered digits. */
       REPEAT:
        IF z > LENGTH(DICTDB._Field._Format) OR SUBSTR(DICTDB._Field._Format,z,1) = "." THEN
           LEAVE.
        IF SUBSTR(DICTDB._Field._Format,z,1) = ">" OR
           SUBSTR(DICTDB._Field._Format,z,1) = "<" OR
           SUBSTR(DICTDB._Field._Format,z,1) = "Z" OR
           SUBSTR(DICTDB._Field._Format,z,1) = "z" OR
           SUBSTR(DICTDB._Field._Format,z,1) = "9" OR
           SUBSTR(DICTDB._Field._Format,z,1) = "*" THEN
             j = j + 1.
        z = z + 1.
       END.
       /* Add the scale to the precision. */
      assign dummyint = DICTDB._Field._Decimals.
       j = j + DICTDB._Field._Decimals.
      END. /* end of ELSE DO: */

      IF j >= 1 AND j <= 9 then odatasize = 5.
      ELSE IF j >= 10 AND j <= 19 then odatasize = 9.
      ELSE IF j >= 20 AND j <= 28 then odatasize = 13.
      ELSE odatasize = 17.
     END.
     WHEN "CHARACTER" THEN DO:
          IF user_env[32] = "MS SQL Server" THEN ASSIGN chrlong = 255.
          ELSE ASSIGN chrlong = integer(user_env[10]).

          IF UPPER(user_env[33]) = "Y" THEN  /* sqlwidth = ON */
             ASSIGN j = DICTDB._Field._Width.
          ELSE DO:
             ASSIGN lngth = LENGTH(DICTDB._Field._format, "character")
                    nbrchar = 0.

             IF INDEX(DICTDB._Field._Format, "(") > 1 THEN DO:
                left_paren = INDEX(DICTDB._Field._Format, "(").
                right_paren = INDEX(DICTDB._Field._Format, ")").
                lngth = right_paren - (left_paren + 1).
                 assign j = INTEGER(SUBSTRING(DICTDB._Field._Format, left_paren + 1, lngth)).
             END.
             ELSE DO:
               DO z = 1 to lngth:
                  IF SUBSTRING(DICTDB._Field._Format,z,1) = "9" OR
                     SUBSTRING(DICTDB._Field._Format,z,1) = "N" OR
                     SUBSTRING(DICTDB._Field._Format,z,1) = "A" OR
                     SUBSTRING(DICTDB._Field._Format,z,1) = "x" OR
                     SUBSTRING(DICTDB._Field._Format,z,1) = "!"   THEN
                        ASSIGN odatasize = odatasize + 1.
               END.
               IF nbrchar > 0 THEN
                  ASSIGN j = nbrchar.
               ELSE
                  ASSIGN j = lngth.
          END.
          FIND FIRST DICTDB._Db WHERE _Db-local NO-LOCK NO-ERROR.
          ASSIGN mdrec_db = RECID(DICTDB._Db).
          IF DICTDB._Field._Decimals > 0
             AND can-find(first DICTDB._Db where RECID(DICTDB._Db) = mdrec_db
                          and DICTDB._Db._Db-type <> "PROGRESS" ) THEN
             ASSIGN j = DICTDB._Field._Decimals.

          IF j = 8 AND UPPER(user_env[33]) = "N" THEN j = INTEGER (user_env[23]).
        END.
        IF (user_env[35] = "y") THEN j = j * 2.
        IF j > chrlong THEN
           odatasize = chrlong. /* long char */
        ELSE
           odatasize = j.
     END.
     OTHERWISE odatasize = 0.
END CASE.
RETURN.
END PROCEDURE.


/* PROCEDURE: Uniquify-Non-UniqIdx-and-retry
 */
PROCEDURE Uniquify-Non-UniqIdx-and-retry.
  def buffer s_buffer_tmp_idx for s_ttb_idx.
  
  ASSIGN parse2 = TRUE.
  for each s_buffer_tmp_idx where s_buffer_tmp_idx.ttb_tbl = s_ttb_tbl.tmp_recid:
                               /*   AND s_buffer_tmp_idx.hlp_mand = TRUE: */
       ASSIGN s_buffer_tmp_idx.hlp_fld#   = 0
              s_buffer_tmp_idx.hlp_dtype# = 0
              s_buffer_tmp_idx.hlp_fstoff = ?
              s_buffer_tmp_idx.hlp_level  = 0
              s_buffer_tmp_idx.pro_uniq_bkp = s_buffer_tmp_idx.pro_uniq.
       ASSIGN s_buffer_tmp_idx.pro_uniq = TRUE.  /* Assume it's uniq for ranking purposes */
      
  END.
  Assign uniquifyAddon  = 22.
  RUN prodict/mss/_cnrank.p (  INPUT s_tmp_best,
                               INPUT s_ttb_tbl.tmp_recid,
                               INPUT uniquifyAddon,
                               INPUT mssrecidCompat,
                               INPUT mapmssdatetime,
                               INPUT callerid).  /* 1-progress ranking , 2-pulled SH ranking */
/***********
  IF (s_ttb_tbl.ds_rowid GT 0 AND s_ttb_tbl.ds_rowid NE ? ) THEN
          ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc +
                                       "Attempted Second parse and successfully identified a ROWID candidate.". 
****************/
END.

/*======================== Mainline =================================== */   

/* FOR EACH s_ttb_tbl: DELETE s_ttb_tbl. END. */
FOR EACH s_ttb_idx: DELETE s_ttb_idx. END.

FOR EACH s_ttb_idf: DELETE s_ttb_idf. END.
FOR EACH s_ttb_fld: DELETE s_ttb_fld. END.

 if  user_env[27] = ?  OR user_env[27] = ""
  THEN ASSIGN compatible = true.
 else if num-entries(user_env[27]) > 1
  then assign  /* more than one value in user_env[27] */
   compatible = ( entry(1,user_env[27]) BEGINS "y"
              or entry(1,user_env[27]) = ""
               ).
 else assign
  compatible = (user_env[27] BEGINS "y"). /* create recid fields/indexes */

ASSIGN migConstraint = (ENTRY(1,user_env[36]) = "y").
ASSIGN msstryp = (ENTRY(2,user_env[36]) = "y").
ASSIGN mssrecidCompat = (ENTRY(3,user_env[36]) = "y").
ASSIGN mapmssdatetime = (ENTRY(3,user_env[25]) = "y").
IF compatible THEN ASSIGN mssOptRowid = ENTRY(3,user_env[27]).
ASSIGN mssselBestRowidIdx = (ENTRY(4,user_env[36]) = "y").
IF mssselBestRowidIdx THEN  ASSIGN msschoiceSchema = INTEGER(ENTRY(5,user_env[36])).

FIND FIRST DICTDB._File WHERE RECID(DICTDB._File) = itbl_recid. 
IF NOT CAN-FIND(FIRST s_ttb_tbl WHERE s_ttb_tbl.tmp_recid = itbl_recid)
THEN DO:
   CREATE s_ttb_tbl.
       assign s_ttb_tbl.tmp_recid = itbl_recid
              s_ttb_tbl.pro_name =  DICTDB._File._File-Name
              s_ttb_tbl.pk_idx_recid = DICTDB._File._Prime-index.    
END. 
ELSE FIND FIRST s_ttb_tbl WHERE s_ttb_tbl.tmp_recid = itbl_recid.

  /* Check if User will have PROGRESS_RECID as ROWID, if no indexes */  
  IF compatible AND (mssOptRowid NE "U") AND 
     NOT CAN-FIND(FIRST DICTDB._index WHERE DICTDB._index._file-recid = s_ttb_tbl.tmp_recid AND
                        DICTDB._Index._Index-name <> "default" AND
                        DICTDB._Index._Wordidx <> 1 ) THEN
     ASSIGN RecidAsRowid = TRUE.
  /* Add index/field details to temp tables relevant for ranking purposes */
_idxloop:
  FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = s_ttb_tbl.tmp_recid AND
                                    DICTDB._Index._Index-name <> "default" AND
                                    DICTDB._Index._Wordidx <> 1 :

      UPDATE DICTDB._INDEX._I-misc2[1] = ?. /* Clean-up previous existing data */

      IF NOT CAN-FIND(FIRST s_ttb_idx WHERE s_ttb_idx.idx_recid = RECID(DICTDB._INDEX) AND
                                      s_ttb_idx.ttb_tbl = DICTDB._index._file-recid )
      THEN DO:
         CREATE s_ttb_idx.
                assign s_ttb_idx.idx_recid = RECID(DICTDB._INDEX)
                       s_ttb_idx.pro_idx#  = DICTDB._index._Idx-num
                       s_ttb_idx.pro_uniq = DICTDB._index._Unique
                       s_ttb_idx.pro_uniq_bkp = DICTDB._index._Unique
                       s_ttb_idx.ds_uniq  = DICTDB._index._Unique
                       s_ttb_idx.ttb_tbl  = DICTDB._index._file-recid
                       s_ttb_idx.pro_name = DICTDB._index._Index-name
                       s_ttb_idx.ds_idx_typ = 2.
         IF (RECID (DICTDB._Index) = s_ttb_tbl.pk_idx_recid ) THEN 
                assign s_ttb_idx.pro_prim = TRUE.  
      END.
      ELSE FIND FIRST s_ttb_idx WHERE s_ttb_idx.idx_recid = RECID(DICTDB._INDEX) AND
                                      s_ttb_idx.ttb_tbl = DICTDB._index._file-recid. 
      IF migConstraint AND CAN-FIND(FIRST DICTDB._Constraint 
              WHERE DICTDB._Constraint._Index-Recid = s_ttb_idx.idx_recid  AND
                    DICTDB._Constraint._Con-Active = TRUE AND 
                   (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC" OR
                    DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "M" )
         ) THEN ASSIGN s_ttb_idx.ds_idx_typ = 1.
      ELSE ASSIGN s_ttb_idx.ds_idx_typ = 2.
      for each DICTDB._Index-field 
          where DICTDB._Index-field._index-recid = s_ttb_idx.idx_recid:

            IF NOT CAN-FIND(FIRST s_ttb_idf WHERE s_ttb_idf.ttb_idx = s_ttb_idx.idx_recid 
                                              AND s_ttb_idf.ttb_fld = DICTDB._Index-field._Field-recid) 
            THEN DO:
              CREATE s_ttb_idf.
                   assign s_ttb_idf.ttb_idx = s_ttb_idx.idx_recid
                           s_ttb_idf.ttb_fld = DICTDB._Index-field._Field-recid
                           s_ttb_idf.pro_order = DICTDB._Index-field._Index-Seq.
            END.
            IF NOT CAN-FIND(FIRST s_ttb_fld WHERE s_ttb_fld.tmpfld_recid = s_ttb_idf.ttb_fld)
            THEN DO:
              find first DICTDB._Field 
                   where RECID(DICTDB._Field) = s_ttb_idf.ttb_fld.
                 CREATE s_ttb_fld.
                        assign s_ttb_fld.tmpfld_recid = RECID(DICTDB._Field)
                               s_ttb_fld.ds_type  = DICTDB._Field._Data-type
                               s_ttb_fld.pro_type = DICTDB._Field._Data-type
                               s_ttb_fld.pro_mand = DICTDB._Field._Mandatory
                               s_ttb_fld.ds_stoff = DICTDB._Field._Fld-stoff
                               s_ttb_fld.ds_msc23 = DICTDB._Field._Fld-misc2[3]
                               s_ttb_fld.ds_name  = DICTDB._Field._Field-Name.
                 IF UPPER(s_ttb_fld.pro_type) = "INT64" THEN assign s_ttb_fld.ds_type = "BIGINT".
                 RUN calc-fldsize ( OUTPUT s_ttb_fld.fld_size ). 
            END.
         end. /* for each DICTDB._Index-field  */
  end.  /* for each _INDEX */

  keyExist = CAN-FIND(FIRST DICTDB._CONSTRAINT WHERE DICTDB._CONSTRAINT._File-Recid = itbl_recid AND
                            DICTDB._Constraint._Con-Active = TRUE AND
                           (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC" OR
                            DICTDB._Constraint._Con-Type = "MP" )).

  FIND FIRST DICTDB._CONSTRAINT WHERE DICTDB._CONSTRAINT._File-Recid = itbl_recid AND
       DICTDB._Constraint._Con-Active = TRUE AND
       DICTDB._Constraint._Con-Type = "M" NO-ERROR.
  IF AVAILABLE DICTDB._CONSTRAINT THEN DO:
       FIND FIRST s_ttb_idx 
                  WHERE s_ttb_idx.idx_recid = DICTDB._CONSTRAINT._Index-recid AND
                        s_ttb_idx.pro_uniq <> TRUE NO-ERROR.
       IF AVAILABLE s_ttb_idx THEN ASSIGN NonUnikCC = TRUE.
       ELSE ASSIGN keyExist = TRUE.
  END.
  FIND FIRST s_ttb_idx WHERE s_ttb_idx.ttb_tbl = itbl_recid AND 
             s_ttb_idx.pro_prim = TRUE NO-ERROR.
  IF AVAILABLE s_ttb_idx THEN DO:
     IF s_ttb_idx.pro_uniq = TRUE THEN ASSIGN pk_unique = TRUE.
     ELSE ASSIGN pk_unique = FALSE.
  END.

  IF ( migConstraint AND keyExist) THEN 
     ASSIGN keyCreated   = TRUE.
  ELSE IF msstryp AND ( pk_unique OR ( NOT pk_unique AND (compatible AND (mssOptRowid EQ "U")))) THEN DO:
     FIND FIRST s_ttb_idx WHERE s_ttb_idx.ttb_tbl = itbl_recid AND 
                                s_ttb_idx.pro_prim = TRUE NO-ERROR.
     IF AVAILABLE s_ttb_idx AND NOT pk_unique THEN DO:
        ASSIGN s_ttb_idx.pro_uniq_bkp = s_ttb_idx.pro_uniq /* save original */
               s_ttb_idx.pro_uniq = TRUE /* Fake it as Unique */
               s_ttb_idx.ds_idx_typ = 1
               restorReqd = TRUE.
     END.
     ASSIGN keyCreated   = TRUE
            s_ttb_idx.ds_idx_typ = 1.
  END.
  ELSE IF (compatible AND (mssOptRowid NE "U")) THEN 
     ASSIGN RecidAsRowid = TRUE
            keyCreated   = TRUE.

IF RecidAsRowid THEN DO:
   ASSIGN DICTDB._FILE._Fil-misc1[1] = 1  /* assign positive to indicate PROGRESS_RECID as ROWID */
          DICTDB._file._Fil-misc1[2] = ?.
   /* Need for cleanup if PROGRESS_RECID is going to be ROWID selection */
   FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = s_ttb_tbl.tmp_recid AND
                                    DICTDB._Index._Index-name <> "default" AND
                                    DICTDB._Index._Wordidx <> 1 :
      UPDATE DICTDB._INDEX._I-misc2[1] = ?. /* Clean-up previous existing data */
   END.
END.
ELSE DO: 
  ASSIGN DICTDB._FILE._Fil-misc1[1] = -1 /* assign negative to indicate no PROGRESS_RECID ROWID */
         s_tmp_best = 2.
  IF ((NUM-ENTRIES(user_env[42]) >= 2) AND
    UPPER(ENTRY(2,user_env[42])) = "L" ) THEN DO:
      RUN prodict/mss/_clrank.p ( INPUT s_tmp_best,
                                    INPUT s_ttb_tbl.tmp_recid,
                                    INPUT ClustAsROWID).
      FOR EACH s_ttb_idx  where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid:
          FIND FIRST DICTDB._INDEX  where RECID(DICTDB._INDEX) = s_ttb_idx.Idx_recid. 
          UPDATE DICTDB._INDEX._I-misc2[1] = s_ttb_idx.ds_msc21.
      END.
  END.
  ELSE DO:
      ASSIGN parse2 = FALSE. 
      RUN prodict/mss/_cnrank.p (  INPUT s_tmp_best,
                                   INPUT s_ttb_tbl.tmp_recid,
                                   INPUT uniquifyAddon,
                                   INPUT mssrecidCompat,
                                   INPUT mapmssdatetime,
                                   INPUT callerid ). /* 1-progress ranking , 2-pulled SH ranking */


       /* Ranking done BUT Did not get RECID after first pass,
          retry ranking and designation with mandatory indexes by
          uniqifying those mandatory indexes.
        */
          IF mssOptRowid EQ "U" AND NOT mssrecidCompat AND 
             NOT keyCreated AND
             NOT CAN-FIND(FIRST s_ttb_idx where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid
                                   AND s_ttb_idx.hlp_level <= 22)
          THEN RUN Uniquify-Non-UniqIdx-and-retry. 


       FOR EACH s_ttb_idx  where s_ttb_idx.ttb_tbl = s_ttb_tbl.tmp_recid:
          IF parse2 THEN ASSIGN s_ttb_idx.pro_uniq = s_ttb_idx.pro_uniq_bkp. /* restore original */
 
          IF s_ttb_idx.pro_prim AND restorReqd THEN ASSIGN s_ttb_idx.pro_uniq = TRUE.

         /* Update ranking info irrespective of rowid designation */
	  FIND FIRST DICTDB._INDEX  where RECID(DICTDB._INDEX) = s_ttb_idx.Idx_recid. 
	  UPDATE DICTDB._INDEX._I-misc2[1] = s_ttb_idx.ds_msc21.
       END.

       IF (s_ttb_tbl.ds_rowid GT 0 AND                  /* ROWID designated successfully */
              s_ttb_tbl.ds_rowid NE ? ) THEN DO:  
          IF NOT parse2 THEN  /* Check if it was done successfully in 1st attempt(parse) */ 
             ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc +
                                       "First parse successfully identified a ROWID candidate.". 
          ELSE ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc +
                                       "SECOND parse successfully identified a ROWID candidate.". 
       END.
       ELSE DO:            /* Even with 2nd parse could not manage to designate a rowid */
          ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc +
                                       "No eligible ROWID candidate identified.". 
          IF parse2 THEN 
             ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc +
                         "Parse-2 attempted and failed. Possibly table has no indexes " + 
                         "OR table has only non-mandatory indexes.". 
          ELSE DO:
             ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc + "Parse2 not attempted.". 
             IF(mssOptRowid NE "U") THEN
                ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc + 
                              "Try turning ON 'For ROWID Uniqueness' migration option.".
             ASSIGN s_ttb_tbl.rank_desc = s_ttb_tbl.rank_desc + 
                              "Ensure there are MANDATORY field Indexes.". 
          END.
       END.

  END. /* End of ELSE-DO for NEW algo call */

 IF (s_ttb_tbl.ds_rowid > 0 AND s_ttb_tbl.ds_rowid NE ? ) THEN DO: 
   UPDATE DICTDB._file._Fil-misc1[2] = s_ttb_tbl.ds_rowid.
 END. 
 ELSE UPDATE DICTDB._file._Fil-misc1[2] = ?. 

END. /* end of else part of - IF RecidAsRowid */

Assign RankDesc = s_ttb_tbl.rank_desc.
DELETE s_ttb_tbl. 
/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/odb/_beauty.p

Description:
    wrapper to odb/_odb_fix.p, which fix-up a SI to match an original
    PROGRESS-DB
    

Input-Parameters:
    none

Output-Parameters:
    none
    
History:
    96/06   hutegger    created

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/odb/odbvar.i NEW }
{ prodict/gate/beauty.i
  &edb-type = "ODBC"
  }

/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* ODBC stored procedures definitions 

  History:  DLM 01/28/98 Added files to handle procedures
            DLM 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
  
*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "SQLTables" NO-ERROR.
IF AVAILABLE _File THEN DO:
  find _db where RECID(_Db) = dbkey NO-LOCK.
  MESSAGE "Meta schema definitions for" _db-name "already exists.".
  RETURN.
END. 


CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLTables"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLTables"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 
/* Stored procedure for SQLTables ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLTables_buffer"
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLTables_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Remark"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 5
  _Field._For-name     = "Type"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for SQLColumns ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLColumns"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLColumns"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for SQLColumns ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLColumns_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLColumns_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Data-type"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 5
  _Field._For-name     = "Data-type"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 60   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 6
  _Field._For-name     = "Type-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Precision"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "9999999999"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 7
  _Field._For-name     = "Precision"
  _Field._For-type     = "integer".


CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Length"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 80
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 8
  _Field._For-name     = "Length"
  _Field._For-type     = "integer".  
 
 
CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Scale"  
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 90
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 9
  _Field._For-name     = "Scale"
  _Field._For-type     = "smallint".
 
   
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Radix"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 100 
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 10 
  _Field._For-name     = "Radix"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "Nullable" 
  _Field._Data-Type    = "integer" 
  _Field._Initial      = "0"    
  _Field._Mandatory    = yes 
  _Field._Format       = "99999" 
  _Field._Order        = 110 
  _Field._Fld-stdtype  = 32 
  _Field._Fld-stoff    = 11 
  _Field._For-name     = "Nullable" 
  _Field._For-type     = "smallint". 


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Remarks"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 120 
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 12 
  _Field._For-name     = "Remarks"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".


/* Stored procedure for SQLStatistics ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey 
  _File._File-name    = "SQLStatistics"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLStatistics"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for SQLStatistics ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SQLStatistics_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SQLStatistics_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Owner"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "Owner"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 3
  _Field._For-name     = "Name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "non-unique"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 40 
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 4
  _Field._For-name     = "non-unique"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "index-qualifier"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 50   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 5
  _Field._For-name     = "index-qualifier"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "index-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""   
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 60   
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 6
  _Field._For-name     = "index-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".  

 
CREATE _Field. /* file: col$ */ 
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Type" 
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "99999"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 32
  _Field._Fld-stoff    = 7
  _Field._For-name     = "Type"
  _Field._For-type     = "smallint".

  
CREATE _Field. /* file: col$ */  
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "seq-in-index" 
  _Field._Data-Type    = "integer" 
  _Field._Initial      = "0" 
  _Field._Mandatory    = yes 
  _Field._Format       = "99999" 
  _Field._Order        = 80  
  _Field._Fld-stdtype  = 32 
  _Field._Fld-stoff    = 8 
  _Field._For-name     = "seq-in-index"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Column-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 90 
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 9 
  _Field._For-name     = "Column-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

 
CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "collation"
  _Field._Data-Type    = "character" 
  _Field._Initial      = "" 
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 100 
  _Field._Fld-stdtype  = 36 
  _Field._Fld-stoff    = 10 
  _Field._For-name     = "collation" 
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".    
 
 
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Cardnality"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "9999999999"
  _Field._Order        = 110 
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 11 
  _Field._For-name     = "Cardnality"
  _Field._For-type     = "integer".


CREATE _Field. /* file: col$ */  
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Pages"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 120 
  _Field._Fld-stdtype  = 33 
  _Field._Fld-stoff    = 12 
  _Field._For-name     = "Pages"
  _Field._For-type     = "integer".  

/* Stored procedure for GetInfo ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetInfo"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetInfo"
  _File._For-Owner    = "".
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "unused"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 1
  _Field._For-name     = "unused"
  _Field._For-type     = "integer".

CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetInfo_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetInfo_buffer"
  _File._For-Owner    = "".
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "escape_char"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "escape_char"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "driver_name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "driver_name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "driver_version" 
  _Field._Data-Type    = "character" 
  _Field._Initial      = "" 
  _Field._Mandatory    = yes 
  _Field._Format       = "x(32)" 
  _Field._Order        = 30  
  _Field._Fld-stdtype  = 36 
  _Field._Fld-stoff    = 3 
  _Field._For-name     = "driver_version" 
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".    

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "dbms_version"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 4
  _Field._For-name     = "dbms_version"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "odbc_version"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 5
  _Field._For-name     = "odbc_version"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "dbms_name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 6
  _Field._For-name     = "dbms_name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "prgrs_srvr_version"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(32)"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 7
  _Field._For-name     = "prgrs_srvr_version"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

 
CREATE _Field. /* file: col$ */ 
ASSIGN 
  _Field._File-recid   = RECID(_File) 
  _Field._Field-Name   = "prgrs_clnt_version"
  _Field._Data-Type    = "character"  
  _Field._Initial      = ""    
  _Field._Mandatory    = yes 
  _Field._Format       = "x(32)" 
  _Field._Order        = 80    
  _Field._Fld-stdtype  = 36 
  _Field._Fld-stoff    = 8 
  _Field._For-name     = "prgrs_clnt_version" 
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".   
   
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "quote_char"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 90
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 9
  _Field._For-name     = "quote_char"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

  
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "do_extents"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(1)"
  _Field._Order        = 100
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 10 
  _Field._For-name     = "do_extents"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

 
/* Stored procedure for GetFieldIds ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetFieldIds"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetFieldIds"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "logical-file-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "logical-file-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "file-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 2
  _Field._For-name     = "file-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "file-num"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 3
  _Field._For-name     = "file-num"
  _Field._For-type     = "integer".

 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "spcl-len"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 4 
  _Field._For-name     = "spcl-len"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "user-len"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 5 
  _Field._For-name     = "user-len"
  _Field._For-type     = "smallint".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "table-len"
  _Field._Data-Type    = "integer"
  _Field._Initial      = "0"
  _Field._Mandatory    = yes
  _Field._Format       = "999999999"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 33
  _Field._Fld-stoff    = 6 
  _Field._For-name     = "table-len"
  _Field._For-type     = "smallint".

/* Stored procedure for GetFieldIds ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "GetFieldIds_buffer"
  _File._ianum        = 6
  _File._For-type     = "buffer"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "GetFieldIds_buffer"
  _File._For-Owner    = "".


CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "field-name"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "field-name"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".

/* Stored procedure for sending an info string to PROGRESS. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SendInfo"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "SendInfo"
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "info"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "info"
  _Field._Fld-misc1[1] = 500
  _Field._For-type     = "char".
 

/* Stored procedure for CloseAllProcs ODBC call. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "CloseAllProcs"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE
  _File._For-name     = "CloseAllProcs"
  _File._For-Owner    = "".

/* Generic Stored procedures buffer.					  */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "PROC-TEXT-BUFFER"
  _File._ianum        = 6
  _File._For-type     = "GENERIC-BUFFER"
  _File._For-name     = "NONAME"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE.
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "proc-text"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "NONAME"
  _Field._For-type     = "char".

/* Dummy Stored procedures SQL pass thru. 				*/
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SEND-SQL-STATEMENT"
  _File._ianum        = 6
  _File._For-type     = "PROCEDURE"
  _File._For-name     = "SEND-SQL-STATEMENT"
  _File._Last-change  = 2146431
  _File._Hidden       = TRUE.
 
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "sql-statement"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 36
  _Field._Fld-stoff    = 1
  _Field._For-name     = "sql-statement"
  _Field._For-type     = "char".

/*
   The following _file and _field records are for support of stored
   procedures in ODBC
*/
   
CREATE _File.
ASSIGN _File._Db-recid = dbkey
       _File._File-name = "SQLProcs_buffer"
       _File._ianum     = 6
       _File._For-type = "buffer"          /* FOREIGN-TYPE */
       _File._For-name = "SQLProcs_buffer" /* FOREIGN-NAME */
       _File._Hidden = yes
       _File._Dump-name = "SQLProcs1"      /* DUMP-NAME */
       _File._For-owner = ""               /* FOREIGN-OWNER */
       _File._Fil-misc1[1] = ?             /* PROGRESS-RECID */
       _File._Fil-misc1[3] = ?             /* INDEX-FREE-FLD */
       _File._Fil-misc2[4] = ? .           /* FLD-NAMES-LIST */
       
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes             /* MANDATORY */
       _Field._Format = "x(76)"            /* FORMAT */
       _Field._Order = 10                  /* ORDER */
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1               /* FOREIGN-POS */
       _Field._For-name = "Qualifier"      /* FOREIGN-NAME */
       _Field._For-type = "char"           /* FOREIGN-TYPE */
       _Field._Fld-misc1[1] = 500          /* DSRVR-PRECISION */
       _Field._Fld-misc1[2] = ?            /* DSRVR-SCALE */
       _Field._Fld-misc1[3] = ?            /* DSRVR-LENGTH */
       _Field._Fld-misc1[4] = ?            /* DSRVR-FLDMISC */
       _Field._Fld-misc2[4] = ?.           /* MISC-PROPERTIES */
       
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "num_input_parms"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 40
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 4
       _Field._For-name = "num_input_parms"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "num_output_parms"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 50
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 5
       _Field._For-name = "num_output_parms"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "num_result_sets"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 60
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 6
       _Field._For-name = "num_result_sets"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Remarks"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 70
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 7
       _Field._For-name = "Remarks"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Procedure_type"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 80
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 8
       _Field._For-name = "Procedure_type"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ?
       _Field._Fld-misc1[2] = ?
       _Field._Fld-misc1[3] = ?
       _Field._Fld-misc1[4] = ?
       _Field._Fld-misc2[4] = ?.


create _File.
assign _File._Db-recid = dbkey
       _File._File-name = "SQLProcCols_buffer"
       _File._ianum     = 6
       _File._For-type = "buffer" 
       _File._For-name = "SQLProcCols_buffer"    
       _File._Hidden = yes
       _File._Dump-name = "SQLProcCols1"   
       _File._For-owner = ""      
       _File._Fil-misc1[1] = ?        
       _File._Fil-misc1[3] = ?      
       _File._Fil-misc2[4] = ?.      
     
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes          
       _Field._Format = "x(76)"    
       _Field._Order = 10       
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1           
       _Field._For-name = "Qualifier"   
       _Field._For-type = "char"    
       _Field._Fld-misc1[1] = 500    
       _Field._Fld-misc1[2] = ?     
       _Field._Fld-misc1[3] = ?     
       _Field._Fld-misc1[4] = ?     
       _Field._Fld-misc2[4] = ?.     
       
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Column-Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 40
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 4
       _Field._For-name = "Column-Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Column-Type"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 50
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 5
       _Field._For-name = "Column-Type"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Data-Type"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 60
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 6
       _Field._For-name = "Data-Type"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Type-Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 70
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 7
       _Field._For-name = "Type-Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Precision"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "999999999"
       _Field._Order = 80
       _Field._Fld-stdtype = 33
       _Field._Fld-stoff = 8
       _Field._For-name = "Precision"
       _Field._For-type = "integer"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Length"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "999999999"
       _Field._Order = 90
       _Field._Fld-stdtype = 33
       _Field._Fld-stoff = 9
       _Field._For-name = "Length"
       _Field._For-type = "integer"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Scale"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 100
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 10
       _Field._For-name = "Scale"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Radix"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 110
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 11
       _Field._For-name = "Radix"
       _Field._For-type = "Smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Nullable"
       _Field._Data-Type = "integer"
       _Field._Mandatory = yes
       _Field._Format = "99999"
       _Field._Order = 120
       _Field._Fld-stdtype = 32
       _Field._Fld-stoff = 12
       _Field._For-name = "Nullable"
       _Field._For-type = "smallint"
       _Field._Fld-misc1[1] = ? 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


create _Field.
assign _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Remarks"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 130
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 13
       _Field._For-name = "Remarks"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.


CREATE _File.
ASSIGN _File._Db-recid = dbkey
       _File._File-name = "SQLProcedures"
       _File._ianum     = 6
       _File._For-type = "PROCEDURE"      
       _File._For-name = "SQLProcedures"  
       _File._Hidden = yes
       _File._Dump-name = "SQLProcedures" 
       _File._For-owner = ""              
       _File._Fil-misc1[1] = ?            
       _File._Fil-misc1[3] = ?            
       _File._Fil-misc2[4] = ?.          
      
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes           
       _Field._Format = "x(76)"          
       _Field._Order = 10              
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1           
       _Field._For-name = "Qualifier"  
       _Field._For-type = "char"        
       _Field._Fld-misc1[1] = 500       
       _Field._Fld-misc1[2] = ?         
       _Field._Fld-misc1[3] = ?         
       _Field._Fld-misc1[4] = ?         
       _Field._Fld-misc2[4] = ?.        
       
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Name"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "Name"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500 
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _File.
ASSIGN _File._Db-recid = dbkey
       _File._File-name = "SQLProcColumns"
       _File._ianum     = 6
       _File._For-type = "PROCEDURE" 
       _File._For-name = "SQLProcColumns"
       _File._Hidden = yes
       _File._Dump-name = "SQLProcColumns"
       _File._For-owner = ""      
       _File._Fil-misc1[1] = ?    
       _File._Fil-misc1[3] = ?    
       _File._Fil-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Qualifier"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 10      
       _Field._Fld-stdtype = 36          
       _Field._Fld-stoff = 1   
       _Field._For-name = "Qualifier" 
       _Field._For-type = "char"     
       _Field._Fld-misc1[1] = 500    
       _Field._Fld-misc1[2] = ?      
       _Field._Fld-misc1[3] = ?      
       _Field._Fld-misc1[4] = ?      
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "Owner"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 20
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 2
       _Field._For-name = "Owner"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.
       
CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "ProcName"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 30
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 3
       _Field._For-name = "ProcName"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

CREATE _Field.
ASSIGN _Field._File-recid = RECID(_File)
       _Field._Field-Name = "ColName"
       _Field._Data-Type = "character"
       _Field._Mandatory = yes
       _Field._Format = "x(76)"
       _Field._Order = 40
       _Field._Fld-stdtype = 36
       _Field._Fld-stoff = 4
       _Field._For-name = "ColName"
       _Field._For-type = "char"
       _Field._Fld-misc1[1] = 500
       _Field._Fld-misc1[2] = ? 
       _Field._Fld-misc1[3] = ? 
       _Field._Fld-misc1[4] = ? 
       _Field._Fld-misc2[4] = ?.

 

RETURN.
/*********************************************************************
* Copyright (C) 2005,2008 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

  History:  D. McMann 07/13/98 Added _Owner to _File finds.
            D. McMann 09/03/98 Added dbrecid to create _sequence.
            D. McMann 09/17/98 Removed default index from being created.
            D. McMann 02/22/99 Added check for files not pushed.
            D. McMann 03/16/99 Remove assignment of _Index._Idx-num
            D. McMann 11/24/99 Fixed to run either from ProToOdb or Adjust
                               Schema option
            D. McMann 04/21/00 Added assignment of user_env 28 and 29 as well
                               as checking for _seq in sequence name.
            D. McMann 08/14/00 Added assignment of index numbers. 20000727013
            D. McMann 07/05/01 Added assignment of _Order to be greater than original
                             Progress database so conflict would not happen.
                             20010703-019
            D.McMann  08/07/02 Added _Owner to FOR EACH on delete loop.
            D. McMann 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
*/  

DEFINE INPUT PARAMETER p_edbtype AS CHARACTER NO-UNDO.

DEFINE VARIABLE sseqn            AS CHARACTER FORMAT "x(60)" NO-UNDO.
DEFINE VARIABLE sfiln            AS CHARACTER NO-UNDO.
DEFINE VARIABLE sfldn            AS CHARACTER NO-UNDO.
DEFINE VARIABLE asfldn           AS CHARACTER NO-UNDO.
DEFINE VARIABLE m21              AS CHARACTER NO-UNDO.
DEFINE VARIABLE sidxn            AS CHARACTER NO-UNDO.
DEFINE VARIABLE ppi              AS CHARACTER NO-UNDO.
DEFINE VARIABLE spi              AS CHARACTER NO-UNDO.
DEFINE VARIABLE cext             AS INTEGER   NO-UNDO.
DEFINE VARIABLE ri               AS INTEGER   NO-UNDO.
DEFINE VARIABLE msg              AS CHARACTER   EXTENT 4 NO-UNDO.
DEFINE VARIABLE max_idx_len      AS INTEGER NO-UNDO.
DEFINE VARIABLE max_id_length    AS INTEGER NO-UNDO.
DEFINE VARIABLE idbtype          AS CHARACTER NO-UNDO.
DEFINE VARIABLE del-cycle        AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_idx-num       AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_files          AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_seqs           AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_views          AS CHARACTER NO-UNDO.
DEFINE VARIABLE maxorder         AS INTEGER   NO-UNDO.
DEFINE VARIABLE prgmaxorder      AS INTEGER   NO-UNDO.
DEFINE VARIABLE a                AS INTEGER   NO-UNDO.

DEFINE BUFFER   a_DICTDB         FOR DICTDB._Field.
DEFINE BUFFER   i_DICTDB        FOR DICTDB._Index.

DEFINE TEMP-TABLE verify-fname NO-UNDO
  FIELD new-name LIKE _Field._Field-name
  INDEX trun-name IS UNIQUE new-name.

DEFINE TEMP-TABLE verify-table NO-UNDO
  FIELD tnew-name LIKE _File._File-name
  INDEX trun-name IS UNIQUE tnew-name.

{ prodict/dictvar.i }
{ prodict/odb/odbvar.i } /* temp */
{ prodict/user/uservar.i }

/* DICTDB is the newly created schema holder.
 * DICTDB2 is the original progress database.
 */

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
FORM
  SKIP(1)
  msg[1] FORMAT "x(25)" LABEL "  File" SKIP
  msg[2] FORMAT "x(25)" LABEL " Field" SKIP
  msg[3] FORMAT "x(25)" LABEL " Index" SKIP
  msg[4] FORMAT "x(25)" LABEL " Component" SKIP
  SKIP(1)
  WITH FRAME odb_fix ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  TITLE " Updating ODBC Schema Holder".
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

IF NOT SESSION:BATCH-MODE  
 then assign SESSION:IMMEDIATE-DISPLAY = yes.

if  user_env[25] = "**all**"
 or user_env[25] = ""
 then assign
  l_files = "**all**"
  l_seqs  = "**all**"
  l_views = "**all**"
  del-cycle = TRUE.
else if  num-entries(user_env[25],";") < 2
 then assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = "**all**"
  l_views = "**all**".
else if  num-entries(user_env[25],";") < 3
 then assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = entry(2,user_env[25],";")
  l_views = "**all**".
 else assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = entry(2,user_env[25],";")
  l_views = entry(3,user_env[25],";").

idbtype = { adecomm/ds_type.i
                &direction = "ETOI"
                &from-type = "p_edbtype"
                }.

IF user_env[28] <> ? THEN
  max_idx_len = INTEGER(user_env[28]).
ELSE
  max_idx_len = 30.  

IF user_env[29] <> ? THEN
  max_id_length = INTEGER(user_env[29]).
ELSE
  max_id_length = 24.

  FOR EACH DICTDB2._View
    where ( l_views = "**all**"
         or lookup(DICTDB2._View._View-Name,l_views) <> 0
          ):
    FIND DICTDB._View WHERE DICTDB._View._View-Name = DICTDB2._View._View-Name NO-ERROR.
    IF AVAILABLE DICTDB._View THEN DO:
      FOR EACH DICTDB._View-col OF DICTDB._View:
          DELETE DICTDB._View-col.
      END.
      FOR EACH DICTDB._View-ref OF DICTDB._View:
          DELETE DICTDB._View-ref.
      END.
      DELETE DICTDB._View.
    END.
    CREATE DICTDB._View.
    ASSIGN DICTDB._View._View-Name    = DICTDB2._View._View-Name
           DICTDB._View._Auth-Id      = DICTDB2._View._Auth-Id
           DICTDB._View._Base-Tables  = DICTDB2._View._Base-Tables
           DICTDB._View._Where-Cls    = DICTDB2._View._Where-Cls
           DICTDB._View._Group-By     = DICTDB2._View._Group-By
           DICTDB._View._View-Def     = DICTDB2._View._View-Def
           DICTDB._View._Can-Read     = DICTDB2._View._Can-Read
           DICTDB._View._Can-Write    = DICTDB2._View._Can-Write
           DICTDB._View._Can-Create   = DICTDB2._View._Can-Create
           DICTDB._View._Can-Delete   = DICTDB2._View._Can-Delete
           DICTDB._View._Desc         = DICTDB2._View._Desc
           DICTDB._View._Updatable    = DICTDB2._View._Updatable.
    FOR EACH DICTDB2._View-Col of DICTDB2._View:    
      CREATE DICTDB._View-Col.
      ASSIGN DICTDB._View-Col._View-Name = DICTDB2._View-Col._View-Name
             DICTDB._View-Col._Auth-Id    = DICTDB2._View-Col._Auth-Id
             DICTDB._View-Col._Col-Name   = DICTDB2._View-Col._Col-Name
             DICTDB._View-Col._Base-Col   = DICTDB2._View-Col._Base-Col
             DICTDB._View-Col._Can-Write  = DICTDB2._View-Col._Can-Write
             DICTDB._View-Col._Can-Create = DICTDB2._View-Col._Can-Create
             DICTDB._View-Col._Vcol-Order = DICTDB2._View-Col._Vcol-Order.
    END. /* DICTDB2._View-Col */

    FOR EACH DICTDB2._View-Ref of DICTDB2._View:    
      CREATE DICTDB._View-Ref.
      ASSIGN DICTDB._View-Ref._View-Name = DICTDB2._View-Ref._View-Name
             DICTDB._View-Ref._Auth-Id   = DICTDB2._View-Ref._Auth-Id
             DICTDB._View-Ref._Ref-Table = DICTDB2._View-Ref._Ref-Table
             DICTDB._View-Ref._Base-Col  = DICTDB2._View-Ref._Base-Col.
    END. /* DICTDB2._View-Ref */
  END. /* each DICTDB2._View */

/* IF (user_env[32] <> ?   and user_env[25] BEGINS "y") THEN*/
FOR EACH DICTDB2._Sequence where ( l_seqs = "**all**"
       or lookup(DICTDB2._Sequence._Seq-Name,l_seqs) <> 0 ):
  ASSIGN sseqn = _Seq-Name
         sseqn = sseqn + "," + p_edbtype + "," + STRING(max_id_length).

  RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sseqn).

  /* _wrktgen.p does not allow _seq to be at the end of the sequence name so we have to do
   the same thing here.
*/   
  IF length(sseqn) > 3 AND lc(SUBSTRING(sseqn, (LENGTH(sseqn) - 3))) = "_seq" THEN
        ASSIGN sseqn = SUBSTRING(sseqn, 1, (LENGTH(sseqn) - 1)).

  FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-LOCK.

  FIND DICTDB._Sequence OF DICTDB._Db WHERE DICTDB._Sequence._Seq-name = sseqn NO-ERROR.

  IF AVAILABLE DICTDB._Seq THEN 
  
  ASSIGN    
    DICTDB._Sequence._Seq-Name = DICTDB2._Sequence._Seq-Name
    DICTDB._Sequence._Seq-Init = DICTDB2._Sequence._Seq-Init
    DICTDB._Sequence._Seq-Incr = DICTDB2._Sequence._Seq-Incr
    DICTDB._Sequence._Seq-Min  = DICTDB2._Sequence._Seq-Min
    DICTDB._Sequence._Seq-Max  = DICTDB2._Sequence._Seq-Max
    DICTDB._Sequence._Cycle-Ok = DICTDB2._Sequence._Cycle-OK.

END. /* each DICTDB2._Sequence */


/* To avoid double dump-names we set them to ? for now, they will be
 * set to dictdb2._File._Dump-name lateron
 */
FOR EACH DICTDB._File WHERE DICTDB._File._DB-recid = drec_db
        and DICTDB._File._Owner = "_FOREIGN"
        and ( l_files = "**all**" or lookup(DICTDB._File._File-name,l_files) <> 0):
  ASSIGN DICTDB._File._Dump-name = ?.
END. /* each DICTDB2._File */


FOR EACH DICTDB2._File WHERE DICTDB2._File._Owner = "PUB" 
                         AND DICTDB2._File._Tbl-type = "T"
                         AND ( l_files = "**all**"
                               or lookup(DICTDB2._File._File-name,l_files) <> 0):

  IF DICTDB2._File._File-name BEGINS "_" THEN NEXT.
  
  ASSIGN sfiln = DICTDB2._File._File-name
         sfiln = sfiln + "," + p_edbtype + "," + string (max_id_length).

  RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sfiln).

  _verify-table:
  DO WHILE TRUE:
    FIND verify-table WHERE verify-table.tnew-name = sfiln NO-ERROR.
    IF NOT AVAILABLE verify-table THEN DO:
      CREATE verify-table.
      ASSIGN verify-table.tnew-name = sfiln.
      LEAVE _verify-table.
    END.
    ELSE DO:
      DO a = 1 TO 999:
        ASSIGN sfiln = SUBSTRING(sfiln, 1, LENGTH(sfiln) - LENGTH(STRING(a))) + STRING(a).

        IF CAN-FIND(verify-table WHERE verify-table.tnew-name = sfiln) THEN NEXT.
        ELSE DO:
          CREATE verify-table.
          ASSIGN verify-table.tnew-name = sfiln.
          LEAVE _verify-table.
        END.
      END.
    END.    
  END.

  FIND DICTDB._File WHERE DICTDB._File._File-name = sfiln 
                      and DICTDB._File._DB-recid = drec_db 
                      and DICTDB._File._Owner = "_FOREIGN" NO-ERROR.

  IF NOT AVAILABLE DICTDB._File THEN NEXT.

  FOR EACH DICTDB._Field OF DICTDB._File WHERE	
    DICTDB._Field._For-Type = "TIME":
   
    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB._File._File-name @ msg[1]
	DICTDB._Field._Field-name @ msg[2]
	"" @ msg[3] "" @ msg[4]
	WITH FRAME odb_fix.
    DELETE DICTDB._Field.

  END. /* each DICTDB._Field */
  
  /* Do first to avoid _order collisions */
  FIND LAST DICTDB._Field OF DICTDB._FILE USE-INDEX _Field-position.
  ASSIGN maxorder = DICTDB._Field._Order.

  /*  OE00218059 */
  FIND LAST DICTDB2._Field OF DICTDB2._FILE USE-INDEX _Field-position.
  ASSIGN prgmaxorder = DICTDB2._Field._Order.

  if maxorder < prgmaxorder then
  assign maxorder = prgmaxorder.

  FOR EACH DICTDB._Field OF DICTDB._File:
    ASSIGN DICTDB._Field._Order = maxorder + 5
           maxorder = maxorder + 5.
  END.

  FOR EACH DICTDB2._File-Trig OF DICTDB2._File:
    FIND DICTDB._File-Trig OF DICTDB._File WHERE   
      DICTDB._File-Trig._Event = DICTDB2._File-Trig._Event NO-ERROR.
    IF AVAILABLE DICTDB._File-Trig THEN 
        DELETE DICTDB._File-Trig.

    CREATE DICTDB._File-Trig.
    ASSIGN DICTDB._File-Trig._File-Recid = RECID(DICTDB._File)
           DICTDB._File-Trig._Event      = DICTDB2._File-Trig._Event
           DICTDB._File-Trig._Proc-Name  = DICTDB2._File-Trig._Proc-Name
           DICTDB._File-Trig._Override   = DICTDB2._File-Trig._Override.

  END. /* each DICTDB2._File-Trig OF DICTDB2._File */

  /* Clear temp table for new file */
  FOR EACH verify-fname:
     DELETE verify-fname.
  END.

  FOR EACH DICTDB2._Field OF DICTDB2._File:
    ASSIGN sfldn = DICTDB2._Field._Field-name.

    /* Avoid collisions with unrolled extents */

    ASSIGN ri = R-INDEX (sfldn, "#").    
    IF ri > 2 AND ri < LENGTH (sfldn) THEN DO:
      IF INDEX ("0123456789", SUBSTR (sfldn, ri + 1, 1)) > 0 THEN DO:
	    ASSIGN asfldn = SUBSTR (sfldn, 1, ri - 1).
	    IF CAN-FIND (DICTDB._Field OF DICTDB._File WHERE
	          DICTDB._Field._Field-name = asfldn) THEN
          OVERLAY (sfldn, ri, 1) = "_".   
      END.
    END.

    ASSIGN sfldn = sfldn + "," + p_edbtype + "," + string (max_id_length).
    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sfldn).

    /* We have to do the same thing we do when running protoodb.
       We need to keep track of the names we come up with, and
       find unique names if the one we just got now is duplicate.*/
    FIND FIRST verify-fname WHERE new-name = sfldn NO-ERROR.

    IF NOT AVAILABLE verify-fname THEN DO:
      CREATE verify-fname.
      ASSIGN verify-fname.new-name = sfldn.
    END.
    ELSE DO:
        DO a = 1 TO 999:
          ASSIGN sfldn = SUBSTRING(sfldn, 1, LENGTH(sfldn) - LENGTH(STRING(a))) + STRING(a).

          IF CAN-FIND(verify-fname WHERE verify-fname.new-name = sfldn) THEN 
              NEXT.
          ELSE DO:
            CREATE verify-fname.
            ASSIGN verify-fname.new-name = sfldn.
            LEAVE. /* get out of the a =1 to 999 loop */
          END.
        END.
    END.

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB2._File._File-name @ msg[1]
        DICTDB2._Field._Field-name @ msg[2]
        "" @ msg[3] "" @ msg[4]
        WITH FRAME odb_fix.

    IF DICTDB2._Field._Extent > 0 AND NOT CAN-FIND (DICTDB._Field OF DICTDB._File 
                WHERE DICTDB._Field._Field-name = sfldn) THEN DO:
      ASSIGN asfldn = sfldn + "#".
      
      FIND a_DICTDB OF DICTDB._File WHERE a_DICTDB._Field-name = asfldn NO-ERROR.
      IF NOT AVAILABLE a_DICTDB THEN NEXT.
      
      ASSIGN m21 = a_DICTDB._For-Name.
      IF R-INDEX (m21, "#") > 3 THEN
	    ASSIGN m21 = SUBSTR (m21, 1, R-INDEX(m21, "#") - 2).

      CREATE DICTDB._Field.
      ASSIGN DICTDB._Field._File-recid      = RECID(DICTDB._File)
	         DICTDB._Field._For-Name        = m21
	         DICTDB._Field._Fld-stdtype     = a_DICTDB._Fld-stdtype
	         DICTDB._Field._Fld-stoff       = a_DICTDB._Fld-stoff
	         DICTDB._Field._Fld-misc2[8]    = a_DICTDB._Fld-misc2[8]
	         DICTDB._Field._Field-name      = DICTDB2._Field._Field-name
	         DICTDB._Field._Fld-case        = DICTDB2._Field._Fld-case
	         DICTDB._Field._Data-type       = DICTDB2._Field._Data-type
	         DICTDB._Field._Format          = DICTDB2._Field._Format
	         DICTDB._Field._Initial         = DICTDB2._Field._Initial
	         DICTDB._Field._Mandatory       = DICTDB2._Field._Mandatory
	         DICTDB._Field._Decimals        = DICTDB2._Field._Decimals
	         DICTDB._Field._Order           = DICTDB2._Field._Order
	         DICTDB._Field._Desc            = DICTDB2._Field._Desc
	         DICTDB._Field._Can-Read        = DICTDB2._Field._Can-Read
	         DICTDB._Field._Can-Write       = DICTDB2._Field._Can-Write
	         DICTDB._Field._Label           = DICTDB2._Field._Label
	         DICTDB._Field._Col-label       = DICTDB2._Field._Col-label
	         DICTDB._Field._Valexp          = DICTDB2._Field._Valexp
	         DICTDB._Field._Valmsg          = DICTDB2._Field._Valmsg
	         DICTDB._Field._Help            = DICTDB2._Field._Help
             DICTDB._Field._Col-label-sa    = DICTDB2._Field._Col-label-sa
             DICTDB._Field._Format-sa       = DICTDB2._Field._Format-sa
             DICTDB._Field._Help-sa         = DICTDB2._Field._Help-sa
             DICTDB._Field._Initial-sa      = DICTDB2._Field._Initial-sa
             DICTDB._Field._Label-sa        = DICTDB2._Field._Label-sa
             DICTDB._Field._Valmsg-sa       = DICTDB2._Field._Valmsg-sa
	         DICTDB._Field._For-Id          = a_DICTDB._For-Id
	         DICTDB._Field._For-Primary     = a_DICTDB._For-Primary
	         DICTDB._Field._For-Spacing     = a_DICTDB._For-Spacing
	         DICTDB._Field._For-Scale       = a_DICTDB._For-Spacing
	         DICTDB._Field._For-Type        = a_DICTDB._For-Type
	         DICTDB._Field._For-Itype       = a_DICTDB._For-Itype
	         DICTDB._Field._For-Xpos        = a_DICTDB._For-Xpos
	         DICTDB._Field._For-Retrieve    = a_DICTDB._For-Retrieve
	         DICTDB._Field._For-Separator   = a_DICTDB._For-Separator
	         DICTDB._Field._For-Maxsize     = a_DICTDB._For-Maxsize
	         DICTDB._Field._For-Allocated   = a_DICTDB._For-Allocated
	         DICTDB._Field._View-As         = DICTDB2._Field._View-As
	         DICTDB._Field._Extent          = DICTDB2._Field._Extent.

      IF DICTDB._Field._Data-type = "RECID" THEN
          DICTDB._Field._Data-type = "INTEGER".

	  DO cext = 1 TO DICTDB._Field._Extent:
	    ASSIGN asfldn = sfldn + "#" + STRING (cext).

	    FIND a_DICTDB OF DICTDB._File WHERE a_DICTDB._Field-name = asfldn NO-ERROR.

	    IF AVAILABLE a_DICTDB THEN
	      DELETE a_DICTDB.

	  END. /* DICTDB._Field._Extent > 1 DO cext = 1 TO ... */
    END. /* DICTDB2._Field._Extent > 0 */
    ELSE DO: /* !  DICTDB2._Field._Extent > 0 */

      FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = sfldn NO-ERROR.
      IF NOT AVAILABLE DICTDB._Field THEN NEXT.
    END. /* !  DICTDB2._Field._Extent > 0 */

    ASSIGN  DICTDB._Field._Field-name   = DICTDB2._Field._Field-name
            DICTDB._Field._Fld-case     = DICTDB2._Field._Fld-case
            DICTDB._Field._Data-type    = DICTDB2._Field._Data-type
            DICTDB._Field._Format       = DICTDB2._Field._Format
            DICTDB._Field._Initial      = DICTDB2._Field._Initial
            DICTDB._Field._Mandatory    = DICTDB2._Field._Mandatory
            DICTDB._Field._Decimals     = DICTDB2._Field._Decimals
            DICTDB._Field._Order        = DICTDB2._Field._Order
            DICTDB._Field._Desc         = DICTDB2._Field._Desc
            DICTDB._Field._Can-Read     = DICTDB2._Field._Can-Read
            DICTDB._Field._Can-Write    = DICTDB2._Field._Can-Write
            DICTDB._Field._Label        = DICTDB2._Field._Label
            DICTDB._Field._Col-label    = DICTDB2._Field._Col-label
            DICTDB._Field._Valexp       = DICTDB2._Field._Valexp
            DICTDB._Field._Valmsg       = DICTDB2._Field._Valmsg
            DICTDB._Field._Col-label-sa = DICTDB2._Field._Col-label-sa
            DICTDB._Field._Format-sa    = DICTDB2._Field._Format-sa
            DICTDB._Field._Help-sa      = DICTDB2._Field._Help-sa
            DICTDB._Field._Initial-sa   = DICTDB2._Field._Initial-sa
            DICTDB._Field._Label-sa     = DICTDB2._Field._Label-sa
            DICTDB._Field._Valmsg-sa    = DICTDB2._Field._Valmsg-sa
            DICTDB._Field._View-As      = DICTDB2._Field._View-As
            DICTDB._Field._Help         = DICTDB2._Field._Help.

    IF DICTDB._Field._Data-type = "RECID" THEN
       DICTDB._Field._Data-type = "INTEGER".

 /*------------------------------------------------------------------*/
/*------------------------  FIELD-TRIGGERS  ------------------------*/
/*------------------------------------------------------------------*/

    FOR EACH DICTDB2._Field-Trig OF DICTDB2._Field:
      FIND DICTDB._Field-Trig OF DICTDB._Field WHERE
        DICTDB._Field-Trig._Event = DICTDB2._Field-Trig._Event NO-ERROR.
      IF AVAILABLE DICTDB._Field-Trig THEN 
          DELETE DICTDB._Field-Trig.

      CREATE DICTDB._Field-Trig.
      ASSIGN
          DICTDB._Field-Trig._Field-Recid = RECID (DICTDB._Field)
          DICTDB._Field-Trig._File-Recid  = RECID (DICTDB._File)
          DICTDB._Field-Trig._Event       = DICTDB2._Field-Trig._Event
          DICTDB._Field-Trig._Proc-Name   = DICTDB2._Field-Trig._Proc-Name
          DICTDB._Field-Trig._Override    = DICTDB2._Field-Trig._Override.
    END. /* each DICTDB2._Field-Trig OF DICTDB2._Field */
  END. /* each DICTDB2._Field OF DICTDB2._File */

  /*------------------------------------------------------------------*/
/*---------------------------  INDEXES  ----------------------------*/
/*------------------------------------------------------------------*/

  /* we first need to give the indexes a higher number, so that we then
   * can safely assign the number from the original db. Otherwise we run
   * the problem of assigning the same number to two different indexes
   */
  assign l_idx-num = 0.
  for each DICTDB._Index of DICTDB._File:
    if l_idx-num < DICTDB._Index._idx-num
     then assign l_idx-num = DICTDB._Index._idx-num.
  END.

  _idxloop:
  FOR EACH DICTDB2._Index OF DICTDB2._File:
    IF DICTDB2._Index._Wordidx = 1  OR DICTDB2._Index._Index-name = "default"
        THEN NEXT _idxloop.

    ASSIGN sidxn = DICTDB2._Index._Index-Name.

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB2._File._File-name @ msg[1] "" @ msg[2]
         DICTDB2._Index._Index-Name @ msg[3] "" @ msg[4]
         WITH FRAME odb_fix.

    ASSIGN sidxn = sidxn + "," + p_edbtype + "," + string (max_idx_len).
    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT sidxn).

    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = sidxn
      NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._For-Name = sidxn
      NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = DICTDB2._index._Index-name NO-ERROR.

    IF NOT AVAILABLE DICTDB._Index THEN DO:
      CREATE DICTDB._Index.
      ASSIGN
        l_idx-num                   = l_idx-num + 1
        DICTDB._Index._File-recid   = RECID (DICTDB._File)
        DICTDB._Index._Wordidx      = DICTDB2._Index._Wordidx
        DICTDB._Index._Desc         = DICTDB2._Index._Desc
        DICTDB._Index._For-Name     = sidxn
        DICTDB._Index._For-type     = DICTDB2._Index._For-type
        DICTDB._Index._Index-name   = DICTDB2._Index._Index-Name
        DICTDB._Index._Active       = DICTDB2._Index._Active
        DICTDB._Index._idx-num      = l_idx-num
        DICTDB._Index._Unique       = DICTDB2._Index._Unique.
    END. /* NOT AVAILABLE DICTDB._Index */
    ELSE DO: /* AVAILABLE DICTDB._Index */
      ASSIGN
        DICTDB._Index._Desc         = DICTDB2._Index._Desc
	    DICTDB._Index._Index-name   = DICTDB2._Index._Index-name.
    END. /* AVAILABLE DICTDB._Index */

    FOR EACH DICTDB2._Index-field OF DICTDB2._Index:

      FIND DICTDB2._Field WHERE RECID(DICTDB2._Field) = 
	       DICTDB2._Index-field._Field-recid NO-ERROR.
      IF NOT AVAILABLE DICTDB2._Field THEN NEXT.     

      IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
        DISPLAY  DICTDB2._File._File-name @ msg[1] "" @ msg[2]
	             DICTDB2._Index._Index-Name @ msg[3]
                 DICTDB2._Field._Field-name @ msg[4]
	         WITH FRAME odb_fix.

      ASSIGN sfldn = DICTDB2._Field._Field-name.

      FIND DICTDB._Field WHERE DICTDB._Field._File-recid = RECID (DICTDB._File) 
                           AND DICTDB._Field._Field-name = sfldn NO-ERROR.
      IF NOT AVAILABLE DICTDB._Field THEN NEXT.

      FIND DICTDB._Index-field OF DICTDB._Index WHERE DICTDB._Index-field._Index-seq = DICTDB2._Index-field._Index-seq NO-ERROR.
      IF NOT AVAILABLE DICTDB._Index-field THEN DO:
	    CREATE DICTDB._Index-field.
	    ASSIGN DICTDB._Index-field._Index-recid = RECID (DICTDB._Index)
	           DICTDB._Index-field._Field-recid = RECID (DICTDB._Field)
	           DICTDB._Index-field._Index-seq   = DICTDB2._Index-field._Index-seq
	           DICTDB._Index-field._Ascending   = DICTDB2._Index-field._Ascending
	           DICTDB._Index-field._Abbreviate  = DICTDB2._Index-field._Abbreviate
	           DICTDB._Index-field._Unsorted    = DICTDB2._Index-field._Unsorted.
      END. /* NOT avaiable DICTDB._Index-field */
      ELSE DO: /* avaiable DICTDB._Index-field */
	    ASSIGN DICTDB._Index-field._Ascending   = DICTDB2._Index-field._Ascending
               DICTDB._Index-field._Abbreviate  = DICTDB2._Index-field._Abbreviate.
      END. /* avaiable DICTDB._Index-field */
    END. /* each DICTDB2._Index-field */
  END. /* each DICTDB2._Index OF DICTDB2._File */

	/* Remove any extra indexes from the schema holder */
  _rmvidx:
  FOR EACH DICTDB._Index OF DICTDB._File:
    ASSIGN sidxn = DICTDB._Index._Index-Name.
    IF sidxn = "default_" THEN NEXT.

    IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
      DISPLAY  DICTDB._File._File-name @ msg[1] "" @ msg[2]
               DICTDB._Index._Index-Name @ msg[3] "" @ msg[4]
               WITH FRAME odb_fix.

    FIND DICTDB2._Index OF DICTDB2._File WHERE  DICTDB2._Index._Index-Name = DICTDB._Index._Index-Name NO-ERROR.
    IF AVAILABLE DICTDB2._Index THEN NEXT.
    IF RECID(DICTDB._Index) = DICTDB._File._Prime-index THEN DO:
      FIND FIRST i_dictdb WHERE RECID(i_dictdb) <> RECID(DICTDB._Index)
                             AND i_dictdb._File-recid = RECID(DICTDB._File)
                             AND i_dictdb._Unique NO-ERROR.
      IF AVAILABLE i_dictdb THEN 
        ASSIGN DICTDB._File._Prime-index = RECID(i_dictdb).
      ELSE DO:
        FIND FIRST i_dictdb WHERE RECID(i_dictdb) <> RECID(DICTDB._Index)
                              AND i_dictdb._File-recid = RECID(DICTDB._File)
                              NO-ERROR.
        IF AVAILABLE i_dictdb THEN
          ASSIGN DICTDB._File._Prime-index = RECID(i_dictdb).
        ELSE NEXT _rmvidx.
      END.
    END.
    FOR EACH DICTDB._Index-field OF DICTDB._Index:
      DELETE DICTDB._Index-field.
    END. /* DICTDB._Index-field OF DICTDB._Index */

    DELETE DICTDB._Index.

  END. /* DICTDB._Index OF DICTDB._File */

	/* Set the primary index */

  FIND DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._File._Prime-Index
      NO-ERROR.
  IF AVAILABLE DICTDB._Index THEN
    ASSIGN spi = DICTDB._Index._Index-Name.
  ELSE
    ASSIGN spi = ?.

  FIND DICTDB2._Index WHERE RECID(DICTDB2._Index) = DICTDB2._File._Prime-Index
     NO-ERROR.
  IF AVAILABLE DICTDB2._Index THEN
    ASSIGN ppi = DICTDB2._Index._Index-Name.
  ELSE
    ASSIGN ppi = ?.

  IF spi <> ppi AND ppi <> ? THEN DO:
    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = ppi NO-ERROR.
    IF AVAILABLE DICTDB._Index THEN 
      DICTDB._File._Prime-Index= RECID(DICTDB._Index).      
  END. /* spi <> ppi AND ppi <> ? */

  IF TERMINAL <> "" and NOT SESSION:BATCH-MODE THEN
    DISPLAY DICTDB2._File._File-name @ msg[1] "" @ msg[2] "" @ msg[3] 
        "" @ msg[4]
        WITH FRAME odb_fix.
  /* Do this last since it may set _File._Frozen. */

  ASSIGN DICTDB._File._File-name     = DICTDB2._File._File-name
         DICTDB._File._Can-Create    = DICTDB2._File._Can-Create
         DICTDB._File._Can-Read      = DICTDB2._File._Can-Read
         DICTDB._File._Can-Write     = DICTDB2._File._Can-Write
         DICTDB._File._Can-Delete    = DICTDB2._File._Can-Delete
         DICTDB._File._Desc          = DICTDB2._File._Desc
         DICTDB._File._Valexp        = DICTDB2._File._Valexp
         DICTDB._File._Valmsg        = DICTDB2._File._Valmsg
         DICTDB._File._File-Label    = DICTDB2._File._File-Label
         DICTDB._File._File-Label-sa = DICTDB2._File._File-Label-sa
         DICTDB._File._Valmsg-sa     = DICTDB2._File._Valmsg-sa
         DICTDB._File._Dump-name     = DICTDB2._File._Dump-name.

  ASSIGN DICTDB._File._Frozen        = DICTDB2._File._Frozen.
END. /* each DICTDB2._File */

/* Now check DICTDB._File to make sure we get only those we pushed */
IF del-cycle THEN DO:
  FOR EACH DICTDB._File WHERE DICTDB._File._Tbl-type = "T"
                          AND DICTDB._File._Owner = "_Foreign":
    IF DICTDB._File._Hidden THEN NEXT.
    FIND DICTDB2._File WHERE DICTDB2._File._File-name = DICTDB._File._File-name 
                         AND DICTDB2._File._Owner = "PUB" NO-ERROR.
    IF NOT AVAILABLE DICTDB2._File THEN DO:
      FOR EACH DICTDB._INDEX OF DICTDB._File:
        FOR EACH DICTDB._Index-field of DICTDB._Index:
          DELETE DICTDB._Index-field.
        END.
        DELETE DICTDB._Index.
      END.
      FOR EACH DICTDB._Field OF DICTDB._File:
        DELETE DICTDB._Field.
      END.
      DELETE DICTDB._File.
    END.
  END.  
  FOR EACH DICTDB._Sequence:
    FIND DICTDB2._Sequence WHERE DICTDB2._Sequence._Seq-name = DICTDB._Sequence._Seq-name NO-ERROR.
    IF NOT AVAILABLE DICTDB2._Sequence THEN
       DELETE DICTDB._Sequence.
  END.    
END.

IF NOT SESSION:BATCH-MODE THEN 
    HIDE FRAME odb_fix NO-PAUSE.

IF NOT SESSION:BATCH-MODE  
 then assign SESSION:IMMEDIATE-DISPLAY = no.

RETURN.









/***********************************************************************
* Copyright (C) 2000,2006-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* odb_fld - field editor for Odbc files */

/*
dfields is NOT AVAILABLE to create, otherwise contains record to
UPDATE (you ain't spoz'ta CREATE with ODBC files).

When you come into this routine, the field name is already set on the
form.

  _File._For-name      = Foreign file name
  _File._For-owner     = Foreign file owner
  _File._For-type      = Foreign file type (TABLE, VIEW, STABLE).
  _Field._Fld-stoff    = Field relative position in record.
  _Field._Fld-stdtype  = Foreign field datatype.
  _Field._For-name     = Foreign field name.
  _Field._For-retrieve  = ? or 0 if field should be retrieved from Odbc,
                         1 if not (large objects ...)
  _Field._For-type     = Foreign field datatype name.
  _Index._For-name     = Foreign index name.

  -----Odbc-----  ---Progress--- (detailed, up-to-date list see
  Data Type  dtype  Data Type                              _odb_typ.p)
  --------- ------  ---------
  CHAR       35	    CHAR
  NUMERIC    136    DECIMAL
  DECIMAL    236    DECIMAL
  INTEGER    33     INTEGER
  SMALLINT   32     INTEGER
  FLOAT      34     DECIMAL
  REAL       48     DECIMAL
  DOUBLE     134    DECIMAL
  VARCHAR    36     CHAR
  DATE       43     DATE
  TIME      143     CHAR
  TIMESTAMP  44     CHAR
  LONGVARCHAR 37    CHAR
  VARBINARY  39     CHAR
  BINARY     38     CHAR
  LONGVARBINARY 40  CHAR
  BIGINT     234    DECIMAL
  TINYINT    31     INTEGER
  BIT        41     LOGICAL
HISTORY:
    96/04   hutegger    restricted update of _fld-stoff to only BUFFERs 
                        that got created on the PROGRES side
    02/14/08 fernando Support for datetime
    08/25/08 fernando Adjusting format of _Initial - OE00168292
    03/24/09 fernando Datetime-tz support for MSS
    04/15/09 fernando BLOB support for MSS
    06/09/10 sgarg    CLOB support for MSS
!!!!!!!NOTE: this program is not yet suitable for adding fields!!!!!!!!

*/

DEFINE INPUT  PARAMETER ronly   AS CHARACTER             NO-UNDO.
DEFINE INPUT  PARAMETER junk2   AS RECID                 NO-UNDO.
DEFINE OUTPUT PARAMETER changed AS LOGICAL INITIAL FALSE NO-UNDO.

DEFINE SHARED BUFFER dfields FOR DICTDB._Field.
DEFINE VARIABLE answer          AS LOGICAL               NO-UNDO.
DEFINE VARIABLE c               AS CHARACTER             NO-UNDO.
DEFINE VARIABLE edbtyp          AS CHARACTER NO-UNDO. /* db-type external format */
DEFINE VARIABLE edbtyp1         AS CHARACTER NO-UNDO. /* label name */
DEFINE VARIABLE edbtyp2         AS CHARACTER NO-UNDO. /* label type */
DEFINE VARIABLE gat_typ         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE i               AS INTEGER               NO-UNDO.
DEFINE VARIABLE inindex         AS LOGICAL               NO-UNDO.
DEFINE VARIABLE inview          AS LOGICAL               NO-UNDO.
DEFINE VARIABLE j               AS INTEGER               NO-UNDO.
define variable l_dt-new        as character             NO-UNDO.
define variable l_dt-old        as character             NO-UNDO.
define variable l_for-type      as character             no-undo.
define variable l_format        as character             NO-UNDO.
define variable l_init          as character             NO-UNDO.
define variable l_length        as integer               NO-UNDO.
define variable l_lcl-bffr      as logical               NO-UNDO.
DEFINE VARIABLE odb_type        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE odb_type_ix     AS INTEGER               NO-UNDO.
DEFINE VARIABLE pro_format      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE pro_type        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE retriev         AS LOGICAL               NO-UNDO.
DEFINE VARIABLE islob           AS LOGICAL               NO-UNDO.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 10 NO-UNDO INITIAL [
  /* 1*/ "This field is used in a View or Index - cannot delete.",
  /* 2*/ "This field is used in a View - cannot rename.",
  /* 3*/ "Are you sure that you want to delete the field named",
  /* 4*/ "Cannot create &1 fields.  Must create on &1 side and",
  /* 5*/ "use ~"Update &1 definition~" to bring definition over.",
  /* 6*/ "You must enter a field name here.", /* reserved */
  /* 7*/ "This is not an equivalent {&PRO_DISPLAY_NAME} datatype for the &1 datatype",
  /* 8*/ "Attempt to add with same name as existing field -switching to MODIFY",
  /* 9*/ "Invalid &1 datatype.",
  /*10*/ "Offset allready used by other field."
].

FORM
  dfields._Field-name   LABEL "  Field-Name" FORMAT "x(32)"
    VALIDATE(KEYWORD(dfields._Field-name) = ?,
      "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SPACE
  dfields._Data-type    LABEL    "Data-Type" FORMAT "x(11)"  SKIP

  edbtyp1            NO-LABEL AT  2          FORMAT "x(12)" SPACE
  dfields._For-name  NO-LABEL                FORMAT "x(30)" SPACE
  edbtyp2            NO-LABEL                FORMAT "x(12)" SPACE
  dfields._For-type  NO-LABEL                FORMAT "x(13)" SKIP

  dfields._Format       LABEL "      Format" FORMAT "x(30)" SPACE(4)
  dfields._Fld-stoff    LABEL     "Position" FORMAT ">>>9" SKIP

  dfields._Label        LABEL "       Label" FORMAT "x(30)" SPACE(4)
  dfields._Decimals     LABEL     "   Scale" FORMAT ">>>>9" "(Decimals)" SKIP

  dfields._Col-label    LABEL "Column-label" FORMAT "x(30)" SPACE(4)
  dfields._Order        LABEL     "   Order" FORMAT ">>>>9"
  /* dfields._For-retrieve  * /
  retriev              LABEL     "Retrieve ?" FORMAT "y/n"*/ SKIP

  dfields._Initial      LABEL "     Initial" FORMAT "x(100)" 
                        VIEW-AS FILL-IN SIZE 30 BY 1 SPACE(4)
  dfields._Mandatory    LABEL     "Not Null" FORMAT "yes/no"
  dfields._Extent       LABEL     "  Extent" FORMAT ">>>>9" SKIP

  dfields._Valexp       LABEL   "Valexp"     VIEW-AS EDITOR
      	       	     	      	       	     INNER-CHARS 63 INNER-LINES 4
      	       	     	      	       	     BUFFER-LINES 4 SKIP
  dfields._Valmsg       LABEL "Valmsg"       FORMAT "x(63)" SKIP
  dfields._Help         LABEL "  Help"       FORMAT "x(63)" SKIP
  dfields._Desc         LABEL "  Desc"       FORMAT "x(70)" SKIP
  HEADER ""
  WITH FRAME odb_fld NO-BOX ATTR-SPACE OVERLAY SIDE-LABELS
  ROW (SCREEN-LINES - 19) COLUMN 1.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*----------------------- Internal Procedures -------------------------*/

/*----------------------------- Triggers ------------------------------*/

on leave of dfields._fld-stoff in frame odb_fld do:

  define variable l_fld-stoff as integer.

  assign
    l_fld-stoff  = input frame odb_fld dfields._fld-stoff.

  if can-find(first DICTDB._Field
    where DICTDB._Field._file-recid = drec_file
    and   RECID(DICTDB._Field) <> RECID(dfields)
    and   DICTDB._FIeld._fld-stoff = l_fld-stoff
    no-lock)
   then do:  /* wrong offset */
    message new_lang[10] view-as alert-box.
    RETURN NO-APPLY.
    end.     /* wrong offset */

  end.   /* on leave of dfields._fld-stoff  trigger */


/*---- LEAVE of foreign type field---- */
on leave of dfields._For-type in frame odb_fld do:

  assign
    l_for-type  = input frame odb_fld dfields._For-type
    odb_type_ix = LOOKUP(l_for-type, user_env[12]).

  if  odb_type_ix = 0
   or odb_type_ix = ?
   then do:  /* invalid foreign type */
    message new_lang[9] view-as alert-box.
    RETURN NO-APPLY.
    end.     /* invalid foreign type */

  repeat while num-entries(user_env[12]) >= odb_type_ix
   and   ENTRY(odb_type_ix,user_env[12])  = l_for-type:
    assign 
      pro_type    = pro_type    + "," + ENTRY(odb_type_ix, user_env[15])
      pro_format  = pro_format  + "|" + ENTRY(odb_type_ix, user_env[17],"|")
      odb_type_ix = odb_type_ix + 1.
    end.

  assign
    pro_type    = substring(pro_type,2,-1,"character")
    pro_format  = substring(pro_format,2,-1,"character")
    odb_type_ix = LOOKUP(l_for-type, user_env[12])
    l_format    = ENTRY(odb_type_ix, user_env[17],"|")
    l_dt-new    = ENTRY(odb_type_ix, user_env[15])
    dfields._fld-stdtype = INTEGER(ENTRY(odb_type_ix, user_env[14]))
    dfields._Data-type   = l_dt-new
    .

    if l_format = "?"
     then assign
      l_format = ( if l_dt-new = "decimal"
                     then "#"
                     else substring(l_dt-new,1,1,"character")
                 ).
                          
    case l_format:
      when "c" then assign l_format = "x(8)".
      when "d" then assign l_format = "99/99/99".
      when "i" then assign l_format = "->>,>>>,>>>9".
      when "#" then assign l_format = "->>,>>>,>>>9.99".
      when "l" then assign  l_format = "yes/no".
      WHEN "dt"  THEN ASSIGN l_format = "99/99/9999 HH:MM:SS.SSS".
      WHEN "dtz" THEN ASSIGN l_format = "99/99/9999 HH:MM:SS.SSS+HH:MM".
      end case.

    DISPLAY 
      l_dt-new @ dfields._Data-type
      l_format @ dfields._Format
      WITH FRAME odb_fld.
  end.   /* on leave of dfields._For-type  trigger */


/*---- GET or HELP of foreign type field---- */
ON GET,HELP OF dfields._For-type IN FRAME odb_fld DO:

  RUN "prodict/user/_usrpick.p".

  IF pik_first <> ? THEN DO:
    /* Show the gateway data type they chose */
    DISPLAY
      pik_first @ dfields._For-type
      WITH FRAME odb_fld.

    /* Show the corresponding progress type */
    assign
      l_for-type  = pik_first
      odb_type_ix = LOOKUP(l_for-type, user_env[12]).
    assign
      l_format    = ENTRY(odb_type_ix, user_env[17],"|")
      l_dt-new    = ENTRY(odb_type_ix, user_env[15]).

    if l_format = "?"
     then assign
      l_format = ( if l_dt-new = "decimal"
                     then "#"
                     else substring(l_dt-new,1,1,"character")
                 ).
                          
    case l_format:
      when "c" then assign l_format = "x(8)".
      when "d" then assign l_format = "99/99/99".
      when "i" then assign l_format = "->>,>>>,>>>9".
      when "#" then assign l_format = "->>,>>>,>>>9.99".
      when "l" then assign l_format = "yes/no".
      WHEN "dt"  THEN ASSIGN l_format = "99/99/9999 HH:MM:SS.SSS".
      WHEN "dtz" THEN ASSIGN l_format = "99/99/9999 HH:MM:SS.SSS+HH:MM".
      end case.

    DISPLAY 
      l_dt-new @ dfields._Data-type
      l_format @ dfields._Format
      WITH FRAME odb_fld.

  END.
END.

/*----- Any ASCII key in foreign type field -----*/
ON ANY-PRINTABLE OF dfields._For-type IN FRAME odb_fld DO:
  /* blank out the pro type if they change the gate type */
  IF dfields._Data-type:SCREEN-VALUE IN FRAME odb_fld <> "" THEN 
    DISPLAY "" @ dfields._Data-type WITH FRAME odb_fld.
END.


/*---- LEAVE of data-type field---- */
on leave of dfields._data-type in frame odb_fld do:

  define variable l_type-match as logical no-undo.

  assign
    l_dt-new    = input frame odb_fld dfields._Data-type
    l_for-type  = input frame odb_fld dfields._For-type
    l_init      = input frame odb_fld dfields._Initial
    odb_type_ix = LOOKUP(l_for-type, user_env[12])
    l_type-match = false.
  repeat while ENTRY(odb_type_ix,user_env[12])  = l_for-type
    and l_type-match = false:
    assign 
      l_type-match = ( ENTRY(odb_type_ix,user_env[15]) = l_dt-new )
      odb_type_ix  = odb_type_ix + 1 - integer(l_type-match)
      .
    end.

  /* handle case where we don't support blob or clob for varbinary(n) or
   * varchar(n) respectively - MSS db */
  IF edbtyp = "MSS" AND l_type-match AND 
     (((l_dt-new = "BLOB") AND
     (dfields._For-type = "varbinary" OR dfields._For-type = "longvarbinary")) OR 
     ((l_dt-new = "CLOB") AND
     (dfields._For-type = "varchar" OR dfields._For-type = "longvarchar"))) THEN DO:
      /* varbinary(max)/varchar(max) reported as varbinary/varchar with zero precision
         by MSS native driver or as longvarchar for other drivers. But the schema pull
         sets precision to 32000 in the schema for the native driver case.
         We do not support varbinary(n)/varchar(n) for blob/clob support but (n) can 
         only be a number between 1 and 8000 inclusive  for varbinary(n)/varchar(n). 
         So let's check the varbinary(n)/varchar(n) case.
         Also, if field has the filestream option set, we only support blob mapping.
      */
     IF (dfields._Fld-misc2[4] = "filestream") OR 
        (dfields._Fld-misc1[1] >= 1 AND dfields._Fld-misc1[1] <= 8000) THEN 
         l_type-match = FALSE.
  END.

  if l_type-match = false
   then do:  /* not a correct match */
    message new_lang[7] view-as alert-box.
    RETURN NO-APPLY.
    end.     /* not a correct match */

  IF l_dt-new = "blob" OR l_dt-new = "clob" THEN DO:
     dfields._Initial = ?.
     DISPLAY dfields._Initial WITH FRAME odb_fld.
  END.

  IF l_dt-new = "BLOB" OR l_dt-new = "CLOB" THEN 
    ASSIGN islob = TRUE.
  ELSE
    ASSIGN islob = FALSE.

  /* if moving from/to BLOB/CLOB, need to adjust fields */
  IF dfields._data-type = "blob" OR dfields._data-type = "clob" OR islob THEN DO:

     /* need to adjust these fields based on the data type */
     ASSIGN  dfields._Format:SENSITIVE IN FRAME odb_fld = NOT islob
             dfields._Label:SENSITIVE = NOT islob
             dfields._Col-label:SENSITIVE = NOT islob
             dfields._Initial:SENSITIVE = NOT islob
             dfields._Mandatory:SENSITIVE = NEW dfields AND NOT islob
             dfields._Extent:SENSITIVE = NEW dfields AND NOT islob
             dfields._Valexp:SENSITIVE = NOT islob
             dfields._Valmsg:SENSITIVE = NOT islob
             dfields._Help:SENSITIVE = NOT islob.

     /* adjust tab order */
     dfields._Order:move-after-tab-item
       (dfields._Col-label:handle in FRAME odb_fld) in FRAME odb_fld.
     dfields._Desc:move-after-tab-item
       (dfields._Help:handle in FRAME odb_fld) in FRAME odb_fld.

  END.

  if  ( l_dt-new = "character" and l_dt-old <> "character" )
   or ( l_dt-new = "date" OR l_dt-new = "datetime" OR l_dt-new = "datetime-tz")
   or ( l_dt-new = "logical"   and l_dt-old <> "logical"   )
   or ( can-do("integer,decimal",l_dt-new) 
                and not can-do("integer,decimal",l_dt-old) )
   then do:  /* change format and ev. initial */
     if l_dt-new = "character" and
        l_for-type = "timestamp" then
        assign l_format = "x(27)".
     else do:  /* any other dt-new/for-type combination */
      assign
        l_format    = ENTRY(odb_type_ix, user_env[17], "|")
        l_length    = ( if  l_length  = ?
                         or l_length <= 0 
                         OR (edbtyp = "MSS" AND l_for-type = "date")
                            then 8
                            else l_length
                      ).
      if l_format = "?"
       then assign
        l_format = ( if l_dt-new = "decimal"
                       then "#"
                       else substring(l_dt-new,1,1,"character")
                   ).
      /* never let format for character be bigger than 320 - consistent with
         pull
      */
      IF l_format = "c" AND l_length > 320 THEN
          l_length = 320.

      case l_format:
        when    "c" then assign l_format = "x(" + string(l_length) + ")".
        when    "d" then assign l_format = ( if l_length = 8
                                                then "99/99/99"
                                                else "99/99/9999"
                                           ).
        WHEN    "dt"  THEN assign l_format = "99/99/9999 HH:MM:SS.SSS".
        WHEN    "dtz" THEN assign l_format = "99/99/9999 HH:MM:SS.SSS+HH:MM".
        when    "i" 
        or when "#" then assign l_format = fill("9",l_length).
        when    "l" then assign l_format = "yes/no".
        end case.
      end.     /* any other dt-new/for-type combination */

    display
      l_format @ dfields._Format
      WITH FRAME odb_fld.

    if   l_init      <> ""
     and l_init      <> ?
     and ( l_dt-new  <> "character"
        or l_for-type = "timestamp"
         )
     then do:  /* change initial-value */
      assign
        l_init = ( if l_dt-new = "logical"
                     then "no"
                     else ?
                 ).
      display
        l_init @ dfields._Initial
        WITH FRAME odb_fld.
      end.     /* change initial-value */

    end.     /* change format, length and ev. initial */

  end.   /* on leave of dfields._data-type */

/*---------------------------- Main Code ------------------------------*/

ASSIGN
  edbtyp      = {adecomm/ds_type.i
                  &direction = "itoe"
                  &from-type = "user_dbtype"
                  }
  new_lang[4] = SUBSTITUTE(new_lang[4],edbtyp)
  new_lang[5] = SUBSTITUTE(new_lang[5],edbtyp)
  new_lang[7] = SUBSTITUTE(new_lang[7],edbtyp)
  new_lang[9] = SUBSTITUTE(new_lang[9],edbtyp)
  edbtyp1     = SUBSTRING(edbtyp,1,6,"character")
  edbtyp1     = FILL(" ",6 - LENGTH(edbtyp1,"character")) + edbtyp1
  edbtyp2     = edbtyp1 + "-Type:"
  edbtyp1     = edbtyp1 + "-Name:".

ASSIGN
  c = ?
  i = ?.

/* if dbtype is MSS, call the correct procedure */
RUN VALUE("prodict/" + 
          (IF edbtyp = "MSS" THEN "mss/_mss_typ.p" ELSE "odb/_odb_typ.p"))
  (INPUT-OUTPUT i,INPUT-OUTPUT i,INPUT-OUTPUT c,INPUT-OUTPUT c,OUTPUT c).

/**/
ASSIGN
  pik_column = 40
  pik_down   = 0
  pik_hide   = TRUE
  pik_init   = ""
  pik_list   = ""
  pik_multi  = FALSE
  pik_number = FALSE
  pik_row    = 3
  pik_skip   = FALSE
  pik_title  = ""
  pik_wide   = FALSE.

j = 1.
DO i = 1 TO NUM-ENTRIES(user_env[12]) - 1:
  /* There are some multiple entries in the table with the same foreign
     type but different progress types.  They are always contiguous.
     Only show the first one.
  */
  IF i = 1 OR ENTRY(i, user_env[12]) <> ENTRY(i - 1, user_env[12]) THEN DO:
    pik_list[j] = ENTRY(i,user_env[12]).
    j = j + 1.
  END.
END.
pik_count = j - 1.
/**/

if available dfields
 then do:
  assign
    odb_type_ix = LOOKUP(dfields._For-type, user_env[12]).
  repeat while num-entries(user_env[12]) <= odb_type_ix
    and ENTRY(odb_type_ix,user_env[12])   = dfields._For-type:
    assign 
      odb_type    = odb_type    + "," + ENTRY(odb_type_ix, user_env[12])
      pro_type    = pro_type    + "," + ENTRY(odb_type_ix, user_env[15])
      pro_format  = pro_format  + "|" + ENTRY(odb_type_ix, user_env[17],"|")
      odb_type_ix = odb_type_ix + 1.
    end.
  assign 
    odb_type    = substring(odb_type,2,-1,"character")
    pro_type    = substring(pro_type,2,-1,"character")
    pro_format  = substring(pro_format,2,-1,"character").
  end.

 else do:
  CLEAR FRAME odb_fld NO-PAUSE.
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    PROMPT-FOR _Field-name WITH FRAME odb_fld.
    IF INPUT FRAME odb_fld _Field-name = "" 
     THEN DO:
      MESSAGE new_lang[6] view-as alert-box. /* nothing entered! */
      UNDO,RETRY.
      END.
    END.
  IF KEYFUNCTION(LASTKEY) = "END-ERROR"
   then do:
    HIDE FRAME odb_fld NO-PAUSE.
    RETURN.
    END.
  FIND FIRST dfields WHERE dfields._File-recid = drec_file
    AND dfields._field-name = INPUT FRAME odb_fld _Field-name NO-ERROR.
  IF AVAILABLE dfields
   then MESSAGE new_lang[8] view-as alert-box.
  ELSE DO:
    CREATE dfields.
    ASSIGN
        dfields._File-recid = drec_file
        dfields._For-type   = ?
        dfields._Fld-case   = TRUE
        dfields._Field-name = INPUT FRAME odb_fld _Field-name.
    end.
  end.

ASSIGN
  inindex    = CAN-FIND(FIRST DICTDB._Index-field OF dfields)
  inview     = CAN-FIND(FIRST DICTDB._View-ref
               WHERE DICTDB._View-ref._Ref-Table = user_filename
               AND DICTDB._View-ref._Base-Col = dfields._Field-name)
  l_lcl-bffr = ( can-find (first DICTDB._File
                    where RECID(DICTDB._File)    = drec_file
                    and   DICTDB._File._for-name = "NONAME"
                    and   DICTDB._File._for-type = "BUFFER"
                    no-lock) )
  l_length   = ( if can-do(
    "char,longvarbinary,time,timestamp,longvarchar,binary,varbinary,varchar"
                         ,dfields._for-type) 
                then dfields._Fld-misc1[3]
               else if dfields._Fld-misc1[4] = 2
                then dfields._Fld-misc1[1] * 0.30103
                else dfields._Fld-misc1[1]
             ).

IF dfields._data-type = "BLOB" OR dfields._data-type = "CLOB" THEN 
  ASSIGN islob = TRUE.
ELSE
  ASSIGN islob = FALSE.

/*retriev = (NOT dfields._For-retrieve = 1).*/
DISPLAY
  edbtyp1 edbtyp2
  dfields._Field-name
  dfields._Data-type
  dfields._For-name
  dfields._For-type
/*  retriev */
  dfields._Format
  dfields._Label
  dfields._Col-label
  dfields._Initial
  dfields._Fld-stoff
  dfields._Decimals WHEN dfields._Data-type = "DECIMAL"
  dfields._Order
  dfields._Mandatory
  dfields._Extent
  dfields._Valexp
  dfields._Valmsg
  dfields._Help
  dfields._Desc
  WITH FRAME odb_fld.

IF ronly = "r/o"
 THEN DO:
  { prodict/user/userpaus.i }
  HIDE FRAME odb_fld NO-PAUSE.
  RETURN.
  end.

IF NOT NEW dfields
 THEN NEXT-PROMPT dfields._Format WITH FRAME odb_fld.

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  FIND _File WHERE RECID(_File) = drec_file.
  if NEW dfields
   then do:
    SET
      dfields._For-type when NEW dfields
      dfields._Fld-stoff WHEN l_Lcl-bffr
      dfields._For-name when NEW dfields
      WITH FRAME odb_fld.
    NEXT-PROMPT dfields._Format WITH FRAME odb_fld.
    end.
   else NEXT-PROMPT dfields._Data-type WITH FRAME odb_fld.
  assign l_dt-old = dfields._Data-type.
  SET
    dfields._Field-name
    dfields._For-name when NEW dfields
    dfields._For-type when NEW dfields
    dfields._Data-type 
    dfields._Format WHEN NOT islob
    dfields._Label WHEN NOT islob
    dfields._Col-label WHEN NOT islob
    dfields._Initial WHEN NOT islob
    dfields._Fld-stoff WHEN l_Lcl-bffr
    dfields._Decimals WHEN dfields._Data-type = "DECIMAL"
    dfields._Order
    /* Suppress update of retrieve until implemented in Progress */
  /* retriev
    dfields._For-retrieve = IF retriev THEN ? ELSE 1 */
    dfields._Mandatory when NEW dfields AND NOT islob
    dfields._Extent when NEW dfields AND NOT islob
    dfields._Valexp WHEN NOT islob
    dfields._Valmsg WHEN NOT islob
    dfields._Help WHEN NOT islob
    dfields._Desc
    WITH FRAME odb_fld.
    
  IF dfields._Field-name ENTERED AND NOT NEW dfields AND inview
   THEN DO:
    MESSAGE new_lang[2] view-as alert-box. /* sorry, used in view */
    UNDO,RETRY.
    end.

  ASSIGN
    dfields._Valexp = (IF TRIM(dfields._Valexp) = "" 
      	       	     	 THEN ? 
      	       	     	 ELSE TRIM(dfields._Valexp)).
  changed = TRUE.
  end.

HIDE FRAME odb_fld NO-PAUSE.

IF KEYFUNCTION(LASTKEY) = "END-ERROR"
 THEN DO:
  IF NEW dfields
   then DELETE dfields.
  ELSE
    UNDO,RETURN.
  end.

RETURN.
/*********************************************************************
* Copyright (C) 2005-2009 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* odb_get - finder for Odbc tables */

/*

OUTPUT:
    gate-work records for found objects

INPUT:
    user_env[25]    "{AUTO},<name>,<owner>,<type>,<qualifier>"
                        for autmatically select all or bringing up the 
                            selection-dialog-box, Initial-values for
                            pre-selection-criterias    
                            
History:  DLM 01/28/98 Added call for stored procedures.
          DLM 09/03/98 Added display as dialog box for gui
          DLM 07/14/99 Added check for _SEQP_ procedure to skip
          DLM 11/18/99 Added assignement of DBMS Type to Db_Misc2[8]
          DLM 10/01/01 Added logic not to pull system tables or overloaded procedures
                       for DB2.
          DLM 09/17/03 Added logic to know if coming from ProToODB to only pull back
                       what was pushed.              
          KSM 04/13/04 Comparing SQLTables_buffer.OWNER to user_library unless it's
                       blank.                                        
          KSM 03/04/05 Added conditions to prevent loading SYS* tables 20050214-028
          KSM 03/21/05 Added more conditions to prevent loading system tables 20041220-005
          DJM 11/11/05 Added schema holder version control linked to the client
     fernando 09/28/06 For DB2, use P_BUFFER_ for pseudo-buffers instead of _BUFFER_ - 20060425-009
     knavneet 02/21/07 For AS400, defining another frame frm_as400 & uppercasing s_owner 
     knavneet 07/24/07 While checking the driver name we read the 1st ENTRY from _Db-misc2[1] as it may have Library name appended to it for DB2/400 
     knavneet 08/22/07 For DB2/400, if Db-misc2[1] has no 2nd entry, s_owner is assigned the default Collection specified in DSN reading from registry 
     fernando 05/27/08 Fixing code that looks for existing stored-proc - OE00130417
     fernando 09/24/08 Allow synonyms to be pulled - OE00175227     
     rkumar   12/10/08 fixed OE00178256 for iSeries Access ODBC driver    
     nagaraju 10/21/09 Support for computed column RECID in MSSDS - OE00186593 
*/

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/gate/odb_ctl.i }
{ prodict/odb/odbvar.i }
&UNDEFINE DATASERVER

DEFINE VARIABLE bug1                AS LOGICAL   NO-UNDO.
DEFINE VARIABLE escp                AS CHARACTER NO-UNDO.
DEFINE VARIABLE c	            AS CHARACTER NO-UNDO.
DEFINE VARIABLE edbtyp              AS CHARACTER NO-UNDO. /* db-type external format */
DEFINE VARIABLE hint	            AS CHARACTER NO-UNDO INITIAL "".
DEFINE VARIABLE i	            AS INTEGER   NO-UNDO.
DEFINE VARIABLE j	            AS INTEGER   NO-UNDO.
DEFINE VARIABLE found	            AS INTEGER   NO-UNDO.
DEFINE VARIABLE efound	            AS INTEGER   NO-UNDO.
DEFINE VARIABLE l	            AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lim	            AS INTEGER   NO-UNDO INITIAL 0.
DEFINE VARIABLE odbtyp              AS CHARACTER NO-UNDO. /* list of ODBC-types */
DEFINE VARIABLE redraw	            AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE VARIABLE rpos1	            AS CHARACTER NO-UNDO.
DEFINE VARIABLE rpos2	            AS CHARACTER NO-UNDO.
DEFINE VARIABLE rpos3	            AS CHARACTER NO-UNDO.
DEFINE VARIABLE xld	            AS INTEGER   NO-UNDO INITIAL 0.
DEFINE VARIABLE canned	            AS LOGICAL   NO-UNDO.
DEFINE VARIABLE inc_qual            AS LOGICAL   NO-UNDO.
DEFINE VARIABLE driver-prefix	    AS CHARACTER NO-UNDO.
DEFINE VARIABLE sqltables-type	    AS CHARACTER NO-UNDO.
DEFINE VARIABLE sqltables-name	    AS CHARACTER NO-UNDO case-sensitive.
DEFINE VARIABLE SQLProcedures-name  AS CHARACTER NO-UNDO.
DEFINE VARIABLE object-type	    AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_client-qual       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_name_f	    AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_owner_f	    AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_qual_f	    AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_rep-presel        AS logical   NO-UNDO.
DEFINE VARIABLE escape_char         AS CHARACTER NO-UNDO.
DEFINE VARIABLE quote_char          AS CHARACTER NO-UNDO.
DEFINE VARIABLE fromproto           AS LOGICAL NO-UNDO.

DEFINE VARIABLE sh_parsbuf          AS CHARACTER NO-UNDO.
DEFINE VARIABLE sh_ver              AS INTEGER NO-UNDO.
DEFINE VARIABLE sh_min_ver          AS INTEGER NO-UNDO.
DEFINE VARIABLE sh_max_ver          AS INTEGER NO-UNDO.
DEFINE VARIABLE is_db2              AS LOGICAL NO-UNDO.
DEFINE VARIABLE is_as400            AS LOGICAL NO-UNDO.
DEFINE VARIABLE default_lib         AS CHARACTER NO-UNDO INITIAL "*".
DEFINE VARIABLE def_libraries       AS CHARACTER INITIAL ""    NO-UNDO. /* OE00179889 */

&IF "{&OPSYS}" NE "UNIX" &THEN
  DEFINE VARIABLE dsn_name            AS CHARACTER NO-UNDO.
  FUNCTION getRegEntry RETURN CHARACTER (INPUT dsnName as CHARACTER, keyName AS CHARACTER) FORWARD.
&ENDIF

/*
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  DEFINE VARIABLE lab-qual AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pat-name AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pat-user AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pat-qual AS CHARACTER NO-UNDO.
&ENDIF
*/

DEFINE BUFFER gate-buff FOR gate-work.
DEFINE stream s_stm_errors.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE err-msg AS CHARACTER NO-UNDO EXTENT 4 INITIAL [
  /* 1*/ "You have not selected an &1 database.",
  /* 2*/ "  Please wait while information is gathered from the &1 schema ",
  /* 3*/ "" /* unused */ , 
  /* 4*/ "" /* unused */
    /*      ....+....1....+....2....+....3....+....4....+....5....+....6 */
].

FORM SKIP(1)
  err-msg[2]       AT  3 NO-LABEL           FORMAT "x(70)"     SKIP(1)
  hint              AT 10 LABEL "(Searching" FORMAT "x(32)" ")" SKIP(1)
 WITH FRAME gate_wait 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  ROW 6 CENTERED SIDE-LABELS NO-ATTR-SPACE.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*------------------------------------------------------------------*/
/*------------------------------------------------------------------*/
/*------------------------------------------------------------------*/
PROCEDURE fix_the_wild_cards:
/* Put an escape sequenve in front of meta-characters. */
DEFINE INPUT PARAMETER src AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER trgt AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER odb-escape AS CHARACTER NO-UNDO.

DEFINE VARIABLE strt AS INT INIT 1 NO-UNDO.
DEFINE VARIABLE ind AS INT NO-UNDO.
DEFINE VARIABLE escape-seq AS CHARACTER NO-UNDO.


DEFINE VAR orig1  AS CHARACTER init "~~*" NO-UNDO.
DEFINE VAR orig2  AS CHARACTER init "~~." NO-UNDO.
DEFINE VAR orig3  AS CHARACTER init "*" NO-UNDO.
DEFINE VAR orig4  AS CHARACTER init "." NO-UNDO.
DEFINE VAR trgt1  AS CHARACTER init "*" NO-UNDO.
DEFINE VAR trgt2  AS CHARACTER init "." NO-UNDO.
DEFINE VAR trgt3  AS CHARACTER init "%" NO-UNDO.
DEFINE VAR trgt4  AS CHARACTER init "_" NO-UNDO.
IF src = ? 
THEN DO:
  trgt = src.
  RETURN.
END.

IF odb-escape = ? or odb-escape = " " THEN odb-escape = "".

escape-seq = odb-escape + "_".
strt = 1.
ind = 0.
REPEAT:
  IF escape-seq = "_" THEN LEAVE.
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), "_").

  IF ind = 0
    THEN LEAVE.

  SUBSTRING(src, ind + strt - 1, 1,"character") = escape-seq.
  strt = strt + ind  + 1.
END.


escape-seq = odb-escape + "%".
strt = 1.
ind = 0.
REPEAT:
  IF escape-seq = "%" THEN LEAVE.
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), "%").
 
  IF ind = 0
    THEN LEAVE.
 
  SUBSTRING(src, ind + strt - 1, 1,"character") = escape-seq.
  strt = strt + ind  + 1.
END.
 
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig3).
 
  IF ind = 0
    THEN LEAVE.
 
  IF strt + ind > 2 AND SUBSTRING(src, strt + ind - 2, 1,"character") = "~~" THEN DO:
    strt = strt + ind.
    NEXT.
  END.
    
  SUBSTRING(src, ind + strt - 1, 1 ,"character") = trgt3.
  strt = strt + ind.
END.
 
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig4).
 
  IF ind = 0
    THEN LEAVE.
     
  IF strt + ind > 2 AND SUBSTRING(src, strt + ind - 2, 1,"character") = "~~"
   THEN DO:
    strt = strt + ind.
    NEXT.
  END.
      
  SUBSTRING(src, ind + strt - 1, 1,"character") = trgt4  .
  strt = strt + ind.
END.
 
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig1).
 
  IF ind = 0
    THEN LEAVE.
 
  SUBSTRING(src, ind + strt - 1, 2,"character") = trgt1.
  strt = strt + ind.
END.

strt = 1. 
ind = 0.
REPEAT: 
  ind = INDEX (SUBSTRING(src,strt,-1,"character"), orig2). 
  
  IF ind = 0 
    THEN LEAVE. 
  
  SUBSTRING(src, ind + strt - 1, 2,"character") = trgt2. 
  strt = strt + ind. 
END. 


trgt = src.
 
RETURN.
END PROCEDURE.


/*------------------------------------------------------------------*/
/*--------------------------- MAIN-BLOCK ---------------------------*/
/*------------------------------------------------------------------*/

ASSIGN
  SESSION:IMMEDIATE-DISPLAY = yes
  edbtyp      = {adecomm/ds_type.i
                  &direction = "itoe"
                  &from-type = "user_dbtype"
                  }
  odbtyp      = {adecomm/ds_type.i
                  &direction = "ODBC"
                  &from-type = "user_dbtype"
                  }
  err-msg[1] = SUBSTITUTE(err-msg[1],edbtyp)
  err-msg[2] = SUBSTITUTE(err-msg[2],edbtyp)
  s_wildcard  = FALSE.
  .

IF INDEX(odbtyp,user_dbtype) = 0
 THEN DO:
  MESSAGE err-msg[1] /* not odbc */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
  END.

/* delete eventually left-over records from earlier schema-pulls */
for each gate-work: delete gate-work. end.
for each s_ttb_seq: delete s_ttb_seq. end.
for each s_ttb_tbl: delete s_ttb_tbl. end.
for each s_ttb_fld: delete s_ttb_fld. end.
for each s_ttb_idx: delete s_ttb_idx. end.
for each s_ttb_idf: delete s_ttb_idf. end.


/*------------------------------------------------------------------*/
/*                        get driver-bug-info                       */
/*------------------------------------------------------------------*/

assign
  l_rep-presel = TRUE.

presel:  
repeat while l_rep-presel:   /* end for this repeat is in nogatwrk.i */

DO TRANSACTION on error undo, leave on stop undo, leave:
RUN STORED-PROC DICTDBG.CloseAllProcs.
FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.
/* Please Note: In the event that we cover DB2 drivers on a UNIX platform:
   The DataDirect ODBC driver on the UNIX platform has a corresponding location in the
   ODBC.INI file the connection string attribute "Collection" (COL=<value>) and
   AlternateID (AID=<value>) where these values can be extracted.
   Also Note: The registry keys & values for SQL qualifier are specific to DataDirect drivers.
   The process for obtaining the appropriate qualifier may change if access to DB2 native
   drivers through the ODBC DataServer is considered in the future */
 /* OE00178256- In case of iSeries Access ODBC driver, the registry entry with the key 
    "DefaultLibraries" specifies the iSeries libraries to add to the server job's library list
    The libraries are delimited by commas or spaces, and *USRLIBL may be used as a 
    place holder for the server job's current library list. */
 /* OE00179889- iSeries driver: Default library is genrated based on the following rules:
    If any value is provided for SQL Default Library, then a space-separated list is created 
    in the registry, irrespective of spaces or commas separating the library list.
    If no value is provided for SQL Default Library, then first character is comma and then a 
    space-separated list is created in registry irrespective of presence of spaces or commas 
    separating the libaries in the library list.  */



RUN STORED-PROC DICTDBG.GetInfo (0).
  for each DICTDBG.GetInfo_buffer:
    is_as400 = (INDEX(UPPER(DICTDBG.GetInfo_buffer.dbms_name), "AS/400") > 0) OR 
               (INDEX(UPPER(DICTDBG.GetInfo_buffer.dbms_name), "DB2/400") > 0) .
    if is_as400 THEN
    DO:  
      if NUM-ENTRIES(DICTDB._Db._DB-misc2[1]) > 1 THEN 
        s_owner = ENTRY(2,DICTDB._Db._DB-misc2[1]).   
      else if (NUM-ENTRIES(DICTDB._Db._DB-misc2[1]) = 1) THEN 
      DO:
        &IF "{&OPSYS}" NE "UNIX" &THEN
          ASSIGN dsn_name    = DICTDB._Db._Db-addr.
	  IF INDEX(getRegEntry(dsn_name,"Driver"),"cwbodbc.dll") EQ 0 THEN 
		 default_lib = (IF getRegEntry(dsn_name,"AlternateID") <> ? THEN
                   getRegEntry(dsn_name,"AlternateID")
                 ELSE (IF getRegEntry(dsn_name,"Collection") <> ? THEN
                   getRegEntry(dsn_name,"Collection")
                 ELSE (IF getRegEntry(dsn_name,"LogOnID") <> ? THEN
                   getRegEntry(dsn_name,"LogOnID")
		 ELSE "*" ))).
	  ELSE DO:
		ASSIGN def_libraries = getRegEntry(dsn_name,"DefaultLibraries").
		default_lib = (IF def_libraries <> ? AND index(def_libraries,",") EQ 1 THEN
		   SUBSTRING(def_libraries,2,index(def_libraries," ") - 1) 
		 ELSE (IF def_libraries <> ? AND index(def_libraries," ") GE 0 THEN
		   SUBSTRING(def_libraries,1,index(def_libraries," ") - 1) 
		 ELSE (IF def_libraries EQ ? AND getRegEntry(dsn_name,"UserID") <> ? THEN 
                   getRegEntry(dsn_name,"UserID")
		 ELSE "*"))).  
	  END. 
        &ENDIF
         s_owner = default_lib.
      END. /* END DO: */
    END. /* END DO: */
    else
        s_owner = "*".
   end. /* END for-each */ 
CLOSE STORED-PROC DICTDBG.GetInfo.
END.

if is_as400 then
DO:
{prodict/gate/presel.i
  &block  = "presel"
  &frame  = "frm_as400"
  &link   = """ """
  &master = """ """
  }
END.
else
DO:
{prodict/gate/presel.i
  &block  = "presel"
  &frame  = "frm_ntoq"
  &link   = """ """
  &master = """ """
  }
END.
s_owner = UPPER(s_owner).

/* if either no qualifier-support from the server (BUG24), or no    */
/* wildcard-support from the server (BUG23) but wildcards contained */
/* in the variables we have to do the selection on the client-side  */

FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.

IF NOT SESSION:BATCH-MODE THEN DO:
    PAUSE 0.
    DISPLAY err-msg[2] WITH FRAME gate_wait.
END. 

SESSION:IMMEDIATE-DISPLAY = yes.
RUN adecomm/_setcurs.p ("WAIT").

DO TRANSACTION on error undo, leave on stop undo, leave:

  RUN STORED-PROC DICTDBG.CloseAllProcs.

  FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.

  RUN STORED-PROC DICTDBG.GetInfo (0).

  FOR EACH DICTDBG.GetInfo_buffer:

/*  This was checking for each individual dll that is certified.  Too many 
    complaints/bugs logged against the warning message.

    IF NOT CAN-DO(odbc-certify-list, DICTDBG.GetInfo_buffer.driver_name)
     THEN MESSAGE "The" DICTDBG.GetInfo_buffer.driver_name
      "driver was not tested and approved by PROGRESS Software."
      VIEW-AS ALERT-BOX TITLE "Warning".
*/

    IF DICTDB._Db._Db-misc2[1] = ?
     THEN DO:

        IF (LENGTH(DICTDBG.GetInfo_buffer.escape_char,"character") < 1)
            THEN  escape_char = " ".
            ELSE  escape_char = DICTDBG.GetInfo_buffer.escape_char .
        IF (LENGTH(DICTDBG.GetInfo_buffer.quote_char,"character") < 1)
            THEN  quote_char = " ".
            ELSE  quote_char = DICTDBG.GetInfo_buffer.quote_char.

      ASSIGN
        DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name
        DICTDB._Db._Db-misc2[2] = DICTDBG.GetInfo_buffer.driver_version
        DICTDB._Db._Db-misc2[3] = escape_char + quote_char
        DICTDB._Db._Db-misc2[5] = DICTDBG.GetInfo_buffer.dbms_name + " " 
  			        + DICTDBG.GetInfo_buffer.dbms_version 
        DICTDB._Db._Db-misc2[6] = DICTDBG.GetInfo_buffer.odbc_version
        DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver
  		                          + ",Client Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_clnt
  		                          + ",Server Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_srvr
                                          + ","
        DICTDB._Db._Db-misc2[8] = DICTDBG.GetInfo_buffer.dbms_name
        driver-prefix    = ( IF DICTDB._Db._Db-misc2[1] BEGINS "QE"
                              THEN SUBSTRING(DICTDB._Db._Db-misc2[1]
                                      ,1
                                      ,LENGTH(DICTDB._Db._Db-misc2[1]
                                              ,"character") - 6
                                      ,"character")
  		              ELSE DICTDB._Db._Db-misc2[1]
  		           )
        DICTDB._Db._Db-misc2[4] = "".

      /* If client version is formatted w/"sh_min", the client is OpenEdge 10.1A or greater 
       * which knows about the dictionary version number.  The current format of _DB-misc2[7]
       * conforms to the following sample:
       *
       * "Dictionary Ver#: 1.000.000; Client Ver#: 101.00,(sh_min=1,sh_max=2); Server Ver#: 101.00; Schema Holder Ver#: 1"
       *
       */

      IF INDEX(DICTDBG.GetInfo_buffer.prgrs_clnt, ",(sh_min=") <> 0 THEN
        DICTDB._Db._Db-misc2[7] = DICTDB._Db._Db-misc2[7] + " Schema Holder Ver#: ".

      REPEAT i = 1 TO 80:
        IF   ( CAN-DO(odbc-bug-list[i], driver-prefix)
         OR    CAN-DO(odbc-bug-list[i], "ALL") )
         AND NOT CAN-DO(odbc-bug-excld[i], driver-prefix)
         THEN ASSIGN
           DICTDB._Db._Db-misc2[4] = DICTDB._Db._Db-misc2[4]
                                   + string(i) + "," .
        END. /* REPEAT */

      END. /* DICTDB._Db._Db-misc2[1] = ? DO */

    ELSE IF ENTRY(1,DICTDB._Db._Db-misc2[1]) <> DICTDBG.GetInfo_buffer.driver_name
     THEN DO:
      RUN adecomm/_setcurs.p ("").
      MESSAGE
	    "The Schema Holder was not created with the ODBC driver you have"
	    "connected with." SKIP
	    "You may experience problems with this connection."
	    SKIP(1)
	    "Schema Holder: "  DICTDB._Db._Db-misc2[1] SKIP
	    "Current driver: " DICTDBG.GetInfo_buffer.driver_name
	    SKIP(1)
	    "Please consider recreating your schema holder using the current"
	    "ODBC driver."
	    VIEW-AS ALERT-BOX WARNING BUTTONS OK.
      RUN adecomm/_setcurs.p ("WAIT").
      END.

    /** Perform a schema holder version check and assignment if needed **/      

    found = INDEX(DICTDBG.GetInfo_buffer.prgrs_clnt, ",(sh_min="). 
    IF found <> 0 THEN DO:
         
      sh_parsbuf = SUBSTRING(DICTDBG.GetInfo_buffer.prgrs_clnt, found + 1).
      found = INDEX(sh_parsbuf, "sh_min=").

      found = found + LENGTH("sh_min=").
      efound = INDEX(sh_parsbuf, ",").
      IF efound > 0 AND efound > found THEN
        sh_min_ver = INTEGER(SUBSTRING(sh_parsbuf, found, efound - found)).

      sh_parsbuf = SUBSTRING(sh_parsbuf, efound + 1).
      found = INDEX(sh_parsbuf, "sh_max=").

      IF found <> 0 THEN DO:
        found = found + LENGTH("sh_max=").
        efound = INDEX(sh_parsbuf, ");").
        IF efound > 0 AND efound > found THEN
          sh_max_ver = INTEGER(SUBSTRING(sh_parsbuf, found, efound  - found)).
      END.
    END.

    /* This code won't (and shouldn't) set the schema holder version on 
     * schema holders create prior to the "version 101A" client set for
     * 10.0B04 and 10.1A.
     */

    found = INDEX(DICTDB._Db._Db-misc2[7], " Schema Holder Ver#: ").
    IF found <> 0 THEN DO:
      found = found + LENGTH(" Schema Holder Ver#: ") - 1.

      /* There is no specified schema holder version number yet */
      IF found = LENGTH(DICTDB._Db._Db-misc2[7]) THEN
        ASSIGN
          DICTDB._Db._Db-misc2[7] = DICTDB._Db._Db-misc2[7] + STRING(sh_min_ver).

      ELSE DO: /* Analyze schema holder value */

        sh_ver = INTEGER(SUBSTRING(DICTDB._Db._Db-misc2[7], found)).

        /* Catch old dictionaries, built by old clients, that are incompatible with 
         * this client.
         */

        IF sh_ver < sh_min_ver THEN DO:
 
          RUN adecomm/_setcurs.p ("").
          MESSAGE
            "The Schema Holder was created with an older version" SKIP
            "of OpenEdge than is supported by this client." SKIP
            "Please recreate your Schema Holder with this newer client."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          RUN adecomm/_setcurs.p ("WAIT").
          CLOSE STORED-PROC DICTDBG.GetInfo.
          RETURN.
          END.

        /* Catch new dictionaries, built by new client, that are incompatible with 
         * this older client.
         */ 

        IF sh_ver > sh_max_ver THEN DO:
 
          RUN adecomm/_setcurs.p ("").
          MESSAGE
            "The Schema Holder was created with a newer version" SKIP
            "of OpenEdge than is supported by this client." SKIP
            "Please recreate your Schema Holder with this back revision" SKIP
            "client or use a newer OpenEdge client with this schema holder." SKIP
            "NOTE: Recreation with a back revision client may cause newer" SKIP
            "features to be dropped.  Please refer to release notes"
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          RUN adecomm/_setcurs.p ("WAIT").
          CLOSE STORED-PROC DICTDBG.GetInfo.
          RETURN.
          END.

        END. /* else of if found = LENGTH(DICTDB._Db._Db-misc2[7]) */
      END. /* if found <> 0 */
    
    END.  /* FOR EACH DICTDBG.GetInfo_buffer */
    
  CLOSE STORED-PROC DICTDBG.GetInfo.

/*------------------------------------------------------------------*/
/*                        pull in schema-info                       */
/*------------------------------------------------------------------*/
  IF user_env[25] = "AUTOM" THEN 
     ASSIGN user_env[25] = "AUTO"
            fromproto = TRUE.
  ELSE
     ASSIGN fromproto = FALSE.

  ASSIGN
    is_db2 = INDEX(UPPER(_Db._Db-misc2[8]), "DB2") > 0
    l_client-qual = ( CAN-DO(DICTDB._Db._Db-misc2[4], "24") /* no qualifier-sprt */
                OR  ( CAN-DO(DICTDB._Db._Db-misc2[4], "23") /* no wildcard-sprt */
                AND   ( INDEX(s_name + s_owner + s_qual + s_type,"*") <> 0
                OR      INDEX(s_name + s_owner + s_qual + s_type,"?") <> 0
                      )                   /* but wildcards in the vars */
                    )
                  )
    bug1     = LOOKUP("1",DICTDB._Db._Db-misc2[4]) <> 0. 

  /* Refresh the bug info we just calculated.				*/
  RUN STORED-PROC DICTDBG.SendInfo (DICTDB._Db._Db-misc2[4]).
  CLOSE STORED-PROC DICTDBG.SendInfo.

  escp  = SUBSTRING(DICTDB._Db._Db-misc2[3],1,1,"character").
  escp  = IF (escp = " ") THEN "" ELSE escp.
  RUN fix_the_wild_cards(INPUT s_qual, OUTPUT l_qual_f, INPUT escp).
  RUN fix_the_wild_cards(INPUT s_owner, OUTPUT l_owner_f, INPUT escp).
  RUN fix_the_wild_cards(INPUT s_name, OUTPUT l_name_f, INPUT escp).
.
  IF l_client-qual THEN DO:
      /* 
         DB2/400 may take a long time to pull definitions when owner is left as ?.
         So if it's DB2 db and no wildcard was specified for the owner, pass it 
         instead to speed up the process of pulling the object name.
      */
      IF NOT is_db2 OR INDEX(s_owner,"*") > 0 OR INDEX(s_owner, "?") > 0 THEN
         l_owner_f = ?. /* non db2 db or wildcard specified, pass ? */
      
      IF fromproto AND is_db2 AND user_library NE "" THEN
          l_owner_f = user_library. /* library name from DB2/400 */
  
      RUN STORED-PROC DICTDBG.SQLTables (?, l_owner_f, ?, "TABLE,VIEW,SYNONYM").
  END.
  ELSE 
      RUN STORED-PROC DICTDBG.SQLTables 
                  (l_qual_f, l_owner_f, l_name_f, "TABLE,VIEW,SYNONYM").

  FOR EACH DICTDBG.SQLTables_buffer:
   /* If fromproto then only pull in what we pushed */ 
   IF fromproto AND 
     TRIM(CAPS(DICTDBG.SQLTables_buffer.OWNER)) <> 
     TRIM(CAPS(IF user_library NE "" THEN 
                 user_library ELSE odb_username)) THEN NEXT.

   IF NOT CAN-DO(odballowed,TRIM(DICTDBG.SQLTables_buffer.type)) THEN NEXT.

   /* A table for sequence implementation.				*/
   IF TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "_SEQP_" THEN NEXT.

   
   /* selection to be done on the client-side */
   /* This IF catches all matches except where one or both  
    * operands have the unknown value. These are caught in the
    * ELSE block.
    */
   IF   l_client-qual
    AND ( NOT TRIM(DICTDBG.SQLTables_buffer.name)      MATCHES s_name
    OR    NOT TRIM(DICTDBG.SQLTables_buffer.owner)     MATCHES s_owner
    OR    NOT TRIM(DICTDBG.SQLTables_buffer.qualifier) MATCHES s_qual
    OR    NOT TRIM(DICTDBG.SQLTables_buffer.type)      MATCHES s_type
        )
    AND NOT ( TRIM(DICTDBG.SQLTables_buffer.name)      BEGINS "_buffer_"
    AND       s_type                                   MATCHES "buffer"
            )
    AND NOT TRIM(DICTDBG.SQLTables_buffer.name)        MATCHES "_buffer_"
                                                             + s_name
    /* 20060425-009
       for DB2, we look for P_BUFFER, since the object name can't start with _ 
    */
    AND NOT (is_db2 AND 
             TRIM(DICTDBG.SQLTables_buffer.name)      BEGINS "p_buffer_"
             AND s_type                               MATCHES "buffer"
            )
    AND NOT (is_db2 AND TRIM(DICTDBG.SQLTables_buffer.name) MATCHES "p_buffer_"
                                                            + s_name )
    THEN NEXT.
    ELSE IF TRIM(DICTDBG.SQLTables_buffer.owner) = "SYSIBM" OR
            TRIM(DICTDBG.SQLTables_buffer.owner) = "SYSCAT" OR
            TRIM(DICTDBG.SQLTables_buffer.owner) = "SYSSTAT" OR
            TRIM(DICTDBG.SQLTables_buffer.owner) = "SYSFUN"  THEN
               NEXT.
    ELSE IF TRIM(DICTDBG.SQLTables_buffer.name) = "SYSCHKCST" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSCOLUMNS" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSCST" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSCSTCOL" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSCSTDEP" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSINDEXES" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSKEYS" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSKEYCST" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSPACKAGE" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSREFCST" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSTABLES" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSTABLEDEP" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSTRIGCOL" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSTRIGDEP" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSTRIGGERS" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSTRIGUPD" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSVIEWDEP" OR
            TRIM(DICTDBG.SQLTables_buffer.name) = "SYSVIEWS" OR
            TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "QIDCT" THEN
               NEXT.
    ELSE DO: 
        /* Check if there is a match with unknown value for
         * in SQLTables_buffer.  This can happen in PODBC. 
         */
         
        IF TRIM(DICTDBG.SQLTables_buffer.name)  = ? THEN 
            IF  NOT ( (s_name = ?) OR (s_name = "*") )  THEN NEXT.
            
        IF TRIM(DICTDBG.SQLTables_buffer.owner) = ? THEN
            IF NOT ( (s_owner = ?) OR (s_owner = "*") ) THEN NEXT.
            
        IF TRIM(DICTDBG.SQLTables_buffer.qual)  = ? THEN 
            IF NOT ( (s_qual = ?) OR (s_qual = "*") )   THEN NEXT.
            
        IF TRIM(DICTDBG.SQLTables_buffer.type)  = ?  THEN 
            IF NOT ( (s_type = ?) OR (s_type = "*") )   THEN NEXT.
            
    END. /* ELSE DO */                                            
    
    ASSIGN
      sqltables-type = TRIM(DICTDBG.SQLTables_buffer.type)
      sqltables-name = TRIM(DICTDBG.SQLTables_buffer.name)
      object-type    = ( IF (    sqltables-type    =    "VIEW" 
                          AND (LC(sqltables-name) BEGINS "_buffer_" 
                               /* 20060425-009 - for DB2, look for P_BUFFER */
                               OR (is_db2 AND LC(sqltables-name) BEGINS "p_buffer_"))
                            )
                          THEN (IF LC(sqltables-name) BEGINS "_buffer_" 
                                THEN substring(sqltables-name,2,6,"character")
                                ELSE substring(sqltables-name,3,6,"character"))
                         ELSE IF NOT ( sqltables-type = "TABLE" 
                          AND sqltables-name BEGINS "_SEQT_" )
                          THEN ENTRY(LOOKUP(sqltables-type ,sobjects),pobjects)
                         ELSE IF asc(substring(sqltables-name,2,1,"character")) = 115
                          THEN "sequence"
                          ELSE "SEQUENCE"
                       ).

    FIND DICTDB._File
      WHERE DICTDB._File._Db-recid     = drec_db
      AND   DICTDB._File._For-name     = sqltables-name
      AND   DICTDB._File._For-owner    = TRIM(DICTDBG.SQLTables_buffer.owner)
      AND ( bug1
      OR    DICTDB._File._FIl-misc2[1] = TRIM(DICTDBG.SQLTables_buffer.qualifier)
          )
      NO-ERROR.

    /* to prevent schemaholder-tables from beeing updated        */
    /*                                          <hutegger> 94/06 */
    IF available DICTDB._File
     AND DICTDB._File._file-name begins "SQLTables" THEN NEXT.
    
    /* skip objects that are not yet contained in the schema-holder */
    if not available DICTDB._File
     and s_vrfy = TRUE then NEXT.

    IF NOT SESSION:BATCH-MODE THEN 
        DISPLAY 
          TRIM(DICTDBG.SQLTables_buffer.name) @ hint 
          WITH FRAME gate_wait.


    CREATE gate-work.
    ASSIGN
      lim = lim + 1
      gate-work.gate-type = TRIM(STRING((AVAILABLE DICTDB._File 
                                    AND DICTDB._File._Frozen),"FROZEN:/"
                                  ))
                            + object-type

      gate-work.gate-name = ( IF object-type = "BUFFER"
                               THEN (IF LC(sqltables-name) BEGINS "_buffer_" 
                                     THEN SUBSTRING(sqltables-name,9,-1,"character")
                                     /* 20060425-009 - for DB2, look for P_BUFFER */
                                     ELSE SUBSTRING(sqltables-name,10,-1,"character"))
                              ELSE IF object-type = "SEQUENCE"
                               THEN SUBSTRING(sqltables-name,7,-1,"character")
                               ELSE sqltables-name
                            )

      gate-work.gate-qual = ( IF DICTDBG.SQLTables_buffer.qualifier = ?
  			       THEN "" 
  			       ELSE TRIM(DICTDBG.SQLTables_buffer.qualifier)
                            )
      gate-work.gate-user = TRIM(DICTDBG.SQLTables_buffer.owner)
      gate-work.gate-prog = ( IF AVAILABLE DICTDB._File
                               THEN DICTDB._File._File-name 
                               ELSE ?
                            ).
     
    END.   /* FOR EACH DICTDBG.SQLTables_buffer */

  CLOSE STORED-PROC DICTDBG.SQLTables.
    IF l_client-qual THEN DO:
        /* 
           DB2/400 may take a long time to pull definitions when owner is left as ?.
           So if it's DB2 db and no wildcard was specified for the owner, pass it 
           instead to speed up the process of pulling the object name.
        */
        IF NOT is_db2 OR INDEX(s_owner,"*") > 0 OR INDEX(s_owner, "?") > 0 THEN
           l_owner_f = ?. /* non db2 db or wildcard specified, pass ? */
        
        IF fromproto AND is_db2 AND user_library NE "" THEN
            l_owner_f = user_library. /* library name from DB2/400 */
         
       RUN STORED-PROC DICTDBG.SQLProcedures (?, l_owner_f, ?).
    END.
   ELSE RUN STORED-PROC DICTDBG.SQLProcedures (l_qual_f, l_owner_f, l_name_f).

  FOR EACH DICTDBG.SQLProcs_Buffer:
   /* If fromproto then only pull in what we pushed */ 
   IF fromproto AND 
     TRIM(CAPS(DICTDBG.SQLProcs_buffer.OWNER)) <> 
     TRIM(CAPS(IF user_library NE "" THEN 
                 user_library ELSE odb_username)) THEN NEXT.

   /* This IF catches all matches except where one or both  
    * operands have the unknown value. These are caught in the
    * ELSE block.
    */
   IF   l_client-qual
    AND ( NOT TRIM(DICTDBG.SQLProcs_Buffer.name)      MATCHES s_name
    OR    NOT TRIM(DICTDBG.SQLProcs_Buffer.owner)     MATCHES s_owner
    OR    NOT TRIM(DICTDBG.SQLProcs_Buffer.qualifier) MATCHES s_qual
        )
    AND NOT ( TRIM(DICTDBG.SQLProcs_Buffer.name)      BEGINS "_buffer_" )
    AND NOT TRIM(DICTDBG.SQLProcs_Buffer.name)        MATCHES "_buffer_"
                                                             + s_name
    /* 20060425-009 - for DB2, look for P_BUFFER */
    AND NOT (is_db2 AND TRIM(DICTDBG.SQLProcs_Buffer.name) BEGINS  "p_buffer_" )
    AND NOT (is_db2 AND TRIM(DICTDBG.SQLProcs_Buffer.name) MATCHES "p_buffer_"
                                                             + s_name)
    THEN NEXT.
    ELSE DO: 
        /* Check if there is a match with unknown value for
         * in SQLProcs_Buffer.  This can happen in PODBC. 
         */
         
        IF TRIM(DICTDBG.SQLProcs_Buffer.name)  = ? THEN 
            IF  NOT ( (s_name = ?) OR (s_name = "*") )  THEN NEXT.
            
        IF TRIM(DICTDBG.SQLProcs_Buffer.owner) = ? THEN
            IF NOT ( (s_owner = ?) OR (s_owner = "*") ) THEN NEXT.
            
        IF TRIM(DICTDBG.SQLProcs_Buffer.qual)  = ? THEN 
            IF NOT ( (s_qual = ?) OR (s_qual = "*") )   THEN NEXT.
 
            
    END. /* ELSE DO */    

    IF DICTDBG.SQLProcs_Buffer.name BEGINS "_SEQP_" THEN NEXT.

    IF TRIM(DICTDBG.SQLProcs_buffer.owner) = "SYSIBM" OR
       TRIM(DICTDBG.SQLProcs_buffer.owner) = "SYSCAT" OR
       TRIM(DICTDBG.SQLProcs_buffer.owner) = "SYSSTAT" OR
       TRIM(DICTDBG.SQLProcs_buffer.owner) = "SYSFUN" THEN NEXT.

    /* DB2 allows overloading of procedures which the DataServer does not support */
    FIND FIRST gate-work WHERE gate-work.gate-name = DICTDBG.SQLProcs_Buffer.name
        NO-LOCK NO-ERROR.
    IF AVAILABLE gate-work THEN NEXT.
 
    ASSIGN
      SQLProcedures-name = TRIM(DICTDBG.SQLProcs_Buffer.name)
      object-type    = "PROCEDURE".

    /* OE00130417 - remove this now so we can lool for the correct name in the schema,
       when checking if it already exists
    */
    IF substring(SQLProcedures-name,(length(SQLProcedures-name) - 1)) = ";1" THEN
       ASSIGN SQLProcedures-name = substring(SQLProcedures-name,1,(length(SQLProcedures-name) - 2)).

    FIND DICTDB._File
      WHERE DICTDB._File._Db-recid     = drec_db
      AND   DICTDB._File._For-name     = SQLProcedures-name
      AND   DICTDB._File._For-owner    = TRIM(DICTDBG.SQLProcs_Buffer.owner)
      AND ( bug1
      OR    DICTDB._File._FIl-misc2[1] = TRIM(DICTDBG.SQLProcs_Buffer.qualifier)
          )
      NO-ERROR.

    /* to prevent schemaholder-tables from beeing updated        */
    /*                                          <hutegger> 94/06 */
    IF available DICTDB._File
     AND DICTDB._File._file-name begins "SQLProcedures" THEN NEXT.
    
    /* skip objects that are not yet contained in the schema-holder */
    if not available DICTDB._File
     and s_vrfy = TRUE then NEXT.

    IF NOT SESSION:BATCH-MODE THEN 
        DISPLAY 
          TRIM(DICTDBG.SQLProcs_Buffer.name) @ hint 
          WITH FRAME gate_wait.


    CREATE gate-work.
    ASSIGN
      lim = lim + 1
      gate-work.gate-type = TRIM(STRING((AVAILABLE DICTDB._File 
                                    AND DICTDB._File._Frozen),"FROZEN:/"
                                  ))
                            + object-type

      gate-work.gate-name =  SQLProcedures-name
      gate-work.gate-qual = ( IF DICTDBG.SQLProcs_Buffer.qualifier = ?
  			       THEN "" 
  			       ELSE TRIM(DICTDBG.SQLProcs_Buffer.qualifier)
                            )
      gate-work.gate-user = TRIM(DICTDBG.SQLProcs_Buffer.owner)
      gate-work.gate-prog = ( IF AVAILABLE DICTDB._File
                               THEN DICTDB._File._File-name 
                               ELSE ?
                            ).
    END.   /* FOR EACH DICTDBG.SQLProcs_Buffer */

  CLOSE STORED-PROC DICTDBG.SQLProcedures.

  END. /* DO TRANSACTION */

HIDE FRAME gate_wait no-pause.

{prodict/gate/gat_get.i
  &block     = "presel"
  &cleanup   = " "
  &end       = "end."
  &gate-flag = "YES"
  &special1  = " "
  &special2  = " "
  &as400-flag = "is_as400"
  &where     = "gate-work.gate-type <> ""STABLE"""
  }

&IF "{&OPSYS}" NE "UNIX" &THEN

&SCOPED-DEFINE KEY_PATH "ODBC~\ODBC.INI~\"

/* Function : getRegEntry
   Purpose  : To read from WindowsRegistry
   Input    : DSN name as charcter & Key as Character
   Output   : Value read from registry as character */

FUNCTION getRegEntry RETURN CHARACTER
 (INPUT dsnName as CHARACTER, keyName AS CHARACTER):
  DEFINE VARIABLE keyData AS CHARACTER NO-UNDO INIT ?.

  /* Look for User DSN first */
   LOAD "SOFTWARE" BASE-KEY "HKEY_CURRENT_USER".
   USE "SOFTWARE".
   GET-KEY-VALUE SECTION {&KEY_PATH} + dsnName
   KEY keyName
   VALUE keyData.
   UNLOAD "SOFTWARE".

  /* Look for System DSN, if User DSN not found */
  IF keyData EQ ? THEN DO:
   LOAD "SOFTWARE" BASE-KEY "HKEY_LOCAL_MACHINE".
   USE "SOFTWARE".
   GET-KEY-VALUE SECTION {&KEY_PATH} + dsnName
   KEY keyName
   VALUE keyData.
   UNLOAD "SOFTWARE".
  END.

  RETURN keyData.
END FUNCTION.
&ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i }
{ prodict/odb/odbvar.i }


FIND FIRST DICTDB._Db WHERE _Db-local NO-LOCK.

ASSIGN
  drec_db      = RECID(DICTDB._Db).

IF SESSION:BATCH-MODE and logfile_open THEN DO: 
    PUT STREAM logfile UNFORMATTED
        " " skip 
        "-- ++ " skip
        "-- Creating SQL to create database objects " skip
        "-- -- " skip(2).
END.

RUN prodict/misc/_wrktgen.p.

IF SESSION:BATCH-MODE and NOT logfile_open THEN DO:
    OUTPUT STREAM logfile TO VALUE(user_env[2] + ".log") 
           APPEND UNBUFFERED NO-MAP NO-ECHO.
    logfile_open = true. 
END.

stages_complete[odb_create_sql] = TRUE. 

IF not stages[odb_dump_data] THEN RETURN.

IF movedata THEN DO:
  /* dump the data in Progress format */

  OUTPUT TO dump.tmp NO-ECHO NO-MAP.
  IF SESSION:BATCH-MODE and logfile_open THEN 
      PUT STREAM logfile UNFORMATTED 
          " " skip
          "-- ++ " skip
          "-- Dumping data " skip
          "-- -- " skip(2).
 
  RUN prodict/dump_d.p ("ALL","","").

END.

stages_complete[odb_dump_data] = TRUE. 

RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* this program assumes that it has an empty progress database.  it
then connects to an odbc database and proceeds to suck over the
definitions for all tables defined to have an owner matching the value
of the variable 'odb_username' 

History:  DLM  09/01/98 Changed Connect not to require a -U parameter
          DLM  09/17/98 Changed how th -U parameter is added when connect parms
                        are present 

*/

&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i NEW }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE DATASERVER

{ prodict/user/uservar.i }
{ prodict/user/userhue.i NEW }
{ prodict/user/userhdr.f NEW }
{ prodict/odb/odbvar.i }


DEFINE VARIABLE c            AS CHARACTER NO-UNDO.
DEFINE VARIABLE i            AS INTEGER   NO-UNDO.
DEFINE VARIABLE j            AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_debug      AS logical   NO-UNDO INIT FALSE.
DEFINE VARIABLE md1_conparms AS CHARACTER NO-UNDO. 
DEFINE VARIABLE conp1        AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp2        AS CHARACTER NO-UNDO.
DEFINE VARIABLE conp3        AS CHARACTER NO-UNDO. 
DEFINE VARIABLE user_env_save22 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save25 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save28 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save29 AS CHARACTER NO-UNDO.

DEFINE VARIABLE connection_string as CHARACTER NO-UNDO.

PROCEDURE connect-schdb:
  IF connection_string = "" OR connection_string = ? THEN 
    CONNECT  VALUE (odb_pdbname)
       -dt VALUE (user_dbtype)
       -ld VALUE (odb_dbname).

  ELSE IF odb_password = "" or odb_password = ? THEN 
    CONNECT  VALUE (odb_pdbname)
         -dt VALUE (user_dbtype)
         -ld VALUE (odb_dbname)
             VALUE (connection_string).
  ELSE 
    CONNECT  VALUE (odb_pdbname)
      -dt VALUE (user_dbtype)
      -ld VALUE (odb_dbname)
          VALUE (connection_string) 
      -P  VALUE (odb_password).

  CREATE ALIAS "DICTDBG" FOR DATABASE VALUE (odb_dbname) NO-ERROR.
END.

/* connect up the database to work with ------------------------------------*/
CONNECT VALUE (osh_dbname) -1.
CREATE ALIAS "DICTDB" FOR DATABaSE VALUE (osh_dbname).

/* create _db record and load odbc definitions ---------------------------*/

RUN prodict/odb/_odb_md2.p.

ASSIGN
  user_dbname = odb_dbname
  user_dbtype = {adecomm/ds_type.i
                  &direction = "etoi"
                  &from-type = "user_env[22]"
                  }.

md1_conparms = odb_conparms.
IF user_env[22] = "MS SQL Server" THEN DO:
   /* for M/S SQL Server, need to execute commands to create tables in another 
           connection, so we add the PRGRS_PROC_TRAN,1 connection parameter
   */
   IF md1_conparms = "" OR md1_conparms = ? THEN
      md1_conparms = "-Dsrv PRGRS_PROC_TRAN,1".
   ELSE 
      md1_conparms = md1_conparms + " -Dsrv PRGRS_PROC_TRAN,1".
END.

IF md1_conparms <> "" and md1_conparms <> ? THEN DO:
  IF odb_username <> "" AND odb_username <> ? THEN
     ASSIGN connection_string = "-U " + odb_username + " " + md1_conparms.
  ELSE
     ASSIGN connection_string = md1_conparms.
END.        
ELSE DO:
  IF odb_username <> "" AND odb_username <> ? THEN
     connection_string = "-U " + odb_username.
END.     

/* Save the user_env variables we will need later.  _odb_pul.p
     reinitializes user_env 
*/
ASSIGN
    user_env_save22 = user_env[22]
    user_env_save28 = user_env[28]
    user_env_save29 = user_env[29]. 

IF not stages[odb_create_objects] THEN RETURN.

/* connect to odbc database ----------------------------------------------*/
/* disconnect-connect is to reload schema cache -- workaround */
DISCONNECT VALUE (osh_dbname).
CONNECT VALUE (osh_dbname) -1.
RUN connect-schdb.


IF PDBNAME("DICTDBG") = ? THEN
  RETURN "undo".

RUN prodict/odb/_odb_sdb.p.

IF RETURN-VALUE = "wrg-ver" THEN DO:
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    ASSIGN user_path = "*N,1=sys,_usrsget".
  &ELSE
    ASSIGN user_path = "*N,1=sys,_guisget".
  &ENDIF   
  RETURN "wrg-ver".
END.

/* Discconnect again so _db updates are available */
DISCONNECT VALUE (osh_dbname).
CONNECT VALUE (osh_dbname) -1.
/* Reconnect the schema holder */

RUN connect-schdb.

RUN "prodict/odb/_sndinfo.p".

/*
 * Create the schema in the Sybase10 Database.
 */
RUN "prodict/gate/_snd_sql.p"
      ( INPUT user_env[31],
        INPUT l_debug,
        INPUT odb_dbname,
        INPUT user_dbtype,
        INPUT user_env[5],
        INPUT user_env[26],
        INPUT osh_dbname + ".sql"
      ).

IF SESSION:BATCH-MODE and NOT logfile_open THEN DO:
   OUTPUT TO VALUE(user_env[2] + ".log") APPEND UNBUFFERED NO-ECHO NO-MAP.
   logfile_open = true.
END.

stages_complete[odb_create_objects] = TRUE.
IF not stages[odb_build_schema] THEN RETURN.


IF SESSION:BATCH-MODE AND logfile_open THEN 

   PUT UNFORMATTED 
       " " skip 
       "-- ++ " skip
       "-- Getting List of Objects from foreign DB Schema" skip
       "-- -- " skip(2).

/*
** Create a list of all the appropriate objects we want from
** the sybase database.
*/
/*RUN prodict/odb/_odb_md3.p.*/
assign
  s_name-hlp   = "*"
  s_owner-hlp  = odb_username
  s_qual-hlp   = "*"
  s_type-hlp   = "*"
  user_env[25] = "AUTOM".
RUN prodict/odb/_odb_get.p.

IF SESSION:BATCH-MODE AND logfile_open THEN 

   PUT UNFORMATTED 
       " " skip 
       "-- ++ " skip
       "-- Importing Objects into the {&PRO_DISPLAY_NAME} Schema Holder" skip
       "-- -- " skip(2).

/*
** Pull objects from sybase schema.
*/
RUN prodict/odb/_odb_pul.p.

/*
** Create objects in the schema holder to match objects in sybase.
*/
RUN prodict/gate/_gat_cro.p.


stages_complete[odb_build_schema] = TRUE.

IF not stages[odb_fixup_schema] THEN RETURN.

/* destroy time fields, then load up progress database changes --------------*/


ASSIGN
    user_env[22]    = user_env_save22
    user_env[28]    = user_env_save28 
    user_env[29]    = user_env_save29
    user_env_save25 = user_env[25]
    user_env[25]    = "**all**".

IF SESSION:BATCH-MODE and logfile_open THEN
    PUT UNFORMATTED
        " " skip
        "-- ++ " skip
        "-- Fixing schema to resemble original {&PRO_DISPLAY_NAME} database." skip
        "-- -- " skip(2).

RUN prodict/odb/_odb_md5.p (osh_dbname, 
                            pro_dbname, 
                            pro_conparms, 
                            user_env[22]).

ASSIGN
    user_env[25] = user_env_save25
    stages_complete[odb_fixup_schema] = TRUE. 

RETURN.







/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
   History:  D. McMann 03/04/99 Added assignment of connect parameters
   
*/   

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/odb/odbvar.i }
{ prodict/gate/odb_ctl.i }	

DEFINE VARIABLE c AS CHARACTER NO-UNDO.

FIND DICTDB._Db WHERE DICTDB._Db._Db-name = odb_dbname NO-LOCK NO-ERROR.
 
IF NOT AVAILABLE DICTDB._Db THEN DO TRANSACTION:

  IF odb_username <> ? AND odb_username <> "" THEN
    ASSIGN c = "-U " + odb_username.
  IF odb_password <> ? AND odb_password <> "" THEN
    ASSIGN c = c + " -P " + odb_password.
  ASSIGN c = c + " " + odb_conparms.
  
  CREATE DICTDB._Db.
  ASSIGN
    DICTDB._Db._Db-name    = odb_dbname 
    DICTDB._Db._Db-addr    = odb_pdbname
    DICTDB._Db._Db-comm    = c
    DICTDB._Db._Db-slave   = TRUE
    DICTDB._Db._Db-type    = {adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "user_env[22]"
                        }.
    { prodict/gate/gat_cp1a.i
              &incpname = "odb_codepage" }
  ASSIGN DICTDB._Db._Db-coll-name = (IF odb_collname <> ? AND odb_collname <> "" THEN odb_collname
                                     ELSE SESSION:CPCOLL).
END.

ASSIGN
  user_dbname = DICTDB._Db._Db-name
  user_dbtype = DICTDB._Db._Db-type
  drec_db     = RECID(DICTDB._Db)
  c           = "add".

RUN prodict/odb/_odb_sys.p (drec_db,INPUT-OUTPUT c).

RETURN.

/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/* _odb_md3.p - returns list of ODBC objects in pik_count,pik_list */

/* redundant!!!!
 *      got replaced by odb_get.p
 *                      (hutegger 95/03)
 */
 
/*
This is used primarily for the Progress automated test
scripts, but it was reasoned that it is useful enough in
general to leave in the /prodict directory for future use.
*/


&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
&UNDEFINE DATASERVER

{ prodict/user/userhue.i } /* userpik.i needs color def vars from userhue.i */
{ prodict/user/userpik.i }
{ prodict/gate/odb_ctl.i }


DEFINE VARIABLE driver-prefix AS CHARACTER NO-UNDO.
DEFINE VARIABLE i             AS INTEGER   NO-UNDO.
DEFINE VARIABLE object-type   AS CHARACTER NO-UNDO.
DEFINE VARIABLE object-name   AS CHARACTER NO-UNDO.
DEFINE VARIABLE object-prog   as CHARACTER NO-UNDO.
DEFINE VARIABLE is_db2        AS LOGICAL   NO-UNDO.

/*
{prodict/gate/gatework.i
  &new        = " "
  &options    = "initial ""*"" "
  &SelVarType = "VARIABLE l"
  } / * Defines WORKFILE: gate-work */

RUN STORED-PROC DICTDBG.CloseAllProcs.
FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-LOCK.

ASSIGN is_db2 = INDEX(UPPER(_Db._Db-misc2[8]), "DB2") > 0.

RUN STORED-PROC DICTDBG.SQLTables(?,?,?,?).

FOR EACH DICTDBG.SQLTables_buffer:
    if DICTDBG.SQLTables_buffer.type = "SYSTEM TABLE" or 
          TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "_SEQP_" then 
       NEXT.
     
    if TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "_SEQT_" then do:
        assign 
            object-type = "SEQUENCE"
            object-name = SUBSTR(DICTDBG.SQLTables_buffer.name,7,-1,"character").
    end. 
    else if TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "_BUFFER_" and 
            DICTDBG.SQLTables_buffer.type = "VIEW" then do:
        assign 
            object-type = "BUFFER"
            object-name = SUBSTR(DICTDBG.SQLTables_buffer.name,9,-1,"character").
    end. 
    ELSE IF is_db2 AND TRIM(DICTDBG.SQLTables_buffer.name) BEGINS "P_BUFFER_" and 
            DICTDBG.SQLTables_buffer.type = "VIEW" THEN DO:
        /* 20060425-009 - for DB2, look for P_BUFFER */
        assign 
            object-type = "BUFFER"
            object-name = SUBSTR(DICTDBG.SQLTables_buffer.name,10,-1,"character").
    END.
    else do:
        assign 
            object-type = DICTDBG.SQLTables_buffer.type
            object-name = DICTDBG.SQLTables_buffer.name.
    end.
 
    object-prog = object-name.
    RUN prodict/gate/_gat_xlt.p (TRUE,drec_db,INPUT-OUTPUT object-prog).


    create gate-work.

    assign 
         gate-work.gate-type = object-type
         gate-work.gate-name = object-name
         gate-work.gate-qual = ( IF DICTDBG.SQLTables_buffer.qualifier = ?
                               THEN ""
                               ELSE TRIM(DICTDBG.SQLTables_buffer.qualifier)
                            )
         gate-work.gate-user = TRIM(DICTDBG.SQLTables_buffer.owner)
         gate-work.gate-prog = object-prog.

end. 

CLOSE STORED-PROC DICTDBG.SQLTables.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
   History:  DLM 09/03/98  New ProToOdb already connects to Progress
                           database.  I added a check so connect would
                           not issue an error
*/                           


DEFINE INPUT PARAMETER odb-name     AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pro-name     AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pro-conparms AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER p_edbtype  AS CHARACTER NO-UNDO.

DEFINE VARIABLE connted AS LOGICAL INITIAL FALSE.

/* connect up the databases to work with ------------------------------------*/

DELETE ALIAS DICTDB2.

IF NOT CONNECTED (pro-name) THEN DO:
  CONNECT VALUE(pro-name) -ld DICTDB2 VALUE (pro-conparms) -1.
  ASSIGN connted = TRUE.
END.  

ELSE
  CREATE ALIAS DICTDB2 FOR DATABASE VALUE(pro-name).  

RUN prodict/odb/_odb_fix.p (p_edbtype).

IF connted THEN
  DISCONNECT DICTDB2.
ELSE
  DELETE ALIAS DICTDB2.
    
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 hutegger     94/02/11    changed input-parameter of runload.i to "y"
*/

{ prodict/gate/_gat_md9.i
    &db-type  = "odb"
    &tmp-name = "odb"
    }
/*********************************************************************
* Copyright (C) 2006-2009 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
file:   prodict/odb/_odb_pul.p

description:
    pulls schemainfo of all objects contained in gate-work into
    the temp-tables

    <DS>_get.p gets a list of all pullable objects from the foreign DB
    <DS>_pul.p pulled over the definition from the foreign side
    gat_cmp.p  compared the existing definitions with the pulled info
    gat_cro.p  replaces the existing definitions with the pulled info
               or creates the new object if it didn't already exist

    Create <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Update <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Verify <DS> Schema: <DS>_get.p <DS>_pul.p gat_cmp.p gat_cro.p

Input:
    &DS_DEBUG   DEBUG to protocol the creation
                ""    to turn off protocol
    gate-work   shared temp-table that contains all the objects to pull

Output:
    s_ttb_tbl   table-information of all objects
    s_ttb_fld   field-information of all objects
    s_ttb_idx   index-information of all objects
    s_ttb_idf   index-field-information of all objects
    s_ttb_seq   sequence-information of all objects

History:
    hutegger    95/03   acreated out of odb_mak.p
    D. McMann  09/03/98 Added view as dialog box for gui
    D. McMann  03/02/99 Added support for progress recid and shadow col skipping
    D. McMann  07/14/99 Added check for INFORMATION_SCHEMA as owner (HHHHH)
    D. McMann  08/29/00 Added check for Informix "__1" to get extents created properly
                        19991231-006
    D. McMann 10/01/01 Added logic not to pull system tables or overloaded procedures
                       for DB2.
    D. McMann 10/16/01 Added logic for fields that begin with progress_   
    D. McMann 10/08/02 Added logic for shadow columns and arrays for MS Access                      
    D. McMann 04/23/03 Added logic to check sequence names - support on-line schema
    K. McIntosh 03/04/05 Changed error handling to reject loading a table if one of its 
                         fields are of an unsupported data-type 20050215-011
    D. Slutz 08/10/05 Added extent_char 20050531-001
    D. Moloney 11/11/05 Added schema holder version processing variables 20050531-001
    fernando   01/04/06 Message added for 20050531-001 should be a warning
	                    and should not come up during migration - 20051230-006.
    fernando   09/28/06 For DB2, use P_BUFFER_ for pseudo-buffers instead of 
                        _BUFFER_ - 20060425-009
    fernando   10/06/06 Check object name in case it has underscore - 20031205-003                        
    knavneet   07/25/07 For DB2/400, append Library name to _Db-misc2[1]
    rkumar     12/10/08 Fixed OE00178256 For iSeries Access ODBC driver 
    rkumar     05/05/09 Added RECID support for ODBC DataServer- OE00177721
    rkumar     10/15/09 Sybase DataServer- added COMMIT statement- OE00164101
*/

/*
relevant header-comments from odb_mak.p:
----------------------------------------

NOTE: there are a couple of bugs that various ODBC-driver have. The
complete list and description of the bugs can be found in odb_ctl.i

History
    mcmann      99/02/22    Added check for progress recid field
    mcmann      98/01/28    Added code for stored procedures
    hutegger    95/01/26    changed schmea-triggers to internal procs
    radams      94/05/10    don't display in batch mode.
    hutegger    94/05/03    trigger-handling
*/
/*h-*/

&SCOPED-DEFINE xxDS_DEBUG                   DEBUG /**/
&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

{ prodict/user/uservar.i }
{ prodict/gate/odb_ctl.i  }

define BUFFER   hlp-work         FOR  gate-work.
define BUFFER   A_col            FOR  DICTDBG.SQLColumns_buffer.
define BUFFER   P_col            FOR  DICTDBG.SQLProcCols_buffer.

define variable A_proc_handle    as integer.
define variable P_proc_handle    as integer.

define variable array_name 	 as character no-undo. 
define variable batch-mode	 as logical.
define variable bug1             as logical no-undo.
define variable bug4             as logical no-undo.
define variable bug7             as logical no-undo.
define variable bug8             as logical no-undo.
define variable bug19            as logical no-undo.
define variable bug22            as logical no-undo.
define variable bug28            as logical no-undo.
define variable bug29            as logical no-undo.
define variable bug34            as logical no-undo.

define variable char-type	 as logical no-undo. 
define variable column_available as logical no-undo. 
define variable comp-name  	 as character no-undo.
define variable temp-comp-name   as character no-undo.
define variable comp-ind         as integer   no-undo.
define variable comp-num         as integer   no-undo.
define variable doextent         as logical   no-undo. 
define variable dot1  	 	 as character no-undo.
define variable dot2  	 	 as character no-undo.
define variable dtyp             as integer   no-undo.
define variable edbtyp           as character no-undo. /* db-type external format */
define variable escp             as character no-undo.
define variable field-position   as integer   no-undo.
define variable fld-name-1   	 as character no-undo.
define variable fld-prior        as integer   no-undo.
define variable fld-properties   as character no-undo.
define variable fld-remark       as character no-undo.
define variable fnam             as character no-undo.
define variable format_len       as integer   no-undo.
define variable format_len1      as integer   no-undo.
define variable full_table_name  as character no-undo.
define variable has_id_ix        as logical   no-undo.
define variable i     	         as integer   no-undo.
define variable indn             as integer   no-undo.
define variable keycp 	         as integer   no-undo.
define variable l_char-types     as character no-undo.
define variable l_chrw-types     as character no-undo.
define variable l_date-types     as character no-undo.
define variable l_dcml           as integer   no-undo.
define variable l_dcml-types     as character no-undo.
define variable l_dt             as character no-undo.
define variable l_floa-types     as character no-undo.
define variable l_frmt           as character no-undo.
define variable l_i###-types     as character no-undo.
define variable l_i##d-types     as character no-undo.
define variable l_i##l-types     as character no-undo.
define variable l_i#dl-types     as character no-undo.
define variable l_logi-types     as character no-undo.
define variable l_prec 	         as integer   no-undo.
define variable l_time-types     as character no-undo.
define variable l_tmst-types     as character no-undo.
define variable l_init           as character no-undo. 
define variable l_matrix         as character no-undo initial
            "a,ax,ax,ax,u,ux,ux,ux".
define variable m1	   	 as integer   no-undo.
define variable m2	   	 as integer   no-undo. 
define variable msg              as character no-undo   EXTENT 6.
define variable namevar   	 as character no-undo case-sensitive.
define variable namevar-1   	 as character no-undo case-sensitive.
define variable newf  	         as logical   no-undo. /* new file definition */
define variable ntyp  	         as character no-undo.
define variable numeric-type	 as logical   no-undo. 
define variable oldf  	         as logical   no-undo. /* old file definition */
define variable pnam             as character no-undo.
define variable extent_char      as character no-undo.
define variable prev-prior       as integer   no-undo.
define variable progvar   	 as character no-undo.
define variable quote            as character no-undo.
define variable r                AS RECID     no-undo.
define variable scrap            as logical   no-undo.
define variable shadow_col_name  as character no-undo.
define variable shadow_col 	 as integer   no-undo. 
define variable spclvar   	 as character no-undo.
define variable spclvar-1   	 as character no-undo.
define variable table_comment    as character no-undo.
define variable table_name  	 as character no-undo case-sensitive.
define variable table_user  	 as character no-undo.
define variable table_user_1  	 as character no-undo.
define variable table-properties as character no-undo.
define variable table_spcl       as character no-undo.
define variable table_spcl_1     as character no-undo.
define variable table_type  	 as character no-undo.
define variable temp1	   	 as integer   no-undo.
define variable temp2	   	 as integer   no-undo.
define variable typevar   	 as character no-undo.
define variable typevar-1   	 as character no-undo.
define variable unique-prime     as logical   no-undo. /* upi already found */
define variable uservar   	 as character no-undo.
define variable uservar-1   	 as character no-undo.
define variable vfmt1            as character no-undo.
define variable field_position   as integer no-undo.

define variable spcl_len	 as integer   no-undo.
define variable user_len	 as integer   no-undo.
define variable table_len	 as integer   no-undo.
define variable dq_index         as integer   no-undo.
DEFINE VARIABLE s                AS CHARACTER NO-UNDO.
DEFINE VARIABLE tdbtype          AS CHARACTER NO-UNDO.  
DEFINE VARIABLE found            AS INTEGER   NO-UNDO.
DEFINE VARIABLE efound           AS INTEGER   NO-UNDO.
DEFINE VARIABLE sh_ver           AS INTEGER   NO-UNDO.
DEFINE VARIABLE sh_max_ver       AS INTEGER   NO-UNDO.
DEFINE VARIABLE clnt_vers        AS CHARACTER NO-UNDO.
DEFINE VARIABLE odb_perform_mode AS CHARACTER NO-UNDO.
DEFINE VARIABLE is_db2           AS LOGICAL   NO-UNDO.
DEFINE VARIABLE is_as400         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE tblrem_sql       AS CHARACTER NO-UNDO.
DEFINE VARIABLE dfth             AS INTEGER   NO-UNDO.
DEFINE VARIABLE h                AS INTEGER   NO-UNDO INIT ?. 
DEFINE VARIABLE ret_ok           AS LOGICAL   NO-UNDO INIT YES. 

define TEMP-TABLE column-id
          FIELD col-name         as character case-sensitive
          FIELD col-id           as integer
          INDEX upi        IS UNIQUE PRIMARY col-name.


/*------------------------------------------------------------------*/

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/
FORM
                                                    SKIP(1)
  msg[1]   FORMAT "x(29)" LABEL "Table"  colon 8 
    "->"
    msg[2] FORMAT "x(25)" LABEL "Table"             SKIP
  msg[3]   FORMAT "x(29)" LABEL "Column" colon 8 
    "->"
    msg[4] FORMAT "x(25)" LABEL "Field"             SKIP
  msg[5]   FORMAT "x(29)" LABEL "Key"    colon 8 
    "->"
    msg[6] FORMAT "x(25)" LABEL "Index"             SKIP (1)

  with ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  TITLE " Loading " + edbtyp + " Definition " USE-TEXT
  frame ds_make.

/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/


/*------------------------------------------------------------------*/
procedure error_handling:

define INPUT PARAMETER error-nr         as INTEGER.
define INPUT PARAMETER param1           as CHARACTER.
define INPUT PARAMETER param2           as CHARACTER.

define       variable  err-msg as character extent 6 initial [
/*  1 */ "WARNING: Column &1 is hidden; it cannot be an index component",
/*  2 */ "ERROR: Table &1 has unsupported data types.",
/*  3 */ "       Skipping this table...",
/*  4 */ " &1 &2 ", /* intentionally left blank for div. error-messages */
/*  5 */ "WARNING: No index for the RECID &1 field",
/*  6 */ "WARNING: The Driver sends wrong data about indexes, they cant be build automatically"
    ].
    
    if param1 = ? then assign param1 = "".
    if param2 = ? then assign param2 = "".
    
    if s_1st-error = false
     then do:
      assign s_1st-error = true.
      output stream s_stm_errors to ds_upd.e.
      output stream s_stm_errors close.
      end.
    output stream s_stm_errors to ds_upd.e append.
    PUT stream s_stm_errors unformatted
              SUBSTITUTE(err-msg[error-nr],param1,param2)  skip.
    output stream s_stm_errors close.
  
    end.  /* error_handling */

/*------------------------------------------------------------------*/
/* Get the list of components of: "FUNC1(f1,N)+FUNC2(f2)+f3 as:     */
/* f1+f2+f3. retunr ? for errors.                                   */
PROCEDURE extract_comp_names:
define INPUT  PARAMETER src             as character no-undo.
define OUTPUT PARAMETER trgt            as character no-undo.

define variable left_par                as integer   no-undo.
define variable right_par               as integer   no-undo.
define variable begin_replace           as integer   no-undo.
define variable to_replace              as integer   no-undo.
define variable comma                   as integer   no-undo.
define variable fld_delim               as integer   no-undo.
define variable fld_len                 as integer   no-undo.
define variable fld_name                as character no-undo.
define variable blnk                    as integer   no-undo.




IF INDEX(src, "(") = 0
 then do:
  trgt = src.
  RETURN.
  end.

REPEAT:
  left_par = INDEX(src, "(").
  if left_par = 0 then LEAVE.
  right_par = INDEX(src, ")").
 
  if right_par = 0
   then do:
    trgt = ?.
    RETURN.
    end.
 
  assign
    begin_replace = R-INDEX( SUBSTRING(src, 1, left_par, "raw"), "+") + 1
    comma = INDEX(src, ",").
 
  if right_par = 0
   then do:
    trgt = ?.
    RETURN.
    end.
 
  assign
    fld_delim  = ( if (right_par < comma OR comma = 0)
                     then right_par
                     else comma
                 )
    fld_len    = fld_delim - left_par - 1
    fld_name   = SUBSTRING(src, left_par + 1, fld_len, "character")
    blnk       = INDEX(fld_name, " ")
    fld_name   = ( if blnk = 0
                     then fld_name 
                     else TRIM(fld_name)
                 )
    to_replace = right_par - begin_replace + 1
    SUBSTRING(src, begin_replace, to_replace, "character") = fld_name.
  
  end.   /* repeat */
 
assign trgt = src.
RETURN.
 
end PROCEDURE.

/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/

assign
  batch-mode   = SESSION:BATCH-MODE
  edbtyp       = {adecomm/ds_type.i
                   &direction = "itoe"
                   &from-type = "user_dbtype"
                   }
  l_char-types = "CHAR,VARCHAR,BINARY,VARBINARY"
  l_chrw-types = "LONGVARBINARY,LONGVARCHAR,TIME"
  l_date-types = "DATE"
  l_dcml-types = "DECIMAL,NUMERIC"
  l_floa-types = "DOUBLE,FLOAT,REAL"
  l_i###-types = ""
  l_i##d-types = "BIGINT"
  l_i##l-types = ""
  l_i#dl-types = "INTEGER,SMALLINT,TINYINT"
  l_logi-types = "BIT"
  l_time-types = ""
  l_tmst-types = "TIMESTAMP"
  .
  
IF NOT batch-mode then assign SESSION:IMMEDIATE-DISPLAY = yes.

RUN adecomm/_setcurs.p ("WAIT").

/* 20051230-006 */
IF user_env[25] BEGINS "AUTO" THEN
    ASSIGN odb_perform_mode = "M". /* migration */
ELSE IF user_env[25] = "add" THEN
    ASSIGN odb_perform_mode = "C". /* create schema */
ELSE IF user_env[25] = "upd" THEN
    ASSIGN odb_perform_mode = "U". /* update schema */

assign
  cache_dirty = TRUE
  user_env    = "" /* yes this is destructive, but we need the -l space */
  l_dt        = ?.

RUN prodict/odb/_odb_typ.p
  ( INPUT-OUTPUT i,
    INPUT-OUTPUT i,
    INPUT-OUTPUT l_dt,
    INPUT-OUTPUT l_dt,
    OUTPUT       l_dt
    ). /* fills user_env[11..17] with datatype-info */

/* Get the name of the foreign dbms and set the foreign_dbms name */
    define variable foreign_dbms            as character no-undo.

    RUN STORED-PROC DICTDBG.GetInfo (0).
    for each DICTDBG.GetInfo_buffer:
       assign foreign_dbms = ( DICTDBG.GetInfo_buffer.dbms_name )
              is_as400 = INDEX(UPPER(DICTDBG.GetInfo_buffer.dbms_name),"AS/400") > 0 OR 
                         INDEX(UPPER(DICTDBG.GetInfo_buffer.dbms_name),"DB2/400") > 0.  
    end.

    CLOSE STORED-PROC DICTDBG.GetInfo.

find DICTDB._Db where RECID(_Db) = drec_db.

/* If we have an Informix db, we need to set bug34 flag for the separator
   character.  We can't set it earlier (like in odb_ctl.i) as there are lots
   of Informix drivers now - too many to try to keep in the list. */

IF (foreign_dbms = "Informix") THEN
   ASSIGN
      DICTDB._Db._Db-misc2[4] = DICTDB._Db._Db-misc2[4] + "34" + ",".
/* For db2/400, if _db-misc2[1] has no 2nd entry append the library name to it else
   update the 2nd entry with the new value */
IF is_as400 AND s_owner <> "*" AND s_owner <> "" THEN 
DO:
   IF NUM-ENTRIES(DICTDB._Db._Db-misc2[1]) = 1 THEN
     ASSIGN
      DICTDB._Db._Db-misc2[1] = DICTDB._Db._Db-misc2[1] + "," + UPPER(s_owner).
   ELSE 
     ASSIGN
      ENTRY(2,DICTDB._Db._Db-misc2[1]) = UPPER(s_owner).
END.
assign
  bug1  = can-do(_Db._Db-misc2[4], "1")
  bug4  = can-do(_Db._Db-misc2[4], "4")
  bug7  = can-do(_Db._Db-misc2[4], "7")
  bug8  = can-do(_Db._Db-misc2[4], "8")
  bug19 = can-do(_Db._Db-misc2[4], "19")
  bug22 = can-do(_Db._Db-misc2[4], "22")
  bug28 = can-do(_Db._Db-misc2[4], "28")
  bug29 = can-do(_Db._Db-misc2[4], "29")
  bug34 = can-do(_Db._Db-misc2[4], "34")
  quote = SUBSTRING(_Db._Db-misc2[3],2,1, "character")
  quote = ( if (quote = " " OR bug7)
                then ""
                else quote
          )
  escp  = SUBSTRING(_Db._Db-misc2[3],1,1, "character")
  escp  = ( if (escp = " ")
                then ""
                else escp
          ).

if bug22 then RUN error_handling(6, "", "").
if bug34 then escp = "".

/* OE00164101- only for Sybase datasource
             - running an explicit COMMIT SQL because pseudo   
               stored-procs cannot be run in a transaction */
IF (INDEX(_Db._Db-misc2[5], "SQL Server") <> 0) THEN DO:
        RUN STORED-PROC DICTDBG.send-sql-statement
           h = PROC-HANDLE NO-ERROR ("COMMIT ").
        assign ret_ok  = NOT ERROR-STATUS:ERROR.
        if ret_ok then  
          CLOSE STORED-PROC DICTDBG.send-sql-statement where PROC-HANDLE = h .
        else 
          run error_handling(4,"COMMIT","","error"). 
END. 

/*---------------------------- MAIN-LOOP ---------------------------*/
ASSIGN is_db2 = INDEX(UPPER(_Db._Db-misc2[8]), "DB2") > 0.

/* just in case some garbage left over */
for each s_ttb_tbl: delete s_ttb_tbl. end.
for each s_ttb_fld: delete s_ttb_fld. end.
for each s_ttb_idx: delete s_ttb_idx. end.
for each s_ttb_idf: delete s_ttb_idf. end.

_crtloop:
for each gate-work
  where gate-work.gate-slct = TRUE:
  
  /* Skip pseudo-entry, which is needed to signal, if user wants to 
   * compare not just <DS> -> PROGRESS, but also the other direction
   */
  if gate-work.gate-type = "PROGRESS" then next.

   /* This is for MS SQL 7 causing GPF when schema tables are pulled */
  IF gate-work.gate-user = "INFORMATION_SCHEMA" THEN NEXT.
  
  /* Eliminate system tables for DB2 */
  IF gate-work.gate-user = "SYSIBM" OR
     gate-work.gate-user = "SYSCAT" OR
     gate-work.gate-user = "SYSSTAT" OR
     gate-work.gate-user = "SYSFUN" THEN NEXT.

  assign
    has_id_ix          = no
    namevar   = ( if      gate-work.gate-type = "BUFFER"
                   /* 20060425-009 - for DB2, look for P_BUFFER */
                   then (IF is_db2 THEN "P_" ELSE "_")
                      + gate-work.gate-type /* coud be lower-case */
                      + "_" + gate-work.gate-name
                  else if gate-work.gate-type <> "SEQUENCE"
                   then            gate-work.gate-name
                  else if asc(substring(gate-work.gate-type,1,1,"character")) = 115
                   then "_seqt_" + gate-work.gate-name
                   else "_SEQT_" + gate-work.gate-name
                )
    typevar   = ( if gate-work.gate-type = "BUFFER"
                   then "VIEW"
                   else ENTRY(LOOKUP(gate-work.gate-type,pobjects),sobjects)
                )
    uservar   = gate-work.gate-user
    progvar   = gate-work.gate-prog
    spclvar   = ( if  gate-work.gate-qual = ""
                   then "%"
                   else gate-work.gate-qual
                ).
    
  if SESSION:BATCH-MODE and logfile_open
   then put unformatted
     gate-work.gate-type at 10
     gate-work.gate-name at 25 skip.


  RUN  prodict/odb/odb_fix.p (spclvar, OUTPUT spclvar-1, escp, bug1).
  RUN  prodict/odb/odb_fix.p (uservar, OUTPUT uservar-1, escp, bug8).
  RUN  prodict/odb/odb_fix.p (namevar, OUTPUT namevar-1, escp, no).
  RUN  prodict/odb/odb_fix.p (typevar, OUTPUT typevar-1, escp, no).
  assign typevar-1 = "'" + typevar-1 + "'". 
  
  IF gate-work.gate-type <> "PROCEDURE" THEN DO:
  
    /*-------------------------- SEQUENCES -----------------------------*/

    if gate-work.gate-type = "SEQUENCE"
        then do:  /* gate-work.gate-type = "SEQUENCE" */

      ASSIGN s = progvar.
      IF SESSION:SCHEMA-CHANGE = "new objects"  THEN 
      DO i = 1 TO 9999 WHILE can-find(FIRST s_ttb_seq
                       where s_ttb_seq.pro_name = progvar)
                       OR CAN-FIND(FIRST DICTDB._Sequence
                       WHERE DICTDB._Sequence._db-recid = drec_db
                         AND DICTDB._Sequence._Seq-name = progvar
                         AND DICTDB._Sequence._Seq-misc[2] <> uservar ) :
        progvar = SUBSTRING(s,1,32 - LENGTH(STRING(- i),"character"),"character") 
                  + STRING(- i).
      end.
      create s_ttb_seq.
      assign
        gate-work.ttb-recid = RECID(s_ttb_seq)
        s_ttb_seq.ds_name   = namevar 
        s_ttb_seq.ds_user   = uservar
        s_ttb_seq.ds_spcl   = uservar + ","
                          + ( if asc(substring(gate-work.gate-type
                                              ,1
                                              ,1
                                              ,"character"
                                    )         )  =  115
                                then "_seqp_"
                                else "_SEQP_" 
                            )
                          + substr(namevar,7,-1,"character") + ","
			  + "@op" + "," + "@val" + ","
        s_ttb_seq.gate-work = RECID(gate-work)
        s_ttb_seq.pro_name  = progvar.

      if TERMINAL <> "" and NOT batch-mode
        then DISPLAY 
          namevar @ msg[1]   ""   @ msg[4]
          progvar @ msg[2]   ""   @ msg[5]
          ""      @ msg[3]   ""   @ msg[6]
          with frame ds_make.

      NEXT.

    end.     /* gate-work.gate-type = "SEQUENCE" */


    /*---------------------------- TABLES ------------------------------*/

    RUN STORED-PROC DICTDBG.GetInfo (0).
    for each DICTDBG.GetInfo_buffer:
      assign doextent = ( DICTDBG.GetInfo_buffer.do_extent = "Y" ).
    end.
    CLOSE STORED-PROC DICTDBG.GetInfo.

    RUN STORED-PROC DICTDBG.SQLTables
                 (spclvar-1, uservar-1, namevar-1, typevar-1).
  
    for each DICTDBG.SQLTables_buffer:

      /* 20031205-003
         If the table name has underscore (_), we may get records for
         different tables, since '_' may be a search pattern depending on
         the driver settings/version. So we need to filter out anything
         that is not the table we are looking for.
      */
      IF TRIM(DICTDBG.SQLTables_buffer.name) NE ? AND 
         trim(namevar-1) NE TRIM(DICTDBG.SQLTables_buffer.name) THEN
         NEXT.

      assign
        table_name = ( if TRIM(DICTDBG.SQLTables_buffer.name) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.name)
                   )
        table_spcl = ( if TRIM(DICTDBG.SQLTables_buffer.qualifier) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.qualifier)
                   )
        table_type = ( if TRIM(DICTDBG.SQLTables_buffer.type) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.type)
                   )
        table_user = ( if TRIM(DICTDBG.SQLTables_buffer.owner) = ?
                        then "%"
                        else TRIM(DICTDBG.SQLTables_buffer.owner)
                   ).

      if DICTDBG.SQLTables_buffer.Remark MATCHES
                                "*(vendor(PROGRESS),product(PODBC)*"
          then RUN prodict/odb/odb_fprp.p 
            ( INPUT  DICTDBG.SQLTables_buffer.Remark,
              INPUT  "--*(vendor(PROGRESS),product(PODBC)",
              INPUT  "--*)",
              OUTPUT table-properties,
              OUTPUT table_comment
            ).

      /* SEND-SQL to get table remarks from SYSTABLES catalog table */
      IF is_as400 THEN DO:
          ASSIGN tblrem_sql = "select table_text from qsys2.systables where " + 
                              " table_name  = '" + DICTDBG.SQLTables_buffer.NAME +
                              "' and table_schema = '" + DICTDBG.SQLTables_buffer.OWNER +
                              "' ".
          RUN STORED-PROC DICTDBG.send-sql-statement dfth = PROC-HANDLE NO-ERROR ( tblrem_sql ).

          IF ERROR-STATUS:ERROR THEN ASSIGN table_comment = ?. 
          ELSE DO:
              FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth:
                  ASSIGN table_comment = proc-text.
              END.
          CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth.
          END.

          IF table_comment <> ? THEN 
             ASSIGN table_comment = TRIM(TRIM(TRIM(table_comment),"'")).
      END. /* End of is_as400 block to fetch table_text from SYSTABLES */
    end.

    CLOSE STORED-PROC DICTDBG.SQLTables.

    create s_ttb_tbl.

    assign
      gate-work.ttb-recid = RECID(s_ttb_tbl)
      s_ttb_tbl.ds_name   = table_name
      s_ttb_tbl.ds_recid  = 0
      s_ttb_tbl.ds_spcl   = ( if (table_spcl = "%" OR bug1) 
                             then ?
                             else table_spcl
                          )
      s_ttb_tbl.ds_type   =  gate-work.gate-type
      s_ttb_tbl.ds_user   = ( if table_user = "%" or bug28
                             then ?
                             else table_user 
                          )
      s_ttb_tbl.gate-work = RECID(gate-work)
      s_ttb_tbl.pro_desc  = ( if table_comment <> ""
                             then table_comment 
                             else s_ttb_tbl.pro_desc
                          )                               
      s_ttb_tbl.pro_name  = gate-work.gate-prog.
      
  

    if TERMINAL <> "" and NOT batch-mode
    then DISPLAY
      namevar @ msg[1]  "" @ msg[4]
      progvar @ msg[2]  "" @ msg[5]
      ""      @ msg[3]  "" @ msg[6]
      with frame ds_make.

    /* there is a bug in the ODBC-Driver. The stored-procedure GetFieldIds
     * chokes on Tables with no fields. We know that SysGams doesn't have
     * any fields, so we end the processing for SysGams right here. 
    */


    if gate-work.gate-name = "sysgams" then NEXT.
  
    /*---------------------------- FIELDS ------------------------------*/

    assign
    /* Get the ordinal number of fields in the table.		*/
      table_spcl_1 = ( if (spclvar-1 = "%" or spclvar-1 = ?)
                            then ""
                            else spclvar
                        )
      spcl_len         = length(table_spcl_1)
 
      table_user_1     = ( if (uservar-1 = "%" or uservar-1 = ?)
                            then ""
                            else uservar
                        )
      user_len         = length(table_user_1)


      dot1              = ( if table_spcl_1 = ""
                            then ""
                            else ( if bug34 
                                     then ":"
                                     else "."
                                 )
                        )

      dot2              = ( if (table_spcl_1 <> "" OR table_user_1 <> "")
                            then "."
                            else ""
                        )
      table_len          = length(table_name)

      full_table_name   = table_spcl_1 + dot1
		      + table_user_1 + dot2 + table_name
      shadow_col        = -1
      array_name        = "".

    /* 20000 is just an arbitrary # since we dont have a _file-number yet.*/
    RUN STORED-PROC DICTDBG.GetFieldIds 
                (s_ttb_tbl.pro_name, full_table_name, 20000, spcl_len,
                 user_len, table_len).

    assign i = 1.
    _loop:
    for each DICTDBG.GetFieldIds_buffer:
      IF DICTDBG.GetFieldIds_buffer.field-name BEGINS '_PROGRESS_RECID' OR
         DICTDBG.GetFieldIds_buffer.field-name BEGINS '_PROGRESS_ROWID' OR
         DICTDBG.GetFieldIds_buffer.field-name BEGINS 'PROGRESS_RECID' OR
         DICTDBG.GetFieldIds_buffer.field-name BEGINS 'PROGRESS_ROWID' THEN DO:                 
        IF s_ttb_tbl.ds_recid = 0 THEN DO:
          ASSIGN s_ttb_tbl.ds_recid = i
                 s_ttb_tbl.ds_msc23 = DICTDBG.GetFieldIds_buffer.field-name.
          IF is_as400 THEN ASSIGN s_ttb_tbl.ds_msc22 = string(i) + ",".
          ASSIGN i = i + 1.
        END. /* s_ttb_tbl.ds_recid = 0 */
         ELSE IF SUBSTRING(DICTDBG.GetFieldIds_buffer.field-name,
              (LENGTH(DICTDBG.GetFieldIds_buffer.field-name) - 6)) = "_IDENT_"
           THEN DO: /* OE00135573 fixed along with RECID implementation */
             IF is_as400 THEN 
                    assign s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + "," + string(i) + ",".
             ELSE 
                    assign s_ttb_tbl.ds_msc22 = string(i) + ",".
           ASSIGN i = i + 1.
         END.
                   
        NEXT _loop.
      END.  
 
      CREATE column-id.
      assign
        column-id.col-name = TRIM(DICTDBG.GetFieldIds_buffer.field-name)
        column-id.col-id   = i
        i                  = i + 1.

        /* Shave the quotes off.                                          */
      if (LENGTH(quote, "character") = 1) AND SUBSTRING(column-id.col-name,1,1) = quote THEN
        ASSIGN column-id.col-name = SUBSTRING(column-id.col-name
                                 ,2
                                 ,LENGTH(column-id.col-name, "character") - 2
                                 , "character"
                                 ).
    end.  /*  for each DICTDBG.GetFieldIds_buffer */

    /* if there are any doubled-up quotes, replace them with one quote */
    dq_index = index(column-id.col-name, CHR(34) + CHR(34) ).
    REPEAT WHILE dq_index > 0:
         ASSIGN 
           SUBSTRING(column-id.col-name, dq_index, 2, "character") = CHR(34)
           dq_index = index(column-id.col-name, CHR(34) + CHR(34)). 
    END.

    CLOSE STORED-PROC DICTDBG.GetFieldIds.
    RUN  prodict/odb/odb_fix.p (table_spcl, OUTPUT spclvar-1, escp, bug1).
    RUN  prodict/odb/odb_fix.p (table_user, OUTPUT uservar-1, escp, bug8).
    RUN  prodict/odb/odb_fix.p (table_name, OUTPUT namevar-1, escp, no).
    RUN STORED-PROC DICTDBG.SQLColumns (spclvar-1, uservar-1, namevar-1, ?).

    assign field-position = 0.

    for each DICTDBG.SQLColumns_buffer:

     /* 20031205-003
        If the table name has underscore (_), we may get records for
        different tables, since '_' may be a search pattern depending on
        the driver settings/version. So we need to filter out anything
        that is not from the table we want.
     */
     IF TRIM(namevar-1) NE TRIM(DICTDBG.SQLColumns_buffer.name) THEN
        NEXT.
		
		
      IF DICTDBG.SQLColumns_buffer.column-name begins "PROGRESS_RECID" OR
         DICTDBG.SQLColumns_buffer.column-name begins "_PROGRESS_RECID" OR
         DICTDBG.SQLColumns_buffer.column-name begins "_PROGRESS_ROWID"
       THEN DO:

         IF DICTDBG.SQLColumns_buffer.data-type = 4 /* int */ 
          THEN
            s_ttb_tbl.ds_msc15 = 1.
         IF DICTDBG.SQLColumns_buffer.data-type = -5 /* bigint */
          THEN
            s_ttb_tbl.ds_msc15 = 2.
      END.

      find first column-id
           where column-id.col-name = TRIM(DICTDBG.SQLColumns_buffer.column-name) NO-ERROR.
      IF NOT AVAILABLE column-id THEN NEXT.     
      assign field-position = column-id.col-id.
    
    assign
        fld-remark     = DICTDBG.SQLColumns_buffer.remarks
        fld-properties = "".
      if DICTDBG.SQLColumns_buffer.remarks MATCHES
                                    "*(vendor(PROGRESS),product(PODBC)*" 
       then RUN prodict/odb/odb_fprp.p 
            ( INPUT  DICTDBG.SQLColumns_buffer.remarks,
              INPUT  "--*(vendor(PROGRESS),product(PODBC)",
              INPUT  "--*)",
              OUTPUT fld-properties,
              OUTPUT fld-remark
              ).

      if can-do (fld-properties, "P")
        then assign
          s_ttb_tbl.ds_recid = field-position
          s_ttb_tbl.ds_msc23 = TRIM(DICTDBG.SQLColumns_buffer.column-name). 

      if can-do (fld-properties, "S") OR 
        DICTDBG.SQLColumns_buffer.column-name BEGINS "_S#_" OR
        DICTDBG.SQLColumns_Buffer.column-name BEGINS "U##" OR
        DICTDBG.SQLColumns_Buffer.column-name BEGINS "U__" then do:
        assign
          shadow_col      = field-position
          shadow_col_name = ( if LENGTH(quote, "character") = 1
                               then quote + column-id.col-name + quote
                               else column-id.col-name
                          ).

        NEXT.
      end.

      if can-do (fld-properties, "N") then do:
        if s_ttb_tbl.ds_msc22 = ?
           then assign s_ttb_tbl.ds_msc22 = "".
        assign s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22
				        + STRING(field-position) + ",".
      end.

      if can-do (fld-properties, "I") then NEXT.

      if   LENGTH (array_name, "character") >    0 
              and TRIM(DICTDBG.SQLColumns_buffer.column-name) BEGINS array_name
              then NEXT.

      do:

        assign
          l_dt  = { prodict/odb/odb_typ.i DICTDBG.SQLColumns_buffer.data-type  bug29 }
          m1 = 0.

        IF l_dt = "UNDEFINED" THEN DO:
          RUN error_handling
            ( 2, 
              s_ttb_tbl.ds_name, "" 
            ).
          RUN error_handling ( 3, "", "" ).

          FOR EACH s_ttb_fld WHERE s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):
            DELETE s_ttb_fld.
          END.
          DELETE s_ttb_tbl.
          CLOSE STORED-PROC DICTDBG.SQLColumns.
          FOR EACH column-id:
            DELETE column-id.
          END.
          NEXT.
        END.

        if (TRIM(DICTDBG.SQLColumns_buffer.column-name) MATCHES "*##1" OR
            (TRIM(DICTDBG.SQLColumns_buffer.column-name) MATCHES "*__1" ))
          and doextent then do:  /* Collect array elements & determine extent */

	  assign
	    m1         = 1
	    i          = LENGTH (TRIM(DICTDBG.SQLColumns_buffer.column-name), "character") - 1
	    array_name = SUBSTR (TRIM(DICTDBG.SQLColumns_buffer.column-name), 1, i, "character").

          RUN  prodict/odb/odb_fix.p
                 (table_spcl, OUTPUT spclvar-1,  escp, bug1).
          RUN  prodict/odb/odb_fix.p 
                (table_user,  OUTPUT uservar-1, escp, bug8).
          RUN  prodict/odb/odb_fix.p 
                (table_name,  OUTPUT namevar-1,  escp, no).


          RUN STORED-PROC DICTDBG.SQLColumns A_proc_handle = PROC-HANDLE
		       (spclvar-1, uservar-1, namevar-1, ?).

	  for each A_col where PROC-HANDLE = A_proc_handle:

        /* 20031205-003
           If the table name has underscore (_), we may get records for
           different tables, since '_' may be a search pattern depending on
           the driver settings/version. So we need to filter out anything
           that is not from the table we want.
        */
        IF TRIM(namevar-1) NE TRIM(A_col.name) THEN
           NEXT.

	    if NOT A_col.column-name BEGINS array_name then NEXT.
	    assign m2 = INTEGER (SUBSTR (A_col.column-name
	                              , i + 1
	                              , LENGTH (A_col.column-name
	                                       , "character") - i
	                              , "character"
	                       )      ).
	    if m2 > m1 then assign m1 = m2.

	  end. /* EACH A_col */
	  
	  CLOSE STORED-PROC DICTDBG.SQLColumns where PROC-HANDLE = A_proc_handle.

        end. /* Collect array elements & determine extent */

        { prodict/odb/odb_pul.i 
           &data-type    = "l_dt"
           &order-offset = "4000"  /* make sure we go well beyond the end */
           &extent       = "m1"
        }

      end. /* DO */

      /* OE00210200: This code is specific to DB2 database, which has the special columns with 'GENERATED AS IDENTITY' property.
         If the column is of type, 'GENERATED ALWAYS AS IDENTITY', append the 'rpos' value of the column to the list of
         un-updatable columns. And if the column if of type, 'GENERATED BY DEFAULT AS IDENTITY', append the 'rpos' value as a
         negative value, to diversify it from the 'GENERATED ALWAYS AS IDENTITY' columns. */
	  IF (INDEX(UPPER(_Db._Db-misc2[5]), "UDB") <> 0 OR INDEX(UPPER(_Db._Db-misc2[5]), "UDB DB") <> 0) THEN DO:
		  IF (s_ttb_fld.ds_msc24 EQ "ALWAYS") THEN DO:
			if s_ttb_tbl.ds_msc22 = ? then 
			   assign s_ttb_tbl.ds_msc22 = "".
			field_position = s_ttb_fld.ds_stoff.
			s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + string(field_position) + ",".
		  end.
 		  ELSE IF (s_ttb_fld.ds_msc24 EQ "BY_DEFAULT") THEN DO:
			if s_ttb_tbl.ds_msc22 = ? then 
			   assign s_ttb_tbl.ds_msc22 = "".
			field_position = s_ttb_fld.ds_stoff * -1.
			s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22 + string(field_position) + ",".
		  end.
	  END.

      if shadow_col > 0 then 
        assign s_ttb_fld.pro_case = FALSE  
               s_ttb_fld.ds_shd#  = shadow_col
               s_ttb_fld.ds_shdn  = shadow_col_name
               shadow_col         = -1
               shadow_col_name    = ? .

    end.      /* for each SQLColumns_buffer */
    
    CLOSE STORED-PROC DICTDBG.SQLColumns.			
				    
    /*----------------------------- INDEXES ------------------------------*/

    RUN  prodict/odb/odb_fix.p (table_spcl, OUTPUT spclvar-1, ?, bug1).
    RUN  prodict/odb/odb_fix.p (table_user, OUTPUT uservar-1, ?, bug8).
    RUN  prodict/odb/odb_fix.p (table_name, OUTPUT namevar-1, ?, no).

    RUN STORED-PROC DICTDBG.SQLStatistics(spclvar-1, uservar-1, namevar-1).
 
    assign
      indn         = 1
      unique-prime = NO.

    for each DICTDBG.SQLStatistics_buffer:

      /* Skip TBALE statistics.						*/
      if DICTDBG.SQLStatistics_buffer.type = 0 OR bug22 then NEXT. 
      
      IF DICTDBG.SQLStatistics_buffer.Column-name BEGINS '_PROGRESS_RECID' OR
         DICTDBG.SQLStatistics_buffer.Column-name BEGINS '_PROGRESS_ROWID' OR
         DICTDBG.SQLStatistics_buffer.Column-name BEGINS 'PROGRESS_RECID' OR
         DICTDBG.SQLStatistics_buffer.Column-name BEGINS 'PROGRESS_ROWID' THEN NEXT.
         
      assign 
        comp-name   = DICTDBG.SQLStatistics_buffer.Column-name.

      if bug4 then do:
        RUN extract_comp_names 
          ( INPUT  comp-name,
            OUTPUT temp-comp-name
          ).
        RUN prodict/odb/odb_qe.p
          ( INPUT-OUTPUT temp-comp-name,
            OUTPUT comp-num
           ).
        assign comp-name = temp-comp-name.
      end.
      else assign comp-num = 1.

      REPEAT comp-ind = 1 to comp-num:

        find first s_ttb_fld 
          where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
            and   s_ttb_fld.ds_name = TRIM(ENTRY(comp-ind, comp-name)) 
          no-lock no-error.

        if NOT available s_ttb_fld then do:  /*  NOT available s_ttb_fld */

           find first column-id 
            where column-id.col-name = TRIM(ENTRY(comp-ind, comp-name))
    	     no-error.

           find first s_ttb_fld
            where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
              and   s_ttb_fld.ds_shd# = column-id.col-id
    	       no-lock no-error.

    	   IF NOT available s_ttb_fld then do: 
    	     /* If not PROGRESS RECID field - complain. */
	     if s_ttb_tbl.ds_recid <> column-id.col-id
	       then RUN error_handling(1, comp-name, "").
               /*WARNING: Column &1 is hidden; it cannot be an index component*/
	     else if DICTDBG.SQLStatistics_buffer.seq-in-index = 1
	              and (DICTDBG.SQLStatistics_buffer.non-unique = 0 OR bug19)
	         then	has_id_ix = yes. /* progress_recid has a unique index */
    	     NEXT.
	   end.        
        end.     /*  NOT available where s_ttb_fld */
        
        if NOT available s_ttb_idx
           OR s_ttb_idx.ds_name <> TRIM(DICTDBG.SQLStatistics_buffer.index-name)
           OR s_ttb_idx.ttb_tbl <> RECID(s_ttb_tbl)
              then do:  /* index non-existent -> create new index */

           if TERMINAL <> "" and NOT batch-mode
            then DISPLAY
                TRIM(DICTDBG.SQLStatistics_buffer.name) @ msg[5] 
                user_env[1]                             @ msg[6]
                with frame ds_make.

           {prodict/gate/gat_puli.i
              &for-idx-name = "SQLStatistics_buffer.index-name"
              &for-idx-nam2 = "SQLStatistics_buffer.index-name"
              &for-obj-name = "SQLStatistics_buffer.index-name"
              &frame        = "ds_make"
              &idx-uniq-cond = "(bug19
                          OR DICTDBG.SQLStatistics_buffer.non-unique = 0)"
            }                                  /* try to recreate index */

        end.     /* index non-existent -> create new index */


     /*-------------------------- INDEX-FIELDS --------------------------*/

        CREATE s_ttb_idf.
          assign
             s_ttb_idf.pro_abbr  = FALSE
             s_ttb_idf.pro_asc   = TRIM(DICTDBG.SQLStatistics_buffer.collation) <> "D" 
             s_ttb_idf.pro_order = ( if bug4 and comp-num > 1
            			        then comp-ind
        			        else DICTDBG.SQLStatistics_buffer.seq-in-index
        		             )
             s_ttb_idf.ttb_fld   = RECID(s_ttb_fld)
             s_ttb_idf.ttb_idx   = RECID(s_ttb_idx).

      end.   /* REPEAT comp-ind = 1 to comp-num */
    
    end.   /* for each DICTDBG.SQLStatistics_buffer */
  
    CLOSE STORED-PROC DICTDBG.SQLStatistics.

    /* If there is a progress_recid without an index then we gently complain */
    if s_ttb_tbl.ds_recid > 0 /*and not has_id_ix*/ THEN DO:
       FIND FIRST s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl) NO-ERROR.
       IF NOT AVAILABLE s_ttb_idx 
        then RUN error_handling(5, s_ttb_tbl.ds_msc23, "").
                      /* "WARNING: No index for the RECID &1 field". */
    END.

    /*------- Find a Field which doesn't participate in an index. ------*/

    assign
      s_ttb_tbl.ds_msc13 = ?
      prev-prior         = 0.
    
    for each s_ttb_fld
      where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl):

       find first s_ttb_idf 
           where s_ttb_idf.ttb_fld = RECID(s_ttb_fld)
           no-error.

       if NOT available s_ttb_idf
          and ( s_ttb_tbl.ds_msc22 = ? 
           or    NOT can-do(s_ttb_tbl.ds_msc22,STRING(s_ttb_fld.ds_stoff))
               ) then do:  /* field is possible candidate */
          case s_ttb_fld.ds_type:
	     when "CHAR"          then fld-prior = 4. 
	     when "NUMERIC"       then fld-prior = 3. 
	     when "DECIMAL"       then fld-prior = 3. 
	     when "INTEGER"       then fld-prior = 5. 
	     when "SMALLINT"      then fld-prior = 5. 
	     when "FLOAT"         then fld-prior = 3. 
	     when "REAL"          then fld-prior = 3. 
	     when "DOUBLE"        then fld-prior = 3. 
	     when "VARCHAR"       then fld-prior = 2. 
	     when "LONGVARCHAR"   then fld-prior = 1. 
	     when "DATE"          then fld-prior = 5. 
	     when "TIME"          then fld-prior = 5. 
	     when "TIMESTAMP"     then fld-prior = 3. 
	     when "VARBINARY"     then fld-prior = 2. 
	     when "LONGVARBINARY" then fld-prior = 1. 
	     when "BINARY"        then fld-prior = 2. 
	     when "BIGINT"        then fld-prior = 3. 
	     when "TINYINT"       then fld-prior = 5. 
	     when "BIT"           then fld-prior = 5. 
	     OTHERWISE                 fld-prior = 1.
          end case.
          if fld-prior > prev-prior then 
            assign
       	         prev-prior         = fld-prior
                 s_ttb_tbl.ds_msc13 = s_ttb_fld.ds_stoff.
       end.     /* field is possible candidate */

    end.  /* for each s_ttb_fld */
  

    /*--------------------------- RECID-INDEX ----------------------------*/

    /* in Version 7.3 we needed a mandatory integer-field with a unique index
     * on it, to be used for RECID-functionality. Now we are able to use any
     * index, as long as it is unique.
     * In order to grant as much compatibility with previous versions as
     * possible, we now put both the old and the new version's info into
     * the required places. As long as there are indexes of "level" 0 or 4
     * selected, the schema can be used with a V7.3-client.
     * If another index gets selected, we put a message into the error-file
     * The new rules are:
     *    Level  Data-Types                andatory  unique   #(comp) misc2[1]
     *      1    integer only                 yes   &  yes  &   =1      a
     *      2    anything except date|float   yes   &  yes  &   =1      ax
     *      3    anything except float        yes   &  yes  &   =1      ax
     *      4    anything                     yes   &  yes  &   =1      ax
     *      5    integer only                 no    |  no   |   >1      u
     *      6    anything except date|float   no    |  no   |   >1      ux
     *      7    anything except float        no    |  no   |   >1      ux
     *      8    anything except date|float   no    |  no   |   >1      ux
     * a/u := automatically-selectable/user-definable
     * x   := NON V7.3-compatible
     * ( float can't be used for "="; date has some restrictions too )
    */
 
    if  s_ttb_tbl.ds_recid <= 0
      or s_ttb_tbl.ds_recid  = ?
      then do:  /* no progress_recid -> check indexes for ROWID usability */
    
       /* check all indexes and calculate their usability-level */
       for each s_ttb_idx
          where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl):
    
         for each s_ttb_idf 
            where s_ttb_idf.ttb_idx = RECID(s_ttb_idx):

           find first s_ttb_fld 
              where RECID(s_ttb_fld) = s_ttb_idf.ttb_fld.
           assign
              s_ttb_idx.hlp_fld#   = s_ttb_idx.hlp_fld# + 1
              s_ttb_idx.hlp_dtype# = maximum(s_ttb_idx.hlp_dtype#,
                          integer(string((s_ttb_fld.ds_type <> "integer"),"1/0")),
                          integer(string((s_ttb_fld.pro_type = "date"   ),"2/0")),
                          integer(string((s_ttb_fld.ds_type  = "float"  ),"3/0")) 
                                     )
              s_ttb_idx.hlp_mand   = s_ttb_idx.hlp_mand and s_ttb_fld.pro_mand
              s_ttb_idx.hlp_fstoff = s_ttb_fld.ds_stoff * -1
              s_ttb_idx.hlp_msc23  = ( if s_ttb_fld.ds_msc23 <> ?
                                      then s_ttb_fld.ds_msc23 
                                      else s_ttb_fld.ds_name
                                      ).
                                 
         end.  /* for each s_ttb_idfs of s_ttb_idx */

         assign
            s_ttb_idx.hlp_dtype# = ( if ( s_ttb_idx.hlp_dtype# = 0
                                    and s_ttb_idx.hlp_fld#   > 1 )
                                    then 1
                                    else s_ttb_idx.hlp_dtype#
                                    )
            s_ttb_idx.hlp_level  = ( if ( s_ttb_idx.hlp_mand = TRUE 
                                    and s_ttb_idx.pro_uniq = TRUE )
                                    then 1
                                    else 5
                                    ) 
                                    + s_ttb_idx.hlp_dtype#.

       end. /* for each s_ttb_idx */

       /* assign correct i-misc2[1]-values and select index */
       for each s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl)
             break by s_ttb_idx.hlp_slctd descending
                   by s_ttb_idx.hlp_level:

          if s_ttb_idx.hlp_slctd   /* previousely selected RowID index */
               and s_ttb_idx.hlp_level <> 0
               and s_ttb_idx.hlp_level <> 4
               then do: /* select it but schema NOT compatible with V7.3 anymore*/
             assign
                s_ttb_idx.ds_msc21 = "r" 
                                     + entry(s_ttb_idx.hlp_level,l_matrix)
                s_ttb_tbl.ds_recid = ?
                s_ttb_tbl.ds_msc23 = ?
                s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
          end.    /* select it but schema NOT compatible with V7.3 anymore*/
          else if first(s_ttb_idx.hlp_slctd)
                 and s_ttb_idx.hlp_level <= 4
                 then assign /* select this index */
                    s_ttb_idx.ds_msc21 = "ra"
                    s_ttb_tbl.ds_recid = s_ttb_idx.hlp_fstoff
                    s_ttb_tbl.ds_msc23 = s_ttb_idx.hlp_msc23
                    s_ttb_tbl.ds_rowid = s_ttb_idx.pro_idx#.
          else assign
              s_ttb_idx.ds_msc21 = entry(s_ttb_idx.hlp_level,l_matrix).

          /* OE00164266 - set the PROGRESS_RECID size if it is an integer */
          find first s_ttb_fld
           where s_ttb_fld.ttb_tbl = RECID(s_ttb_tbl)
             and  ABSOLUTE(s_ttb_fld.ds_stoff) = ABSOLUTE(s_ttb_tbl.ds_recid)
    	      no-lock no-error.
          IF available s_ttb_fld then do: 
            if s_ttb_fld.ds_type = "INTEGER"
             then
               s_ttb_tbl.ds_msc15 = 1. /* RECID is 4 byte */
            if s_ttb_fld.ds_type = "BIGINT"
             then
               s_ttb_tbl.ds_msc15 = 2. /* RECID is 8 byte */
          END.

       end.     /* for each s_ttb_idx */
    end.     /* no progress_recid -> check indexes for ROWID usability */

    /* PROGRESS-RECID-field -> reset recid-info of all indexes */
    if has_id_ix then 
    for each s_ttb_idx where s_ttb_idx.ttb_tbl = RECID(s_ttb_tbl):
       assign s_ttb_idx.ds_msc21 = ?.
    end.
      
    for each column-id:
      delete column-id.
    end.
  end. /* if <> procedure */
  ELSE DO:
  /******************************  Stored Procedure Records ****************/
     RUN STORED-PROC DICTDBG.SQLProcedures
                 (spclvar-1, uservar-1, namevar-1).
  

     for each DICTDBG.SQLProcs_buffer:

        /* 20031205-003
           If the proc name has underscore (_), we may get records for
           different procedures since '_' may be a search pattern depending on
           the driver settings/version. So we need to filter out anything
           that is not the procedure we are looking for.
        */
        IF TRIM(DICTDBG.SQLProcs_buffer.name) NE ? AND 
           /* if it has ";0" or ";1" at the end, don't use it to compare proc name */
           trim(namevar-1) NE SUBSTRING(TRIM(DICTDBG.SQLProcs_buffer.name),1,LENGTH(trim(namevar-1))) THEN
           NEXT.

        assign table_name = ( if TRIM(DICTDBG.SQLProcs_buffer.name) = ?
                              then "%"
                              else TRIM(DICTDBG.SQLProcs_buffer.name)
                             )
               table_spcl = ( if TRIM(DICTDBG.SQLProcs_buffer.qualifier) = ?
                              then "%"
                              else TRIM(DICTDBG.SQLProcs_buffer.qualifier)
                             )
               table_user = ( if TRIM(DICTDBG.SQLProcs_buffer.owner) = ?
                              then "%"
                              else TRIM(DICTDBG.SQLProcs_buffer.owner)
                             ).

     end.

     CLOSE STORED-PROC DICTDBG.SQLProcedures.

     IF substring(table_name,(length(table_name) - 1)) = ";1" THEN
        ASSIGN table_name = substring(table_name,1,(length(table_name) - 2)).

     create s_ttb_tbl.
     ASSIGN gate-work.ttb-recid = RECID(s_ttb_tbl)
            s_ttb_tbl.ds_name   = table_name
            s_ttb_tbl.ds_recid  = 0
            s_ttb_tbl.ds_msc13 = 1
            s_ttb_tbl.ds_spcl   = ( if (table_spcl = "%" OR bug1) 
                                   then ?
                                   else table_spcl
                                   )
            s_ttb_tbl.ds_type   =  gate-work.gate-type
            s_ttb_tbl.ds_user   = ( if table_user = "%" or bug28
                                    then ?
                                    else table_user 
                                   )
            s_ttb_tbl.gate-work = RECID(gate-work)
            s_ttb_tbl.pro_desc  = ( if table_comment <> ""
                                    then table_comment 
                                    else s_ttb_tbl.pro_desc
                                   )                               
            s_ttb_tbl.pro_name  = gate-work.gate-prog.
 
     if TERMINAL <> "" and NOT batch-mode then 
       DISPLAY
            namevar @ msg[1]  "" @ msg[4]
            progvar @ msg[2]  "" @ msg[5]
            ""      @ msg[3]  "" @ msg[6]
       with frame ds_make.
  
     /*---------------------------- Parameters ------------------------------*/
      /* Get the ordinal number of parameters in the procedure.		*/
     assign table_spcl_1 = ( if (spclvar-1 = "%" or spclvar-1 = ?)
                            then ""
                            else spclvar
                            )
            spcl_len     = length(table_spcl_1)
 
            table_user_1 = ( if (uservar-1 = "%" or uservar-1 = ?)
                             then ""
                             else uservar
                            )
            user_len     = length(table_user_1)
            dot1         = ( if foreign_dbms = "Informix"
                             then ":"
                             else "."
                            )
            dot2         = ( if (table_spcl_1 <> "" OR table_user_1 <> "")
                             then "."
                             else ""
                           )
            table_len    = length(table_name)
            full_table_name   = table_spcl_1 + dot1
	 	             + table_user_1 + dot2 + table_name
            shadow_col        = -1
            array_name        = "".

     RUN prodict/odb/odb_fix.p (table_spcl, OUTPUT spclvar-1, escp, bug1).
     RUN prodict/odb/odb_fix.p (table_user, OUTPUT uservar-1, escp, bug8).
     RUN prodict/odb/odb_fix.p (table_name, OUTPUT namevar-1, escp, no).

     RUN STORED-PROC DICTDBG.SQLProcColumns (spclvar-1, uservar-1, namevar-1, ?).

     assign field-position = 0.
     
     _col-loop:
     for each DICTDBG.SQLProcCols_buffer:

        /* 20031205-003
           If the proc name has underscore (_), we may get records for
           different procedures since '_' may be a search pattern depending on
           the driver settings/version. So we need to filter out anything
           that is not the procedure we are looking for.
        */
        /* if it has ";0" or ";1" at the end, don't use it to compare proc name */
        IF trim(namevar-1) NE SUBSTRING(TRIM(DICTDBG.SQLProcCols_buffer.name),1,LENGTH(trim(namevar-1))) THEN
           NEXT.

        assign field-position = field-position + 1
               fld-remark     = DICTDBG.SQLProcCols_buffer.remarks
               fld-properties = "".
       
        IF CAPS(DICTDBG.SQLProcCols_buffer.Column-name) = "RETURN_VALUE" THEN DO:
            assign field-position = field-position - 1.
            NEXT _col-loop.
        end.    
        if can-do (fld-properties, "P") then 
           assign s_ttb_tbl.ds_recid = field-position
                  s_ttb_tbl.ds_msc23 = TRIM(DICTDBG.SQLProcCols_buffer.column-name). 

        if can-do (fld-properties, "S") then do:
           assign shadow_col      = field-position
                  shadow_col_name = ( if LENGTH(quote, "character") = 1
                                      then quote + column-id.col-name + quote
                                      else column-id.col-name
                                     ).

           NEXT.
        end.

        if can-do (fld-properties, "N") then do:
           if s_ttb_tbl.ds_msc22 = ? then 
              assign s_ttb_tbl.ds_msc22 = "".
           assign s_ttb_tbl.ds_msc22 = s_ttb_tbl.ds_msc22
	  			        + STRING(field-position) + ",".
        end.

        if can-do (fld-properties, "I") then NEXT.

        if LENGTH (array_name, "character")              >    0 
            and TRIM(DICTDBG.SQLProcCols_buffer.column-name) BEGINS array_name
            then NEXT.

        do:

           assign
             l_dt  = { prodict/odb/odb_typ.i DICTDBG.SQLProcCols_buffer.data-type  bug29 }
             m1 = 0.

           if (TRIM(DICTDBG.SQLProcCols_buffer.column-name) MATCHES "*##1" OR
            (TRIM(DICTDBG.SQLProcCols_buffer.column-name) MATCHES "*__1" AND foreign_dbms = "Informix"))
                 and doextent then do:  /* Collect array elements & determine extent */

	      assign
	         m1         = 1
	         i          = LENGTH (TRIM(DICTDBG.SQLProcCols_buffer.column-name), "character") - 1
	         array_name = SUBSTR (TRIM(DICTDBG.SQLProcCols_buffer.column-name), 1, i, "character").

             RUN  prodict/odb/odb_fix.p
                 (table_spcl, OUTPUT spclvar-1,  escp, bug1).
             RUN  prodict/odb/odb_fix.p 
                 (table_user,  OUTPUT uservar-1, escp, bug8).
             RUN  prodict/odb/odb_fix.p 
                 (table_name,  OUTPUT namevar-1,  escp, no).


             RUN STORED-PROC DICTDBG.SQLProcColumns P_proc_handle = PROC-HANDLE
		       (spclvar-1, uservar-1, namevar-1, ?).

	     for each P_col where PROC-HANDLE = P_proc_handle:

            /* 20031205-003
               If the proc name has underscore (_), we may get records for
               different procedures since '_' may be a search pattern depending on
               the driver settings/version. So we need to filter out anything
               that is not the procedure we are looking for.
            */
            /* if it has ";0" or ";1" at the end, don't use it to compare proc name */
            IF trim(namevar-1) NE SUBSTRING(TRIM(P_col.name),1,LENGTH(trim(namevar-1))) THEN
               NEXT.

	        if NOT P_col.column-name BEGINS array_name then NEXT.
	        assign m2 = INTEGER (SUBSTR (P_col.column-name
	                              , i + 1
	                              , LENGTH (P_col.column-name
	                              , "character") - i
	                              , "character"
	                                )      ).
	        if m2 > m1 then assign m1 = m2.

	     end. /* EACH P_col */
	  
	     CLOSE STORED-PROC DICTDBG.SQLProcColumns where PROC-HANDLE = P_proc_handle.

           end. /* Collect array elements & determine extent */

           { prodict/odb/odb_pulp.i 
               &data-type    = "l_dt"
               &order-offset = "4000"  /* make sure we go well beyond the end */
               &extent       = "m1"
            }

        end. /* DO */

        if   shadow_col > 0 then 
           assign s_ttb_fld.pro_case = FALSE  
                  s_ttb_fld.ds_shd#  = shadow_col
                  s_ttb_fld.ds_shdn  = shadow_col_name
                  shadow_col         = -1
                  shadow_col_name    = ? .

     end.      /* for each SQLProcCols_buffer */
    
     CLOSE STORED-PROC DICTDBG.SQLProcColumns.

   END. /* = PROCEDURE */  
end. /* end gate-work */

/**/&IF "{&DS_DEBUG}" = "DEBUG"
/**/ &THEN
/**/
/**/ message "odb_pul.i: DS_DEBUG turned on!" view-as alert-box.
/**/
/**/ run error_handling(4, "*****----- END odb_pul.p!!! -----*****" ,"").
/**/
/**/  output stream s_stm_errors to gate-work.d.
/**/  for each hlp-work no-lock: 
/**/    display stream s_stm_errors hlp-work with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_tbl.d.
/**/  for each s_ttb_tbl no-lock: 
/**/    display stream s_stm_errors s_ttb_tbl with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_fld.d.
/**/  for each s_ttb_fld no-lock: 
/**/    display stream s_stm_errors 
/**/     RECID(s_ttb_fld) format "zzzzzz9" label "RECID"
/**/     s_ttb_fld.pro_name s_ttb_fld.ttb_tbl  s_ttb_fld.pro_type
/**/     s_ttb_fld.ds_prec  format "zz9-" label "prc"
/**/     s_ttb_fld.ds_scale format "zz9-" label "scl"
/**/     s_ttb_fld.ds_lngth format "zz9-" label "lng"
/**/     s_ttb_fld.ds_radix format "zz9-" label "rdx"
/**/     s_ttb_fld.ds_msc23 s_ttb_fld.ds_msc24
/**/     s_ttb_fld.ds_shdn  s_ttb_fld.ds_shd# format "zz9-" label "sh#"
/**/     s_ttb_fld.ds_name  s_ttb_fld.ds_stoff s_ttb_fld.ds_type
/**/     s_ttb_fld.ds_stdtype format "zz9-" label "std"
/**/     with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_fl1.d.
/**/  for each s_ttb_fld no-lock: 
/**/    display stream s_stm_errors 
/**/     RECID(s_ttb_fld) format "zzzzzz9" label "RECID"
/**/     s_ttb_fld.pro_name  s_ttb_fld.ttb_tbl   s_ttb_fld.pro_case
/**/     s_ttb_fld.pro_dcml  s_ttb_fld.pro_desc  s_ttb_fld.pro_extnt
/**/     s_ttb_fld.pro_frmt  s_ttb_fld.pro_init  s_ttb_fld.pro_mand
/**/     s_ttb_fld.pro_order s_ttb_fld.pro_type
/**/     with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_idx.d.
/**/  for each s_ttb_idx no-lock: 
/**/    display stream s_stm_errors 
/**/     RECID(s_ttb_idx)     format "zzzzzz9" label "RECID"
/**/     s_ttb_idx.pro_name s_ttb_idx.ttb_tbl 
/**/     s_ttb_idx.pro_prim s_ttb_idx.pro_actv 
/**/     s_ttb_idx.pro_uniq    
/**/     s_ttb_idx.pro_idx#   format "zz9-"    label "ix#"
/**/     s_ttb_idx.ds_name    s_ttb_idx.ds_msc21
/**/     s_ttb_idx.hlp_dtype  format "zz9-"    label "dty#"
/**/     s_ttb_idx.hlp_fld#   format "zz9-"    label "fld#"
/**/     s_ttb_idx.hlp_fstoff format "zz9-"    label "fst#"
/**/     s_ttb_idx.hlp_level  format "9"       label "L"
/**/     s_ttb_idx.hlp_mand   s_ttb_idx.hlp_msc23  
/**/     with width 255. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_idf.d.
/**/  for each s_ttb_idf no-lock: 
/**/    display stream s_stm_errors s_ttb_idf. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/  output stream s_stm_errors to s_ttb_seq.d.
/**/  for each s_ttb_seq no-lock: 
/**/    display stream s_stm_errors s_ttb_seq. 
/**/    end.
/**/  output stream s_stm_errors close.
/**/
/**/  &ENDIF

IF NOT batch-mode
 then SESSION:IMMEDIATE-DISPLAY = no.

RUN adecomm/_setcurs.p ("").

IF NOT batch-mode
 then HIDE FRAME ds_make NO-PAUSE.

RETURN.




/*********************************************************************
* Copyright (C) 2000,2007-08, 2009 by Progress Software Corporation. All *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Procedure prodict/odb/_odb_sdb.p
   Created February 18, 2000
   Donna L. McMann
   
   This procedure assigns information to the _db record that is needed
   before processing is done via protoodb.p  The bug flags were not
   being assigned early enough in the process for the DataServer to
   know what to do.
   History :
   knavneet 07/24/07 For DB2/400 append the library name to _Db-misc2[1] if it is not empty string. This can be used as default lib while schema update 
   nagaraju 10/21/09 Support for computed column RECID in MSSDS - OE00186593 
*/   

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/gate/odb_ctl.i }
&UNDEFINE DATASERVER

DEFINE VARIABLE driver-prefix	 AS CHARACTER NO-UNDO.
DEFINE VARIABLE escape_char      AS CHARACTER NO-UNDO.
DEFINE VARIABLE quote_char       AS CHARACTER NO-UNDO.
DEFINE VARIABLE i	         AS INTEGER   NO-UNDO.
DEFINE VARIABLE found	         AS INTEGER   NO-UNDO.
DEFINE VARIABLE clnt_vers           AS CHARACTER NO-UNDO.

FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.  
RUN STORED-PROC DICTDBG.GetInfo (0).

FOR EACH DICTDBG.GetInfo_buffer:
   IF (LENGTH(DICTDBG.GetInfo_buffer.escape_char,"character") < 1)
     THEN  escape_char = " ".
   ELSE  escape_char = DICTDBG.GetInfo_buffer.escape_char .
   IF (LENGTH(DICTDBG.GetInfo_buffer.quote_char,"character") < 1)
      THEN  quote_char = " ".
   ELSE  quote_char = DICTDBG.GetInfo_buffer.quote_char.

   IF INTEGER(SUBSTRING(DICTDBG.GetInfo_buffer.dbms_version,1,2)) >= 7 AND
      DICTDBG.GetInfo_buffer.dbms_name BEGINS "Microsoft SQL" THEN
       RETURN "wrg-ver".

   ASSIGN DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name
          DICTDB._Db._Db-misc2[2] = DICTDBG.GetInfo_buffer.driver_version
          DICTDB._Db._Db-misc2[3] = escape_char + quote_char
          DICTDB._Db._Db-misc2[5] = DICTDBG.GetInfo_buffer.dbms_name + " " 
  			        + DICTDBG.GetInfo_buffer.dbms_version 
          DICTDB._Db._Db-misc2[6] = DICTDBG.GetInfo_buffer.odbc_version
          DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver
  		                          + ",Client Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_clnt
  		                          + ",Server Ver #:"
  		                          + DICTDBG.GetInfo_buffer.prgrs_srvr
                                          + ","
          DICTDB._Db._Db-misc2[8] = DICTDBG.GetInfo_buffer.dbms_name
          driver-prefix    = ( IF DICTDB._Db._Db-misc2[1] BEGINS "QE"
                              THEN SUBSTRING(DICTDB._Db._Db-misc2[1]
                                      ,1
                                      ,LENGTH(DICTDB._Db._Db-misc2[1]
                                              ,"character") - 6
                                      ,"character")
  		                       ELSE DICTDB._Db._Db-misc2[1] )
          DICTDB._Db._Db-misc2[4] = "".
 
    /* wait until here to add library name so that driver-prefix is correctly set
       to the driver name only.
    */
   IF user_library <> "" AND user_library <> "*" THEN 
    ASSIGN DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name + "," + UPPER(user_library).

   /* If client version is formatted w/"sh_min", the client is OpenEdge 10.1A or greater
    * which knows about the dictionary version number
    */
      IF INDEX(DICTDBG.GetInfo_buffer.prgrs_clnt, ",(sh_min=") <> 0 THEN
        DICTDB._Db._Db-misc2[7] = DICTDB._Db._Db-misc2[7] + " Schema Holder Ver#: ".
       
  REPEAT i = 1 TO 80:
    IF ( CAN-DO(odbc-bug-list[i], driver-prefix) OR
         CAN-DO(odbc-bug-list[i], "ALL") ) AND
         NOT CAN-DO(odbc-bug-excld[i], driver-prefix) THEN
      ASSIGN DICTDB._Db._Db-misc2[4] = DICTDB._Db._Db-misc2[4]
                                   + string(i) + "," .
  END. 
END. 
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
./*-----------------------------------------------------------------------

File:
    prodict/odb/_odb_sys.p
    
Description:
    depending on the input code this routines either creates/updates
    the metaschema-info for the foreign db, or returns specifique info.

Input Parameter:
    system      a   add meta-schema tables
                c   can-delete this _db? (:= no userdefined tables?)
                f   supply list of foreign-names of foreign meta-schema
                p   supply list of progress-names of foreign meta-schema
                q   query for capabilities
                u   supply list of un{dump|load}able foreign object-types

Output Parameter:
    system      a       none
                c       "ok"  or  ""  for "can-delete"  or  "can't delete"
                f,p,u   list of objects
                q       list of allowed/supported functions/features
                
History:
    04/20/06    fernando    Added NOTTCACHE define - 20050930-006  
    07/13/98    D. McMann   Added _Owner to _File finds
    95/08       hutegger    extracted non-queryable objects from l_sys-obj
                            assignment, so that report-builder can use it
                            too (-> odb/odb_sys.i)
    95/08       hutegger    added support for "f" and "p"; plus 
                            auto-update functionality for meta-schema
    94/11       gfs         Added 'add' to table 
    94/08       hutegger    Index-Capabilities: u changed from 
                            unique-index-allowed to 
                            change-uniqueness-allowed

-----------------------------------------------------------------------*/
/*h-*/

/*===========================  DEFINITIONS ============================*/
&GLOBAL-DEFINE NOTTCACHE 1
{ prodict/dictvar.i }

DEFINE INPUT        PARAMETER dbkey  AS RECID     NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER system AS CHARACTER NO-UNDO.

DEFINE VARIABLE               l_schema-ok   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE               l_sys-obj     AS CHARACTER NO-UNDO.
DEFINE VARIABLE               l_sys-obj-f   AS CHARACTER NO-UNDO.

/*=============================  TRIGGERS  ============================*/

/*=======================  INTERNAL PROCEDURES  =======================*/

/*=========================  INITIALIZATIONS  =========================*/

/* initialize system-objects list */
assign
  l_sys-obj   = {prodict/odb/odb_sys.i}
  l_sys-obj-f = "".
/* NOTE: If you add a new foreign-meta-schema table be sure to append
 *       its progress-name and foreign-name TO THE END of the lists
 *       above. This way we automatically upgrade old schemaholders
 *       with the new tables.
 */

/* check if meta-schema is up-to-date * /
find first DICTDB._File
  where RECID(DICTDB._File) = dbkey
  and   DICTDB._File._File-name = entry(num-entries(l_sys-obj),l_sys-obj)
  and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
  no-lock no-error. / **/
assign
  l_schema-ok = available DICTDB._File OR dbkey = ?.

/*============================  MAIN CODE  ============================*/


/*
system = "f" for list of foreign-names of meta-schema-objects
-------------------------------------------------------------
*/
IF      system BEGINS "f"
 then assign system = l_sys-obj-f.


/*
system = "p" for list of progress-names of meta-schema-objects
--------------------------------------------------------------
*/
ELSE IF system BEGINS "p"
 then assign system = l_sys-obj.


/*
system = "a" for add system tables
----------------------------------
*/
ELSE IF system BEGINS "a" THEN DO: /* add meta-schema definitions */
  RUN adecomm/_setcurs.p ("WAIT").
  RUN "prodict/odb/_odb_crp.p" (dbkey).
  RUN adecomm/_setcurs.p ("").
END.


/*
system = "c" for can-remove system tables
-----------------------------------------
*/
ELSE IF system BEGINS "c" THEN DO: /* can remove entire schema? */
  /* return OK if the database contains no user files and can be deleted */
  FIND FIRST DICTDB._File
    WHERE DICTDB._File._Db-recid = dbkey
    AND   LOOKUP(DICTDB._File._File-name,l_sys-obj) = 0
    and (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
    NO-ERROR.
  system = STRING(AVAILABLE DICTDB._File,"/ok").
END.


/*
system = "q" for query
----------------------
  ENTRY 1 = valid database options
            a=after_add, c=can_delete, d=do_delete, u=userid/passwd_supported
  ENTRY 2 = valid file options
            a=add, c=can_copy_fields, d=delete, f=chg_foreign_name,
            g=get_foreign_name, n=can_add_new_fields, o=get_ownername,
            r=rename, s=chg_foreign_size, t=chg_foreign_type
  ENTRY 3 = valid index options
            a=add, b=idxbuild, d=delete, i=inactivate_index,
            n=non-unique_indexes_allowed, r=rename, s=set_primary,
            u=change uniqueness_allowed, w=word_index, 
             #=index-number-to-be-generated
  ENTRY 4 = load size
  ENTRY 5 = db class and naming conventions
            0=progress_db 1=stand_alone_file 2=part_of_database
            l=logical_name_applies, p=physical_name_applies
  ENTRY 6 = max number index components
  ENTRY 7 = name of sysadmin user ("SA", "DBA", "SYSTEM", "MANAGER", etc.)
  ENTRY 8 = name of system tables ("SYS.*", etc.)
  ENTRY 9 = three-letter dictionary code
  ENTRY 10 = valid sequence options
            a=can_add, d=can_delete, m=can-modify-anything-beyond-name
            n=has_foreign_name o=has_owner, r=can_rename, s=seq_supported
  ENTRY 11 = default-value for code-page
*/
ELSE IF system BEGINS "q" THEN DO:
  system = "acdu,adgor,adnrsu#,100,2lp,16,?,?,odb,nors,iso8859-1".
END.


/*
system = "u" for unloadable/undumpable file types
-------------------------------------------------
*/
ELSE IF system BEGINS "u" THEN DO:
  system = "BUFFER,PROCEDURE".
END.

RETURN.
/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/* _odb_typ.p - Odbc-to-Progress datatype conversion subroutine */

/*
Pass parameters, and this routine will fill in the unknowns, as long as
io-pro-type or io-gate-type is input.

  in:  io-pro-type  = ? or Progress datatype
       io-length    = ? or _Fld-stlen; size, or 0 for variable length
       io-dtype     = ? or _Fld-stdtype; gate datatype code for _Fld-stdtype
       io-gate-type = ? or Odbc datatype
  out: io-pro-type  = Progress datatype
       io-length    = _Fld-stlen
       io-dtype     = _Fld-stdtype
       io-gate-type = Odbc datatype
       io-format    = suggested format

To get the list of progress types that can be mapped to a particular
gateway type:
  in:  io-pro-type  = "get-list"
       io-gate-type = ?
  out: io-pro-type = comma separated list of pro_types

To get the Odbc-to-PROGRESS tables copied to the environment:
  in:  io-pro-type  = ?
       io-gate-type = ?
  out: user_env[11] = gate_desc
       user_env[12] = gate_type
       user_env[13] = gate_stlen
       user_env[14] = gate_stdtype
       user_env[15] = pro_type
       user_env[16] = gate_family
       user_env[17] = pro_format

  Note: gate_family is the data type family.  This indicates which data
  types can be changed to which other types - only types within the same
  family can be switched with each other.  0 = an orphan: cannot be changed.
*/

/* history:
    94/07/14    hutegger    added output of format in user_env[17] 
                            plus support of i, l, # for formats
                            plus usage of this program for _xxx_mak.p
                            
    04/17/02    D. McMann replaced "?" with "l" for logical data types 
    06/09/02    D. McMann added format x(26) for timestamp
    06/13/06    fernando  Support for bigint
    08/24/06    rkumar replaced "c" with "99:99:99" for TIME data type 
*/ 

                            
/* NOTES for gate_config: 
1) Standard character string must be first in table! 
2) All entries that are the same gateway type must be contiguous in the 
   table.
3) the format can contain either 
   * a specific format                                             OR 
   * {c,d,i,l,#} for (character, date, integer, logical, decimal} to use 
     the format created by the hardcoded algorithm in _xxx_mak.i   
   
*/ 

DEFINE VARIABLE gate-config AS CHARACTER EXTENT 42 NO-UNDO INITIAL [
  /*description      datatype      sz cd  pro type  fm format*/
  /*-----------      --------      -- --  --------  -- ------*/ 
  "Char,	         Char,         0, 35, character,0, |c",
  "Longvarbinary,    Longvarbinary,0, 40, character,0, |c",
  "Time,             Time,         0, 143,character,0, |99:99:99",
  "Timestamp,	     Timestamp,	   0, 44, character,a, |x(26)",
  "Timestamp,	     Timestamp,	   0, 44, date,     a, |d",
  "Longvarchar,	     Longvarchar,  0, 37, character,0, |c",
  "Binary,           Binary,       0, 38, character,0, |c",
  "Varbinary,	     Varbinary,    0, 39, character,0, |c",
  "Date,             Date,         0, 43, date,     0, |d",
  "Numeric,          Numeric,      0, 136,decimal,  1, |#",
  "Numeric,          Numeric,      0, 136,integer,  1, |i",
  "Numeric,          Numeric,      0, 136,int64,    1, |i",
  "Decimal,          Decimal,      0, 236,decimal,  2, |#",
  "Decimal,          Decimal,      0, 236,integer,  2, |i",
  "Decimal,          Decimal,      0, 236,int64,    2, |i",
  "Integer,          Integer,      0, 33, integer,  3, |i",
  "Integer,          Integer,      0, 33, decimal,  3, |#",
  "Integer,          Integer,      0, 33, int64,    3, |i",
  "Integer,          Integer,      0, 33, logical,  3, |l",
  "Smallint,	     Smallint,     0, 32, integer,  4, |i",
  "Smallint,         Smallint,     0, 32, decimal,  4, |#",
  "Smallint,	     Smallint,     0, 32, int64,    4, |i",
  "Smallint,	     Smallint,     0, 32, logical,  4, |l",
  "Float,            Float,        0, 34, decimal,  5, |#",
  "Float,            Float,        0, 34, integer,  5, |i",
  "Float,            Float,        0, 34, int64,    5, |i",
  "Real,             Real,         0, 48, decimal,  6, |#",
  "Real,             Real,         0, 48, integer,  6, |i",
  "Real,             Real,         0, 48, int64,    6, |i",
  "Double,           Double,       0, 134,decimal,  7, |#",
  "Double,           Double,       0, 134,integer,  7, |i",
  "Double,           Double,       0, 134,int64,    7, |i",
  "Varchar,          Varchar,      0, 36, character,0, |c",
  "Bigint,           Bigint,       0, 234,int64,    8, |i",
  "Bigint,           Bigint,       0, 234,decimal,  8, |#",
  "Bigint,           Bigint,       0, 234,integer,  8, |i",
  "Tinyint,          Tinyint,      0, 31, integer,  9, |->>9",
  "Tinyint,          Tinyint,      0, 31, decimal,  9, |->>>>9",
  "Tinyint,          Tinyint,      0, 31, int64,    9, |->>9",
  "Tinyint,          Tinyint,      0, 31, logical,  9, |l",
  "Bit,	     	     Bit,          0, 41, logical,  0, |l",
  ?
].

/* from prodict/dictvar.i */
DEFINE SHARED VARIABLE is-pre-101b-db  AS LOGICAL NO-UNDO.

{ prodict/user/uservar.i }

DEFINE INPUT-OUTPUT PARAMETER io-dtype     AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-length    AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-pro-type  AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-gate-type AS CHARACTER NO-UNDO.
DEFINE       OUTPUT PARAMETER io-format    AS CHARACTER NO-UNDO.

DEFINE              VARIABLE  c            AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_desc    AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_stdtype AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_stlen   AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_type    AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_family  AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  i            AS INTEGER   NO-UNDO.
DEFINE              VARIABLE  pro_format   AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  pro_type     AS CHARACTER NO-UNDO.

/* If we want the list of progress types that match a given gateway
   type, then just get that.  A gateway type that matches multiple
   Progress types are in contiguous entries in the gate-config table.
*/
IF io-gate-type <> ? AND io-pro-type = "get-list" THEN DO:
  DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
    IF TRIM(ENTRY(2,gate-config[i])) = io-gate-type THEN
       LEAVE.
  END.
  io-pro-type = "".
  DO WHILE TRIM(ENTRY(2,gate-config[i])) = io-gate-type:
     /* dont' allow int64 if a pre-10.1B schema holder */
     IF NOT is-pre-101b-db OR TRIM(ENTRY(5,gate-config[i])) NE "int64" THEN
        io-pro-type = io-pro-type + (IF io-pro-type = "" THEN "" ELSE ",") +
          	       	  TRIM(ENTRY(5,gate-config[i])).
    i = i + 1.
  END.
  RETURN.
END.

/* Compose comma delimited lists of each "column" of the gate-config 
   array (leaving just the format in gate-config itself).
*/
DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
   /* dont' allow int64 if a pre-10.1B schema holder */
   IF NOT is-pre-101b-db OR TRIM(ENTRY(5,gate-config[i])) NE "int64" THEN
      ASSIGN
        gate_desc      = gate_desc    + TRIM(ENTRY(1,gate-config[i])) + ","
        gate_type      = gate_type    + TRIM(ENTRY(2,gate-config[i])) + ","
        gate_stlen     = gate_stlen   + TRIM(ENTRY(3,gate-config[i])) + ","
        gate_stdtype   = gate_stdtype + TRIM(ENTRY(4,gate-config[i])) + ","
        pro_type       = pro_type     + TRIM(ENTRY(5,gate-config[i])) + ","
        gate_family    = gate_family  + TRIM(ENTRY(6,gate-config[i])) + ","
        gate-config[i] = SUBSTRING(gate-config[i]
                                  ,INDEX(gate-config[i],"|") + 1
                                  ,-1
                                  ,"character"
                                  )
        pro_format     = pro_format   + gate-config[i] + "|".
END.

IF io-gate-type = ? AND io-pro-type = ? THEN DO:
  ASSIGN
    user_env[11] = gate_desc
    user_env[12] = gate_type
    user_env[13] = gate_stlen
    user_env[14] = gate_stdtype
    user_env[15] = pro_type
    user_env[16] = gate_family
    user_env[17] = pro_format.
/*  ASSIGN
 *    user_env[11] = pro_type
 *    user_env[12] = gate_type
 *    user_env[13] = gate_stdtype
 *    user_env[14] = gate_stlen
 *    user_env[15] = gate_desc
 *    user_env[16] = gate_family.
 */
  RETURN.
END.

i = 0.

/* PROGRESS datatype -> ODBC datatype (io-pro-type given, io-gate-type = ?) */
IF io-gate-type = ? THEN DO: 
  DO i = 1 TO NUM-ENTRIES(gate_type) - 1:
    IF io-pro-type = ENTRY(i,pro_type)
      AND INTEGER(ENTRY(i,gate_stdtype)) = io-dtype
      AND (INTEGER(ENTRY(i,gate_stlen))  = io-length
        OR INTEGER(ENTRY(i,gate_stlen))  = 0) THEN LEAVE.
  END.
  io-gate-type = ENTRY(i,gate_type).
END.
ELSE DO: /* io-gate-type given, io-pro-type may be ? */
   i = LOOKUP(io-gate-type,gate_type).
   IF io-pro-type  = ? THEN 
      io-pro-type = ENTRY(i,pro_type).
   ELSE 
      /* Make sure we have the entry that matches both io-pro-type AND
      	 io-gate-type.
      */
      IF io-pro-type <> ENTRY(i,pro_type) THEN
	DO i = i + 1 to NUM-ENTRIES(gate_type) - 1:
	   IF io-pro-type = ENTRY(i,pro_type) AND
	      io-gate-type = ENTRY(i,gate_type) THEN LEAVE.
	END.
END.

ASSIGN
  io-length   = (IF INTEGER(ENTRY(i,gate_stlen)) = 0 THEN io-length
                ELSE INTEGER(ENTRY(i,gate_stlen)))
  io-format   = (IF gate-config[i] = "d" THEN "99/99/99"
                ELSE IF gate-config[i] = "c" THEN
                  "x(" + STRING(IF io-length = 0 THEN 8 ELSE io-length) + ")"
                ELSE gate-config[i])
  io-dtype    = INTEGER(ENTRY(i,gate_stdtype)).

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Get the next available _idx-num. This program is required since we don't
   get a number from the dbmgr like we get from the PROGRESS dbmgr.
*/
DEFINE INPUT PARAMETER file_recid AS RECID NO-UNDO.
DEFINE OUTPUT PARAMETER index-num AS INTEGER NO-UNDO.

index-num = 0.

FOR EACH DICTDB._Index WHERE DICTDB._Index._File-recid = file_recid NO-LOCK:
  IF DICTDB._Index._idx-num <> ? AND DICTDB._Index._idx-num > index-num THEN
    index-num = DICTDB._Index._idx-num.
END.
index-num = index-num + 1.
RETURN.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _snd_sql.p - SEND.SQL to Sybase to create Sybase objects. */

/*++
 
Author:     Rob Adams

Component:  Protoxxx   (progress to foreign datamanager)

Purpose:    Read in SQL from a file created by _wrktgen.p
            and use SEND-SQL-STATEMENT stored procedure
            to perform each command inside foreign data manager. 

            NOTE: The output of this file can be adjusted 
                 by using the local environment variables 
                 and the dataserver dependent section at 
                 begining of the code.  

History:    
    21 Sep 1995 Hutegger replaced &DEBUG preprocessor variable with
                        parameter p_debug
     6 Jan 1995 DHM     This becomes a wrapper to include gate/_snd_sql.i
                        to allow for datatype specific r-code
     6 Sep 1994  RLA    Add Oracle drop logic. 
                        Add batch mode output functions
                        Add switching from chained to unchained mode.
                        Add object failure notification. 
     6 Jul 1994  RLA    add some output to let user know we're working
     7 Jun 1994  davidn Added informix specific dependencies.

                         Added comit1_per_stmt  to the local
                        environment.  With the idea that some
                        dataserver do not like to have a comit
                        after every statement.(like informix) 
                        
                        NOTE: The clear_buffers flage is part 
                        of a work around for a bug in running 
                        stored procs.  If there is no output to 
                        retrieve from the dataserver after the 
                        sql statement has been sent, some data
                        servers send back an error message that 
                        progress does not yet no how to handle.
                        Udi is currently working on this, and it
                        should be fixed soon. When the fix goes in,
                        we should be able to get rid of the clear_
                        buffers flag
                        -----davidn 7 Jun 1994 
     2 Jun 1994  RLA    Make generic for all datamanagers. 
    19 May 1994  RLA    Creation.

--*/


{ prodict/gate/_snd_sql.i }
/*********************************************************************
* Copyright (C) 2000,2007, 2009 by Progress Software Corporation. All *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _sndinfo.p - 

   History:  DLM Removed warning message about driver not being certified 11/23/98
             knavneet While checking the driver name we read the 1st ENTRY from _Db-misc2[1] as it may have Library name appended to it for DB2/400 01/24/07
             nagaraju 10/21/09 Support for computed column RECID in MSSDS - OE00186593 

*/
{ prodict/dictvar.i }
{ prodict/gate/odb_ctl.i }

DEFINE VARIABLE driver-prefix AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.

RUN STORED-PROC DICTDBG.CloseAllProcs.
FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db.
RUN STORED-PROC DICTDBG.GetInfo (0).
FOR EACH DICTDBG.GetInfo_buffer:

  IF DICTDB._Db._Db-misc2[1] = ? THEN DO:
    ASSIGN
      DICTDB._Db._Db-misc2[1] = DICTDBG.GetInfo_buffer.driver_name
      DICTDB._Db._Db-misc2[2] = DICTDBG.GetInfo_buffer.driver_version
      DICTDB._Db._Db-misc2[3] = (IF (LENGTH(DICTDBG.GetInfo_buffer.escape_char) < 1)
			 THEN " "
  			 ELSE
  			 DICTDBG.GetInfo_buffer.escape_char) +
        			 (IF (LENGTH(DICTDBG.GetInfo_buffer.quote_char)
				 < 1)
  			 THEN " "
  			 ELSE
  			 DICTDBG.GetInfo_buffer.quote_char) 
        DICTDB._Db._Db-misc2[5] = DICTDBG.GetInfo_buffer.dbms_name + " " +
  			 DICTDBG.GetInfo_buffer.dbms_version 
        DICTDB._Db._Db-misc2[6] = DICTDBG.GetInfo_buffer.odbc_version
        DICTDB._Db._Db-misc2[7] = "Dictionary Ver #:" +  odbc-dict-ver +
  		       ",Client Ver #:" + DICTDBG.GetInfo_buffer.prgrs_clnt +
  		       ",Server Ver #:" + DICTDBG.GetInfo_buffer.prgrs_srvr +
                       ",".

        driver-prefix = IF DICTDB._Db._Db-misc2[1] BEGINS "QE" THEN
  		      SUBSTRING(DICTDB._Db._Db-misc2[1], 1,
  				LENGTH(DICTDB._Db._Db-misc2[1]) - 6) ELSE
  		      DICTDB._Db._Db-misc2[1].

        DICTDB._Db._Db-misc2[4] = "".
        REPEAT i = 1 TO 80:
          DICTDB._Db._Db-misc2[4] = IF ( CAN-DO(odbc-bug-list[i], driver-prefix)
                                OR CAN-DO(odbc-bug-list[i], "ALL") )
                                AND NOT CAN-DO(odbc-bug-excld[i],
  					 driver-prefix)
                             THEN DICTDB._Db._Db-misc2[4] + string(i) + "," 
  			   ELSE DICTDB._Db._Db-misc2[4].
        END. /* REPEAT */

        END. /* _Db._Db-misc2[1] = ? DO */
    
    ELSE IF ENTRY(1,DICTDB._Db._Db-misc2[1]) <> DICTDBG.GetInfo_buffer.driver_name THEN
    DO:
      MESSAGE
	    "The Schema Holder was not created with the ODBC driver you have"
	    "connected with." SKIP
	    "You may experience problems with this connection."
	    SKIP(1)
	    "Schema Holder: "  DICTDB._Db._Db-misc2[1] SKIP
	    "Current driver: " DICTDBG.GetInfo_buffer.driver_name
	    SKIP(1)
	    "Please consider recreating your schema holder using the current"
	    "ODBC driver."
	    VIEW-AS ALERT-BOX WARNING BUTTONS OK.
    END.
  END.
  CLOSE STORED-PROC DICTDBG.GetInfo.

  /* Refresh the bug info we just calculated.				*/
  RUN STORED-PROC DICTDBG.SendInfo (DICTDB._Db._Db-misc2[4]).
  CLOSE STORED-PROC DICTDBG.SendInfo.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Put an escape sequenve in front of meta-characters. */
DEFINE INPUT PARAMETER src AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER trgt AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER odb-escape AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER ret-unknown AS LOGICAL NO-UNDO.

DEFINE VARIABLE strt AS INT INIT 1 NO-UNDO.
DEFINE VARIABLE ind AS INT NO-UNDO.
DEFINE VARIABLE escape-seq AS CHARACTER NO-UNDO.

/* Some drivers don't support % in the search pattern */
IF src = "%" OR ret-unknown THEN src = ?.

IF src = ? OR odb-escape = ? OR odb-escape = "" OR src = "%"
THEN DO:
  trgt = src.
  RETURN.
END.

escape-seq = odb-escape + "_".
REPEAT:
  ind = INDEX (SUBSTRING(src,strt), "_").

  IF ind = 0
    THEN LEAVE.

  SUBSTRING(src, ind + strt - 1, 1) = escape-seq.
  strt = strt + ind  + 1.
END.

escape-seq = odb-escape + "%".
strt = 1.
ind = 0.
REPEAT:
  ind = INDEX (SUBSTRING(src,strt), "%").

  IF ind = 0
    THEN LEAVE.

  SUBSTRING(src, ind + strt - 1, 1) = escape-seq.
  strt = strt + ind  + 1.
END.

trgt = src.

RETURN.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Extract a value marked with prefix and postfix and the source without    */
/* the value.					     			    */
/* Used to get column properties:					    
   P - progress recid.
   S - shadow column (case insensitive).
   I - Invisible columne
   N - Unupdatable column.
*/

DEFINE INPUT PARAM src-string AS char NO-UNDO.
DEFINE INPUT PARAM prefix AS char NO-UNDO.
DEFINE INPUT PARAM postfix AS char NO-UNDO.
DEFINE OUTPUT PARAM val-string AS char NO-UNDO.
DEFINE OUTPUT PARAM delta-string AS char NO-UNDO.

DEFINE VAR s AS char NO-UNDO.
DEFINE VAR prefix-len AS int NO-UNDO.
DEFINE VAR postfix-len AS int NO-UNDO.
DEFINE VAR val-len AS int NO-UNDO.
DEFINE VAR i AS int NO-UNDO.

ASSIGN
  prefix-len = LENGTH(prefix)
  postfix-len = LENGTH(postfix)
  val-string = ""
  delta-string = ""
  i = 1.                          


REPEAT:
  s = SUBSTRING(src-string, i).
  IF s BEGINS prefix THEN DO:
    ASSIGN
    val-len = LENGTH(s) - prefix-len -  postfix-len
    val-string = SUBSTRING(s, prefix-len + 1, val-len)
    delta-string = IF (i > 1) THEN SUBSTRING(src-string, 1, i - 1)
		   ELSE "".
    LEAVE.                             
  END. /* DO */

  i = i + 1.
END. /* REPEAT */

/*********************************************************************
* Copyright (C) 2006, 2008-2009 by Progress Software Corporation. All*
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/odb/odb_pul.i

Description:
    creates the _field-definitions out of the ODBC-definitions
    
Text-Parameters:
    &data-type      Foreign data-type in PROGRESS-Notation
                    usually DICTDBG.SQLColumns_buffer.data-type
    &extent         in the range of 0 to n
    &order-offset   gets added to the _field._order
    
Included in:            
    prodict/odb/_odb_pul.p
    
History:
    hutegger    95/03   abstracted from prodict/odb/odb_mak.i
    mcmann      05/15/01 Added check for differences between precision and
                         length
    moloney     11/11/05 Modify the schema holder version number if
                         the new array character feature is implemented.
                         20050531-001
    fernando    01/04/06 Message added for 20050531-001 should be a warning
	                     and should not come up during migration - 20051230-006.
    nmanchal    11/06/08 setting initial value as 0 for numbers and Empty string for 
	                     character column, reg. OE00176741 (DB2 - ODBC dataservers)
    rkumar      01/07/09 Added default values for ODBC DataServer- OE00177724
    rkumar      07/23/09 OE00177724- modified call to SYSCOLUMNS to resolve
                         userid/driver issues - TR# OE00188452
    rkumar      09/25/09 OE00189853- fetching info for column desc from SYSCOLUMNS

--------------------------------------------------------------------*/

    
/*--------------------------------------------------------------------
Comments from prodict/odb/odb_mak.i:

History:
    hutegger    94/07/15    creation (reworked from previous version
                            basing on new version of ora_mak.i)
    slutz       08/10/05    Added s_ttb_fld.ds_msc26 20050531-001
    moloney     11/11/05    Added version upgrades and schema holder
                            tests against client version.

--------------------------------------------------------------------*/

/* this code gets executed only for the first element of array-field  */
/* so extent-code of field is always ##1 or __1 or some other suffix  */
/* character for array extent mapping (even with real extent >= 10).  */

DEFINE VARIABLE sqlq     AS CHARACTER NO-UNDO. /* OE00177724- for SYSCOLUMNS */
DEFINE VARIABLE dfth1    AS INTEGER   NO-UNDO. /* OE00177724- for SYSCOLUMNS */
DEFINE VARIABLE col_result AS CHARACTER NO-UNDO.
DEFINE VARIABLE first_str  AS CHARACTER NO-UNDO.
DEFINE VARIABLE second_str AS CHARACTER NO-UNDO.
DEFINE VARIABLE third_str  AS CHARACTER NO-UNDO.
DEFINE VARIABLE has_default AS CHARACTER NO-UNDO.
DEFINE VARIABLE is_identity AS CHARACTER NO-UNDO.

ASSIGN
  pnam = TRIM(DICTDBG.SQLColumns_buffer.Column-name).
ASSIGN
  extent_char = ( if {&extent} > 0 AND LENGTH (pnam, "character") > 4 /* Extract the "#" */
             then SUBSTRING (pnam, LENGTH (pnam, "character") - 2, 1, "character")
             else ? ).

  IF INDEX(UPPER(_Db._Db-misc2[8]), "DB2") <> 0 AND
       extent_char <>  "#" AND extent_char <> ? THEN DO:

    found = INDEX(DICTDB._Db._Db-misc2[7], " Schema Holder Ver#: ").
    IF found <> 0 THEN DO:
      found = found + LENGTH(" Schema Holder Ver#: ").
      IF found <= LENGTH(DICTDB._Db._Db-misc2[7]) THEN DO:

        sh_ver = INTEGER(SUBSTRING(DICTDB._Db._Db-misc2[7], found)).
        IF sh_ver < {&ODBC_SCH_VER2} THEN DO:

          DICTDB._Db._Db-misc2[7] = SUBSTRING(DICTDB._Db._Db-misc2[7], 1, found - 1, "character").
          ASSIGN
            DICTDB._Db._Db-misc2[7] = DICTDB._Db._Db-misc2[7] + STRING({&ODBC_SCH_VER2}).

          /* 20051230-006 - don't show this if running migration or create schema */
          IF NOT CAN-DO("M,C",odb_perform_mode) THEN DO:
              RUN adecomm/_setcurs.p ("").
              MESSAGE
                "The schema holder version " + STRING(sh_ver) + 
                " was automatically upgraded to version " + STRING({&ODBC_SCH_VER2}) + "." SKIP
                "Version " + STRING({&ODBC_SCH_VER2}) + " schema holder features were located."
                VIEW-AS ALERT-BOX WARNING BUTTONS OK.
              RUN adecomm/_setcurs.p ("WAIT").
          END.

          /* Now just check that the schema holder level you've upgraded to hasn't
           * exceeded the client (very unlikely but should be checked just in case)
           */
 
          /* If found, then the field is OpenEdge 10.1A client formatted */
          found = INDEX(DICTDB._Db._Db-misc2[7], "Client Ver #:").
          IF found <> 0 THEN DO:

            found = found + LENGTH("Client Ver #:"). 
            efound = INDEX(SUBSTRING(DICTDB._Db._Db-misc2[7], found), ",(sh_min=").
            IF efound > 0 THEN
              clnt_vers =  SUBSTRING(DICTDB._Db._Db-misc2[7], found, efound - 1).
            found = INDEX(DICTDB._Db._Db-misc2[7], ",sh_max=").
            IF found <> 0 THEN DO: 
              found = found + LENGTH(",sh_max=").
              efound = INDEX(SUBSTRING(DICTDB._Db._Db-misc2[7], found), ");").
              IF efound > 0 THEN
                sh_max_ver = INTEGER(SUBSTRING(DICTDB._Db._Db-misc2[7], found, efound - 1)).

            END. 

          END.
 
          IF sh_ver > sh_max_ver THEN DO:
            RUN adecomm/_setcurs.p ("").
            MESSAGE
              "The schema holder version " + STRING(sh_ver) + 
              " is higher than the version capacity of this OpenEdge client." SKIP
              "OpenEdge client version " + clnt_vers + 
              " can only handle schema holder versions up to " + STRING(sh_max_ver) + "." SKIP 
              "Please upgrade your OpenEdge client to one that is compatible with this" +
              " schema holder."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RUN adecomm/_setcurs.p ("WAIT").
            RETURN.
          END.
         
        END.
      END.
    END.
  END.
 
assign
  pnam = TRIM(DICTDBG.SQLColumns_buffer.Column-name)

  pnam = ( if {&extent} > 0 AND LENGTH (pnam, "character") > 4 /* Drop the "##1" */
             then SUBSTRING (pnam, 1, LENGTH (pnam, "character") - 3, "character")
             else pnam )
  fnam = pnam
  pnam = ( if s_ttb_tbl.ds_type = "PROCEDURE"
            and pnam begins "@"
            then substring(pnam,2,-1,"character")
            else pnam
         ).

RUN "prodict/gate/_gat_fnm.p" 
    ( INPUT        "FIELD",
      INPUT        RECID(s_ttb_tbl),
      INPUT-OUTPUT pnam).

if NOT SESSION:BATCH-MODE
 then DISPLAY
   TRIM(DICTDBG.SQLColumns_buffer.Column-name) @ msg[3]
   pnam                                        @ msg[4]
   WITH FRAME ds_make.

assign
  dtyp    = LOOKUP({&data-type},user_env[12])
  l_init  = ?
  ntyp    = ( if dtyp = 0
                then "undefined"
                else ENTRY(dtyp,user_env[15])
            )
  l_dcml  = 0.

/* OE00177724- ODBC DB2/400- fetch default values from SYSCOLUMNS system table  */

IF (INDEX(UPPER(_Db._Db-misc2[5]), "DB2/400") <> 0 OR INDEX(UPPER(_Db._Db-misc2[5]), "AS/400") <> 0) THEN DO: 
  IF (dtyp EQ 3 or dtyp EQ 4 or dtyp EQ 5) THEN /* TIME/TIMESTAMP datatypes */ 
       ASSIGN l_init = ?.
  ELSE DO:
   ASSIGN sqlq = "select has_default,column_heading,'$$',column_default from qsys2.syscolumns where " + 
       " column_name = '" + DICTDBG.SQLColumns_buffer.column-name +
       "' and table_name  = '" + DICTDBG.SQLColumns_buffer.NAME +
       "' and table_schema = '" + DICTDBG.SQLColumns_buffer.OWNER +
       "' ".

   RUN STORED-PROC DICTDBG.send-sql-statement dfth1 = PROC-HANDLE NO-ERROR ( sqlq ).

  IF ERROR-STATUS:ERROR THEN
       ASSIGN fld-remark = ?
              l_init = ?. 
  ELSE DO:
    FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth1:
        ASSIGN col_result = proc-text.
    END.
    CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
    ASSIGN fld-remark = TRIM(TRIM(SUBSTRING(col_result,5,INDEX(col_result," '$$'") - 5),"'")," ~"~ ").
           has_default =  TRIM(SUBSTRING(col_result,1,3),"'").
    IF has_default EQ 'Y' THEN 
           ASSIGN l_init = TRIM(TRIM(SUBSTRING(col_result,INDEX(col_result," '$$'") + 6, -1)),"'").
  END.

/* COLUMN_HEADING is of size VARCHAR(60) and can contain heading in 3 rows of
   20 characters each.Separating out the 3 substrings  and then concatenating
   them separated by '!' for display as column description.  */

 IF length(fld-remark) > 20 THEN DO:
  ASSIGN first_str = TRIM(SUBSTRING(fld-remark,1,20)," ").
  ASSIGN second_str = TRIM(SUBSTRING(fld-remark,21,20)," ").
  ASSIGN third_str = TRIM(SUBSTRING(fld-remark,41,20)," ").
  IF length(first_str) GT 0 THEN ASSIGN  fld-remark = first_str.
  IF length(second_str) GT 0 THEN ASSIGN  fld-remark = fld-remark  + "!" + second_str. 
  IF length(third_str) GT 0 THEN ASSIGN  fld-remark = fld-remark  + "!" + third_str.
 END.

 IF l_init <> ? THEN DO: 
 IF (ntyp = "DATE") AND INDEX(l_init,"CURRENT_DATE") = 0 THEN
      ASSIGN l_init = ?. 
  ELSE IF ntyp = "DATE" THEN 
      ASSIGN l_init = "TODAY".
 END. 
 /* Rohit- confirm changes for logical field */
 IF (ntyp = "CHARACTER" and l_init = "NULL") THEN
          ASSIGN l_init = "". 
 ELSE IF (ntyp = "LOGICAL" and (l_init = "NULL" OR l_init EQ "0")) THEN
          ASSIGN l_init = "NO". 
 ELSE IF (ntyp = "LOGICAL" and l_init NE "0") THEN
          ASSIGN l_init = "YES". 
 ELSE IF ((ntyp = "DECIMAL" OR ntyp = "INTEGER" OR ntyp = "INT64" ) and (l_init = "NULL")) THEN 
          ASSIGN l_init = "0".
 END. /* END of IF (dtyp EQ 3 or dtyp EQ 4 or dtyp EQ 5) */
END.

/* OE00210200: To identify whether the column has 'GENERATED' property. */
IF (INDEX(UPPER(_Db._Db-misc2[5]), "UDB") <> 0 OR INDEX(UPPER(_Db._Db-misc2[5]), "UDB DB") <> 0) THEN DO:
	ASSIGN sqlq = "select GENERATED from syscat.columns where " + 
	   " TABNAME = '" + DICTDBG.SQLColumns_buffer.NAME +
	   "' and COLNAME  = '" + DICTDBG.SQLColumns_buffer.column-name +
	   "' and USER = '" + DICTDBG.SQLColumns_buffer.OWNER +
	   "' ".

	RUN STORED-PROC DICTDBG.send-sql-statement dfth1 = PROC-HANDLE NO-ERROR ( sqlq ).

	IF ERROR-STATUS:ERROR THEN
	   ASSIGN is_identity = ?.
	ELSE DO:
		FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = dfth1:
			ASSIGN is_identity = proc-text.
		END.
		is_identity = TRIM(SUBSTRING(is_identity,1,3),"'").
		CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = dfth1.
	END.
END.

CREATE s_ttb_fld.

assign
  s_ttb_fld.pro_Desc    = fld-remark
  s_ttb_fld.pro_Extnt   = {&extent}
  s_ttb_fld.pro_name    = pnam
  s_ttb_fld.ttb_tbl     = RECID(s_ttb_tbl)
  s_ttb_fld.ds_prec    = DICTDBG.SQLColumns_buffer.Precision
  s_ttb_fld.ds_scale    = DICTDBG.SQLColumns_buffer.Scale
  s_ttb_fld.ds_lngth    = (IF DICTDBG.SQLColumns_buffer.LENGTH > DICTDBG.SQLColumns_buffer.PRECISION 
                              THEN DICTDBG.SQLColumns_buffer.Precision
                           ELSE DICTDBG.SQLColumns_buffer.LENGTH)
  s_ttb_fld.ds_radix    = DICTDBG.SQLColumns_buffer.Radix 
  s_ttb_fld.ds_msc23    = ( if (LENGTH(quote, "character") = 1)
                             then quote + fnam + quote
                             else ?
                          )
  s_ttb_fld.ds_msc24    = fld-properties
  s_ttb_fld.ds_msc26    = extent_char
  s_ttb_fld.ds_stoff    = field-position
  s_ttb_fld.ds_name     = fnam
  s_ttb_fld.ds_type     = {&data-type}
  s_ttb_fld.pro_order   = IF ((INDEX(UPPER(_Db._Db-misc2[5]), "DB2/400") <> 0 OR INDEX(UPPER(_Db._Db-misc2[5]), "AS/400") <> 0)) THEN
                             field-position * 10 
                          ELSE
                             field-position * 10 + 1000 
                              + {&order-offset}
  s_ttb_fld.pro_mand    = ( if CAN-DO(fld-properties, "N")
                                then false
                                ELSE IF (is_identity EQ 'A' OR is_identity EQ 'D')
                                THEN FALSE
                                else (DICTDBG.SQLColumns_buffer.Nullable = 0)
                          ).
						  
/* OE00210200: Check field to see if generated field and mark _field-Misc2[4] as appropriately. */
IF (INDEX(UPPER(_Db._Db-misc2[5]), "UDB") <> 0 OR INDEX(UPPER(_Db._Db-misc2[5]), "UDB DB") <> 0) THEN DO:
 IF (is_identity EQ 'A') THEN
   ASSIGN s_ttb_fld.ds_msc24 = "ALWAYS"
          s_ttb_fld.ds_itype = 1. 
 ELSE IF (is_identity EQ 'D') THEN
   ASSIGN s_ttb_fld.ds_msc24 = "BY_DEFAULT"
          s_ttb_fld.ds_itype = 1.
END.
   
 IF s_ttb_Fld.ds_scale = ? THEN 
   ASSIGN s_ttb_Fld.ds_scale = 0.
   
 IF s_ttb_Fld.ds_radix = ? THEN 
   ASSIGN s_ttb_Fld.ds_radix = 0.
  
   
/*                                                             */
/* If the field is not updatable (fld-properties contains "N") */ 
/* then the field cannot be mandatory.                         */
/*                                                             */

{prodict/gate/gat_pul2.i
  &undo = "next"
  }

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/odb/odb_pulp.i

Description:
    creates the _field-definitions out of the ODBC-definitions for
    stored procedures parameters.
    
Text-Parameters:
    &data-type      Foreign data-type in PROGRESS-Notation
                    usually DICTDBG.SQLProcCols_buffer.data-type
    &extent         in the range of 0 to n
    &order-offset   gets added to the _field._order
    
Included in:            
    prodict/odb/_odb_pul.p
    
History:
    D. McMann    01/22/98   abstracted from prodict/odb/odb_pul.i

--------------------------------------------------------------------*/

 
/* this code gets executed only for the first element of array-field   */
/* so extent-code of field is always ##1 (even with real extent >= 10) */
assign
  pnam = TRIM(DICTDBG.SQLProcCols_buffer.Column-name)
  pnam = ( if {&extent} > 0 AND LENGTH (pnam, "character") > 4 /* Drop the "##1" */
             then SUBSTRING (pnam, 1, LENGTH (pnam, "character") - 3, "character")
             else pnam )
  fnam = pnam
  pnam = ( if s_ttb_tbl.ds_type = "PROCEDURE"
            and pnam begins "@"
            then substring(pnam,2,-1,"character")
            else pnam
         ).

RUN "prodict/gate/_gat_fnm.p" 
    ( INPUT        "FIELD",
      INPUT        RECID(s_ttb_tbl),
      INPUT-OUTPUT pnam).

if NOT SESSION:BATCH-MODE
 then DISPLAY
   TRIM(DICTDBG.SQLProcCols_buffer.Column-name) @ msg[3]
   pnam                                        @ msg[4]
   WITH FRAME ds_make.

assign
  dtyp    = LOOKUP({&data-type},user_env[12])
  l_init  = ?
  ntyp    = ( if dtyp = 0
                then "undefined"
                else ENTRY(dtyp,user_env[15])
            )
  l_dcml  = 0.

CREATE s_ttb_fld.

assign
  s_ttb_fld.pro_Desc    = fld-remark
  s_ttb_fld.pro_Extnt   = {&extent}
  s_ttb_fld.pro_name    = pnam
  s_ttb_fld.ttb_tbl     = RECID(s_ttb_tbl)
  s_ttb_fld.ds_prec    = DICTDBG.SQLProcCols_buffer.Precision
  s_ttb_fld.ds_scale    = DICTDBG.SQLProcCols_buffer.Scale
  s_ttb_fld.ds_lngth    = DICTDBG.SQLProcCols_buffer.Length
  s_ttb_fld.ds_radix    = DICTDBG.SQLProcCols_buffer.Radix 
  s_ttb_fld.ds_msc23    = ( if (LENGTH(quote, "character") = 1)
                             then quote + fnam + quote
                             else ?
                          )
  s_ttb_fld.ds_msc24    = fld-properties
  s_ttb_fld.ds_stoff    = field-position
  s_ttb_fld.ds_name     = fnam
  s_ttb_fld.ds_type     = {&data-type}
  s_ttb_fld.pro_order   = IF ((INDEX(UPPER(_Db._Db-misc2[5]), "DB2/400") <> 0 OR INDEX(UPPER(_Db._Db-misc2[5]), "AS/400") <> 0)) THEN
                             field-position * 10 
                          ELSE
                             field-position * 10 + 1000 
                              + {&order-offset}
  s_ttb_fld.pro_mand    = ( if CAN-DO(fld-properties, "N")
                                then false
                                else (DICTDBG.SQLProcCols_buffer.Nullable = 0)
                          ).
/*                                                             */
/* If the field is not updatable (fld-properties contains "N") */ 
/* then the field cannot be mandatory.                         */
/*                                                             */

{prodict/gate/gat_pul2.i
  &undo = "next"
  }

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Workaround for Q+E ODBC drivers - Create a comma seperated index comp list */

DEFINE INPUT-OUTPUT PARAM crnt AS CHAR.
DEFINE OUTPUT PARAM numcomp AS INT.

DEFINE VAR separ as int.
DEFINE VAR parrent AS int.
DEFINE VAR str-patt AS int.
DEFINE VAR ind AS int.
DEFINE VAR endlp AS logical.

IF crnt = ? THEN DO:
  numcomp = 0.
  RETURN.
END.

ind = 0.
endlp = no.
DO WHILE  NOT endlp AND crnt <> "":
  separ = INDEX(crnt, "+").
  ind = ind + 1.

  IF separ = 0 THEN DO:
    endlp = yes.
    NEXT. 
  END.
  SUBSTRING(crnt, separ, 1) = ",".

END.
numcomp = ind.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/odb/odb_sys.i

Description:
    This string contains a comma-seperated list of the names of all
    system-objects for ODBC-based schemaholders, that are non-queryable.
    For example: Stored-Procedures, Buffers, ...
    This file gets used also from the report-builder -therefore it
    needs to be in a format that complies with C *and* PROGRESS
    
Text-Parameters:  
   none
                                     
History:
    hutegger    95/08   creation
    mcmann      99/11/02 Added New tables for stored procedure implementation
    
--------------------------------------------------------------------*/
/*h-*/
"SQLTables,SQLTables_buffer,SQLColumns,SQLColumns_buffer,SQLStatistics,SQLStatistics_buffer,GetFieldIds,GetFieldIds_buffer,GetInfo,GetInfo_buffer,CloseAllProcs,SendInfo,PROC-TEXT-BUFFER,SEND-SQL-STATEMENT,SQLProcs_Buffer,SQLProcCols_Buffer,SQLProcedures,SQLProcColumns"

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* tyb_typ.i - converts SQL data-type number to its datatype name */
/*
  {1} is  "DICTDBG.SQLColumns_buffer.data-type"
  {2} is  bug29 == configuration "bug" #29 from odb_ctl.i
*/


(IF ({1} > 2)
THEN
    (IF     {1} =  9  THEN "DATE"
    ELSE IF {1} =  10  THEN "TIME"
    ELSE IF {1} =  3  THEN "DECIMAL"
    ELSE IF {1} =  4  THEN "INTEGER"
    ELSE IF {1} =  5   THEN "SMALLINT"
    ELSE IF {1} =  6  THEN "FLOAT"
    ELSE IF {1} =  7  THEN "REAL"
    ELSE IF {1} =  8  THEN "DOUBLE"
    ELSE IF {1} =  11  THEN "TIMESTAMP"
    ELSE IF {1} =  12  THEN "VARCHAR"
    ELSE                  "UNDEFINED")

ELSE IF  ({1} > -16) 
THEN
    (IF     {1} =   1  THEN "CHAR"
    ELSE IF {1} =   2  THEN "NUMERIC"
    ELSE IF {1} =  -1  THEN "LONGVARCHAR"
    ELSE IF {1} =  -2  THEN "BINARY"
    ELSE IF {1} =  -3  THEN "VARBINARY"
    ELSE IF {1} =  -4  THEN "LONGVARBINARY"
    ELSE IF {1} =  -5  THEN "BIGINT"
    ELSE IF {1} =  -6  THEN "TINYINT"
    ELSE IF {1} =  -7  THEN "BIT"
    ELSE                    "UNDEFINED")
ELSE
    /* do special datatypes only if bug flag on. */
   (IF      ({2} and {1} =  -98) THEN "LONGVARBINARY"
    ELSE IF ({2} and {1} =  -99) THEN "LONGVARBINARY"
    ELSE                    "UNDEFINED")

)



/*********************************************************************
* Copyright (C) 2005-2006, 2009 by Progress Software Corporation. All*
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
    History:  D. McMann   03/03/99 Removed On-line from Informix
              D. McMann   02/01/00 Added sqlwidth variable
              D. McMann   10/08/02 Added shadowcol variable
              D. McMann   06/17/03 Removed unsupported data sources
              D. McMann   10/16/03 Created two OTHER catigories and removed MS Access
              K. McIntosh 04/13/04 Added support for ODBC type DB2/400
              fernando    08/14/06 Removed Informix from list of valid foreign db types
	      rkumar      01/07/09 Added default values for ODBC DataServer- OE00177724
              rkumar      05/05/09 Added RECID support  for ODBC DataServer- OE00177721
*/    

DEFINE {1} SHARED VARIABLE pro_dbname   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE pro_conparms AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE osh_dbname   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_dbname   AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_pdbname  AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_username AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_password AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_codepage AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_collname AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_library  AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_conparms AS CHARACTER NO-UNDO.
DEFINE {1} SHARED VARIABLE odb_type     AS CHARACTER FORMAT "x(16)"
  INITIAL "Sybase" VIEW-AS COMBO-BOX  
     LIST-ITEMS  "Sybase", "DB2/400", "DB2(Other)", "Other(MS Access)",  "Other(Generic)"  
         SIZE-CHAR 32 By 1.

DEFINE {1} SHARED VARIABLE movedata     AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE pcompatible  AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE shadowcol    AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE odbdef       AS LOGICAL NO-UNDO. 
DEFINE {1} SHARED VARIABLE sqlwidth     AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE loadsql      AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE rmvobj       AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE iFmtOption   AS INTEGER NO-UNDO INITIAL 2.
DEFINE {1} SHARED VARIABLE lFormat      AS LOGICAL NO-UNDO INITIAL TRUE.
DEFINE {1} SHARED VARIABLE iRidOption   AS INTEGER NO-UNDO INITIAL 2. /* OE00177721*/

DEFINE {1} SHARED STREAM dbg_stream.

DEFINE {1} SHARED VARIABLE stages 		AS LOGICAL EXTENT 7 NO-UNDO.
DEFINE {1} SHARED VARIABLE stages_complete 	AS LOGICAL EXTENT 7 NO-UNDO.

/*
 * Constants describing stage we are at.
 */ 
define {1} shared variable odb_create_sql	as integer   initial 1.
define {1} shared variable odb_dump_data   	as integer   initial 2.
define {1} shared variable odb_create_sh 	as integer   initial 3. 
define {1} shared variable odb_create_objects	as integer   initial 4.
define {1} shared variable odb_build_schema	as integer   initial 5.
define {1} shared variable odb_fixup_schema	as integer   initial 6.
define {1} shared variable odb_load_data	as integer   initial 7. 
define {1} shared variable s_file-sel           as character initial "*". 



/*********************************************************************
* Copyright (C) 2006,2009 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Procedure prodict/odb/protood1.p

    Created 06/23/98 Used prodict/ora/protoor1.p as model D. McMann
    
    Each ODBC Foreign Database must have the following user_env parameters
    created specific for the data source:
       user_env[5] = statement terminator
       user_env[11..18] = a string of how to convert PROGRESS datatypes:
               [11] = character  -> varchar, long varchar, text, memo, Sql_Varchar, Sql_Longvar
               [12] = date       -> date, datetime, Sql_Date
               [13] = logical    -> logical, bit
               [14] = integer    -> smallint, logical, tinyint, Sql_bit 
               [15] = decimal    -> money, decimal, currency, Sql_decimal
               [16] = decimal*   -> decimal, integer, number
               [17] = recid      -> recid, rowid
               [18] = char**     -> long varchar, memo, Sql_Longvar
               [19] = logical*** -> logical, tinyint              
       user_env[20] = character to use for unique name creation
       user_env[25] = create sequences
       user_env[30] = write exit at end of SQL.
       user_env[33] = Use _Field._Width for size of field.
       user_env[34] = DB2 db type or the unknown value.
       
       * = When the datatype is decimals and no decimals are present
      ** = Name of character field when max for regular char is exceeded
     *** = Logical fields which are key componets
     
     History:  D. McMann  09/03/98 Added statement terminator for MS Access
               D. McMann  09/17/98 Changed Informix index name length to 18
                                   and statement terminator to ;
               D. McMann  02/08/99 Removed disconnect of original database 
               D. McMann  02/24/99 Added TTY check for all data sources 
               D. McMann  03/03/99 Removed On-line from Informix 
               D. McMann  03/16/98 Made sure sequences were not being created 
                                   for Informix  
               D. McMann  10/08/02 Added support for shadow column selection
               D. McMann  10/31/02 Changed Informix Char to VarChar
               D. McMann  09/17/03 Put CHAR back
               K. McIntosh  04/13/04 Added support for DB2/400 libraries 
                                   (user_library)  
               D. Slutz  08/10/05 Set dft ext char to __ for DB2 20050531-001
               K. McIntosh  10/25/05 Fixed x8override functionality 20051018-006
               fernando     01/04/06 Handle decimals for DB2/400 20051214-009
               fernando     02/12/08 Adding missing entries to log file in batch
	       rkumar       02/13/08 OE00177724- default values support for DB2/400
               rkumar       05/05/09 OE00177721- RECID support for DB2/400

*/           

{ prodict/user/uservar.i }
{ prodict/odb/odbvar.i }

DEFINE VARIABLE cmd           AS CHARACTER           NO-UNDO.
DEFINE VARIABLE wait          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE create_h      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE db_exist      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO  NO-UNDO. 
DEFINE VARIABLE output_file   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE l_i           AS INTEGER             NO-UNDO.
DEFINE VARIABLE run_time      AS INTEGER             NO-UNDO.
DEFINE VARIABLE schname       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE clctn_output  AS CHARACTER           NO-UNDO.

DEFINE STREAM strm.

/*------------------------------------------------------------------*/

assign batch_mode    = SESSION:BATCH-MODE
       run_time      = TIME
       odb_library  = (IF odb_library EQ ? THEN "" ELSE odb_library)
       clctn_output  = (IF odb_library NE "" THEN
                          "DB2/400 Library:                    " + 
                          odb_library + CHR(10)
                        ELSE "").

IF batch_mode THEN DO:
   PUT STREAM logfile UNFORMATTED
       " " skip
       "{&PRO_DISPLAY_NAME} to ODBC Log" skip(2)
       "Original {&PRO_DISPLAY_NAME} Database:            " pro_dbname skip
       "Other {&PRO_DISPLAY_NAME} db connect parameters : " pro_conparms  skip
       "ODBC Data Source Name:                 " odb_dbname skip
       "Foreign DBMS Type:                     " odb_type skip
       "{&PRO_DISPLAY_NAME} Schema Holder name:           " osh_dbname skip
       "ODBC Username:                         " odb_username SKIP
       clctn_output
       "Codepage for Schema Image:             " odb_codepage SKIP
       "Collation Name:                        " odb_collname SKIP           
       "Field width calculation based on:      " (IF iFmtOption = 1 THEN
                                                    "_Field._Width field"
                                                  ELSE IF (lFormat = FALSE) THEN
                                                    "Calculation"
                                                  ELSE "_Field._Format field")
                                                  SKIP
       "Compatible structure:                  " pcompatible skip
       "Create RECID for:                      " (IF odb_type EQ "DB2/400" AND iRidOption = 1 THEN 
                                                        "All Tables" 
                                                  ELSE IF odb_type EQ "DB2/400" AND iRidOption = 2 THEN
                                                        "Tables Without Unique Key"
                                                  ELSE  "All Tables")
                                                  skip 
       "Create objects in ODBC:                " loadsql skip
       "Moved data to ODBC:                    " movedata skip
       "Include Defaults:                      " odbdef skip
       "Create shadow columns:                 " shadowcol skip(2).
END.

IF loadsql THEN DO:
  ASSIGN stages[odb_create_sql] = TRUE
         stages[odb_build_schema] = TRUE
         stages[odb_fixup_schema] = TRUE
         stages[odb_create_objects] = TRUE.
  
  IF not batch_mode THEN
     HIDE MESSAGE NO-PAUSE.
  ASSIGN schname = osh_dbname + ".db".
  IF search (osh_dbname) <> ? THEN do:
    connect osh_dbname -1 no-error.
    if ERROR-STATUS:ERROR then do:
      IF not batch_mode THEN DO:
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            MESSAGE "Can't connect to Database " osh_dbname.
        &ELSE
            MESSAGE "Can't connect to Database " osh_dbname
              VIEW-AS ALERT-BOX ERROR.
        &ENDIF.
      END.       
      ELSE 
          PUT STREAM logfile UNFORMATTED 
               "Can't connect to Database " osh_dbname skip(2).
      UNDO, RETURN error.
    end.
  end.

  IF CONNECTED (osh_dbname) THEN DO:
    ASSIGN rmvobj   = FALSE
           create_h = FALSE
           stages[odb_create_sh] = FALSE.
           
    CREATE ALIAS DICTDB2 FOR DATABASE value(osh_dbname).
    ASSIGN db_exist = FALSE.
    RUN "prodict/misc/_tstsh.p" (INPUT odb_dbname, OUTPUT db_exist).
    IF db_exist THEN DO:
      IF not batch_mode THEN DO:
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           MESSAGE "Data Source " odb_dbname " already exists in schema holder " 
                  osh_dbname.
        &ELSE 
           MESSAGE "Data Source " odb_dbname " already exists in schema holder " 
                             osh_dbname VIEW-AS ALERT-BOX ERROR.
        &ENDIF
      END.                                              
      ELSE 
         PUT STREAM logfile UNFORMATTED 
            "Data Source " odb_dbname " already exists in schema holder " 
            osh_dbname skip(2).
      DISCONNECT VALUE(osh_dbname).
      UNDO, RETURN "indb".
    END. 
    DISCONNECT VALUE (osh_dbname).
    
  END. 
  ELSE
    ASSIGN create_h = TRUE
           rmvobj   = TRUE.
           
  IF odb_dbname = pro_dbname OR odb_dbname = osh_dbname THEN DO:
    IF batch_mode THEN 
       PUT STREAM logfile UNFORMATTED 
               "Data Source Name " odb_dbname 
               " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name"
                skip(2).
    ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           MESSAGE "Data Source Name " odb_dbname 
             " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name".
      &ELSE
           MESSAGE "Data Source name " odb_dbname 
             " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database Name"
             VIEW-AS ALERT-BOX ERROR.
      &ENDIF
    END.             
    UNDO, RETURN error.
  END.
END.

ASSIGN user_env[1]   = "ALL"
       user_env[2]   = osh_dbname
       user_env[3]   = ""
       user_env[4]   = "n"
       user_env[6]   = "y"
       user_env[7]   = (IF odbdef then "y" else "n")
       user_env[8]   = "y"
       user_env[9]   = "ALL"
       user_env[22]  = "ODBC"
       user_env[23]  = "30"
       user_env[24]  = "15"
       user_env[26]  = odb_username
       user_env[31]  = "-- ** "
       user_env[34]  = ?
       user_library = odb_library
       user_dbname   = odb_dbname
       odb_pdbname   = odb_dbname.

IF iFmtOption = 1 THEN 
  user_env[33]  = "y".
ELSE IF (lFormat = FALSE) THEN 
  user_env[33] = "no".
ELSE user_env[33] = "?".

CASE odb_type:
  WHEN "Informix" THEN
    ASSIGN user_env[5]  = ";"
           user_env[11] = "char" 
           user_env[12] = "date"
           user_env[13] = "smallint"
           user_env[14] = "integer"
           user_env[15] = "money"
           user_env[16] = "decimal"
           user_env[17] = "integer"
           user_env[18] = "char"
           user_env[19] = "smallint"
           user_env[20] = "_"
           user_env[21] = (IF shadowcol THEN "y" ELSE "n")  /* should shadow colunms be produced */
           user_env[25] = "n" 
           user_env[28] = "18"
           user_env[29] = "18"           
           user_env[30] = "n"
           user_env[32] = "Informix".
       
  WHEN "DB2/MVS"    OR 
  WHEN "DB2/6000"   OR 
  WHEN "DB2/NT"     OR 
  WHEN "DB2/400"    OR 
  WHEN "DB2" 		OR 
  WHEN "DB2(Other)" THEN
    ASSIGN user_env[5]  = ";"
           user_env[11] = "varchar" 
           user_env[12] = "date"
           user_env[13] = "smallint"
           user_env[14] = "integer"
           user_env[15] = "decimal(18,5)"
           user_env[16] = "decimal"
           user_env[17] = "integer"
           user_env[18] = "long varchar"
           user_env[19] = "smallint"
           user_env[20] = "__"
           user_env[21] = (IF shadowcol THEN "y" ELSE "n")  /* should shadow colunms be produced */           
           user_env[25] = "n"  
           user_env[28] = (IF odb_type = "DB2/400" THEN "30" ELSE "18")
           user_env[29] = (IF odb_type = "DB2/400" THEN "30" ELSE "18")
           user_env[30] = "no"
           user_env[32] = "DB2"
           user_env[34] = odb_type.
           
  WHEN "MS Access" OR WHEN "MSAccess" THEN
    ASSIGN user_env[5]  = ";"
           user_env[11] = "text" 
           user_env[12] = "datetime"
           user_env[13] = "logical"
           user_env[14] = "number"
           user_env[15] = "number"
           user_env[16] = "number"
           user_env[17] = "integer"
           user_env[18] = "memo"
           user_env[19] = "logical"
           user_env[20] = "_"
           user_env[21] = (IF shadowcol THEN "y" ELSE "n")  /* should shadow colunms be produced */           
           user_env[25] = "n" 
           user_env[28] = "33"
           user_env[29] = "33"            
           user_env[30] = "no"
           user_env[32] = odb_type.

 WHEN "SQL Server 6"  THEN
    ASSIGN user_env[5]  = "go"
           user_env[11] = "varchar" 
           user_env[12] = "datetime"
           user_env[13] = "tinyint"
           user_env[14] = "integer"
           user_env[15] = "decimal(18,5)"
           user_env[16] = "decimal"
           user_env[17] = "integer"
           user_env[18] = "text"
           user_env[19] = "tinyint"
           user_env[20] = "##"
           user_env[21] = (IF shadowcol THEN "y" ELSE "n")  /* should shadow colunms be produced */           
           user_env[25] = "y" 
           user_env[28] = "30"
           user_env[29] = "24"            
           user_env[30] = "y"
           user_env[32] = "MS SQL Server".
  
  WHEN "Sybase" THEN
    ASSIGN user_env[5]  = "go"
           user_env[11] = "varchar" 
           user_env[12] = "datetime"
           user_env[13] = "tinyint"
           user_env[14] = "integer"
           user_env[15] = "decimal(18,5)"
           user_env[16] = "decimal"
           user_env[17] = "integer"
           user_env[18] = "text"
           user_env[19] = "tinyint"
           user_env[20] = "##"
           user_env[21] = (IF shadowcol THEN "y" ELSE "n")  /* should shadow colunms be produced */           
           user_env[25] = "y"
           user_env[28] = "30"
           user_env[29] = "24"            
           user_env[30] = "y"
           user_env[32] = odb_type.
  
  WHEN "Other" THEN
    ASSIGN user_env[5]  = ";"
           user_env[11] = "varchar" 
           user_env[12] = "date"
           user_env[13] = "smallint"
           user_env[14] = "integer"
           user_env[15] = "decimal"
           user_env[16] = "decimal"
           user_env[17] = "integer"
           user_env[18] = "longvar"
           user_env[19] = "smallint"
           user_env[20] = ""
           user_env[21] = "n"  /* should shadow colunms be produced */           
           user_env[25] = "n"  
           user_env[28] = "30"
           user_env[29] = "24"            
           user_env[30] = "y"
           user_env[32] = odb_type.
END CASE.
           
IF pcompatible THEN 
   ASSIGN user_env[27] = "y".
ELSE
   ASSIGN user_env[27] = "no".

IF (odb_type = "DB2/400" and pcompatible) THEN 
     ASSIGN user_env[27] = user_env[27] + "," + STRING(iRidOption).

ASSIGN user_env[36] = "n,n,n,n,n"
       user_env[38] = "1"
       user_env[39] = "1".
IF movedata THEN
  ASSIGN stages[odb_dump_data] = TRUE
         stages[odb_load_data] = TRUE.

    /* md0: creates SQL */
RUN "prodict/odb/_odb_md0.p".


/*
IF not stages[odb_create_sh] THEN LEAVE.
*/
IF loadsql THEN DO:
  IF create_h THEN DO:
    IF batch_mode THEN DO:
      PUT STREAM logfile UNFORMATTED
              " " skip
              "-- ++ " skip
              "-- Creating empty schema holder " skip
              "-- -- " skip(2).
    END.

    CREATE DATABASE osh_dbname FROM "EMPTY".
  END.

  IF NOT batch_mode THEN
    HIDE FRAME table-wait NO-PAUSE.
  
  ASSIGN stages_complete[odb_create_sh] = TRUE
         stages[odb_create_objects]     = TRUE.
    
  /* md1: creates SI and ODBC-Schema using send-sql.p
   *      pulls schema into SI
   *      beautifies SI by comparing it and matching it up with 
   *            the original progress-db
   */
  RUN "prodict/odb/_odb_md1.p".

  IF RETURN-VALUE = "wrg-ver" THEN
    RETURN "wrg-ver".

  IF RETURN-VALUE = "undo" THEN
    RETURN "undo".

  IF batch_mode and NOT logfile_open THEN DO:
    OUTPUT TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
    logfile_open = true.
  END.

  /* See if we were successful. */

  IF NOT CONNECTED (odb_dbname) THEN DO:
    cmd = "Error creating ODBC Database - Check logfile " + osh_dbname + 
                ".log".
    IF NOT Batch_mode THEN
      MESSAGE cmd.
    ELSE
      PUT STREAM logfile UNFORMATTED  cmd.  
    UNDO, RETURN error.
  END.

  ASSIGN cmd = "c" + odb_dbname + ".p".

  OUTPUT STREAM strm TO VALUE (cmd) NO-MAP.

  PUT STREAM strm UNFORMATTED "CONNECT " osh_dbname " -1." SKIP.

  IF odb_conparms <> ? THEN DO:
    IF INDEX(odb_conparms,"@") <> 0 THEN 
         odb_username = odb_username + odb_conparms. 
  END. 
  
  IF odb_username = "" or odb_username = ? THEN
     PUT STREAM strm UNFORMATTED " CONNECT " odb_dbname " -ld " odb_dbname
        " -dt ODBC" .
  ELSE IF odb_password = "" or odb_password = ? THEN
     PUT STREAM strm UNFORMATTED "CONNECT " odb_dbname " -ld ~"" odb_dbname
        "~" -dt ODBC -U ~"" odb_username "~"".
  ELSE 
     PUT STREAM strm UNFORMATTED "CONNECT " odb_dbname " -ld ~"" odb_dbname
        "~" -dt ODBC -U ~"" odb_username "~" -P ~"" odb_password "~"".
 
  IF odb_conparms <> ? THEN DO:
    IF INDEX(odb_conparms,"@") = 0 THEN 
         PUT STREAM strm UNFORMATTED " " odb_conparms.
  END.

  PUT STREAM strm UNFORMATTED "." SKIP.

  OUTPUT STREAM strm CLOSE.

  IF movedata THEN 
  _mvdt:
  DO:
    IF NOT CONNECTED(odb_dbname) THEN DO:
      IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED
          "Database" odb_dbname " not connected.  Unable to load data."  SKIP.
       ELSE
         MESSAGE "Database" odb_dbname " NOT connected.  Unable to load data." SKIP
           VIEW-AS ALERT-BOX.
       LEAVE _mvdt.    
    END.        
    IF batch_mode THEN
       PUT STREAM logfile UNFORMATTED
           "-- ++ " skip
           "-- Loading data into the ODBC database. " skip
           "-- -- " skip(2).
    ELSE
      DISPLAY  " " SKIP 
               "   Loading data into the ODBC Database.  " SKIP(2)
        WITH FRAME ld-dt NO-LABELS THREE-D CENTERED ROW 5 
          TITLE "Moving Data".

    RUN "prodict/odb/_odb_md9.p".

    DISCONNECT VALUE (odb_dbname).
    DISCONNECT VALUE (osh_dbname).
  END.  
end.
IF NOT batch_mode and loadsql THEN DO:
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
      MESSAGE "Run pro -p " cmd " to connect to new ODBC database.".
  &ELSE
      MESSAGE "Run pro -p " cmd " to connect to new ODBC database."
            VIEW-AS ALERT-BOX INFORMATION.
  &ENDIF
END.
ELSE IF batch_mode THEN DO:

   IF NOT logfile_open THEN DO:
      OUTPUT STREAM logfile TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
      logfile_open = true.
   END.

   PUT STREAM logfile UNFORMATTED
       " "           skip
       "-- ++ "      skip
       "-- PROTOodb Complete in " STRING(TIME - run_time,"HH:MM:SS")  skip
       "-- -- "      skip(2).
   if loadsql then
       PUT STREAM logfile UNFORMATTED
          " "                                   skip 
          "Run pro -p " cmd
          " to connect to new ODBC database." skip.
END.

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2005-2009 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Created:  D. McMann 06/22/98 PROTOODBC Utiity to migrate a Progress
                                database via ODBC to one of the following
                                foreign database:  Informix On-Line, DB2/6000
                                DB2NT, DB2/MVS, MS Access, MS SQL Server,
                                Sybase, and Other which will be a catch all
                                for databases which we do not specifically
                                support but that the user wants to try.
                                
  History:  D. McMann 09/03/98  Added assignment of code-page for default
                                and removed <current database> from progress
                                connect parameters. 
                      09/08/98  Removed compatibility for DB2 data bases. 
                      10/21/98  Removed compatibility for ALL data bases.
                      02/08/99  Added check for pro_dbname being same as DICTDB.
                                98-09-14-053   
                      03/03/99  Removed on-line from informix  
                      03/16/99  Made compatible the default  
                      12/02/99  Changed compatible label 
                                19990305027  
                      02/01/00  Added sqlwidth support                                             
                      04/12/00  Added long Progress Database path name
                      09/05/01  Added support for wrong version of SQL Server
                      11/16/01  Added logic to block moving data if running -rx
                      10/08/02  Added logic to create shadow columns.
                      10/23/02  Changed BLANK to PASSWORD-FIELD
                      06/17/03  Removed unsupported data sources
                      10/16/03  Created two OTHER catigories and removed MS Access
          K. McIntosh 04/13/04  Added Library field for DB2/400 ODBC support
          K. McIntosh 02/28/05  Added ability to override default x(8) character field
                                handling when deciding field width
          fernando    08/14/06  Removed Informix from list of valid foreign db types
          knavneet    08/03/07  For db2/400, making library name a required field
                      08/22/07  For db2/400, changing label from Library to Collection/Library and defaulting it to what is specified in the DSN.
          fernando    10/18/07  Make sure pcompatible is mantain disabled after error - OE00134723           
          fernando    08/18/08  Allow COLLECTION for batch - DB2/400
	  rkumar      01/08/09  Added default values for ODBC DataServer- OE00177724
          rkumar      04/28/09  Added RECID support  for ODBC DataServer- OE00177721
*/            


{ prodict/user/uservar.i NEW }
{ prodict/odb/odbvar.i NEW }

DEFINE VARIABLE cmd           AS CHARACTER                NO-UNDO.
DEFINE VARIABLE wait          AS CHARACTER                NO-UNDO.
DEFINE VARIABLE create_h      AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE db_exist      AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.
DEFINE VARIABLE old-dictdb    AS CHARACTER                NO-UNDO.  
DEFINE VARIABLE output_file   AS CHARACTER                NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER                NO-UNDO.
DEFINE VARIABLE run_time      AS INTEGER                  NO-UNDO.
DEFINE VARIABLE i             AS INTEGER                  NO-UNDO.
DEFINE VARIABLE err-rtn       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE codb_type     AS CHARACTER FORMAT "x(32)" NO-UNDO.
DEFINE VARIABLE redo          AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE redoblk       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE wrg-ver       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE mvdta         AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE odbctypes     AS CHARACTER 
  INITIAL "Sybase,DB2/400,DB2(Other),Other(MS Access),Other(Generic),Other(MSAcce~ ss)" NO-UNDO.
DEFINE VARIABLE cFormat       AS CHARACTER INITIAL "For field widths use:"
                                           FORMAT "x(21)" NO-UNDO.
DEFINE VARIABLE lExpand             AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE lCompatible_enabled AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE def_libraries       AS CHARACTER INITIAL ""  NO-UNDO.
DEFINE VARIABLE lodbdef_enabled     AS LOGICAL                  NO-UNDO. /* OE00177724 */

DEFINE STREAM   strm.

&IF "{&OPSYS}" NE "UNIX" &THEN 
 DEFINE VARIABLE dsn_name      AS CHARACTER                NO-UNDO.
 DEFINE VARIABLE default_lib   AS CHARACTER                NO-UNDO.
 FUNCTION getRegEntry RETURN CHARACTER (INPUT dsnName as CHARACTER, keyName  AS CHARACTER) FORWARD. 
&ENDIF.
batch_mode = SESSION:BATCH-MODE.

FORM
  " "   SKIP({&VM_WID}) 
  pro_dbname   FORMAT "x({&PATH_WIDG})"  view-as fill-in size 32 by 1 
    LABEL "Original {&PRO_DISPLAY_NAME} Database" colon 36 SKIP({&VM_WID}) 
  pro_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
    LABEL "Connect Parameters for {&PRO_DISPLAY_NAME}" colon 36 SKIP({&VM_WID})
  osh_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Name of Schema Holder Database" colon 36 SKIP({&VM_WID})
  odb_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "ODBC Data Source Name" colon 36 SKIP({&VM_WID})
 &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   codb_type LABEL "Foreign DBMS Type" colon 36 view-as fill-in size 32 by 1
      SKIP ({&VM_WID})  
 &ELSE
   odb_type LABEL "Foreign DBMS Type" colon 36 SKIP ({&VM_WID})       
 &ENDIF  
 
  odb_username FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "ODBC Username" colon 36 SKIP({&VM_WID})
  odb_password FORMAT "x(32)"  PASSWORD-FIELD
        view-as fill-in size 32 by 1 
        LABEL "ODBC User's Password" colon 36 SKIP({&VM_WID})
  odb_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
     LABEL "ODBC Connect Parameters" colon 36 SKIP({&VM_WID})
  odb_codepage FORMAT "x(32)"  view-as fill-in size 32 by 1
     LABEL "Codepage for Schema Image" colon 36 SKIP({&VM_WID})
  odb_collname FORMAT "x(32)"  view-as fill-in size 32 by 1
     LABEL "Collation Name" colon 36 SKIP({&VM_WID})
  odb_library FORMAT "x(32)"  VIEW-AS FILL-IN SIZE 32 BY 1
     LABEL "Collection/Library" COLON 36 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF


  SPACE(2) pcompatible view-as toggle-box 
                       LABEL "Create RECID Column"  
  shadowcol VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" COLON 38 SKIP({&VM_WID})
  SPACE(2) iRidOption AT 6 VIEW-AS RADIO-SET RADIO-BUTTONS "All Tables", 1,
                                             "Tables Without Unique Key", 2
                               VERTICAL NO-LABEL 
  loadsql view-as toggle-box label "Load SQL" COLON 38 SKIP({&VM_WID})
 /*&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SPACE(24)
 &ELSE SPACE(23) &ENDIF */
  movedata view-as toggle-box label "Move Data" AT ROW-OF iRidOption + 1 COL 40 SKIP({&VM_WID})
  SPACE(2) odbdef VIEW-AS TOGGLE-BOX LABEL "Include Defaults" SKIP({&VM_WID})
  SPACE(2) cFormat VIEW-AS TEXT NO-LABEL 
  iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                             "ABL Format", 2
                               HORIZONTAL NO-LABEL SKIP({&VM_WID})
  lExpand VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30" AT 40
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
  &ELSE SKIP({&VM_WID}) &ENDIF
             {prodict/user/userbtns.i}
  WITH FRAME x  CENTERED SIDE-labels OVERLAY
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF
  TITLE "{&PRO_DISPLAY_NAME} DB to ODBC Conversion".

FORM
  wait FORMAT "x" LABEL
  "Creating tables - Please wait"
  WITH FRAME table-wait ROW SCREEN-LINES - 2 COLUMN 1 NO-BOX OVERLAY
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF.


/* PROCEDURES */
PROCEDURE cleanup:  
  IF NUM-DBS > 1 THEN DO:   
    IF rmvobj THEN DO:
        DISCONNECT VALUE(osh_dbname).
        RUN prodict/misc/_clproto.p (INPUT osh_dbname, INPUT pro_dbname).
    END.
    ELSE DO:       
      CREATE ALIAS DICTDB FOR DATABASE VALUE(osh_dbname).
      RUN prodict/misc/_del-db.p (INPUT odb_dbname, INPUT osh_dbname, 
                                  INPUT pro_dbname).       
    END.
  END.
END PROCEDURE.

/*   TRIGGERS   */

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN

 ON LEAVE of codb_type IN FRAME x DO :
   IF codb_type BEGINS "SQL" THEN codb_type = "Sql Server 6".
   IF LOOKUP(input codb_type, odbctypes) = 0 THEN DO:
     MESSAGE "THE DBMS types that are supported are: " SKIP  
       "  Sybase, DB2/400, DB2(Other), Other(MS Access), Other(Generic)" SKIP (1)
        VIEW-AS ALERT-BOX ERROR.
     RETURN NO-APPLY.
   END.

      /* if not changing value, nothing to be done and can't go through or we 
      will end up undoing the user changes and changing stuff back to their 
      default values 
   */
   IF codb_type = SELF:screen-value THEN
      RETURN.

   IF input codb_type BEGINS "DB2" OR
      input codb_type BEGINS "MS Acc" OR
      input codb_type BEGINS "MSAcc" OR
      input codb_type BEGINS "Oth"  THEN 
     ASSIGN pcompatible:screen-value in frame x = "no"
            pcompatible = FALSE
            pcompatible:sensitive in frame x = no.
   ELSE
     ASSIGN pcompatible:sensitive in frame x = YES
            pcompatible = TRUE
            pcompatible:screen-value in frame x = "yes".   

   IF input codb_type EQ "DB2/400" THEN 
     ASSIGN odbdef:screen-value in frame x = "no"
            odbdef = FALSE
            odbdef:sensitive in frame x = yes
            pcompatible:sensitive in frame x = yes.
   ELSE
     ASSIGN odbdef:sensitive in frame x = no
            odbdef = FALSE
            odbdef:screen-value in frame x = "no"
            iRidOption:SCREEN-VALUE in frame x = "1"  
            iRidOption:SENSITIVE in frame x = FALSE.
   ASSIGN lodbdef_enabled = odbdef
          iRidOption = INTEGER(iRidOption:SCREEN-VALUE). /* OE00189366 */
  
   ASSIGN lCompatible_enabled = pcompatible:sensitive in frame x. 

   IF codb_type:SCREEN-VALUE BEGINS "Oth" THEN
       ASSIGN shadowcol:SENSITIVE IN FRAME X = NO
              shadowcol:SCREEN-VALUE IN FRAME X = "no".
   ELSE
       ASSIGN shadowcol:SENSITIVE IN FRAME X = YES
              shadowcol:SCREEN-VALUE IN FRAME X = "no".
   /* If the user has chosen DB2/400, display and enable the Library fill-in. 
      Otherwise, hide it. */
   IF codb_type:SCREEN-VALUE IN FRAME X EQ "DB2/400" THEN
     ASSIGN odb_library:HIDDEN    IN FRAME X = FALSE
            odb_library:SENSITIVE IN FRAME X = TRUE.
   ELSE
     ASSIGN odb_library:HIDDEN       IN FRAME X = TRUE
            odb_library:SENSITIVE    IN FRAME X = FALSE
            odb_library:SCREEN-VALUE IN FRAME X = ""
            odb_library                         = "".

   /*keep value up-to-date - OE00177721 */
   odb_type = SELF:screen-value.
 END.

 ON ENTRY OF pro_dbname IN FRAME X DO:

   IF codb_type:SCREEN-VALUE IN FRAME X EQ "DB2/400" THEN
     ASSIGN odb_library:HIDDEN    IN FRAME X = FALSE
            odb_library:SENSITIVE IN FRAME X = TRUE
            odbdef:SENSITIVE      IN FRAME X = TRUE.
   ELSE
     ASSIGN odb_library:HIDDEN       IN FRAME X = TRUE
            odb_library:SENSITIVE    IN FRAME X = FALSE
            odb_library:SCREEN-VALUE IN FRAME X = ""
            odb_library                         = ""
            odbdef:SENSITIVE         IN FRAME X = FALSE
            odbdef:SCREEN-VALUE      IN FRAME X = "no"
            odbdef                              = NO.
 END.
&ENDIF  

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
 ON VALUE-CHANGED of odb_type IN FRAME x OR
    LEAVE of odb_type IN FRAME x DO :

   /* if not changing value, nothing to be done and can't go through or we 
      will end up undoing the user changes and changing stuff back to their 
      default values 
   */
   IF odb_type = SELF:screen-value THEN
      RETURN.

   IF odb_type:screen-value BEGINS "DB2" OR
      odb_type:screen-value BEGINS "MS Acc" OR
      odb_type:screen-value BEGINS "Oth" THEN
     ASSIGN pcompatible:screen-value in frame x = "no"
            pcompatible = FALSE
            pcompatible:sensitive in frame x = no.
   ELSE
     ASSIGN pcompatible:sensitive in frame x = YES
            pcompatible:screen-value in frame x = "yes"
            pcompatible = TRUE.  

   IF odb_type:screen-value EQ "DB2/400" THEN
     ASSIGN odbdef:screen-value in frame x = "no"
            odbdef = FALSE
            odbdef:sensitive in frame x = yes
            pcompatible:sensitive in frame x = yes.
   ELSE
     ASSIGN odbdef:sensitive in frame x = NO
            odbdef:screen-value in frame x = "no"
            odbdef = FALSE
            iRidOption:SCREEN-VALUE in frame x  = "1"  
            iRidOption:SENSITIVE in frame x = FALSE.  
   ASSIGN lodbdef_enabled = odbdef
          lCompatible_enabled = pcompatible:sensitive in frame X
          iRidOption = INTEGER(iRidOption:SCREEN-VALUE). /* OE00189366 */. 
    
   IF odb_type:SCREEN-VALUE BEGINS "Other(G" THEN
       ASSIGN shadowcol:SENSITIVE IN FRAME X = NO
              shadowcol:SCREEN-VALUE = "NO".
   ELSE
       ASSIGN shadowcol:SENSITIVE IN FRAME X = YES
              shadowcol:SCREEN-VALUE = "no".
   /* If the user has chosen DB2/400, display and enable the Library fill-in. 
      Otherwise, hide it. */
   IF odb_type:SCREEN-VALUE IN FRAME X EQ "DB2/400" THEN
     ASSIGN odb_library:HIDDEN    IN FRAME X = FALSE
            odb_library:SENSITIVE IN FRAME X = TRUE.
   ELSE
     ASSIGN odb_library:HIDDEN       IN FRAME X = TRUE
            odb_library:SENSITIVE    IN FRAME X = FALSE
            odb_library:SCREEN-VALUE IN FRAME X = ""
            odb_library                         = "".

   /*keep value up-to-date - OE00177721 */
   odb_type = SELF:screen-value.
 END.

 ON ENTRY OF pro_dbname IN FRAME X DO:
   IF odb_type EQ "DB2/400" THEN
     ASSIGN odb_library:HIDDEN    IN FRAME X = FALSE
            odb_library:SENSITIVE IN FRAME X = TRUE
            iRidOption:SENSITIVE  IN FRAME X = TRUE
            odbdef:SENSITIVE      IN FRAME X = TRUE.
   ELSE
     ASSIGN odb_library:HIDDEN       IN FRAME X = TRUE
            odb_library:SENSITIVE    IN FRAME X = FALSE
            odb_library:SCREEN-VALUE IN FRAME X = ""
            odb_library                         = ""
            iRidOption:SENSITIVE     IN FRAME X = FALSE
            odbdef:SENSITIVE         IN FRAME X = FALSE
            odbdef:SCREEN-VALUE      IN FRAME X = "no"
            odbdef                              = NO.
 END.
&ENDIF
  
/* Please Note: In the event that we cover DB2 drivers on a UNIX platform:
   The DataDirect ODBC driver on the UNIX platform has a corresponding 
   location in the ODBC.INI file the connection string attribute
   "Collection" (COL=<value>) and AlternateID (AID=<value>)  
   where these values can be extracted.
   Also Note: The registry keys & values for SQL qualifier are specific to DataDirect drivers.
   The process for obtaining the appropriate qualifier may change if access to DB2 native
   drivers through the ODBC DataServer is considered in the future */
 /* OE00178256- In case of iSeries Access ODBC driver, the registry entry with the key 
    "DefaultLibraries" specifies the iSeries libraries to add to the server job's library list
    The libraries are delimited by commas or spaces, and *USRLIBL may be used as a 
    place holder for the server job's current library list. */
 /* OE00179889- iSeries driver: Default library is genrated based on the following rules:
    If any value is provided for SQL Default Library, then a space-separated list is created 
    in the registry, irrespective of spaces or commas separating the library list.
    If no value is provided for SQL Default Library, then first character is comma and then a 
    space-separated list is created in registry irrespective of presence of spaces or commas 
    separating the libaries in the library list.  */


&IF "{&OPSYS}" NE "UNIX" 
&THEN
  ON LEAVE of odb_dbname in frame X DO:
  dsn_name = odb_dbname:SCREEN-VALUE.
  IF INDEX(getRegEntry(dsn_name,"Driver"),"cwbodbc.dll") EQ 0 THEN 
	default_lib = (IF getRegEntry(dsn_name,"AlternateID") <> ? THEN
                   getRegEntry(dsn_name,"AlternateID")
                 ELSE (IF getRegEntry(dsn_name,"Collection") <> ? THEN
                   getRegEntry(dsn_name,"Collection")
                 ELSE (IF getRegEntry(dsn_name,"LogOnID") <> ? THEN
                   getRegEntry(dsn_name,"LogOnID")
		 ELSE "" ))).
  ELSE DO:
         ASSIGN def_libraries = getRegEntry(dsn_name,"DefaultLibraries").
	 default_lib = (IF def_libraries <> ? AND index(def_libraries,",") EQ 1 THEN
		    SUBSTRING(def_libraries,2,index(def_libraries," ") - 1) 
		 ELSE (IF def_libraries <> ? AND index(def_libraries," ") GE 0 THEN
		    SUBSTRING(def_libraries,1,index(def_libraries," ") - 1) 
		 ELSE (IF def_libraries EQ ? AND getRegEntry(dsn_name,"UserID") <> ? THEN 
                    getRegEntry(dsn_name,"UserID")
		 ELSE ""))).  
  END. 
  ASSIGN odb_library:SCREEN-VALUE IN FRAME X = default_lib
         odb_library                         = default_lib.
  END. 
&ENDIF.

ON LEAVE OF odb_library IN FRAME X 
  ASSIGN odb_library.

ON WINDOW-CLOSE of FRAME x
   APPLY "END-ERROR" to FRAME x.
   
ON VALUE-CHANGED OF iFmtOption IN FRAME x DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lExpand:CHECKED   = FALSE
           lExpand:SENSITIVE = FALSE
           lFormat           = ?.
  ELSE 
    ASSIGN lExpand:CHECKED   = TRUE
           lExpand:SENSITIVE = TRUE
           lFormat           = FALSE.
END.
ON VALUE-CHANGED of loadsql IN FRAME x DO:
  IF SELF:screen-value = "yes" THEN 
     movedata:sensitive in frame x = YES.
  ELSE DO:
     movedata:screen-value in frame x = "no".
     movedata = false.
     movedata:sensitive in frame x = NO.
  END.   
END.  

ON VALUE-CHANGED of pcompatible IN FRAME x DO: 
/* only need to do this for db2/400 since iRidOption cannot be enabled otherwise */ 
    IF SELF:screen-value = "yes" THEN DO:
       assign pcompatible = TRUE.
       IF odb_type EQ "DB2/400" THEN DO:
          ASSIGN iRidOption:SCREEN-VALUE in frame x = "2"
                 iRidOption:SENSITIVE in frame x = TRUE.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
           iRidOption:MOVE-AFTER-TAB-ITEM(pcompatible:HANDLE in frame x) in frame X.
&ENDIF
       END.
       ELSE
          ASSIGN iRidOption:SCREEN-VALUE in frame x  = "1"
                 iRidOption:SENSITIVE in frame x = FALSE.   
    END. 
    ELSE 
       ASSIGN pcompatible = FALSE
              iRidOption:SCREEN-VALUE in frame x  = "1" 
              iRidOption:SENSITIVE in frame x = FALSE.
ASSIGN iRidOption = INTEGER(iRidOption:SCREEN-VALUE). /* OE00189366 */
END.

ON VALUE-CHANGED of odbdef IN FRAME x DO:
  IF SELF:screen-value = "yes" THEN
     assign lodbdef_enabled = TRUE
            odbdef = TRUE.
  ELSE DO:
     assign lodbdef_enabled = FALSE
            odbdef = FALSE.
  END.   
END.  

&IF "{&WINDOW-SYSTEM}"<> "TTY" &THEN   
/*----- HELP in Progress DB to Oracle Database -----*/
on CHOOSE of btn_Help in frame x
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&PROGRESS_DB_to_ODBC_Dlg_Box},
                             INPUT ?).
&ENDIF

IF LDBNAME ("DICTDB") <> ? THEN
  ASSIGN pro_dbname = LDBNAME ("DICTDB").

IF NOT batch_mode THEN DO:
   {adecomm/okrun.i  
       &FRAME  = "FRAME x" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
   }
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME x = yes.
   &ENDIF
END.

ASSIGN pcompatible = YES
    lCompatible_enabled = YES.
ASSIGN odbdef = NO
    lodbdef_enabled = NO.

main-blk:
DO ON ERROR UNDO main-blk, RETRY main-blk:
  
  IF redo THEN
     RUN cleanup.

  IF logfile_open THEN DO:
     OUTPUT STREAM logfile CLOSE.
     logfile_open = FALSE.
  END.

  IF wrg-ver THEN DO:
    MESSAGE "The DataServer for ODBC was designed to work with MS SQL Server 6 and " SKIP
            "below.  You have tried to connect to a later version. " SKIP
            "Use the DataServer for MS SQL Server to perform this function. " SKIP(1)       
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.

  ASSIGN run_time = TIME.

  IF OS-GETENV("PRODBNAME")   <> ? THEN
      pro_dbname   = OS-GETENV("PRODBNAME").
  IF OS-GETENV("PROCONPARMS")   <> ? THEN
        pro_conparms = OS-GETENV("PROCONPARMS").
  IF OS-GETENV("SHDBNAME")    <> ? THEN
      osh_dbname   = OS-GETENV("SHDBNAME").
  IF OS-GETENV("ODBCDBNAME")   <> ? THEN
      odb_dbname   = OS-GETENV("ODBCDBNAME").
  IF OS-GETENV("ODBCTYPE")   <> ? THEN
      odb_type   = OS-GETENV("ODBCTYPE").    
  IF OS-GETENV("ODBCUSERNAME") <> ? THEN
      odb_username = OS-GETENV("ODBCUSERNAME").
  IF OS-GETENV("ODBCPASSWORD") <> ? THEN
      odb_password = OS-GETENV("ODBCPASSWORD").
  IF OS-GETENV("ODBCCONPARMS") <> ? THEN
      odb_conparms = OS-GETENV("ODBCCONPARMS").
  IF OS-GETENV("ODBCCODEPAGE") <> ? THEN
      odb_codepage = OS-GETENV("ODBCODEPAGE").
  ELSE
     ASSIGN odb_codepage = session:cpinternal.
  IF OS-GETENV("ODBCCOLLNAME") <> ? THEN
      odb_collname = OS-GETENV("ODBCCOLLNAME").
  ELSE
     ASSIGN odb_collname = session:CPCOLL.
  IF OS-GETENV("MOVEDATA")    <> ? THEN
      tmp_str      = OS-GETENV("MOVEDATA").
  IF tmp_str BEGINS "Y" THEN movedata = TRUE.

  IF OS-GETENV("COMPATIBLE") <> ? 
  THEN DO:
      tmp_str      = OS-GETENV("COMPATIBLE").
      IF tmp_str BEGINS "Y" then pcompatible = TRUE.
      ELSE pcompatible = FALSE.
   END. 
  ELSE IF batch_mode AND odb_type EQ "DB2/400" THEN ASSIGN
      pcompatible = FALSE.

  IF OS-GETENV("SHADOWCOL") <> ? THEN DO:
    tmp_str      = OS-GETENV("SHADOWCOL").
    IF tmp_str BEGINS "Y" then shadowcol = TRUE.
    ELSE shadowcol = FALSE.
  END. 
  ELSE 
    shadowcol = FALSE.

  IF OS-GETENV("CRTDEFAULT") <> ? 
   THEN DO:
      tmp_str      = OS-GETENV("CRTDEFAULT").
      IF tmp_str BEGINS "Y" then odbdef = TRUE.
      ELSE odbdef = FALSE.
   END. 
  ELSE
      odbdef = FALSE.

  /* Initialize field width choice */
  IF OS-GETENV("SQLWIDTH") <> ? THEN DO:
    tmp_str      = OS-GETENV("SQLWIDTH").
    IF tmp_str BEGINS "Y" THEN 
      iFmtOption = 1.
    ELSE 
      iFmtOption = 2.
  END. 
  ELSE
    iFmtOption = 2.
 
  IF OS-GETENV("EXPANDX8") <> ? THEN DO:
    ASSIGN tmp_str  = OS-GETENV("EXPANDX8").
    IF tmp_str BEGINS "Y" THEN 
      ASSIGN lExpand = TRUE
             lFormat = FALSE.
    ELSE 
      ASSIGN lExpand = FALSE
             lFormat = TRUE.
  END. 
  ELSE
    ASSIGN lExpand = TRUE
           lFormat = FALSE.

  IF odb_type = "DB2/400" THEN DO: 
    tmp_str      = OS-GETENV("RECIDALLTABLES").
    IF tmp_str BEGINS "Y" THEN 
      iRidOption = 1.
    ELSE 
      iRidOption = 2.
  END. 
  ELSE
    iRidOption = 1.

  IF OS-GETENV("LOADSQL") <> ? THEN DO:
    tmp_str      = OS-GETENV("LOADSQL").
    IF tmp_str BEGINS "Y" then loadsql = TRUE.
    ELSE loadsql = FALSE.
  END. 
  ELSE 
    loadsql = TRUE.
 
  /* allow collection to be specified */
  IF odb_type = "DB2/400" AND OS-GETENV("COLLECTION") <> ? THEN
     odb_library = OS-GETENV("COLLECTION").

  IF PROGRESS EQ "COMPILE-ENCRYPT" THEN
    ASSIGN mvdta = FALSE.
  ELSE
    ASSIGN mvdta = TRUE.

  if   pro_dbname   = ldbname("DICTDB")
   and pro_conparms = ""
   then assign pro_conparms = "<current working database>".

  IF redoblk THEN DO:
      MESSAGE "You have received error messages from the client stating why" 
              SKIP
              "the process was stopped.  Correct the errors and try again." SKIP
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  END.

  /*
   * if this is not batch mode, allow override of environment variables.
   */
  
  IF NOT batch_mode THEN 
  _updtvar: 
  DO WHILE TRUE:
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      DISPLAY cFormat lExpand WITH FRAME x.
      UPDATE pro_dbname
        pro_conparms
        osh_dbname
        odb_dbname
        odb_type 
        odb_username
        odb_password
        odb_conparms
        odb_codepage  
        odb_collname
        odb_library
        pcompatible WHEN lCompatible_enabled    
        iRidOption WHEN pcompatible
        shadowcol
        loadsql
        movedata WHEN mvdta
        odbdef
        iFmtOption
        lExpand WHEN iFmtOption = 2
        btn_OK btn_Cancel 
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            btn_Help
        &ENDIF
        WITH FRAME x.
    &ELSE
      DISPLAY cFormat lExpand WITH FRAME x.
      UPDATE pro_dbname
        pro_conparms
        osh_dbname
        odb_dbname
        codb_type 
        odb_username
        odb_password
        odb_conparms
        odb_codepage
        odb_collname
        odb_library
        pcompatible
        iRidOption WHEN pcompatible AND codb_type = "DB2/400"
        shadowcol
        loadsql
        movedata
        odbdef
        iFmtOption
        lExpand WHEN iFmtOption = 2
        btn_OK btn_Cancel
        WITH FRAME X.
        
      IF codb_type = ? OR codb_type = "" THEN DO:
        MESSAGE "Foreign DBMS Type is required." SKIP
            VIEW-AS ALERT-BOX.
        NEXT-PROMPT codb_type with frame x.
        NEXT _updtvar.
      END.
      ELSE
        ASSIGN odb_type = codb_type.              
    &ENDIF      

    IF iFmtOption = 1 THEN
        lFormat = ?.
      ELSE
        lFormat = (NOT lExpand).
      
    IF pro_conparms = "<current working database>" THEN
      ASSIGN pro_conparms = "".

      IF odb_library:HIDDEN = NO and (odb_library = "" OR odb_library = ?) THEN DO:
        MESSAGE "Collection/Library is required."
             VIEW-AS ALERT-BOX ERROR.
        NEXT-PROMPT odb_library with frame x.
        NEXT _updtvar.
      END.

    IF loadsql THEN DO:
      IF Osh_dbname = "" OR osh_dbname = ? THEN DO:
        MESSAGE "Schema holder database Name is required." 
             VIEW-AS ALERT-BOX ERROR.    
        NEXT _updtvar.
      END.

      IF odb_dbname = "" OR odb_dbname = ? THEN DO:
        MESSAGE "ODBC Data Source Name is required."  
            VIEW-AS ALERT-BOX ERROR.  
        NEXT _updtvar.
      END.
     ELSE
       ASSIGN odb_library = UPPER(odb_library).
    END.      
    LEAVE _updtvar.
  END.
  
  IF osh_dbname <> "" AND osh_dbname <> ? THEN
      output_file = osh_dbname + ".log".
  ELSE
      output_file = "protoodb.log". 

  OUTPUT STREAM logfile TO VALUE(output_file) NO-ECHO NO-MAP UNBUFFERED. 
  logfile_open = true. 
  IF pro_dbname = "" OR pro_dbname = ? THEN DO:
    PUT STREAM logfile UNFORMATTED "{&PRO_DISPLAY_NAME} Database name is required." SKIP.
    ASSIGN err-rtn = TRUE.
  END.
  ELSE DO:
      IF LDBNAME ("DICTDB") <> pro_dbname THEN DO:
          ASSIGN old-dictdb = LDBNAME("DICTDB").
          IF NOT CONNECTED(pro_dbname) THEN
            CONNECT VALUE (pro_dbname) VALUE (pro_conparms) -1 NO-ERROR.              
          
          IF ERROR-STATUS:ERROR OR NOT CONNECTED (pro_dbname) THEN DO:
            DO i = 1 TO  ERROR-STATUS:NUM-MESSAGES:
              IF batch_mode THEN
                PUT STREAM logfile UNFORMATTED ERROR-STATUS:GET-MESSAGE(i) skip.
              ELSE
                MESSAGE ERROR-STATUS:GET-MESSAGE(i).
            END.
            IF batch_mode THEN
               PUT STREAM logfile UNFORMATTED "Unable to connect to {&PRO_DISPLAY_NAME} database"
               skip.
            ELSE DO:
              &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                  MESSAGE "Unable to connect to {&PRO_DISPLAY_NAME} database".
              &ELSE
                 MESSAGE "Unable to connect to {&PRO_DISPLAY_NAME} database" 
                 VIEW-AS ALERT-BOX ERROR.
              &ENDIF
            END.            
            ASSIGN err-rtn = TRUE.
          END.
          ELSE DO:
            CREATE ALIAS DICTDB FOR DATABASE VALUE(pro_dbname).
          end.  
      END.
      ELSE
          ASSIGN old-dictdb = LDBNAME("DICTDB").
  END.

  IF odb_type = "" OR odb_type = ? THEN DO:
     PUT STREAM logfile UNFORMATTED "Foreign DBMS type is required." SKIP.   
     ASSIGN err-rtn = TRUE.
  END.

  /* for DB2/400, must specify collection name */
  IF odb_type = "DB2/400" AND (odb_library = "" OR odb_library = ?) THEN DO:
     PUT STREAM logfile UNFORMATTED "Collection/Library is required." SKIP.
     ASSIGN err-rtn = TRUE.
  END.

  IF loadsql THEN DO:
    IF Osh_dbname = "" OR osh_dbname = ? THEN DO:
       PUT STREAM logfile UNFORMATTED  "Schema holder Database Name is required." SKIP.   
       ASSIGN err-rtn = TRUE.        
    END.
    IF odb_dbname = "" OR odb_dbname = ? THEN DO:
       PUT STREAM logfile UNFORMATTED "ODBC data source name is required." SKIP.   
       ASSIGN err-rtn = TRUE.
    END.
  END.      
  IF err-rtn THEN RETURN.

  ASSIGN redo = TRUE.
  /* Set correct odbc type for the next process */
  IF odb_type BEGINS "Oth" THEN DO:
    IF odb_type = "Other(Ms Access)" OR odb_type = "Other(MsAccess)" THEN
       ASSIGN odb_type = "Ms Access".
    ELSE
       ASSIGN odb_type = "Other".
  END.

  RUN prodict/odb/protood1.p.
  IF RETURN-VALUE = "indb" THEN DO:
    ASSIGN redo = FALSE.
    UNDO, RETRY.
  END.
  ELSE IF RETURN-VALUE = "wrg-ver" THEN DO:
    ASSIGN wrg-ver = TRUE.
    UNDO, RETRY.
  END.
  ELSE IF RETURN-VALUE = "undo" THEN DO:
    ASSIGN redoblk = TRUE.
    UNDO, RETRY.
  END.
  /*
   * If this is batch mode, make sure we close the output file we
   * opened above.
  */
  IF logfile_open
    THEN OUTPUT STREAM logfile CLOSE.
 
  IF CONNECTED (osh_dbname) THEN 
     DISCONNECT VALUE (osh_dbname).

  IF pro_dbname <> old-dictdb THEN DO:
    DISCONNECT VALUE(pro_dbname).
    IF old-dictdb NE ? THEN
       CREATE ALIAS DICTDB FOR DATABASE VALUE(old-dictdb).   
  END.
END.

&IF "{&OPSYS}" NE "UNIX" &THEN

&SCOPED-DEFINE KEY_PATH "ODBC~\ODBC.INI~\"

/* Function : getRegEntry
   Purpose  : To read from WindowsRegistry
   Input    : DSN name as charcter & Key as Character
   Output   : Value read from registry as character */

FUNCTION getRegEntry RETURN CHARACTER 
 (INPUT dsnName as CHARACTER, keyName AS CHARACTER):
  DEFINE VARIABLE keyData AS CHARACTER NO-UNDO INIT ?.

  /* Look for User DSN first */
   LOAD "SOFTWARE" BASE-KEY "HKEY_CURRENT_USER".
   USE "SOFTWARE".
   GET-KEY-VALUE SECTION {&KEY_PATH} + dsnName
   KEY keyName
   VALUE keyData.
   UNLOAD "SOFTWARE".

  /* Look for System DSN, if User DSN not found */
  IF keyData EQ ? THEN DO:
   LOAD "SOFTWARE" BASE-KEY "HKEY_LOCAL_MACHINE".
   USE "SOFTWARE".
   GET-KEY-VALUE SECTION {&KEY_PATH} + dsnName
   KEY keyName
   VALUE keyData.
   UNLOAD "SOFTWARE".
  END.

  RETURN keyData.
END FUNCTION.
&ENDIF 
/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Created:  fernando 12/04/07

             Wrapper for MSS or ODBC schema pull that can be executed in batch
             mode.
                  
                  
   Input: p_db_name   - logical name of schema image
          p_obj_name  - object name for object selection
          p_obj_owner - owner name for object selection
          p_obj_type  - type for object selection
          
          p_obj_* can be '*' to match all, a string or a string containing '*'
          (i.e. 'cust*').

          Database must already be connected and the user connected
          must have permissions to query the schema information.

  History:  
         kmayur  06/28/11  added procbfrpul.p for constraint feature. 
*/
 
&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/odb/odbvar.i NEW }
{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i NEW }

DEFINE INPUT PARAMETER p_db_name    AS CHAR. 
DEFINE INPUT PARAMETER p_obj_name   AS CHAR.
DEFINE INPUT PARAMETER p_obj_owner  AS CHAR.
DEFINE INPUT PARAMETER p_obj_type   AS CHAR.

/* Initialize variables */
ASSIGN
  user_dbtype   = DBTYPE(p_db_name)
  user_filename = ""
  drec_file     = ?
  odb_dbname    = p_db_name
  cache_dirty   = TRUE
  user_env[1]   = "upd"
  user_env[2]   = p_db_name
  user_env[3]   = user_dbtype.

IF user_dbtype NE "MSS" AND user_dbtype NE "ODBC" THEN
DO:
    MESSAGE "Database" p_db_name "has invalid type".
    RETURN ERROR.
END.

CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(p_db_name) NO-ERROR.

/* Get the RECID for the database in the schema holder */
FIND DICTDB._Db WHERE DICTDB._Db._Db-name = p_db_name NO-LOCK NO-ERROR.
drec_db = RECID(DICTDB._Db).

/* Initialize variables */
ASSIGN
   user_dbname = p_db_name
   user_env[1] = p_db_name
   user_env[2] = p_db_name.

DO TRANSACTION:
    CREATE s_ttb_link.
    ASSIGN
       s_level   = 0
       s_ldbname = p_db_name
       s_master  = ""
       s_lnkname = ""
       s_ttb_link.level    = 0
       s_ttb_link.master   = ""
       s_ttb_link.name     = ""
       s_ttb_link.srchd    = false
       s_ttb_link.presel-n = p_obj_name
       s_ttb_link.presel-o = p_obj_owner
       s_ttb_link.presel-t = p_obj_type
       /* for _odb_get.p */
       /* "{AUTO},<name>,<owner>,<type>,<qualifier>"*/
       user_env[25] = "AUTO," + p_obj_name + "," + 
                      p_obj_owner + "," + 
                      p_obj_type + ",*"
      . 
END. /* transaction */

/* Determine what to pull  */
IF DBTYPE(p_db_name) = "MSS" THEN
    RUN prodict/mss/_mss_get.p.  
ELSE 
    RUN prodict/odb/_odb_get.p.

FIND FIRST gate-work NO-ERROR.
IF NOT AVAILABLE gate-work THEN DO:
    MESSAGE "No objects found.".
    RETURN.
END.

/* Pull */
IF DBTYPE(p_db_name) = "MSS" THEN
DO:   
   RUN prodict/mss/procbfrpul.p.
   RUN prodict/mss/_mss_pul.p.
END.   
ELSE
   RUN prodict/odb/_odb_pul.p.

find first gate-work where gate-work.gate-slct = TRUE no-error.
IF NOT AVAILABLE gate-work THEN DO:
    MESSAGE "No objects selected to be pulled.".
    RETURN.
END.

RUN prodict/gate/_gat_cro.p. /* Create the objects in the schema-holder */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_beauty.p

Description:
    wrapper to ora/_ora_fix.p, which fixes-up an SI to match an original
    PROGRESS-DB

Input-Parameters:
    none

Output-Parameters:
    none
    
History:
    96/06   hutegger    created

                            
--------------------------------------------------------------------*/
/*h-*/

/*------------------------  INITIALIZATIONS  -----------------------*/

{ prodict/gate/beauty.i
    &edb-type = "ORACLE"
    }.

/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2005-2009 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Procedure: prodict/ora/_gendsql.p

     Created: Donna L. McMann
              10/20/98
              
              Creates an incremental sql script to be loaded into ORACLE
              and an incremental df to be loaded into the ORACLE Schema holder
              
     History: 
     ll/03/98 put check in for renamed file to get proper field names  
     11/20/98 Index-fields for old file, foreign name for indexes 
     03/22/99 Changed how index names are translated
     01/18/00 Changed new shadow column to be created as VARCHAR2
     06/07/00 Added proper quoting of fields.
     06/09/00 Changed how long index names are created.
     08/11/00 Changed calculation of foreign position 20000809014
     08/17/00 Removed FORMAT from .df 20000808036
     08/19/00 Corrected compatibility not working 20000818034
     08/22/00 Changed data type for recid and integer 20000821017
     08/23/00 Changed calculation of shadow column position 20000822016
     11/13/00 Added minwidth for character format to be consistent with _wrktgen.p
     12/18/00 Added check for existing file and new-obj for foreign-pos.
     03/14/01 Changed how format for decimals are done.
     04/10/01 Assignment of index name with new table and index corrected.
     06/20/01 Added Foreign Owner
     07/09/01 Changed how index name is created to match protoora 20010523-010
     11/27/01 Added defaults and check for longs. 20011108-022 20010226-013
     11/30/01 Added check for unique table and index names 20010116-014
     12/06/01 Added support for sql-width 20010112-007
     03/15/02 Added suport for descending indexes
     07/08/02 DESC index fixes 20020702013,20020703006, 20020622001
     07/23/02 Added support for function based index, dropping fields for > V7
     09/18/02 Added support for MAX-WIDTH keyword
     11/13/02 Fixed output of defaut values when table is being altered 20021112-034
     11/22/02 Added .e file when FORMAT or WIDTH is changed and also put out message about
              which table had too many longs and was commented out 20021122-021
     11/25/02 Modified logic for updating SEQ.  20021122-025
     01/06/03 Modified logic for numbering index on existing files 20030106-040
     02/25/03 Added support for BLOBS
     03/18/03 Added alter table after update statement for blobs to put on
              null constraint
     06/02/03 Fixed 20030528-012 foreign position with multiple updates
     06/30/03 Added logic for unsupported data types.
     08/14/03 Added verify field and index names, fixed add seq problem
     08/15/03 Added CAPS for case insensitive search for _file _index for name
     10/10/03 Added logic for multiple extents at end of file for foreign position 20031007-008
     08/12/04 Fixed logic for EXTENTS when using SQL-WIDTH 20040603-016
     08/13/04 Added support for LONG RAW 20040312-002

     03/15/05 kmcintos Added code to check for pending renamed index before
                       attempting to find a unique name for add. 20050311-014 
     03/25/05 Additional work to fix logic for extents using SQL-WIDTH 20050214-017
     02/08/05 Added support for turning on/off x(8) override to x(30) - depending on
              value stored in sqlwidth 
     08/04/05 Reworked handling of sqlwidth so it doesn't interfere with handling of defaults 20050216-014
     06/12/06 Support for int64
     06/11/07 Unicode and clob support for ORACLE
     04/07/08 Datetime support
     04/14/08 Removed unnecessary type check in write-tbl-sql - OE00166674
     05/12/08 Handle duplicate field names being added - OE00166402
     12/08/08 Handle case where index is re-added - OE00177558
     04/14/09 Handle update of new object
     09/25/11 Delta sql support for constraint feature by kmayur               
If the user wants to have a DEFAULT value of blank for VARCHAR2 fields, 
an environmental variable BLANKDEFAULT can be set to "YES" and the code will
put the DEFAULT ' ' syntax on the definition for a new field. D. McMann 11/27/02                 
                  
*/              

{ prodict/user/uservar.i }
{ prodict/ora/oravar.i }

DEFINE VARIABLE iarg          AS CHARACTER             NO-UNDO. 
DEFINE VARIABLE ikwd          AS CHARACTER             NO-UNDO. 
DEFINE VARIABLE imod          AS CHARACTER             NO-UNDO. 
DEFINE VARIABLE ipos          AS INTEGER               NO-UNDO. 
DEFINE VARIABLE ilin          AS CHARACTER EXTENT 256  NO-UNDO.
DEFINE VARIABLE a             AS INTEGER               NO-UNDO.
DEFINE VARIABLE i             AS INTEGER               NO-UNDO.
DEFINE VARIABLE j             AS INTEGER               NO-UNDO.
DEFINE VARIABLE k             AS INTEGER               NO-UNDO.
DEFINE VARIABLE u             AS INTEGER               NO-UNDO.
DEFINE VARIABLE z             AS INTEGER               NO-UNDO.
DEFINE VARIABLE iobj          AS CHARACTER             NO-UNDO. /* d,t,f,i */
DEFINE VARIABLE inot          AS LOGICAL               NO-UNDO.
DEFINE VARIABLE inum          AS INTEGER               NO-UNDO.
DEFINE VARIABLE all_digits    AS INTEGER               NO-UNDO. 
DEFINE VARIABLE dec_point     AS INTEGER               NO-UNDO. 
DEFINE VARIABLE pos           AS INTEGER               NO-UNDO.
DEFINE VARIABLE idx-number    AS INTEGER               NO-UNDO.
DEFINE VARIABLE lvar          AS CHARACTER EXTENT 10   NO-UNDO.
DEFINE VARIABLE lvar#         AS INTEGER               NO-UNDO.
DEFINE VARIABLE sqlout        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dfout         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE startdf       AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE addtable      AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE alt-table     AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE tablename     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE forname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fortype       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dffortype     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dfforitype    AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fieldname     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fieldtype     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE idbtyp        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE xlate         AS LOGICAL               NO-UNDO.
DEFINE VARIABLE nbrchar       AS INTEGER               NO-UNDO.
DEFINE VARIABLE lngth         AS INTEGER               NO-UNDO.
DEFINE VARIABLE left_paren    AS INTEGER               NO-UNDO.
DEFINE VARIABLE right_paren   AS INTEGER               NO-UNDO.
DEFINE VARIABLE lnum          AS INTEGER               NO-UNDO.
DEFINE VARIABLE endline       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE idxline       AS CHARACTER  INITIAL ?  NO-UNDO.
DEFINE VARIABLE idxname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE wordidx       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE wordfile      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE shw-fld       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE p-r-index     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE seqname       AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE seq-type      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE seq-line      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE init          AS CHARACTER             NO-UNDO.
DEFINE VARIABLE incre         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE cyc           AS CHARACTER             NO-UNDO.
DEFINE VARIABLE minval        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE maxval        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dbrecid       AS RECID                 NO-UNDO.
DEFINE VARIABLE fldnum        AS INTEGER               NO-UNDO.
DEFINE VARIABLE shw-col       AS INTEGER               NO-UNDO.
DEFINE VARIABLE df-idx        AS CHARACTER EXTENT 6    NO-UNDO.
DEFINE VARIABLE is-unique     AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE new-ord       AS INTEGER INITIAL 1     NO-UNDO.
DEFINE VARIABLE view-created  AS LOGICAL               NO-UNDO.
DEFINE VARIABLE dropped-fld   AS LOGICAL               NO-UNDO.
DEFINE VARIABLE transname     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE dupfield      AS LOGICAL               NO-UNDO.
DEFINE VARIABLE oq-string     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE minwidth      AS INTEGER               NO-UNDO.
DEFINE VARIABLE dfseq         AS INTEGER INITIAL 1     NO-UNDO.
DEFINE VARIABLE for-init      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE comment_chars AS CHARACTER             NO-UNDO.
DEFINE VARIABLE col-long      AS INTEGER               NO-UNDO.
DEFINE VARIABLE comment-out   AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE extline       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE extlinenum    AS INTEGER               NO-UNDO.
DEFINE VARIABLE newstoff      AS INTEGER               NO-UNDO.
DEFINE VARIABLE efile         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE rntbl         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE blankdefault  AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE uptseq        AS INTEGER               NO-UNDO.
DEFINE VARIABLE unsptdt       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE fsize         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE iExtents      AS INTEGER               NO-UNDO.
DEFINE VARIABLE lMandatory    AS LOGICAL               NO-UNDO.
DEFINE VARIABLE iWidth        AS INTEGER               NO-UNDO.
DEFINE VARIABLE cfldwidth     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE longwid       AS INTEGER               NO-UNDO.
DEFINE VARIABLE longType      AS CHARACTER             NO-UNDO.
DEFINE VARIABLE longIndex     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE index_df_start  AS INTEGER             NO-UNDO.
DEFINE VARIABLE index_sql_start AS INTEGER             NO-UNDO.
DEFINE VARIABLE origName      AS CHARACTER             NO-UNDO.

DEFINE VARIABLE conline       AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conline1      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conline2      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conname       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE conline3      AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE conidx        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE fldcon        AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE is_check      AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE con-number    AS INTEGER               NO-UNDO.
DEFINE VARIABLE pos-comma     AS INTEGER               NO-UNDO.
DEFINE VARIABLE df-con        AS CHARACTER EXTENT 7    NO-UNDO.
DEFINE VARIABLE con-fld-name  AS CHARACTER             NO-UNDO.
DEFINE VARIABLE con-ty        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE par-tab       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE par-index     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE con-actn      AS CHARACTER             NO-UNDO.


DEFINE TEMP-TABLE con-index NO-UNDO
  FIELD con-table    LIKE _file._File-name
  FIELD idx-name     LIKE _Index._Index-name
  FIELD idx-fld-name LIKE _field._Field-name.

DEFINE TEMP-TABLE con-type NO-UNDO  
  FIELD con-tab      LIKE _file._File-name  
  FIELD idx-nam      LIKE _Index._Index-name
  FIELD type     LIKE _Constraint._Con-type.
  
DEFINE TEMP-TABLE upt-blob NO-UNDO
    FIELD upt-line AS CHARACTER
    FIELD upt-seq  AS INTEGER
    FIELD upt-tbl  AS CHARACTER
    INDEX out-line AS PRIMARY upt-seq upt-tbl.

DEFINE TEMP-TABLE df-info NO-UNDO
    FIELD df-seq  AS INTEGER
    FIELD df-line AS CHARACTER
    FIELD df-tbl  AS CHARACTER
    FIELD df-fld  AS CHARACTER
    INDEX rt-line IS PRIMARY df-seq.

DEFINE TEMP-TABLE sql-info NO-UNDO
  FIELD line-num AS INTEGER
  FIELD line     AS CHARACTER
  FIELD tblname  AS CHARACTER
  FIELD fldname  AS CHARACTER
  FIELD fldmand  AS LOGICAL
  INDEX tbl-line IS PRIMARY tblname line-num ASCENDING
  INDEX fname tblname fldname. 
  
DEFINE TEMP-TABLE new-obj NO-UNDO
  FIELD add-type AS CHARACTER
  FIELD tbl-name AS CHARACTER
  FIELD fld-name AS CHARACTER
  FIELD for-name AS CHARACTER
  FIELD for-type AS CHARACTER
  FIELD prg-name AS CHARACTER
  FIELD n-order  AS INTEGER
  INDEX add-rec IS PRIMARY add-type tbl-name n-order prg-name.

DEFINE TEMP-TABLE rename-obj NO-UNDO
  FIELD rename-type AS CHARACTER
  FIELD t-name      AS CHARACTER
  FIELD old-name    AS CHARACTER
  FIELD new-name    AS CHARACTER
  FIELD dsv-name    AS CHARACTER.

DEFINE TEMP-TABLE drop-field NO-UNDO
  FIELD f-name      AS CHARACTER
  FIELD of-table    AS CHARACTER
  FIELD drop-f-name AS CHARACTER.  

DEFINE TEMP-TABLE new-position NO-UNDO
  FIELD table-np    AS CHARACTER
  FIELD old-pos     AS INTEGER
  FIELD new-pos     AS INTEGER
  FIELD extent#     AS INTEGER
  FIELD shadow      AS INTEGER
  FIELD field-np    AS CHARACTER
  FIELD dropped     AS LOGICAL INITIAL FALSE
  INDEX fld-pos IS PRIMARY table-np old-pos.


DEFINE TEMP-TABLE view-table NO-UNDO
  FIELD v-order  AS INTEGER
  FIELD v-table  AS CHARACTER
  FIELD v-field  AS CHARACTER
  FIELD v-line   AS CHARACTER
  FIELD v-progn  AS CHARACTER
  FIELD v-shadow AS LOGICAL INITIAL FALSE
  FIELD v-ext    AS LOGICAL INITIAL FALSE
  INDEX view-line IS PRIMARY v-table v-order ASCENDING
  INDEX v-field v-table v-field.

DEFINE TEMP-TABLE alt-info NO-UNDO
  FIELD a-line-num AS INTEGER
  FIELD a-line     AS CHARACTER
  FIELD a-tblname  AS CHARACTER
  FIELD a-fldname  AS CHARACTER
  FIELD fldmand    AS LOGICAL
  INDEX tbl-line IS PRIMARY a-tblname a-line-num ASCENDING
  INDEX fname a-tblname a-fldname. 
  
DEFINE TEMP-TABLE shad-col NO-UNDO
  FIELD s-fld-name AS CHARACTER
  FIELD s-tbl-name AS CHARACTER
  FIELD p-fld-name AS CHARACTER
  FIELD col-num    AS INTEGER.
    
DEFINE TEMP-TABLE verify-table NO-UNDO
  FIELD tnew-name LIKE _File._File-name
  INDEX trun-name IS UNIQUE tnew-name.

DEFINE TEMP-TABLE verify-field NO-UNDO
  FIELD f-table   LIKE _file._File-name
  FIELD fnew-name LIKE _field._Field-name
  INDEX frun-name IS UNIQUE f-table fnew-name.
  
DEFINE TEMP-TABLE verify-index NO-UNDO
  FIELD inew-name LIKE _index._index-name
  FIELD i-table   LIKE _file._File-name
  INDEX trun-name IS UNIQUE inew-name i-table.  

DEFINE TEMP-TABLE warnlong NO-UNDO
   FIELD wname AS CHARACTER
   INDEX wnamel wname.

DEFINE TEMP-TABLE verify-con NO-UNDO
  FIELD cnew-name LIKE _constraint._con-name
  INDEX trun-name IS UNIQUE cnew-name.

DEFINE BUFFER n-obj FOR new-obj.
    
DEFINE STREAM todf.
DEFINE STREAM tosql.

FORM
  SKIP(1)
  tablename LABEL "Working on" FORMAT "x(32)" AT 3
  SKIP(1)
  WITH FRAME working 
  WIDTH 58 SIDE-LABELS ROW 5 CENTERED &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX THREE-D &ENDIF TITLE "Generate Scripts" .


/* Internal Procedure */
PROCEDURE write-tbl-sql:     
  DEFINE VARIABLE dftblname   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE forpos      AS INTEGER                     NO-UNDO.
  DEFINE VARIABLE extnt       AS LOGICAL                     NO-UNDO.
  DEFINE VARIABLE recidname   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE recidpos    AS INTEGER                     NO-UNDO.

  ASSIGN col-long = 0
         comment_chars = ""
         comment-out = FALSE
         unsptdt = FALSE.

  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename
                      AND DICTDB._File._Owner = "_FOREIGN"
                      NO-ERROR.   

  IF AVAILABLE DICTDB._File  THEN DO:
    FOR EACH DICTDB._Field OF DICTDB._File:
      IF DICTDB._Field._For-type = "LONG" OR DICTDB._Field._For-type = "LONGRAW" THEN
            ASSIGN col-long = col-long + 1.
    END.  
    FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = tablename:  
      IF new-obj.for-type = " LONG" OR new-obj.for-type = " LONG RAW" THEN
        ASSIGN col-long = col-long + 1.
      IF new-obj.for-type = " UNSUPPORTED" THEN
        ASSIGN unsptdt = TRUE.
    END.
  END.
  ELSE DO:
    FIND FIRST new-obj WHERE add-type = "T"
                         AND tbl-name = tablename
                          NO-ERROR.
    ASSIGN fldnum = 0.
    FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = tablename:  
      IF new-obj.for-type = " LONG" OR new-obj.for-type = " LONG RAW" THEN
        ASSIGN col-long = col-long + 1.
      IF new-obj.for-type = " UNSUPPORTED" THEN
        ASSIGN unsptdt = TRUE.
      ASSIGN fldnum = fldnum + 1.
    END.
    /* add one more for the progress recid field */
    ASSIGN fldnum = fldnum + 1.
  END.

  IF col-long > 1 THEN DO:
    ASSIGN comment_chars = "-- ** "
           comment-out = TRUE.
    
    FIND FIRST warnlong WHERE wname = tablename NO-ERROR.
    IF NOT AVAILABLE warnlong THEN DO:
      CREATE warnlong.
      ASSIGN wname = tablename.

      ASSIGN efile = tablename + ".e".
      OUTPUT TO VALUE(efile) APPEND.
      PUT UNFORMATTED tablename " had too many long columns.  The" SKIP
                     "sql was commented out and no information was" SKIP
                      "outputed to the {&PRO_DISPLAY_NAME} DF File." SKIP
                      " " SKIP.
      OUTPUT CLOSE.  
    END.
  END.
  IF unsptdt THEN DO:
    ASSIGN comment_chars = "-- ** "
           comment-out = TRUE.
    
    FIND FIRST warnlong WHERE wname = tablename NO-ERROR.
    IF NOT AVAILABLE warnlong THEN DO:
      CREATE warnlong.
      ASSIGN wname = tablename.

      ASSIGN efile = tablename + ".e".
      OUTPUT TO VALUE(efile) APPEND.
      PUT UNFORMATTED tablename " had columns with unsupported data types." SKIP
                     "The sql was commented out and no information was" SKIP
                      "outputed to the {&PRO_DISPLAY_NAME} DF File." SKIP
                     " " SKIP.
      OUTPUT CLOSE.  
    END.
  END.

  IF dropped-fld THEN
      RUN new-for-position.

  FOR EACH sql-info BREAK BY tblname BY line-num:  
    IF FIRST-OF(tblname) THEN DO:
      IF pcompatible THEN DO:
        FIND FIRST new-obj WHERE add-type = "T"
                             AND tbl-name = tblname
                             NO-ERROR.
        IF AVAILABLE new-obj THEN DO:
          ASSIGN p-r-index = for-name.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = 'UPDATE TABLE "' + tblname + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-tbl = tblname
                 df-line = "  PROGRESS-RECID " + string(fldnum).
        END.
      END.

      FIND DICTDB._File WHERE DICTDB._File._File-name = tblname
                          AND DICTDB._File._Owner = "_FOREIGN"
                          NO-ERROR.   
      FIND FIRST new-obj WHERE add-type = "T"
                             AND tbl-name = tblname
                             NO-ERROR.

      IF AVAILABLE DICTDB._File AND NOT AVAILABLE new-obj THEN DO: /* adding new fields to file not dropping it */     
        /* If progress-recid not a specific field but one the user has selected. */

        IF DICTDB._File._fil-misc1[4] <> 0  OR DICTDB._File._Fil-misc1[4] <> ? THEN DO:
          FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Fld-stoff = DICTDB._File._Fil-misc1[4]
               NO-ERROR.
          IF AVAILABLE DICTDB._Field THEN     
            ASSIGN recidname = DICTDB._Field._Field-name.
        END.
        ELSE IF DICTDB._File._fil-misc1[1] <> 0 THEN
          ASSIGN recidname = "progress_recid".             
        
        ASSIGN forpos = 1
               extnt = FALSE.
     
       FOR EACH DICTDB._field OF DICTDB._file BREAK BY _File-recid BY _fld-stoff . 
         IF forpos < _fld-stoff THEN ASSIGN forpos = _fld-stoff.
         IF LAST-OF(_File-recid) THEN DO:
           IF _field._extent > 0 THEN
             ASSIGN forpos = forpos + (_Field._Extent - 1).
         END.
       END.

       IF forpos < DICTDB._File._Fil-misc1[1] THEN
         ASSIGN forpos = DICTDB._File._Fil-misc1[1].

        FOR EACH new-obj WHERE add-type = "F"
                           AND tbl-name = tblname:         
          IF INDEX(new-obj.for-name , "##") <> 0 THEN DO: 

            IF SUBSTRING(new-obj.for-name, (LENGTH(new-obj.for-name) - 2), 3) = "##1" THEN
              ASSIGN extnt = FALSE.
            IF for-name BEGINS "U##" THEN 
              ASSIGN extnt = FALSE.    

            ELSE IF NOT extnt THEN DO:   
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tbl-name
                     df-info.df-fld = fieldname
                     df-line = 'UPDATE FIELD "' + prg-name  + '" OF "' + tbl-name + '"'.
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tbl-name
                     df-info.df-fld = fieldname
                     df-line = '  FOREIGN-POS ' + string(forpos).
              IF for-name BEGINS "A##" THEN
                ASSIGN extnt = false.
              ELSE 
                ASSIGN extnt = true.
            END. 
          END.
          ELSE DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tbl-name
                   df-info.df-fld = fieldname
                   df-line = 'UPDATE FIELD "' + prg-name + '" OF "' + tbl-name + '"'.
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tbl-name
                   df-info.df-fld = fieldname
                   df-line = '  FOREIGN-POS ' + STRING(forpos).
            ASSIGN extnt = FALSE.   
          END.                  
          ASSIGN forpos = forpos + 1.
        END.
      END.        
      ELSE DO: /* Have a new file here */
        ASSIGN forpos = 1
               extnt = false.

        FOR EACH new-obj WHERE new-obj.add-type = "F"
                           AND new-obj.tbl-name = tblname: 
          IF INDEX(new-obj.for-name , "##") <> 0 THEN DO: 
            IF SUBSTRING(for-name, (LENGTH(for-name) - 2), 3) = "##1" THEN
              ASSIGN extnt = FALSE.
            IF new-obj.for-name BEGINS "U##" THEN 
              ASSIGN extnt = FALSE.  
            ELSE IF NOT extnt THEN DO:   
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-obj.tbl-name
                     df-info.df-fld = fieldname
                     df-line = 'UPDATE FIELD "' + new-obj.prg-name + '" OF "' + new-obj.tbl-name + '"'.
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = new-obj.tbl-name
                     df-info.df-fld = fieldname
                     df-line = '  FOREIGN-POS ' + STRING(forpos).
              ASSIGN extnt = true.
            END. 
          END.
          ELSE DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = new-obj.tbl-name
                   df-info.df-fld = fieldname
                   df-line =  'UPDATE FIELD "' + new-obj.prg-name + '" OF "' + new-obj.tbl-name + '"'.
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = new-obj.tbl-name
                   df-info.df-fld = fieldname
                   df-line = '  FOREIGN-POS ' + STRING(forpos).
            ASSIGN extnt = FALSE.   
          END.                  
          ASSIGN forpos = forpos + 1.
        END.
      END.
    END.                                       
    IF line-num < 2 THEN
      PUT STREAM tosql UNFORMATTED comment_chars line SKIP.          
    ELSE IF NOT LAST-OF(tblname) THEN DO:
      IF crtdefault AND blankdefault THEN DO:
        IF (INDEX(line, "VARCHAR2") > 0 OR INDEX(line, "NVARCHAR2") > 0) AND 
           INDEX(line, "DEFAULT") = 0  THEN
          ASSIGN line = line + " DEFAULT ' ' ".
      END.
      /* mandatory field */
      IF sql-info.fldmand = YES THEN
          line = line + " NOT NULL ".

      PUT STREAM tosql UNFORMATTED comment_chars line "," SKIP.
    END.
    ELSE DO:          
      PUT STREAM tosql UNFORMATTED comment_chars line ")" SKIP.
      IF user_env[34] <> "" AND user_env[34] <> ? THEN
        PUT STREAM tosql UNFORMATTED comment_chars "TABLESPACE " user_env[34] SKIP. 
      PUT STREAM tosql UNFORMATTED comment_chars ";" SKIP(1).
    END.         
    DELETE sql-info.
  END.

  FOR EACH alt-info BREAK BY a-tblname BY a-line-num: 
    IF NOT LAST-OF(a-tblname) THEN DO:

      /* mandatory field */
      IF alt-info.fldmand = YES THEN
         ASSIGN a-line = a-line + " NOT NULL ".

      PUT STREAM tosql UNFORMATTED comment_chars a-line  SKIP.
    END.
    ELSE DO:          
        /* mandatory field */
        IF alt-info.fldmand = YES THEN
           ASSIGN a-line = a-line + " NOT NULL ".

      PUT STREAM tosql UNFORMATTED  comment_chars a-line   SKIP.       
      PUT STREAM tosql UNFORMATTED comment_chars ";" SKIP(1).
    END.         
    DELETE alt-info.
  END.
    
  IF pcompatible AND addtable THEN DO:
    IF LENGTH(p-r-index) < 15 THEN
        ASSIGN p-r-index = p-r-index + "##progress_recid ON " + p-r-index.
    ELSE
        ASSIGN p-r-index = p-r-index + " ON " + p-r-index.  
    
    PUT STREAM tosql UNFORMATTED comment_chars
      "CREATE UNIQUE INDEX " p-r-index "(progress_recid)" SKIP.
    IF user_env[35] <> "" AND user_env[35] <> ? THEN
       PUT STREAM tosql UNFORMATTED comment_chars "TABLESPACE " user_env[35] ";" SKIP(1).
    ELSE
       PUT STREAM tosql UNFORMATTED comment_chars ";" SKIP(1).   
  END.    
  
  FOR EACH upt-blob:
      PUT STREAM tosql UNFORMATTED comment_chars upt-line ";" SKIP.
      DELETE upt-blob.
  END.

  ASSIGN addtable      = FALSE
         alt-table     = FALSE
         lnum          = 0.

  IF comment-out THEN DO:
       /* Delete all df info for this table */
    FOR EACH df-info WHERE df-tbl = tablename:
      DELETE df-info.
    END.
  END.

END PROCEDURE.

PROCEDURE write-view:
  DEFINE VARIABLE dftblname   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE orig-name   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE forpos      AS INTEGER                     NO-UNDO.
  DEFINE VARIABLE extnt       AS LOGICAL                     NO-UNDO.
  DEFINE VARIABLE recidname   AS CHARACTER                   NO-UNDO.
  DEFINE VARIABLE recidpos    AS INTEGER                     NO-UNDO.

  IF NOT view-created THEN RETURN.

  FIND FIRST sql-info WHERE sql-info.tblname = tablename NO-ERROR.
  IF AVAILABLE sql-info THEN
    RUN write-tbl-sql.
  ELSE DO:
    FIND FIRST alt-info WHERE a-tblname = tablename NO-ERROR.
    IF AVAILABLE alt-info THEN
      RUN write-tbl-sql.
  END.      
  FIND LAST view-table WHERE v-table = tablename USE-INDEX view-line NO-ERROR.
 
  IF AVAILABLE view-table  THEN DO: 
    ASSIGN orig-name = SUBSTRING(v-line, 6). 
    IF NOT pcompatible THEN DO:
      FIND PREV view-table WHERE v-table = tablename USE-INDEX view-line.
      ASSIGN v-line = SUBSTRING(v-line,1, LENGTH(v-line) - 1). 
    END. 
    FIND view-table WHERE v-table = tablename
                      AND v-order = -1.
    ASSIGN dftblname = SUBSTRING(v-line,11)
           dftblname = SUBSTRING(dftblname,1, LENGTH(dftblname) - 1).
 
    ASSIGN forpos = 1. 
    FOR EACH view-table USE-INDEX view-line BREAK BY v-table:
      IF v-order < 2 THEN NEXT.
      IF NOT v-shadow AND NOT v-ext AND v-progn <> "" AND v-prog <> ? THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = v-table
               df-line = 'UPDATE FIELD "' + v-progn + '" OF "' + v-table + '"'.
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = v-table
               df-line = "  FOREIGN-POS " + STRING(forpos).
      END.
      
      IF v-shadow THEN DO:      
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = v-table
               df-line = 'UPDATE FIELD "' + v-progn + '" OF "' + v-table + '"'.
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = v-table
               df-line = '  SHADOW-COL "' + STRING(forpos) + '"'. 
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = v-table
               df-line = "  FIELD-MISC15 " + STRING(forpos).
      END. 
      IF recidname = v-progn THEN
        ASSIGN recidpos = forpos.
      IF LAST-OF(v-table) AND pcompatible THEN
        ASSIGN recidpos = forpos.     
      ASSIGN forpos = forpos + 1.
    END. 
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = tablename
           df-line = 'UPDATE TABLE "' + tablename + '"'.
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = tablename
           df-line = '  FOREIGN-NAME "' + CAPS(dftblname) + '"'.

    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = tablename
           df-line = '  FILE-MISC27 "' + orig-name + '"'.      
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = tablename
           df-line = '  FOREIGN-TYPE "VIEW"'. 
    IF recidpos <> 0 THEN DO:
      IF pcompatible THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = tablename
               df-line = '  PROGRESS-RECID ' + STRING(recidpos).
      END.
      ELSE DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = tablename
               df-line = '  RECID-COL-NO ' + STRING(recidpos).
      END.
    END.
  END. 
                                
  FOR EACH view-table USE-INDEX view-line BREAK BY v-table :    
    IF v-order < 2 THEN
      PUT STREAM tosql UNFORMATTED comment_chars  v-line SKIP.           
    ELSE IF LAST-OF(v-table) THEN DO:
      IF pcompatible THEN DO:
        PUT STREAM tosql UNFORMATTED comment_chars  "PROGRESS_RECID" SKIP.
        PUT STREAM tosql UNFORMATTED comment_chars v-line ";" SKIP(1). 
      END.
      ELSE
        PUT STREAM tosql UNFORMATTED comment_chars v-line ";" SKIP(1). 
    END.  
    ELSE 
      PUT STREAM tosql UNFORMATTED comment_chars v-line SKIP.      

    DELETE view-table.
  END. 
END PROCEDURE.

PROCEDURE write-idx-sql:
  IF idxline = ? OR idxline = "" THEN LEAVE.

  IF pcompatible AND is-unique = FALSE THEN 
      ASSIGN idxline = idxline + ", PROGRESS_RECID".
  IF user_env[35] <> "" AND user_env[35] <> ? THEN DO:
    PUT STREAM tosql UNFORMATTED comment_chars idxline ")" SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars "TABLESPACE " user_env[35] SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars ";" SKIP(1).
  END.
  ELSE      
    PUT STREAM tosql UNFORMATTED comment_chars idxline ");"  SKIP(1).
    
  ASSIGN idxline = ?
         idxname = ?
         is-unique = FALSE
         wordidx = FALSE
         wordfile = ?.  
  
  FOR EACH shad-col:
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = s-tbl-name
           df-line = 'UPDATE FIELD "' + p-fld-name + '" OF "' + s-tbl-name + '"'.
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = s-tbl-name
           df-line = '  SHADOW-COL "' + STRING(col-num) + '"'.
    CREATE df-info.
    ASSIGN df-info.df-seq = dfseq
           dfseq = dfseq + 1
           df-info.df-tbl = s-tbl-name
           df-line = "  FIELD-MISC15 " + STRING(col-num).
    DELETE shad-col.
  END.                                 
END PROCEDURE.

PROCEDURE write-con-sql:
    IF conline = ? OR conline = "" THEN LEAVE.
    IF fldcon = TRUE THEN
       PUT STREAM tosql UNFORMATTED comment_chars conline ";" SKIP.
    ELSE
       PUT STREAM tosql UNFORMATTED comment_chars conline ");"  SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.
   
    ASSIGN conline = ?
            fldcon = FALSE.      
           
END.    

PROCEDURE write-seq-sql:
  IF seq-line = ? OR seq-line = "" THEN LEAVE.
  IF seq-type = "d"  THEN 
    PUT STREAM tosql UNFORMATTED seq-line ";" SKIP(1).
  ELSE DO:
    PUT STREAM tosql UNFORMATTED seq-line " " SKIP.
    IF incre <> ? AND incre <> "" THEN
      PUT STREAM tosql UNFORMATTED "INCREMENT BY " incre " " SKIP. 
    IF seq-type = "u" THEN.
    ELSE DO:
      IF (init <> ? AND init <> "") THEN
        PUT STREAM tosql UNFORMATTED "START WITH " init " " SKIP.
    END.
    IF maxval <> ? AND maxval <> "" THEN
      PUT STREAM tosql UNFORMATTED "MAXVALUE " maxval SKIP.
    ELSE DO:
      IF seq-type <> "u" THEN
        PUT STREAM tosql UNFORMATTED "NOMAXVALUE"  SKIP.  
    END.
    IF minval <> ? AND minval <> "" THEN
      PUT STREAM tosql UNFORMATTED "MINVALUE " minval SKIP.
    ELSE DO:
      IF seq-type <> "u" THEN
      PUT STREAM tosql UNFORMATTED "NOMINVALUE" SKIP.  
    END.
    IF cyc <> ? AND cyc <> "" THEN       
        PUT STREAM tosql UNFORMATTED cyc SKIP.              
    PUT STREAM tosql UNFORMATTED ";" SKIP(1).
    IF init <> ? AND init <> "" THEN DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  INITIAL " + init.
    END.

    IF incre <> ? AND incre <> "" THEN DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  INCREMENT " + incre.
    END.
    IF cyc <> ? AND cyc <> "" THEN DO:
      IF cyc = "CYCLE" THEN 
        ASSIGN cyc = "yes".
      ELSE
        ASSIGN cyc = "no".  

      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  CYCLE-ON-LIMIT " + cyc.
    END.
    IF seq-type <> "u" THEN DO:
      IF minval NE "" AND minval NE ? THEN DO:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-line = "  MIN-VAL " + minval.
      END.

      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1.
      IF maxval = ? OR maxval = "" THEN
        ASSIGN df-line = "  MAX-VAL ? ".
      ELSE
        ASSIGN df-line = "  MAX-VAL " + maxval.
    END.
    ELSE IF seq-type = "u" THEN DO:
      IF minval <> ? AND minval <> "" THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  MIN-VAL " + minval.
      END.
      IF maxval <> ? AND maxval <> "" THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "  MAX-VAL " + maxval.
      END.
    END.
    IF ora_owner <> "" AND seq-type = "a" THEN DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = '  FOREIGN-OWNER "' + CAPS(ora_owner) + '"'.
    END.
  END.

  ASSIGN seq-type = ?
         seq-line = ?
         seqname = ?
         init = ?
         maxval = ?
         minval = ?
         incre = ?
         cyc = ?.                 
END PROCEDURE.

PROCEDURE create-new-obj:
  DEFINE INPUT PARAMETER atype   AS CHARACTER.
  DEFINE INPUT PARAMETER ext-num AS CHARACTER.

  IF atype = "T" THEN DO:
    CREATE new-obj.
    ASSIGN add-type = "T"
           tbl-name = ilin[3]
           for-name = forname.
  END. 
  ELSE IF atype = "F" THEN DO:    
    CREATE new-obj.
    ASSIGN add-type = "F"
           n-order = new-ord
           new-ord = new-ord + 1
           tbl-name = tablename
           fld-name = fieldname
           for-type = fortype
           prg-name = ilin[3].
    IF ext-num = ? THEN
      ASSIGN for-name = fieldname.       
    ELSE
      ASSIGN for-name = fieldname + "##" + ext-num.  

    IF (fieldtype = "BLOB" OR fieldtype = "CLOB") AND alt-table THEN DO:
        CREATE upt-blob.
        ASSIGN upt-blob.upt-line = "UPDATE " + forname + " SET " + fieldname + 
                                   (IF fieldtype = "BLOB" THEN " = empty_blob()" ELSE " = empty_clob()")
               upt-tbl = tablename
               upt-blob.upt-seq = uptseq
               uptseq = uptseq + 1.
        CREATE upt-blob.
        ASSIGN upt-blob.upt-line = "ALTER TABLE " + forname + " MODIFY " + fieldname + " NOT NULL"
               upt-tbl = tablename
               upt-blob.upt-seq = uptseq
               uptseq = uptseq + 1.       
    END.


  END. 
  ELSE IF atype = "I" THEN DO:
     CREATE new-obj.
     ASSIGN add-type = "I"
            tbl-name = ilin[5]
            for-name = forname
            prg-name = ilin[3].
  END.
  ELSE IF atype = "C" THEN DO:
     CREATE new-obj.
     ASSIGN add-type = "C"
            tbl-name = ilin[5]
            for-name = forname
            prg-name = ilin[3].
  END.         
         
END PROCEDURE. 

PROCEDURE create-view:
  DEFINE VARIABLE rename       AS LOGICAL   NO-UNDO.
  DEFINE VARIABLE rename-table AS CHARACTER NO-UNDO.
                    
  IF AVAILABLE rename-obj THEN DO:  
    IF rename-type = "T" THEN 
      ASSIGN rename = TRUE
             rename-table = new-name.
    ELSE
      ASSIGN rename = FALSE.
  END.  
  ELSE
    ASSIGN rename = FALSE.      

  IF NOT AVAILABLE DICTDB._File THEN DO:
    IF rename THEN
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
    ELSE
      FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  END.
  IF NOT AVAILABLE DICTDB._File THEN DO.
    ASSIGN view-created = FALSE.
    RETURN.
  END.  
  IF NOT rename THEN DO:
    FIND FIRST rename-obj WHERE old-name = DICTDB._File._File-name NO-ERROR.
    IF AVAILABLE rename-obj THEN
      ASSIGN rename = TRUE
             rename-table = new-name.
  END.
  
  IF LENGTH(DICTDB._File._For-name) > 4 AND SUBSTRING(DICTDB._File._For-name, LENGTH(DICTDB._File._For-name) - 4 ) = "_V##" THEN DO:
    IF DICTDB._File._fil-misc2[7] <> ? AND DICTDB._File._fil-misc2[7] <> "" THEN
      ASSIGN forname = DICTDB._File._fil-misc2[7].
    ELSE
      ASSIGN forname = SUBSTRING(DICTDB._File._For-name, 1, (LENGTH(DICTDB._File._For-name) - 4)).  
  END.
  ELSE    
    ASSIGN forname = DICTDB._File._For-name.  
  FIND view-table WHERE v-order = -1 NO-ERROR.
  IF NOT AVAILABLE view-table THEN DO:           
    CREATE view-table.
    ASSIGN v-order = -1
           v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
           v-line = "DROP VIEW " + forname + "_V## ;".
  
    CREATE view-table.
    ASSIGN lnum = 1 
           v-order = lnum
           v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)       
           v-line = "CREATE VIEW " + forname + "_V## AS SELECT". 
  
    CREATE view-table.
    ASSIGN v-order = 10001
           v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
           v-line = "FROM " + forname.               
  END. 
  
  _fld-loop:                                                
  FOR EACH DICTDB._Field OF DICTDB._File NO-LOCK:        
    IF DICTDB._Field._Field-name = ilin[3] THEN NEXT.
    FIND FIRST drop-field WHERE of-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
                            AND drop-f-name = DICTDB._Field._Field-name
                            NO-ERROR.   
    IF AVAILABLE drop-field THEN  NEXT _fld-loop.                                       
                           
    IF DICTDB._Field._Extent = 0 THEN DO:             
      CREATE view-table.
      ASSIGN lnum = lnum + 1
             v-order = lnum
             v-line = DICTDB._Field._For-name + ","  
             v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
             v-field = DICTDB._Field._Field-name.
             
      FIND FIRST rename-obj WHERE rename-type = "F"
                              AND t-name = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
                              AND old-name = DICTDB._Field._Field-name
                              NO-ERROR.
      IF AVAILABLE rename-obj THEN
        ASSIGN v-progn = new-name.
      ELSE                         
        ASSIGN v-progn = DICTDB._Field._Field-name.
              
      IF DICTDB._Field._Fld-misc2[2] <> ? AND DICTDB._Field._Fld-misc2[2] <> "" THEN DO:       
        CREATE view-table.
        ASSIGN lnum = lnum + 1
               v-order = lnum
               v-line = "U##" + DICTDB._Field._For-name + ","
               v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
               v-field = "U##" + DICTDB._Field._For-name
               v-shadow = TRUE.
               
        FIND FIRST rename-obj WHERE rename-type = "F"
                                AND t-name = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
                                AND old-name = DICTDB._Field._Field-name
                                NO-ERROR.
        IF AVAILABLE rename-obj THEN
          ASSIGN v-progn = new-name.
        ELSE                         
          ASSIGN v-progn = DICTDB._Field._Field-name.   
                      
      END.
    END.
    ELSE DO:
      DO i = 1 TO DICTDB._Field._Extent:
        CREATE view-table.
        ASSIGN lnum = lnum + 1
               v-order = lnum
               v-line = DICTDB._Field._For-name + "##" + STRING(i) + ","
               v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
               v-field = DICTDB._Field._For-name + "##" + STRING(i)               
               v-ext   = TRUE.
                
        FIND FIRST rename-obj WHERE rename-type = "F"
                                AND t-name = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
                                AND old-name = DICTDB._Field._Field-name
                                NO-ERROR.
        IF AVAILABLE rename-obj THEN
          ASSIGN v-progn = new-name
                 v-ext = (IF i = 1 THEN FALSE ELSE TRUE).
        ELSE                         
          ASSIGN v-progn = DICTDB._Field._Field-name
                 v-ext = (IF i = 1 THEN FALSE ELSE TRUE).                                                                         
      END.                        
    END.
  END. /* FOR EACH FIELD */            
  FOR EACH new-obj WHERE add-type = "F" 
                     AND tbl-name = (IF rename THEN rename-table ELSE DICTDB._File._File-name):                          
    CREATE view-table.
    ASSIGN lnum = lnum + 1
           v-order = lnum
           v-line = for-name + ","
           v-table = (IF rename THEN rename-table ELSE DICTDB._File._File-name)
           v-field = fieldname
           v-progn = prg-name.
     
    IF for-name BEGINS "U##" THEN ASSIGN v-shadow = TRUE.       
  END.  
END PROCEDURE.

PROCEDURE new-obj-idx:           
  ASSIGN fortype = new-obj.for-type
         forname = new-obj.for-name.
                              
  FIND new-obj where new-obj.add-type = "F"
                 AND new-obj.tbl-name = tablename
                 AND new-obj.fld-name = "U##" + ilin[2]
                 NO-ERROR.                                                                              
  
  IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */ 
                                                            
    ASSIGN shw-col = 0.                               
                            
    FOR EACH new-Obj WHERE add-type = "F"
                       AND tbl-name = tablename:
      ASSIGN shw-col = shw-col + 1.
    END.
    IF pcompatible AND NOT addtable THEN
      ASSIGN shw-col = shw-col + 2.
    ELSE  
      ASSIGN shw-col = shw-col + 1.
                                                                                              
    CREATE shad-col.
    ASSIGN s-fld-name = "U##" + forname
           p-fld-name = ilin[2]
           s-tbl-name = tablename
           col-num = shw-col.                
 
    CREATE new-obj.
    ASSIGN new-obj.add-type = "F"
           new-obj.tbl-name = tablename
           new-obj.n-order = new-ord
           new-ord = new-ord + 1
           new-obj.for-name = "U##" + forname
           new-obj.fld-name = "U##" + ilin[2]
           new-obj.prg-name = ilin[2]
           new-obj.for-type = fortype. 
    
    FIND n-obj WHERE n-obj.add-type = "t"
                 AND n-obj.tbl-name = tablename.
                              
    PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + n-obj.for-name SKIP.
    PUT STREAM tosql UNFORMATTED comment_chars " ADD " + new-obj.for-name + " " + new-obj.for-type + ";" SKIP(1).                                                          
  END.                                 
END PROCEDURE.

PROCEDURE get-position:

  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  IF NOT AVAILABLE DICTDB._File THEN 
    FIND rename-obj WHERE rename-type = "T"
                      AND t-name = tablename
                      NO-ERROR.
  IF AVAILABLE rename-obj THEN
    FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR. 
  IF AVAILABLE DICTDB._File THEN DO:
    ASSIGN i = 0.

   FOR EACH DICTDB._field OF DICTDB._file BREAK BY _File-recid BY _fld-stoff:
      IF DICTDB._Field._Fld-stoff > i THEN
       ASSIGN i = DICTDB._Field._Fld-stoff.
      IF INTEGER(DICTDB._Field._Fld-misc2[2]) > i THEN
        ASSIGN i = INTEGER(DICTDB._Field._Fld-misc2[2]).
      IF LAST-OF(_File-recid) THEN DO:
        IF _field._extent > 0 THEN
          ASSIGN i = i + (_Field._Extent - 1).
      END.
    END.

    IF i < DICTDB._File._Fil-misc1[1] THEN
        ASSIGN i = DICTDB._File._Fil-misc1[1].

    FOR EACH new-obj WHERE new-obj.add-type = "F"
                       AND new-obj.tbl-name = tablename:                      
      ASSIGN i = i + 1.
    END.
    FIND FIRST df-info WHERE df-info.df-tbl = tablename
                         AND df-info.df-fld = fieldname
                         AND df-line BEGINS '  FOREIGN-POS '
                         NO-ERROR.
    IF AVAILABLE df-info THEN.
    ELSE DO:
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-info.df-tbl = tablename
             df-info.df-fld = fieldname
             df-line = '  FOREIGN-POS ' + STRING(i).  
    END.
  END.   
END PROCEDURE.  

PROCEDURE new-for-position:
  DEFINE VARIABLE recidname AS CHARACTER NO-UNDO.
  DEFINE VARIABLE forpos    AS INTEGER   NO-UNDO.

  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename
                      AND DICTDB._File._Owner = "_FOREIGN"
                      NO-ERROR.          
  IF NOT AVAILABLE DICTDB._File THEN DO:
    FIND FIRST rename-obj WHERE rename-obj.new-name = tablename 
                            AND rename-obj.rename-type = "t" NO-ERROR.
    IF AVAILABLE rename-obj THEN DO:
      ASSIGN rntbl = tablename.
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
    END.
  END.
  ELSE
    ASSIGN rntbl = tablename.

  IF AVAILABLE DICTDB._File THEN DO:
    IF DICTDB._File._fil-misc1[4] <> 0  AND DICTDB._File._Fil-misc1[4] <> ? THEN DO:
      FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Fld-stoff = DICTDB._File._Fil-misc1[4]
               NO-ERROR.
      IF AVAILABLE DICTDB._Field THEN     
         ASSIGN recidname = DICTDB._Field._Field-name.
    END.
    ELSE IF DICTDB._File._fil-misc1[1] <> 0 THEN
      ASSIGN recidname = "progress_recid".

    IF recidname <> ? AND recidname <> "" THEN DO:
      CREATE new-position.
      ASSIGN new-position.table-np = rntbl
             new-position.field-np = recidname
             new-position.old-pos  = DICTDB._File._Fil-Misc1[1]
             new-position.shadow   = 0
             new-position.extent#  = 0.
    END.

    FOR EACH DICTDB._Field OF DICTDB._File BY DICTDB._Field._Fld-stoff:      

      CREATE new-position.
      ASSIGN new-position.table-np = rntbl
             new-position.field-np = DICTDB._Field._Field-name
             new-position.old-pos  = DICTDB._Field._Fld-stoff
             new-position.shadow   = (IF DICTDB._Field._Fld-Misc1[5] > 0 THEN
                                       DICTDB._Field._Fld-Misc1[5]
                                      ELSE 0)
             new-position.extent#  = (IF DICTDB._Field._Extent > 0 THEN
                                          DICTDB._Field._Extent
                                       ELSE 0).
      FIND FIRST rename-obj WHERE rename-obj.t-name = rntbl 
                            AND rename-obj.rename-type = "f" 
                            AND rename-obj.old-name = new-position.field-np NO-ERROR.
       IF AVAILABLE rename-obj THEN
           ASSIGN new-position.field-np = rename-obj.new-name.
    END.
    ASSIGN forpos = 0.
    FOR EACH new-position WHERE table-np = rntbl:

      FIND FIRST drop-field WHERE drop-field.of-table = new-position.table-np
                              AND drop-field.f-name = new-position.field-np NO-ERROR.

      IF AVAILABLE drop-field THEN                
        ASSIGN new-position.dropped = TRUE
               forpos = forpos + (IF new-position.extent# = 0 THEN 1
                                  ELSE new-position.extent#).       
      ELSE DO:
        IF new-position.shadow <> 0 THEN
          ASSIGN new-position.shadow = new-position.shadow - forpos
                 new-position.new-pos = new-position.old-pos - forpos.
        ELSE
          ASSIGN new-position.new-pos = new-position.old-pos - forpos.             
      END.
    END.

    /* Now assigns the forpos equal to the last new-pos  */
    FIND LAST new-position WHERE table-np = rntbl
                             AND new-position.dropped = FALSE.
    ASSIGN forpos = new-position.new-pos + 1.
    _newloop:
    FOR EACH new-obj WHERE add-type = "F"
                       AND tbl-name = rntbl:

      IF INDEX(new-obj.for-name, "##") <> 0 THEN DO:
       IF SUBSTRING(new-obj.for-name, LENGTH(new-obj.for-name) - 2) = "##1" THEN DO:
          CREATE new-position.
          ASSIGN new-position.table-np = rntbl
                 new-position.field-np = prg-name
                 new-position.new-pos  = forpos.
          FOR EACH n-obj WHERE n-obj.prg-name BEGINS SUBSTRING(new-obj.prg-name, 1, LENGTH(new-position.field-np) - 3):
            ASSIGN forpos = forpos + 1.
          END.
          NEXT _newloop.
        END.        
      END.
      ELSE IF new-obj.for-name BEGINS "_S#_" THEN DO:
         ASSIGN forpos = forpos + 1.
         NEXT _newloop.
      END.
      ELSE DO:
        CREATE new-position.
        ASSIGN new-position.table-np = rntbl
               new-position.field-np = new-obj.prg-name.

        FIND FIRST n-obj WHERE n-obj.prg-name BEGINS SUBSTRING(new-obj.prg-name, 3) NO-ERROR.
        IF AVAILABLE n-obj  THEN
           ASSIGN new-position.shadow   = forpos
                  forpos                = forpos + 1
                  new-position.new-pos  = forpos                     
                  forpos                = forpos + 1.
        ELSE
          ASSIGN new-position.new-pos  = forpos                     
                 forpos                = forpos + 1.
      END.
    END.

    FOR EACH new-position WHERE table-np = rntbl
                            AND new-position.dropped = FALSE:

      IF new-position.field-np = recidname THEN DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-line = 'UPDATE TABLE "' + rntbl + '"'.
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-line = '  PROGRESS-RECID ' + STRING( new-position.new-pos).
        /* if user has chosen a field instead of creating the recid field put out df info */
        IF new-position.field-np <> "progress_recid" THEN DO:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = new-position.table-np
                 df-info.df-fld = new-position.field-np
                 df-line = 'UPDATE FIELD "' + new-position.field-np  + '" OF "' + new-position.table-np + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = new-position.table-np
                 df-info.df-fld = new-position.field-np
                 df-line = '  FOREIGN-POS ' + string(new-position.new-pos).
        END.
      END.
      ELSE DO:
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-info.df-fld = new-position.field-np
               df-line = 'UPDATE FIELD "' + new-position.field-np  + '" OF "' + new-position.table-np + '"'.
        CREATE df-info.
        ASSIGN df-info.df-seq = dfseq
               dfseq = dfseq + 1
               df-info.df-tbl = new-position.table-np
               df-info.df-fld = new-position.field-np
               df-line = '  FOREIGN-POS ' + string(new-position.new-pos).
      END.  
    END.
  END.
  ASSIGN dropped-fld = FALSE.
END PROCEDURE.

PROCEDURE check-view:
  IF view-created THEN DO: 
    IF iobj = "t" THEN DO:
      IF tablename <> ilin[3] THEN DO:
        RUN create-view.
        RUN write-view. 
        ASSIGN view-created = FALSE.
      END.
    END.    
  
    ELSE IF iobj = "f" THEN DO:
      IF tablename <> ilin[5] THEN DO:
        RUN create-view.
        RUN write-view. 
        ASSIGN view-created = FALSE.
      END.
    END.    
     
    ELSE IF iobj = "i" THEN DO:
      DO i = 4 TO 10:
        IF ilin[i] = "ON" THEN DO:
          IF ilin[i + 1] <> tablename THEN DO:
            RUN create-view.
            RUN write-view.
            ASSIGN view-created = FALSE
                   i = 11.
          END.
        END.
      END.
    END.
  END.
END PROCEDURE.

PROCEDURE dctquot:

  DEFINE INPUT  PARAMETER inline  AS CHARACTER            NO-UNDO.
  DEFINE INPUT  PARAMETER quotype AS CHARACTER            NO-UNDO.
  DEFINE OUTPUT PARAMETER outline AS CHARACTER INITIAL "" NO-UNDO.
  DEFINE        VARIABLE  i       AS INTEGER              NO-UNDO.

  IF INDEX(inline,quotype) > 0 THEN
    DO i = 1 TO LENGTH(inline):
       outline = outline + (IF SUBSTRING(inline,i,1) = quotype
                 THEN quotype + quotype ELSE SUBSTRING(inline,i,1)).
    END.
  ELSE
    outline = inline.

  outline = (IF outline = ? THEN "?" ELSE quotype + outline + quotype).

END PROCEDURE.

PROCEDURE create-idx-field:
  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  IF NOT AVAILABLE DICTDB._FILE THEN DO:               
    FIND rename-obj WHERE rename-type = "T"   
                      AND new-name = tablename
                      NO-ERROR.
    IF AVAILABLE rename-obj THEN 
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.            
  END.        

  IF AVAILABLE DICTDB._File THEN DO:        
    FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = ilin[2] NO-ERROR.
    IF AVAILABLE DICTDB._Field THEN DO:

      IF DICTDB._Field._Data-type = "Character" THEN DO:
          /* a long or clob column */
          IF DICTDB._Field._For-itype = 8 OR DICTDB._Field._For-itype = 112 THEN
          DO:
              /* we can't create an index on a long/clob column. So need to skip the index */
              RUN skip-long-index (INPUT  DICTDB._Field._For-type).
              RETURN.
          END.
      END.

      IF NOT shadowcol THEN DO:
          ASSIGN con-fld-name = DICTDB._Field._For-name.      
          IF DICTDB._Field._Data-type <> "Character" THEN DO:
            IF INDEX(idxline, "(") = 0 THEN
              ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
            ELSE
              ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name.  
          END.
          ELSE DO:
            IF INDEX(idxline, "(") = 0 THEN
              ASSIGN idxline = idxline + "(UPPER(" + DICTDB._Field._For-name + ")".
            ELSE
              ASSIGN idxline = idxline + ", UPPER(" + DICTDB._Field._For-name + ")".  
          END.
      END.     
      ELSE DO: /* shadowcol */

          IF DICTDB._Field._Data-type <> "Character" THEN DO:
              ASSIGN con-fld-name = DICTDB._Field._For-name.           
              IF INDEX(idxline, "(") = 0 THEN
                ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
              ELSE
               ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name.  
          END. 
          ELSE IF DICTDB._Field._Data-type = "Character" THEN DO:                                    

                IF (DICTDB._Field._Fld-misc2[2] <> ? and DICTDB._Field._Fld-misc2[2] <> "") OR
                    CAN-FIND(new-obj where new-obj.add-type = "F"
                                       AND new-obj.tbl-name = tablename
                                       AND new-obj.fld-name = "U##" + ilin[2]) THEN DO: /* shawdow column exists in file */
                  ASSIGN con-fld-name = "U##" + DICTDB._Field._For-name.    
                  IF INDEX(idxline, "(") = 0 THEN
                    ASSIGN idxline = idxline + "(U##" + DICTDB._Field._For-name.
                  ELSE
                    ASSIGN idxline = idxline + ", U##" + DICTDB._Field._For-name.  
        
                END.                    
                ELSE DO: /* shawdow not in original file see if already created */     
                      FIND FIRST new-obj where new-obj.add-type = "F"
                                           AND new-obj.tbl-name = tablename
                                           AND new-obj.prg-name = ilin[2]
                                           AND new-obj.fld-name BEGINS "U##" 
                                           NO-ERROR.
                                                    
                      IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */        
                            ASSIGN shw-col = 0.

                            FOR EACH DICTDB._Field OF DICTDB._FILE NO-LOCK:
                                  IF DICTDB._Field._Extent = 0 THEN                   
                                    ASSIGN shw-col = shw-col + 1.
                                  ELSE
                                    ASSIGN shw-col = shw-col + DICTDB._Field._Extent. 
                                  
                                  IF DICTDB._Field._Fld-Misc1[5] <> ? AND DICTDB._Field._Fld-Misc1[5] <> 0 THEN
                                      ASSIGN shw-col = shw-col + 1.
                             END.
                             IF shw-col < DICTDB._File._Fil-Misc1[1] THEN
                               ASSIGN shw-col = DICTDB._File._Fil-misc1[1].
                
                             FOR EACH new-Obj WHERE new-obj.add-type = "F"
                                                AND new-obj.tbl-name = tablename:
                               ASSIGN shw-col = shw-col + 1.
                             END.               
                
                             ASSIGN shw-col = shw-col + 1.  
                             
                             FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = ilin[2] NO-ERROR.
                             
                             CREATE shad-col.
                             ASSIGN p-fld-name = ilin[2]
                                    s-tbl-name = tablename
                                    col-num = shw-col
                                    s-fld-name = "U##" + DICTDB._Field._For-name
                                    j = DICTDB._Field._Fld-Misc1[3].
                                              
                             CREATE new-obj.
                             ASSIGN new-obj.add-type = "F"
                                    new-obj.tbl-name = tablename
                                    new-obj.n-order = new-ord
                                    new-ord = new-ord + 1
                                    new-obj.fld-name = "U##" + DICTDB._Field._For-name
                                    new-obj.prg-name = ilin[2]
                                    new-obj.for-name = "U##" + DICTDB._Field._For-name. 
                                         
                             IF DICTDB._File._Fil-Misc2[7] <> "" AND DICTDB._File._Fil-Misc2[7] <> ? THEN
                                 PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " +  DICTDB._File._Fil-Misc2[7] SKIP.
                             ELSE 
                                 PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-name SKIP.

                             /*IF j <= longwid THEN DO:                                   */
                                 PUT STREAM tosql UNFORMATTED comment_chars "  ADD " + new-obj.fld-name + " " + user_env[11]  /*"VARCHAR2"*/ + "(" +
                                               STRING(j) + ");" SKIP(1).
                                 ASSIGN new-obj.for-type = /*"VARCHAR2"*/ user_env[11] + "(" + STRING(j) + ")".  
                             /*END.      */
                            /* ELSE DO: this can't happen
                                 PUT STREAM tosql UNFORMATTED comment_chars "  ADD " + new-obj.fld-name + " " + /*"LONG"*/ longType + ";" SKIP(1).
                                 ASSIGN new-obj.for-type = /*"LONG"*/ longType.
                             END.     
                             */
                             ASSIGN con-fld-name = new-obj.fld-name.
                             IF INDEX(idxline, "(") = 0 THEN
                               ASSIGN idxline = idxline + "(" + new-obj.fld-name.
                             ELSE
                               ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                  
                      END.
                      ELSE DO: /* Available new-obj for shawdow */
                             ASSIGN con-fld-name = new-obj.fld-name.                    
                             IF INDEX(idxline, "(") = 0 THEN
                               ASSIGN idxline = idxline + "(" + new-obj.fld-name.
                             ELSE
                                ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                                   
                      END.                        
                END. /* shawdow not in existing file */
          END.

      END.

      IF ilin[3] BEGINS "DESC"  THEN
        ASSIGN idxline = idxline + " DESC ".
    END. /* end available field */                             
    ELSE DO: /* Not available field see if renamed field */   
      FIND rename-obj WHERE rename-type = "F" 
                        AND t-name = tablename
                        AND new-name = ilin[2] NO-ERROR.                                    
      IF AVAILABLE rename-obj THEN DO:      
        FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name NO-ERROR.                   
        IF AVAILABLE DICTDB._Field THEN DO:

            IF DICTDB._Field._Data-type = "Character" THEN DO:
                /* a long or clob column */
                IF DICTDB._Field._For-itype = 8 OR DICTDB._Field._For-itype = 112 THEN
                DO:
                    /* we can't create an index on a long/clob column. So need to skip the index */
                    RUN skip-long-index (INPUT  DICTDB._Field._For-type).
                    RETURN.
                END.
            END.

            IF NOT shadowcol THEN DO:
                  IF DICTDB._Field._Data-type <> "Character" THEN DO:
                    ASSIGN con-fld-name = DICTDB._Field._For-name.                 
                    IF INDEX(idxline, "(") = 0 THEN
                      ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
                    ELSE
                      ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name.  
                  END.
                  ELSE DO:
                    ASSIGN con-fld-name = DICTDB._Field._For-name.                  
                    IF INDEX(idxline, "(") = 0 THEN
                      ASSIGN idxline = idxline + "(UPPER(" + DICTDB._Field._For-name + ")".
                    ELSE
                      ASSIGN idxline = idxline + ", UPPER(" + DICTDB._Field._For-name + ")".  
                  END.
            END.
            ELSE DO: /* shadowcol */

                  IF DICTDB._Field._Data-type = "Character" THEN DO: 
                      IF (DICTDB._Field._Fld-misc2[2] <> ? and DICTDB._Field._Fld-misc2[2] <> "") OR
                         CAN-FIND(new-obj where new-obj.add-type = "F"
                                            AND new-obj.tbl-name = tablename
                                            AND new-obj.fld-name = "U##" + DICTDB._Field._For-name) THEN DO:   
                            ASSIGN con-fld-name = "U##" + dsv-name.                                   
                            IF INDEX(idxline, "(") = 0 THEN
                              ASSIGN idxline = idxline + "(U##" + dsv-name.
                            ELSE
                              ASSIGN idxline = idxline + ", U##" + dsv-name.                          
                      END.
                      ELSE DO: /* shawdow not in file see if already created */                      
                            FIND new-obj where new-obj.add-type = "F"
                                           AND new-obj.tbl-name = tablename
                                           AND new-obj.fld-name = "U##" + DICTDB._Field._For-name
                                           NO-ERROR.
                                             
                          IF NOT AVAILABLE new-obj THEN DO:  /* need to alter the table to create field */              
                            ASSIGN shw-col = 0.
                                  
                            FOR EACH DICTDB._Field OF DICTDB._FILE NO-LOCK:
                              IF DICTDB._Field._Extent = 0 THEN                   
                                ASSIGN shw-col = shw-col + 1.
                              ELSE
                                ASSIGN shw-col = shw-col + DICTDB._Field._Extent. 
                              IF DICTDB._Field._Fld-Misc1[5] <> ? AND DICTDB._Field._Fld-Misc1[5] <> 0 THEN
                                ASSIGN shw-col = shw-col + 1.
                            END.
                            IF shw-col < DICTDB._File._Fil-Misc1[1] THEN
                                ASSIGN shw-col = DICTDB._File._Fil-Misc1[1].
            
                            FOR EACH new-Obj WHERE new-obj.add-type = "F"
                                               AND new-obj.tbl-name = tablename:
                              ASSIGN shw-col = shw-col + 1.
                            END.
                             
                            ASSIGN shw-col = shw-col + 1.
                                                                                                          
                            FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name.
            
                            CREATE shad-col.
                            ASSIGN p-fld-name = ilin[2]
                                   s-tbl-name = tablename
                                   col-num = shw-col
                                   s-fld-name = "U##" + DICTDB._Field._For-name
                                   j = DICTDB._Field._Fld-Misc1[3].
                              
                            CREATE new-obj.
                            ASSIGN new-obj.add-type = "F"
                                   new-obj.tbl-name = tablename
                                   new-obj.n-order = new-ord
                                   new-ord = new-ord + 1
                                   new-obj.fld-name = "U##" + DICTDB._Field._For-name
                                   new-obj.prg-name = ilin[2]
                                   new-obj.for-name = "U##" + DICTDB._Field._For-name. 
                             IF DICTDB._File._Fil-Misc2[7] <> "" AND DICTDB._File._Fil-Misc2[7] <> ? THEN
                                  PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " +  DICTDB._File._Fil-Misc2[7] SKIP.
                             ELSE 
                                  PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-name SKIP.
            
                             /* IF j <= longwid THEN DO: */
                                    PUT STREAM tosql UNFORMATTED comment_chars "  ADD " + new-obj.fld-name + " " + /*"VARCHAR2"*/ user_env[11] + "(" +
                                                   STRING(j) + ");" SKIP(1).
                                    ASSIGN new-obj.for-type = /*"VARCHAR2"*/ user_env[11] + "(" + STRING(j) + ")".  
                              /*END.
                               ELSE DO: this can't happen
                                    PUT STREAM tosql UNFORMATTED comment_chars " ADD " + new-obj.fld-name + " " + /*"LONG"*/ longType + ";" SKIP(1).
                                    ASSIGN new-obj.for-type = /*"LONG"*/ longType.
                              END.     
                              */
                            ASSIGN con-fld-name = new-obj.fld-name.
                            IF INDEX(idxline, "(") = 0 THEN
                              ASSIGN idxline = idxline + "(" + new-obj.fld-name.
                            ELSE
                              ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                  
                          END.                                 
                          ELSE DO: /* Available new-obj for shawdow */
                                ASSIGN con-fld-name = new-obj.fld-name.                          
                                IF INDEX(idxline, "(") = 0 THEN
                                  ASSIGN idxline = idxline + "(" + new-obj.fld-name.
                                ELSE
                                  ASSIGN idxline = idxline + ", " + new-obj.fld-name.                                                                   
                          END.                    
                    END. /* shawdow not in existing file */
                  END. /* End available field that is a character. */
                  ELSE DO:
                        ASSIGN con-fld-name = DICTDB._Field._For-name.               
                        IF INDEX(idxline, "(") = 0 THEN
                          ASSIGN idxline = idxline + "( " + DICTDB._Field._For-name.
                        ELSE
                          ASSIGN idxline = idxline + ", " + DICTDB._Field._For-name. 
                  END.      

            END.  /* end of shadowcol check */

            IF ilin[3] BEGINS "DESC"  THEN
               ASSIGN idxline = idxline + " DESC ".
        END.
      END. /* End of rename object */
      ELSE DO:
        FIND FIRST new-obj WHERE new-obj.add-type = "F"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.prg-name = ilin[2]
                                        NO-ERROR.                                      
        IF AVAILABLE new-obj THEN DO:                                                      
            IF CAN-DO("LONG,CLOB,NCLOB", SUBSTRING(new-obj.for-type,2)) THEN DO:
                /* we can't create an index on a long/clob column. So need to skip the index */
                RUN skip-long-index (INPUT SUBSTRING(new-obj.for-type,2)).
                RETURN.
            END.
          
          IF SUBSTRING(new-obj.for-type,2,7) = "VARCHAR"
              OR SUBSTRING(new-obj.for-type,2,8) = "NVARCHAR" THEN DO:                      
            ASSIGN fortype = new-obj.for-type
                   forname = new-obj.for-name.
            IF NOT shadowcol THEN DO:
                ASSIGN con-fld-name = new-obj.for-name.          
                IF INDEX(idxline, "(") = 0 THEN
                  ASSIGN idxline = idxline + "(UPPER(" + new-obj.for-name + ")".
                ELSE
                  ASSIGN idxline = idxline + ", UPPER(" + new-obj.for-name + ")".
            END.
            ELSE DO: /* shadowcol */
                  FIND n-obj where n-obj.add-type = "F"
                               AND n-obj.tbl-name = tablename
                               AND n-obj.fld-name = "U##" + ilin[2]
                                           NO-ERROR.     
    
                  IF NOT AVAILABLE n-obj THEN DO:  /* need to alter the table to create field */                                                           
                                                               
                      ASSIGN shw-col = 0.                               
                                                        
                      FOR EACH DICTDB._Field OF DICTDB._FILE NO-LOCK:
                            IF DICTDB._Field._Extent = 0 THEN                   
                                ASSIGN shw-col = shw-col + 1.
                            ELSE
                              ASSIGN shw-col = shw-col + DICTDB._Field._Extent. 
                            IF DICTDB._Field._Fld-Misc1[5] <> ? AND DICTDB._Field._Fld-Misc1[5] <> 0 THEN
                              ASSIGN shw-col = shw-col + 1.
                      END.
        
                      IF shw-col < DICTDB._File._Fil-Misc1[1] THEN
                        ASSIGN shw-col = DICTDB._File._Fil-misc1[1].
        
                      FOR EACH new-Obj WHERE new-obj.add-type = "F"
                                         AND new-obj.tbl-name = tablename:
                        ASSIGN shw-col = shw-col + 1.
                      END.               
        
                      ASSIGN shw-col = shw-col + 1.  
                                                                                                      
                      CREATE shad-col.
                      ASSIGN p-fld-name = ilin[2]
                             s-fld-name = "U##" + forname
                             s-tbl-name = tablename
                             col-num = shw-col.                
         
                      CREATE new-obj.
                      ASSIGN new-obj.add-type = "F"
                             new-obj.tbl-name = tablename
                             new-obj.n-order = new-ord
                             new-ord = new-ord + 1
                             new-obj.for-name = "U##" + forname
                             new-obj.fld-name = "U##" + ilin[2]
                             new-obj.prg-name = ilin[2]
                             new-obj.for-type = (IF fortype BEGINS "CHAR" THEN /*"VARCHAR2"*/ user_env[11]
                                                               ELSE fortype). 
                                      
                      IF DICTDB._File._Fil-Misc2[7] <> "" AND DICTDB._File._Fil-Misc2[7] <> ? THEN
                         PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " +  DICTDB._File._Fil-Misc2[7] SKIP.
                      ELSE 
                         PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-name SKIP.
        
                        PUT STREAM tosql UNFORMATTED comment_chars " ADD " + new-obj.for-name + " " + new-obj.for-type + ";" SKIP(1).                                                          
                  END.                 
                  ASSIGN con-fld-name = IF AVAILABLE n-obj THEN n-obj.for-name ELSE new-obj.for-name.  
                  IF INDEX(idxline, "(") = 0 THEN
                    ASSIGN idxline = idxline + "(" + (IF AVAILABLE n-obj THEN n-obj.for-name ELSE new-obj.for-name).
                  ELSE
                    ASSIGN idxline = idxline + ", " + (IF AVAILABLE n-obj THEN n-obj.for-name ELSE new-obj.for-name).
                END.

          END.
          ELSE DO:
            ASSIGN con-fld-name =  new-obj.for-name.
            IF INDEX(idxline, "(") = 0 THEN
              ASSIGN idxline = idxline + "(" + new-obj.for-name.
            ELSE
              ASSIGN idxline = idxline + ", " + new-obj.for-name. 
          END.
          IF ilin[3] BEGINS "DESC"  THEN
              ASSIGN idxline = idxline + " DESC".
        END.  
      END.  /* end of new-obj */                           
    END. /* Not available field */
  END. /* End of available file */
  ELSE DO:  /* Dealing with new table */
    FIND FIRST new-obj WHERE new-obj.add-type = "F"
                   AND new-obj.tbl-name = tablename
                   AND new-obj.prg-name = ilin[2]
                               NO-ERROR.                     
    IF AVAILABLE new-obj THEN DO:

        IF CAN-DO("LONG,CLOB,NCLOB", SUBSTRING(new-obj.for-type,2)) THEN DO:
            /* we can't create an index on a long/clob column. So need to skip the index */
            RUN skip-long-index (INPUT SUBSTRING(new-obj.for-type,2)).
            RETURN.
        END.

      IF SUBSTRING(new-obj.for-type,2,7) = "VARCHAR" 
          OR SUBSTRING(new-obj.for-type,2,8) = "NVARCHAR" THEN DO:
          IF NOT shadowcol THEN DO:
                ASSIGN con-fld-name =  new-obj.for-name.          
                IF INDEX(idxline, "(") = 0 THEN
                  ASSIGN idxline = idxline + "(UPPER(" + new-obj.for-name + ")".
                 ELSE
                  ASSIGN idxline = idxline + ", UPPER(" + new-obj.for-name + ")".
          END.
          ELSE DO: /* shadowcol */
                  RUN new-obj-idx.
                  ASSIGN con-fld-name =  new-obj.for-name.                  
                  IF INDEX(idxline, "(") = 0 THEN
                    ASSIGN idxline = idxline + "(" + new-obj.for-name.
                  ELSE
                    ASSIGN idxline = idxline + ", " + new-obj.for-name.  
          END.

      END.       
      ELSE DO:
        ASSIGN con-fld-name =  new-obj.for-name.        
        IF INDEX(idxline, "(") = 0 THEN
          ASSIGN idxline = idxline + "(" + new-obj.for-name.
        ELSE
          ASSIGN idxline = idxline + ", " + new-obj.for-name.
      END.
      IF ilin[3] BEGINS "DESC"  THEN
              ASSIGN idxline = idxline + " DESC".
    END. 
  END.
  IF conline = ? THEN DO:  
  CREATE df-info.
  ASSIGN df-info.df-seq = dfseq
         dfseq = dfseq + 1
         df-info.df-tbl = tablename
         df-line = "  " + ilin[1] + ' "' + ilin[2] + '" '.  
  DO j = 3 TO 5:
    IF ilin[j] <> ? THEN     
      ASSIGN df-info.df-line = df-info.df-line + ilin[j] + " ".
    ELSE 
      ASSIGN j = 6. 
  END.  
    CREATE  con-index.
    ASSIGN  con-table = tablename
            idx-name  = idxname
            idx-fld-name = con-fld-name.    
  END.                                                 
END PROCEDURE.

PROCEDURE create-con-field:
  FIND DICTDB._File WHERE DICTDB._File._File-name = tablename NO-ERROR.
  IF NOT AVAILABLE DICTDB._FILE THEN DO:               
    FIND rename-obj WHERE rename-type = "T"   
                      AND new-name = tablename
                      NO-ERROR.
    IF AVAILABLE rename-obj THEN 
      FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.            
  END.        

  IF AVAILABLE DICTDB._File THEN DO:        
    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = conidx NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN DO:               
      FIND rename-obj WHERE rename-type = "I"
                      AND t-name = tablename   
                      AND new-name = conidx
                      NO-ERROR.
      IF AVAILABLE rename-obj THEN 
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.            
    END.        
    IF AVAILABLE DICTDB._Index THEN DO:
      FOR EACH DICTDB._Index-Field OF DICTDB._Index:
        FIND DICTDB._Field OF DICTDB._Index-Field NO-ERROR.
        IF AVAILABLE DICTDB._Field THEN DO:
               IF INDEX(conline, "(") = 0 THEN
                   conline = conline + "(" + DICTDB._Field._For-Name.
               ELSE
                   conline = conline + ", " + DICTDB._Field._For-Name.           
        END.                          
      END.
    END.  
    ELSE DO:
     FIND FIRST new-obj WHERE new-obj.add-type = "I"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.prg-name = conidx
                                        NO-ERROR.
       IF AVAILABLE new-obj THEN DO:
           FOR EACH con-index WHERE con-table = tablename AND idx-name = conidx:    
               IF INDEX(conline, "(") = 0 THEN
                   conline = conline + "(" + idx-fld-name.
               ELSE
                   conline = conline + ", " + idx-fld-name.              
           END.                                 
       END. 
       ELSE MESSAGE "Parent index for the Foreign constraint is not available " VIEW-AS ALERT-BOX ERROR.
    END.
  END.
  ELSE DO:
     FIND FIRST new-obj WHERE new-obj.add-type = "I"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.prg-name = conidx
                                        NO-ERROR.
       IF AVAILABLE new-obj THEN DO:
           FOR EACH con-index WHERE con-table = tablename AND idx-name = conidx:    
               IF INDEX(conline, "(") = 0 THEN
                   conline = conline + "(" + idx-fld-name.
               ELSE
                   conline = conline + ", " + idx-fld-name.              
           END.                                 
       END. 
       ELSE MESSAGE "Parent index for the Foreign constraint is not available " VIEW-AS ALERT-BOX ERROR.
   END. 
END PROCEDURE.

PROCEDURE create-for-con:
  ASSIGN tablename = par-tab.
  
  FIND DICTDB._File WHERE DICTDB._File._File-name = par-tab NO-ERROR.      
  IF AVAILABLE DICTDB._File THEN 
      ASSIGN conline = conline + ") REFERENCES " + DICTDB._File._For-name + "(".
  ELSE DO:
    FIND FIRST rename-obj WHERE rename-type = "T"
         AND rename-obj.new-name = par-tab
         NO-ERROR.
    IF AVAILABLE rename-obj THEN 
       ASSIGN conline = conline + ") REFERENCES " + dsv-name + "(".
       FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.                      
  END.

  IF AVAILABLE DICTDB._File THEN DO:
    FIND DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC"
               OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "U" NO-ERROR.
    IF AVAILABLE DICTDB._Constraint THEN DO:
            FIND DICTDB._Index OF DICTDB._Constraint WHERE DICTDB._Index._Index-Name = par-index  NO-ERROR.
            IF AVAILABLE DICTDB._Index THEN DO:
               ASSIGN conidx = DICTDB._Index._Index-Name.               
               RUN create-con-field.
            END.   
    END.
    
    ELSE DO:
           FIND FIRST new-obj WHERE new-obj.add-type = "C"
                      AND new-obj.tbl-name = par-tab
                      NO-ERROR.  
           IF AVAILABLE new-obj THEN DO:
              FIND con-type WHERE con-type.con-tab = par-tab AND con-type.idx-nam = par-index
                            AND  (con-type.type = "P" OR con-type.type = "U") NO-ERROR.
               IF AVAILABLE con-type THEN DO:
                  ASSIGN conidx = con-type.idx-nam.
                  RUN create-con-field.      
               END.               
           END.            
           ELSE DO:
              MESSAGE "parent table does not have a primary constraint " view-as alert-box.
              RETURN.
           END.   
    END.   
  
  END.
  ELSE DO:
           FIND FIRST new-obj WHERE new-obj.add-type = "T"
                     AND new-obj.tbl-name = par-tab
                      NO-ERROR.
           IF AVAILABLE new-obj THEN
               ASSIGN conline = conline + ") REFERENCES " + new-obj.for-name + "(". 

           FIND FIRST new-obj WHERE new-obj.add-type = "C"
                      AND new-obj.tbl-name = par-tab
                      NO-ERROR.  
           IF AVAILABLE new-obj THEN DO:
              FIND con-type WHERE con-type.con-tab = par-tab AND con-type.idx-nam = par-index
                            AND  (con-type.type = "P" OR con-type.type = "U") NO-ERROR.
               IF AVAILABLE con-type THEN DO:
                  ASSIGN conidx = con-type.idx-nam.
                  RUN create-con-field.      
               END.               
           END.            
           ELSE
              MESSAGE "parent table does not have a primary constraint " view-as alert-box.                                     
  END.
  assign conline1 = substring(conline, 1, index(conline,"REFERENCES") + 10).
  assign conline2 = substring(conline, index(conline,"REFERENCES") + 11, -1).
  pos-comma = index(conline2,",").
  assign conline = conline1 + " " + substring(conline2, 1, pos-comma - 1) + substring(conline2,pos-comma + 2, -1).  
END PROCEDURE.

/* skip an index if it contains a long or clob column */
PROCEDURE skip-long-index:
    DEFINE INPUT PARAMETER cType AS CHARACTER NO-UNDO.

    DEFINE VARIABLE currpos AS INTEGER NO-UNDO.

    /* remember this is an index we can't create, and get rid of idxline which is the sql to be added
       to the .sql file.
    */
    ASSIGN longIndex = TRUE
           idxline = ?.

    /* remove all df lines for this index */
    FOR EACH df-info WHERE df-tbl = tablename AND df-info.df-seq >= index_df_start:
        DELETE df-info.
    END.
    ASSIGN dfseq = index_df_start.

    IF shadowcol THEN DO:
        FOR EACH shad-col:
            DELETE shad-col.
        END.

        /* if the index had other fields that required a shadow column, we need to remove the shadow
           column from the .sql file. This is not pretty but does the job.
        */
        currpos = SEEK(tosql).
        IF currpos > index_sql_start THEN DO:
            SEEK STREAM tosql TO index_sql_start.
            PUT STREAM tosql  UNFORMATTED FILL(" ", currpos - index_sql_start) SKIP.
            SEEK STREAM tosql TO index_sql_start.
        END.
        
    END.

    ASSIGN efile = tablename + ".e".
    OUTPUT TO value(efile) APPEND.
    PUT UNFORMATTED idxname " in " tablename " is a index that contain a column of type "
        cType " and will not be contained in the" SKIP
        "df file and no CREATE INDEX statement was generated in the sql file." SKIP(1).
    OUTPUT CLOSE.

END PROCEDURE.

PROCEDURE process-extents-with-fldwidth:
    DEFINE INPUT PARAMETER iMode AS INTEGER NO-UNDO.

    DEFINE VARIABLE iSeq   AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cDelim AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cTemp  AS CHARACTER NO-UNDO.

    /* MODE 1 = use the sql-info table; MODE 2 = use the alt-info table */
    
    ASSIGN iWidth = INTEGER(ENTRY(1,cfldwidth))
           iSeq = (IF NUM-ENTRIES(cfldwidth) > 1 THEN  
                      INTEGER(ENTRY(2,cfldwidth)) ELSE 0).

    IF fieldtype <> "decimal" THEN
        /* if not decimal, we only need to do this for LONG and VARCHAR2/NVARCHAR2  columns */
        FIND FIRST new-obj WHERE new-obj.add-type = "F" AND 
                                 new-obj.tbl-name = tablename AND 
                                 new-obj.fld-name = fieldname AND 
                                 (new-obj.for-type BEGINS " VARCHAR2" OR 
                                  new-obj.for-type BEGINS " NVARCHAR2" OR
                                  new-obj.for-type BEGINS " LONG")
                           NO-LOCK NO-ERROR. 

    /* check size */
    IF iWidth > 0 AND 
        (fieldtype = "decimal" OR ( AVAILABLE new-obj AND 
                                    INDEX(new-obj.for-type,"RAW") = 0)) THEN DO:

      /* calculate the size of each column */
      IF fieldtype = "decimal" THEN DO:
          /* do it just like we do upon migration */
          u = integer(ilin[2]).

          ASSIGN  iWidth = ((iWidth - (u * 2)) / u).

          IF iWidth > 38 THEN
             ASSIGN iWidth = 38.        
      END.
      ELSE DO: /* not decimal - must be varchar or long */

         ASSIGN cTemp = ENTRY(1,cfldwidth)
                iWidth = (iWidth / integer(ilin[2])) - 2.

          /* if the size is still too big to be a VARCHAR2, there is nothing left
             to do - leave it as it is
          */
          IF (ora_version > 7 AND iWidth <= longwid) /*OR
             (iWidth < 2001)*/ THEN DO:

            IF new-obj.for-type BEGINS " LONG" THEN DO:
              /* if it is a LONG now, need to recreate df-info record since
                 it may have been deleted and we need to set FORMAT */
              FIND df-info WHERE df-info.df-tbl = tablename AND 
                                 df-info.df-fld = fieldname AND 
                                 df-info.df-line BEGINS "  FORMAT" NO-ERROR.

              /* we need to update FORMAT with the sql width - that's what we do upon migration.
                 The adjust schema is the process that later adjusts it to match the original 
                 definition from the Progress db
              */
              IF NOT AVAILABLE df-info THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq  = iSeq
                         df-info.df-tbl  = tablename 
                         df-info.df-fld  = fieldname
                         df-info.df-line = "  FORMAT " + '"x(' + cTemp + ')"'.
              END.
              ELSE
                  ASSIGN df-info.df-line = (IF INDEX(df-info.df-line,"x(") <> 0 THEN 
                                            "  FORMAT " + '"x(' + cTemp + ')"'
                                          ELSE df-info.df-line).

              /* we are changing this from LONG to VARCHAR2. Need to adjust all
                 the relevant information as well. for-type, the sql-line,
                 and the FOREIGN-TYPE and FOREIGN-CODE in the df
              */
              IF iMode = 1 THEN DO: /* sql-info */
                  ASSIGN new-obj.for-type = /*"VARCHAR2 ("*/ user_env[11] + " (" + STRING(iWidth) + ")"
                         sql-info.LINE = REPLACE (sql-info.LINE, " LONG", " " + new-obj.for-type).
              END.
              ELSE IF iMode = 2 THEN DO: /* alt-info */
                 ASSIGN new-obj.for-type = /*"VARCHAR2 ("*/ user_env[11] + " (" + STRING(iWidth) + ")"
                        alt-info.a-line = REPLACE (alt-info.a-line, " LONG", " " + new-obj.for-type).
              END.

              FIND df-info WHERE df-info.df-tbl = tablename AND 
                                 df-info.df-fld = fieldname AND 
                                 df-info.df-line BEGINS "  FOREIGN-TYPE".
              IF user_env[11] = "VARCHAR2" THEN
                 ASSIGN df-info.df-line = '  FOREIGN-TYPE "VARCHAR2"'.
              ELSE
                 ASSIGN df-info.df-line = '  FOREIGN-TYPE "NVARCHAR2"'.
              
              FIND df-info WHERE df-info.df-tbl = tablename
                             AND df-info.df-fld = fieldname
                             AND df-info.df-line BEGINS "  FOREIGN-CODE".
              ASSIGN df-info.df-line = "  FOREIGN-CODE 1".

            END.
          END.
          ELSE
             ASSIGN iWidth = -1. /* so we don't change anything below */
      END.

      IF iWidth > 0 THEN DO: /* check if we have to change it */
        
        ASSIGN fsize = STRING (iWidth).
        
        IF fieldtype = "decimal" THEN 
           cDelim = ",".
        ELSE
           cDelim = ")".

        IF iMode = 1 THEN DO: /* sql-info */
        
            ASSIGN left_paren = INDEX(sql-info.line, "(")
                   /* find the size of the field between the left parenthesis and the right delimiter */
                   extline = SUBSTRING(sql-info.line, left_paren, INDEX(sql-info.line, cDelim) - left_paren)
                   /* now replace it with new value */
                   sql-info.line = REPLACE(sql-info.line, extline, "(" + fsize ).
        END.
        ELSE IF iMode = 2 THEN DO: /* alt-info */
            
            ASSIGN left_paren = INDEX(alt-info.a-line, "(")
                   /* find the size of the field between the left parenthesis and the right delimiter */
                   extline = SUBSTRING(alt-info.a-line, left_paren, INDEX(alt-info.a-line, cDelim) - left_paren)
                   /* now replace it with new value */
                   alt-info.a-line = REPLACE(alt-info.a-line, extline, "(" + fsize ).
        
        END.

        /* reset the information using the value we just calculated */
        ASSIGN left_paren = INDEX(new-obj.for-type, "(")
               /* find the size of the field between parentheses */
               extline = SUBSTRING(new-obj.for-type, left_paren, INDEX(new-obj.for-type, cDelim) - left_paren)
               /* now replace it with new value */
               new-obj.for-type = REPLACE(new-obj.for-type,extline, "(" + fsize).
      END. /* iWidth > 0 */

      /* need to reset some other settings */
      IF fieldtype <> "decimal" THEN DO:
          FIND df-info WHERE df-info.df-tbl = tablename AND 
                             df-info.df-fld = fieldname AND 
                             df-info.df-line BEGINS "  FIELD-MISC13".
          ASSIGN df-info.df-line = "  FIELD-MISC13 " + fsize.
      END.

      FIND df-info WHERE df-info.df-tbl = tablename AND 
                       df-info.df-fld = fieldname AND 
                       df-info.df-line BEGINS "  FOREIGN-MAXIMUM".
      ASSIGN df-info.df-line = "  FOREIGN-MAXIMUM " + fsize.     

      /* now go back to the df-info record that we created before all this
       madness
      */
      FIND FIRST df-info WHERE df-info.df-seq = (dfseq - 1) NO-ERROR.

    END. /* Check Size */
    
END PROCEDURE.


PROCEDURE process-fld-width:
    DEFINE VARIABLE cDelim AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cTemp  AS CHARACTER NO-UNDO.

    /* we use this to find the string to be replaced when width is changed */
    IF fieldtype = "decimal" THEN 
       cDelim = ",".
    ELSE
       cDelim = ")".

    IF alt-table THEN DO:               
      FIND FIRST alt-info WHERE a-tblname = tablename
                      AND a-fldname = fieldname 
                      AND a-line BEGINS "ADD" NO-ERROR.

      IF AVAILABLE alt-info THEN DO:
          
         IF new-obj.for-type BEGINS " VARCHAR2" OR new-obj.for-type BEGINS " NVARCHAR2" THEN DO:  
             
            /* validate max size */
            IF (ora_version > 7 AND iWidth <= longwid) /*OR 
               iWidth < 2001*/ THEN DO: 

                /* we need to update FORMAT with the sql width - that's what we do upon migration.
                   The adjust schema is the process that later adjusts it to match the original 
                   definition from the Progress db
                */
                ASSIGN df-info.df-line = (IF INDEX(df-info.df-line,"x(") <> 0 THEN  
                                          "  FORMAT " + '"x(' + ilin[2] + ')"'
                                          ELSE df-info.df-line).
            END.
            ELSE DO: 
                  ASSIGN new-obj.for-type = " " +  longType /*" LONG"*/
                         left_paren = INDEX(alt-info.a-line, /*" VARCHAR2"*/  " " + user_env[11])
                         extline = SUBSTRING(alt-info.a-line, left_paren, INDEX(alt-info.a-line, ")") - left_paren)
                         alt-info.a-line = REPLACE(alt-info.a-line, extline + ")", " " +  longType /*" LONG"*/)
                         iWidth = 0.
                  /* There is no format statement for a long */
                  IF longType = "LONG" THEN
                     DELETE df-info.

                  /* if we are processing extents, change the size of all elements */
                  IF iExtents > 0 THEN DO:
                      ASSIGN cTemp = new-obj.for-type
                             extlinenum = alt-info.a-line-num.

                      FOR EACH alt-info WHERE a-tblname = tablename
                                        AND a-fldname = fieldname 
                                        AND a-line BEGINS "ADD"
                                        AND a-line-num > extlinenum:
                           FIND NEXT new-obj WHERE new-obj.add-type = "F" AND
                                                   new-obj.tbl-name = tablename AND
                                                   new-obj.fld-name = fieldname NO-ERROR.
    
                           ASSIGN new-obj.for-type = cTemp
                                  left_paren = INDEX(alt-info.a-line, /*" VARCHAR2"*/  " " + user_env[11])
                                  extline = SUBSTRING(alt-info.a-line, left_paren, INDEX(alt-info.a-line, ")") - left_paren)
                                  alt-info.a-line = REPLACE(alt-info.a-line, extline + ")", " " +  longType /*" LONG"*/).
                      END. /* FOR EACH */
                  END.

                  /* we are changing the type from VARCHAR2 to LONG, so need to
                     change all the relevant information
                  */
                  FIND df-info WHERE df-info.df-tbl = tablename
                                 AND df-info.df-fld = fieldname
                                 AND df-info.df-line BEGINS "  FOREIGN-CODE".
                  ASSIGN df-info.df-line = "  FOREIGN-CODE ".
                  
                  IF longType = "LONG" THEN
                      ASSIGN df-info.df-line = df-info.df-line + "8".
                  ELSE /* it is a clob or nclob */
                      ASSIGN df-info.df-line = df-info.df-line + "112".

                  FIND df-info WHERE df-info.df-tbl = tablename
                                 AND df-info.df-fld = fieldname
                                 AND df-info.df-line BEGINS "  FOREIGN-TYPE".
                  ASSIGN df-info.df-line = '  FOREIGN-TYPE "' + longType + '"'.
                      
                  IF longType = "NCLOB" THEN DO:
                      CREATE df-info.
                      ASSIGN df-info.df-seq  = dfseq
                             dfseq = dfseq + 1
                             df-info.df-tbl  = tablename 
                             df-info.df-fld  = fieldname
                             df-info.df-line = "FOREIGN-MISC25 1".
                  END.

            END. /* check max fld length */
         END. /* for-type BEGINS VARCHAR2 */

         /* adjust the size */
         IF iWidth > 0 THEN DO:

             ASSIGN left_paren = INDEX(alt-info.a-line, "(")
                    /* find the size of the field between parentheses */
                    extline = SUBSTRING(alt-info.a-line, left_paren, INDEX(alt-info.a-line, cDelim) - left_paren)
                    /* now replace it with new value */
                    alt-info.a-line = REPLACE(alt-info.a-line, extline, "(" + fsize ).

             ASSIGN left_paren = INDEX(new-obj.for-type, "(")
                    /* find the size of the field between parentheses */
                    extline = SUBSTRING(new-obj.for-type, left_paren, INDEX(new-obj.for-type, cDelim) - left_paren)
                    /* now replace it with new value */
                    new-obj.for-type = REPLACE(new-obj.for-type,extline, "(" + fsize).

             /* if we are processing extents, change the size of all elements */
             IF iExtents > 0 THEN DO:
                 ASSIGN cTemp = new-obj.for-type
                        extlinenum = alt-info.a-line-num.

                 FOR EACH alt-info WHERE a-tblname = tablename
                                         AND a-fldname = fieldname 
                                         AND a-line BEGINS "ADD"
                                         AND a-line-num > extlinenum:
                      FIND NEXT new-obj WHERE new-obj.add-type = "F" AND
                                              new-obj.tbl-name = tablename AND
                                              new-obj.fld-name = fieldname NO-ERROR.

                      ASSIGN new-obj.for-type = cTemp
                             left_paren = INDEX(alt-info.a-line, "(")
                             /* find the size of the field between parentheses */
                             extline = SUBSTRING(alt-info.a-line, left_paren, INDEX(alt-info.a-line, cDelim) - left_paren)
                             /* now replace it with new value */
                             alt-info.a-line = REPLACE(alt-info.a-line, extline, "(" + fsize ).
                 END. /* FOR EACH */
             END.   /* if iExtents > 0 */

         END. /* iWidth > 0 */
      END. /* if available alt-info */
    END.
    ELSE DO: /* not alt-table */
      FIND FIRST sql-info WHERE tblname = tablename
                      AND fldname = fieldname 
                      AND line <> "" /* BEGINS fieldname */
                      NO-ERROR.
      IF AVAILABLE sql-info THEN DO:     
        
        IF new-obj.for-type BEGINS " VARCHAR2" OR new-obj.for-type BEGINS " NVARCHAR2" THEN DO:  

            IF (ora_version > 7 AND iWidth <= longwid) /*OR
               iWidth < 2001*/ THEN DO: 

              /* we need to update FORMAT with the sql width - that's what we do upon migration.
                 The adjust schema is the process that later adjusts it to match the original 
                 definition from the Progress db
              */
              ASSIGN df-info.df-line = (IF INDEX(df-info.df-line,"x(") <> 0 THEN
                                          "  FORMAT " + '"x(' + ilin[2] + ')"'
                                        ELSE df-info.df-line).
            END.
            ELSE DO:       

              ASSIGN new-obj.for-type = " " +  longType /*" LONG"*/
                     left_paren = INDEX(sql-info.line, /*" VARCHAR2"*/ " " + user_env[11])
                     extline = SUBSTRING(sql-info.line, left_paren, INDEX(sql-info.line, ")") - left_paren)
                     sql-info.line = REPLACE(sql-info.line, extline + ")", " " +  longType /*" LONG"*/)
                     iWidth  = 0.

              /* There is no format statement for a long */
              IF longType = "LONG" THEN
                  DELETE df-info.

              /* if we are processing extents, change the size of all elements */
              IF iExtents > 0 THEN DO:
                  ASSIGN cTemp = new-obj.for-type
                         extlinenum = sql-info.line-num.

                  FOR EACH sql-info WHERE tblname = tablename
                                    AND fldname = fieldname 
                                    AND line <> "" /*BEGINS fieldname*/
                                    AND sql-info.line-num > extlinenum:

                      FIND NEXT new-obj WHERE new-obj.add-type = "F" AND
                                              new-obj.tbl-name = tablename AND
                                              new-obj.fld-name = fieldname NO-ERROR.

                      ASSIGN new-obj.for-type = cTemp
                             left_paren = INDEX(sql-info.line, /*" VARCHAR2"*/ " " + user_env[11])
                             extline = SUBSTRING(sql-info.line, left_paren, INDEX(sql-info.line, ")") - left_paren)
                             sql-info.line = REPLACE(sql-info.line, extline + ")", " " +  longType /*" LONG"*/).
                  END.
              END. /* iExtents > 0 */

              FIND df-info WHERE df-info.df-tbl = tablename
                             AND df-info.df-fld = fieldname
                             AND df-info.df-line BEGINS "  FOREIGN-CODE".
              ASSIGN df-info.df-line = "  FOREIGN-CODE ".
              
              IF longType = "LONG" THEN
                  ASSIGN df-info.df-line = df-info.df-line + "8".
              ELSE /* it is a clob or nclob */
                  ASSIGN df-info.df-line = df-info.df-line + "112".

              FIND df-info WHERE df-info.df-tbl = tablename
                             AND df-info.df-fld = fieldname
                             AND df-info.df-line BEGINS "  FOREIGN-TYPE".
              ASSIGN df-info.df-line = '  FOREIGN-TYPE "' + longType + '"'.

              IF longType = "NCLOB" THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq  = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl  = tablename 
                         df-info.df-fld  = fieldname
                         df-info.df-line = "FOREIGN-MISC25 1".
              END.

            END.
        END. /* varchar */                    

        IF iWidth > 0 THEN DO:
            ASSIGN left_paren = INDEX(new-obj.for-type,"(")
                   /* find the size of the field between parenthesis */
                   extline = SUBSTRING(new-obj.for-type, left_paren, INDEX(new-obj.for-type, cDelim) - left_paren)
                   /* now replace it with new value */
                   new-obj.for-type = REPLACE(new-obj.for-type,extline, "(" + fsize)
                   left_paren = INDEX(line, "(")
                   /* find the size of the field between parentheses */
                   extline = SUBSTRING(line, left_paren, INDEX(line, cDelim) - left_paren)
                   /* now replace it with new value */
                   line = REPLACE(line, extline, "(" + fsize ).
             
            /* if we are processing extents, change the size of all elements */
            IF iExtents > 0 THEN DO:
                ASSIGN cTemp = new-obj.for-type
                       extlinenum = sql-info.line-num.

                FOR EACH sql-info WHERE tblname = tablename
                          AND fldname = fieldname 
                          AND line <> "" /*BEGINS fieldname*/
                          AND sql-info.line-num > extlinenum:

                    FIND NEXT new-obj WHERE new-obj.add-type = "F" AND
                                            new-obj.tbl-name = tablename AND
                                            new-obj.fld-name = fieldname NO-ERROR.

                    ASSIGN new-obj.for-type = cTemp
                           left_paren = INDEX(sql-info.line, "(")
                           /* find the size of the field between parentheses */
                           extline = SUBSTRING(sql-info.line, left_paren, INDEX(sql-info.line, cDelim) - left_paren)
                           /* now replace it with new value */
                           sql-info.line = REPLACE(sql-info.line, extline, "(" + fsize ).
                END.
            END. /* iExtents > 0 */

        END. /* iWidth > 0 */
      END. /* if available sql-info */
    END. /* sql-info */

    IF fieldtype <> "decimal" THEN DO:
        FIND df-info WHERE df-info.df-tbl = tablename
                       AND df-info.df-fld = fieldname
                       AND df-info.df-line BEGINS "  FIELD-MISC13".
        ASSIGN df-info.df-line = "  FIELD-MISC13 " + fsize.
    END.

    FIND df-info WHERE df-info.df-tbl = tablename
                   AND df-info.df-fld = fieldname
                   AND df-info.df-line BEGINS "  FOREIGN-MAXIMUM".
    ASSIGN df-info.df-line = "  FOREIGN-MAXIMUM " + fsize.                  

END PROCEDURE.

/*======================== Mainline =================================== */   

IF OS-GETENV("BLANKDEFAULT") <> ? THEN
  tmp_str   = OS-GETENV("BLANKDEFAULT").
IF tmp_str BEGINS "Y" THEN
  ASSIGN blankdefault = TRUE.

ASSIGN ilin = ?
       ipos = 0
       dfout = osh_dbname + ".df"
       sqlout = ora_dbname + ".sql"
       idbtyp = (IF user_env[32] = ? THEN user_env[22] ELSE user_env[32])
       xlate  = (user_env[8] BEGINS "y")
       minwidth = 30
       uptseq = 1.
   
/* For char types, the first entry in user_env[10] has the maximum size */
ASSIGN longwid = integer(entry(1,user_env[10])).

/* The second entry in user_env[10] has the YES if user wants to expand character columns to be
   CLOB instead of LONG
*/
IF LOGICAL(entry(2,user_env[10])) THEN
   ASSIGN longType = "CLOB".
ELSE /* if using unicode data types, then columns are expanded to nclob */
   ASSIGN longType = (IF user_env[11] = "NVARCHAR2" THEN "NCLOB" ELSE "LONG").

OUTPUT STREAM todf TO VALUE(dfout) NO-ECHO NO-MAP.
OUTPUT STREAM tosql TO VALUE(sqlout) NO-ECHO NO-MAP.

INPUT FROM VALUE(user_env[1]).              

SESSION:IMMEDIATE-DISPLAY = yes.

RUN adecomm/_setcurs.p ("WAIT").

FIND FIRST DICTDB._File NO-ERROR.
IF AVAILABLE DICTDB._File THEN
  ASSIGN dbrecid = DICTDB._File._Db-recid.

/* this defines if user wants character semantics */
IF LOGICAL(entry(3,user_env[10])) THEN
   PUT STREAM tosql UNFORMATTED "ALTER SESSION SET NLS_LENGTH_SEMANTICS='CHAR';" SKIP.

DO ON STOP UNDO, LEAVE:
    /* when IMPORT hits the end, it generates ENDKEY.  This is how loop ends */
  load_loop:
  REPEAT ON ERROR UNDO,RETRY ON ENDKEY UNDO, LEAVE:
       /* Pop the top token off the top and move all the other tokens up one 
         so that ilin[1] is the next token to process.
       */
    ASSIGN ilin = ?.
    IMPORT ilin.

    IF ilin[1] = ? THEN NEXT.    
    ASSIGN inum = 3.

        /* set the action mode */
    CASE ilin[1]:
      WHEN "ADD":u    OR WHEN "CREATE":u OR WHEN "NEW":u  THEN imod = "a":u.
      WHEN "UPDATE":u OR WHEN "MODIFY":u OR WHEN "ALTER":u OR 
                                          WHEN "CHANGE":u THEN imod = "m":u.
      WHEN "DELETE":u OR WHEN "DROP":u OR WHEN "REMOVE":u THEN imod = "d":u.
      WHEN "RENAME":u                                     THEN imod = "r":u.
    END CASE.

    IF ilin[1] = "ADD"    OR ilin[1] = "CREATE" OR ilin[1] = "NEW"    OR
       ilin[1] = "UPDATE" OR ilin[1] = "MODIFY" OR ilin[1] = "ALTER" OR 
       ilin[1] = "CHANGE" OR ilin[1] = "DELETE" OR ilin[1] = "DROP" OR 
       ilin[1] = "REMOVE" OR ilin[1] = "RENAME" THEN DO:
        /* set the object type */
      CASE ilin[2]:
        WHEN "DATABASE":u OR WHEN "CONNECT":u THEN iobj = "d":u.
        WHEN "FILE":u     OR WHEN "TABLE":u   THEN ASSIGN iobj = "t":u.                  
        WHEN "FIELD":u    OR WHEN "COLUMN":u THEN ASSIGN iobj = "f":u.        
        WHEN "INDEX":u    OR WHEN "KEY":u THEN ASSIGN iobj = "i":u.                      
        WHEN "SEQUENCE":u                 THEN ASSIGN iobj = "s":u.
        WHEN "CONSTRAINT":u               THEN ASSIGN iobj = "c":u.          
      END CASE.
    END.
    /* This code is here only for when the index syntax is
        ADD/UPDATE [UNIQUE] [PRIMARY] [INACTIVE] INDEX name 
    */

    IF ilin[1] = "UPDATE" AND
       (ilin[2] <> "DATABASE" AND
        ilin[2] <> "FILE" AND
        ilin[2] <> "FIELD" AND
        ilin[2] <> "INDEX") THEN DO:
      IF CAN-DO("INDEX,KEY":u,ilin[3]) THEN 
        ASSIGN iobj    = "i":u.             
      ELSE IF CAN-DO("INDEX,KEY",ilin[4]) THEN
        ASSIGN iobj    = "i".          
      ELSE IF CAN-DO("INDEX,KEY",ilin[5]) THEN
        ASSIGN iobj    = "i".             
    END.
    
    CASE ilin[2]:
      WHEN "DATABASE":u OR WHEN "CONNECT":u OR WHEN "FILE":u   OR 
      WHEN "TABLE":u    OR WHEN "FIELD":u   OR WHEN "COLUMN":u OR 
      WHEN "INDEX":u    OR WHEN "KEY":u     OR WHEN "SEQUENCE":u
          THEN RUN check-view.      
    END CASE.
    
  
                    
    IF iobj = "d"  or startdf THEN DO: 
      CREATE df-info.
      ASSIGN df-info.df-seq = dfseq
             dfseq = dfseq + 1
             df-line = "UPDATE DATABASE " + '"' + ora_dbname + '"'. 
      ASSIGN startdf = FALSE.
    END.  
          
    IF iobj = "t" THEN DO:
      IF imod = "d" THEN DO:
        IF tablename <> ? AND tablename <> ilin[3] THEN 
          RUN write-tbl-sql.            
                         
       IF idxline <> ? THEN 
          RUN write-idx-sql.

       IF seq-line <> ? THEN
          RUN write-seq-sql.
       
       IF conline <> ? THEN
          RUN write-con-sql.
          
       IF tablename <> ilin[3] THEN
         ASSIGN tablename = ilin[3]
                 comment_chars = ""
                 comment-out = FALSE
                 unsptdt = FALSE.

        IF tablename <> ? THEN                             
          DISPLAY tablename WITH FRAME working.
    
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[3]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
        IF AVAILABLE DICTDB._File THEN DO:
          PUT STREAM tosql UNFORMATTED comment_chars "DROP TABLE " DICTDB._File._For-name user_env[5] SKIP(1).
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = DICTDB._File._File-name
                 df-line = "DROP TABLE " + '"' + DICTDB._File._File-name + '"'.
        END.
        ELSE DO:
          MESSAGE "The Delta DF File contains DROP TABLE " ilin[3]  SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
          RETURN.
        END.
        ASSIGN ilin = ?.
      END. /* End delete table */

      /* Rename table */
      ELSE IF imod = "r" THEN DO:
        IF tablename <> ? AND tablename <> ilin[5] THEN 
          Run write-tbl-sql.                      
        
        IF idxline <> ? THEN 
          RUN write-idx-sql.
        
        IF seq-line <> ? THEN
          RUN write-seq-sql. 
       
        IF conline <> ? THEN
          RUN write-con-sql.
          
        IF tablename <> ilin[5] THEN
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE
                 unsptdt = FALSE.

        IF tablename <> ? THEN                              
          DISPLAY tablename WITH FRAME working.       
                      
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[3]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
 
        IF AVAILABLE DICTDB._File THEN DO:     
          ASSIGN idx-number = 0.
          FOR EACH DICTDB._Index OF DICTDB._File:
            IF idx-number < DICTDB._Index._Idx-num THEN
              ASSIGN idx-number = DICTDB._Index._Idx-num.
          END.
          ASSIGN idx-number = idx-number + 1.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = ilin[5]
                 df-line = "RENAME TABLE " + '"' + DICTDB._File._File-name + '" TO "' + ilin[5] + '"'.          
          
          CREATE rename-obj.
          ASSIGN rename-type = "T"
                 t-name = ilin[5]
                 old-name = DICTDB._File._File-name
                 new-name = ilin[5].
                  
          IF LENGTH(DICTDB._File._For-name) > 4 AND SUBSTRING(DICTDB._File._For-name, (LENGTH(DICTDB._File._For-name) - 4)) <> "_V##" THEN
            ASSIGN dsv-name = DICTDB._File._For-name.
          ELSE DO:
            IF DICTDB._File._Fil-misc2[7] <> "" AND DICTDB._File._Fil-misc2[7] <> ? THEN
              ASSIGN dsv-name = DICTDB._File._Fil-misc2[7].
            ELSE
              ASSIGN dsv-name = SUBSTRING(DICTDB._File._For-name, 1,(LENGTH(DICTDB._File._For-name) -  4)).
          END.                    
        END.
        ELSE DO:
          MESSAGE "The Delta DF File contains RENAME TABLE" ilin[3] SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
          RETURN.
        END.
        ASSIGN ilin = ?. 
      END. /* End Rename Table */
      
      /* Add new table */
      ELSE IF imod = "a" THEN DO:                               
        IF ilin[1] = "ADD" AND ilin[2] = "TABLE" THEN DO: 
          RUN write-tbl-sql.
          
          IF idxline <> ? THEN 
             RUN write-idx-sql.

          IF seq-line <> ? THEN
            RUN write-seq-sql.
       
          IF conline <> ? THEN
            RUN write-con-sql.
                   
          ASSIGN addtable = TRUE
                 tablename = ilin[3]
                 fldnum = 0
                 idx-number = 1
                 comment_chars = ""
                 comment-out = FALSE.
                                                                                        
          FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = tablename
                                    AND DICTDB._File._Owner = "_FOREIGN"
                                    NO-LOCK NO-ERROR.
          IF AVAILABLE DICTDB._File THEN DO:
            MESSAGE "The Delta DF File contains ADD TABLE" ilin[3] SKIP
                  "and table already exists in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.

          IF xlate THEN DO:       
            ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
          END.
          ELSE IF LENGTH(ilin[3]) > INTEGER(user_env[29]) THEN DO:   
            ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
          END.
          ELSE
            ASSIGN forname = ilin[3].
 
          _verify-table:
          DO WHILE TRUE:
            FIND FIRST verify-table WHERE verify-table.tnew-name = forname NO-ERROR.
            FIND FIRST DICTDB._File WHERE CAPS(DICTDB._File._For-name) = CAPS(forname) NO-ERROR.
            IF AVAILABLE verify-table OR AVAILABLE DICTDB._File THEN DO:
              DO a = 1 TO 999:
                IF a = 1 THEN
                  ASSIGN forname = forname + STRING(a).
                ELSE
                  ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - LENGTH(STRING(a))) + STRING(a). 
                IF CAN-FIND(FIRST DICTDB._File WHERE DICTDB._File._For-name = forname) THEN NEXT.
                ELSE IF CAN-FIND(FIRST verify-table WHERE verify-table.tnew-name = forname) THEN NEXT.
                ELSE DO:
                  CREATE verify-table.
                  ASSIGN verify-table.tnew-name = forname.
                  LEAVE _verify-table.
                END.
              END.
            END.                
            ELSE DO:
              CREATE verify-table.
              ASSIGN verify-table.tnew-name = forname.
              LEAVE _verify-table.
            END.
          END.

          RUN create-new-obj (INPUT "T", INPUT ?).
          
          IF tablename <> ? THEN    
            DISPLAY tablename WITH FRAME working.   

          IF pcompatible THEN DO: 
            ASSIGN fldnum = fldnum + 1.             
            CREATE sql-info.
            ASSIGN line-num = -3
                   line = comment_chars + "DROP SEQUENCE " + forname + "_SEQ" + user_env[5]
                   tblname = ilin[3].
        
            CREATE sql-info.
            ASSIGN line-num = -2 
                   line = 'CREATE SEQUENCE ' + forname + 
                          '_SEQ START WITH 1 INCREMENT BY 1' + user_env[5]
                   tblname = ilin[3].       
            CREATE sql-info.
            ASSIGN line-num = 5000
                   line = "PROGRESS_RECID NUMBER NULL"  
                   tblname = ilin[3]
                   fldname = "PROGRESS_RECID".                  
          END.          
            
          CREATE sql-info.
          ASSIGN line-num = -1
                 line = 'DROP TABLE ' + forname + ' ' + user_env[5]
                 tblname = ilin[3].
          
          CREATE sql-info.
          ASSIGN lnum = 1 
                 line-num = lnum
                 line = 'CREATE TABLE ' + forname +  ' ('
                 tblname = ilin[3].
                
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '"'.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = '  FOREIGN-NAME "' + CAPS(forname) + '"'.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = '  FOREIGN-TYPE "TABLE" '.
          IF ora_owner <> "" THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line = '  FOREIGN-OWNER "' + CAPS(ora_owner) + '"'.
          END.
        END.
        ELSE DO:          
          CASE ilin[1]:
            WHEN "AREA" THEN . /* Don't assign the Area it will default to 6 */
            WHEN "CAN-INSERT" OR WHEN "CAN-READ" OR WHEN "CAN-WRITE" OR
            WHEN "CAN-UPDATE" OR WHEN "CAN-DELETE" OR WHEN "CAN-DUMP" OR
            WHEN "CAN-LOAD" OR WHEN "CAN-SELECT" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "LABEL" OR WHEN "LABEL-SA" OR WHEN "DESCRIPTION" OR WHEN "VALEXP" OR
            WHEN "VALMSG" OR WHEN "VALMSG-SA" THEN DO:
              RUN dctquot (ilin[2], '"',OUTPUT oq-string).
              IF LENGTH(oq-string) > 0 THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = "  " + ilin[1] + " " + oq-string.
              END.
            END.
 
            WHEN "FROZEN" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "HIDDEN" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "DUMP-NAME" THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.
            END.
            WHEN "FILE-TRIGGER" OR WHEN "TABLE-TRIGGER" THEN DO:             
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                              ilin[3] + " ". 
             IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].            
             IF ilin[5] <> ? THEN 
                 ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.             
             IF ilin[6] <> ? THEN 
                 ASSIGN df-line = df-line + ilin[6].            
             IF ilin[7] <> ? THEN
                 ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
            END.
          END CASE. 
        END.
        ASSIGN ilin = ?.
      END. /* End Add Table section */
      
      /* Update or modify table attributes are for df only */
      ELSE DO: 
        IF ilin[1] = "UPDATE" THEN DO: 
          IF tablename <> ? AND tablename <> ilin[3] THEN 
            RUN write-tbl-sql.                     
         
          FIND DICTDB._File where DICTDB._File._File-name = ilin[3] NO-ERROR.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            FIND rename-obj WHERE rename-type = "T"
                              AND new-name = ilin[3] NO-ERROR.
            IF AVAILABLE rename-obj THEN
              FIND DICTDB._File where DICTDB._File._File-name = old-name NO-ERROR.
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            /* see if it's a new table */
            FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[3] 
                                     AND new-obj.add-type = "T" NO-ERROR.
            IF NOT AVAILABLE new-obj THEN DO:
                MESSAGE "The Delta DF File contains UPDATE TABLE" ilin[3] SKIP
                        "and table does not exist in the schema holder." SKIP
                        "This process is being aborted."  SKIP (1)
                        VIEW-AS ALERT-BOX ERROR.
                RETURN.
            END.
          END.
          IF AVAILABLE DICTDB._File THEN DO:
            ASSIGN idx-number = 0.
            FOR EACH DICTDB._Index OF DICTDB._File:
              IF idx-number < DICTDB._Index._Idx-num THEN
                ASSIGN idx-number = DICTDB._Index._Idx-num.
            END.
            IF idx-number > 0 THEN
              ASSIGN idx-number = idx-number + 1.
          END.
          IF idxline <> ? THEN 
            RUN write-idx-sql.
          
          IF seq-line <> ? THEN
            RUN write-seq-sql.
       
          IF conline <> ? THEN
            RUN write-con-sql.
                    
          IF tablename <> ilin[3] THEN
            ASSIGN tablename = ilin[3]
                   comment_chars = ""
                   comment-out = FALSE.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '"'.
        END.  
                
        IF tablename <> ? THEN                             
          DISPLAY tablename WITH FRAME working.
           
        CASE ilin[1]:
          WHEN "LABEL"  OR WHEN "LABEL-SA" OR WHEN "DESCRIPTION" OR
          WHEN "VALEXP" OR WHEN "VALMSG"   OR WHEN "VALMSG-SA"   OR
          WHEN "DUMP-NAME" THEN DO:            
            RUN dctquot (ilin[2], '"',OUTPUT oq-string).
            IF ilin[2] = ? THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + " ?".
            END.               
            ELSE IF LENGTH(oq-string) > 0 THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = "  " + ilin[1] + " " + oq-string.
            END.
          END.
          WHEN "FROZEN"  OR WHEN "HIDDEN" THEN DO:
           CREATE df-info.
           ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-info.df-tbl = tablename
                  df-line = "  " + ilin[1].
          END.
          WHEN "FILE-TRIGGER" OR WHEN "TABLE-TRIGGER"  THEN DO:            
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                              ilin[3] + " ". 
             IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].             
             IF ilin[5] <> ? THEN 
                 ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.             
             IF ilin[6] <> ? THEN 
                 ASSIGN df-line = df-line + ilin[6].             
             IF ilin[7] <> ? THEN
                 ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
          END.
        END CASE. 
        ASSIGN ilin = ?.
      END.                                    
    END.  /* End TABLE Section */
    
    IF iobj = "f" THEN DO:               
      IF imod = "d" THEN DO:
        IF tablename <> ? AND tablename <> ilin[5] THEN 
          RUN write-tbl-sql.                 
        
        IF idxline <> ? THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
       
        IF conline <> ? THEN
          RUN write-con-sql.
               
        IF tablename <> ilin[5] THEN
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE
                 unsptdt = FALSE.

        IF tablename <> ? THEN  
          DISPLAY tablename WITH FRAME working.
          
                
        FIND FIRST rename-obj WHERE rename-type = "T"
                                AND new-name = ilin[5]
                                NO-ERROR.
        IF NOT AVAILABLE rename-obj THEN
          FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                    AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
        ELSE FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = rename-obj.old-name
                                       AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
        IF NOT AVAILABLE DICTDB._File THEN DO:
          MESSAGE "The Delta DF File contains DROP FIELD for table" ilin[5] SKIP
                  "and table does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
              VIEW-AS ALERT-BOX ERROR.
           RETURN.
        END.
        IF AVAILABLE DICTDB._File THEN DO:
          FIND FIRST rename-obj WHERE rename-type = "F"
                                  AND t-name = ilin[5]
                                  AND new-name = ilin[3]
                                  NO-ERROR.
          IF AVAILABLE rename-obj THEN
            FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = old-name NO-ERROR.
          ELSE
            FIND DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-name = ilin[3] NO-ERROR.
            
          IF NOT AVAILABLE DICTDB._Field THEN DO:
            MESSAGE "The Delta DF File contains DROP FIELD" ilin[3] "for table" SKIP
                     ilin[5] "and field does not exist in the schema holder." SKIP
                     "This process is being aborted."  SKIP (1)
                VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.

          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line =  ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                            ilin[4] + ' "' + ilin[5] + '"'.
       
          ASSIGN dropped-fld = TRUE.

          IF AVAILABLE DICTDB._Field THEN DO:
            IF DICTDB._Field._Extent = 0 THEN DO:
              PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-name + 
                                 " DROP COLUMN " + DICTDB._Field._For-name + ";" SKIP.     
              CREATE drop-field.
              ASSIGN f-name = ilin[3]
                     of-table = ilin[5]
                     dropped-fld = TRUE.
              
              FIND FIRST rename-obj WHERE rename-type = "F"
                                      AND t-name = ilin[5]
                                      AND new-name = ilin[3]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN
                ASSIGN drop-f-name = old-name.
              ELSE                       
                ASSIGN drop-f-name = ilin[3].
            END.
            ELSE DO u = 1 TO DICTDB._Field._Extent:
              PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " + DICTDB._File._For-name + 
                                 " DROP COLUMN " + DICTDB._Field._For-name + "##" + string(u) + ";" SKIP.  
              IF u = 1 THEN DO:
                CREATE drop-field.
                ASSIGN f-name = ilin[3]
                       of-table = ilin[5]
                       dropped-fld = TRUE.

                FIND FIRST rename-obj WHERE rename-type = "F"
                                        AND t-name = ilin[5]
                                        AND new-name = ilin[3]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN
                  ASSIGN drop-f-name = old-name.
                ELSE                       
                  ASSIGN drop-f-name = ilin[3].
              END.
            END.
            PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.                   
          END.
        END. /* End of IF AVAILABLE _File */          
        ASSIGN ilin = ?.
      END. /* End delete field */ 
                
      /* Rename field in schema holder only */          
      ELSE IF imod = "r" THEN DO:
        IF tablename <> ? AND tablename <> ilin[5] THEN 
          RUN write-tbl-sql.
                            
        IF idxline <> ? THEN 
          RUN write-idx-sql.
        
        IF seq-line <> ? THEN
          RUN write-seq-sql.
       
        IF conline <> ? THEN
          RUN write-con-sql.
          
        IF tablename <> ilin[5] THEN
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE
                 unsptdt = FALSE.

        IF tablename <> ? THEN
          DISPLAY tablename WITH FRAME working.
       
        FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.       
        IF AVAILABLE DICTDB._File THEN DO:
          FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                             NO-ERROR.
          IF AVAILABLE DICTDB._Field THEN DO:                                   
            CREATE rename-obj.
            ASSIGN rename-type = "F"
                   t-name = ilin[5]
                   old-name = ilin[3]
                   new-name = ilin[7]
                   dsv-name = DICTDB._Field._For-name.
          END.
          ELSE DO:
            FIND rename-obj WHERE rename-type = "F"
                              AND t-name = ilin[5]
                              AND new-name = ilin[3]
                              NO-ERROR.
            IF AVAILABLE rename-obj THEN 
              ASSIGN new-name = ilin[7].         
          END.
        END.    
        ELSE DO:       
          _rename-loop:
          FOR EACH rename-obj WHERE rename-type = "T"
                                AND new-name = ilin[5]:
          
            FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
            IF AVAILABLE DICTDB._File THEN 
              LEAVE _rename-loop.
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
             MESSAGE "The Delta DF File contains RENAME FIELD for table" ilin[5] SKIP
                     "and table does not exist in the schema holder." SKIP
                     "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
             RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN DO:               
            FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                             NO-ERROR.
            IF AVAILABLE DICTDB._Field THEN DO:                                   
              CREATE rename-obj.
              ASSIGN rename-type = "F"
                     t-name = ilin[5]
                     old-name = ilin[3]
                     new-name = ilin[7]
                     dsv-name = DICTDB._Field._For-name.                  
            END.
            ELSE DO:
              FIND rename-obj WHERE rename-type = "F"
                                AND t-name = tablename
                                AND new-name = ilin[3]
                                  NO-ERROR.
              IF NOT AVAILABLE rename-obj THEN DO:           
                FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = old-name
                                               NO-ERROR.
                IF NOT AVAILABLE DICTDB._Field THEN DO:
                  MESSAGE "The Delta DF File contains RENAME FIELD" ilin[3] "for table" ilin[5] SKIP
                          "and field does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
                  RETURN.
                END.
                IF AVAILABLE DICTDB._Field THEN DO:
                  CREATE rename-obj.                                                   
                  ASSIGN rename-type = "F"
                         t-name = tablename
                         old-name = DICTDB._Field._Field-name
                         new-name = ilin[7]
                         dsv-name = DICTDB._Field._For-name.
                END.
              END.
            END.
          END.
        END.
        IF ilin[1] <> ? THEN do:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                           ilin[4] + ' "' + ilin[5] + '" ' + ilin[6] + ' "' + ilin[7] + '"'.
        END.  
        ASSIGN ilin = ?.             
      END.
      
      /* Add field */            
      ELSE IF imod = "a" THEN DO:
        IF ilin[1] = "ADD" AND ilin[2] = "FIELD" THEN DO:  
          ASSIGN iExtents = 0
                  cfldwidth = "".
          /* Verify we are working the same table */
          IF tablename <> ? AND tablename <> ilin[5] THEN 
            RUN write-tbl-sql.                        

          IF idxline <> ? THEN 
            RUN write-idx-sql.
          
          IF seq-line <> ? THEN
            RUN write-seq-sql.
       
          IF conline <> ? THEN
            RUN write-con-sql.
          
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE
                   unsptdt = FALSE.

          IF tablename <> ? THEN       
            DISPLAY tablename WITH FRAME WORKING.                       
 
          FIND drop-field WHERE f-name = ilin[3]
                            AND of-table = ilin[5]
                            NO-ERROR.
          IF AVAILABLE drop-field THEN DO: /* adding field which we dropped from schema holder */
            FIND FIRST rename-obj WHERE rename-type = "F"
                                    AND t-name = ilin[5]
                                    AND new-name = ilin[3]
                                    NO-ERROR.
            IF NOT AVAILABLE rename-obj THEN                         
              ASSIGN fieldname = "a##" + SUBSTRING(ilin[3], 1, (INTEGER(user_env[29]) - 3)).   
            ELSE
              ASSIGN fieldname = ilin[3].
          END.           
          ELSE IF NOT AVAILABLE drop-field THEN DO:
            FIND rename-obj WHERE rename-type = "F"
                              AND new-name = ilin[3]
                              AND t-name = ilin[5]
                              NO-ERROR.
            IF AVAILABLE rename-obj THEN 
              ASSIGN fieldname = "a##" + SUBSTRING(ilin[3], 1, (INTEGER(user_env[29]) - 3)).             
            ELSE DO:
              ASSIGN fieldname = ilin[3].

              /* if not a dropped or renamed field, check if it's not a field name that
                 already exists in the schema.
              */
              FIND FIRST DICTDB._File WHERE DICTDB._File._file-name = tablename NO-ERROR.
              IF AVAILABLE DICTDB._File THEN DO:
                 FIND FIRST DICTDB._Field OF DICTDB._File WHERE _Field-Name = fieldname NO-ERROR.
                 IF AVAILABLE DICTDB._Field THEN DO:
                     MESSAGE "The Delta DF File contains ADD FIELD" ilin[3] "for table" tablename SKIP
                             "and field already exists in the schema holder." SKIP
                             "This process is being aborted."  SKIP (1)
                     VIEW-AS ALERT-BOX ERROR.
                     RETURN.
                 END.
              END.
            END.
          END.
        
          IF xlate THEN DO:           
            IF LENGTH(fieldname) > INTEGER(user_env[29]) THEN DO: 
              IF fieldname BEGINS "a##" THEN                   
                ASSIGN fieldname = SUBSTRING(fieldname, 4, (INTEGER(user_env[29]) - 3)) + "," + idbtyp + "," + user_env[29]
                       dupfield = TRUE.
              ELSE
                ASSIGN fieldname = SUBSTRING(fieldname, 1, (INTEGER(user_env[29]))) + "," + idbtyp + "," + user_env[29]
                       dupfield = FALSE.
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT fieldname).
              IF dupfield THEN
                ASSIGN fieldname = "A##" + fieldname
                       dupfield = FALSE.
            END.
            ELSE DO:  
              IF fieldname BEGINS "a##" THEN
                ASSIGN fieldname = SUBSTRING(fieldname,4) + "," + idbtyp + "," + user_env[29]
                       dupfield = TRUE.
              ELSE 
                ASSIGN fieldname = fieldname + "," + idbtyp + "," + user_env[29]
                       dupfield = FALSE.
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT fieldname).
              IF dupfield THEN
                ASSIGN fieldname = "A##" + fieldname
                       dupfield = FALSE.
            END.
          END.   
                                           
           _verify-field:
          DO WHILE TRUE:

            FIND FIRST rename-obj WHERE rename-type =  "F"     AND
                                        t-name      =  ilin[5] AND
                                        old-name    =  ilin[3] AND
                                        new-name    <> ilin[3] NO-ERROR.
            FIND FIRST verify-field WHERE verify-field.f-table = tablename
                                      AND verify-field.fnew-name = fieldname NO-ERROR.
            FIND FIRST DICTDB._File WHERE DICTDB._File._file-name = tablename NO-ERROR.
            IF AVAILABLE DICTDB._File THEN
                FIND FIRST DICTDB._Field WHERE DICTDB._Field._File-recid = RECID(DICTDB._File)
                                           AND DICTDB._Field._For-name = fieldname NO-ERROR.
            IF (AVAILABLE verify-field OR 
                AVAILABLE DICTDB._Field) AND 
               NOT AVAILABLE rename-obj THEN DO:
              DO a = 1 TO 999:
                IF a = 1 THEN
                  ASSIGN fieldname = fieldname + STRING(a).
                ELSE
                  ASSIGN fieldname = SUBSTRING(fieldname, 1, LENGTH(fieldname) - LENGTH(STRING(a))) + STRING(a). 
                IF CAN-FIND(FIRST DICTDB._Field WHERE DICTDB._Field._File-recid = RECID(DICTDB._File)
                                                  AND DICTDB._Field._For-name = fieldname) THEN NEXT.
                ELSE IF CAN-FIND(FIRST verify-field WHERE verify-field.f-table = tablename
                                                      AND verify-field.fnew-name = fieldname) THEN NEXT.
                ELSE DO:
                  CREATE verify-field.
                  ASSIGN verify-field.f-table = tablename
                         verify-field.fnew-name = fieldname.
                  LEAVE _verify-field.
                END.
              END.
            END.                
            ELSE DO:
              CREATE verify-field.
              ASSIGN verify-field.f-table = tablename
                     verify-field.fnew-name = fieldname.
              LEAVE _verify-field.
            END.
          END.



          ASSIGN fieldtype = ilin[7].
     
          IF NOT addtable THEN DO: 
            IF NOT alt-table THEN DO:                                                
              FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
              IF AVAILABLE DICTDB._File THEN DO: 
              
                IF LENGTH(DICTDB._File._For-name) > 4 THEN DO:
                  IF SUBSTRING(DICTDB._File._For-name, (LENGTH(DICTDB._File._For-name) - 4)) <> "_V##" THEN
                    ASSIGN forname = DICTDB._File._For-name.                  
                  ELSE DO:
                    IF DICTDB._File._Fil-misc2[7] <> ? AND DICTDB._File._Fil-misc2[7] <> "" THEN
                      ASSIGN forname = DICTDB._File._Fil-misc2[7].
                    ELSE
                      ASSIGN forname = SUBSTRING(DICTDB._File._For-name, 1, (LENGTH(DICTDB._File._For-name) -  4)).                                                             
                    ASSIGN view-created = TRUE. 
                  END.
                END.
                ELSE
                  ASSIGN forname = DICTDB._File._For-name.

                CREATE alt-info.
                ASSIGN lnum = 1
                       a-line-num = lnum
                       a-line = "ALTER TABLE " + forname 
                       a-tblname = ilin[5]
                       a-fldname = fieldname.                       
              END.
          
              ELSE IF NOT AVAILABLE DICTDB._File THEN DO:
                FIND rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5] NO-ERROR.


                IF AVAILABLE rename-obj THEN DO:
                  ASSIGN forname = dsv-name
                         fieldtype = ilin[7].
                  CREATE alt-info.
                  ASSIGN lnum = 1
                         a-line-num = lnum
                         a-line = "ALTER TABLE " + forname 
                         a-tblname = ilin[5]
                         a-fldname = fieldname.
                  FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
                  IF NOT AVAILABLE DICTDB._File THEN DO:
                    MESSAGE "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                            "and table does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                    RETURN.
                  END. 
                  IF AVAILABLE DICTDB._File AND LENGTH(DICTDB._File._For-name) > 4 AND 
                    SUBSTRING(DICTDB._File._For-name, (LENGTH(DICTDB._File._For-name) - 4)) = "_V##" THEN
                      ASSIGN view-created = TRUE.
                END.
                ELSE DO:
                  MESSAGE "The Delta DF File contains ADD FIELD for table" ilin[5] SKIP
                          "and table does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                  RETURN.
                END.
              END.
              ASSIGN alt-table = TRUE.
            END.
          END.          
          RUN create-new-obj (INPUT "F", INPUT ?).          
          ASSIGN fldnum = fldnum + 1.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                           ilin[4] + ' "' + ilin[5] + '" ' + ilin[6] + ' ' + ilin[7].
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-info.df-fld = fieldname
                 df-line = '  FOREIGN-NAME "' + CAPS(fieldname) + '"'. 

        END. /* End first line of add field */                      
        ELSE DO:
          CASE ilin[1]:
            WHEN "FORMAT" THEN DO:
              FIND new-obj WHERE new-obj.add-type = "F"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.fld-name = fieldname
                             NO-LOCK NO-ERROR. 
                              
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname.

              IF sqlwidth AND (new-obj.for-type = " VARCHAR2" OR new-obj.for-type = " NVARCHAR2") THEN
                ASSIGN df-line = "  " + ilin[1] + ' "'.
              ELSE
                ASSIGN df-line = "  " + ilin[1] + ' "' + ilin[2] + '"'.

              IF available new-obj THEN DO:
                IF alt-table THEN DO:
                  CREATE alt-info.
                  ASSIGN lnum = lnum + 1
                         a-line-num = lnum
                         a-tblname = tablename
                         a-fldname = fieldname.
                END.
                ELSE DO:         
                  CREATE sql-info.
                  ASSIGN lnum = lnum + 1
                         line-num = lnum
                         tblname = tablename
                         fldname = fieldname.
                         
                END.
              END.         

              IF fieldtype = "character" THEN DO:
                ASSIGN nbrchar = 0 
                       lngth = LENGTH(ilin[2], "character").  
                IF INDEX(ilin[2], "(") > 1 THEN DO:
                  ASSIGN left_paren = INDEX(ilin[2], "(")
                         right_paren = INDEX(ilin[2], ")")
                         lngth = right_paren - (left_paren + 1)        
                         j = INTEGER(SUBSTRING(ilin[2], left_paren + 1, lngth)).  
                  /* user can turn off the x(8) override */
                  IF j = 8 AND sqlwidth = FALSE THEN j = minwidth.
                END.  
                ELSE DO:           
                  DO z = 1 to lngth:        
                    IF SUBSTRING(ilin[2],z,1) = "9" OR
                       SUBSTRING(ilin[2],z,1) = "N" OR   
                       SUBSTRING(ilin[2],z,1) = "A" OR    
                       SUBSTRING(ilin[2],z,1) = "x" OR
                       SUBSTRING(ilin[2],z,1) = "!"   THEN
                         ASSIGN nbrchar = nbrchar + 1.
                  END.         
                  IF nbrchar > 0 THEN
                    ASSIGN j = nbrchar.
                  ELSE
                    ASSIGN j = lngth.   
                  /* user can turn off the x(8) override */
                  IF j = 8 AND sqlwidth = FALSE THEN j = minwidth.
                END.       
                IF ora_version > 7 THEN DO: 
                  IF j <= longwid  THEN DO:              
                    IF AVAILABLE new-obj THEN
                      ASSIGN new-obj.for-type = /*" VARCHAR2 ("*/ " " + user_env[11] + "(" + STRING(j) + ")" 
                             dffortype = user_env[11] /*"VARCHAR2"*/
                             dfforitype = "1".
                  END.
                  ELSE  /* > longwid  */                     
                    IF AVAILABLE new-obj THEN DO:
                      ASSIGN new-obj.for-type = " " +  longType /*" LONG"*/
                             dffortype = longType /*"LONG"*/
                             .
                      IF longType = "LONG" THEN
                          ASSIGN dfforitype = "8".
                      ELSE /* whether clob or nclob, this is code 112 */
                          ASSIGN dfforitype = "112".
                    END.
                END.
                ELSE DO: /* Not V8 */
                  IF j < 2001 THEN DO:
                    IF AVAILABLE new-obj THEN
                       ASSIGN new-obj.for-type = " VARCHAR2 (" + STRING(j) + ")" 
                              dffortype = "VARCHAR2"
                              dfforitype = "1".                                                                   
                  END.
                  ELSE 
                    IF AVAILABLE new-obj THEN
                      ASSIGN new-obj.for-type = " LONG"
                             dffortype = "LONG"
                             dfforitype = "8".
                END.
                ASSIGN lngth = j.   
              END. /* Character datatype */
              ELSE IF fieldtype = "blob" THEN DO:
                IF AVAILABLE new-obj THEN DO:
                  ASSIGN new-obj.for-type = " BLOB "
                         lngth = 4000
                         dffortype = "BLOB"
                         dfforitype = "113".
                  IF NOT alt-table THEN
                    ASSIGN new-obj.for-type = new-obj.for-type + "NOT NULL".
                END.
              END.
              ELSE IF fieldtype = "integer" OR fieldtype = "int64" THEN DO: 
                IF AVAILABLE new-obj THEN
                  ASSIGN new-obj.for-type = " NUMBER"
                         dffortype = "NUMBER"
                         dfforitype = "2"
                         lngth = 22.                                                            
              END.
              ELSE IF fieldtype = "decimal" THEN DO:                    
                ASSIGN lngth = LENGTH(ilin[2], "character")
                       all_digits = 0
                       dec_point = 0.
                     /* First, count all the digits in the format. */
                DO pos = 1 to lngth:
                  if (SUBSTRING(ilin[2], pos, 1) = ">") OR 
                     (SUBSTRING(ilin[2], pos, 1) = "<") OR  
                     (SUBSTRING(ilin[2], pos, 1) = "*") OR  
                     (SUBSTRING(ilin[2], pos, 1) = "z") OR 
                     (SUBSTRING(ilin[2], pos, 1) = "Z") OR
                     (SUBSTRING(ilin[2], pos, 1) = "9") THEN
                         ASSIGN all_digits = all_digits + 1.   
                  ELSE IF (SUBSTRING(ilin[2],pos,1)) = "."  THEN
                      ASSIGN dec_point = all_digits + 1.            
                END.
                IF AVAILABLE new-obj THEN DO:
                  IF dec_point > 0 THEN
                    ASSIGN new-obj.for-type = " NUMBER (" + string(all_digits) + "," +
                                    string(all_digits - dec_point + 1) + ")".
                  ELSE
                    ASSIGN new-obj.for-type = " NUMBER (" + string(all_digits) + ",0)".

                  ASSIGN dffortype = "NUMBER"
                         dfforitype = "2"
                         lngth = 22
                         dec_point = (IF dec_point > 0 THEN all_digits - (dec_point - 1)
                                      ELSE 0) .
                END.
              END.
              ELSE if fieldtype = "date" AND AVAILABLE new-obj THEN
                ASSIGN new-obj.for-type = " DATE"
                       dffortype = "DATE"
                       dfforitype = "12"
                       lngth     = 7. 
              ELSE if fieldtype = "datetime" AND AVAILABLE new-obj THEN
                ASSIGN new-obj.for-type = " TIMESTAMP"
                       dffortype = "TIMESTAMP"
                       dfforitype = "180"
                       lngth     = 11.
              ELSE if fieldtype = "datetime-tz" AND AVAILABLE new-obj THEN
                ASSIGN new-obj.for-type = " TIMESTAMP WITH TIME ZONE"
                       dffortype = "TIMESTAMP_TZ"
                       dfforitype = "181"
                       lngth     = 13.
              ELSE IF fieldtype = "logical" AND AVAILABLE new-obj THEN
                ASSIGN new-obj.for-type = " NUMBER"
                       dffortype = "NUMBER"
                       dfforitype = "2"
                       lngth = 22.
              ELSE IF fieldtype = "Recid" AND AVAILABLE new-obj THEN
                ASSIGN new-obj.for-type = " NUMBER"
                       dffortype = "NUMBER"
                       dfforitype = "2"
                       lngth = 22. 
              ELSE IF fieldtype = "Raw" AND AVAILABLE new-obj THEN
                  ASSIGN new-obj.for-type = " LONG RAW"
                       dffortype = "LONGRAW"
                       dfforitype = "24".
              ELSE IF fieldtype = "Clob"  THEN DO:
              
                  ASSIGN new-obj.for-type = (IF longType = "NCLOB" THEN " NCLOB" ELSE " CLOB")
                         lngth = 4000
                         dffortype = (IF longType = "NCLOB" THEN "NCLOB" ELSE "CLOB")
                         dfforitype = "112".
                  IF NOT alt-table THEN
                    ASSIGN new-obj.for-type = new-obj.for-type + " NOT NULL".
              END.
              ELSE IF AVAILABLE new-obj AND (new-obj.for-type = "" OR new-obj.for-type = ?) THEN
                ASSIGN new-obj.for-type = " UNSUPPORTED" .

              IF AVAILABLE sql-info THEN 
                ASSIGN line = fieldname + new-obj.for-type.                        
              ELSE IF AVAILABLE alt-info THEN DO:              
                ASSIGN a-line = "ADD " + fieldname + new-obj.for-type. 
                RUN get-position.
              END.    
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line = '  FOREIGN-TYPE "' + dffortype + '"'.

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line = '  FOREIGN-CODE ' + dfforitype.
              
              IF all_digits <> 0 THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = "  DSRVR-PRECISION " + STRING(all_digits).
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-info.df-fld = fieldname
                       df-line = "  FIELD-MISC12 " + STRING(dec_point).
              END.
                
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line = "  FIELD-MISC13 " + STRING(lngth).
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line = "  FIELD-MISC14 1".   
              /* we don't set this for long raw */
              IF  dffortype <> "LONGRAW" THEN DO:              
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  FOREIGN-MAXIMUM " + string(lngth).
              END.

              /* field-misc25 needs to be updated for unicode data types */
              IF CAN-DO("NVARCHAR2,NCLOB",dffortype) THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  FIELD-MISC25 1".
              END.

              IF fieldtype = "Clob" THEN DO: /* TEMPORARY */
                  FIND FIRST DICTDB._Db WHERE DICTDB._Db._Db-type = "ORACLE".

                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = '  CLOB-CODEPAGE "' + DICTDB._Db._Db-xl-name + '"'. 

                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = '  CLOB-COLLATION "' 
                                + (IF DICTDB._Db._Db-coll-name = ? 
                                      THEN "basic" ELSE DICTDB._Db._Db-coll-name) + '"'.

                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line = "  CLOB-TYPE 1". /* using db codepage */
              END.

              ASSIGN all_digits = 0
                     dec_point  = 0.            
            END. /* WHEN FORMAT */                           
            WHEN "QUOTED-NAME"     OR WHEN "FIELD-MISC21"  OR WHEN "FIELD-MISC23"    OR 
            WHEN "FIELD-MISC24"    OR WHEN "FIELD-MISC25"  OR WHEN "FIELD-MISC26"    OR 
            WHEN "FIELD-MISC27"    OR WHEN "FIELD-MISC28"  OR WHEN "MISC-PROPERTIES" OR 
            WHEN "SHADOW-NAME"     OR WHEN "DESC"          OR WHEN "DESCRIPTION"     OR 
            WHEN "CAN-READ"        OR WHEN "CAN-SELECT"    OR WHEN "CAN-WRITE"       OR 
            WHEN "CAN-UPDATE"      OR WHEN "NULL"          OR WHEN "FORMAT-SA"       OR 
            WHEN "LABEL"           OR WHEN "LABEL-SA"      OR WHEN "COLUMN-LABEL"    OR 
            WHEN "COLUMN-LABEL-SA" OR WHEN "INITIAL-SA"    OR WHEN "VALEXP"          OR 
            WHEN "VALMSG"          OR WHEN "VALMSG-SA"     OR WHEN "VIEW-AS"         OR 
            WHEN "HELP"            OR WHEN "HELP-SA"       THEN DO:                                                                
              IF ilin[2] <> "" AND ilin[2] <> ? THEN DO:
                RUN dctquot (ilin[2], '"',OUTPUT oq-string).
                IF LENGTH(oq-string) > 0 THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " " + oq-string.
                END.
              END.
            END.
            WHEN "INITIAL" THEN DO:
              FIND new-obj WHERE new-obj.add-type = "F"
                             AND new-obj.tbl-name = tablename
                             AND new-obj.fld-name = fieldname
                             NO-LOCK NO-ERROR. 
                               
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename.
              IF ilin[2] <> ? THEN
                ASSIGN df-line = "  " + ilin[1] + '  "' + ilin[2] + '"'.
              ELSE
                ASSIGN df-line = "  " + ilin[1] + " ?".
              IF crtdefault THEN  DO:
                IF AVAILABLE new-obj THEN DO: 
                  IF blankdefault AND (new-obj.For-type BEGINS " VARCHAR2" OR new-obj.For-type BEGINS " NVARCHAR2") AND
                  (ilin[2] = "" OR ilin[2] = ? OR ilin[2] = "?") THEN DO:
                    ASSIGN for-init = " DEFAULT ' '".

                    IF AVAILABLE sql-info THEN 
                      ASSIGN LINE = LINE + for-init.
                    ELSE IF AVAILABLE alt-info THEN 
                      ASSIGN a-line = a-line + for-init. 
                  END.
                END.
                IF available new-obj AND ilin[2] <> "" AND ilin[2] <> ? AND ilin[2] <> "?" THEN DO:
                  IF alt-table THEN DO:   
                    IF AVAILABLE alt-info THEN DO: 
                      IF a-tblname <> tablename AND
                         a-fldname <> fieldname THEN                  
                      FIND alt-info WHERE a-tblname = tablename
                                      AND a-fldname = fieldname
                                      NO-ERROR.
                    END.
                    ELSE 
                      FIND alt-info WHERE a-tblname = tablename
                                      AND a-fldname = fieldname
                                      NO-ERROR.
                  END.
                  ELSE          
                    FIND sql-info WHERE tblname = tablename
                                    AND fldname = fieldname
                                    NO-ERROR.
 
                  ASSIGN for-init = "".
                   /* Character */ 
                  IF new-obj.for-type BEGINS " VARCHAR2" OR new-obj.for-type BEGINS " NVARCHAR2" THEN 
                    ASSIGN for-init = " DEFAULT '" + ilin[2] + "'".                                
                  ELSE IF new-obj.for-type BEGINS " NUMBER" THEN DO:  
                    /* logical no or false */
                    IF ilin[2] BEGINS "N" OR ilin[2] BEGINS "F" THEN
                      ASSIGN for-init = " DEFAULT 0 ".
                    /* logical yes or true */
                    ELSE IF ilin[2] BEGINS "Y" OR ilin[2] BEGINS "T" THEN
                      ASSIGN for-init = " DEFAULT 1 ".
                    /* integer */
                    ELSE IF INDEX(ilin[2], ",") = 0 AND LOOKUP(substring(ilin[2], 1,1), "1,2,3,4,5,6,7,8,9,0") <> 0 THEN
                       ASSIGN for-init = " DEFAULT " + ilin[2].
                    /* decimal, remove formatting */
                    ELSE IF INDEX(ilin[2], ",") > 0 THEN DO:
                      ASSIGN for-init = ilin[2].
                      DO k = 1 TO LENGTH(ilin[2]):
                        IF INDEX(for-init, ",") > 0 THEN
                          ASSIGN for-init = SUBSTRING(for-init, 1, (INDEX(for-init, ",") - 1)) +  
                                            SUBSTRING(for-init, (INDEX(for-init, ",") + 1)).
                        ELSE
                          ASSIGN k = LENGTH(ilin[2]).
                      END.
                      ASSIGN for-init = " DEFAULT " + for-init.
                    END.                    
                  END.
                  /* date */
                  ELSE IF new-obj.for-type BEGINS " DATE" THEN DO:
                    IF UPPER(ilin[2]) = "TODAY" THEN 
                      ASSIGN for-init = " DEFAULT SYSDATE".                   
                  END.  
                  ELSE IF new-obj.for-type BEGINS " TIMESTAMP" THEN DO:
                    IF UPPER(ilin[2]) = "NOW" THEN 
                      ASSIGN for-init = " DEFAULT SYSDATE".                   
                  END.  
                  IF AVAILABLE sql-info THEN 
                    ASSIGN LINE = LINE + for-init.
                  ELSE IF AVAILABLE alt-info THEN 
                    ASSIGN a-line = a-line + for-init. 
                END.
              END.
            END.
            WHEN "EXTENT"  THEN DO:
              IF ilin[2] <> "0" THEN DO:
                iExtents = INTEGER(ilin[2]).
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " "  + ilin[2].
             
                FIND FIRST sql-info WHERE tblname = tablename
                                      AND fldname = fieldname 
                                      AND line-num > 1 
                                      AND line <> "" NO-ERROR.
                IF AVAILABLE sql-info THEN DO:    
                          
                  /* 20040603-016
                     if the user wants to use SqlWidth, we need to calculate the size of the each
                     field in the foreign db based on the number of extents, or if the sql-width
                     value is too big, we will create the columns as LONG, and since a table
                     in ORACLE can only have one LONG column, this table will be commented out.
                     To figure out the size of the each extent, we divide the sql-width value
                     and subtract the number of extents and subtract 2.
                     size = (sqlwidth / num_of_extents) - 2
                  */
                  IF sqlwidth THEN 
                     RUN process-extents-with-fldwidth (INPUT 1).

                  IF (LENGTH(fieldname) + length(ilin[2]) + 2) < integer(user_env[29]) THEN DO:
                
                    ASSIGN endline = SUBSTRING(line,(length(fieldname)+ 1))
                           line = SUBSTRING(line, 1, length(fieldname)) +
                                     "##1" + endline.

                    FIND new-obj WHERE new-obj.add-type = "F"
                                   AND new-obj.tbl-name = tablename
                                   AND new-obj.fld-name = fieldname
                                   NO-ERROR.
                    IF AVAILABLE new-obj THEN
                      ASSIGN new-obj.for-name = new-obj.for-name + "##1"
                             fortype = new-obj.for-type.   

                    /* assign the same value to all extents */
                    ASSIGN lMandatory = sql-info.fldmand.

                    DO i = 2 TO INTEGER(ilin[2]):
                      CREATE sql-info.
                      ASSIGN lnum = lnum + 1
                             line-num = lnum
                             tblname = tablename
                             fldname = fieldname
                             line = fieldname + "##" + STRING(i) +  endline
                             sql-info.fldmand = lMandatory.  
                                                              
                      RUN create-new-obj (INPUT "F", INPUT STRING(i)).                                                     
                    END.
                  END.
                  ELSE DO:
                    ASSIGN forname = substring(line,1,(INTEGER(user_env[29]) - length(ilin[2]) - 2 )) + "##"
                           endline = SUBSTRING(line,(length(fieldname) + 1))
                           line = forname + "1 " + endline.
                    
                    FIND new-obj WHERE new-obj.add-type = "F"
                                   AND new-obj.tbl-name = tablename
                                   AND new-obj.fld-name = fieldname
                                   NO-ERROR.
                    IF AVAILABLE new-obj THEN
                      ASSIGN new-obj.for-name = forname + "1"
                             fortype = new-obj.for-type.                
                                                                                                   
                    DO i = 2 TO INTEGER(ilin[2]):
                      CREATE sql-info.
                      ASSIGN lnum = lnum + 1
                             line-num = lnum
                             tblname = tablename
                             fldname = fieldname
                             line = forname + STRING(i) + endline.   
                                       
                      RUN create-new-obj (INPUT "F", INPUT STRING(i)).                                         
                    END.

                    /*  20040603-016
                        now need to fix FOREIGN-NAME since we did not account the ## when we genereated it */
                    FIND df-info WHERE df-info.df-tbl = tablename
                                   AND df-info.df-fld = fieldname
                                   AND df-info.df-line BEGINS "  FOREIGN-NAME".
                    ASSIGN df-info.df-line = '  FOREIGN-NAME "' + CAPS(SUBSTRING(forname,1,LENGTH(forname) - 2)) + '"'.
                  END.
                END.
                ELSE DO:
                  FIND FIRST alt-info WHERE a-tblname = tablename
                                        AND a-fldname = fieldname 
                                        AND a-line-num > 1 
                                        AND a-line <> "" NO-ERROR.
                  IF AVAILABLE alt-info THEN DO:  

                    /* 20040603-016
                         if the user wants to use SqlWidth, we need to calculate the size of the each
                         field in the foreign db based on the number of extents, or if the sql-width
                         value is too big, we will create the columns as LONG, and since a table
                         in ORACLE can only have one LONG column, this table will be commented out.
                         To figure out the size of the each extent, we divide the sql-width value
                         by the number of extents and subtract 2.
                         size = (sqlwidth / num_of_extents) - 2
                    */
                    IF sqlwidth THEN
                       RUN process-extents-with-fldwidth (INPUT 2).

                    FIND new-obj WHERE new-obj.add-type = "F"
                                   AND new-obj.tbl-name = tablename
                                   AND new-obj.for-name = fieldname
                                   NO-ERROR.
                    IF AVAILABLE new-obj THEN
                        ASSIGN new-obj.for-name = new-obj.for-name + "##1"
                               fortype = new-obj.for-type.

                    IF (LENGTH(fieldname) + length(ilin[2]) + 2) < integer(user_env[29]) THEN DO:
               
                      ASSIGN endline = SUBSTRING(a-line,(length(fieldname)+ 5))
                             a-line = SUBSTRING(a-line, 1, length(fieldname) + 4) +
                                       "##1" + endline.                 
                 
                      /* assign the same value to all extents */
                      ASSIGN lMandatory = alt-info.fldmand.

                      DO i = 2 TO INTEGER(ilin[2]):
                        CREATE alt-info.
                        ASSIGN lnum = lnum + 1
                               a-line-num = lnum
                               a-tblname = tablename
                               a-fldname = fieldname
                               a-line = "ADD " + fieldname + "##" + STRING(i) +  endline
                               alt-info.fldmand = lMandatory. 
                    
                        RUN create-new-obj (INPUT "F", INPUT STRING(i)).                                                                                        
                      END.
                    END.
                    ELSE DO:                   
                      ASSIGN forname = TRIM(substring(a-line,4,(INTEGER(user_env[29]) - length(ilin[2]) - 2 ))) + "##"
                             endline = SUBSTRING(a-line,(length(fieldname) + 5))
                             a-line  = "ADD " + forname + "1 " + endline.
                  
                      DO i = 2 TO INTEGER(ilin[2]):
                        CREATE alt-info.
                        ASSIGN lnum = lnum + 1
                               a-line-num = lnum
                               a-tblname = tablename
                               a-fldname = fieldname
                               a-line = "ADD " + forname + STRING(i) + endline. 
                                            
                        RUN create-new-obj (INPUT "F", INPUT STRING(i)).   
                      END.

                      /* 20040603-016 
                         now need to fix FOREIGN-NAME since we did not account the ## when we genereated it */
                      FIND df-info WHERE df-info.df-tbl = tablename
                                     AND df-info.df-fld = fieldname
                                     AND df-info.df-line BEGINS "  FOREIGN-NAME".
                      ASSIGN df-info.df-line = '  FOREIGN-NAME "' + CAPS(SUBSTRING(forname,1,LENGTH(forname) - 2)) + '"'.

                    END.
                  END.
                END.
              END. 
            ASSIGN fortype = "".                
            END. /* WHEN EXTENT */
                 
            WHEN "ORDER"           OR WHEN "FIELD-MISC11"  OR WHEN "FIELD-MISC12"      OR 
            WHEN "FIELD-MISC13"    OR WHEN "FIELD-MISC14"  OR WHEN "FIELD-MISC15"      OR
            WHEN "FIELD-MISC16"    OR WHEN "FIELD-MISC17"  OR WHEN "FIELD-MISC18"      OR
            WHEN "DECIMALS"        OR WHEN "POSITION" THEN DO:
              IF ilin[2] <> ? THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " " + ilin[2].
              END.
            END.
            WHEN "LENGTH" THEN DO:
              IF ilin[2] <> "0" THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  "  " + ilin[1] + " " + ilin[2].
              END.
            END.
            WHEN "MANDATORY" OR WHEN "CASE-SENSITIVE" OR WHEN "NOT-CASE-SENSITIVE" OR
            WHEN "NULL-ALLOWED" THEN DO:

              IF ilin[1] = "MANDATORY" THEN DO:
                  /* assign it to all instances of this field (in case it's an extent */
                  FOR EACH sql-info WHERE tblname = tablename AND
                                          fldname = fieldname AND
                                          line-num > 1 AND
                                          line <> "":
                      ASSIGN sql-info.fldmand = YES.
                  END.

                 FOR EACH alt-info WHERE a-tblname = tablename AND
                                         a-fldname = fieldname AND
                                         a-line-num > 1 AND
                                         a-line <> "":
                     ASSIGN alt-info.fldmand = YES.
                 END.

              END. /* MANDATORY */

              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line =  "  " + ilin[1].
            END.                                          
            WHEN "FIELD-TRIGGER"  THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                               ilin[3] + " ". 
              IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].             
              IF ilin[5] <> ? THEN 
                ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.              
              IF ilin[6] <> ? THEN 
                ASSIGN df-line = df-line + ilin[6].             
              IF ilin[7] <> ? THEN
                ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
            END.
            WHEN "SQL-WIDTH" OR WHEN "MAX-WIDTH" THEN DO:
             
                IF sqlwidth THEN 
                 _sqlw:    
                DO:

                  FIND FIRST new-obj WHERE new-obj.add-type = "F" AND
                                           new-obj.tbl-name = tablename AND
                                           new-obj.fld-name = fieldname
                                     NO-LOCK NO-ERROR. 

                  IF new-obj.for-type = " UNSUPPORTED" THEN LEAVE _sqlw.

                  FIND df-info WHERE df-info.df-tbl = tablename
                               AND df-info.df-fld = fieldname
                               AND df-info.df-line BEGINS "  FORMAT" NO-ERROR.

                  /* this is used when processing EXTENTS */
                  ASSIGN cfldwidth = ilin[2] + ",".
                  IF AVAILABLE df-info THEN
                     ASSIGN cfldwidth = cfldwidth + string(df-info.df-seq).

                  IF fieldtype = "decimal" OR (NOT new-obj.for-type BEGINS " NUMBER" AND
                     new-obj.for-type <> " DATE" AND
                     NOT (new-obj.for-type BEGINS " TIMESTAMP") AND
                     new-obj.for-type <> " LONG" AND
                     new-obj.for-type <> " CLOB" AND
                     new-obj.for-type <> " NCLOB" ) THEN DO:

                    /* start with the fld width value */
                    ASSIGN iWidth = integer(ilin[2]).

                    /* figure out the size of each element if extents were specified */
                    /* also for decimals, the max size is 38 */
                    IF fieldtype = "decimal" THEN DO:

                       /* if extents was specified, take it into account */
                       IF iExtents > 0 THEN
                          /* do it just like we do upon migration */
                          ASSIGN iWidth = ((iWidth - (iExtents * 2)) / iExtents).

                       IF iWidth > 38 THEN
                          ASSIGN iWidth = 38.        
                    END.
                    ELSE IF iExtents > 0 
                         AND (new-obj.for-type BEGINS " VARCHAR2" OR new-obj.for-type BEGINS " NVARCHAR2")  THEN
                         ASSIGN iWidth = (iWidth / iExtents) - 2.

                    ASSIGN fsize = STRING(iWidth).

                    /* the bulk of the processing is in the internal procedure */
                    RUN process-fld-width.

                  END. /* if fieldtype */
                  ASSIGN extlinenum = ?
                         extline = "".
                END. /* _sqlw */
            END.
            END CASE.
        END. /* End subsequent lines of add field */       

        ASSIGN ilin = ?.
      END.
      ELSE DO:  /* imod = m */
        IF ilin[1] = "UPDATE" THEN DO:       
          IF tablename <> ? AND tablename <> ilin[5] THEN 
            RUN write-tbl-sql.               
          
          IF idxline <> ? THEN 
            RUN write-idx-sql.
 
          IF seq-line <> ? THEN
            RUN write-seq-sql.
       
          IF conline <> ? THEN
            RUN write-con-sql.
          
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE
                   unsptdt = FALSE
                   fieldtype = ?.

          IF fieldname <> ilin[3] THEN
            ASSIGN fieldname = ilin[3].

          FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.       
          IF AVAILABLE DICTDB._File THEN DO:
            FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                                     NO-ERROR.
            IF NOT AVAILABLE DICTDB._Field THEN DO:
              FIND rename-obj WHERE rename-type = "F"
                                AND t-name = ilin[5]
                                AND new-name = ilin[3]
                                  NO-ERROR.
              IF AVAILABLE rename-obj THEN 
                FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = old-name
                                               NO-ERROR.
              IF NOT AVAILABLE DICTDB._Field THEN DO:
                  /* check if it's a new field */
                  FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5]
                                     AND new-obj.add-type = "F" 
                                     AND new-obj.fld-name = ilin[3] NO-ERROR.
                  IF NOT AVAILABLE new-obj THEN DO:
                     MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                             "and field does not exist in the schema holder." SKIP
                             "This process is being aborted."  SKIP (1)
                     VIEW-AS ALERT-BOX ERROR.
                     RETURN.
                  END.
              END.
            END.
            IF AVAILABLE DICTDB._Field THEN
               ASSIGN fieldtype = DICTDB._Field._data-type.
          END.

          IF NOT AVAILABLE DICTDB._File THEN DO:
            _ren-loop:
            FOR EACH rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5]:
          
              FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR.
              IF AVAILABLE DICTDB._File THEN 
                LEAVE _ren-loop.
            END.
            IF NOT AVAILABLE DICTDB._File THEN DO:
              /* see if it's a new table */
              FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5] 
                                       AND new-obj.add-type = "T" NO-ERROR.
              IF NOT AVAILABLE new-obj THEN DO:
                 MESSAGE "The Delta DF File contains UPDATE FIELD for table" ilin[5] SKIP
                         "and table does not exist in the schema holder." SKIP
                         "This process is being aborted."  SKIP (1)
                      VIEW-AS ALERT-BOX ERROR.
                 RETURN.
              END.
              ELSE DO:
                 /* new table, make sure it's a new field too */
                 FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5]
                                    AND new-obj.add-type = "F" 
                                    AND new-obj.fld-name = ilin[3] NO-ERROR.
                 IF NOT AVAILABLE new-obj THEN DO:
                     MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                             "and field does not exist in the schema holder or in the .df." SKIP
                             "This process is being aborted."  SKIP (1)
                     VIEW-AS ALERT-BOX ERROR.
                     RETURN.
                 END.
             END.
            END.
            ELSE DO:
              FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = ilin[3]
                                                     NO-ERROR.
              IF NOT AVAILABLE DICTDB._Field THEN DO:
                FIND rename-obj WHERE rename-type = "F"
                                  AND t-name = ilin[5]
                                  AND new-name = ilin[3]
                                  NO-ERROR.
                IF AVAILABLE rename-obj THEN 
                  FIND DICTDB._Field OF DICTDB._FILE WHERE DICTDB._Field._Field-name = old-name
                                               NO-ERROR.
              END.
              IF NOT AVAILABLE DICTDB._Field THEN DO:
                  /* check if it's a new field */
                  FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[5]
                                     AND new-obj.add-type = "F" 
                                     AND new-obj.fld-name = ilin[3] NO-ERROR.
                  IF NOT AVAILABLE new-obj THEN DO:
                     MESSAGE "The Delta DF File contains UPDATE FIELD" ilin[3] "for table" ilin[5] SKIP
                             "and field does not exist in the schema holder." SKIP
                             "This process is being aborted."  SKIP (1)
                     VIEW-AS ALERT-BOX ERROR.
                     RETURN.
                  END.
              END.
            END.

            IF AVAILABLE DICTDB._Field THEN
               ASSIGN fieldtype = DICTDB._Field._data-type.
          END.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                  dfseq = dfseq + 1
                  df-info.df-tbl = tablename
                  df-info.df-fld = fieldname
                  df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                            ilin[4] + ' "' + ilin[5] + '"'.

          /* allow int->int64 type changes */
          IF ilin[6] = "AS" AND ilin[7] = "int64" THEN DO:
              df-line = df-line + " " + ilin[6] + " " + ilin[7].
          END.
        END.

        CASE ilin[1]:
          WHEN "FORMAT" THEN DO: /* skip changes in format because Oracle is already created */             
             /* if this is a logical field, we can change the format, since it won't
                mean a change in ORACLE - also, if the format has changed for a logical field,
                it means that the INITIAL may have also changed, in which case we will
                generate a bad .df - we will fail to load it if INITIAL has changed, but
                FORMAT hasn't changed.
             */
             IF fieldtype = "logical" THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-info.df-fld = fieldname
                         df-line =  "  " + ilin[1] + ' "' + ilin[2] + '"'.
             END.
             ELSE DO:
                 ASSIGN efile = tablename + ".e".
                 OUTPUT TO value(efile) APPEND.
                 PUT UNFORMATTED fieldname " in " tablename " had a change to FORMAT which was not passed to the" SKIP
                                "df file and no ALTER TABLE statement was created to change field size." SKIP(1).
                 OUTPUT CLOSE.
             END.
          END.
          WHEN "SQL-WIDTH" OR WHEN "MAX-WIDTH" THEN DO:
            IF sqlwidth THEN DO:
              ASSIGN efile = tablename + ".e".
              OUTPUT TO value(efile) APPEND.
              PUT UNFORMATTED fieldname " in " tablename " had a change to WIDTH which was not passed to the" SKIP
                              "df file and no ALTER TABLE statement was created to change field size." SKIP(1).
              OUTPUT CLOSE.
            END.
          END.
          WHEN "DESC"            OR WHEN "DESCRIPTION"      OR WHEN "CAN-READ"        OR 
          WHEN "CAN-SELECT"      OR WHEN "CAN-WRITE"        OR WHEN "CAN-UPDATE"      OR
          WHEN "FORMAT-SA"       OR WHEN "LABEL"            OR WHEN "LABEL-SA"        OR 
          WHEN "COLUMN-LABEL"    OR WHEN "COLUMN-LABEL-SA"  OR WHEN "INITIAL-SA"      OR 
          WHEN "VALEXP"          OR WHEN "VALMSG"           OR WHEN "VALMSG-SA"       OR 
          WHEN "VIEW-AS"         OR WHEN "HELP"             OR WHEN "HELP-SA"         OR
          WHEN "QUOTED-NAME"     OR WHEN "FIELD-MISC21"     OR WHEN "FIELD-MISC23"    OR            
          WHEN "FIELD-MISC24"    OR WHEN "FIELD-MISC25"     OR WHEN "FIELD-MISC26"    OR 
          WHEN "FIELD-MISC27"    OR WHEN "FIELD-MISC28"     OR WHEN "MISC-PROPERTIES" OR 
          WHEN "SHADOW-NAME"     OR WHEN "INITIAL" THEN DO:
            IF ilin[2] = ? THEN DO:
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-info.df-fld = fieldname
                     df-line =  "  " + ilin[1] + " ?".
            END.                                                                
            ELSE DO:
              RUN dctquot (ilin[2], '"',OUTPUT oq-string).
              IF LENGTH(oq-string) > 0 THEN DO:
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-info.df-fld = fieldname
                       df-line =  "  " + ilin[1] + " " + oq-string.
              END.       
            END.              
          END.
          
          WHEN "POSITION"     OR WHEN "LENGTH"       OR WHEN "SCALE"        OR
          WHEN "ORDER"        OR WHEN "FOREIGN-CODE" OR WHEN "FIELD-MISC11" OR 
          WHEN "FIELD-MISC12" OR WHEN "FIELD-MISC13" OR WHEN "FIELD-MISC14" OR 
          WHEN "FIELD-MISC15" OR WHEN "FIELD-MISC16" OR WHEN "FIELD-MISC17" OR 
          WHEN "FIELD-MISC18" THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-info.df-fld = fieldname
                   df-line =  "  " + ilin[1] + " " + ilin[2].
          END.
          WHEN "MANDATORY" THEN DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-info.df-fld = fieldname
                   df-line =  "  " + ilin[1].
          END.
          WHEN "FIELD-TRIGGER"  THEN  DO:
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-info.df-fld = fieldname
                   df-line =  "  " + ilin[1] +  ' "' + ilin[2] + '" ' + 
                              ilin[3] + " ". 
             IF ilin[4] <> ? THEN
                 ASSIGN df-line = df-line + ilin[4].
             
             IF ilin[5] <> ? THEN 
                 ASSIGN df-line = df-line + ' "' + ilin[5] + '" '.
             
             IF ilin[6] <> ? THEN 
                 ASSIGN df-line = df-line + ilin[6].
             
             IF ilin[7] <> ? THEN
                 ASSIGN df-line = df-line + ' "' + ilin[7] + '"'.
          END.
        END CASE.
        ASSIGN ilin = ?.
      END. /* end update */                    
    END. /* End of object = field */
    ELSE IF iobj = "i" THEN DO:  
      /* Drop an index */
      IF imod = "d" THEN DO:
        RUN write-tbl-sql.
  
        IF idxline <> ? THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
       
        IF conline <> ? THEN
          RUN write-con-sql.
          
        IF tablename <> ilin[5] THEN 
          ASSIGN tablename = ilin[5]
                 comment_chars = ""
                 comment-out = FALSE
                 unsptdt = FALSE.
       
 
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.                                  
        IF AVAILABLE DICTDB._File THEN DO:
          FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[3] NO-ERROR.
          IF AVAILABLE DICTDB._Index THEN DO:
            PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._Index._For-name user_env[5] SKIP.
            PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "DROP INDEX " + '"' + DICTDB._Index._Index-name +
                              '"' + " ON " + '"' + ilin[5] + '"'.           
          END.
          ELSE DO:
            FIND FIRST rename-obj WHERE rename-type = "I"
                                    and t-name = ilin[5]
                                    AND new-name = ilin[3]
                                    NO-ERROR.
            IF AVAILABLE rename-obj THEN DO:  
              IF new-name BEGINS "temp-we" THEN DO:              
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line =  ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                                  ilin[4] + ' "' + ilin[5] + '" '.
              END.
              ELSE DO:
                FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.

                IF AVAILABLE DICTDB._Index THEN DO:
                  /* Only put out the df info since if we renamed we have already dropped. */
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' + ilin[4] +
                                   ' "' + ilin[5] + '" '.
                END.
                IF NOT AVAILABLE DICTDB._Index THEN DO:
                  MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                       VIEW-AS ALERT-BOX ERROR.
                  RETURN.
                END.
              END.               
            END.
            ELSE DO:
              MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
              RETURN.
            END.
          END.
        END.
        ELSE DO:
          FIND FIRST rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5]
                                  NO-ERROR.
                                                                 
          IF AVAILABLE rename-obj THEN 
            FIND DICTDB._File WHERE DICTDB._File._File-name = old-name
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            MESSAGE "The Delta DF File contains DROP INDEX for table" ilin[5] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN DO:
            FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[3] NO-ERROR.
            IF AVAILABLE DICTDB._Index THEN DO:
              PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._Index._For-name user_env[5] SKIP.
              PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-info.df-tbl = tablename
                     df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' + ilin[4] +
                                 ' "' + ilin[5] + '" '.
            END.
            ELSE DO:
              FIND FIRST rename-obj WHERE rename-type = "I"
                                      and t-name = old-name
                                      AND new-name = ilin[3]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN DO:
                FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
                IF NOT AVAILABLE DICTDB._Index THEN DO:
                  MESSAGE "The Delta DF File contains DROP INDEX" ilin[3] "for table" ilin[5] SKIP
                          "and index does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                       VIEW-AS ALERT-BOX ERROR.
                  RETURN.
                END.
                IF AVAILABLE DICTDB._Index THEN DO:
                    /* only put to df because if we renamed first, we have dropped and added already in sql */
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                                   ilin[4] + ' "' + ilin[5] + '" '.
                END.
              END.
              ELSE DO:
                IF ilin[3] BEGINS "temp-we" THEN DO:
                  CREATE df-info.
                  ASSIGN df-info.df-seq = dfseq
                         dfseq = dfseq + 1
                         df-info.df-tbl = tablename
                         df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                                   ilin[4] + ' "' + ilin[5] + '" '.
                END.
              END.                  
            END.              
          END.  
        END.        
        ASSIGN ilin = ?.
      END. /* End delete index */                
      IF imod = "a" THEN DO:
        IF ilin[1] = "ADD" and ilin[2] = "INDEX" THEN DO:     
          RUN write-tbl-sql.
                                 
          IF idxline <> ? THEN 
            RUN write-idx-sql.
            
          IF seq-line <> ? THEN
            RUN write-seq-sql.
       
          IF conline <> ? THEN
            RUN write-con-sql.
          
          ASSIGN wordidx = FALSE
                 wordfile = ?
                 is-unique = FALSE
                 longIndex = FALSE
                 /* remember the first one */
                 index_df_start = dfseq.

          /* remember current position in the tosql stream. If shadowcol is on, and we detect an index
             with a character component that translates to a long/clob column, than we will need to skip
             the index and remove any shadow column from the .sql file for that index, if one exists.
             so remember the position in the stream, so we can go back if needed.
          */
          IF shadowcol THEN
              ASSIGN index_sql_start = SEEK(tosql).

          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE
                   unsptdt = FALSE.

          ASSIGN transname = ilin[3]
                 idxname   = ilin[3].
          IF xlate THEN DO:          
            ASSIGN transname = transname  + "," + idbtyp + "," + user_env[28].          
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT transname).
          END. 
          ASSIGN transname = transname.       
         
          IF user_env[6] = "Y" THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.
            IF AVAILABLE DICTDB._File THEN DO:  
              ASSIGN idx-number = 0.
              FOR EACH DICTDB._Index OF DICTDB._File:
                IF idx-number < DICTDB._Index._Idx-num THEN
                  ASSIGN idx-number = DICTDB._Index._Idx-num.
              END.
              FOR EACH new-obj WHERE new-obj.tbl-name = DICTDB._File._File-name
                                 AND new-obj.add-type = "I":
                  ASSIGN idx-number = idx-number + 1.
              END.
              ASSIGN idx-number = idx-number + 1.          
              IF DICTDB._File._Fil-misc2[7] <> ? AND DICTDB._File._Fil-misc2[7] <> "" THEN DO:   
                ASSIGN forname = DICTDB._File._Fil-misc2[7].
                IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                  IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                    ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                  ELSE DO:
                    ASSIGN forname = transname.
                    _iname:
                    REPEAT:
                      forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                      IF LENGTH(forname) + 2 <= INTEGER(user_env[28]) THEN LEAVE _iname.
                    END.
                    ASSIGN forname =  forname + "##".
                  END.
                END.
                ELSE 
                    ASSIGN forname = DICTDB._File._Fil-misc2[7] + "##" + transname.
              END.
              ELSE DO:
                forname = DICTDB._File._For-name.
                
                IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                  IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                    ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                  ELSE DO:
                    ASSIGN forname = transname.
                    REPEAT:

                      forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                      IF LENGTH(forname) + 2 <= INTEGER(user_env[28]) THEN LEAVE.
                    END.
                    ASSIGN forname =  forname + "##".
                  END.
                END.
                ELSE 
                    ASSIGN forname = DICTDB._File._For-name + "##" + transname.
              END.

               _verify-index:
              DO WHILE TRUE:
                FIND FIRST rename-obj WHERE rename-type = "I" AND 
                                            rename-obj.new-name <> ilin[5] AND
                                            rename-obj.old-name = ilin[5]
                                        NO-ERROR.
                FIND FIRST verify-index WHERE verify-index.inew-name = forname AND
                                              verify-index.i-table = ilin[5] NO-ERROR.
                FIND FIRST DICTDB._Index WHERE CAPS(DICTDB._Index._For-name) = CAPS(forname) 
                                           AND DICTDB._Index._File-recid = RECID(DICTDB._File) NO-ERROR.

                IF (AVAILABLE verify-Index OR AVAILABLE DICTDB._Index) AND NOT AVAILABLE rename-obj THEN DO:

                   /* OE00177558 - check if we found an index that was renamed */
                   IF NOT AVAILABLE verify-Index THEN DO:
                       FIND FIRST rename-obj WHERE rename-type = "I"
                            and t-name = ilin[5]
                            AND old-name = ilin[3]
                            NO-ERROR.
                       /* assuming that we are the only ones that would use 'temp-' to
                          rename index, re-add it and delete the renamed version.
                       */
                       IF AVAILABLE rename-obj AND rename-obj.new-name BEGINS "temp-" THEN DO:         
                          IF CAN-FIND (FIRST DICTDB._Index OF DICTDB._File 
                                       WHERE DICTDB._Index._Index-name = old-name) THEN DO:
                              CREATE verify-index.
                              ASSIGN verify-index.inew-name = forname
                                     verify-index.i-table = ilin[5].
                              LEAVE _verify-index.
                          END.
                       END.
                  END.

                  origName = forname.

                  DO a = 1 TO 999:
                    
                    /* keep the name size limit */
                    IF LENGTH(origName) + LENGTH(STRING(a)) > INTEGER(user_env[28]) THEN
                        origName = SUBSTRING(origName,1, LENGTH(origName) - 1).

                    ASSIGN forname = origName + STRING(a).
                    
                    IF CAN-FIND(FIRST DICTDB._Index WHERE DICTDB._Index._File-recid = RECID(DICTDB._File)
                                                  AND DICTDB._Index._For-name = forname) THEN NEXT.
                    ELSE IF CAN-FIND(FIRST verify-index WHERE verify-index.inew-name = forname AND
                                      verify-index.i-table = ilin[5]) THEN NEXT.
                    ELSE DO:
                      CREATE verify-index.
                      ASSIGN verify-index.inew-name = forname
                             verify-index.i-table = ilin[5].
                      LEAVE _verify-index.
                    END.
                  END.
                END.
                ELSE DO:
                  CREATE verify-index.
                  ASSIGN verify-index.inew-name = forname
                         verify-index.i-table = ilin[5].
                  LEAVE _verify-index.
                END.
              END.
            END. 
            ELSE DO:
              FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
              IF AVAILABLE new-obj THEN DO:
                ASSIGN forname = new-obj.for-name. 
                IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                  IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                    ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                  ELSE DO:
                    ASSIGN forname = transname.
                    REPEAT:
                      forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                      IF LENGTH(forname) + 2 <= INTEGER(user_env[28]) THEN LEAVE.
                    END.
                    ASSIGN forname =  forname + "##".
                  END.
                END.
                ELSE ASSIGN forname = forname + "##" + transname.
                 
                _verify-new-index:
                DO WHILE TRUE:
                  FIND FIRST verify-index WHERE verify-index.inew-name = forname AND 
                                                verify-index.i-table = ilin[5] NO-ERROR.
                  FIND FIRST n-obj WHERE n-obj.for-name = forname 
                                       AND n-obj.tbl-name = ilin[5]
                                       AND n-obj.add-type = "I" NO-ERROR.
                  IF AVAILABLE verify-Index OR AVAILABLE n-obj THEN
                    ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - 1).
                  ELSE DO:
                    CREATE verify-index.
                    ASSIGN verify-index.inew-name = forname
                           verify-index.i-table = ilin[5].
                    LEAVE _verify-new-index.
                  END.
                END.
              END.
              ELSE DO:
                FIND FIRST rename-obj WHERE rename-type = "T"
                                        AND rename-obj.new-name = ilin[5]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN DO: 
                  FIND DICTDB._File WHERE DICTDB._File._File-name = rename-obj.old-name.
                  ASSIGN idx-number = 0.
                  FOR EACH DICTDB._Index OF DICTDB._File:
                    IF idx-number < DICTDB._Index._Idx-num THEN
                    ASSIGN idx-number = DICTDB._Index._Idx-num.
                  END.
                  FOR EACH new-obj WHERE new-obj.tbl-name = ilin[5]
                                     AND new-obj.add-type = "I":
                    ASSIGN idx-number = idx-number + 1.
                  END.
                  ASSIGN idx-number = idx-number + 1.
                  ASSIGN forname = dsv-name.                        
                  IF LENGTH(forname) + LENGTH(transname) + 2 > INTEGER(user_env[28]) THEN DO:
                    IF LENGTH(transname) + 2 < INTEGER(user_env[28]) THEN
                      ASSIGN forname = SUBSTRING(forname,1,(INTEGER(user_env[28]) - length(transname) - 2)) + "##" + transname.
                    ELSE DO:
                      ASSIGN forname = transname.
                      REPEAT:
                        forname = SUBSTRING(transname,1, (LENGTH(forname) - 1)).
                        IF LENGTH(forname) + 2 < INTEGER(user_env[28]) THEN LEAVE.
                      END.
                      ASSIGN forname =  forname + "##".
                    END.
                  END.          
                END.
              END.                                       
            END. 
          END.
          ELSE
            ASSIGN forname = transname.
          
          IF AVAILABLE DICTDB._File THEN DO:
            IF DICTDB._File._Fil-Misc2[7] <> "" AND DICTDB._File._Fil-Misc2[7] <> ? THEN
              ASSIGN idxline = "CREATE INDEX " + forname + " ON " + DICTDB._File._Fil-Misc2[7].
            ELSE
              ASSIGN idxline = "CREATE INDEX " + forname + " ON " + DICTDB._File._For-name.
          END.
          ELSE DO:
            FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
            IF AVAILABLE new-obj THEN
               ASSIGN idxline = "CREATE INDEX " + forname + " ON " +  new-obj.for-name. 
            ELSE DO:
              FIND FIRST rename-obj WHERE rename-type = "T"
                                      AND rename-obj.new-name = ilin[5]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN 
                   ASSIGN idxline = "CREATE INDEX " + forname + " ON " + dsv-name.                           
            END.
          END.
          ASSIGN df-idx[1] = 'ADD INDEX "' + ilin[3] + '" ON "' + ilin[5] + '"'
                 df-idx[2] = "  INDEX-NUM " + STRING(idx-number)
                 idx-number = idx-number + 1.

          FIND FIRST rename-obj WHERE rename-type = "I"
                                  and t-name = ilin[5]
                                  AND old-name = ilin[3]
                                  NO-ERROR.
          IF AVAILABLE rename-obj THEN DO:         
            FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
            IF AVAILABLE DICTDB._Index THEN 
              PUT STREAM tosql UNFORMATTED comment_chars "DROP INDEX " DICTDB._Index._For-name user_env[5] SKIP.           
          END.
          IF NOT AVAILABLE DICTDB._File AND NOT AVAILABLE rename-obj AND NOT AVAILABLE new-obj THEN DO:
            MESSAGE "The Delta DF File contains ADD INDEX for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.

          RUN create-new-obj (INPUT "I", INPUT ?). 
        END.  /* End of add index line */
        ELSE DO:           
          CASE ilin[1]:
            WHEN "UNIQUE" THEN 
              ASSIGN idxline = SUBSTRING(idxline, 1, 7) + "UNIQUE " + SUBSTRING(idxline,8)
                     df-idx[3] = "  " + ilin[1]
                     is-unique = TRUE.             
            WHEN "INACTIVE" THEN 
              ASSIGN df-idx[4] = "  " + ilin[1].
            WHEN "PRIMARY"  THEN
              ASSIGN df-idx[5] = "  " + ilin[1]. 
            WHEN "DESC" OR WHEN "DESCRIPTION" THEN  DO:
              RUN dctquot (ilin[2], '"',OUTPUT oq-string).  
              IF LENGTH(oq-string) > 0 THEN
                ASSIGN df-idx[6] = "  " + ilin[1] + " " + oq-string.
            END.
            WHEN "WORD" THEN DO: /* Skip, work indexes not supported */   
              ASSIGN efile = tablename + ".e".
              OUTPUT TO value(efile) APPEND.
              PUT UNFORMATTED idxname " in " tablename " is a word index and will not be contained in the" SKIP
                             "df file and no CREATE INDEX statement was generated in the sql file." SKIP(1).
              OUTPUT CLOSE.
              ASSIGN idxline = ?
                     wordidx = TRUE
                     wordfile = idxname
                     df-idx = ?.
            END.
            WHEN "INDEX-FIELD" OR WHEN "KEY-FIELD" THEN DO:   
              IF wordidx THEN NEXT.

              IF longIndex THEN NEXT. /* if index with long/clob column, skip this */

              ELSE IF df-idx[1] <> ? THEN DO:
                DO i = 1 TO 6:
                  IF df-idx[i] <> ? THEN DO:
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = df-idx[i].
                  END.
                END.
                CREATE df-info.
                ASSIGN df-info.df-seq = dfseq
                       dfseq = dfseq + 1
                       df-info.df-tbl = tablename
                       df-line = "  FOREIGN-NAME " + '"' + CAPS(forname) + '"'.

                ASSIGN df-idx = ?.
              END.   
              RUN create-idx-field.
            END.
          END CASE.
          ASSIGN ilin = ?.
        END. /* End of other attributes of add index */       
      END. /* End of add index */
      
      /* Rename Index */
      ELSE IF imod = "r" THEN DO:     
        RUN write-tbl-sql.
        
        IF idxline <> ? AND idxname <> ilin[3] THEN 
          RUN write-idx-sql.
        
        IF seq-line <> ? THEN
          RUN write-seq-sql.
       
        IF conline <> ? THEN
          RUN write-con-sql.
          
        ASSIGN tablename = ilin[7]
               comment_chars = ""
               comment-out = FALSE
               unsptdt = FALSE.

        IF ilin[1] <> ? THEN DO:
          FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[7] NO-ERROR.  
              
          IF NOT AVAILABLE DICTDB._File THEN DO:
            FIND rename-obj WHERE rename-type = "T"
                              AND rename-obj.new-name = ilin[7]
                              NO-ERROR.
                             
            IF AVAILABLE rename-obj THEN
              FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR. 
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            MESSAGE "The Delta DF File contains RENAME INDEX for table" ilin[7] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN 
            FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[3] NO-ERROR. 
          
          IF AVAILABLE DICTDB._Index THEN DO:                                                
            CREATE rename-obj.
            ASSIGN rename-type = "I"
                   t-name = ilin[7]
                   old-name = ilin[3]
                   rename-obj.new-name = ilin[5].

            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line = ilin[1] + ' ' + ilin[2] + ' "' + ilin[3] + '" ' +
                             ilin[4] + ' "' + ilin[5] + '" ' + ilin[6] + ' "' +
                             ilin[7] + '"'.
          END.
          ELSE DO:
            MESSAGE "The Delta DF File contains RENAME INDEX" ilin[3] "for table" ilin[7] SKIP
                    "and index does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.
        END.                              
        ASSIGN ilin = ?.  
      END.
      /* Update Index */
      ELSE DO:
        IF idxline <> ?  THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
       
        IF conline <> ? THEN
          RUN write-con-sql.
          
        /* only update if primary is changing since word indexes can't be primary */
        IF ilin[2] = "PRIMARY" THEN DO:   
          FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[6] NO-ERROR.  
              
          IF NOT AVAILABLE DICTDB._File THEN DO:
            FIND rename-obj WHERE rename-type = "T"
                              AND rename-obj.new-name = ilin[6]
                              NO-ERROR.
                             
            IF AVAILABLE rename-obj THEN
              FIND DICTDB._File WHERE DICTDB._File._File-name = old-name NO-ERROR. 
          END.
          IF NOT AVAILABLE DICTDB._File THEN DO:
            MESSAGE "The Delta DF File contains UPDATE PRIMARY INDEX for table" ilin[6] SKIP
                    "and table does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.
          IF AVAILABLE DICTDB._File THEN 
            FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = ilin[4] NO-ERROR. 
          
          IF NOT AVAILABLE DICTDB._Index THEN DO:                                                
            FIND rename-obj WHERE rename-type = "I"
                              AND rename-obj.new-name = ilin[4]
                              NO-ERROR.
            IF AVAILABLE rename-obj THEN
              FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = old-name NO-ERROR.
            IF NOT AVAILABLE DICTDB._Index THEN DO:
                /* check if the index is being created as well */
                FIND FIRST new-obj WHERE new-obj.tbl-name = ilin[6] AND 
                                         new-obj.add-type = "I" AND
                                         new-obj.prg-name = ilin[4] NO-ERROR.
                IF NOT AVAILABLE new-obj THEN DO:
                     MESSAGE "The Delta DF File contains UPDATE PRIMARY INDEX" ilin[4] "for table" ilin[6] SKIP
                             "and index does not exist in the schema holder." SKIP
                             "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                     RETURN.
                END.
            END.
          END.
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-info.df-tbl = tablename
                 df-line = ?.
          DO i = 1 TO 9: 
            IF ilin[i] <> "" AND ilin[i] <> ? THEN DO:  
              IF df-line = ? THEN 
                ASSIGN df-line = ilin[i] + " ".                        
              ELSE 
                ASSIGN df-line = df-line + ilin[i] + " ".
            END.
          END.
        END.
      END.                  
    END. /* End of index processing */
    IF iobj = "s" THEN DO: 
      IF tablename <> ? THEN 
        RUN write-tbl-sql.
   
      RUN write-idx-sql.
       
      IF conline <> ? THEN
          RUN write-con-sql.
          
      ASSIGN tablename = ?
             comment_chars = ""
             comment-out = FALSE.

      IF imod = "d" THEN DO:  
        IF ilin[3] <> seqname AND seqname <> ? THEN 
          RUN write-seq-sql.  
            
        ASSIGN seqname = ilin[3].
        
        DISPLAY seqname @ tablename WITH FRAME WORKING.          
        
        IF xlate THEN DO:       
          ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
          RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
        END.
        ELSE IF LENGTH(ilin[3]) > INTEGER(user_env[29]) THEN DO:   
          ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
          RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
        END.
        ELSE
          ASSIGN forname = ilin[3].
        
        FIND DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = dbrecid
                                AND DICTDB._Sequence._Seq-name = ilin[3]
                                NO-ERROR.
        IF AVAILABLE _Sequence THEN DO:                        
          ASSIGN seq-line = "DROP SEQUENCE " + forname
                 seq-type = "d"
                 seqname = ilin[3].
       
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '"'.
        END.
        ELSE DO:
          MESSAGE "The Delta DF File contains DROP SEQUENXE" ilin[3] SKIP
                    "and sequence does not exist in the schema holder." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
          RETURN.
        END.
      END.
      ELSE IF imod = "a"  OR imod = "m" THEN DO: 

        CASE ilin[1]:
          WHEN "ADD" THEN DO:
            DISPLAY ilin[3] @ tablename WITH FRAME WORKING.
            IF seq-line <> ? THEN
              RUN write-seq-sql.
            IF xlate THEN DO:       
              ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
            END.
            ELSE IF LENGTH(ilin[3]) > INTEGER(user_env[29]) THEN DO:   
              ASSIGN forname = ilin[3] + "," + idbtyp + "," + user_env[29].
              RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT forname).
            END.
            ELSE
              ASSIGN forname = ilin[3].
            
            ASSIGN seq-line = "CREATE SEQUENCE " + forname
                   seq-type = "a"
                   seqname = ilin[3].
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-line = 'ADD SEQUENCE "' + ilin[3] + '"'.
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-line = '  FOREIGN-NAME "' + CAPS(forname) + '"'.

          END.
         
          WHEN "UPDATE" THEN DO:         
            IF seqname <> ? THEN 
              RUN write-seq-sql.
            DISPLAY ilin[3] @ tablename WITH FRAME WORKING.  
            FIND FIRST DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = dbrecid
                                          AND DICTDB._Sequence._Seq-name = ilin[3]
                                          NO-ERROR.
            IF NOT AVAILABLE _Sequence THEN DO:
              MESSAGE "The Delta DF File contains UPDATE SEQUENCE" ilin[3] SKIP
                      "and sequence does not exist in the schema holder." SKIP
                       "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
              RETURN.
            END.
            IF AVAILABLE _Sequence THEN DO:            
              ASSIGN seq-line = "ALTER SEQUENCE " + _Sequence._Seq-misc[1]
                     seq-type = "u"
                     seqname = ilin[3].
              CREATE df-info.
              ASSIGN df-info.df-seq = dfseq
                     dfseq = dfseq + 1
                     df-line = 'UPDATE SEQUENCE "' + ilin[3] + '"'.                  
            END.          
          END.
          WHEN "INITIAL" THEN
            ASSIGN init = ilin[2].         
          WHEN "INCREMENT" THEN
            ASSIGN incre = ilin[2].
          WHEN "CYCLE-ON-LIMIT" THEN DO:
            IF ilin[2] = "no" THEN
              ASSIGN cyc = "NOCYCLE".
            ELSE
              ASSIGN cyc = "CYCLE".
          END.
          WHEN "MIN-VAL" THEN 
              ASSIGN minval = ilin[2].
          WHEN "MAX-VAL" THEN DO:
              ASSIGN maxval = ilin[2].
          END.
        END CASE.
      END.
      /* Rename sequence in schema holder only */          
      ELSE IF imod = "r" THEN DO:
        IF seq-line <> ? THEN
           RUN write-seq-sql.
           
        FIND FIRST DICTDB._Sequence WHERE DICTDB._Sequence._Db-recid = dbrecid
                                      AND DICTDB._Sequence._Seq-name = ilin[3]
                                      NO-ERROR.
        IF NOT AVAILABLE _Sequence THEN DO:
          MESSAGE "The Delta DF File contains RENAME SEQUENCE" ilin[3] SKIP
                  "and sequence does not exist in the schema holder." SKIP
                  "This process is being aborted."  SKIP (1)
               VIEW-AS ALERT-BOX ERROR.
          RETURN.
        END.

        DISPLAY ilin[3] @ tablename WITH FRAME WORKING.
        
        IF ilin[1] <> ? THEN do:
          CREATE df-info.
          ASSIGN df-info.df-seq = dfseq
                 dfseq = dfseq + 1
                 df-line = ilin[1] + " " + ilin[2] + ' "' + ilin[3] + '" ' +
                           ilin[4] + ' "' + ilin[5] + '"'.
        END.  
      END.
    END.
    ELSE IF iobj = "c" THEN DO:  
      /* Drop a constraint */
      IF imod = "d" THEN DO:
        RUN write-tbl-sql.
       
        IF idxline <> ? THEN 
          RUN write-idx-sql.

        IF seq-line <> ? THEN
          RUN write-seq-sql.
        
        IF conline <> ? THEN
          RUN write-con-sql.  

        IF tablename <> ilin[5] THEN 
          ASSIGN tablename = ilin[5]
                 conname = ilin[3]
                 comment_chars = ""
                 comment-out = FALSE.
       
 
        FIND FIRST DICTDB._File WHERE DICTDB._File._File-name = ilin[5]
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.                                  
        IF AVAILABLE DICTDB._File THEN DO:
          FIND DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-name = ilin[3] NO-ERROR.
          IF AVAILABLE DICTDB._Constraint THEN DO:
            PUT STREAM tosql UNFORMATTED comment_chars "ALTER TABLE " DICTDB._File._For-name " DROP CONSTRAINT "  DICTDB._Constraint._For-name ";" SKIP.
            PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.
            CREATE df-info.
            ASSIGN df-info.df-seq = dfseq
                   dfseq = dfseq + 1
                   df-info.df-tbl = tablename
                   df-line =  "DROP CONSTRAINT " + '"' + DICTDB._Constraint._Con-name +
                              '"' + " ON " + '"' + ilin[5] + '"'.           
          END.
          ELSE DO:
              MESSAGE "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                          "and constraint does not exist in the schema holder." SKIP
                          "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
              RETURN.
          END.
        END.
        ELSE DO:
          FIND FIRST rename-obj WHERE rename-type = "T"
                                  AND new-name = ilin[5]
                                  NO-ERROR.
                                                                 
          IF AVAILABLE rename-obj THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = old-name
                                  AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.
            IF NOT AVAILABLE DICTDB._File THEN DO:
              MESSAGE "The Delta DF File contains DROP CONSTRAINT for table" ilin[5] SKIP
                      "and constraint does not exist in the schema holder." SKIP
                      "This process is being aborted."  SKIP (1)
                  VIEW-AS ALERT-BOX ERROR.
              RETURN.
            END.
            IF AVAILABLE DICTDB._File THEN DO:
               FIND DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-name = ilin[3] NO-ERROR.
               IF AVAILABLE DICTDB._Constraint THEN DO:
                  PUT STREAM tosql UNFORMATTED comment_chars " ALTER TABLE " DICTDB._File._For-name " DROP CONSTRAINT "  DICTDB._Constraint._For-name ";" SKIP.
                  PUT STREAM tosql UNFORMATTED comment_chars " " SKIP.
                 CREATE df-info.
                 ASSIGN df-info.df-seq = dfseq
                        dfseq = dfseq + 1
                        df-info.df-tbl = tablename
                        df-line =  "DROP CONSTRAINT " + '"' + DICTDB._Constraint._Con-name +
                                   '"' + " ON " + '"' + ilin[5] + '"'.           
               END.
               ELSE DO:
                    MESSAGE "The Delta DF File contains DROP CONSTRAINT" ilin[3] "for table" ilin[5] SKIP
                            "and constraint does not exist in the schema holder." SKIP
                            "This process is being aborted."  SKIP (1)
                         VIEW-AS ALERT-BOX ERROR.
                    RETURN.
               END.

            END.  
          END.
        END.        
        ASSIGN conline = ?.
      END. /* End delete constraint */ 
      IF imod = "a" THEN DO:
        IF ilin[1] = "ADD" and ilin[2] = "CONSTRAINT" THEN DO:     

          RUN write-tbl-sql.
                                 
          IF idxline <> ? THEN 
            RUN write-idx-sql.
            
          IF seq-line <> ? THEN
            RUN write-seq-sql.

          IF conline <> ? THEN
            RUN write-con-sql.
          IF tablename <> ilin[5] THEN
            ASSIGN tablename = ilin[5]
                   comment_chars = ""
                   comment-out = FALSE.

          ASSIGN transname = ilin[3]
                 conname = ilin[3].
          IF xlate THEN DO:          
            ASSIGN transname = transname  + "," + idbtyp + "," + user_env[28].          
            RUN "prodict/misc/_resxlat.p" (INPUT-OUTPUT transname).
          END. 
          ASSIGN transname = transname.              
          IF user_env[6] = "Y" THEN DO:
            FIND DICTDB._File WHERE DICTDB._File._File-name = ilin[5] NO-ERROR.
            IF AVAILABLE DICTDB._File THEN DO:  
              ASSIGN con-number = 0.
              FOR EACH DICTDB._Constraint OF DICTDB._File:
                IF con-number < DICTDB._Constraint._Con-num THEN
                  ASSIGN con-number = DICTDB._Constraint._Con-num.
              END.
              FOR EACH n-obj WHERE n-obj.tbl-name = ilin[5]
                               AND n-obj.add-type = "C":
                  ASSIGN con-number = con-number + 1.
              END.
              ASSIGN con-number = con-number + 1.          
                     forname = transname.
         
               _verify-con:
              DO WHILE TRUE:
                FIND FIRST verify-con WHERE verify-con.cnew-name = forname NO-ERROR.
                FIND FIRST DICTDB._Constraint WHERE CAPS(DICTDB._Constraint._For-name) = CAPS(forname)
                                           AND DICTDB._Constraint._File-recid = RECID(DICTDB._File) NO-ERROR.

                IF AVAILABLE verify-con OR AVAILABLE DICTDB._Constraint THEN DO:
                  DO a = 1 TO 999:
                    IF a = 1 THEN
                      ASSIGN forname = forname + STRING(a).
                    ELSE
                      ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - LENGTH(STRING(a))) + STRING(a). 
                    IF CAN-FIND(FIRST DICTDB._Constraint WHERE DICTDB._Constraint._File-recid = RECID(DICTDB._File)
                                                  AND DICTDB._Constraint._For-name = forname) THEN NEXT.
                    ELSE IF CAN-FIND(FIRST verify-con WHERE verify-con.cnew-name = forname) THEN NEXT.
                    ELSE DO:
                      CREATE verify-con.
                      ASSIGN verify-con.cnew-name = forname.
                      LEAVE _verify-con.
                    END.
                  END.
                END.
                ELSE DO:
                  CREATE verify-con.
                  ASSIGN verify-con.cnew-name = forname.
                  LEAVE _verify-con.
                END.
              END.
            END. 
            ELSE DO:
              FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
              IF AVAILABLE new-obj THEN DO:
              ASSIGN forname = transname.                 
                _verify-new-con:
                DO WHILE TRUE:
                  FIND FIRST verify-con WHERE verify-con.cnew-name = forname NO-ERROR.
                  FIND FIRST n-obj WHERE n-obj.for-name = forname 
                                       AND n-obj.tbl-name = ilin[5]
                                       AND n-obj.add-type = "C" NO-ERROR.
                  IF AVAILABLE verify-con OR AVAILABLE n-obj THEN
                    ASSIGN forname = SUBSTRING(forname, 1, LENGTH(forname) - 1).
                  ELSE DO:
                    CREATE verify-con.
                    ASSIGN verify-con.cnew-name = forname.
                    LEAVE _verify-new-con.
                  END.
                END.
              END.
              ELSE DO:
                FIND FIRST rename-obj WHERE rename-type = "T"
                                        AND rename-obj.new-name = ilin[5]
                                        NO-ERROR.
                IF AVAILABLE rename-obj THEN DO: 
                  FIND DICTDB._File WHERE DICTDB._File._File-name = rename-obj.old-name.
                  IF AVAILABLE DICTDB._File THEN DO:
                    ASSIGN con-number = 0.
                    FOR EACH DICTDB._Constraint OF DICTDB._File:
                      IF con-number < DICTDB._Constraint._Con-num THEN
                        ASSIGN con-number = DICTDB._Constraint._Con-num.
                    END.
                    FOR EACH n-obj WHERE n-obj.tbl-name = ilin[5]
                                    AND n-obj.add-type = "C":
                       ASSIGN con-number = con-number + 1.
                    END.
                    ASSIGN con-number = con-number + 1.
                  END.
                END.
              END.                                       
            END. 
          END.
          ELSE
            ASSIGN forname = transname.
          
          IF AVAILABLE DICTDB._File THEN 
              ASSIGN conline = "ALTER TABLE " + DICTDB._File._For-name + " ADD CONSTRAINT " + forname.
          ELSE DO:
            FIND FIRST new-obj WHERE new-obj.add-type = "T"
                                 AND new-obj.tbl-name = ilin[5]
                                 NO-ERROR.
            IF AVAILABLE new-obj THEN
               ASSIGN conline = "ALTER TABLE " + new-obj.for-name + " ADD CONSTRAINT " + forname. 
            ELSE DO:
              FIND FIRST rename-obj WHERE rename-type = "T"
                                      AND rename-obj.new-name = ilin[5]
                                      NO-ERROR.
              IF AVAILABLE rename-obj THEN 
                   ASSIGN conline = "ALTER TABLE " + dsv-name + " ADD CONSTRAINT " + forname.                      
            END.
          END.
          ASSIGN df-con[1] = 'ADD CONSTRAINT "' + ilin[3] + '" ON "' + ilin[5] + '"'
                 con-number = con-number + 1.

          IF NOT AVAILABLE DICTDB._File AND NOT AVAILABLE rename-obj AND NOT AVAILABLE new-obj THEN DO:
            MESSAGE "The Delta DF File contains ADD CONSTRAINT for table" ilin[5] SKIP
                    "and table information does not exist." SKIP
                    "This process is being aborted."  SKIP (1)
                    VIEW-AS ALERT-BOX ERROR.
            RETURN.
          END.

          RUN create-new-obj (INPUT "C", INPUT ?). 
          ASSIGN ilin = ?.
        END.  /* End of add constraint line */
        ELSE DO:           
          CASE ilin[1]:
            WHEN "PRIMARY" OR WHEN "PRIMARY-CLUSTERED" THEN 
              ASSIGN conline = conline + " PRIMARY KEY "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "P".
            WHEN "UNIQUE" THEN 
              ASSIGN conline = conline + " UNIQUE "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "U".
            WHEN "CLUSTERED" THEN
              ASSIGN conline = conline + " CLUSTERED "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "CL".                     
            WHEN "FOREIGN-KEY" THEN 
              ASSIGN conline = conline + " FOREIGN KEY "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "F".
            WHEN "CHECK" THEN 
              ASSIGN conline = conline + " CHECK "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "C".
            WHEN "DEFAULT" THEN 
              ASSIGN conline = conline + " DEFAULT "
                     df-con[2] = "  " + ilin[1]
                     con-ty = "D".                                                                          
            WHEN "INACTIVE" THEN 
              ASSIGN conline = ?
                     df-con[3] = "  " + ilin[1].
            WHEN "ACTIVE" THEN 
              ASSIGN df-con[3] = "  " + ilin[1].              
            WHEN "CONSTRAINT-INDEX" THEN DO:
              ASSIGN df-con[4] = "  " + ilin[1] + " " + '"' + ilin[2] + '"'
                     conidx = ilin[2]
                     fldcon = FALSE.
                     CREATE con-type.
                     ASSIGN con-type.con-tab = tablename   
                            con-type.idx-nam = ilin[2] 
                            con-type.type    = con-ty.   
                     RUN create-con-field.
                     
                     IF df-con[1] <> ? AND con-ty <> "F" AND con-ty <> "CL" THEN DO:
                       DO i = 1 TO 4:
                          IF df-con[i] <> ? THEN DO:
                            CREATE df-info.
                            ASSIGN df-info.df-seq = dfseq
                                   dfseq = dfseq + 1
                                   df-info.df-tbl = tablename
                                   df-line = df-con[i].
                           END.
                       END.
                       ASSIGN df-con = ?.
                     END. 
               IF con-ty = "CL"  THEN 
                              ASSIGN conline = ?
                                      df-con = ? .
            END.                
          
            WHEN "CONSTRAINT-FIELD" THEN DO:
              ASSIGN df-con[4] = "  " + ilin[1] + " " + '"' + ilin[2] + '"'.
              RUN create-idx-field. /* this procedure is being used to fetch the field name for constraint definition */
              ASSIGN idxline = ?.                         
            END.
           
            WHEN "CONSTRAINT-EXPR" THEN DO:
              IF con-ty = "C" THEN
                  ASSIGN conline = conline + " (" + replace(ilin[2],"-","_") + ")".
              ELSE
                  ASSIGN conline = conline + " " + replace(ilin[2],"-","_") + " FOR " + con-fld-name.                  
              
              ASSIGN df-con[5] = "  " + ilin[1] + ' "' + ilin[2] + '"'                     
                     fldcon = TRUE.                   
            
               IF df-con[1] <> ? AND con-ty <> "D" THEN DO:
                 DO i = 1 TO 5:
                   IF df-con[i] <> ? THEN DO:
                    CREATE df-info.
                    ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = df-con[i].
                   END.
                 END.
               END. 
                     ASSIGN df-con = ?.   
               IF con-ty = "D"  THEN ASSIGN conline = ?.                    
            END.        

            WHEN "PARENT-TABLE" THEN DO:          
                 ASSIGN par-tab = ilin[2].
                 ASSIGN df-con[5] = "  " + ilin[1] + ' "' + ilin[2] + '"'.           
            END.

            WHEN "PARENT-INDEX" THEN DO:
              ASSIGN df-con[6] = "  " + ilin[1] + ' "' + ilin[2] + '"'
                     par-index = ilin[2].
              RUN create-for-con.
            END.
            WHEN "CONSTRAINT-ACTION" THEN DO:
              ASSIGN df-con[7] = "  " + ilin[1] + ' "' + ilin[2] + '"'
                     con-actn  = ilin[2]
                     fldcon = TRUE.
              IF df-con[1] <> ? THEN DO:
                 DO i = 1 TO 7:
                    IF df-con[i] <> ? THEN DO:
                     CREATE df-info.
                     ASSIGN df-info.df-seq = dfseq
                           dfseq = dfseq + 1
                           df-info.df-tbl = tablename
                           df-line = df-con[i].
                    END.
                 END.
               END. 
               IF (con-actn <> "NONE" AND con-actn <> "SET DEFAULT") THEN ASSIGN conline = conline + ") ON DELETE " + con-actn.
               ELSE ASSIGN conline = conline + ")".
                 ASSIGN df-con = ?.
            END.            
          END CASE.
        END. /* End of other attributes of add constraint */ 
      END. /* End of add constraint */
    END.                
      
  END.
END.

/* flush out last line of script */
RUN write-tbl-sql.
RUN write-idx-sql.
IF view-created THEN DO:
  RUN create-view.
  RUN write-view.
END.
RUN write-seq-sql.
RUN write-con-sql.
IF user_env[2] = "yes" THEN DO:    
  FOR EACH df-info:     
    IF SUBSTRING(df-line,1,1) <> " " THEN
      PUT STREAM todf UNFORMATTED " " SKIP.
    PUT STREAM todf UNFORMATTED df-line SKIP.
  END.

  ASSIGN user_env[5] = SESSION:CPSTREAM.
  
 /* adds trailer with code-page-entry to end of file */ 
 {prodict/dump/dmptrail.i
        &entries      = " "
        &seek-stream  = "todf"
        &stream       = "stream todf"
        }   
        
  OUTPUT STREAM todf CLOSE.  
  OUTPUT STREAM tosql CLOSE. 
  HIDE FRAME working NO-PAUSE.
  
  MESSAGE "The following files have been created:" SKIP(1)
          "ORACLE SQL Script:  " sqlout  SKIP
          "{&PRO_DISPLAY_NAME} DF File:  " dfout SKIP(1)
          "If the delta.df contained any drop statements," SKIP
          "data will be lost from the ORACLE Database." SKIP(1) 
          "Check for warnings in <table name>.e files " SKIP          
    VIEW-AS ALERT-BOX INFORMATION. 
END.
ELSE do:
  OUTPUT STREAM todf CLOSE.
  OUTPUT STREAM tosql CLOSE.
  OS-DELETE VALUE(dfout).
  HIDE FRAME working NO-PAUSE.
  
  MESSAGE "The following file has been created: " SKIP(1)
          "    ORACLE SQL Script: " sqlout SKIP(1)
          "If the delta.df contained any drop statements," SKIP
          "data will be lost from the ORACLE Database." SKIP(1) 
          "Check for warnings in <table name>.e files " SKIP
     VIEW-AS ALERT-BOX INFORMATION.
END.
RUN adecomm/_setcurs.p ("").
 
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_als.p

Description:
    + disconnects from DICTDBG if already connectd
    + assignes the link-name to _db-misc2[8]
    + connects to the link-db 
    + sets the alias
    
Input-Parameters:  
    p_ldbname      logical name of the link-db (= physical name)
    p_link-name    link-name for _db-misc2[8]
    
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    none

    
History:
    hutegger    94/09/11    creation
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define input parameter p_ldbname   as character.

{ prodict/dictvar.i }

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

if connected(p_ldbname)
 then create alias DICTDBG for database value(p_ldbname).

 
/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_cra - base argument for oracle meta-schema

   Modified:  DLM 12/29/97 Added _ianum
              DLM 01/29/98 Added _db find and change _For-name based on 
                           Oracle Version.
              DLM 07/13/98 Added _Owner to _File Find             
         fernando 06/11/07 Unicode support - new field
             
*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

DEFINE VARIABLE isNew AS LOGICAL NO-UNDO INITIAL NO.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

/* we better find the _db record */
IF NOT AVAILABLE(_Db) THEN RETURN.
ELSE IF _Db._Db-type <> "ORACLE" THEN RETURN.

/* if read-only, nothing to be done here */
IF CAN-DO("READ-ONLY",DBRESTRICTIONS("DICTDB")) THEN RETURN.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_arguments" 
    AND (_File._Owner = "_FOREIGN" OR _File._owner = "PUB") NO-ERROR.

IF NOT AVAILABLE _File THEN DO:

ASSIGN isNew = YES.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_arguments"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "ARGUMENT$"
  _File._For-Owner   = "sys"
  _File._ianum       = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "PROCEDURE$"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimal      = 32
  _Field._Order        = 20
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 30
  _Field._For-Name = "PROCEDURE$"
  _Field._For-Type = "char".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OVERLOAD#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OVERLOAD#"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "POSITION"
   _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "POSITION"
                             ELSE "POSITION#")
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "SEQUENCE#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 5
  _Field._For-Maxsize  = 12
  _Field._For-Name = "SEQUENCE#"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "LEVEL#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 6
  _Field._For-Maxsize  = 12
  _Field._For-Name = "LEVEL#"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "ARGUMENT"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimal      = 32
  _Field._Order        = 70
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 7
  _Field._For-Maxsize  = 30
  _Field._For-Name = "ARGUMENT"
  _Field._For-Type = "char".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "TYPE#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 80
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 8
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "TYPE"
                             ELSE "TYPE#")
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DEFAULT#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 90
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 9
  _Field._For-Maxsize  = 12
  _Field._For-Name = "DEFAULT#"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "IN_OUT"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 100
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 10
  _Field._For-Maxsize  = 12
  _Field._For-Name = "IN_OUT"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "LENGTH_"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 110
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 11
  _Field._For-Maxsize  = 12
  _Field._For-Name = "LENGTH"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "PRECISION_"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 120
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 12
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "PRECISION"
                             ELSE "PRECISION#")
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "SCALE"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 130
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 13
  _Field._For-Maxsize  = 12
  _Field._For-Name = "SCALE"
  _Field._For-Type = "number".

CREATE _Field. /* file: argument$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DEFAULT$"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimal      = 32
  _Field._Order        = 140
  _Field._Fld-stdtype  = 16384
  _Field._Fld-stoff    = 14
  _Field._For-Maxsize  = 0
  _Field._For-Name = "DEFAULT$"
  _Field._For-Type = "long".

END.
ELSE DO:
/* This field was added to 10.1C for the Unicode Support. Make sure that we
  add it if this was an pre-10.1C schema holder
*/
   FIND _Field OF _File WHERE _Field._File-recid   = RECID(_File) 
                     AND _Field._Field-Name   = "CHARSETFORM" NO-ERROR.
   IF NOT AVAILABLE(_Field) AND NOT CAN-DO("READ-ONLY",DBRESTRICTIONS("DICTDB")) THEN
      ASSIGN isNew = YES.

END.

/* if this is a new schema, or if the field doesn't exist, then create it */
IF isNew THEN DO:

    CREATE _Field. /* file: argument$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "CHARSETFORM"
      _Field._Data-Type    = "integer"
      _Field._Initial      = ?
      _Field._Mandatory    = no
      _Field._Format       = ">>>>>>>>>9"
      _Field._Order        = 150
      _Field._Fld-stdtype  = 8192
      _Field._Fld-stoff    = 15
      _Field._For-Maxsize  = 12
      _Field._For-Name = "CHARSETFORM"
      _Field._For-Type = "number".
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crc - base columns for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find
         fernando 06/11/07 Unicode support - new field
*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

DEFINE VARIABLE isNew AS LOGICAL NO-UNDO INITIAL NO.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

IF NOT AVAILABLE _Db THEN RETURN.
ELSE IF _Db._Db-type <> "ORACLE" THEN RETURN.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_columns" 
    AND (_File._Owner = "_FOREIGN" OR _File._owner = "PUB") NO-ERROR.

IF NOT AVAILABLE _File THEN DO:

ASSIGN isNew = YES.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_columns"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "col$"
  _File._For-Owner   = "sys"
  _File._ianum       = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "COL#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name = "COL#"
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "NAME"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(30)"
  _Field._Decimals     = 30
  _Field._Order        = 30
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 30
  _Field._For-Name = "NAME"
  _Field._For-Type = "char".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "TYPE#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-Maxsize  = 12
  _Field._For-Name = "TYPE#"
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "LENGTH_"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 5
  _Field._For-Maxsize  = 12
  _Field._For-Name = "LENGTH"
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "PRECISION_"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 6
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "PRECISION"
                             ELSE "PRECISION#")
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "SCALE"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 7
  _Field._For-Maxsize  = 12
  _Field._For-Name = "SCALE"
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "NULL$"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 80
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 8
  _Field._For-Maxsize  = 12
  _Field._For-Name = "NULL$"
  _Field._For-Type = "number".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DEFAULT$"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimals     = ?
  _Field._Order        = 90
  _Field._Fld-stdtype  = 16384
  _Field._Fld-stoff    = 9
  _Field._For-Maxsize  = 0
  _Field._For-Name = "DEFAULT$"
  _Field._For-Type = "long".

END.
ELSE DO:

/* This field was added to 10.1C for the Unicode Support. Make sure that we
  add it if this was an pre-10.1C schema holder
*/
   FIND _Field OF _File WHERE _Field._File-recid   = RECID(_File) 
                     AND _Field._Field-Name   = "CHARSETFORM" NO-ERROR.
   IF NOT AVAILABLE(_Field) AND NOT CAN-DO("READ-ONLY",DBRESTRICTIONS("DICTDB")) THEN
      ASSIGN isNew = YES.
END.

/* if this is a new schema, or if the field doesn't exist, then create it */
IF isNew THEN DO:

    CREATE _Field. /* file: col$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "CHARSETFORM"
      _Field._Data-Type    = "integer"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "->>>>>>>>>9"
      _Field._Order        = 100
      _Field._Fld-stdtype  = 8192
      _Field._Fld-stoff    = 10
      _Field._For-Maxsize  = 12
      _Field._For-Name = "CHARSETFORM"
      _Field._For-Type = "number".
END.


RETURN.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crg - Generic Stored procedures buffer for Oracle databases.

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

 */

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "PROC-TEXT-BUFFER" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "PROC-TEXT-BUFFER"
  _File._For-type     = "GENERIC-BUFFER"
  _File._For-name     = "NONAME"
  _File._Last-change  = 2146431
  _File._ianum        = 6
  _File._Hidden       = TRUE.
  _File._For-Owner    = "".

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "proc-text"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 1
  _Field._For-name     = "NONAME"
  _Field._For-type     = "char".

/* Dummy Stored procedures buffer SQL pass thru. */
CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "SEND-SQL-STATEMENT"
  _File._For-type     = "PROCEDURE"
  _File._For-name     = "SEND-SQL-STATEMENT"
  _File._Last-change  = 2146431
  _File._ianum        = 6
  _File._Hidden       = TRUE.

CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "sql-statement"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(76)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 1
  _Field._For-name     = "sql-statement"
  _Field._For-type     = "char".

/* Dummy Stored procedures buffer SQL pass thru. */
FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "CloseAllProcs" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "CloseAllProcs"
  _File._For-type     = "PROCEDURE"
  _File._For-name     = "CLOSEALLPROCS"
  _File._Last-change  = 2146431
  _File._ianum        = 6
  _File._Hidden       = TRUE.

/* Stored procedures buffer DS-CLOSE-CURSOR. */
FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "DS-Close-Cursor" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid     = dbkey
  _File._File-name    = "DS-Close-Cursor"
  _File._For-type     = "PROCEDURE"
  _File._For-name     = "DS-Close-Cursor"
  _File._Last-change  = 2146431
  _File._ianum        = 6
  _File._Hidden       = TRUE.

CREATE _Field. 
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "Find$"
  _Field._Data-Type    = "character"
  _Field._Initial      = ""
  _Field._Mandatory    = yes
  _Field._Format       = "x(30)"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 1
  _Field._For-name     = "Find$"
  _Field._For-type     = "char".
  
CREATE _Field. /* file: col$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "N#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "9999"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 4
  _Field._For-name     = "N#"
  _Field._For-type     = "number".

  
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_cri - base indexes for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_indexes" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_indexes"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "ind$"
  _File._For-Owner   = "sys"
  _File._Last-change = 2146431
  _File._ianum       = 6
  _File._Hidden      = TRUE.

CREATE _Field. /* file: ind$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ind$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "BO#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name = "BO#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ind$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "UNIQUE$"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "UNIQUE$"
                             ELSE "PROPERTY")
  _Field._For-Type = "number".

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crk - base index-columns for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_idxcols" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_idxcols"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "icol$"
  _File._For-Owner   = "sys"
  _File._Last-change = 2146431
  _File._ianum       = 6
  _File._Hidden      = TRUE.

CREATE _Field. /* file: icol$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: icol$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "COL#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name = "COL#"
  _Field._For-Type = "number".

CREATE _Field. /* file: icol$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "POS#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 12
  _Field._For-Name = "POS#"
  _Field._For-Type = "number".

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crl - base sys.link$ & sys.syn$ for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_links" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF NOT AVAILABLE _File THEN DO:

    CREATE _File.
    ASSIGN
      _File._Db-recid    = dbkey
      _File._File-name   = "oracle_links"
      _File._For-Type    = "TABLE"
      _File._For-Name    = "link$"
      _File._For-Owner   = "sys"
      _File._Last-change = 2146431
      _File._ianum       = 6
      _File._Hidden      = TRUE.

    CREATE _Field. /* file: link$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "OWNER#"
      _Field._Data-Type    = "integer"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "->>>>>>>>>9"
      _Field._Order        = 10
      _Field._Fld-stdtype  = 8192
      _Field._Fld-stoff    = 1
      _Field._For-Maxsize  = 12
      _Field._For-Name     = "OWNER#"
      _Field._For-Type     = "number".

    CREATE _Field. /* file: link$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "NAME"
      _Field._Data-Type    = "character"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "x(30)"
      _Field._Decimals     = 30
      _Field._Order        = 20
      _Field._Fld-stdtype  = 4096
      _Field._Fld-stoff    = 2
      _Field._For-Maxsize  = 128
      _Field._For-Name     = "NAME"
      _Field._For-Type     = "char".
END.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_synonyms" NO-ERROR.
IF NOT AVAILABLE _File THEN DO:

    CREATE _File.
    ASSIGN
      _File._Db-recid    = dbkey
      _File._File-name   = "oracle_synonyms"
      _File._For-Type    = "TABLE"
      _File._For-Name    = "syn$"
      _File._For-Owner   = "sys"
      _File._Last-change = 2146431
      _File._ianum       = 6
      _File._Hidden      = TRUE.

    CREATE _Field. /* file: syn$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "OBJ#"
      _Field._Data-Type    = "integer"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "->>>>>>>>>9"
      _Field._Order        = 10
      _Field._Fld-stdtype  = 8192
      _Field._Fld-stoff    = 1
      _Field._For-Maxsize  = 12
      _Field._For-Name     = "OBJ#"
      _Field._For-Type     = "number".

    CREATE _Field. /* file: syn$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "NODE"
      _Field._Data-Type    = "character"
      _Field._Initial      = ?
      _Field._Mandatory    = no
      _Field._Format       = "x(30)"
      _Field._Decimals     = 30
      _Field._Order        = 20
      _Field._Fld-stdtype  = 4096
      _Field._Fld-stoff    = 2
      _Field._For-Maxsize  = 128
      _Field._For-Name     = "NODE"
      _Field._For-Type     = "char".

    CREATE _Field. /* file: syn$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "OWNER"
      _Field._Data-Type    = "character"
      _Field._Initial      = ?
      _Field._Mandatory    = no
      _Field._Format       = "x(30)"
      _Field._Decimals     = 30
      _Field._Order        = 30
      _Field._Fld-stdtype  = 4096
      _Field._Fld-stoff    = 3
      _Field._For-Maxsize  = 30
      _Field._For-Name     = "OWNER"
      _Field._For-Type     = "char".

    CREATE _Field. /* file: syn$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "NAME"
      _Field._Data-Type    = "character"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "x(30)"
      _Field._Decimals     = 30
      _Field._Order        = 40
      _Field._Fld-stdtype  = 4096
      _Field._Fld-stoff    = 4
      _Field._For-Maxsize  = 30
      _Field._For-Name     = "NAME"
      _Field._For-Type     = "char".
END.


FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_views" NO-ERROR.
IF NOT AVAILABLE _File THEN DO:

    CREATE _File.
    ASSIGN
      _File._Db-recid    = dbkey
      _File._File-name   = "oracle_views"
      _File._For-Type    = "TABLE"
      _File._For-Name    = "view$"
      _File._For-Owner   = "sys"
      _File._ianum       = 6
      _File._Last-change = 2146431
      _File._Hidden      = TRUE.

    CREATE _Field. /* file: view$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "OBJ#"
      _Field._Data-Type    = "integer"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "->>>>>>>>>9"
      _Field._Order        = 10
      _Field._Fld-stdtype  = 8192
      _Field._Fld-stoff    = 1
      _Field._For-Maxsize  = 12
      _Field._For-Name     = "OBJ#"
      _Field._For-Type     = "number".

    CREATE _Field. /* file: view$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "COLS"
      _Field._Data-Type    = "integer"
      _Field._Initial      = ?
      _Field._Mandatory    = yes
      _Field._Format       = "->>>>>>>>>9"
      _Field._Order        = 20
      _Field._Fld-stdtype  = 8192
      _Field._Fld-stoff    = 2
      _Field._For-Maxsize  = 12
      _Field._For-Name = "COLS"
      _Field._For-Type = "number".

    CREATE _Field. /* file: view$ */
    ASSIGN
      _Field._File-recid   = RECID(_File)
      _Field._Field-Name   = "TEXT_"
      _Field._Data-Type    = "character"
      _Field._Initial      = ?
      _Field._Mandatory    = no
      _Field._Format       = "x(64)"
      _Field._Decimals     = ?
      _Field._Order        = 30
      _Field._Fld-stdtype  = 16384
      _Field._Fld-stoff    = 3
      _Field._For-Maxsize  = 0
      _Field._For-Name     = "TEXT"
      _Field._For-Type     = "long".
END.

RETURN.









/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crm - base comments for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_comment" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_comment"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "com$"
  _File._For-Owner   = "sys"
  _File._Last-change = 2146431
  _File._ianum       = 6
  _File._Hidden      = TRUE.

CREATE _Field. /* file: com$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: com$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "COL#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name = "COL#"
  _Field._For-Type = "number".

CREATE _Field. /* file: com$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "COMMENT$"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimal      = 255
  _Field._Order        = 30
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 2000
  _Field._For-Name = "COMMENT$"
  _Field._For-Type = "char".

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_cro - base objects for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_objects" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_objects"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "obj$"
  _File._For-Owner   = "sys"
  _File._ianum       = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: obj$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: obj$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OWNER#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OWNER#"
  _Field._For-Type = "number".

CREATE _Field. /* file: obj$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "NAME"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(30)"
  _Field._Decimals     = 30
  _Field._Order        = 30
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 30
  _Field._For-Name = "NAME"
  _Field._For-Type = "char".

CREATE _Field. /* file: obj$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "TYPE"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "TYPE"
                             ELSE "TYPE#")
  _Field._For-Type = "number".

CREATE _Field. /* file: obj$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "LINKNAME"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(64)"
  _Field._Decimals     = 30
  _Field._Order        = 50
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 5
  _Field._For-Maxsize  = 128
  _Field._For-Name = "LINKNAME"
  _Field._For-Type = "char".

RETURN.
/*********************************************************************
* Copyright (C) 2000,2008 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crp - base procedure for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find


*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

return.
/* commenting code below since it's not executed - to get rid of compiler
   warning on statement not reached. 
*/

/*
FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_procedures" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_procedures"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "PROCEDURE$"
  _File._For-Owner   = "sys"
  _File._ianum       = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: procedure$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: procedure$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "AUDIT$"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimal      = 32
  _Field._Order        = 20
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 32
  _Field._For-Name = "AUDIT$"
  _Field._For-Type = "char".

CREATE _Field. /* file: procedure$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "STORAGESIZE"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 12
  _Field._For-Name = "STORAGESIZE"
  _Field._For-Type = "number".


CREATE _Field. /* file: procedure$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OPTIONS"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OPTIONS"
  _Field._For-Type = "number".

RETURN.
*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crs - base sequences for oracle meta-schema 


   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_sequences" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_sequences"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "seq$"
  _File._For-Owner   = "sys"
  _File._ianum       = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: seq$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "OBJ#"
  _Field._For-Type = "number".

CREATE _Field. /* file: seq$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "INCREMENT$"
  _Field._Data-Type    = "decimal"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 40
  _Field._For-Name = "INCREMENT$"
  _Field._For-Type = "number".

CREATE _Field. /* file: seq$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "MINVALUE"
  _Field._Data-Type    = "decimal"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 40
  _Field._For-Name = "MINVALUE"
  _Field._For-Type = "number".

CREATE _Field. /* file: seq$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "MAXVALUE"
  _Field._Data-Type    = "decimal"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-Maxsize  = 40
  _Field._For-Name = "MAXVALUE"
  _Field._For-Type = "number".

CREATE _Field. /* file: seq$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "CYCLE"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 5
  _Field._For-Maxsize  = 12
  _Field._For-Name = (IF _Db._Db-misc1[3] = 7 THEN "CYCLE"
                             ELSE "CYCLE#")
  _Field._For-Type = "number".

RETURN.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crt - base argument for oracle meta-schema

   Created 03/10/98 D. McMann  Creating _file for TableSpaces
    
  Modified: DLM 07/13/98 Added _Owner to _File Find       
   
*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

IF dbkey = ? THEN RETURN.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

IF NOT AVAILABLE _Db THEN RETURN.

ELSE IF _Db._Db-type <> "ORACLE" THEN RETURN.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_tablespace" 
    AND (_File._Owner = "_FOREIGN" OR _File._owner = "PUB") NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_tablespace"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "ts$"
  _File._For-Owner   = "sys"
  _File._ianum = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "TS#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-maxsize  = 10
  _Field._For-Name = "TS#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "NAME"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "x(30)"
  _Field._Decimal      = 30
  _Field._Order        = 20
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 2
  _Field._For-maxsize  = 30
  _Field._For-Name = "NAME"
  _Field._For-Type = "VarChar2".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OWNER#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-maxsize  = 10
  _Field._For-Name = "OWNER#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "ONLINE$"
   _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-maxsize  = 10  
  _Field._For-Name =  "ONLINE$"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "UNDOFILE#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = NO
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 5
  _Field._For-maxsize  = 10  
  _Field._For-Name = "UNDOFILE#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "UNDOBLOCK#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 60
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 6
  _Field._For-maxsize  = 10
  _Field._For-Name = "UNDOBLOCK#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "BLOCKSIZE"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 7
  _Field._For-maxsize  = 10  
  _Field._For-Name = "BLOCKSIZE"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "INC#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 80
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 8
  _Field._For-maxsize  = 10  
  _Field._For-Name     = "INC#"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "SCNWRP"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 90
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 9
  _Field._For-maxsize  = 10  
  _Field._For-Name = "SCNWRP"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "SCNBAS"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 100
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 10
  _Field._For-maxsize  = 10  
  _Field._For-Name = "SCNBAS"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DFLMINEXT"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 110
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 11
  _Field._For-maxsize  = 10  
  _Field._For-Name = "DFLMINEXT"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DFLMAXEXT"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 120
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 12
  _Field._For-maxsize  = 10  
  _Field._For-Name =  "DFLMAXEXT"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DFLINIT"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 130
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 13
  _Field._For-maxsize  = 10  
  _Field._For-Name = "DFLINIT"
  _Field._For-Type = "number".

CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DFLINCR"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 140
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 14
  _Field._For-maxsize  = 10  
  _Field._For-Name = "DFLINCR"
  _Field._For-Type = "number".
  
CREATE _Field. /* file: ts$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "DFLEXTPCT"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 150
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 15
  _Field._For-maxsize  = 10  
  _Field._For-Name = "DFLEXTPCT"
  _Field._For-Type = "number".
  

RETURN.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_cru - base users for oracle meta-schema 

   Modified:  DLM 12/29/97 Added _ianum
              DLM 07/13/98 Added _Owner to _File Find

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_users" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_users"
  _File._For-Type = "TABLE"
  _File._For-Name = "user$"
  _File._For-Owner = "sys"
  _File._ianum     = 6
  _File._Last-change = 2146431
  _File._Hidden      = TRUE.

CREATE _Field. /* file: user$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "USER#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name = "USER#"
  _Field._For-Type = "number".

CREATE _Field. /* file: user$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "NAME"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "x(30)"
  _Field._Decimals     = 30
  _Field._Order        = 20
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 30
  _Field._For-Name = "NAME"
  _Field._For-Type = "char".

RETURN.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_fix.p

Description:
    last step of protoora.
    adjusts schemaholder to original progress-db


Input:
    none

Output:
    none
    
Used/Modified Shared Objects:
    drec_db
    user_dbname

History:
    ?           9?/??   created
   DLM         11/12/97 Added view-as dialog-box to screens for non TTY clients.
   DLM         11/24/97 Added logic to skip word indexes
   DLM         03/19/98 Added logic to look at _for-name if _file or _field 
                        can not be found.    
   DLM         04/17/98 Added logic to skip _Index-field record which is
                        now associated with default index. 
   DLM         07/13/98 Added _Owner to _File Find   
   DLM         09/17/98 Removed creating defalut index as default_  
   DLM         02/02/99 Added passign dbtype and length to _resxlat.p  
   DLM         02/08/99 Added delete loop for files not pushed.   
   DLM         10/20/99 Added check for system tables in delete loop.  
   DLM         11/18/99 Fixed so procedure can run with protoora and adjust schema
   DLM         01/25/00 Added sequences to delete loop.
   DLM         06/01/00 Fixed seq name translation so _seq becomes _se
   DLM         05/10/01 Added check for _Unique now that DESC Index can not
                        be determined if unique so make sure it matches Original
   DLM         05/09/02 Change length from 30 to 26 to match protoora.
   DLM         07/23/02 Added _OWNER = "Pub" on the delete for each _file section. 20020723-004
   DLM         06/21/11 kmayur  added support for constraint - OE00195067                                
--------------------------------------------------------------------*/
/*h-*/

{ prodict/user/uservar.i } 

/* _ora_fix */

DEFINE SHARED VARIABLE drec_db  AS RECID     NO-UNDO.

DEFINE VARIABLE a               AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_dump-name     AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_idx-num       AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_max-order     AS INTEGER   NO-UNDO.
DEFINE VARIABLE oseqn           AS CHARACTER NO-UNDO.
DEFINE VARIABLE ofiln           AS CHARACTER NO-UNDO.
DEFINE VARIABLE ofldn           AS CHARACTER NO-UNDO.
DEFINE VARIABLE aofldn          AS CHARACTER NO-UNDO.
DEFINE VARIABLE m21             AS CHARACTER NO-UNDO.
DEFINE VARIABLE oidxn           AS CHARACTER NO-UNDO.
DEFINE VARIABLE ppi             AS CHARACTER NO-UNDO.
DEFINE VARIABLE opi             AS CHARACTER NO-UNDO.
DEFINE VARIABLE cext            AS INTEGER   NO-UNDO.
DEFINE VARIABLE ri              AS INTEGER   NO-UNDO.
DEFINE VARIABLE msg                AS CHARACTER   EXTENT 4 NO-UNDO.
DEFINE VARIABLE batch_mode      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE dbtype-l         AS CHARACTER NO-UNDO.
DEFINE VARIABLE migCon           AS LOGICAL   NO-UNDO.

DEFINE VARIABLE l_files          AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_seqs           AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_views          AS CHARACTER NO-UNDO.
DEFINE vARIABLE l_sys-obj        AS CHARACTER NO-UNDO.
DEFINE VARIABLE del-cycle        AS LOGICAL   NO-UNDO.

DEFINE VARIABLE max_name_size    AS CHARACTER INITIAL "26" NO-UNDO.
DEFINE VARIABLE temp_dbtype-1    AS CHARACTER NO-UNDO.
DEFINE VARIABLE temp_size        AS INTEGER   NO-UNDO.
DEFINE VARIABLE cid              AS CHARACTER NO-UNDO.

/* CR#00195067 */
DEFINE VARIABLE sconn            AS CHARACTER NO-UNDO.
DEFINE VARIABLE con-fld_recid    AS INTEGER   NO-UNDO.
DEFINE VARIABLE con_indx_recid   AS INTEGER   NO-UNDO.
DEFINE VARIABLE con_parnt_recid  AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_con-num        AS INTEGER   NO-UNDO.
DEFINE BUFFER   f_DICTDB2         FOR DICTDB2._File.
DEFINE BUFFER   f_DICTDB         FOR DICTDB._File.

DEFINE TEMP-TABLE verify-fname NO-UNDO
  FIELD new-name LIKE _Field._Field-name
  INDEX trun-name IS UNIQUE new-name.

DEFINE TEMP-TABLE verify-table NO-UNDO
  FIELD tnew-name LIKE _File._File-name
  INDEX trun-name IS UNIQUE tnew-name.

DEFINE BUFFER   a_DICTDB        FOR DICTDB._Field.
DEFINE BUFFER   i_DICTDB        FOR DICTDB._Index.

/* DICTDB is the newly created schema holder.
 * DICTDB2 is the original progress database.
 */

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/
FORM
  SKIP(1)
  msg[1] FORMAT "x(25)" LABEL " File"      SKIP
  msg[2] FORMAT "x(25)" LABEL " Field"     SKIP
  msg[3] FORMAT "x(25)" LABEL " Index"     SKIP
  msg[4] FORMAT "x(25)" LABEL " Component" SKIP
  SKIP(1)
  WITH FRAME ora_fix ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box three-d &ENDIF
  TITLE " Updating ORACLE Schema Holder".
  
/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/


/*------------------------------------------------------------------*/
/*---------------------------  MAIN-CODE  --------------------------*/
/*------------------------------------------------------------------*/


/*------------------------ INITIALIZATIONS -------------------------*/

ASSIGN 
  batch_mode = SESSION:BATCH-MODE
  dbtype-l = ",ORACLE," + max_name_size
  l_sys-obj   = {prodict/ora/ora_sys.i} /* non-queryable objects */
              + ","
              + "oracle_arguments,oracle_columns,oracle_comment,"
              + "oracle_idxcols,oracle_indexes,oracle_objects,"
              + "oracle_procedures,oracle_sequences,oracle_users,"
              + "oracle_links,oracle_synonyms,oracle_views,"
              + "oracle_tablespace,oracle_constraint,oracle_cons,oracle_cons_fld".
  
IF NOT batch_mode
  then assign SESSION:IMMEDIATE-DISPLAY = yes.

IF ENTRY(1,user_env[36]) = "y" 
THEN migCon = YES.
ELSE migCon = NO. 
 
if  user_env[25] = "**all**"
 or user_env[25] = ""
 then assign
  l_files = "**all**"
  l_seqs  = "**all**"
  l_views = "**all**"
  del-cycle = TRUE.
  
else if  num-entries(user_env[25],";") < 2
 then assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = "**all**"
  l_views = "**all**".
else if  num-entries(user_env[25],";") < 3
 then assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = entry(2,user_env[25],";")
  l_views = "**all**".
 else assign
  l_files = entry(1,user_env[25],";")
  l_seqs  = entry(2,user_env[25],";")
  l_views = entry(3,user_env[25],";").


/*------------------------------------------------------------------*/
/*-----------------------------  VIEWS  ----------------------------*/
/*------------------------------------------------------------------*/

FOR EACH DICTDB2._View
  where ( l_views = "**all**"
       or lookup(DICTDB2._View._View-Name,l_views) <> 0
        ):
  FIND DICTDB._View WHERE DICTDB._View._View-Name = DICTDB2._View._View-Name NO-ERROR.
  IF AVAILABLE DICTDB._View THEN DO:
    FOR EACH DICTDB._View-col OF DICTDB._View:
        DELETE DICTDB._View-col.
    END.
    FOR EACH DICTDB._View-ref OF DICTDB._View:
        DELETE DICTDB._View-ref.
    END.
    DELETE DICTDB._View.
  END.
  CREATE DICTDB._View.
  ASSIGN DICTDB._View._View-Name    = DICTDB2._View._View-Name
         DICTDB._View._Auth-Id      = DICTDB2._View._Auth-Id
         DICTDB._View._Base-Tables  = DICTDB2._View._Base-Tables
         DICTDB._View._Where-Cls    = DICTDB2._View._Where-Cls
         DICTDB._View._Group-By     = DICTDB2._View._Group-By
         DICTDB._View._View-Def     = DICTDB2._View._View-Def
         DICTDB._View._Can-Read     = DICTDB2._View._Can-Read
         DICTDB._View._Can-Write    = DICTDB2._View._Can-Write
         DICTDB._View._Can-Create   = DICTDB2._View._Can-Create
         DICTDB._View._Can-Delete   = DICTDB2._View._Can-Delete
         DICTDB._View._Desc         = DICTDB2._View._Desc
         DICTDB._View._Updatable    = DICTDB2._View._Updatable.
  FOR EACH DICTDB2._View-Col of DICTDB2._View:    
    CREATE DICTDB._View-Col.
    ASSIGN DICTDB._View-Col._View-Name = DICTDB2._View-Col._View-Name
           DICTDB._View-Col._Auth-Id    = DICTDB2._View-Col._Auth-Id
           DICTDB._View-Col._Col-Name   = DICTDB2._View-Col._Col-Name
           DICTDB._View-Col._Base-Col   = DICTDB2._View-Col._Base-Col
           DICTDB._View-Col._Can-Write  = DICTDB2._View-Col._Can-Write
           DICTDB._View-Col._Can-Create = DICTDB2._View-Col._Can-Create
           DICTDB._View-Col._Vcol-Order = DICTDB2._View-Col._Vcol-Order.
  END. /* DICTDB2._View-Col */

  FOR EACH DICTDB2._View-Ref of DICTDB2._View:    
    CREATE DICTDB._View-Ref.
    ASSIGN DICTDB._View-Ref._View-Name = DICTDB2._View-Ref._View-Name
           DICTDB._View-Ref._Auth-Id   = DICTDB2._View-Ref._Auth-Id
           DICTDB._View-Ref._Ref-Table = DICTDB2._View-Ref._Ref-Table
           DICTDB._View-Ref._Base-Col  = DICTDB2._View-Ref._Base-Col.
  END. /* DICTDB2._View-Ref */
END. /* each DICTDB2._View */


/*------------------------------------------------------------------*/
/*--------------------------- SEQUENCES ----------------------------*/
/*------------------------------------------------------------------*/

FOR EACH DICTDB2._Sequence
  where ( l_seqs = "**all**"
       or lookup(DICTDB2._Sequence._Seq-Name,l_seqs) <> 0
        ):

  oseqn = _Seq-Name + dbtype-l.
  
  RUN prodict/misc/_resxlat.p (INPUT-OUTPUT oseqn).
  /* check to see if ends in _seq then rememove q like wrktgen does */
  IF length(oseqn) > 3 AND lc(SUBSTRING(oseqn, (LENGTH(oseqn) - 3))) = "_seq" THEN
        ASSIGN oseqn = SUBSTRING(oseqn, 1, (LENGTH(oseqn) - 1)).

  IF batch_mode and logfile_open
   then put stream logfile unformatted 
      "Sequence " at 10 _Seq-Name at 25 skip.

  FIND DICTDB._Sequence WHERE  DICTDB._Sequence._DB-Recid = drec_db
                          AND    DICTDB._Sequence._Seq-name = oseqn NO-ERROR.
  IF NOT AVAILABLE DICTDB._Sequence THEN 
    FIND DICTDB._Sequence WHERE  DICTDB._Sequence._DB-Recid = drec_db
                          AND    DICTDB._Sequence._Seq-name = DICTDB2._Sequence._Seq-name NO-ERROR.

  IF NOT AVAILABLE DICTDB._Sequence THEN DO:
    CREATE DICTDB._Seq.
    ASSIGN DICTDB._Sequence._Db-recid = drec_db.
  END.

  ASSIGN
    DICTDB._Sequence._Seq-Name   = DICTDB2._Sequence._Seq-Name
    DICTDB._Sequence._Seq-Init   = DICTDB2._Sequence._Seq-Init
    DICTDB._Sequence._Seq-Incr   = DICTDB2._Sequence._Seq-Incr
    DICTDB._Sequence._Seq-Min    = DICTDB2._Sequence._Seq-Min
    DICTDB._Sequence._Seq-Max    = DICTDB2._Sequence._Seq-Max
    DICTDB._Sequence._Cycle-Ok   = DICTDB2._Sequence._Cycle-OK.

  END. /* each DICTDB2._Sequence */


/*------------------------------------------------------------------*/
/*----------------------------  FILES  -----------------------------*/
/*------------------------------------------------------------------*/

/* To avoid double dump-names we set them to ? for now, they will be
 * set to dictdb2._File._Dump-name lateron
 */
FOR EACH DICTDB._File  WHERE DICTDB._File._DB-recid = drec_db
                         AND DICTDB._File._Owner = "_FOREIGN" 
                         and   ( l_files = "**all**"
                                 or lookup(DICTDB._File._File-name,l_files) <> 0 ):
  ASSIGN DICTDB._File._Dump-name = ?.
END. /* each DICTDB2._File */

/* now adjust the file to match the original */
FOR EACH DICTDB2._File WHERE ( l_files = "**all**" or 
                               lookup(DICTDB2._File._File-name,l_files) <> 0)
                         AND DICTDB2._File._Owner = "PUB":

  IF _File-name BEGINS "_" OR
     _File-name BEGINS "oracle_" THEN NEXT.
  
  ASSIGN dbtype-l = ",ORACLE," + max_name_size.

  IF _for-name <> ? AND _for-name <> "" AND _for-name <> "n/a" THEN
    ASSIGN ofiln = _For-name.
  ELSE DO:  
    ofiln = _File-name + dbtype-l.
    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT ofiln).
  END.

  _verify-table:
  DO WHILE TRUE:
    FIND verify-table WHERE verify-table.tnew-name = ofiln NO-ERROR.
    IF NOT AVAILABLE verify-table THEN DO:
      CREATE verify-table.
      ASSIGN verify-table.tnew-name = ofiln.
      LEAVE _verify-table.
    END.
    ELSE DO:
      DO a = 1 TO 999:
        ASSIGN ofiln = SUBSTRING(ofiln, 1, LENGTH(ofiln) - LENGTH(STRING(a))) + STRING(a).

        IF CAN-FIND(verify-table WHERE verify-table.tnew-name = ofiln) THEN NEXT.
        ELSE DO:
          CREATE verify-table.
          ASSIGN verify-table.tnew-name = ofiln.
          LEAVE _verify-table.
        END.
      END.
    END.    
  END.

  FIND DICTDB._File WHERE DICTDB._File._Db-Recid  = drec_db
                      AND DICTDB._File._File-name = ofiln
                      AND DICTDB._File._Owner = "_FOREIGN" NO-ERROR.

  IF NOT AVAILABLE DICTDB._File THEN NEXT.

  if batch_mode and logfile_open then 
      put stream logfile unformatted "Table " at 10 
                                 DICTDB2._File._File-name at 25 skip.


/*------------------------------------------------------------------*/
/*------------------------  FILE_TRIGGERS  -------------------------*/
/*------------------------------------------------------------------*/

  FOR EACH DICTDB2._File-Trig OF DICTDB2._File:
    FIND DICTDB._File-Trig OF DICTDB._File WHERE   
      DICTDB._File-Trig._Event = DICTDB2._File-Trig._Event NO-ERROR.
    IF AVAILABLE DICTDB._File-Trig THEN 
        DELETE DICTDB._File-Trig.

    CREATE DICTDB._File-Trig.
    ASSIGN DICTDB._File-Trig._File-Recid = RECID(DICTDB._File)
           DICTDB._File-Trig._Event      = DICTDB2._File-Trig._Event
           DICTDB._File-Trig._Proc-Name  = DICTDB2._File-Trig._Proc-Name
           DICTDB._File-Trig._Override   = DICTDB2._File-Trig._Override.

  END. /* each DICTDB2._File-Trig OF DICTDB2._File */


/*------------------------------------------------------------------*/
/*---------------------------  FIELDS  -----------------------------*/
/*------------------------------------------------------------------*/

/*---------------  Inits to avoid Order-collisions  ----------------*/

  FOR EACH DICTDB._Field OF DICTDB._File:

    IF TERMINAL <> "" and not batch_mode THEN
      DISPLAY  DICTDB._File._File-name @ msg[1]
        DICTDB._Field._Field-name @ msg[2]
        "" @ msg[3] "" @ msg[4]
        WITH FRAME ora_fix.

    IF DICTDB._Field._For-Type = "TIME"
     THEN DELETE DICTDB._Field.
     ELSE ASSIGN DICTDB._Field._Order = DICTDB._Field._Order + 100000.

    END. /* each DICTDB._Field */

  /* Clear temp table for new file */
  FOR EACH verify-fname:
     DELETE verify-fname.
  END.

  assign l_max-order = 0.

  FOR EACH DICTDB2._Field OF DICTDB2._File:
    IF DICTDB2._Field._For-name <> ? AND DICTDB2._Field._For-name <> "" THEN
      ASSIGN ofldn = DICTDB2._Field._For-name.
    ELSE
      ASSIGN ofldn = DICTDB2._Field._Field-name.

    /*--------  Avoid collisions with unrolled extents  -------------*/

    ri = R-INDEX (ofldn, "#").    
    IF ri > 2 AND ri < LENGTH (ofldn,"character")
     THEN DO:  /* found an extent-indicator */
     
      IF INDEX ("0123456789", SUBSTR (ofldn, ri + 1, 1,"character")) > 0
       THEN DO:
        aofldn = SUBSTR (ofldn, 1, ri - 1,"character").
        IF CAN-FIND(DICTDB._Field OF DICTDB._File
              WHERE DICTDB._Field._Field-name = aofldn)
         THEN DO:
          OVERLAY (ofldn, ri, 1, "character") = "_".
          END.
        END.
        
      END.     /* found an extent-indicator */
    

    IF (DICTDB2._Field._Extent > 0) THEN
        /* Need to process extent fields diferently. We add extra characters to
           the columns when they are extents, so need to take that into account
           when calculating the max size for the field name:
           size =  maximum - 2 (for ##) - number of digits in the extent field 
        */
        ASSIGN temp_size = INTEGER(max_name_size) - 2 - LENGTH(STRING(DICTDB2._Field._Extent))
               temp_dbtype-1 = ",ORACLE," + TRIM(STRING(temp_size))
               ofldn = ofldn + temp_dbtype-1.
    ELSE
        ASSIGN ofldn = ofldn + dbtype-l.

    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT ofldn).

    /* We have to do the same thing we do when running protoora.
       We need to keep track of the names we come up with, and
       find unique names if the one we just got now is duplicate.*/
    FIND FIRST verify-fname WHERE new-name = ofldn NO-ERROR.

    IF NOT AVAILABLE verify-fname THEN DO:
      CREATE verify-fname.
      ASSIGN verify-fname.new-name = ofldn.
    END.
    ELSE DO:
        DO a = 1 TO 999:
          ASSIGN ofldn = SUBSTRING(ofldn, 1, LENGTH(ofldn) - LENGTH(STRING(a))) + STRING(a).

          IF CAN-FIND(verify-fname WHERE verify-fname.new-name = ofldn) THEN 
              NEXT.
          ELSE DO:
            CREATE verify-fname.
            ASSIGN verify-fname.new-name = ofldn.
            LEAVE. /* get out of the a =1 to 999 loop */
          END.
        END.
    END.

    IF TERMINAL <> "" and not batch_mode THEN
      DISPLAY  DICTDB2._File._File-name @ msg[1]
        DICTDB2._Field._Field-name @ msg[2]
        "" @ msg[3] "" @ msg[4]
        WITH FRAME ora_fix.

/*-----------------------  Extent handling  ------------------------*/

    IF DICTDB2._Field._Extent > 0
     AND NOT CAN-FIND(DICTDB._Field OF DICTDB._File
                WHERE DICTDB._Field._Field-name = ofldn OR
                      DICTDB._Field._For-name = ofldn)
     THEN DO:  /* field with extent */

      aofldn = ofldn + "#".

      FIND a_DICTDB OF DICTDB._File
        WHERE a_DICTDB._Field-name = aofldn
        NO-ERROR.
      IF NOT AVAILABLE a_DICTDB THEN NEXT.

      m21 = a_DICTDB._For-Name.
      IF R-INDEX (m21, "#") > 3 THEN
        m21 = SUBSTR (m21, 1, R-INDEX(m21, "#") - 2,"character").

      CREATE DICTDB._Field.
      ASSIGN
        DICTDB._Field._File-recid    = RECID(DICTDB._File)
        DICTDB._Field._For-Name      = m21
        DICTDB._Field._Fld-stdtype   = a_DICTDB._Fld-stdtype
        DICTDB._Field._Fld-stoff     = a_DICTDB._Fld-stoff
        DICTDB._Field._Fld-misc2[8]  = a_DICTDB._Fld-misc2[8]

        DICTDB._Field._Field-name    = DICTDB2._Field._Field-name
        DICTDB._Field._Fld-case      = DICTDB2._Field._Fld-case
        DICTDB._Field._Data-type     = DICTDB2._Field._Data-type
        DICTDB._Field._Format        = DICTDB2._Field._Format
        DICTDB._Field._Initial       = DICTDB2._Field._Initial
        DICTDB._Field._Mandatory     = DICTDB2._Field._Mandatory
        DICTDB._Field._Decimals      = DICTDB2._Field._Decimals
        DICTDB._Field._Order         = DICTDB2._Field._Order
        DICTDB._Field._Desc          = DICTDB2._Field._Desc
        DICTDB._Field._Can-Read      = DICTDB2._Field._Can-Read
        DICTDB._Field._Can-Write     = DICTDB2._Field._Can-Write
        DICTDB._Field._Label         = DICTDB2._Field._Label
        DICTDB._Field._Col-label     = DICTDB2._Field._Col-label
        DICTDB._Field._Valexp        = DICTDB2._Field._Valexp
        DICTDB._Field._Valmsg        = DICTDB2._Field._Valmsg
        DICTDB._Field._Help          = DICTDB2._Field._Help
        DICTDB._Field._Col-label-sa  = DICTDB2._Field._Col-label-sa
        DICTDB._Field._Format-sa     = DICTDB2._Field._Format-sa
        DICTDB._Field._Help-sa       = DICTDB2._Field._Help-sa
        DICTDB._Field._Initial-sa    = DICTDB2._Field._Initial-sa
        DICTDB._Field._Label-sa      = DICTDB2._Field._Label-sa
        DICTDB._Field._Valmsg-sa     = DICTDB2._Field._Valmsg-sa
        DICTDB._Field._For-Id        = a_DICTDB._For-Id
        DICTDB._Field._For-Primary   = a_DICTDB._For-Primary
        DICTDB._Field._For-Spacing   = a_DICTDB._For-Spacing
        DICTDB._Field._For-Scale     = a_DICTDB._For-Scale
        DICTDB._Field._For-Type      = a_DICTDB._For-Type
        DICTDB._Field._For-Itype     = a_DICTDB._For-Itype
        DICTDB._Field._For-Xpos      = a_DICTDB._For-Xpos
        DICTDB._Field._For-Retrieve  = a_DICTDB._For-Retrieve
        DICTDB._Field._For-Separator = a_DICTDB._For-Separator
        DICTDB._Field._For-Maxsize   = a_DICTDB._For-Maxsize
        DICTDB._Field._For-Allocated = a_DICTDB._For-Allocated
        DICTDB._Field._View-As       = DICTDB2._Field._View-As
        DICTDB._Field._Extent        = DICTDB2._Field._Extent
        l_max-order                  = MAX(l_max-order
                                          ,DICTDB._Field._Order).
      
     /*
      * OE00218270 : Commented out to remove RECID mapping to Oracle integer.
      * RECID now mapped directly to NUMBER from _ora_typ.p map list.
      IF DICTDB._Field._Data-type = "RECID"
       THEN DICTDB._Field._Data-type = "INTEGER".
      */

      DO cext = 1 TO DICTDB._Field._Extent:
        aofldn = ofldn + "#" + STRING (cext).
        FIND a_DICTDB OF DICTDB._File
          WHERE a_DICTDB._Field-name = aofldn
          NO-ERROR.
        IF AVAILABLE a_DICTDB
         THEN DELETE a_DICTDB.
        END. /* DICTDB._Field._Extent > 1 DO cext = 1 TO ... */

      END.     /* field with extent */

     ELSE DO:  /* field without extent */

      /* if the user already ran the adjust schema option previously, and
         the field name containe a character that was modified when pushed
         to the Oracle database, we won't find a record with the _Field-name.
         Need to look at the _For-name as well, otherwise the fields in this
         table will have the wrong _order values.
      */

      FIND DICTDB._Field OF DICTDB._File
        WHERE DICTDB._Field._Field-name = ofldn OR 
              DICTDB._Field._For-name = ofldn NO-ERROR.

      IF DICTDB2._Field._For-name MATCHES ".*##1"
       AND NOT AVAILABLE DICTDB._Field
       THEN DO:
        /* If DICTDB2 is really a pre 6.3c schema holder, use the #1 _Field */
        /* to set-up the array's _Field record. */
        FIND DICTDB._Field OF DICTDB._File
          WHERE DICTDB._Field._Field-name = SUBSTR
                      (DICTDB2._Field._For-name
                      ,1
                      ,LENGTH (DICTDB2._Field._For-name,"character") - 3
                      ,"character") NO-ERROR.
        END.

      IF NOT AVAILABLE DICTDB._Field THEN NEXT.
      
      END.     /* field without extent */

/*---------------------  Adjust Field itself  ----------------------*/

    ASSIGN
      DICTDB._Field._Field-name    = DICTDB2._Field._Field-name
      DICTDB._Field._Fld-case      = DICTDB2._Field._Fld-case
      DICTDB._Field._Data-type     = DICTDB2._Field._Data-type
      DICTDB._Field._Format        = DICTDB2._Field._Format
      DICTDB._Field._Initial       = DICTDB2._Field._Initial
      DICTDB._Field._Mandatory     = DICTDB2._Field._Mandatory
      DICTDB._Field._Decimals      = DICTDB2._Field._Decimals
      DICTDB._Field._Order         = DICTDB2._Field._Order
      DICTDB._Field._Desc          = DICTDB2._Field._Desc
      DICTDB._Field._Can-Read      = DICTDB2._Field._Can-Read
      DICTDB._Field._Can-Write     = DICTDB2._Field._Can-Write
      DICTDB._Field._Label         = DICTDB2._Field._Label
      DICTDB._Field._Col-label     = DICTDB2._Field._Col-label
      DICTDB._Field._Valexp        = DICTDB2._Field._Valexp
      DICTDB._Field._Valmsg        = DICTDB2._Field._Valmsg
      DICTDB._Field._Col-label-sa  = DICTDB2._Field._Col-label-sa
      DICTDB._Field._Format-sa     = DICTDB2._Field._Format-sa
      DICTDB._Field._Help-sa       = DICTDB2._Field._Help-sa
      DICTDB._Field._Initial-sa    = DICTDB2._Field._Initial-sa
      DICTDB._Field._Label-sa      = DICTDB2._Field._Label-sa
      DICTDB._Field._Valmsg-sa     = DICTDB2._Field._Valmsg-sa      
      DICTDB._Field._View-As       = DICTDB2._Field._View-As
      DICTDB._Field._Help          = DICTDB2._Field._Help
      l_max-order                  = MAX(l_max-order,DICTDB._Field._Order).

     /*
      * OE00218270 : Commented out to remove RECID mapping to Oracle integer.
      * RECID now mapped directly to NUMBER from _ora_typ.p map list.
      IF DICTDB._Field._Data-type = "RECID"
       THEN DICTDB._Field._Data-type = "INTEGER".
      */

/*------------------------------------------------------------------*/
/*------------------------  FIELD-TRIGGERS  ------------------------*/
/*------------------------------------------------------------------*/

    FOR EACH DICTDB2._Field-Trig OF DICTDB2._Field:
      FIND DICTDB._Field-Trig OF DICTDB._Field WHERE
        DICTDB._Field-Trig._Event = DICTDB2._Field-Trig._Event NO-ERROR.
      IF AVAILABLE DICTDB._Field-Trig THEN 
          DELETE DICTDB._Field-Trig.

      CREATE DICTDB._Field-Trig.
      ASSIGN
          DICTDB._Field-Trig._Field-Recid = RECID (DICTDB._Field)
          DICTDB._Field-Trig._File-Recid  = RECID (DICTDB._File)
          DICTDB._Field-Trig._Event       = DICTDB2._Field-Trig._Event
          DICTDB._Field-Trig._Proc-Name   = DICTDB2._Field-Trig._Proc-Name
          DICTDB._Field-Trig._Override    = DICTDB2._Field-Trig._Override.
    END. /* each DICTDB2._Field-Trig OF DICTDB2._Field */
  END. /* each DICTDB2._Field OF DICTDB2._File */
  
/*----------------------  Reset Field-Order  -----------------------*/

for each DICTDB._Field of DICTDB._File where DICTDB._Field._Order > 100000:
  ASSIGN l_max-order          = l_max-order + 10
         DICTDB._Field._Order = l_max-order.
end.


/*------------------------------------------------------------------*/
/*---------------------------  INDEXES  ----------------------------*/
/*------------------------------------------------------------------*/
 
/* Find greatest index number if we need to add another index */
  assign l_idx-num = 0.
  for each DICTDB._Index of DICTDB._File:
    if l_idx-num < DICTDB._Index._idx-num
     then assign l_idx-num = DICTDB._Index._idx-num.
  END.

  ASSIGN dbtype-l = ",ORACLE,30".

  _idxloop:
  FOR EACH DICTDB2._Index OF DICTDB2._File:
    IF DICTDB2._Index._Wordidx = 1  OR DICTDB2._Index._Index-name = "default"
       THEN NEXT _idxloop.

    ASSIGN oidxn = DICTDB2._Index._Index-Name + dbtype-l.

    IF TERMINAL <> "" and not batch_mode THEN
      DISPLAY  DICTDB2._File._File-name @ msg[1] "" @ msg[2]
         DICTDB2._Index._Index-Name @ msg[3] "" @ msg[4]
        WITH FRAME ora_fix.

    RUN prodict/misc/_resxlat.p (INPUT-OUTPUT oidxn).
   
    IF batch_mode and logfile_open
     THEN put stream logfile unformatted 
       "Index" at 10 DICTDB2._Index._Index-name at 25 skip.


/*---------------------  Adjust Index itself  ----------------------*/

    FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = oidxn
      NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._For-Name = CAPS(oidxn)
      NO-ERROR.
    IF NOT AVAILABLE DICTDB._Index THEN
      FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-name = DICTDB2._index._Index-name NO-ERROR.

&SCOPED-DEFINE  MAX_IDX_LEN 30
&SCOPED-DEFINE  UNIK  "##"       /* adjust LEN_UNIK if this changes */
&SCOPED-DEFINE  LEN_UNIK      2

    IF NOT AVAILABLE DICTDB._Index THEN DO:
        /* upon migration, we may have trimmed some characters off of the index name if the index name was too big
           or if it conflicted with another index name generated (in case table and index name were trimmed to the same
           string). Therefore, we are going to try to do the same thing here to emulate what was done upon migration: try to generate
           the name of the foreign index with the info we have and try to find the index in the schema holder.
           This still may not find it if we had to again trim characters off of the generated foreign name to resolve duplicate names, so
           we will trim one character at a time and check if we can find the index that way.
        */
        IF LENGTH(ofiln) + LENGTH(oidxn) +  {&LEN_UNIK} > {&MAX_IDX_LEN} THEN DO:
            IF LENGTH(oidxn) + 2 <  {&MAX_IDX_LEN} THEN  /* easy way */
                ASSIGN oidxn = SUBSTRING(ofiln,1,  {&MAX_IDX_LEN} - LENGTH(oidxn) -  {&LEN_UNIK}) + {&UNIK} + oidxn.
            ELSE DO:  /* Then, we have to knock some chars off of oidxn as well */
              
                REPEAT:
                  oidxn =  SUBSTRING (oidxn,1, LENGTH(oidxn) - 1).       
                  IF LENGTH(oidxn) +  {&LEN_UNIK} <  {&MAX_IDX_LEN} THEN
                  LEAVE.   /* This is what we want */
                END.  

                ASSIGN oidxn = SUBSTRING(ofiln,1, {&MAX_IDX_LEN} - LENGTH(oidxn) - {&LEN_UNIK}) +  {&UNIK} + oidxn.
            END.
        END.  
        ELSE  /*string is okay */
              ASSIGN oidxn = ofiln +  {&UNIK} + oidxn. 
        
        /* _Index._For-name is case-sensitive, so get characters in uppercase */
        ASSIGN oidxn = CAPS(oidxn)
                     cid = oidxn.
        
        /* we will start with the name we have now, and then trim 1 character at a time and see if we can find it */
        REPEAT temp_size = (LENGTH(oidxn) - 1) TO 0 BY -1:

             FIND DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._For-Name = cid NO-ERROR.
             
             IF AVAILABLE DICTDB._Index THEN  DO:
                 ASSIGN oidxn = cid.
                 LEAVE.
             END. 
             /* trim one character */
             IF temp_size = 0 THEN
                 LEAVE.

             ASSIGN cid = SUBSTRING(oidxn, 1, temp_size).
       END.
    
    END.   /* not available _Index */

    IF NOT AVAILABLE DICTDB._Index THEN DO:  /* NOT AVAILABLE DICTDB._Index and not a word index */     
      CREATE DICTDB._Index.
      ASSIGN
        l_idx-num                   = l_idx-num + 1
        DICTDB._Index._File-recid   = RECID (DICTDB._File)
        DICTDB._Index._Wordidx      = DICTDB2._Index._Wordidx
        DICTDB._Index._Desc         = DICTDB2._Index._Desc
        DICTDB._Index._For-Name     = CAPS(oidxn)
        DICTDB._Index._For-type     = DICTDB2._Index._For-type
        DICTDB._Index._Index-name   = DICTDB2._Index._Index-Name
        DICTDB._Index._Active       = DICTDB2._Index._Active
        DICTDB._Index._idx-num      = l_idx-num
        DICTDB._Index._Unique       = DICTDB2._Index._Unique.
    END.     /* NOT AVAILABLE DICTDB._Index */
   
    ASSIGN DICTDB._Index._Desc       = DICTDB2._Index._Desc
           DICTDB._Index._Index-name = DICTDB2._Index._Index-name.
      
    IF DICTDB._Index._Unique <> DICTDB2._Index._Unique THEN
        ASSIGN DICTDB._Index._Unique       = DICTDB2._Index._Unique.

/*-------------------------  Index-Fields  -------------------------*/

    FOR EACH DICTDB2._Index-field OF DICTDB2._Index:

      FIND DICTDB2._Field WHERE RECID (DICTDB2._Field) = 
        DICTDB2._Index-field._Field-recid NO-ERROR.
        
      IF NOT AVAILABLE DICTDB2._Field OR DICTDB2._Index._Index-name = "default" 
          THEN NEXT.      

      IF TERMINAL <> "" and not batch_mode THEN
        DISPLAY  DICTDB2._File._File-name @ msg[1] "" @ msg[2]
          DICTDB2._Index._Index-Name @ msg[3]
          DICTDB2._Field._Field-name @ msg[4]
          WITH FRAME ora_fix.

      ofldn = DICTDB2._Field._Field-name.

      FIND DICTDB._Field WHERE DICTDB._Field._File-recid = RECID (DICTDB._File) 
                           AND DICTDB._Field._Field-name = ofldn NO-ERROR.
      
      IF NOT AVAILABLE DICTDB._Field THEN NEXT.

      FIND DICTDB._Index-field OF DICTDB._Index
        WHERE DICTDB._Index-field._Index-seq = DICTDB2._Index-field._Index-seq
        NO-ERROR.
      IF NOT AVAILABLE DICTDB._Index-field THEN DO:
          CREATE DICTDB._Index-field.
          ASSIGN
            DICTDB._Index-field._Index-recid = RECID (DICTDB._Index)
            DICTDB._Index-field._Field-recid = RECID (DICTDB._Field)
            DICTDB._Index-field._Index-seq   = DICTDB2._Index-field._Index-seq
            DICTDB._Index-field._Ascending   = DICTDB2._Index-field._Ascending
            DICTDB._Index-field._Abbreviate  = DICTDB2._Index-field._Abbreviate
            DICTDB._Index-field._Unsorted    = DICTDB2._Index-field._Unsorted.

      END. /* NOT avaiable DICTDB._Index-field */
      ELSE 
        ASSIGN
          DICTDB._Index-field._Ascending   = DICTDB2._Index-field._Ascending
          DICTDB._Index-field._Abbreviate  = DICTDB2._Index-field._Abbreviate.
         /* avaiable DICTDB._Index-field */

    END. /* each DICTDB2._Index-field */
  END. /* each DICTDB2._Index OF DICTDB2._File */


/*--------  Remove any extra indexes from the schema holder  -------*/
  _rmvidx:
  FOR EACH DICTDB._Index OF DICTDB._File:
    oidxn = DICTDB._Index._Index-Name.
    IF oidxn = "default_" THEN NEXT.   

    IF TERMINAL <> "" and not batch_mode THEN
      DISPLAY  DICTDB._File._File-name @ msg[1] "" @ msg[2]
         DICTDB._Index._Index-Name @ msg[3] "" @ msg[4]
        WITH FRAME Ora_fix.

    FIND DICTDB2._Index OF DICTDB2._File
      WHERE  DICTDB2._Index._Index-Name = DICTDB._Index._Index-Name NO-ERROR.
    IF AVAILABLE DICTDB2._Index THEN NEXT.
    IF RECID(DICTDB._Index) = DICTDB._File._Prime-index THEN DO:
      FIND FIRST i_dictdb WHERE RECID(i_dictdb) <> RECID(DICTDB._Index)
                             AND i_dictdb._File-recid = RECID(DICTDB._File)
                             AND i_dictdb._Unique NO-ERROR.
      IF AVAILABLE i_dictdb THEN 
        ASSIGN DICTDB._File._Prime-index = RECID(i_dictdb).
      ELSE DO:
        FIND FIRST i_dictdb WHERE RECID(i_dictdb) <> RECID(DICTDB._Index)
                              AND i_dictdb._File-recid = RECID(DICTDB._File)
                              NO-ERROR.
        IF AVAILABLE i_dictdb THEN
          ASSIGN DICTDB._File._Prime-index = RECID(i_dictdb).
        ELSE NEXT _rmvidx.
      END.
    END.

    FOR EACH DICTDB._Index-field OF DICTDB._Index:
      DELETE DICTDB._Index-field.
    END. /* DICTDB._Index-field OF DICTDB._Index */

    DELETE DICTDB._Index.

  END. /* DICTDB._Index OF DICTDB._File */


/*---------------------  Set the primary index  --------------------*/

  FIND DICTDB._Index WHERE RECID(DICTDB._Index) = DICTDB._File._Prime-Index
    NO-ERROR.
  IF AVAILABLE DICTDB._Index THEN
    opi = DICTDB._Index._Index-Name.
  ELSE
    opi = ?.

  FIND DICTDB2._Index WHERE RECID(DICTDB2._Index) = DICTDB2._File._Prime-Index
    NO-ERROR.
  IF AVAILABLE DICTDB2._Index THEN
    ppi = DICTDB2._Index._Index-Name.
  ELSE
    ppi = ?.

  IF opi <> ppi AND ppi <> ? THEN DO:
    FIND DICTDB._Index OF DICTDB._File WHERE
      DICTDB._Index._Index-Name = ppi NO-ERROR.
    IF AVAILABLE DICTDB._Index THEN DO:
      DICTDB._File._Prime-Index                = RECID(DICTDB._Index).
      END. /* AVAILABLE DICTDB._Index */
    END. /* opi <> ppi AND ppi <> ? */

/*------------------------------------------------------------------*/
/*------------------------  CONSTRAINTS    -------------------------*/
/*------------------------------------------------------------------*/

IF migCon THEN DO: /* constraints only fixed if migrate constraints set intitially */
  ASSIGN l_con-num = 0.
  FOR EACH DICTDB._Constraint:
    IF l_con-num < DICTDB._Constraint._con-num THEN
      ASSIGN l_con-num = DICTDB._Constraint._con-num.
  END.
  
  _con-loop:
  FOR EACH DICTDB2._Constraint OF DICTDB2._File:
    IF DICTDB2._Constraint._Con-Status = "D" OR DICTDB2._Constraint._Con-Status = "O"
       THEN NEXT _con-loop.
    IF (DICTDB2._Constraint._Con-Type = "M" OR DICTDB2._Constraint._Con-Type = "D")   
       THEN NEXT _con-loop.

        IF (DICTDB2._Constraint._Con-Type = "C")
        THEN DO:
          FIND FIRST DICTDB2._Field OF DICTDB2._File WHERE RECID(DICTDB2._Field) = DICTDB2._Constraint._Field-Recid NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Field-Name = DICTDB2._Field._Field-Name NO-LOCK NO-ERROR.
          ASSIGN con-fld_recid = RECID (DICTDB._Field).
        END.   
        
        IF (DICTDB2._Constraint._Con-Type = "F" OR DICTDB2._Constraint._Con-Type = "U" OR DICTDB2._Constraint._Con-Type = "PC" 
              OR DICTDB2._Constraint._Con-Type = "P" OR DICTDB2._Constraint._Con-Type = "MP")
        THEN DO:     
          FIND FIRST DICTDB2._Index OF DICTDB2._File WHERE RECID(DICTDB2._Index) = DICTDB2._Constraint._Index-Recid NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Index OF DICTDB._File WHERE DICTDB._Index._Index-Name = DICTDB2._Index._Index-Name NO-LOCK NO-ERROR.
          ASSIGN con_indx_recid = RECID (DICTDB._Index).
        END.
        
        IF DICTDB2._Constraint._Con-Type = "F"
        THEN DO:
          FIND FIRST DICTDB2._Index WHERE RECID(DICTDB2._Index) = DICTDB2._Constraint._Index-Parent-Recid NO-LOCK NO-ERROR.
          FIND first f_DICTDB2 WHERE RECID(f_DICTDB2) = DICTDB2._Index._File-Recid NO-LOCK NO-ERROR.
          FIND FIRST f_DICTDB WHERE f_DICTDB._File-Name = f_DICTDB2._File-Name NO-LOCK NO-ERROR.
          FIND FIRST DICTDB._Index OF f_DICTDB WHERE DICTDB._Index._Index-Name = DICTDB2._Index._Index-Name NO-LOCK NO-ERROR.
          ASSIGN con_parnt_recid = RECID(DICTDB._Index). 
        END.  
        
        
      FIND FIRST DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-Name = DICTDB2._Constraint._Con-Name EXCLUSIVE-LOCK NO-ERROR.
          IF NOT AVAILABLE(DICTDB._Constraint) THEN
      FIND FIRST DICTDB._Constraint OF DICTDB._File WHERE DICTDB._Constraint._Con-Name = DICTDB2._Constraint._For-Name EXCLUSIVE-LOCK NO-ERROR.
          IF NOT AVAILABLE(DICTDB._Constraint) 
      THEN DO: 
      l_con-num                        = l_con-num + 1.
     
      CREATE DICTDB._Constraint.
      ASSIGN
        DICTDB._Constraint._File-recid   = RECID (DICTDB._File)
        DICTDB._constraint._db-recid     = drec_db
        DICTDB._Constraint._Con-Desc     = DICTDB2._Constraint._Con-Desc
        DICTDB._Constraint._For-Name     = DICTDB2._Constraint._For-Name
        DICTDB._Constraint._Con-Name     = DICTDB2._Constraint._Con-Name
        DICTDB._Constraint._Con-Type     = DICTDB2._Constraint._Con-Type
        DICTDB._Constraint._Con-Expr     = DICTDB2._Constraint._Con-Expr
        DICTDB._Constraint._Con-Status   = DICTDB2._Constraint._Con-Status
        DICTDB._Constraint._Con-Type     = DICTDB2._Constraint._Con-Type
        DICTDB._constraint._con-num      = l_con-num
        DICTDB._Constraint._Con-Active   = TRUE.
        
        IF (DICTDB2._Constraint._Con-Type = "C")
        THEN
           DICTDB._Constraint._Field-Recid = con-fld_recid.
        ELSE 
           DICTDB._Constraint._Index-Recid = con_indx_recid.
        
        IF DICTDB2._Constraint._Con-Type = "F"
        THEN
           DICTDB._Constraint._Index-Parent-Recid = con_parnt_recid.   
        
      END.
      ELSE DO:
      ASSIGN 
        DICTDB._constraint._db-recid     = drec_db
        DICTDB._Constraint._Con-Desc     = DICTDB2._Constraint._Con-Desc
        DICTDB._Constraint._For-Name     = DICTDB2._Constraint._For-Name
        DICTDB._Constraint._Con-Name     = DICTDB2._Constraint._Con-Name
        DICTDB._Constraint._Con-Status   = DICTDB2._Constraint._Con-Status
        DICTDB._Constraint._Con-Expr     = DICTDB2._Constraint._Con-Expr
        DICTDB._Constraint._Con-Active   = TRUE.
        
        IF (DICTDB2._Constraint._Con-Type = "C" OR DICTDB2._Constraint._Con-Type = "D")
        THEN
           DICTDB._Constraint._Field-Recid = con-fld_recid.
        ELSE 
           DICTDB._Constraint._Index-Recid = con_indx_recid.
        
        IF DICTDB2._Constraint._Con-Type = "F"
        THEN
           DICTDB._Constraint._Index-Parent-Recid = con_parnt_recid.  
   
      END. 
  END.
  
  _rmcon:
  FOR EACH DICTDB._constraint OF DICTDB._File:
   FIND FIRST DICTDB2._Constraint WHERE DICTDB2._Constraint._Con-Name = DICTDB._Constraint._Con-Name NO-LOCK NO-ERROR.
   IF NOT AVAILABLE (DICTDB2._Constraint)
   THEN do:
      DELETE DICTDB._Constraint.
   END.
  END.
END. /* migrate constraints*/  


/*----------------------  Adjust File itself  ----------------------*/

  IF TERMINAL <> "" and not batch_mode THEN
    DISPLAY DICTDB2._File._File-name @ msg[1] "" @ msg[2] "" @ msg[3] 
      "" @ msg[4]
      WITH FRAME ora_fix.

  /* Do this last since it may set _File._Frozen. */


  ASSIGN
    DICTDB._File._File-name       = DICTDB2._File._File-name
    DICTDB._File._Can-Create      = DICTDB2._File._Can-Create
    DICTDB._File._Can-Read        = DICTDB2._File._Can-Read
    DICTDB._File._Can-Write       = DICTDB2._File._Can-Write
    DICTDB._File._Can-Delete      = DICTDB2._File._Can-Delete
    DICTDB._File._Desc            = DICTDB2._File._Desc
    DICTDB._File._Valexp          = DICTDB2._File._Valexp
    DICTDB._File._Valmsg          = DICTDB2._File._Valmsg
    DICTDB._File._For-Size        = DICTDB2._File._For-Size
    DICTDB._File._For-Flag        = DICTDB2._File._For-Flag
    DICTDB._File._For-Cnt1        = DICTDB2._File._For-Cnt1
    DICTDB._File._For-Cnt2        = DICTDB2._File._For-Cnt2
    DICTDB._File._For-Format      = DICTDB2._File._For-Format
    DICTDB._File._For-Info        = DICTDB2._File._For-Info
    DICTDB._File._For-Id          = DICTDB2._File._For-ID
    DICTDB._File._For-Number      = DICTDB2._File._For-Number
    DICTDB._File._File-Label      = DICTDB2._File._File-Label
    DICTDB._File._File-Label-sa   = DICTDB2._File._File-Label-sa
    DICTDB._File._Valmsg-sa       = DICTDB2._File._Valmsg-sa
    DICTDB._File._Dump-name       = DICTDB2._File._Dump-name
    DICTDB._File._Frozen          = DICTDB2._File._Frozen.

  END. /* each DICTDB2._File */

/* Now check DICTDB._File to make sure we get only those we pushed 
   if running from protoora or all objects being compared */
IF del-cycle THEN DO:
  FOR EACH DICTDB._File WHERE DICTDB._File._Owner = "_FOREIGN":
    IF DICTDB._File._For-type <> "TABLE" THEN NEXT.
    IF LOOKUP(DICTDB._FILE._File-name,l_sys-obj) = 0 THEN DO:
      FIND DICTDB2._File WHERE DICTDB2._File._File-name = DICTDB._File._File-name 
                           AND DICTDB2._File._Owner = "PUB" NO-ERROR.
      IF NOT AVAILABLE DICTDB2._File THEN DO:
        FOR EACH DICTDB._Constraint OF DICTDB._File:
           FOR EACH DICTDB._Constraint-Keys WHERE recid(DICTDB._Constraint) = DICTDB._Constraint-Keys._con-recid:
               DELETE DICTDB._Constraint-Keys.
           END.
           DELETE DICTDB._Constraint.
        END.      
        FOR EACH DICTDB._INDEX OF DICTDB._File:
          FOR EACH DICTDB._Index-field of DICTDB._Index:
            DELETE DICTDB._Index-field.
          END.
          DELETE DICTDB._Index.
        END.
        FOR EACH DICTDB._Field OF DICTDB._File:
          DELETE DICTDB._Field.
        END.
        DELETE DICTDB._File.
      END.
    END.
  END.  
  FOR EACH DICTDB._Sequence:
    FIND DICTDB2._Sequence WHERE DICTDB2._Sequence._Seq-name = DICTDB._Sequence._Seq-name NO-ERROR.
    IF NOT AVAILABLE DICTDB2._Sequence THEN
       DELETE DICTDB._Sequence.
  END.    
END.

IF not batch_mode THEN 
    HIDE FRAME ora_fix NO-PAUSE.

RETURN.
/***********************************************************************
* Copyright (C) 2000,2007-2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* ora_fld - field editor for Oracle files */

/*
dfields is NOT AVAILABLE to create, otherwise contains record to
UPDATE (you ain't spoz'ta CREATE with ORACLE files).

When you come into this routine, the field name is already set on the
form.

  _File._For-Name     = Foreign file name.
  _File._For-Owner    = Foreign file owner.
  _File._For-Type     = Foreign file type (TABLE, VIEW, SYNONYM, CLUSTER).
  _Field._Fld-stoff   = Field relative position in record.
  _Field._Fld-stdtype = Foreign field datatype.
  _Field._For-Name    = Foreign field name.
  _Field._For-retrieve = ? or 0 if field should be retrieved from Oracle,
                        1 if not (large objects ...)
  _Field._For-Type    = Foreign field datatype name.
  _Index._For-name    = Foreign index name.

  -----Oracle-----  ---Progress---
  Data Type  dtype  Data Type dtyp
  --------- ------  --------- ----
  Char       4,096  character    1
  Varchar    4,096  character    1
  Varchar2   4,096  character    1
  Float      8,192  decimal      5
  Number     8,192  decimal      5
  Number     8,192  integer      4
  Number     8,192  logical      3
  Date      12,288  date         2
  Long      16,384  character    1
  Raw       20,480  character    1
  Long Raw  24,576  character    1
  Time      28,672  integer      4
*/

DEFINE INPUT  PARAMETER ronly       AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER junk2       AS RECID       NO-UNDO.
DEFINE OUTPUT PARAMETER changed     AS LOGICAL     NO-UNDO INITIAL FALSE.

DEFINE SHARED  BUFFER   dfields     FOR _Field.
DEFINE         VARIABLE answer      AS LOGICAL     NO-UNDO.
DEFINE         VARIABLE chg-extent  AS LOGICAL     NO-UNDO.
DEFINE         VARIABLE i           AS INTEGER     NO-UNDO.
DEFINE         VARIABLE j           AS INTEGER     NO-UNDO.
DEFINE         VARIABLE inindex     AS LOGICAL     NO-UNDO.
DEFINE         VARIABLE inview      AS LOGICAL     NO-UNDO.
DEFINE         VARIABLE retriev     AS LOGICAL     NO-UNDO.
DEFINE         VARIABLE c           AS CHARACTER   NO-UNDO.
DEFINE         VARIABLE pro_typ     AS CHARACTER   NO-UNDO.
DEFINE         VARIABLE gat_typ     AS CHARACTER   NO-UNDO.
DEFINE         VARIABLE islob       AS LOGICAL     NO-UNDO.
DEFINE         VARIABLE oldType     AS CHARACTER   NO-UNDO.

DEFINE BUFFER tmpField FOR DICTDB._Field.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /* 1*/ "This field is used in a View or Index - cannot delete.",
  /* 2*/ "This field is used in a View - cannot rename.",
  /* 3*/ "Are you sure that you want to delete the field named",
  /* 4*/ "Cannot create ORACLE fields.  Must create on ORACLE side and",
  /* 5*/ "use ~"Update ORACLE definition~" to bring definition over.",
  /* 6*/ "", /* reserved */
  /* 7*/ "This is not an equivalent {&PRO_DISPLAY_NAME} datatype for the ORACLE datatype"
].

FORM
  dfields._Field-name   LABEL "  Field-Name" FORMAT "x(32)"
    VALIDATE(KEYWORD(dfields._Field-name) = ?,
      "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SPACE
  dfields._Data-type    LABEL    "Data-Type" FORMAT "x(11)"  SKIP

  dfields._For-Name LABEL " Oracle-Name" FORMAT "x(30)" SPACE(4)
  dfields._For-Type LABEL     "Ora-Type" FORMAT "x(12)" SKIP

  dfields._Format       LABEL "      Format" FORMAT "x(30)" SPACE(4)
  dfields._Fld-stoff    LABEL     "Column #" FORMAT ">>>9"
  dfields._Fld-case	LABEL " Case-sens"   FORMAT "y/n"   SKIP

  dfields._Label        LABEL "       Label" FORMAT "x(30)" SPACE(4)
  dfields._Decimals     LABEL     "   Scale" FORMAT "->>>>9" "(Decimals)" SKIP

  dfields._Col-label    LABEL "Column-label" FORMAT "x(30)" SPACE(4)
  dfields._Order        LABEL     "   Order" FORMAT ">>>>9"
  /* dfields._For-retrieve  */
  retriev              LABEL     "Retrieve ?" FORMAT "y/n" SKIP

  dfields._Initial      LABEL "     Initial" FORMAT "x(100)" 
                        VIEW-AS FILL-IN SIZE 30 BY 1        SPACE(4)
  dfields._Mandatory    LABEL     "Not Null" FORMAT "yes/no"
  dfields._Extent	LABEL	  "  Extent" FORMAT ">>>>9" SKIP

  dfields._Valexp       LABEL "Valexp"       VIEW-AS EDITOR
       	       	     	      	       	     INNER-CHARS 63 INNER-LINES 4
      	       	     	      	       	     BUFFER-LINES 4 SKIP

  dfields._Valmsg       LABEL "Valmsg"       FORMAT "x(63)" SKIP
  dfields._Help         LABEL "  Help"       FORMAT "x(63)" SKIP
  dfields._Desc         LABEL "  Desc"       FORMAT "x(70)" SKIP
  HEADER ""
  WITH FRAME ora_fld NO-BOX ATTR-SPACE OVERLAY SIDE-LABELS
  ROW (SCREEN-LINES - 19) COLUMN 1.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*---- LEAVE of data-type field---- */
on leave of dfields._data-type in frame ora_fld do:

  define variable l_type-match as logical no-undo.
  DEFINE VAR      l_dt-new     AS CHARACTER NO-UNDO.
  DEFINE VAR      l_for-type   AS CHARACTER NO-UNDO.
  DEFINE VAR      l_init       AS CHARACTER NO-UNDO.

  assign
    l_dt-new    = trim(input frame ora_fld dfields._Data-type)
    l_for-type  = input frame ora_fld dfields._For-type
    l_init      = input frame ora_fld dfields._Initial.

  /* validate on the SET stmt will take care of this */
  IF NOT CAN-DO(pro_typ,l_dt-new) THEN
      RETURN.

  /* handle changing date/datetime/char */
  IF  ( l_dt-new = "character" AND dfields._Data-type BEGINS "date")
   OR ( l_dt-new BEGINS "date" AND (l_dt-new NE dfields._Data-type))
   THEN DO:  /* change format and ev. initial */

      IF l_dt-new = "date" THEN DO:
          dfields._Format:SCREEN-VALUE IN FRAME ora_fld = "99/99/99".
          IF dfields._Initial = "now" THEN
             dfields._Initial:SCREEN-VALUE IN FRAME ora_fld = "today".
      END.
      ELSE IF l_dt-new BEGINS "datetime" THEN DO:
          IF l_dt-new = "datetime" THEN
             dfields._Format:SCREEN-VALUE IN FRAME ora_fld = "99/99/9999 HH:MM:SS.SSS".
          ELSE
             dfields._Format:SCREEN-VALUE IN FRAME ora_fld = "99/99/9999 HH:MM:SS.SSS+HH:MM".

          IF dfields._Initial = "today" THEN
             dfields._Initial:SCREEN-VALUE IN FRAME ora_fld = "now".
      END.
      ELSE IF l_dt-new = "character" THEN DO:
          ASSIGN dfields._Format:SCREEN-VALUE IN FRAME ora_fld = 
                        (IF dfields._For-type = "date"
                         THEN "9999/99/99 99:99:99"
                         ELSE IF dfields._For-type = "TIMESTAMP_TZ" 
                             THEN "X(34)" ELSE "X(26)")
                 dfields._Initial:SCREEN-VALUE IN FRAME ora_fld = ?.
      END.
  END.

  /* save away new value */
  dfields._Data-type = l_dt-new.
end.   /* on leave of dfields._data-type */


/* Main Block */

IF NOT AVAILABLE dfields THEN
  FIND FIRST dfields WHERE dfields._File-recid = drec_file
    USING FRAME ora_fld _Field-name NO-ERROR.

IF NOT AVAILABLE dfields THEN DO:
  MESSAGE new_lang[4] SKIP /* cannot create */
      	  new_lang[5]
      	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  HIDE MESSAGE NO-PAUSE.
  RETURN.
END.

/* PROCEDURES and FUNCTIONS and BUFFERS can have arrays as parameters
 * we have to allow the user to change the extent, because ORACLE does
 * not tell us the right number.
 */
FIND _File OF dfields NO-LOCK NO-ERROR.
 
ASSIGN
  chg-extent = available _File 
           AND CAN-DO("PROCEDURE,FUNCTION,BUFFER",_File._For-type)
           AND dfields._Extent > 0
  inindex    = CAN-FIND(FIRST _Index-field OF dfields)
  inview     = CAN-FIND(FIRST _View-ref
                          WHERE _View-ref._Ref-Table = user_filename
                          AND   _View-ref._Base-Col = dfields._Field-name).

IF dfields._For-type = "BLOB" OR dfields._data-type = "CLOB" THEN 
  ASSIGN islob = TRUE.
ELSE
  ASSIGN islob = FALSE.

/* Get the list of Progress types that can be used for the 
   gateway type for this field. */
ASSIGN
   pro_typ = "get-list"
   gat_typ = dfields._For-type
   oldType = dfields._Data-type
   c = ?
   i = ?.
RUN "prodict/ora/_ora_typ.p"
  (INPUT-OUTPUT i,INPUT-OUTPUT i,
   INPUT-OUTPUT pro_typ,INPUT-OUTPUT gat_typ,
   OUTPUT c).

RELEASE _File.

/*retriev = dfields._For-retrieve = 1.*/
DISPLAY
  dfields._Field-name
  dfields._Data-type
  dfields._For-Name
  dfields._For-Type
  retriev
  dfields._Format
  dfields._Label
  dfields._Col-label
  dfields._Initial
  dfields._Fld-stoff
  dfields._Fld-case WHEN dfields._Data-type = "CHARACTER"
  dfields._Decimals WHEN dfields._Data-type = "DECIMAL" 
  dfields._Order
  dfields._Mandatory
  dfields._Extent
  dfields._Valexp
  dfields._Valmsg
  dfields._Help
  dfields._Desc
  WITH FRAME ora_fld.

IF ronly = "r/o" THEN DO:
  { prodict/user/userpaus.i }
  HIDE FRAME ora_fld NO-PAUSE.
  RETURN.
END.

NEXT-PROMPT dfields._Format WITH FRAME ora_fld.

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  SET
    dfields._Field-name 
    dfields._Data-type  VALIDATE(
      CAN-DO(pro_typ,dfields._Data-type), new_lang[7]) /* not equiv dtype */
      /* OE00173867 - disallow type changed if foreign type is N/CLOB */
      WHEN NOT (dfields._For-type = "CLOB" OR dfields._For-type = "NCLOB")
  /*dfields._For-Name*/
  /*dfields._For-Type*/
    dfields._Format
    dfields._Label WHEN NOT islob
    dfields._Col-label WHEN NOT islob
    dfields._Initial WHEN NOT islob
  /*dfields._Fld-stoff*/
    dfields._Decimals WHEN dfields._Data-type = "DECIMAL"
    dfields._Order
    dfields._Fld-case WHEN INPUT dfields._Data-type = "character"
                        AND (NEW dfields OR NOT inindex)
    /* Suppress update of retrieve until implemented in Progress */
  /* retriev
    dfields._For-retrieve = IF retriev THEN ? ELSE 1 */
    dfields._Mandatory WHEN NOT islob
    dfields._Extent  WHEN chg-extent
    dfields._Valexp WHEN NOT islob
    dfields._Valmsg WHEN NOT islob
    dfields._Help WHEN NOT islob
    dfields._Desc
    WITH FRAME ora_fld.

  IF dfields._Field-name ENTERED AND NOT NEW dfields AND inview THEN DO:
    MESSAGE new_lang[2]. /* sorry, used in view */
    UNDO,RETRY.
  END.

  ASSIGN
    dfields._Valexp = (IF TRIM(dfields._Valexp) = "" 
      	       	     	 THEN ? 
      	       	     	 ELSE TRIM(dfields._Valexp)).

  IF oldType NE dfields._Data-type AND 
     can-do("date,character",oldType) AND dfields._Data-type BEGINS "datetime" THEN DO:

     /* remove the time companion field if changing from date to datetime */
      FIND FIRST tmpField WHERE tmpField._File-recid = 
          dfields._File-recid AND tmpField._For-name = dfields._For-name AND
          tmpField._For-type = "TIME" NO-ERROR.

      IF AVAILABLE tmpField THEN
         DELETE tmpField. /* delete it */
  END.
  changed = TRUE.
END.

HIDE FRAME ora_fld NO-PAUSE.
RETURN.
/*********************************************************************
* Copyright (C) 2008 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Procedure _ora_inc.p
   Donna L. McMann
   
   Created 08/19/98 Initial procedure for the Oracle Incremental Df Utility
   History:  12/14/99 D. McMann Changed label for extended objects
             04/13/00 D. McMann Added support for long path names
             06/20/01 D. McMann Added Foreign Owner
             06/25/02 D. McMann Added logic for function based indexes
             11/26/02 D. McMann Removed Oracle V7 support
             06/11/07 fernando  Unicode support   
             08/30/07 fernando  More Unicode support stuff
             01/22/08 fernando  Unicode support for ORACLE
*/   

{ prodict/user/uservar.i NEW }
{ prodict/ora/oravar.i NEW }
{ prodict/misc/filesbtn.i }

DEFINE VARIABLE create_df     AS LOGICAL INITIAL TRUE   NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL FALSE  NO-UNDO. 
DEFINE VARIABLE output_file   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE df-file       AS CHARACTER              NO-UNDO.
DEFINE VARIABLE i             AS INTEGER                NO-UNDO.
DEFINE VARIABLE schdbcon      AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE conparms      AS CHARACTER              NO-UNDO.
DEFINE VARIABLE l_curr-db     AS INTEGER INITIAL 1      NO-UNDO.
DEFINE VARIABLE l_dbnr        AS INTEGER                NO-UNDO.
DEFINE VARIABLE disp_msg1     AS LOGICAL INITIAL TRUE   NO-UNDO.
DEFINE VARIABLE disp_msg2     AS LOGICAL INITIAL TRUE   NO-UNDO.
DEFINE VARIABLE hasUniSupport AS LOGICAL                NO-UNDO.

DEFINE VARIABLE cFormat       AS CHARACTER 
                              INITIAL "For field widths use:"
                              FORMAT "x(20)" NO-UNDO.

FORM
  " "   SKIP 
    df-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Delta DF File" colon  15
  btn_File SKIP SKIP({&VM_WIDG})
  osh_dbname   FORMAT "x(256)"  view-as fill-in size 32 by 1 
    LABEL "Schema Holder Database" colon 35 SKIP({&VM_WID}) 
  ora_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
    LABEL "Connect parameters for Schema" colon 35 SKIP({&VM_WID})
  ora_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Logical name for ORACLE Database" colon 35 SKIP({&VM_WID})   
  ora_owner    FORMAT "x(32)"  VIEW-AS FILL-IN SIZE 32 BY 1
    LABEL "ORACLE Object Owner Name" COLON 35 SKIP({&VM_WID}) 
  ora_tspace FORMAT "x(30)" view-as fill-in size 32 by 1
     LABEL "ORACLE tablespace for Tables" colon 35 SKIP({&VM_WID})
  ora_ispace FORMAT "x(30)" view-as fill-in size 32  by 1
     LABEL "ORACLE tablespace for Indexes" colon 35 SKIP({&VM_WID})
  ora_varlen FORMAT ">>>9" 
      VALIDATE (INPUT ora_varlen > 0 AND
                INPUT ora_varlen <= 4000,
                "Maximum length must not be greater than 4000") 
           LABEL "Maximum char length"  COLON 35
  /*space(2) lExpandClob view-as toggle-box label "Expand to CLOB"*/ SKIP({&VM_WIDG})
  SPACE(3) pcompatible view-as toggle-box LABEL "Create RECID Field"  
  crtdefault VIEW-AS TOGGLE-BOX LABEL "Include Default" AT 40  SKIP({&VM_WID})
  SPACE(3) create_df view-as toggle-box LABEL "Create schema holder delta df"
  shadowcol VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" AT 40
  SKIP({&VM_WID})
  SPACE(3) lCharSemantics view-as toggle-box LABEL "Char Semantics"
  unicodeTypes view-as toggle-box LABEL "Use Unicode Types"   AT 40
  SKIP({&VM_WID})
  space(3) cFormat VIEW-AS TEXT NO-LABEL COLON 2
  iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                             "ABL Format", 2
                               HORIZONTAL NO-LABEL SKIP({&VM_WID})
  lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30" AT 39
             {prodict/user/userbtns.i}
  WITH FRAME read-df ROW 2 CENTERED SIDE-labels 
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF
  TITLE "Delta df to ORACLE Conversion".

/*=============================Triggers===============================*/

/*----- ON GO or OK -----*/
ON GO OF FRAME read-df
DO:
  IF (df-file:SCREEN-VALUE IN FRAME read-df = ? OR
      df-file:SCREEN-VALUE IN FRAME read-df = "") THEN DO:
    MESSAGE "Delta DF File is required. " VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO df-file IN FRAME read-df.
    RETURN NO-APPLY.
  END.

  IF SEARCH(df-file:SCREEN-VALUE IN FRAME read-df) = ? THEN DO:
    MESSAGE "Can not find a file of this name.  Try again." 
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO df-file IN FRAME read-df.
    RETURN NO-APPLY.
  END.
  ELSE
    ASSIGN df-file = df-file:SCREEN-VALUE IN FRAME read-df.

  IF osh_dbname:SCREEN-VALUE IN FRAME read-df = "" OR 
              osh_dbname:SCREEN-VALUE IN FRAME read-df = ? THEN DO:
    MESSAGE "Schema Holder Name is required."  VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO osh_dbname IN FRAME read-df.
    RETURN NO-APPLY. 
  END.
  
  REPEAT l_dbnr = 1 to NUM-DBS:
    IF LDBNAME("DICTDB") = LDBNAME(l_dbnr)
     THEN ASSIGN l_curr-db = l_dbnr.
  END.
  
  DO i = 1 TO NUM-DBS:
    IF PDBNAME(i) = osh_dbname:SCREEN-VALUE IN FRAME read-df OR 
       LDBNAME(i) = osh_dbname:SCREEN-VALUE IN FRAME read-df THEN DO:
      ASSIGN schdbcon = TRUE.
      CREATE ALIAS DICTDB FOR DATABASE 
         VALUE(LDBNAME(osh_dbname:SCREEN-VALUE IN FRAME read-df)).
    END.
  END.
  IF NOT schdbcon THEN DO:
    ASSIGN conparms = ora_conparms:SCREEN-VALUE IN FRAME read-df +  
                            " -ld schdb".
    CONNECT VALUE(osh_dbname:SCREEN-VALUE IN FRAME read-df) 
            VALUE(conparms) NO-ERROR.
    IF NOT CONNECTED(LDBNAME(osh_dbname:SCREEN-VALUE IN FRAME read-df)) THEN DO:
      MESSAGE osh_dbname:SCREEN-VALUE IN FRAME read-df
         " can not be connected using entered connect parameters."
        VIEW-AS ALERT-BOX ERROR.
      APPLY "ENTRY" to osh_dbname IN FRAME read-df.
      RETURN NO-APPLY.
     END.
  END.
END.

/*----- HELP in Oracle Incremental Utility FRAME read-df -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
on HELP of frame read-df or CHOOSE of btn_Help in frame read-df
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Incremental_Schema_Migration_Dlg_Box},
                             INPUT ?).
&ENDIF

on WINDOW-CLOSE of frame read-df
   apply "END-ERROR" to frame read-df.

ON LEAVE OF df-file in frame read-df
   df-file:screen-value in frame read-df = 
        TRIM(df-file:screen-value in frame read-df).

ON CHOOSE OF btn_File in frame read-df DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT df-file:handle in frame read-df /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT "*.df"                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.

ON VALUE-CHANGED OF ora_dbname IN FRAME read-df  DO:
   /* if user changes the name of the logical db name, check the oracle version */
   IF LDBNAME("DICTDB") <> ? THEN DO:
      FOR EACH DICTDB._DB NO-LOCK:
           IF DICTDB._Db._Db-type = "ORACLE" AND 
               DICTDB._Db._Db-name = self:SCREEN-VALUE THEN DO:
              ASSIGN ora_version = DICTDB._Db._Db-misc1[3].
               IF ora_version >= 9 AND DICTDB._Db._Db-xl-name = "utf-8" THEN DO:
                   ASSIGN unicodeTypes:SENSITIVE IN FRAME read-df = YES
                       lCharSemantics:SENSITIVE = YES.
                   unicodeTypes:move-after-tab-item(lCharSemantics:HANDLE) in frame read-df.
                   lCharSemantics:move-after-tab-item(shadowcol:HANDLE) in frame read-df.
                   RETURN.
               END.
           END.
      END.
   END.
   ASSIGN unicodeTypes:SENSITIVE IN FRAME read-df = NO
          unicodeTypes:SCREEN-VALUE IN FRAME read-df = "NO"
          lCharSemantics:SENSITIVE = NO
          lCharSemantics:SCREEN-VALUE = "NO"        .
END.

ON VALUE-CHANGED OF iFmtOption IN FRAME read-df DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lFormat:CHECKED   = FALSE
           lFormat:SENSITIVE = FALSE.
  ELSE
    ASSIGN lFormat:CHECKED   = TRUE
           lFormat:SENSITIVE = TRUE.
END. 

ON VALUE-CHANGED OF unicodeTypes IN FRAME read-df DO:
    IF SELF:screen-value = "yes" THEN DO:
       ASSIGN lCharSemantics:SENSITIVE = NO
              lCharSemantics:SCREEN-VALUE = "NO"
               /*lExpandClob:SENSITIVE = NO*/
               /*lExpandClob:SCREEN-VALUE = "no"*/
               ora_varlen = 2000
               ora_varlen:SCREEN-VALUE = "2000".

       IF disp_msg1 = TRUE THEN DO:

           ASSIGN disp_msg1 = FALSE.

           MESSAGE "The maximum char length default value is assuming AL16UTF16 encoding for the national" SKIP
                   "character set on the ORACLE database. For UTF8 encoding, you may have to set it to a" SKIP
                   "lower value depending on the data."
               VIEW-AS ALERT-BOX INFO BUTTONS OK.
       END.

    END.
    ELSE DO:
       ASSIGN lCharSemantics:SENSITIVE = YES
              /*lExpandClob:SENSITIVE = YES*/
              ora_varlen = 4000
              ora_varlen:SCREEN-VALUE = "4000".

       /*lExpandClob:move-after-tab-item(ora_varlen:HANDLE) in frame read-df.*/
       lCharSemantics:move-after-tab-item(shadowcol:HANDLE) in frame read-df.
    END.

END.

ON VALUE-CHANGED OF lCharSemantics IN FRAME read-df DO:

    IF SELF:SCREEN-VALUE = "YES" THEN DO:
        IF disp_msg2 = TRUE THEN DO:
            disp_msg2 = FALSE.
    
            MESSAGE "If you select character semantics, you will have to run the update schema" SKIP
                    "utility after you load the .df file into the schema holder for the schema" SKIP
                    "to be valid. Otherwise, you will get a schema mismatch error at runtime for" SKIP
                    "new fields or new tables."
                    VIEW-AS ALERT-BOX WARNING BUTTONS OK.
        END.
    END.
END.

/*==========================Mainline code=============================*/        

{adecomm/okrun.i  
    &FRAME  = "FRAME read-df" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
}
 
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME read-df = yes.
&ENDIF

IF LDBNAME("DICTDB") <> ? THEN DO:
  FOR EACH DICTDB._DB NO-LOCK:
    IF DICTDB._Db._Db-type = "PROGRESS" THEN
      ASSIGN osh_dbname = LDBNAME ("DICTDB")
             ora_conparms = "<current working database>".
    ELSE IF DICTDB._Db._Db-type = "ORACLE" THEN
      ASSIGN ora_dbname = DICTDB._Db._Db-name
             ora_version = DICTDB._Db._Db-misc1[3]
             hasUniSupport = (DICTDB._Db._Db-xl-name = "utf-8").
  END.
END.

ASSIGN pcompatible = TRUE
       shadowcol = FALSE.
       
ASSIGN shadowcol:TOOLTIP = "Use shadow columns for case insensitive index support".

DISPLAY cFormat lFormat WITH FRAME read-df.

UPDATE df-file 
       btn_file
       osh_dbname
       ora_conparms
       ora_dbname
       ora_owner
       ora_tspace
       ora_ispace
       ora_varlen
       /*lExpandClob*/
       pcompatible
       crtdefault        
       create_df
       shadowcol
       lCharSemantics WHEN ora_version >= 9
       unicodeTypes WHEN ora_version >= 9 AND hasUniSupport
       iFmtOption
       lFormat WHEN iFmtOption = 2
       btn_OK btn_Cancel
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            btn_Help
       &ENDIF
  WITH FRAME read-df.
       
/* make sure these are assigned */
IF unicodeTypes:SCREEN-VALUE ="yes" THEN
   ASSIGN unicodeTypes = YES.
IF lCharSemantics:SCREEN-VALUE = "yes" THEN
   ASSIGN lCharSemantics = YES.

ASSIGN user_env[1]  = df-file
       user_env[3]  = ""
       user_env[4]  = "n"
       user_env[5]  = ";"
       user_env[6]  = "y"
       user_env[7]  = "y"
       user_env[8]  = "y"
       user_env[9]  = "ALL"
       user_env[10] = string(ora_varlen) /* maximum char column length */
                             + "," + "NO" /*STRING(lExpandClob)*/  /* expand to clob */
                             + "," + STRING(lCharSemantics) /* use char semantics */
       user_env[11] = (IF unicodeTypes THEN "nvarchar2" ELSE "varchar2") 
       user_env[12] = "date"
       user_env[13] = "number"
       user_env[14] = "number"
       user_env[15] = "number"
       user_env[16] = "number"
       user_env[17] = "number"
       user_env[19] = "number"
       user_env[20] = "##"
       user_env[22] = "ORACLE"
       user_env[23] = "30"
       user_env[24] = "15"
       user_env[25] = "y"
       user_env[28] = "30"
       user_env[29] = "26"
       user_env[31] = "-- ** "
       user_env[32] = ?
       user_env[34] = ora_tspace
       user_env[35] = ora_ispace.

IF iFmtOption = 1 THEN 
  ASSIGN sqlwidth = TRUE. /* Use _Width field for size */
ELSE IF (lFormat = FALSE) THEN
  ASSIGN sqlwidth = ?. /* Use _Format field for size */
ELSE
  ASSIGN sqlwidth = FALSE. /* Calculate size */
 
/* create df for schema holder */
IF create_df THEN
  ASSIGN user_env[2] = "yes".
ELSE
  ASSIGN user_env[2] = "no".

RUN prodict/ora/_gendsql.p.
 
IF lCharSemantics = TRUE THEN DO:
   MESSAGE "Remember that you may have to run the update schema utility after you load" SKIP
           "the .df file into the schema holder for it to be valid."
           VIEW-AS ALERT-BOX WARNING BUTTONS OK.
END.

IF NOT schdbcon THEN 
   DISCONNECT DICTDB. 
ELSE DO:
  IF LDBNAME(l_curr-db) = ? THEN
    DELETE ALIAS DICTDB.
  ELSE
    RUN adecomm/_setalia.p
        ( INPUT l_curr-db
        ).
END.

    



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lk0.p

Description:
    creates the temporary _db-record for the links
    
Input-Parameters:  
    none
    
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    user_env[1]     db_comm-parameter

    
History:
    hutegger    94/09/11    creation
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

define        variable l_c            as character.
define        variable l_db-xl-name   as character.
define        variable l_db-comm      as character.
define        variable l_drec_db      like drec_db.
define        variable l_user_dbname  like user_dbname.

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/


/* handle v6-oracle by calling other routines */
/* Oracle 6 is no longer supported in 8.2 of Progress
IF DBVERSION("DICTDBG") MATCHES "*6*"
 THEN do:
  assign user_path = ( if index (user_path,"compare") = 0
                        then "_ora6get,_ora6mak"
   &IF "{&WINDOW-SYSTEM}" = "TTY"
        &THEN           else "1=,_usrtget,9=pro,_ora6vrf,_ora6mak"
        &ELSE           else "1=,_guitget,9=pro,_ora6vrf,_ora6mak"
        &ENDIF
                     ).
  return.
  end.
************ Removed about code for 8.2 ********/  

/* delete eventually left-over records from earlier schema-pulls */
for each s_ttb_link: delete s_ttb_link. end.
for each gate-work:  delete gate-work.  end.
for each s_ttb_seq:  delete s_ttb_seq.  end.
for each s_ttb_tbl:  delete s_ttb_tbl.  end.
for each s_ttb_fld:  delete s_ttb_fld.  end.
for each s_ttb_idx:  delete s_ttb_idx.  end.
for each s_ttb_idf:  delete s_ttb_idf.  end.
for each s_ttb_con:  delete s_ttb_con.  end.

/* initialize preselection-criteria and link for local db */  
create s_ttb_link.
assign
  s_name-hlp              = "*"
  s_owner-hlp             = "*"
  s_qual-hlp              = "*"
  s_type-hlp              = "*"
  s_level                 = 0
  s_master                = ""
  s_lnkname               = ""
  s_owner                 = s_owner-hlp
  s_name                  = s_name-hlp
  s_type                  = s_type-hlp
  s_qual                  = s_qual-hlp
  s_ttb_link.name         = s_lnkname
  s_ttb_link.level        = s_level
  s_ttb_link.srchd        = FALSE
  s_ttb_link.slctd        = TRUE
  s_ttb_link.master       = s_master.


/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lkc.p   THIS ROUTINE GETS CALLED ONCE PER LINK!

Description:
    CONNECTs to s_ldbname and sets alias DICTDBG
    
Input-Parameters:  
   none
                                     
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    DICTDBG     alias gets reset for all selected links
History:
    hutegger    94/10/18    creation
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/


SESSION:IMMEDIATE-DISPLAY = yes.
RUN adecomm/_setcurs.p ("WAIT").


if s_level > 0
 then do:  /* only if s_ttb_link is for linked db */

/** / message "_ora_lkc.p: set alias DICTDBG to" s_ldbname
/**/     view-as alert-box.
/ **/
  if not connected(s_ldbname)
   then connect value(s_ldbconct).

  run prodict/ora/_ora_als.p        /* create alias */
    ( INPUT s_ldbname
    ).

  end.     /* only if s_ttb_link is for linked db */

else if LDBNAME("DICTDBG") <> user_dbname
 then do:  /* use normal _db for local-db; set alias only if needed */
  
/** / message "_ora_lkc.p: set alias DICTDBG to" user_dbname
/**/     view-as alert-box.
/ **/
  if not connected(user_dbname)
   then connect value(user_dbname). /* should always be no-op */

  run prodict/ora/_ora_als.p        /* create alias */
    ( INPUT user_dbname
    ).

  end.     /* use normal _db for local-db; set alias only if needed */

/** /
 else message "DICTDBG already set to" user_dbname view-as alert-box.
/ **/
  
/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2006,2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lkg.p   THIS ROUTINE GETS CALLED ONCE PER LINK!

Description:
    GETs all the object-info from all the previousely selected links 
    according to the preselection criteria also stored with the links
    
Input-Parameters:  
   none
                                     
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    DICTDBG     alias gets reset for all selected links
    
History:
    hutegger    94/10/18    creation
    mcmann      97/11/12    Added view-as dialog-box for non TTY clients
    mcmann      98/01/19    Added user_env[25] check for procedures to
                            know if an update is being done.
    mcmann      98/06/15    Added check for num-entries in oobjects
                            98-04-17-046    
    mcmann      01/01/23    Split for each so Oracle 8 can get the
                            proper records 20010108-001     
    mcmann      02/09/10    Added check for num-entries for Synonyms
                            20020820-004               
    04/19/06    fernando    Oracle 10g - skip BIN$* tables
    08/11/08    ashukla     LDAP support (CR#OE00172458)
    08/14/08    knavneet    OE00170417 - Quoting object names if it has special chars.
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&GLOBAL-DEFINE DS_DEBUG XXDEBUG
&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
&UNDEFINE DATASERVER

{ prodict/user/uservar.i }
{ prodict/ora/ora_ctl.i 8 }

define variable hint            AS character no-undo initial "".

define variable l_i             AS integer   no-undo.
define variable l_list          AS character no-undo.
define variable l_name          AS character no-undo.
define variable l_owner         AS character no-undo.
define variable l_qual          AS character no-undo.
define variable l_syst-names    AS character no-undo.
define variable l_type          AS character no-undo.
define variable l_unspprtd      AS character no-undo.
DEFINE VARIABLE batch_mode      AS LOGICAL   no-undo.
define variable l_quoted-owner  AS character no-undo.

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/

FORM 
                                                                   SKIP(1)
  "  Please wait while information is gathered from the ORACLE schema  "
                                                                   SKIP(1)
  SPACE(10) s_qual LABEL "(DB-Link  " FORMAT "x(32)" ")"           SKIP
  SPACE(10) hint   LABEL "(Searching" FORMAT "x(32)" ")"           SKIP(1)
 with row 6 centered
  side-labels no-attr-space
  frame gate_wait 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box 
    three-d &ENDIF.

FORM 
                                                                   SKIP(1)
  "  Please wait while SYNONYMS are getting resolved  "            SKIP(1)
 with row 7 centered
  side-labels no-attr-space
  frame syno_wait view-as dialog-box three-d.

/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/


/*---------------------------  TRIGGERS  ---------------------------*/


/*------------------------  INT.-PROCEDURES  -----------------------*/
procedure clean-up-matches-params:

define input  parameter p_in    as character.
define output parameter p_out   as character.
define        variable i        as integer.

  assign
    p_out = p_in
    i     = index(p_out,"_").
  repeat while i <> 0:
    assign
      p_out = substring(p_out,1,i - 1,"character")
            + "."
            + substring(p_out,i + 1,-1,"character")
      i     = index(p_out,"_").
    end.

  assign i = index(p_out,"%").
  repeat while i <> 0:
    assign
      p_out = substring(p_out,1,i - 1,"character")
            + "*"
            + substring(p_out,i + 1,-1,"character")
      i     = index(p_out,"%").
    end.

  end.   /* procedure clean-up-matches-params */

/*---------------------------  MAIN-CODE  --------------------------*/

assign SESSION:IMMEDIATE-DISPLAY = yes.
batch_mode = SESSION:BATCH-MODE.
RUN adecomm/_setcurs.p ("WAIT").
assign
  l_unspprtd = "DBMS_ALERT,DBMS_APPLICATION_INFO,DBMS_DDL,"
             + "DBMS_EXPORT_EXTENSION,DBMS_JOB,DBMS_ISNAPSHOT,DBMS_LOCK,"
             + "DBMS_OUTPUT,DBMS_PIPE,DBMS_REFRESH,DBMS_SESSION,"
             + "DBMS_SNAPSHOT,DBMS_SPACE,DBMS_STANDARD,DBMS_SQL,"
             + "DBMS_SYS_SQL,DBMS_TRANSACTION,DBMS_UTILITY,DIANA,"
             + "DIUTIL,STANDARD".

{ prodict/dictgate.i 
  &action = "flist" 
  &dbtype = " ""ORACLE"" " 
  &dbrec  = "drec_db"
  &output = "l_syst-names"
  }
find first s_ttb_link
  where s_ttb_link.slctd  = TRUE
  and   s_ttb_link.level  = s_level
  and   s_ttb_link.master = s_master
  and   s_ttb_link.name   = s_lnkname
  no-error.

if available s_ttb_link
 then assign
  s_name  = s_ttb_link.presel-n
  s_owner = s_ttb_link.presel-o
  s_qual  = s_ttb_link.master + s_ttb_link.name
  s_type  = s_ttb_link.presel-t
  s_vrfy  = s_ttb_link.presel-v
  s_ttb_link.srchd = TRUE.
 else do:  /* should actually never happen */
  assign user_path = "*C,_ora_lkx". /* clean-up */
  leave.
  end.     /* should actually never happen */

 
/* pull in the objects of this link according to the preselection
 * criteria. Store all of them in gate-work temp-table. In the next
 * program the user will be able to select the ones he wants to get
 * pulled over
 */
IF NOT batch_mode THEN DO:
  if s_qual = "" then do:
    display "<Local DB>" @ s_qual with frame gate_wait.
    s_qual = ?.
  end.
  else display            s_qual with frame gate_wait.
END.

RUN clean-up-matches-params (INPUT s_name, OUTPUT l_name).
RUN clean-up-matches-params (INPUT s_owner,OUTPUT l_owner).
RUN clean-up-matches-params (INPUT s_type, OUTPUT l_type).
if index(l_owner,"/") <> 0
 then assign
  l_owner = substring(l_owner,1,index(l_owner,"/") - 1,"character").
if index(l_owner,"@") <> 0
 then assign
  l_owner = substring(l_owner,1,index(l_owner,"@") - 1,"character").

/* In case l_owner is null, we are using external authentication 
 * Get user name from database.
 */
IF (l_owner EQ "" OR l_owner EQ ?) THEN 
   RUN prodict/ora/_get_orauser.p (OUTPUT l_owner).
     
/* Skip remote packages, functions and procedures */
if s_qual <> ?
 then do:
  assign l_list = "". 
  repeat l_i = 1 to num-entries(tallowed):
    if lookup(entry(l_i,tallowed),"FUNCTION,PACKAGE,PROCEDURE") = 0
     then assign l_list = l_list + "," + entry(l_i,tallowed).
    end.
  assign tallowed = substring(l_list,2,-1,"character"). 
  end.

for each DICTDBG.oracle_users 
  fields (name user#)
  where DICTDBG.oracle_users.name MATCHES l_owner
  NO-LOCK  by DICTDBG.oracle_users.name: 
    FOR each DICTDBG.oracle_objects fields (owner# type name linkname obj#)
    where DICTDBG.oracle_objects.owner# = DICTDBG.oracle_users.user#
    NO-LOCK by DICTDBG.oracle_objects.name: 

    /* and phrase in the second each-phrase produces error-message */
    /* from ORACLE, so I sort out the records with linknames <> ?  */
    /* here                                                        */

      if DICTDBG.oracle_objects.linkname <> ? then next.

    /* we don't want to pull system-files, so we sort them out */
      if LOOKUP(DICTDBG.oracle_objects.name,l_syst-names ) <> 0 then next.
  
    /* There are a couple of system-tables other than above checked, that
     * we don't support. We filter them out with this statement:
     */
     
      if   DICTDBG.oracle_users.name = "SYS"
       and LOOKUP(DICTDBG.oracle_objects.name,l_unspprtd ) <> 0 then next.
   
   
   /* The list of oracle object can change without notice so this statement
      handles when more types then entries in oobjects so we don't receive
      an error message.  If it is a type that we will be supporting then
      ora_ctl.i needs to be changed so that this statement will eliminate it.
   */

      IF (DICTDBG.oracle_objects.type + 1) > NUM-ENTRIES(oobjects) THEN NEXT.
   
    /* since there are no esc-characters possible in Oracle V6, we
     * can't use the wildcards. As soon as we drop V6-support, we
     * can move this lines up into the where-clause              
     */
     
      if NOT (
       ( ENTRY(DICTDBG.oracle_objects.type + 1,oobjects) =    "view"
         and DICTDBG.oracle_objects.name  MATCHES "buffer." + l_name
         and "buffer" MATCHES l_type
       )  /* "buffer_" produces error, so I use "buffer." (hutegger) */
       or 
       ( ENTRY(DICTDBG.oracle_objects.type + 1,oobjects)     MATCHES l_type
         and     DICTDBG.oracle_objects.name                   MATCHES l_name
         and  CAN-DO(tallowed,ENTRY(DICTDBG.oracle_objects.type + 1,oobjects))
       )
      ) then NEXT.

    /* Skip sequence generators created for compatible oracle tables */
      if DICTDBG.oracle_objects.name MATCHES "*_SEQ" then NEXT.

      /* in Oracle 10g, there is a feature called flashback table which 
         saves deleted tables, by renaming them to BIN$<some-string>.
         We can skip these too.
      */
      IF DICTDBG.oracle_objects.NAME BEGINS "BIN$" THEN
         NEXT.

    /* we try to find the object in the existing schema, because we need 
     * to make sure, that when it get's created later-on, it will get a 
     * unique name. Therefore we try to find teh object with the name,
     * foreign-name, qualifier (= db-link) and user. If we don't find that
     * object we assign a ? to gate-work.gate-prog (which is the 
     * PROGRESS-name); and in ora_lks we go through all the gate-work 
     * records that the user selected and that have a ? instead a 
     * progress-name, and find a new name for the object
     */
      l_quoted-owner = QUOTER(DICTDBG.oracle_users.name).

      if ENTRY(DICTDBG.oracle_objects.type + 1, oobjects) = "SYNONYM" then do:  /* synonym */
        find first DICTDB._Sequence
          where DICTDB._Sequence._Db-recid    = drec_db
            and (DICTDB._Sequence._Seq-misc[1] = DICTDBG.oracle_objects.name
                 /* OE00170417 - string may be quoted */
                 OR DICTDB._Sequence._Seq-misc[1] = QUOTER(DICTDBG.oracle_objects.NAME))
            and   DICTDB._Sequence._Seq-misc[2] = ""
            and   DICTDB._Sequence._Seq-misc[8] = s_qual
            no-error.
        if not available DICTDB._Sequence
         then find first DICTDB._File
            where DICTDB._File._Db-recid     = drec_db
              and   (DICTDB._File._For-Name     = DICTDBG.oracle_objects.name
                    /* OE00170417 - string may be quoted */
                     OR DICTDB._File._For-Name = QUOTER(DICTDBG.oracle_objects.NAME))
              and   DICTDB._File._For-Owner    = ""
              and   DICTDB._File._Fil-misc2[8] = s_qual
              no-error.
      end.     /* synonym */
     
      else if ENTRY(DICTDBG.oracle_objects.type + 1, oobjects) = "SEQUENCE" then do:  /* sequence */
        find first DICTDB._Sequence where DICTDB._Sequence._Db-recid    = drec_db
          and  (DICTDB._Sequence._Seq-misc[1] = DICTDBG.oracle_objects.name
                 /* OE00170417 - string may be quoted */
                 OR DICTDB._Sequence._Seq-misc[1] = QUOTER(DICTDBG.oracle_objects.NAME))
          and  (DICTDB._Sequence._Seq-misc[2] = DICTDBG.oracle_users.name
                 OR DICTDB._Sequence._Seq-misc[2] = l_quoted-owner)
          and   DICTDB._Sequence._Seq-misc[8] = s_qual
          no-error.
      end.     /* sequence */
     
      else do:  /* table */
        if ENTRY(DICTDBG.oracle_objects.type + 1, oobjects) = "PACKAGE"
         then find first DICTDB._File
           where DICTDB._File._Db-recid     = drec_db
             and (DICTDB._File._For-Owner    = DICTDBG.oracle_users.name
                  OR DICTDB._File._For-Owner = l_quoted-owner)
             and (DICTDB._File._Fil-misc2[1] = DICTDBG.oracle_objects.name
                 /* OE00170417 - string may be quoted */
                 OR DICTDB._File._Fil-misc2[1] = QUOTER(DICTDBG.oracle_objects.NAME))
             and DICTDB._File._Fil-misc2[8] = s_qual
             no-error.
         else find first DICTDB._File
            where DICTDB._File._Db-recid     = drec_db
              and (DICTDB._File._For-Name     = DICTDBG.oracle_objects.name
                 /* OE00170417 - string may be quoted */
                 OR DICTDB._File._For-Name = QUOTER(DICTDBG.oracle_objects.NAME))
              and (DICTDB._File._For-Owner    = DICTDBG.oracle_users.name
                   OR DICTDB._File._For-Owner = l_quoted-owner)
              and DICTDB._File._Fil-misc2[8] = s_qual
              no-error.

    /* to prevent schemaholder-tables from beeing updated        */
    /*                                          <hutegger> 94/06 */
         if available DICTDB._File
          and DICTDB._file._file-name begins "oracle_" then NEXT.

      end.     /* table */

      if not available _File and not available _Sequence
          and s_vrfy = TRUE then NEXT.

      IF NOT batch_mode THEN   
          display DICTDBG.oracle_objects.name @ hint with frame gate_wait.

      create gate-work.
      ASSIGN gate-work.gate-user = DICTDBG.oracle_users.name
             gate-work.gate-prog = ( if available DICTDB._File
                                    and DICTDB._File._Fil-misc2[1] <> ?
                                    /* OE00130417 - and not 0-length value */
                                    AND DICTDB._File._Fil-misc2[1] <> ""
                                    and user_env[25] <> "compare"
                                    then ?
                                    else if available DICTDB._File
                                    then DICTDB._File._File-name 
                                    else if available DICTDB._Sequence
                                    then DICTDB._Sequence._Seq-name 
                                    else ? )
             gate-work.gate-qual = s_qual
             gate-work.gate-type = TRIM(STRING((AVAILABLE DICTDB._File 
                                    AND DICTDB._File._Frozen),"FROZEN:/" ) )
             gate-work.gate-obj# = DICTDBG.oracle_objects.obj#.

      if DICTDBG.oracle_objects.type   =    4
            and DICTDBG.oracle_objects.name BEGINS "BUFFER_" then 
        ASSIGN gate-work.gate-name = SUBSTR(DICTDBG.oracle_objects.name, 8, -1 ,"character")
               gate-work.gate-type = gate-work.gate-type + ENTRY(19,oobjects).
      else 
        ASSIGN gate-work.gate-name = DICTDBG.oracle_objects.name
               gate-work.gate-type = gate-work.gate-type
                                    + ENTRY(DICTDBG.oracle_objects.type + 1
                                    ,oobjects).
    END. /* for each DICTDBG.oracle_objects */
  END. /* for each DICTDBG.oracle_users */

IF NOT batch_mode THEN DO:
  pause 0.
  hide frame gate_wait no-pause.
  view frame syno_wait.
END.

find first gate-work no-error.

/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to gate-work.d.
/**/    display s_qual format "x(50)" with side-label frame d1a.
/**/    for each gate-work:
/**/        display
/**/          gate-slct gate-flag
/**/          gate-name format "x(20)"
/**/          gate-edit format "x(30)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-obj# format ">>>>>>>>>9"
/**/          gate-type gate-user with down stream-io width 100 frame d1.
/**/      end.  /* for each gate-work */
/**/    output close.
/**/    message "D1 DEBUG-Output done" s_qual view-as alert-box.
/**/   &ENDIF

for each gate-work
  where gate-work.gate-type = "SYNONYM"
  and   gate-work.gate-edit = ""
  and   gate-work.gate-qual = s_qual:

  find first DICTDBG.oracle_synonyms 
    where DICTDBG.oracle_synonyms.obj# = gate-work.gate-obj#
    no-lock no-error.

  /* The synonym needs to be a local one, except if it is in the local
   * db. And there are a couple of system-tables, that we don't support.
   * We filter them out with this statement.
   */
  if available DICTDBG.oracle_synonyms
  and ( DICTDBG.oracle_synonyms.node = ?
     or s_qual  =  ?
      )
  and (  DICTDBG.oracle_synonyms.owner <> "SYS"
     or LOOKUP(DICTDBG.oracle_synonyms.name,l_unspprtd ) = 0
      )

   then do:  /* try to resolve this synonym */

    /* synonyms pointing at remote objects can't be resolved completely */
    if DICTDBG.oracle_synonyms.node = ?
     then do:  /* pointing local -> resolve */
      find first DICTDBG.oracle_users 
        where DICTDBG.oracle_users.name = DICTDBG.oracle_synonyms.owner
        no-lock no-error.
      if available DICTDBG.oracle_users
       then find first DICTDBG.oracle_objects 
        where DICTDBG.oracle_objects.name = DICTDBG.oracle_synonyms.name
        and   DICTDBG.oracle_users.user#  = DICTDBG.oracle_objects.owner#
        no-lock no-error.
       else release DICTDBG.oracle_objects.
      end.     /* pointing local -> resolve */
     else release DICTDBG.oracle_objects.
    
    IF AVAILABLE DICTDBG.oracle_objects THEN DO:
      IF (DICTDBG.oracle_objects.type + 1) <= NUM-ENTRIES(oobjects) THEN
        ASSIGN l_type = ENTRY(DICTDBG.oracle_objects.type + 1,oobjects).
      ELSE
        ASSIGN l_type = "".
    END. 
    ELSE
     ASSIGN l_type =  "".
         
     IF ( s_qual <> ? or DICTDBG.oracle_synonyms.node <> ? )
     and  LOOKUP(l_type,"PACKAGE,PROCEDURE,FUNCTION") <> 0
     then next. /* disallow remote procedures, functions and packages */

    if   LOOKUP(l_type,tallowed + ",") <> 0
     and l_type                        <> "SYNONYM"
     then assign
       gate-work.gate-edit = DICTDBG.oracle_synonyms.owner
                           + ":"
                           + DICTDBG.oracle_synonyms.name
                           + ":"
                           + l_type
                           + ( if DICTDBG.oracle_synonyms.node <> ?
                                then ":@" + DICTDBG.oracle_synonyms.node
                                else ""
                             ).

    end.     /* try to resolve this synonym */

  end.     /* for each gate-work "synonym" */
  
/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to gate-work.d2.
/**/    display s_qual format "x(50)"  with side-label frame d2a.
/**/    for each gate-work:
/**/        display
/**/          gate-slct gate-flag
/**/          gate-name format "x(20)"
/**/          gate-edit format "x(30)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-obj# format ">>>>>>>>>9"
/**/          gate-type gate-user with down stream-io width 100 frame d2.
/**/      end.  /* for each gate-work */
/**/    output close.
/**/    message "D2 DEBUG-Output done" view-as alert-box.
/**/   &ENDIF

if s_qual <> ?
 then for each gate-work
  where gate-work.gate-type                   = "SYNONYM"
  and   num-entries(gate-work.gate-edit,":") >= 4:

  if not ( entry(3,gate-work.gate-edit,":")      = ""
     and   entry(4,gate-work.gate-edit,":")      = s_qual
         )
     then next.
 
  find first DICTDBG.oracle_users 
    where DICTDBG.oracle_users.name = entry(1,gate-work.gate-edit,":")
    no-lock no-error.
  release DICTDBG.oracle_objects.
  if available DICTDBG.oracle_users
   then find first DICTDBG.oracle_objects 
    where DICTDBG.oracle_objects.name = entry(2,gate-work.gate-edit,":")
    and   DICTDBG.oracle_users.user#  = DICTDBG.oracle_objects.owner#
    no-lock no-error.

  assign
    l_type = ( if available DICTDBG.oracle_objects
                then ENTRY(DICTDBG.oracle_objects.type + 1,oobjects)
                else ""
             ).

  if   LOOKUP(l_type,tallowed + ",") <> 0
   and l_type                        <> "SYNONYM"
   then assign
     gate-work.gate-edit = entry(1,gate-work.gate-edit,":")
                         + ":"
                         + entry(2,gate-work.gate-edit,":")
                         + ":"
                         + l_type
                         + ":"
                         + s_qual.

  end.     /* for each gate-work "synonym" */

/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to gate-work.d3.
/**/    display s_qual format "x(50)"  with side-label frame d3a.
/**/    for each gate-work:
/**/        display
/**/          gate-slct gate-flag
/**/          gate-name format "x(20)"
/**/          gate-edit format "x(30)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-obj# format ">>>>>>>>>9"
/**/          gate-type gate-user with down stream-io width 100 frame d3.
/**/      end.  /* for each gate-work */
/**/    output close.
/**/    message "D3 DEBUG-Output done" view-as alert-box.
/**/   &ENDIF

/* we are done with this link, lets do the next one (srchd = false)
 * if there aren't anymore, we continue to the next step, wich is allowing
 * the user to select the objects to be pulled
 */

find first s_ttb_link
  where s_ttb_link.slctd  = TRUE
  and   s_ttb_link.srchd  = FALSE
  no-lock no-error.
if not available s_ttb_link
 then do:  /* done with getting object-names -> objects-selection */

/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to gate-work.d4.
/**/    display s_qual format "x(50)"  with side-label frame d4a.
/**/    for each gate-work:
/**/        display
/**/          gate-slct gate-flag
/**/          gate-name format "x(20)"
/**/          gate-edit format "x(30)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-obj# format ">>>>>>>>>9"
/**/          gate-type gate-user with down stream-io width 100 frame d4.
/**/      end.  /* for each gate-work */
/**/    output close.
/**/    message "D4 DEBUG-Output done" view-as alert-box.
/**/   &ENDIF

  for each gate-work
    where gate-work.gate-type = "SYNONYM":
    
    if gate-work.gate-edit = ""
     or num-entries(gate-work.gate-edit,":") < 3
     or     entry(3,gate-work.gate-edit,":") = ""
     then do:  /* these synonyms couldn't get resolved - wrong link */
     
     IF NOT batch_mode THEN
/** /    message "unresolved synonym:"                    /**/
/**/       gate-work.gate-name gate-work.gate-type       /**/
/**/       gate-work.gate-user                           /**/
/**/       gate-work.gate-edit                           /**/
/**/       num-entries(gate-work.gate-edit,":")          /**/
/**/       entry(3,gate-work.gate-edit,":") = ""         /**/
/**/       view-as alert-box.                            / **/
      delete gate-work.
      end.     /* these synonyms couldn't get resolved - wrong link */
    end.     /* for each gate-work */

/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to gate-work.d5.
/**/    display s_qual format "x(50)"  with side-label frame d5a.
/**/    for each gate-work:
/**/        display
/**/          gate-slct gate-flag
/**/          gate-name format "x(20)"
/**/          gate-edit format "x(30)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-obj# format ">>>>>>>>>9"
/**/          gate-type gate-user with down stream-io width 100 frame d5.
/**/      end.  /* for each gate-work */
/**/    output close.
/**/    message "LAST DEBUG-Output done" view-as alert-box.
/**/   &ENDIF
  /* relict from previous version now redundant * /
  for each s_ttb_link
    where s_ttb_link.slctd  = TRUE:
    assign s_ttb_link.srchd  = FALSE. /* init for next step: */
    end.                              /*      select objects */
  */
  
  assign
    user_path = "_ora_lks".             /* objects-selection */

  end.     /* done with getting object-names -> objects-selection */

 else do:  /* look for objects in next selected link */

  assign
    s_level   = s_ttb_link.level
    s_master  = s_ttb_link.master
    s_lnkname = s_ttb_link.name.

  if s_level > 0
   then do:  /* only if s_ttb_link is for linked db */

    if connected(s_ldbname)
     then disconnect value(s_ldbname) /*no-error*/.

    do transaction:
      find first DICTDB._Db
        where DICTDB._Db._Db-name = s_ldbname
        and   DICTDB._Db._Db-type = "ORACLE".
      assign DICTDB._Db._Db-misc2[8] = s_master + s_ttb_link.name.
      end.     /* transaction */

    end.     /* only if s_ttb_link is for linked db */

  assign  user_path = "*C,_ora_lkc,_ora_lkg".

  end.     /* look for objects in next selected link */

IF NOT batch_mode THEN
  hide frame syno_wait no-pause.


/**/  &IF "{&DS_DEBUG}" = "DEBUG"
/**/   &THEN
/**/    output to s_ttb_link.lst append.
/**/    for each s_ttb_link:
/**/      display
/**/        slctd srchd master s_ttb_link.name level
/**/        with side-labels frame a.
/**/      for each gate-work
/**/        where gate-work.gate-qual = ( if s_ttb_link.master + s_ttb_link.name = ""
/**/                            then ?
/**/                            else s_ttb_link.master + s_ttb_link.name
/**/                                    ):
/**/        display
/**/          gate-slct gate-flag
/**/          gate-name format "x(20)"
/**/          gate-edit format "x(30)"
/**/          gate-prog format "x(20)"
/**/          gate-qual format "x(20)"
/**/          gate-type gate-user with down width 100 frame b.
/**/        end.  /* for each gate-work */
/**/      end.  /* for each s_ttb_link */
/**/    output close.
/**/   &ENDIF

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lkl.p   THIS ROUTINE GETS CALLED ONCE PER LINK!

Description:
    gets all the LINKs from the current ORACLE-DB, allows the user to
    select the ones he'd like. If the user selects one or more, we change
    the user_path to commit the transaction and call that routine again
    
Input-Parameters:  
   none
                                     
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    DICTDBG     alias gets reset for all selected links
    s_ttb_link  creates a record for each selected link
    s_level     level of links: 0 master-slave,      a     level 0
                1 1. children-generation,...        / \
                                                   b   c   level 1
    s_master    name of parent   master(a) = "", master(b) = @a, ...
    s_ldbname   name of current ORACLE-db (usually "z_ora_links")
    
NOTE: Oracle doesn't support multi-level links yet. This code got
      written as if they would. I changed the code just a little, so
      that it doesn't loop into the recursion. If ORACLE ever starts
      to support multi-levels, we need just to de-comment some code
      and delete its "temporary" replacement. (search for: #$%$#)
      
History:
    hutegger    94/09/01    creation
    mcmann      97/11/12    Added view-as dialog-box for non TTY clients
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&SCOPED-DEFINE DATASERVER YES

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

define variable   canned      as logical.
define variable   i           as integer.
define variable   l_master    as character.
define variable   l_result    as logical.
define variable   l_stri      as character.
define variable   l_text1     as character.
define variable   l_text2     as character.
define variable   l_text3     as character.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*define button     btn_presel    label "&PreSel Criteria" {&STDPH_OKBTN}.*/
&ENDIF

define query      qry_link   for   s_ttb_link.
define browse     brw_link   query qry_link
          display s_ttb_link.slctd  no-label     
                  s_ttb_link.name      label "Link-Name" format "x(42)"         
          with size 50 by 10 multiple.
          
form
  " "                                             skip /*({&VM_WIDG})*/
  "Master DB:"  at 2                              skip
  l_master      at 4 format "x(45)"  view-as text skip({&VM_WIDG})
  l_text1       at 2 format "x(50)"  view-as text skip
  l_text2       at 2 format "x(50)"  view-as text skip
  l_text3       at 2 format "x(50)"  view-as text skip({&VM_WIDG})
  brw_link      at 2   
  { prodict/user/userbtns.i
      &othergui = " "
      }
/*      &othergui = "SPACE({&HM_DBTN}) btn_presel" */
 with frame frm_link
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box 
    three-d &ENDIF 
  row 2 centered no-labels scrollable
  title "  Links to Distributed Databases  "
  default-button btn_OK cancel-button btn_Cancel.

&UNDEFINE DATASERVER



/*---------------------------  TRIGGERS  ---------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  on  HELP   of             frame frm_link 
   or CHOOSE of btn_Help in frame frm_link
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&Link_Distrib_DB_Dlg_Box},
                              INPUT ?).
 &ENDIF
   
/*----- GO or choose of OK BUTTON -----*/
on GO of frame frm_link do:

  do with frame frm_link:
  
    do i = 1 to brw_link:num-selected-rows:
      l_result = brw_link:fetch-selected-row(i).
      if available s_ttb_link then s_ttb_link.slctd = true.
      end.  /* i = 1 to brw_link:num-selected-rows */
      
    end.  /* with frame frm_link */
  
  end.
  
/*----- WINDOW-CLOSE of dialog -----*/
on window-close of frame frm_link
  apply "END-ERROR" to frame frm_link.


/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "frame frm_link" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

/****** ask user for preselection-criteria ******/
/************* for the current link *************/

assign
  s_name  = s_name-hlp
  s_owner = s_owner-hlp
  s_qual  = s_qual-hlp
  s_type  = s_type-hlp
  s_vrfy  = s_vrfy-hlp
  l_text1 = "Below is the list of available links to further"
  l_text2 = "distributed DBs. Select the links from which you"
  l_text3 = "want to pull schema information."
  canned  = TRUE.
  
/* presel.i executes a LEAVE when the user chose CANCEL
 * so we put everything into an endless-loop and LEAVE out of it
 * either in presel.i when canceld (-> canned = TRUE) or after 
 * returning from presel.i (-> canned = FALSE).
 */
repeat while TRUE:
  {prodict/gate/presel.i
    &frame  = "frm_link"
    &link   = "s_lnkname"
    &master = "s_master"
    }
  assign canned = FALSE.
  leave.
  end.

if not canned 
 then find first s_ttb_link
  where s_ttb_link.level  = s_level
  and   s_ttb_link.master = s_master
  and   s_ttb_link.name   = s_lnkname
  no-error.
if not available s_ttb_link
 then do:
  assign user_path = "*C,_ora_lkx". /* clean-up */
  leave.
  end.

assign
  s_ttb_link.presel-n = s_name
  s_ttb_link.presel-o = s_owner
  s_ttb_link.presel-q = s_qual
  s_ttb_link.presel-t = s_type
  s_ttb_link.presel-v = s_vrfy
  s_ttb_link.srchd    = true
  l_master            = s_master + s_lnkname.

/* use presel-criteria of local db as default-values */
if l_master = ""
 then assign 
  s_owner-hlp         = s_owner
  s_name-hlp          = s_name
  s_type-hlp          = s_type
  s_qual-hlp          = s_qual.

/*** only "public" links are usefull -> get user-id of "public" ***/
/* during development we found out that ORACLE doesn't support
 * multiple layers of links. So <table>@<link1>@<link2> is illegal.
 * So we inserted an additional if-condition here to create new
 * s_ttb_link-records only if also the level < 2. If ORACLE ever
 * supports multi-level links, we just need to remove that line.
 */
find first DICTDBG.oracle_users
  where DICTDBG.oracle_users.name = "public"
  no-lock no-error.
if available DICTDBG.oracle_users
 /* and s_level < 1    / * no multi-level-links supported by ORACLE */
 then do:  /* found user "public" */

/******** create new s_ttb_link-records *********/

  for each DICTDBG.oracle_links fields(owner# name)
    where DICTDBG.oracle_links.owner# = DICTDBG.oracle_users.user#
    no-lock:
  
  /**//* if not can-find(first sysobj$@<link-name>) then next. */
  /* since we are not connected to that link-db, we can't look */
  /* at it's schema, therefore we can't make this validation   */

  /* check if there is already a link with this name, if yes skip 
   * the current, otherwise create a new s_ttb_link record
   */
    find first s_ttb_link
      where s_ttb_link.name = "@" + DICTDBG.oracle_links.name
      no-lock no-error.
    if not available s_ttb_link
     then do:
      create s_ttb_link.
      assign
        s_ttb_link.level     = s_level + 1
        s_ttb_link.master    = l_master
        s_ttb_link.name      = "@" + DICTDBG.oracle_links.name
        s_ttb_link.srchd     = false
        s_ttb_link.slctd     = false.
      end.
    end.
  end.     /* found user "public" */
  
/************* leave if no new links ************/

if can-find(first s_ttb_link
 where s_ttb_link.level  = s_level + 1
 and   s_ttb_link.master = l_master)
 then do:  /* there are links in this db */

  /********** allow user to select links **********/

  open query qry_link for each s_ttb_link
            where s_ttb_link.level  = s_level + 1
            and   s_ttb_link.master = l_master.

  assign canned  = true.

  if l_master = ""
   then display
    "<Local DB>" @ l_master
    l_text1
    l_text2
    l_text3
    with frame frm_link.
   else display
    substring(l_master
             ,max(1,length(l_master,"character") - 45)
             ,-1
             ,"character") @ l_master
    l_text1
    l_text2
    l_text3
    with frame frm_link.

  enable 
    brw_link
    btn_OK
    btn_Cancel
    {&HLP_BTN_NAME}
    with frame frm_link.
/*  &IF "{&WINDOW-SYSTEM}" <> "TTY"
 *   &THEN
 *    btn_presel
 *   &ENDIF
 *  with frame frm_link.
 */
 
  RUN adecomm/_setcurs.p ("").

  do on endkey undo, leave:
    wait-for go of frame frm_link.
    assign canned = false.
    end.
  
  RUN adecomm/_setcurs.p ("WAIT").

  hide frame frm_link.

  if canned
   then do:
    assign user_path = "*C,_ora_lkx". /* clean-up */
    leave.
    end.


  /* we want to be able to identify objects that didn't get compared
   * because the user didn't select them or because they don't exist
   
  /********* get rid of non-selected links *********/

  for each s_ttb_link
    where s_ttb_link.level  = s_level + 1
    and   s_ttb_link.master = l_master:
    if s_ttb_link.slctd = false
     then delete s_ttb_link.
    end.     /* for each s_ttb_link */
   */
   
  end.     /* there are links in this db */


/* we are done with this link, lets do the next one (srchd = false)
 * if there aren't anymore, we continue to the next step, wich is pulling the
 * object-names into the gate-work temp-table
 */

/* the following section is in comments because ORACLE doesn't support
 * multi-level links. So we don't have to ask the user for further links
 * in all of the currently new selected links, but just for their
 * preselection-criterias, which we do in the code-piece after this
 * commented-out part                                       #$%$#
find first s_ttb_link
  where s_ttb_link.slctd  = TRUE
  and   s_ttb_link.srchd  = FALSE
  no-lock no-error.
if not available s_ttb_link
 then do:  /* done with link-selection -> pull object-info */

  for each s_ttb_link:
    assign s_ttb_link.srchd  = FALSE.       /* init for next step: */
    end.                                    /*    pull object-info */

  find first s_ttb_link
    where s_ttb_link.slctd  = TRUE
    no-lock no-error.
  if available s_ttb_link
   then do:
    assign
      user_path = "*C,_ora_lkc,_ora_lkg"       /* pull object-info */
      s_level   = s_ttb_link.level
      s_master  = s_ttb_link.master
      s_lnkname = s_ttb_link.name.
    if connected(s_ldbname)
     then disconnect value(s_ldbname) /*no-error*/.
    do transaction:
      find first DICTDB._Db
        where DICTDB._Db._Db-name = s_ldbname
        and   DICTDB._Db._Db-type = "ORACLE".
      assign DICTDB._Db._Db-misc2[8] = s_master + s_lnkname.
        user_path               = "*C,_ora_lkg"       /* pull object-info */
      end.     /* transaction */
    end.
    
   else assign user_path = "*C,_ora_lkx". /* clean-up */

  end.     /* done with link-selection -> pull object-info */

 else do:  /* look for links in next selected link */

  assign
    s_level   = s_ttb_link.level
    s_master  = s_ttb_link.master
    s_lnkname = s_ttb_link.name.

  if connected(s_ldbname)
   then disconnect value(s_ldbname) /*no-error*/.

  do transaction:
    find first DICTDB._Db
      where DICTDB._Db._Db-name = s_ldbname
      and   DICTDB._Db._Db-type = "ORACLE".
    assign DICTDB._Db._Db-misc2[8] = s_master + s_ttb_link.name.
    end.     /* transaction */

  assign  user_path = "*C,_ora_lkc,_ora_lkl".  /* get next links */

  end.     /* look for links in next selected link */
 * here is the end of the commented-out part. If ORACLE ever decides
 * to support multi-levels just remove the following lines and decomment
 * the upper section                                        #$%$#
 */


/* if there are links, try to create "z_ora_links" _db */
find first s_ttb_link
  where s_ttb_link.slctd  = TRUE
  and   s_ttb_link.level  > 0
  no-error.
if available s_ttb_link
 then do:
  assign user_path = "*C".
  run prodict/ora/_ora_lkz.p.
  if user_path = ""
   then do:
    assign user_path = "*C,_ora_lkx". /* clean-up */
    leave.
    end.
  end.


/* ask for the preselection-criteria for each selected link */
for each s_ttb_link
  where s_ttb_link.slctd  = TRUE
  and   s_ttb_link.srchd  = FALSE:
  assign
    s_name  = s_name-hlp
    s_owner = s_owner-hlp
    s_qual  = s_qual-hlp
    s_type  = s_type-hlp
    canned  = TRUE.
  /* presel.i executes a LEAVE when the user chose CANCEL
   * so we put everything into an endless-loop and LEAVE out of it
   * either in presel.i when canceld (-> canned = TRUE) or after 
   * returning from presel.i (-> canned = FALSE).
   */
  repeat while TRUE:
    {prodict/gate/presel.i
      &frame  = "frm_link"
      &link   = "s_ttb_link.name"
      &master = "s_ttb_link.master"
      }
    assign canned = FALSE.
    leave.
    end.
  if not canned
   then assign
    s_ttb_link.presel-n = s_name
    s_ttb_link.presel-o = s_owner
    s_ttb_link.presel-q = s_qual
    s_ttb_link.presel-t = s_type
    s_ttb_link.presel-v = s_vrfy
    s_ttb_link.srchd    = true.
   else do:
    assign user_path = "*C,_ora_lkx". /* clean-up */
    leave.
    end.
  end.
  
for each s_ttb_link
  where s_ttb_link.slctd  = TRUE:
  assign s_ttb_link.srchd = FALSE. /* init for next step: */
  end.                             /*    pull object-info */

find first s_ttb_link
  where s_ttb_link.slctd  = TRUE
  no-lock no-error.
if available s_ttb_link
 and not canned
 then do:

  assign
    user_path = "*C,_ora_lkc,_ora_lkg"    /* pull object-info */
    s_level   = s_ttb_link.level
    s_master  = s_ttb_link.master
    s_lnkname = s_ttb_link.name.

  if s_level > 0
   then do:  /* only if s_ttb_link is for linked db */

    if connected(s_ldbname)
     then disconnect value(s_ldbname) /*no-error*/.

    do transaction:
      find first DICTDB._Db
        where DICTDB._Db._Db-name = s_ldbname
        and   DICTDB._Db._Db-type = "ORACLE".
      assign DICTDB._Db._Db-misc2[8] = s_master + s_lnkname.
      end.     /* transaction */

    end.     /* only if s_ttb_link is for linked db */

  end.
    
 else assign user_path = "*C,_ora_lkx". /* clean-up */
/* end of "temporary" replacement-code, that needs do get deleted,
 * as soon as ORACLE supports multi-level links             #$%$#
 */


/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000,08 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lks.p       THIS ROUTINE GETS CALLED ONLY ONCE!

Description:
    let the user SELECT the objects whose definitions are to be pulled
    this routine gets called only once (and not once per link!)
    
Input-Parameters:  
    none
                                                
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    DICTDBG     alias for current link
    s_ldbname   logical name of the link-db (= physical name)
    s_ttb_link  local and distributed DBs
    gate-work   objects in DBs
    
History:
    hutegger    94/10/18    creation
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER

define variable canned          as logical   no-undo.
define variable edbtyp          as character no-undo.
define variable i               as integer   no-undo. 
define variable l_rep-presel    as logical   no-undo init TRUE. 
DEFINE NEW SHARED VARIABLE s_is_as400 as LOGICAL NO-UNDO INIT NO.
/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

SESSION:IMMEDIATE-display = no.
assign edbtyp = "ORACLE".

repeat while TRUE:

  presel: DO:

  {prodict/gate/gat_get.i
    &block     = "presel "
    &clean-up  = "_ora_lkx"
    &end       = "end. "
    &gate-flag = "NOT gate-work.gate-name begins ""Oracle_"""
    &special1  = "for each gate-work
                    where gate-work.gate-slct = TRUE
                    and   gate-work.gate-qual = ?:
                    assign gate-work.gate-qual = ""<Local DB>"".
                    end.
                 "
    &special2  = "for each gate-work
                    where gate-work.gate-slct  = TRUE
                    and   gate-work.gate-qual  = ""<Local DB>"":
                    assign gate-work.gate-qual = ?.
                    end.
                 "
    &where     = "not gate-work.gate-user begins ""SYS"""
    } /* message and leave */
  
  leave.
  end.

if l_rep-presel = TRUE
 then do:  /* repeat preselection */
  assign
    i         = 0
    s_level   = 0
    s_lnkname = ""
    s_master  = ""
    user_path = "*C,_ora_lkc,_ora_lkl".
  for each s_ttb_link
    where s_ttb_link.slctd  = TRUE:
    assign
      i                = i + 1
      s_ttb_link.srchd = FALSE.
    end.
  if i > 1
   then do:
    if connected(s_ldbname)
     then disconnect value(s_ldbname) /*no-error*/.
    do transaction:
      find first DICTDB._Db
        where DICTDB._Db._Db-name = s_ldbname
        and   DICTDB._Db._Db-type = "ORACLE".
      assign DICTDB._Db._Db-misc2[8] = ?.
      end.     /* transaction */
    end.

  end.     /* repeat preselection */
 
/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lkx.p

Description:
    clean-up by removing temporary db, and deleteing all
    temp-table records
    
Input-Parameters:  
    none
                                                
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    DICTDBG     alias for current link
    s_ldbname      logical name of the link-db (= physical name)
    s_ttb_link  local and distributed DBs
    gate-work   objects in DBs
    
History:
    hutegger    94/10/18    creation
    
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
&UNDEFINE DATASERVER

define variable  s_1st-error     as logical.

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

/** / message "_ora_lkx.p" view-as alert-box. / **/

/* we use "z_ora_links instead of s_ldbname because s_ldb-name can be
 * the real db, and we don't want to disconnect this one
 */

if connected("z_ora_links")
 then disconnect value("z_ora_links") /*no-error*/.

for each s_ttb_link:
  delete s_ttb_link.
  end.
for each gate-work:
  delete gate-work.
  end.


find _Db where _Db._db-name = s_ldbname
  no-error.
if available _Db
 then do:
  for each _File OF _Db:
    { prodict/dump/loadkill.i }
    end.
  delete _Db.
  end.


RUN adecomm/_setcurs.p ("").
assign
  SESSION:IMMEDIATE-DISPLAY = no
  s_1st-error               = no.


/*------------------------------------------------------------------*/

/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_lkz.p

Description:
    creates the temporary _db-record for the links
    
Input-Parameters:  
    none
    
Output-Parameters: 
    none
    
Used/Modified Shared Objects:
    none

    
History:
    hutegger    94/09/11    creation
    mcmann      97/11/12    Added view-as dialog-box for non tty clients
    mcmann      98/11/13    Added assignment of _Db-misc1[3] = Original _db-misc1[3]
                            or if ? then default to 7.
    mcmann      07/03/01    Removed delete of files from z-ora db link record
                            20010626-017      
    mcmann      10/17/03    Add NO-LOCK statement to _Db find in support of on-line schema add                      
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

&SCOPED-DEFINE DATASERVER YES

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

define        variable l_c            as character.
define        variable l_db-xl-name   as character.
define        variable l_db-comm      as character.
define        variable l_db-misc13    AS INTEGER.

&UNDEFINE DATASERVER

/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

display
  " "                                                               skip
  "  Creating z_ora_links to be used for ORACLE distributed DBs.  " skip
  " "
  with centered row 5 frame msg 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN view-as dialog-box 
    three-d &ENDIF.

find first DICTDB._Db
  where DICTDB._Db._Db-name = ldbname("DICTDBG")
  and   DICTDB._Db._Db-type = "ORACLE"
  no-lock no-error.
if not available DICTDB._Db
 then do: /* should never happen otherwise we wouldn't be here ... */
  message "could not find ORACLE-schemaholder" view-as alert-box.
  hide frame msg no-pause.
  assign user_path = "".
  RETURN.
  end.
 
 
assign
  l_db-comm    = DICTDB._Db._Db-comm
  l_db-xl-name = DICTDB._Db._Db-xl-name
  s_ldbname    = "z_ora_links"
  s_ldbconct   = s_ldbname + " -RO -U ""*" + _Db._Db-name + """"
  l_db-misc13  = DICTDB._Db._Db-Misc1[3].
  
IF l_db-misc13 = 0 OR l_db-misc13 = ? THEN
    ASSIGN l_db-misc13 = 7.


find first DICTDB._Db
  where DICTDB._Db._db-name = s_ldbname
  NO-LOCK no-error.
if available DICTDB._Db
 then do:  /* z_ora_links _db exists */
  if RECID(DICTDB._Db) = drec_db
   then do:
    message
      """z_ora_links"" can't get used as logical name for an ORACLE DB"
      view-as alert-box.
    hide frame msg no-pause.
    assign user_path = "".
    LEAVE.
    end.
    
  else if DICTDB._Db._Db-type <> "ORACLE"
   then do:  /* non-ORACLE z_ora_links _db */
      message 
        "{&PRO_DISPLAY_NAME} creates a temporary _Db-record called ""z_ora_links"" to "
        &IF "{&window-system}" = "OSF/MOTIF" &THEN skip &ENDIF
        "access distributed DBs. There is currently a _Db-record named "
        &IF "{&window-system}" = "OSF/MOTIF" &THEN skip &ENDIF
        """z_ora_links"" in your DB."
                                                                    skip(1)
        "Please give this schema a different logical name and then"
        &IF "{&window-system}" = "OSF/MOTIF" &THEN skip &ENDIF
        "choose this function again."
       view-as alert-box.

      hide frame msg no-pause.
      assign user_path = "".
      LEAVE.
    end.     /* non-ORACLE z_ora_links _db */
   
   else do:  /* reusable or error-message */
   
    
    { prodict/dictgate.i 
        &action = "can-reuse"
        &dbtype = "DICTDB._Db._Db-type"
        &dbrec  = "RECID(DICTDB._Db)"
        &output = "l_c"
    }  /* can-reuse = can-remove */

    if l_c <> "ok"
     then do:  /* z_ora_links _db NOT useable */
      message 
        "{&PRO_DISPLAY_NAME} creates a temporary _Db-record called ""z_ora_links"" to "
        &IF "{&window-system}" = "OSF/MOTIF" &THEN skip &ENDIF
        "access distributed DBs. There is currently a _Db-record named "
        &IF "{&window-system}" = "OSF/MOTIF" &THEN skip &ENDIF
        """z_ora_links"" in your DB."
                                                                    skip(1)
        "Please give this schema a different logical name and then"
        &IF "{&window-system}" = "OSF/MOTIF" &THEN skip &ENDIF
        "choose this function again."
        view-as alert-box.
        
      hide frame msg no-pause.
      assign user_path = "".
      LEAVE.
      end.     /* z_ora_links _db NOT useable */

    end.     /* reusable or error-message */

  end.     /* z_ora_links _db exists */

 else do:  /* create new z_ora_links _db */
  create DICTDB._Db.
  assign
    DICTDB._Db._Db-slave    = TRUE
    DICTDB._Db._Db-type     = "ORACLE"
    DICTDB._Db._Db-addr     = ""
    DICTDB._Db._Db-name     = s_ldbname
    DICTDB._Db._Db-misc1[3] = l_db-misc13
    DICTDB._Db._Db-comm     = l_db-comm
    DICTDB._Db._Db-xl-name  = l_db-xl-name.
 
  { prodict/dictgate.i 
      &action = "add"
      &dbtype = "DICTDB._Db._Db-type"
      &dbrec  = "RECID(DICTDB._Db)"
      &output = "l_c"
      }
  end. /* create new z_ora_links _db */
hide frame msg no-pause.

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

file: prodict/ora/_ora_md0.p

Description:
    creates empty SI, creates SQL and ev. dumps the data from the
    PROGRESS source-db

Input:
    none

Output:
    nnoe

Changed/Used Shared Objects:
    s_xxx       ...

History:
    hutegger    94/05/12    stripped ".sql" from user_env[2], now
                            assigned in _wrktgen.p

    mcmann      97/12/29    Removed reference to oracle 6
    mcmann      03/10/17    Add NO-LOCK statement to _Db find in support of on-line schema add
    fernando    06/11/07    Unicode support
--------------------------------------------------------------------*/
/*h-*/

{ prodict/dictvar.i NEW}
{ prodict/user/uservar.i }
{ prodict/ora/oravar.i }

/*----------------------- INTERNAL PROCEDURES ----------------------*/
/*---------------------------- TRIGGERS ----------------------------*/
/*------------------------- INITIALIZATIONS ------------------------*/
/*--------------------------- MAIN-BLOCK ---------------------------*/

FIND FIRST _DB
  WHERE _Db._Db-type = "ORACLE"
  NO-LOCK NO-ERROR.
IF NOT AVAILABLE _Db
 THEN FIND FIRST _Db WHERE _Db-local NO-LOCK.

ASSIGN
  drec_db      = RECID(_Db)
  ora_codepage = ( if   ora_codepage <> ""
                    then ora_codepage
                    else _Db._Db-xl-name
                 )
  user_env[11] = (IF unicodeTypes THEN "nvarchar2" ELSE "varchar2")
  .
 
/*------------------------------------------------------------------*/

IF SESSION:BATCH-MODE and logfile_open
 THEN PUT STREAM logfile UNFORMATTED
        " " skip
        "-- ++ " skip
        "-- Creating SQL to create database objects " skip
        "-- -- " skip(2).

RUN "prodict/misc/_wrktgen.p".

IF SESSION:BATCH-MODE 
 and NOT logfile_open
 THEN DO:
  OUTPUT STREAM logfile TO VALUE(user_env[2] + ".log")
         APPEND UNBUFFERED NO-MAP NO-ECHO.
  logfile_open = true.
  END.

/*------------------------------------------------------------------*/

IF movedata
 THEN DO:  /* dump data */
  /* dump the data in Progress format */
  OUTPUT TO dump.tmp NO-ECHO NO-MAP.

  IF SESSION:BATCH-MODE and logfile_open
   THEN PUT STREAM logfile UNFORMATTED
          " " skip
          "-- ++ " skip
          "-- Dumping data " skip
          "-- -- " skip(2).


  RUN "prodict/dump_d.p" ("ALL","","").
  OUTPUT CLOSE.

  END.     /* dump data */


/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* --------------------------------------------------------------------

File: prodict/ora/_ora_md1.p

Description:
    this program assumes that it has an empty progress database.  it
    then connects to an oracle database and proceeds to suck over the
    definitions for all tables defined to have an owner matching the value
    of the variable 'ora_username'

Input:
    none
    
Output:
    none
    
History:
    95/09   hutegger    introduced l_debug variable to turn debugging 
                        of snd_sql on/off
    95/04   hutegger    adjusted to use _syb_pul routines
    ?       ?           created

    97/12   mcmann      Changed number of cursors from 50 to 10 so that
                        an oracle error message will not be issued.
    01/13/98 mcmann     Removed assignment of cursors since the dataserver
                        now handles releasing cursors properly.
    05/01/98 mcmann     Removed message about no gate-work since user has
                        already been given this message 98-04-29-066  
    05/07/99 mcmann     Added space between user name and connection parms
                        when @ is used.   
    06/04/02 mcmann     Added check for error creating hidden files.                 
    06/13/07 fernando   Unicode support

--------------------------------------------------------------------*/
/*h-*/

&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i NEW }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE DATASERVER

{ prodict/ora/oravar.i }
{ prodict/user/uservar.i }

DEFINE NEW SHARED VARIABLE l_closelog  AS logical   NO-UNDO.

DEFINE VARIABLE j           AS INTEGER   NO-UNDO.
DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_debug     AS logical   NO-UNDO.

DEFINE VARIABLE connection_string as CHARACTER NO-UNDO.
DEFINE VARIABLE l_ora_username    as CHARACTER NO-UNDO.
DEFINE VARIABLE ora_lang            AS CHARACTER  NO-UNDO.
DEFINE VARIABLE nls_upp             AS CHARACTER  NO-UNDO.
DEFINE STREAM code.
OUTPUT STREAM code TO VALUE("enable.sql") NO-ECHO NO-MAP.
DEFINE VARIABLE user_env_save5 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save26 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save31 AS CHARACTER NO-UNDO.
DEFINE VARIABLE user_env_save36 AS CHARACTER NO-UNDO.
/*------------------------------------------------------------------*/

/* connect up the database to work with ------------------------------------*/
if not connected(osh_dbname) 
 then CONNECT VALUE(osh_dbname) -1.

/* create _db record and load oracle definitions ---------------------------*/
assign user_env[1] = ora_username.

create alias DICTDB for database value(osh_dbname).

RUN prodict/ora/_ora_md2.p.
IF RETURN-VALUE = "2" THEN
    RETURN "2".

/* connect to oracle database ----------------------------------------------*/
/* disconnect-connect is to reload schema cache -- workaround */
DISCONNECT VALUE(osh_dbname).
CONNECT VALUE(osh_dbname) -1.

ASSIGN 
  user_dbname       = ora_dbname
  user_dbtype       = {adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "user_env[22]"
                        }
  l_ora_username    = ora_username
  user_env[25]      = "AUTO-PROTOXXX,*,ora_username,*,*".

IF ora_conparms <> "" and ora_conparms <> ?
  THEN DO:
    IF INDEX(ora_conparms,"@") = 0
      then 
        assign 
          connection_string = ora_conparms
          l_ora_username    = ora_username.
      else 
        assign 
          connection_string = " "
          l_ora_username    = ora_username + " " + ora_conparms.
   END.

IF ora_password = "" or ora_password = ?
  THEN 
    CONNECT VALUE(ora_dbname)
        -dt VALUE(user_dbtype)
        -ld VALUE(ora_dbname)
        -U  VALUE(l_ora_username)
            VALUE(connection_string). 
  ELSE
    CONNECT VALUE(ora_dbname)
        -dt VALUE(user_dbtype)
        -ld VALUE(ora_dbname)
        -U  VALUE(l_ora_username)
        -P  VALUE(ora_password)
            VALUE(connection_string).

CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(ora_dbname) NO-ERROR.

ASSIGN
    user_env_save5  = user_env[5]
    user_env_save26 = user_env[26]
    user_env_save31 = user_env[31]
    user_env_save36 = user_env[36].
    
/* Verify tablespaces for tables and indexes */
RUN prodict/ora/_ora_vts.p.
IF RETURN-VALUE = "1" THEN
   RETURN "1".
   
/* if unicode types, make sure database is Oracle V9 or later */
IF unicodeTypes THEN DO:
   RUN prodict/ora/_get_oraver.p (OUTPUT j).
   IF j < 9 THEN DO:
       RETURN "3".
   END.
END.

Assign 
     nls_upp = user_env[40].
IF nls_upp = "y" THEN DO:
    RUN prodict/ora/_ora_nlsvld.p(OUTPUT i).
    IF i = 0 THEN DO:
       RETURN "4".
   END.
END.

/*
** Create the schema in Oracle 
*/
RUN "prodict/gate/_snd_sql.p"
  ( INPUT user_env[31],
    INPUT l_debug,
    INPUT ora_dbname,
    INPUT user_dbtype,
    INPUT user_env[5],
    INPUT user_env[26],
    INPUT osh_dbname + ".sql"
  ).


IF (SESSION:BATCH-MODE and not logfile_open)
  THEN DO:
    output stream logfile to value(user_env[2] + ".log") 
        unbuffered no-map no-echo append. 
    assign
     l_closelog   = true
     logfile_open = true. 
    END.


IF SESSION:BATCH-MODE AND logfile_open THEN DO:
   PUT STREAM logfile UNFORMATTED
       " " skip 
       "-- ++ " skip
       "-- Getting List of Objects from foreign DB Schema" skip
       "-- -- " skip(2).
    PUT STREAM logfile UNFORMATTED
      "Object Type" at 14
      "Object Owner" at 28
      "Object Name" at 44 skip(1).
   END.

/*
** We have to create the record in table s_ttb_link and the variables
** s_* below so that the link table logic in ora_lkm will work properly.
*/
create s_ttb_link.
assign
   s_ttb_link.level    = 0
   s_ttb_link.master   = ""
   s_ttb_link.name     = ""
   s_ttb_link.slctd    = true
   s_ttb_link.srchd    = false
   s_ttb_link.presel-n = "*"
   s_ttb_link.presel-o = ora_username
   s_ttb_link.presel-t = "*"
   s_level             = 0
   s_master            = ""
   s_lnkname           = ""
   s_name-hlp          = "*"
   s_owner-hlp         = ora_username
   s_qual-hlp          = "*"
   s_type-hlp          = "*".

/* the following find is just as a workaround for a bug
 */ 
find first s_ttb_link.


/*
** Create a list of all the appropriate objects we want from
** the oracle database.
*/
    RUN prodict/ora/_ora_lkg.p.
    RUN prodict/ora/_ora_lks.p.


/*
** we check if there is something to pull, if not we just skip the rest
** of this routine
*/
find first gate-work
  where gate-work.gate-slct = TRUE
  no-error.
if available gate-work
  then do:   /* found at least one object to pull */

/*
** Create objects in the schema holder to match objects in Oracle.
*/

    RUN prodict/ora/_ora_pul.p.

  IF SESSION:BATCH-MODE AND logfile_open THEN 
   PUT STREAM logfile UNFORMATTED
       " " skip 
       "-- ++ " skip
       "-- Importing Objects into the {&PRO_DISPLAY_NAME} Schema Holder." skip
       "-- -- " skip(2).

    RUN prodict/gate/_gat_cro.p. 

    IF SESSION:BATCH-MODE and logfile_open
      THEN
        PUT STREAM logfile UNFORMATTED
            " " skip
            "-- ++ " skip
            "-- Fixing schema to resemble original {&PRO_DISPLAY_NAME} database." skip
            "-- -- " skip(2).

 
    ASSIGN     
    user_env[5]     = user_env_save5  
    user_env[26]    = user_env_save26 
    user_env[31]    = user_env_save31
    user_env[36]    = user_env_save36
    user_env[25]    = "**all**".

IF movedata THEN DO:
   FOR EACH s_ttb_con WHERE s_ttb_con.cons_type = "FOREIGN KEY":
        PUT STREAM code UNFORMATTED "ALTER TABLE " + s_ttb_con.tab_name + " ENABLE CONSTRAINT " + s_ttb_con.const_name SKIP. 
        PUT STREAM code UNFORMATTED user_env[5] SKIP.
   END.
END.

    RUN prodict/ora/_ora_md5.p (osh_dbname, pro_dbname).


 end.     /* found at least one object to pull */


/*
** The logfile will be closed as soon as we leave this procedure
** because it was opened in this procedure.
*/ 
IF l_closelog
  THEN DO:
    OUTPUT STREAM logfile CLOSE. 
    logfile_open = false. 
    END.


RETURN.

/*------------------------------------------------------------------*/


/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
   Procedure _ora_md2.p
   
   History: 02/16/99 DLM Added assignment of ora_conparms
            06/04/02 DLM Added check for error creating hidden files.
   
*/

   
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/ora/oravar.i }

DEFINE VARIABLE c AS CHARACTER NO-UNDO.

FIND _Db WHERE _Db._Db-name = ora_dbname NO-LOCK NO-ERROR.

IF NOT AVAILABLE _Db THEN DO TRANSACTION:
  CREATE _Db.
  ASSIGN
    _Db._Db-name    = ora_dbname
    _Db._Db-comm    = ora_conparms
    _Db._Db-type    = "ORACLE"
    _Db._Db-slave   = TRUE
    _Db._Db-Misc1[3] = ora_version
    _Db._Db-Misc2[1] = user_env[41]
    _Db._Db-xl-name = ora_codepage
    _Db._Db-coll-name = (IF ora_collname <> ? AND ora_collname <> "" THEN ora_collname
                         ELSE SESSION:CPCOLL).
END.

ASSIGN
  user_dbname = _Db._Db-name
  user_dbtype = _Db._Db-type
  drec_db     = RECID(_Db)
  c           = "add".

RUN prodict/ora/_ora_sys.p (drec_db,INPUT-OUTPUT c).
IF RETURN-VALUE = "2" THEN
    RETURN "2".
ELSE
  RETURN.

/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_md3 - returns list of Oracle OBJ$ in gate-work */
/*
  History:
  
  04/19/06    fernando    Oracle 10g - skip BIN$* tables
*/

/*
This is used primarily for the Progress automated test
scripts, but it was reasoned that it is useful enough in
general to leave in the /prodict directory for future use.
*/

{ prodict/dictvar.i    }
{ prodict/ora/oravar.i }
{ prodict/user/uservar.i }

{prodict/gate/gatework.i
  &new        = " "
  &options    = "initial ""*"" "
  &SelVarType = "VARIABLE l"
  } /* Defines WORKFILE: gate-work */

DEFINE VARIABLE object-type AS CHARACTER NO-UNDO. 
DEFINE VARIABLE object-prog AS CHARACTER NO-UNDO. 

FOR EACH DICTDBG.oracle_objects NO-LOCK,
  EACH DICTDBG.oracle_users
    WHERE DICTDBG.oracle_users.user# = DICTDBG.oracle_objects.owner# NO-LOCK
    BY DICTDBG.oracle_users.name BY DICTDBG.oracle_objects.name:


  /*
  ** Skip objects that we didn't create and/or don't own.
  */ 

   IF (DICTDBG.oracle_objects.type <> 2 AND
       DICTDBG.oracle_objects.type <> 6 AND
       DICTDBG.oracle_objects.type <> 7 AND
       DICTDBG.oracle_objects.type <> 8 AND
       DICTDBG.oracle_objects.type <> 9) 
     THEN NEXT.
 
  IF DICTDBG.oracle_users.name <> CAPS(ora_username) THEN
      NEXT. 

  /* Skip sequence generators created for compatible oracle tables */

  IF DICTDBG.oracle_objects.name MATCHES "*_SEQ" THEN
    NEXT.

  /* in Oracle 10g, there is a feature called flashback table which 
     saves deleted tables, by renaming them to BIN$<some-string>.
     We can skip these too.
  */
  IF DICTDBG.oracle_objects.NAME BEGINS "BIN$" THEN
     NEXT.

  IF DICTDBG.oracle_objects.type = 2 OR 
     DICTDBG.oracle_objects.type = 7 OR
     DICTDBG.oracle_objects.type = 8 OR
     DICTDBG.oracle_objects.type = 9 THEN
      object-type = "TABLE".
  ELSE 
      object-type = "SEQUENCE".

  object-prog = DICTDBG.oracle_objects.name.
  RUN prodict/gate/_gat_xlt.p (TRUE,drec_db,INPUT-OUTPUT object-prog).

  create gate-work. 

  ASSIGN
      gate-work.gate-type = object-type
      gate-work.gate-name = DICTDBG.oracle_objects.name
      gate-work.gate-qual = ?
      gate-work.gate-user = DICTDBG.oracle_users.name
      gate-work.gate-prog = object-prog. 

END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Procedure prodict/ora/_ora_md5.p

   Modified 11/12/97 DLM Removed DISCONNECT of Progress Database.
   
*/   


DEFINE INPUT PARAMETER ora-name AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER pro-name AS CHARACTER NO-UNDO.
DEFINE VARIABLE i AS INTEGER NO-UNDO.

/* connect up the databases to work with ------------------------------------*/

DELETE ALIAS DICTDB2.

IF NOT CONNECTED(pro-name) THEN
  CONNECT VALUE(pro-name)-1 -ld DICTDB2 NO-ERROR.
ELSE
   CREATE ALIAS DICTDB2 FOR DATABASE VALUE(pro-name).  

RUN prodict/ora/_ora_fix.p.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*
 hutegger     94/02/11    changed input-parameter of runload.i to "y"
*/

{ prodict/gate/_gat_md9.i
    &db-type  = "ora"
    &tmp-name = "osh"
    }
/*----------------------------------------------------------------
{ prodict/dictvar.i NEW }
{ prodict/ora/oravar.i }
DEFINE NEW SHARED STREAM   loaderr.
DEFINE NEW SHARED VARIABLE errs   AS INTEGER INITIAL 0 NO-UNDO.
DEFINE NEW SHARED VARIABLE recs   AS INTEGER INITIAL 0. /*UNDO*/
DEFINE NEW SHARED VARIABLE xpos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE NEW SHARED VARIABLE ypos   AS INTEGER INITIAL ? NO-UNDO.
DEFINE            VARIABLE noload AS CHARACTER NO-UNDO.

OUTPUT TO VALUE (osh_dbname + "out.tmp") NO-MAP.

CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(ora_dbname).
FIND DICTDB._Db WHERE DICTDB._Db._Db-name = ora_dbname.

assign noload = "u".
{ prodict/dictgate.i
    &action = "undumpload"
    &dbtype = "_Db._Db-type"
    &dbrec  = "RECID(_Db)"
    &output = "noload"
    }
    
FOR EACH DICTDB._File OF DICTDB._Db
  WHERE NOT DICTDB._File._Hidden
  AND   _file._File-number > 0
  AND   (noload = "" OR NOT CAN-DO(noload,_File._For-type))
  BY DICTDB._File._File-name:

  OUTPUT STREAM loaderr TO VALUE(_Dump-name + ".e") NO-ECHO.
  INPUT FROM VALUE(_Dump-name + ".d") NO-ECHO NO-MAP.
  RUN prodict/misc/_runload.i (INPUT "y") _File-name 0 100 _File-name 0.
  INPUT  CLOSE.
  OUTPUT STREAM loaderr CLOSE.  


END.

OUTPUT CLOSE.

RETURN.
----------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2009 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------

file: prodict/ora/_ora_prc.p

description:
    pulls schemainfo of procedure, FUNCTIONS and PACKAGES
    In difference to the other objects, these objects don't have
    indizes and triggers. However it is (at the moment) still possible
    to enter some of these, so we also try to retain it, just like 
    with the other objects.

Input:
    p_typevar   foreign type
    p_namevar   foreign name of base-object
    p_namevar-s foreign name of synonym (= p_namevar, if obj not synonym)
    p_progvar   progress-name
    p_spclvar   link-name

Output:
    p_gate-work recid of parent gate-work
    p_ttb_tbl   if only one procedure or function
                    then recid of s_ttb_tbl record
                    else  UNKNOWN
    s_ttb_tbl   table-information of all objects
    s_ttb_fld   field-information of all objects
    s_ttb_idx   index-information of all objects
    s_ttb_idf   index-field-information of all objects

History:
    hutegger    96/05   nameing-problem with packages, by checking wether
                        the _File already exists, and if so, use its
                        file-name instead of generating a new one
    hutegger    95/03   created out of _ora_fun.p
    mcmann    09/30/02  Added THREE-D to frame to match the rest of the
                        utility.
   fernando   06/11/07  Unicode and clob support
--------------------------------------------------------------------*/

/*--------------------------------------------------------------------
comments from prodict/ora/_ora_fun.p:

History:
    hutegger    95/01/26    changed schmea-triggers to internal procs
    hutegger    94/07/28    reworked
    marceau     94/07/20    prototype

--------------------------------------------------------------------*/
/*h-*/

define INPUT  parameter p_typevar                as integer.
define INPUT  parameter p_namevar                as character.
define INPUT  parameter p_namevar-s              as character.
define INPUT  parameter p_uservar                as character.
define INPUT  parameter p_progvar                as character.
define INPUT  parameter p_spclvar                as character.
define INPUT  parameter p_gate-work              as recid.
define OUTPUT parameter p_ttb_tbl                as RECID NO-UNDO.

&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i }
&UNDEFINE DATASERVER
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES

{ prodict/user/uservar.i }
{ prodict/ora/ora_ctl.i 8 }

define variable batch_mode          as logical   no-undo.
define variable dtyp                as integer   no-undo.
define variable fnam                as character no-undo.
define variable i                   as integer   no-undo.
define variable j                   as integer   no-undo.
define variable l_char-types        as character no-undo.
define variable l_chrw-types        as character no-undo.
define variable l_date-types        as character no-undo.
define variable l_dcml              as integer   no-undo.
define variable l_dcml-types        as character no-undo.
define variable l_dt                as character no-undo.
define variable l_floa-types        as character no-undo.
define variable l_frmt              as character no-undo.
define variable l_i###-types        as character no-undo.
define variable l_i##d-types        as character no-undo.
define variable l_i##l-types        as character no-undo.
define variable l_i#dl-types        as character no-undo.
define variable l_init              as character no-undo.
define variable l_logi-types        as character no-undo.
define variable l_prec              as integer   no-undo.
define variable l_time-types        as character no-undo.
define variable l_tmst-types        as character no-undo.
define variable l_scale             as integer   no-undo.
define variable msg                 as character no-undo EXTENT 6.
define variable nexts               as integer   no-undo.
define variable ntyp                as character no-undo.
define variable onum                as integer   no-undo.
define variable overld              as integer   no-undo.
define variable over-name           as character no-undo.
define variable pkgnm               as character no-undo.
define variable pnam                as character no-undo.
define variable rid                 as recid     no-undo.
define variable stoff               as integer   no-undo.
define variable tnam                as character no-undo.
DEFINE VARIABLE tdbtype         AS CHARACTER NO-UNDO.
DEFINE VARIABLE oraversion      AS INTEGER   NO-UNDO.

define buffer over_file         for DICTDB._File.
define buffer ds_columns        for DICTDBG.oracle_arguments.
define buffer ds_comments       for DICTDBG.oracle_comment.


/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/

FORM
                                                    SKIP(1)
  msg[1] FORMAT "x(25)" LABEL "Package"    colon 10 
  "->" 
  msg[2] FORMAT "x(25)" LABEL "  Package"           SKIP 
  msg[3] FORMAT "x(25)" LABEL "Procedure"  colon 10 
  "->"
  msg[4] FORMAT "x(25)" LABEL "Procedure"           SKIP
  msg[5] FORMAT "x(25)" LABEL "Argument"   colon 10
  "->"
  msg[6] FORMAT "x(25)" LABEL " Argument"           SKIP(1)
 with frame ds_make 
  ATTR-SPACE OVERLAY SIDE-LABELS ROW 4 CENTERED
  TITLE " Loading ORACLE Definitions " + p_spclvar THREE-D USE-TEXT.
  
/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/

define variable o-name        as character no-undo. /* local forgn-name */
define variable o-prog        as character no-undo. /* local table-name */
define variable o-type        as character no-undo. /* local forgn-type */
define variable o-pckg        as character no-undo. /* local package-id */
/*------------------------------------------------------------------*/
procedure error_handling:

define INPUT PARAMETER error-nr         as INTEGER.
define INPUT PARAMETER param1           as cHARACTER.
define INPUT PARAMETER param2           as cHARACTER.

define       variable  err-msg as character extent 5 initial [
/*  1 */ "WARNING: Field not found for Index-Field (Object#: &1 Field#: &2).",
/*  2 */ "ERROR: Table &1 has unsupported data types.",
/*  3 */ "       Skipping this table...",
/*  4 */ "WARNING: Index &1 has too many components; Accepting only first 16.",
/*  5 */ " &1 &2 " /* intentionally left blank for div. error-messages */
    ].
    
    if param1 = ? then assign param1 = "".
    if param2 = ? then assign param2 = "".
    
    if s_1st-error = false
     then do:
      assign s_1st-error = true.
      output stream s_stm_errors to ds_upd.e.
      output stream s_stm_errors close.
      end.
    output stream s_stm_errors to ds_upd.e append.
    PUT stream s_stm_errors unformatted
              SUBSTITUTE(err-msg[error-nr],param1,param2)  skip.
    output stream s_stm_errors close.
  
    end.  /* error_handling */


/*------------------------------------------------------------------*/
pause 0 no-message. /* needed for protoora to avoid "press spacebar..." */
assign
  batch_mode   = SESSION:BATCH-MODE.

find first DICTDBG.oracle_users
  where DICTDBG.oracle_users.name = p_uservar
  no-lock.

FOR EACH DICTDBG.oracle_objects
  where DICTDBG.oracle_objects.name   = p_namevar
    and   DICTDBG.oracle_objects.owner# = DICTDBG.oracle_users.user#
  no-lock:

  IF DICTDBG.oracle_objects.type = p_typevar THEN LEAVE.
END.
  
/* 20041223-004 
   if this an empty package, with nothing in it, don't bother adding it to the schema, just return 
*/
IF p_typevar = 9 THEN DO:
    FIND FIRST ds_columns WHERE ds_columns.obj# = DICTDBG.oracle_objects.obj# NO-LOCK NO-ERROR.
    IF NOT AVAILABLE ds_columns THEN
        RETURN.
END.


find first DICTDB._Db
  where DICTDB._Db._Db-name = LDBNAME("DICTDBG")
  and   DICTDB._Db._Db-type = "ORACLE".
ASSIGN oraversion = INTEGER(DICTDB._Db._Db-misc1[3]).

/* just make sure the info in the schema holder isn't invalid */
IF oraversion > 8 THEN DO:
   RUN prodict/ora/_get_oraver.p (OUTPUT oraversion).
   /* if something went wrong that we could not get the version, just keep the value
      from the schema holder
   */
   IF oraversion = 0 THEN
       oraversion = INTEGER(DICTDB._Db._Db-misc1[3]). 
END.

assign
  l_char-types  = "CHAR,VARCHAR,VARCHAR2,ROWID,NCHAR,NVARCHAR2"
  l_chrw-types  = "LONG,RAW,LONGRAW,CLOB,NCLOB,BLOB"
  l_date-types  = "DATE"
  l_dcml-types  = ""
  l_floa-types  = "FLOAT"
  l_i#dl-types  = "NUMBER,CURSOR"
  l_i##d-types  = ""
  l_i##l-types  = ""
  l_i###-types  = "TIME"
  l_logi-types  = "LOGICAL"
/*l_time-types  = ""*/
  l_tmst-types  = "TIMESTAMP,TIMESTAMP_LOCAL,TIMESTAMP_TZ"
  onum          = DICTDBG.oracle_objects.obj#
  p_ttb_tbl     = 0.

/*------------------------------------------------------------------*/

/********************************************************************/
/*          create PROGRESS-objects using the ORACLE-infos          */
/********************************************************************/


/*****----------------------------------------------------------*****/
/*****-------------- handle _file - entry/entries --------------*****/
/*****----------------------------------------------------------*****/

if p_typevar = 9
 then assign 
  o-name = p_namevar-s + "..."
  o-pckg = p_namevar-s
  o-prog = p_progvar + "..."
  o-type = ENTRY(p_typevar + 1,oobjects).
 else assign 
  o-name = p_namevar-s
  o-pckg = ""
  o-prog = p_progvar
  o-type = ENTRY(p_typevar + 1,oobjects).
    
/***** screen-protocol *****/
  if TERMINAL <> "" and not batch_mode 
   then display
      o-pckg @ msg[1] o-pckg @ msg[2]
      o-name @ msg[3] o-prog @ msg[4] 
      ""     @ msg[5] ""     @ msg[6]
      with frame ds_make.
     
/***** create s_ttb_tbl record *****/
  create s_ttb_tbl.
  assign
    p_ttb_tbl              = ( if p_typevar = 9
                                then 0
                                else integer(RECID(s_ttb_tbl))
                             )
    s_ttb_tbl.gate-work    = p_gate-work
    s_ttb_tbl.pro_name     = o-prog
    s_ttb_tbl.ds_msc21     = o-pckg
    s_ttb_tbl.ds_spcl      = ( if p_spclvar = ""
                                 then ?
                                 else p_spclvar
                             )
    s_ttb_tbl.ds_name      = o-name
    s_ttb_tbl.ds_user      = p_uservar
    s_ttb_tbl.ds_type      = o-type
    stoff                  = 1
    rid                    = RECID (s_ttb_tbl).



/* for each "item" of that object:                  */
/*      procedure$ = name of that item              */
/*      overload#  = overload-instance of that item */
/*      sequence#  = 0: procedure                   */
/*                   1: function                    */
/*                  >1: parameters                  */
/*      position   = 0 for function; else procedure */
/*      type#      = 251: this parameter is array   */
/*                   x   parameter - data-type      */
_crtloop:
for each ds_columns
  fields( obj# procedure$ overload# sequence# type# position argument
          level# in_out default$ default# length_ charsetform)
  where ds_columns.obj# = onum
  no-lock
  by ds_columns.procedure$
  by ds_columns.overload#
  by ds_columns.sequence#
  /*transaction*/: /* 20040309-029 moved the transaction to code below*/


/*****----------------------------------------------------------*****/
/*****-------------- adjust s_ttb_tbl for packages -------------*****/
/*****----------------------------------------------------------*****/

  if ds_columns.sequence# <= 1
   then DO:  /* object = { package, procedure, function } */
    
    /* generate the right table-, package- and type-names */
    if p_typevar = 9
     then DO:  /* object = package */
      assign
        overld = ds_columns.overload#
        o-name = ds_columns.procedure$
        o-prog = o-name
               + ( if overld > 0 
                    then "#" + STRING (overld, "999") 
                    else ""
                 )
        o-type = ( if ds_columns.position = 0
                    then "FUNCTION"
                    else "PROCEDURE"
                 ).

      find first DICTDB._File
        where DICTDB._File._db-recid     = drec_db
        and   DICTDB._File._fil-misc2[1] = o-pckg
        and   DICTDB._File._for-name     = o-name
        and   DICTDB._File._for-type     = o-type
        and ( overld = 0
           or DICTDB._File._file-name matches "*#" + STRING (overld, "999")
            )
        no-lock no-error.

      if not available DICTDB._File
       then do:
        RUN prodict/gate/_gat_fnm.p 
          ( INPUT        "TABLE",
            INPUT        drec_db,
            INPUT-OUTPUT o-prog
          ).
        end.
       else assign
        o-prog = DICTDB._File._file-name.


    /***** adjust screen-protocol *****/
      if TERMINAL <> "" and not batch_mode 
       then display
          o-pckg @ msg[1] o-pckg @ msg[2]
          o-name @ msg[3] o-prog @ msg[4] 
          ""     @ msg[5] ""     @ msg[6]
          with frame ds_make.
      
    /***** create/adjust s_ttb_tbl record *****/
      if p_ttb_tbl = 0
       then do: /* use previously created s_ttb_tbl-record */
        assign
          p_ttb_tbl              = RECID (s_ttb_tbl)
          s_ttb_tbl.pro_name     = o-prog
          s_ttb_tbl.ds_name      = o-name
          s_ttb_tbl.ds_type      = o-type
          stoff                  = 1
          rid                    = RECID (s_ttb_tbl).
        end.     /* use previously created s_ttb_tbl-record */
        
       else do:  /* next proc/func in package -> create new s_ttb_tbl */
        create s_ttb_tbl.
        assign
          p_ttb_tbl              = ?
          s_ttb_tbl.gate-work    = p_gate-work
          s_ttb_tbl.ds_msc21     = o-pckg
          s_ttb_tbl.pro_name     = o-prog
          s_ttb_tbl.ds_name      = o-name
          s_ttb_tbl.ds_spcl      = ( if p_spclvar = ""
                                       then ?
                                       else p_spclvar
                                   )
          s_ttb_tbl.ds_type      = o-type
          s_ttb_tbl.ds_user      = p_uservar
          stoff                  = 1
          rid                    = RECID (s_ttb_tbl).
        end.     /* next proc/func in package -> create new s_ttb_tbl */

      end.     /* object = package */

    if ds_columns.sequence# < 1 
     then NEXT. /* procedure has no return-value */

    end.     /* object = { package, procedure, function } */


/*****----------------------------------------------------------*****/
/*****------------- handle _field - entry/entries --------------*****/
/*****----------------------------------------------------------*****/

  if ds_columns.type# = 251 
   then do:         /* 251: this field is an array, and the   */
    assign          /*      next argument holds the data-type */
      nexts  = 2    /* arbitruary */
      o-name = ds_columns.argument.
    NEXT.
    end.
  else if ds_columns.level# = 0
   then assign nexts = 0.
/* else: this is the actual field, use nexts from previous field */

  { prodict/ora/ora_typ.i 
    &procedure = "YES"
    }
  
  assign 
    pnam  = ( if ds_columns.argument <> ?
               then ds_columns.argument 
               else ds_columns.procedure$
            )
    pnam  = ( if  pnam = ?
                or ds_columns.level# > 0
                then o-name
                else pnam
            )
    fnam  = pnam.
  
  /* NCHAR and NVARCHAR2 (Unicode Types) are only supported as such
     with Oracle 9 and up, otherwise, they will be treated as character
  */
  IF (l_dt = "NVARCHAR2" OR l_dt = "NCHAR") AND oraversion < 9 THEN DO:
      IF l_dt = "NVARCHAR2" THEN
          l_dt = "VARCHAR2".
      ELSE
          l_dt = "CHAR".
  END.  

  RUN prodict/gate/_gat_fnm.p
    ( INPUT        "FIELD",
      INPUT        rid,
      INPUT-OUTPUT pnam
    ).

  if not batch_mode then
    display
      fnam     @ msg[5]
      pnam     @ msg[6]
     with frame ds_make.
  
  find first ds_comments
    where ds_comments.obj# = ds_columns.obj#
    and   ds_comments.col# = ds_columns.sequence#
    no-lock no-error.
  
  assign
    dtyp    = LOOKUP(l_dt,user_env[12])
    l_init  = ?
    ntyp    = ( if dtyp > 0
                  then ENTRY(dtyp,user_env[15])
                  else "character"
              )
    l_dcml  = 0
    l_frmt  = "?".
  
  /*20040309-029
    Define the transaction here so if the code in gate/gat_pul2.i undoes
    the transaction, it only undoes the creation of this record. Everything else
    can remain the same.
  */
  DO TRANSACTION:
  
  CREATE s_ttb_fld.
  assign
    s_ttb_fld.pro_desc    = ( if not available ds_comments
                                or ds_comments.comment$ = ?
                                then ""
                                else ds_comments.comment$
                            )
    s_ttb_fld.pro_extnt   = nexts
    s_ttb_fld.pro_name    = pnam
    s_ttb_fld.ttb_tbl     = rid
    s_ttb_fld.ds_stoff    = stoff
    s_ttb_fld.ds_name     = fnam
    s_ttb_fld.ds_type     = l_dt
    s_ttb_fld.pro_init    = ds_columns.default$
    s_ttb_fld.pro_mand    = ( ds_columns.default# = ? )
    s_ttb_fld.pro_order   = ds_columns.sequence# * 10 + 1000
    s_ttb_fld.ds_prec     = ?
    s_ttb_fld.ds_scale    = ?
    s_ttb_fld.ds_lngth    = ( if ds_columns.length_ > 0
                                then ds_columns.length_
                                else 15
                            )
    s_ttb_fld.ds_itype    = ds_columns.type#.

  {prodict/gate/gat_pul2.i
    &undo      = "next"
    }

  /* this is just for ORACLE 9 and above */
  IF oraversion > 8 THEN
     ASSIGN s_ttb_fld.ds_msc25 = (IF ds_columns.charsetform = 2 THEN '1' ELSE ?).

  /* fix the format for logical if it is an empty string */
  IF CAN-DO(l_logi-types,s_ttb_fld.ds_type) THEN
      IF s_ttb_fld.pro_frmt = ""  THEN
         s_ttb_fld.pro_frmt = "yes/no".

/* NOTE: ds_prec gets used differently with ORACLE procedures and
 *       functions
 */
  assign
    s_ttb_fld.ds_prec     = ( if ds_columns.in_out = ?
                                then 1 
                                else ds_columns.in_out + 1
                            ).
/*
  { prodict/ora/ora_mak1.i
    &data-type = "c"
    &file-name = "oracle_arguments"
    &undo      = "LEAVE"
    }
*/
    
  if s_ttb_fld.ds_prec = 2
   then assign s_ttb_fld.pro_mand = no.  /* output only argument */  

  /* Mark pseudo-function-argument that represent the return value */

  if   o-type               = "FUNCTION" 
   and ds_columns.sequence# = 1
   then s_ttb_fld.ds_prec = s_ttb_fld.ds_prec + 8.

  assign stoff = stoff + (if nexts > 0 then nexts else 1).

  END. /* end transaction */

  end.     /* for each ds_columns */


if not batch_mode then
    hide frame ds_make no-pause.

RETURN.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000,2007-2011 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/_ora_pul.p   THIS ROUTINE GETS CALLED ONCE PER LINK!

Description:
    pulls schemainfo of all objects contained in gate-work into
    the temp-tables

    <DS>_get.p gets a list of all pullable objects from the foreign DB
    <DS>_pul.p pulled over the definition from the foreign side
    gat_cmp.p  compared the existing definitions with the pulled info
    gat_cro.p  replaces the existing definitions with the pulled info
               or creates the new object if it didn't already exist

    Create <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Update <DS> Schema: <DS>_get.p <DS>_pul.p gat_cro.p
    Verify <DS> Schema: <DS>_get.p <DS>_pul.p gat_cmp.p gat_cro.p

Input:
    &DS_DEBUG   DEBUG to protocol the creation
                ""    to turn off protocol
    gate-work   shared temp-table that contains all the objects to pull

Output:
    s_ttb_tbl   table-information of all objects
    s_ttb_fld   field-information of all objects
    s_ttb_idx   index-information of all objects
    s_ttb_idf   index-field-information of all objects
    s_ttb_seq   sequence-information of all objects

History:
    hutegger    95/04   created out of ora_lkm.i
    mcmann     03/20/01 Added support for decending indexes
    mcmann     05/11/01 Change unique condition to be = 1
    fernando   06/11/07 Unicode support
    fernando   12/31/08 don't set mandatory for blob/clob fields
    kmayur     06/21/11 added support for constraint pull - OE00195067
--------------------------------------------------------------------*/
/*h-*/

define buffer ds_users          for DICTDBG.oracle_users.
define buffer ds_objects        for DICTDBG.oracle_objects.
define buffer ds_objects-2      for DICTDBG.oracle_objects.
define buffer ds_comments       for DICTDBG.oracle_comment.
define buffer ds_columns        for DICTDBG.oracle_columns.
define buffer ds_columns-2      for DICTDBG.oracle_columns.
define buffer ds_indexes        for DICTDBG.oracle_indexes.
define buffer ds_idx-cols       for DICTDBG.oracle_idxcols.
define buffer ds_sequences      for DICTDBG.oracle_sequences.
define buffer ds_constraint     for DICTDBG.oracle_constraint.
define buffer ds_constraint-2   for DICTDBG.oracle_constraint.
define buffer ds_cons           for DICTDBG.oracle_cons.
define buffer ds_cons-2         for DICTDBG.oracle_cons.
define buffer ds_cons-fld       for DICTDBG.oracle_cons_fld.

DEFINE VARIABLE h1 AS INTEGER NO-UNDO.
/*------------------------------------------------------------------*/

/* SYSDATE will be handled by ORACLE so PROGRESS gets ? */

{prodict/gate/gat_pul.i
  &buffer        = " "" "" "
  &col-fields    = "scale precision_ length_ null$ default$ charsetform"
  &colid         = "col#"
  &colid-t-cmnt  = "?"
  &comment       = "comment$"
  &db-type       = "oracle"
  &dbtyp         = "ora"
  &ds_recid      = "ds_columns.col#"
  &for-idx-name  = "ds_objects-2.name"
  &for-idx-nam2  = "ds_objects-2.name"
  &for-obj-name  = "ds_objects-2.name"
  &idx-fields    = "bo# obj# unique$ "
  &idx-tbl-break = "break by ds_objects-2.name"
  &idx-uniq-cond = "(ds_indexes.unique$ = 1)"
  &idx-where     = " "
  &idxid         = "bo#"
  &init          = "( IF  ds_columns.default$ = """"SYSDATE""""
                       OR ds_columns.default$ = """"NULL""""
                       THEN ?
                       ELSE ds_columns.default$
                    )"
  &length        = "ds_columns.length_"
  &mand          = "((ds_columns.null$ <> 0) AND (LOOKUP(l_dt,""""BLOB,BFILE,CLOB,NCLOB"""") = 0))"
  &msc23         =  "s_ttb_fld.ds_msc23"
  &name          = "ds_columns.name"
  &objid         = "obj#"
  &precision     = "ds_columns.precision_"
  &radix         = "(IF l_dt = """"FLOAT"""" then 0.30103 else 1)"
  &scale         = "ds_columns.scale"
  &type          = "type#"
  &typvar        = "LOOKUP(typevar-s ,oobjects) - 1"
  &typvar-b      = "LOOKUP(""VIEW""  ,oobjects) - 1"
  &usrid         = "user#"
  &usrid-t       = "owner#"
  }

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*********************************************************************/

/*-----------------------------------------------------------------------

File:
    prodict/ora/_ora_sys.p
    
Description:
    depending on the input code this routines either creates/updates
    the metaschema-info for the foreign db, or returns specifique info.

Input Parameter:
    system      a   add meta-schema tables
                c   can-delete this _db? (:= no userdefined tables?)
                f   supply list of foreign-names of foreign meta-schema
                p   supply list of progress-names of foreign meta-schema
                q   query for capabilities
                u   supply list of un{dump|load}able foreign object-types

Output Parameter:
    system      a       none
                c       "ok"  or  ""  for "can-delete"  or  "can't delete"
                f,p,u   list of objects
                q       list of allowed/supported functions/features
                
History:
    06/11/07    fernando    Unicode support - new fields in oracle_columns
    04/20/06    fernando    Added NOTTCACHE define - 20050930-006  
    07/18/02    D. McMann   Changed default codepage to iso8859-1
    06/04/02    D. McMann   Added check for problem creating hidden files
    07/13/98    D. McMann   Added _Owner to _File Find
    98/03       D. McMann   Added creation of oracle_tablespace table TS$
    95/08       hutegger    extracted non-queryable objects from l_sys-obj
                            assignment, so that report-builder can use it
                            too (-> ora/ora_sys.i)
    95/08       hutegger    added support for "f" and "p"; plus 
                            auto-update functionality for meta-schema
    94/08       hutegger    Index-Capabilities: u changed from 
                            unique-index-allowed to 
                            change-uniqueness-allowed   and
                            removed the "u" from the capab-string
    06/21/11   kmayur       added support for constraint pull - OE00195067                            

-----------------------------------------------------------------------*/
/*h-*/

/*===========================  DEFINITIONS ============================*/
&GLOBAL-DEFINE NOTTCACHE 1
{ prodict/dictvar.i }

DEFINE INPUT        PARAMETER dbkey         AS RECID     NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER system        AS CHARACTER NO-UNDO.

DEFINE VARIABLE               l_schema-ok   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE               l_sys-obj     AS CHARACTER NO-UNDO.
DEFINE VARIABLE               l_sys-obj-f   AS CHARACTER NO-UNDO.

/*=============================  TRIGGERS  ============================*/

/*=======================  INTERNAL PROCEDURES  =======================*/

/*=========================  INITIALIZATIONS  =========================*/

/* initialize system-objects list */
assign
  l_sys-obj   = {prodict/ora/ora_sys.i} /* non-queryable objects */
              + ","
              + "oracle_arguments,oracle_columns,oracle_comment,"
              + "oracle_idxcols,oracle_indexes,oracle_objects,"
              + "oracle_procedures,oracle_sequences,oracle_users,"
              + "oracle_links,oracle_synonyms,oracle_views,"
              + "oracle_tablespace,oracle_constraint,oracle_cons,"
              + "oracle_cons_fld"
  l_sys-obj-f = "ARGUMENT$,COL$,COM$,ICOL$,IND$,OBJ$,"
              + "PROCEDURE$,SEQ$,USER$,LINK$,SYN$,VIEW$,CON$,CDEF$,CCOL$".
/* NOTE: If you add a new foreign-meta-schema table be sure to append
 *       its progress-name and foreign-name TO THE END of the lists
 *       above. This way we automatically upgrade old schemaholders
 *       with the new tables.
 */

/* check if meta-schema is up-to-date */
find first DICTDB._File
  where RECID(DICTDB._File) = dbkey
  and   DICTDB._File._File-name = entry(num-entries(l_sys-obj),l_sys-obj)
  AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN" )
  no-lock no-error.
assign
  l_schema-ok = available DICTDB._File OR dbkey = ?.

/*============================  MAIN CODE  ============================*/

/*
system = "f" for list of foreign-names of meta-schema-objects
-------------------------------------------------------------
*/
IF      system BEGINS "f"
 then assign system = l_sys-obj-f.


/*
system = "p" for list of progress-names of meta-schema-objects
--------------------------------------------------------------
*/
ELSE IF system BEGINS "p"
 then assign system = l_sys-obj.


/*
system = "a" for add system tables
----------------------------------
*/
ELSE IF system BEGINS "a"
 or NOT l_schema-ok THEN DO: /* add meta-schema definitions */
  RUN adecomm/_setcurs.p ("WAIT").
  RUN "prodict/ora/_ora_cra.p" (dbkey) NO-ERROR. /* argument             */
  /* check to make sure table was created if not return */
  IF NOT CAN-FIND(FIRST _file WHERE _db-recid = dbkey
                                AND _file-name = "oracle_arguments") THEN
    RETURN "2".

  RUN "prodict/ora/_ora_crc.p" (dbkey). /* columns              */
  RUN "prodict/ora/_ora_crg.p" (dbkey). /* PROC-TEXT-BUFFER
                                         * SEND-SQL-STATEMENT 
                                         * CLOSEALLPROCS        */
  RUN "prodict/ora/_ora_cri.p" (dbkey). /* indexes              */
  RUN "prodict/ora/_ora_crk.p" (dbkey). /* idxcols              */
  RUN "prodict/ora/_ora_crl.p" (dbkey). /* links synonyms views */
  RUN "prodict/ora/_ora_crm.p" (dbkey). /* comment              */
  RUN "prodict/ora/_ora_cro.p" (dbkey). /* objects              */
  RUN "prodict/ora/_ora_crp.p" (dbkey). /* procedures           */
  RUN "prodict/ora/_ora_crs.p" (dbkey). /* sequences            */
  RUN "prodict/ora/_ora_crt.p" (dbkey). /* tablespaces          */
  RUN "prodict/ora/_ora_cru.p" (dbkey). /* users                */
  RUN "prodict/ora/_ora_crn.p" (dbkey). /* constraint           */
  RUN adecomm/_setcurs.p ("").
  end.

/*
system = "c" for can-remove system tables
-----------------------------------------
*/
/*ELSE*/ IF system BEGINS "c" THEN DO: /* can remove entire schema? */
  /* return TRUE if the database contains no user files and can be deleted */
  FIND FIRST DICTDB._File
    WHERE DICTDB._File._Db-recid = dbkey
    AND   LOOKUP(DICTDB._File._File-name,l_sys-obj) = 0
    AND   DICTDB._File._File-name <> "oracle5_COLUMNS"
    AND   DICTDB._File._File-name <> "oracle5_INDEXES"
    AND   DICTDB._File._File-name <> "oracle5_TABLES"
    AND   DICTDB._File._File-name <> "oracle5_USERS"
    AND   DICTDB._File._File-name <> "oracle6_COLUMNS"
    AND   DICTDB._File._File-name <> "oracle6_COMMENT"
    AND   DICTDB._File._File-name <> "oracle6_IDXCOLS"
    AND   DICTDB._File._File-name <> "oracle6_INDEXES"
    AND   DICTDB._File._File-name <> "oracle6_OBJECTS"
    AND   DICTDB._File._File-name <> "oracle6_TABLES"
    AND   DICTDB._File._File-name <> "oracle6_SEQUENCES"
    AND   DICTDB._File._File-name <> "oracle6_USERS"
    NO-ERROR.
  /* leave ORA5 references in here for update purposes */
  system = STRING(AVAILABLE DICTDB._File,"/ok").
  end.


/*
system = "q" for query
----------------------
  ENTRY  1 = valid database options
             a=after_add, c=can_delete, d=do_delete, u=userid/passwd_supported
  ENTRY  2 = valid file options
             a=add, c=can_copy_fields, d=delete, f=chg_foreign_name,
             g=get_foreign_name, n=can_add_new_fields, o=get_ownername,
             r=rename, s=chg_foreign_size, t=chg_foreign_type
  ENTRY  3 = valid index options
             a=add, b=idxbuild, d=delete, i=inactivate_index,
             n=non-unique_indexes_allowed, r=rename, s=set_primary,
             u=change_uniqueness_allowed, w=word_index, 
             #=index-number-to-be-generated
  ENTRY  4 = load size
  ENTRY  5 = db class and naming conventions
             0=progress_db 1=stand_alone_file 2=part_of_database
             l=logical_name_applies, p=physical_name_applies
  ENTRY  6 = max number index components
  ENTRY  7 = name of sysadmin ("SA", "DBA", "SYSTEM", "MANAGER", etc.)
  ENTRY  8 = name of system tables ("SYS.*", etc.)
  ENTRY  9 = three-letter dictionary code
  ENTRY 10 = valid sequence options
            a=can_add, d=can_delete, m=can-modify-anything-beyond-name
            n=has_foreign_name o=has_owner, r=can_rename, s=seq_supported
  ENTRY 11 = default-value for code-page

*/
ELSE IF system BEGINS "q" THEN DO:
  system = "acdu,dgor,adnrsu#,100,2l,16,DBA,SYS.*,ora,dnors,iso8859-1".
  ASSIGN dbkey = drec_db.
  RUN "prodict/ora/_ora_crt.p" (dbkey).
  RUN "prodict/ora/_ora_crc.p" (dbkey). /* columns  */
  RUN "prodict/ora/_ora_cra.p" (dbkey). /* argument */
end.


/*
system = "u" for unloadable/undumpable file types
-------------------------------------------------
*/
ELSE IF system BEGINS "u" THEN DO:
  system = "PROCEDURE,FUNCTION,PACKAGE,BUFFER".
  end.

RETURN.

/*=====================================================================*/

/**********************************************************************
* Copyright (C) 2000,2006-2008 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
**********************************************************************/

/* _ora_typ.p - Oracle-to-Progress datatype conversion subroutine */

/*
Pass parameters, and this routine will fill in the unknowns, as long as
io-pro-type or io-gate-type is defined.

  in:  io-pro-type  = ? or Progress datatype
       io-length    = ? or _Fld-stlen; size, or 0 for variable length
       io-dtype     = ? or _Fld-stdtype; gate datatype code for _Fld-stdtype
       io-gate-type = ? or Oracle datatype
  out: io-pro-type  = Progress datatype
       io-length    = _Fld-stlen
       io-dtype     = _Fld-stdtype
       io-gate-type = Oracle datatype
       io-format    = suggested format

To get the list of progress types that can be mapped to a particular
gateway type:
  in:  io-pro-type  = "get-list"
       io-gate-type = ?
  out: io-pro-type = comma separated list of pro_types

To get the Oracle-to-PROGRESS tables copied to the environment:
  in:  io-pro-type  = ?
       io-gate-type = ?
  out: user_env[11] = gate_desc
       user_env[12] = gate_type
       user_env[13] = gate_stlen
       user_env[14] = gate_stdtype
       user_env[15] = pro_type
       user_env[16] = gate_family
       user_env[17] = pro_format

  Note: gate_family is the data type family.  This indicates which data
  types can be changed to which other types - only types within the same
  family can be switched with each other.  0 = an orphan: cannot be changed.
*/
/* history:
    04/07/08    fernando    Datetime support
    06/11/07    fernando    Unicode and clob support
    06/05/26    fernando    Added support for int64
    98/01/15    D. McMann   Swapped Cursor and Number/logical so that the
                            Number entries are contiguous
    95/05/24    hutegger    added datatype UNDEFINED (treat it like RAW)
    94/07/14    hutegger    added output of format in user_env[17] 
                            plus support of i, l, # for formats
                            plus usage of this program for _xxx_mak.p
*/ 

                            
/* NOTES for gate_config: 
1) Standard character string must be first in table! 
2) All the Number entries should be contiguous in table with 
   the Number/Number entry as the first one.
3) the format can contain either 
   * a specific format                                             OR 
   * {c,d,dt,i,l,#} for (character, date, datetime, integer, logical, decimal} to use 
     the format created by the hardcoded algorithm in _xxx_mak.i   OR
   * ? to use the PROGRESS default format  
*/ 

DEFINE VARIABLE gate-config AS CHARACTER EXTENT 41 NO-UNDO INITIAL [
  /*description     datatyp  sz code pro type fm format*/
  /*--------------- -------  - ----- -------- -- ------*/ 
  "Character string,Char      ,0, 4096,character,0,|c", 
  "Var-length Char ,VarChar   ,0, 4096,character,0,|c",
  "Var-length Char2,VarChar2  ,0, 4096,character,0,|c",
  "NVarChar2       ,NVarChar2 ,0, 4096,character,0,|c",
  "NChar           ,NChar     ,0, 4096,character,0,|c",
  "Number          ,Number    ,0, 8192,decimal  ,1,|#",
  "Number          ,Number    ,0, 8192,integer  ,1,|i",
  "Number          ,Number    ,0, 8192,int64    ,1,|i",
  "Number          ,Number    ,0, 8192,logical  ,1,|?",
  "Number          ,Number    ,0, 8192,recid    ,1,|i",
  "Cursor          ,Cursor    ,0, 8192,integer  ,1,|i",
  "Float           ,Float     ,0, 8192,decimal  ,0,|#",
  "CLOB            ,CLOB      ,0,    0,CLOB     ,0,|c",
  "NCLOB           ,NCLOB     ,0,    0,CLOB     ,0,|c",
  "NCLOB           ,NCLOB     ,0,    0,character,0,|c",
  "BLOB            ,BLOB      ,0,    0,BLOB     ,0,|c",
  "BFILE           ,BFILE     ,0,    0,BLOB     ,0,|c",           
  "Long Character  ,Long      ,0,16384,character,0,|c",
  "Undefined       ,undefined ,0,20480,character,0,|c",
  "Raw             ,Raw       ,0,20480,raw      ,0,|c",
  "Long Raw        ,LongRaw   ,0,24576,raw      ,0,|c",
  "Rowid           ,Rowid     ,0, 4096,character,0,|c",
  "Logical         ,Logical   ,0, 8192,logical  ,0,|?",
  "Date            ,Date      ,0,12288,date     ,2,|?",
  "Date            ,Date      ,0,12288,datetime ,2,|dt",
  "Date            ,Date      ,0,12288,datetime-tz,2,|dtz",
  "DateTime (Char) ,Date      ,0,12288,character,2,|9999/99/99 99:99:99",
  "Time            ,Time      ,0,28672,integer  ,0,|>>,>>9",
  "DateTime        ,Timestamp ,0, 6144,datetime ,3,|dt",
  "DateTime        ,Timestamp ,0, 6144,date     ,3,|d",
  "DateTime        ,Timestamp ,0, 6144,datetime-tz,3,|dtz",
  "DateTime        ,Timestamp ,0, 6144,character,3,|x(26)",
  "DateTime (local),Timestamp_local,0, 14336,datetime,   4,|dt",
  "DateTime (local),Timestamp_local,0, 14336,date,       4,|d",
  "DateTime (local),Timestamp_local,0, 14336,datetime-tz,4,|dtz",
  "DateTime (local),Timestamp_local,0, 14336,character,  4,|x(26)",
  "DateTime-tz      ,Timestamp_tz ,0, 10240,datetime-tz, 5,|dtz",
  "DateTime-tz      ,Timestamp_tz ,0, 10240,datetime,    5,|dt",
  "DateTime-tz      ,Timestamp_tz ,0, 10240,date,        5,|d",
  "DateTime-tz      ,Timestamp_tz ,0, 10240,character,   5,|x(34)",
  ?
].


{ prodict/user/uservar.i }

DEFINE INPUT-OUTPUT PARAMETER io-dtype     AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-length    AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-pro-type  AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-gate-type AS CHARACTER NO-UNDO.
DEFINE       OUTPUT PARAMETER io-format    AS CHARACTER NO-UNDO.

DEFINE              VARIABLE  c            AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_desc    AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_stdtype AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_stlen   AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_type    AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  gate_family  AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  i            AS INTEGER   NO-UNDO.
DEFINE              VARIABLE  pro_format   AS CHARACTER NO-UNDO.
DEFINE              VARIABLE  pro_type     AS CHARACTER NO-UNDO.

/* If we want the list of progress types that match a given gateway
   type, then just get that.  A gateway type that matches multiple
   Progress types are in contiguous entries in the gate-config table.
*/
IF io-gate-type <> ? AND io-pro-type = "get-list" THEN DO:
  DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
    IF TRIM(ENTRY(2,gate-config[i])) = io-gate-type THEN
       LEAVE.
  END.
  io-pro-type = "".
  DO WHILE TRIM(ENTRY(2,gate-config[i])) = io-gate-type:
    io-pro-type = io-pro-type + (IF io-pro-type = "" THEN "" ELSE ",") +
      	       	  TRIM(ENTRY(5,gate-config[i])).
    i = i + 1.
  END.
  RETURN.
END.

/* this is a special case, where caller wants datetime to be the default mapping 
   for timestamp
*/
IF io-pro-type = "datetime_default" THEN DO:
   ASSIGN io-pro-type = ?. 
   DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
      IF TRIM(ENTRY(1,gate-config[i])) = "Date" THEN DO:
         c = TRIM(ENTRY(5,gate-config[i])).
         /* if date is not the default, nothing to be done here */
         IF c EQ "date" THEN
             assign c = gate-config[i]
                    gate-config[i] = gate-config[i + 1]
                    gate-config[i + 1] = c.

          /* when we get there we are done */
          LEAVE.
      END.
   END.
END.

/* Compose comma delimited lists of each "column" of the gate-config 
   array (leaving just the format in gate-config itself).
*/
DO i = 1 TO i + 1 WHILE gate-config[i] <> ?:
  ASSIGN
    gate_desc      = gate_desc    + TRIM(ENTRY(1,gate-config[i])) + ","
    gate_type      = gate_type    + TRIM(ENTRY(2,gate-config[i])) + ","
    gate_stlen     = gate_stlen   + TRIM(ENTRY(3,gate-config[i])) + ","
    gate_stdtype   = gate_stdtype + TRIM(ENTRY(4,gate-config[i])) + ","
    pro_type       = pro_type     + TRIM(ENTRY(5,gate-config[i])) + ","
    gate_family    = gate_family  + TRIM(ENTRY(6,gate-config[i])) + ","
    gate-config[i] = SUBSTRING(gate-config[i]
                              ,INDEX(gate-config[i],"|") + 1
                              ,-1
                              ,"character")
    pro_format     = pro_format   + gate-config[i] + "|".
END.

IF io-gate-type = ? AND io-pro-type = ? THEN DO:
  ASSIGN
    user_env[11] = gate_desc
    user_env[12] = gate_type
    user_env[13] = gate_stlen
    user_env[14] = gate_stdtype
    user_env[15] = pro_type
    user_env[16] = gate_family
    user_env[17] = pro_format.
/*  ASSIGN
 *    user_env[11] = pro_type
 *    user_env[12] = gate_type
 *    user_env[13] = gate_stdtype
 *    user_env[14] = gate_stlen
 *    user_env[15] = gate_desc
 *    user_env[16] = gate_family.
 */
  RETURN.
END.

i = 0.

/* PROGRESS datatype -> ORACLE datatype (io-pro-type given, io-gate-type = ?) */
IF io-gate-type = ? THEN DO: 
  DO i = 1 TO NUM-ENTRIES(gate_type) - 1:
    IF io-pro-type = ENTRY(i,pro_type)
      AND INTEGER(ENTRY(i,gate_stdtype)) = io-dtype
      AND (INTEGER(ENTRY(i,gate_stlen))  = io-length
        OR INTEGER(ENTRY(i,gate_stlen))  = 0) THEN LEAVE.
  END.
  io-gate-type = ENTRY(i,gate_type).
END.
ELSE DO: /* io-gate-type given, io-pro-type may be ? */
   i = LOOKUP(io-gate-type,gate_type).
   IF io-pro-type  = ? THEN 
      io-pro-type = ENTRY(i,pro_type).
   ELSE 
      /* Make sure we have the entry that matches both io-pro-type AND
      	 io-gate-type.
      */
      IF io-pro-type <> ENTRY(i,pro_type) THEN
	DO i = i + 1 to NUM-ENTRIES(gate_type) - 1:
	   IF io-pro-type = ENTRY(i,pro_type) AND
	      io-gate-type = ENTRY(i,gate_type) THEN LEAVE.
	END.
END.

ASSIGN
  io-length  = (IF INTEGER(ENTRY(i,gate_stlen)) = 0 THEN io-length
               ELSE INTEGER(ENTRY(i,gate_stlen)))
  io-format  = (IF gate-config[i] = "d" THEN "99/99/99"
               ELSE IF gate-config[i] = "c" THEN
                 "x(" + STRING(IF io-length = 0 THEN 8 ELSE io-length) + ")"
               ELSE gate-config[i])
  io-dtype   = INTEGER(ENTRY(i,gate_stdtype)).

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* --------------------------------------------------------------------

File: prodict/ora/_ora_vts.p

Description:
    This procedure verifys the tablespace names entered during protoora for
    where to place the files and indexes.
    
Input:
    none
    
Output:
    none
    
History:
     created 03/16/98 D. McMann
     
*/

{ prodict/ora/oravar.i }
{ prodict/user/uservar.i }

DEFINE SHARED VARIABLE l_closelog  AS logical   NO-UNDO.

IF user_env[34] <> ? and user_env[34] <> "" THEN DO:
   FIND DICTDBG.oracle_tablespace where DICTDBG.oracle_tablespace.name = user_env[34]
                                    and DICTDBG.oracle_tablespace.online$ = 1
                                    NO-LOCK NO-ERROR.
   /* If available then check to see if userid is owner if not check for security */   
   IF AVAILABLE DICTDBG.oracle_tablespace THEN DO:
     
         /* here is where code checks to see if user can use tablespace */
       
   END.
   ELSE DO:
  
     IF not logfile_open THEN DO:
        output stream logfile to value(user_env[2] + ".log") 
               unbuffered no-map no-echo append. 
        assign l_closelog   = true
               logfile_open = true. 
      END.

      PUT STREAM logfile UNFORMATTED 
           " " skip 
           "-- ++ " skip
           "   Tablespace " user_env[34] " could not be found." skip
           "   Load of SQL not performed." SKIP
           "-- -- " skip(2).
      ASSIGN movedata = false.
      RETURN "1".
   END.
END.

IF user_env[35] <> ? and user_env[35] <> "" THEN DO:
   FIND DICTDBG.oracle_tablespace where DICTDBG.oracle_tablespace.name = user_env[35]
                                    and DICTDBG.oracle_tablespace.online$ = 1
                                    NO-LOCK NO-ERROR.
   /* If available then check to see if userid is owner if not check for security */   
   IF AVAILABLE DICTDBG.oracle_tablespace THEN DO:
     
         /* here is where code checks to see if user can use tablespace */
      
   END.
   ELSE DO:
     IF not logfile_open THEN DO:
        output stream logfile to value(user_env[2] + ".log") 
               unbuffered no-map no-echo append. 
        assign l_closelog   = true
               logfile_open = true. 
      END.

      PUT STREAM logfile UNFORMATTED 
           " " skip 
           "-- ++ " skip
           "-- Tablespace " user_env[35] " could not be found." skip
           "-- Load of SQL not performed." SKIP
           "-- -- " skip(2).
      ASSIGN movedata = false.     
      RETURN "1".
   END.
END.                                             
/*********************************************************************
* Copyright (C) 2000,2007-2008 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

File:   prodict/ora/_usrload 

Describtion:
    user interface and defaults setup for loading data to an Oracle Database

Input:
  user_env[1] = "ALL" or comma-separated list of files
  user_env[9] = "f" = load data file contents
                
Output:
  user_env[1] = same as IN
  user_env[2] = physical file or directry name for some input
  user_env[4] = "y" or "n" - stop on first error (if class = "d","4" or "s")
              = error% (if class = "f")
  user_env[5] = comma separated list of "y" (yes) or "n" (no) which
                corresponds to file list in user_env[1], indicating for each,
                whether triggers should be disabled when the load is done.
                (only used for load data file contents, "f").
  user_env[10]= user specified code page

History:
    D. McMann   02/08/00 Copied from user/_usrload.p for the Oracle Bulk Load.  Needed to copy 
                         because Oracle can not handle an acceptable percent for errors.  
    D. McMann   04/13/00 Added support for long path names
    D. McMann   03/19/03 Added block for loading lobs.
    fernando    06/20/07 Support for large files
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE canned   AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE class    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE comma    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE i        AS INT64      NO-UNDO.
DEFINE VARIABLE j        AS INTEGER    NO-UNDO.
DEFINE VARIABLE err      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE io-file  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE io-frame AS CHARACTER  NO-UNDO.
DEFINE VARIABLE io-title AS CHARACTER  NO-UNDO.
DEFINE VARIABLE is-all   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-one   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-some  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-lob   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE stop_flg AS LOGICAL    NO-UNDO.
DEFINE VARIABLE msg-num  AS INTEGER    NO-UNDO INITIAL 0.
DEFINE VARIABLE noload   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE prefix   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE trash    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE dis_trig AS CHARACTER  NO-UNDO.
DEFINE VARIABLE codepage AS CHARACTER  NO-UNDO FORMAT "X(20)".
DEFINE VARIABLE lvar     AS CHAR EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#    AS INT            NO-UNDO.  
DEFINE VARIABLE cr       AS CHARACTER      NO-UNDO.
DEFINE VARIABLE loblist  AS CHARACTER      NO-UNDO.
DEFINE VARIABLE do-screen AS LOGICAL       NO-UNDO INIT FALSE.
DEFINE VARIABLE err-to-file AS LOGICAL     NO-UNDO INIT FALSE.
DEFINE VARIABLE err-to-screen AS LOGICAL   NO-UNDO INIT TRUE.
DEFINE VARIABLE base_lchar    AS LONGCHAR  NO-UNDO.
DEFINE VARIABLE cEntry        AS CHARACTER NO-UNDO.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
DEFINE VARIABLE warntxt  AS CHARACTER  NO-UNDO VIEW-AS EDITOR NO-BOX 
 INNER-CHARS 64 INNER-LINES 2.
&ENDIF
/* To support fill-in label mnemonic (Nordhougen 07/26/95) */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
DEFINE VARIABLE idir_lbl AS CHARACTER  NO-UNDO FORMAT "X(55)"
  INIT "&Input Directory (if different from current directory):". 
&ENDIF

{prodict/misc/filesbtn.i}

/* standard form */
FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "&Input File"
  btn_File SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-input
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
  &GLOBAL-DEFINE LINEUP 12
  &GLOBAL-DEFINE FILLCH 67
&ELSEIF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN
  &GLOBAL-DEFINE LINEUP 12
  &GLOBAL-DEFINE FILLCH 69
&ELSE
  &GLOBAL-DEFINE LINEUP 15
&ENDIF

cr = CHR(10).

FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 45 BY 1
         LABEL "&Input File"
  btn_File  SKIP ({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL " Display Errors to &Screen"
      AT 2 SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-d-file
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".


FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    idir_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
          SIZE {&FILLCH} BY 1 NO-LABEL SKIP({&VM_WIDG})
  &ELSE
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 50 BY 1
                LABEL "Input Directory" SKIP
    "(Leave blank for current directory)" VIEW-AS TEXT AT 19 SKIP ({&VM_WIDG})
  &ENDIF
  do-screen VIEW-AS TOGGLE-BOX LABEL "Output Errors to &Screen"
      AT 2 SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-d-dir
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ". 
  
/* For MSW, associate text widget with fill-in to enable mnemonic (Nordhougen 07/26/95) */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
ASSIGN
  user_env[2]:SIDE-LABEL-HANDLE IN FRAME read-d-dir = idir_lbl:HANDLE
  user_env[2]:LABEL IN FRAME read-d-dir = idir_lbl.
&ENDIF

FORM
  "Please enter a Code Page to use for this load." AT 2 SKIP
  codepage {&STDPH_FILL} LABEL "&Code Page" AT 2
  {prodict/user/userbtns.i}
  WITH FRAME get-cp SIDE-LABELS NO-ATTR-SPACE CENTERED
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Code Page ".

/*=============================Triggers===============================*/

DEFINE VAR msg AS CHAR NO-UNDO INITIAL
   "Can not find a file of this name.  Try again.".

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame read-input or CHOOSE of btn_Help in frame read-input
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Load_Stuff_Dlg_Box},
                             INPUT ?).

on HELP of frame read-d-file
   or CHOOSE of btn_Help in frame read-d-file
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Load_Data_Contents_Dlg_Box},
                             INPUT ?).
on HELP of frame read-d-dir
   or CHOOSE of btn_Help in frame read-d-dir
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Load_Data_Contents_Some_Dlg_Box},
                             INPUT ?).
                             
on HELP of frame get-cp or CHOOSE of btn_Help in frame get-cp
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT",
                             INPUT {&Code_Page_Dlg_Box},
                              INPUT ?).

&ENDIF

/*----- ON GO or OK -----*/

ON GO OF FRAME read-d-file
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-d-file) = ? 
  THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-d-file.
    RETURN NO-APPLY.
  END.
  ASSIGN user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-d-file.
  run verify-cp.
END.

ON GO OF FRAME read-d-dir
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-d-dir) = ? 
  THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-d-dir.
    RETURN NO-APPLY.
  END.
END.

ON GO OF FRAME read-input
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-input) = ? THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-input.
    RETURN NO-APPLY.
  END.
  ASSIGN user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-input.
  run verify-cp.
END.
/*----- ON WINDOW-CLOSE -----*/
on WINDOW-CLOSE of frame read-input
   apply "END-ERROR" to frame read-input.
on WINDOW-CLOSE of frame read-d-file
   apply "END-ERROR" to frame read-d-file.
on WINDOW-CLOSE of frame read-d-dir
   apply "END-ERROR" to frame read-d-dir.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[2] in frame read-input
   user_env[2]:screen-value in frame read-input = 
        TRIM(user_env[2]:screen-value in frame read-input).
ON LEAVE OF user_env[2] in frame read-d-file
   user_env[2]:screen-value in frame read-d-file = 
        TRIM(user_env[2]:screen-value in frame read-d-file).
ON LEAVE OF user_env[2] in frame read-d-dir
   user_env[2]:screen-value in frame read-d-dir = 
        TRIM(user_env[2]:screen-value in frame read-d-dir).

/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame read-input DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-input /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.

ON CHOOSE OF btn_File in frame read-d-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-d-file /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.

 
/*=======================Internal Procedures==========================*/

PROCEDURE verify-cp.
  /* Is there a defined codepage? Try to read it in the trailer, if
   * not, ask for it
   */
  ASSIGN codepage = "".
  RUN read-cp. /* read the code page in the file */
  IF codepage = "" OR codepage = ? OR codepage = "(no conversion)" THEN
  DO:
     MESSAGE "There is no Code Page defined in this input file." view-as
        ALERT-BOX ERROR BUTTONS OK.
     RUN get-cp. /* prompt for it */
  END.
  ELSE user_env[10] = codepage.
END PROCEDURE.

PROCEDURE read-cp.
  /* Read trailer of file and find codepage */
  /* (partially stolen from lodtrail.i)     */
  
  DEFINE VARIABLE tempi AS DECIMAL          NO-UNDO.
  DEFINE VARIABLE j     AS INTEGER          NO-UNDO.

  INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP.
  SEEK INPUT TO END.
  i = SEEK(INPUT) - 11.
  SEEK INPUT TO i. /* position to possible beginning of last line */

  /*   Now we need to deal with a large offset, which is a variable size
       value in the trailer, for large values.
       Now go back one character at a time until we find a new line or we have
       gone back too far.
       For the non-large offset format, the previous char will be a
       newline character, so we will  detect that right away and read the
       value as usual. Unless the file has CRLF (Windows), in which case
       we will go back 1 character to read the value properly - to
       account for the extra byte.
       For larger values, we will read as many digits as needed.
       The loop below could stop after 10 digits, but I am letting it go
       up to 50 to try to catch a bad value.
  */
  DO WHILE LASTKEY <> 13 AND j <= 50:
     ASSIGN j = j + 1
            i = i - 1.
     SEEK INPUT TO i.
     READKEY PAUSE 0.
  END.

  /* now we can start reading it */
  READKEY PAUSE 0.
  ASSIGN
    lvar# = 0
    lvar  = ""
    i     = 0.

  DO WHILE LASTKEY <> 13 AND i <> ?: /* get byte count (last line) */
     IF LASTKEY > 47 AND LASTKEY < 58 THEN DO:
          /* check if can fit the value into an int64 type. We need
             to manipulate it with a decimal so that we don't get fooled
             by a value that overflows. This is so that we catch a
             bad offset in the file.
           */
          ASSIGN tempi = i /* first move it to a decimal */
                 tempi = tempi * 10 + LASTKEY - 48. /* get new value */
          i = INT64(tempi) NO-ERROR. /* see if it fits into an int64 */
          
          /* check if the value overflows becoming negative or an error happened. 
             If so, something is wrong (too many digits or invalid values),
             so forget this.
          */
          IF  i < 0 OR
              ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
              ASSIGN i = 0.
              LEAVE. /* we are done with this */
          END.

     END.
     ELSE 
          ASSIGN i = ?. /* bad character */

     READKEY PAUSE 0.
  END.

  IF i > 0 then run get_psc. /* get it */
  ELSE RUN find_psc. /* look for it */
  INPUT CLOSE.
  DO i = 1 TO lvar#:
    IF lvar[i] BEGINS "cpstream=" OR lvar[i] BEGINS "codepage" THEN
       codepage = TRIM(SUBSTRING(lvar[i],10,-1,"character":U)).
  END.
END PROCEDURE.

PROCEDURE get-cp.
   /* Prompt for codepage */
   DO ON ERROR UNDO, RETRY ON ENDKEY UNDO, LEAVE WITH FRAME get-cp:
       ASSIGN codepage = SESSION:STREAM.
       UPDATE codepage btn_OK btn_Cancel {&HLP_BTN_NAME}.
       ASSIGN user_env[10] = codepage.
   END.
END PROCEDURE.

PROCEDURE get_psc:
  /* using the byte count, we scoot right down there and look for
   * the beginning of the trailer ("PSC"). If we don't find it, we
   * will go and look for it.
   */
   
  DEFINE VARIABLE rc AS LOGICAL INITIAL no.
  _psc:
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    SEEK INPUT TO i. /* skip to beginning of "PSC" in file */
    READKEY PAUSE 0. IF LASTKEY <> ASC("P") THEN LEAVE _psc. /* not there!*/
    READKEY PAUSE 0. IF LASTKEY <> ASC("S") THEN LEAVE _psc.
    READKEY PAUSE 0. IF LASTKEY <> ASC("C") THEN LEAVE _psc.
    ASSIGN rc = yes. /* found it! */
    RUN read_bits (INPUT i). /* read trailer bits */
  END.
  IF NOT rc THEN RUN find_psc. /* look for it */
END PROCEDURE.

PROCEDURE find_psc:
  /* If the bytecount at the end of the file is wrong, we will jump
   * back the maximum number of bytes in a trailer and start looking
   * from there. If we still don't find it then tough luck.
   * NOTE: Variable p holds the number of bytes to roll back. AS of
   * 7/21/94, the max size of a trailer (.d) is 204 bytes, if you add
   * anything to this trailer, you must change this number to reflect
   * the number of bytes you added. I'll use 256 to add a little padding. (gfs)
   */
  DEFINE VARIABLE p AS INT64 INITIAL 256. /* really 204, added extra just in case */
  DEFINE VARIABLE l AS INT64.             /* LAST char position */
  
  SEEK INPUT TO END.
  ASSIGN l = SEEK(INPUT). /* EOF */
  SEEK INPUT TO SEEK(INPUT) - MINIMUM(p,l). /* take p, or size of file */
  IF SEEK(INPUT) = ? THEN RETURN.
  _scan:
  REPEAT ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    READKEY PAUSE 0.
    p = SEEK(INPUT). /* save off where we are looking */
    IF LASTKEY = ASC("P") THEN DO:
       READKEY PAUSE 0.
       IF LASTKEY <> ASC("S") THEN NEXT.
       ELSE DO: /* found "PS" */
         READKEY PAUSE 0.
         IF LASTKEY <> ASC("C") THEN NEXT.
         ELSE DO: /* found "PSC"! */
           RUN read_bits (INPUT p - 1).
           LEAVE.
         END. /* IF "C" */
       END. /* IF "S" */    
    END. /* IF "P" */
    ELSE IF p >= l THEN LEAVE _scan. /* at EOF, so give up */
  END. /* repeat */
END.

PROCEDURE read_bits:
  /* reads trailer given a starting position 
   */ 
  DEFINE INPUT PARAMETER pi as INT64. /* "SEEK TO" location */
    
  SEEK INPUT TO pi.
  REPEAT:
    IMPORT lvar[lvar# + 1].
    lvar# = lvar# + 1.
  END.
END PROCEDURE. 

/*==========================Mainline code=============================*/
{adecomm/okrun.i
  &FRAME = "FRAME get-cp"
  &BOX   = "rect_Btns"
  &OK    = "btn_OK"
  {&CAN_BTN}
  {&HLP_BTN}
  }

ASSIGN
  class    = SUBSTRING(user_env[9],1,-1,"character")
  io-file  = TRUE
  io-frame = ""
  prefix   = ""
  loblist  = ?.  

IF user_env[1] NE "" THEN
  ASSIGN is-some  = (user_env[1] MATCHES "*,*").
ELSE DO:
  ASSIGN is-some  = (user_longchar MATCHES "*,*").
END.

ASSIGN   
  is-all   = (user_env[1] = "ALL")
  is-one   = NOT is-all AND NOT is-some.

IF dict_rog THEN msg-num = 3. /* look but don't touch */

/*--------------------------------------*/ /* LOAD DATA FILE CONTENTS */
DO FOR DICTDB._File:

  /* read-only status is relevant only for PROGRESS-db's */
  /* schemaholders can be in read-only mode and still    */
  /* allow data to be loaded!                            */
  IF dict_rog 
    AND msg-num = 3
    AND user_dbtype <> "PROGRESS"
    THEN ASSIGN msg-num = 0. 

  noload = "u".
  { prodict/dictgate.i &action=undumpload
    &dbtype=user_dbtype &dbrec=drec_db &output=noload
  }

  FIND DICTDB._File  WHERE DICTDB._FIle._File-name = "_File"
                       AND DICTDB._File._Owner = "PUB".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 4.
  RELEASE DICTDB._File.
  IF NOT is-all AND NOT is-some THEN
    FIND DICTDB._File WHERE _Db-recid = drec_db AND _File-name = user_env[1]
                        AND (_Owner = "PUB" OR _Owner = "_FOREIGN").

  IF is-one OR is-some THEN DO:
      /* if user_env[1] is "", then value is in user_longchar */
      IF user_env[1] NE "" THEN
          base_lchar = user_env[1].
      ELSE
          base_lchar = user_longchar.
  END.
  ELSE
      base_lchar = "".


  ASSIGN
    user_env[2] = prefix + (IF is-all OR is-some THEN "" ELSE
                  (IF DICTDB._File._Dump-name = ?
                  THEN DICTDB._File._File-name ELSE DICTDB._File._Dump-name)
                + ".d")
    user_env[4] = "0"
    io-file     = NOT is-all AND NOT is-some /* read from file/dir */
    io-frame    = "d"
    io-title    = "Load Data Contents for"
                + " " + (IF is-all THEN "All Tables" /*allfiles*/
                  ELSE  IF is-some THEN "Some Tables" /*somefiles*/
                  ELSE "Table ~"" + user_env[1] + "~"")
    user_env[1] = ""
    user_longchar = ""
    comma       = ""
    i           = 1.

  /* If user had selected ALL, fill base array with list of files.  
     Otherwise, it is already set to file list.
  */
  IF is-all THEN FOR EACH DICTDB._File
    WHERE DICTDB._File._File-number > 0
      AND DICTDB._File._Db-recid = drec_db
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
      AND NOT DICTDB._File._Hidden
      AND DICTDB._File._Tbl-Type <> "V"
      AND CAN-DO(DICTDB._File._Can-create,USERID(user_dbname))
      AND (noload = "" OR NOT CAN-DO(noload,DICTDB._File._For-type))
    BY DICTDB._File._File-name:
    base_lchar = base_lchar + (IF base_lchar = "" THEN "" ELSE ",") + DICTDB._File._File-name.
  END.

  /* Run through the file list and cull out the ones that the user
     is not allowed to dump for some reason.
  */
  ASSIGN user_env[5] = ""
         j = NUM-ENTRIES(base_lchar).

  DO i = 1 TO j:
    err = ?.
    dis_trig = "y".
    cEntry = ENTRY(i,base_lchar).
    FIND DICTDB._File
      WHERE _Db-recid = drec_db AND _File-name = cEntry
        AND (_Owner = "PUB" OR _Owner = "_FOREIGN").

    IF NOT CAN-DO(DICTDB._File._Can-create,USERID(user_dbname)) THEN
      err = DICTDB._File._File-name
        + " will not be loaded due to insufficient privileges.".
    ELSE
    IF noload <> "" AND CAN-DO(noload,DICTDB._File._For-type) THEN
      err = "".
        /*SUBSTITUTE("&1 is a &2 &3 and cannot be dumped.",
          DICTDB._File._File-name,user_dbtype,DICTDB._File._For-type).*/
    ELSE DO:
      {prodict/dump/ltrigchk.i &OK = answer}
      IF NOT answer THEN DO:
         MESSAGE "You do not have privileges to load table" DICTDB._File._File-name 
                 SKIP
                 "with triggers disabled.  Do you want to load this table" SKIP
                 "anyway even though the triggers will fire?"
                 VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL UPDATE answer.
         IF answer = no THEN
            err = "".  /* don't do this table but no more messages */
         ELSE IF answer = yes THEN DO:
            err = ?.   /* include this table in load */
            dis_trig = "n".
         END.
         ELSE DO:    /* cancel the load operation */
            user_path = "".
            RETURN.
         END.
      END.
    END.

    IF err = ? THEN DO:
      FIND FIRST DICTDB._Field OF DICTDB._File WHERE DICTDB._Field._Dtype > 17 NO-LOCK NO-ERROR.
      IF AVAILABLE DICTDB._Field THEN
        ASSIGN loblist = (IF loblist = ? THEN DICTDB._File._File-name ELSE loblist + "," + DICTDB._File._File-name). 
      ELSE
        ASSIGN
          user_longchar = user_longchar + comma + DICTDB._File._File-name
          user_env[5] = user_env[5] + comma + dis_trig
          comma       = ",".
    END.
    ELSE IF err <> "" THEN DO:
      MESSAGE err SKIP "Do you want to continue?"
         VIEW-AS ALERT-BOX ERROR BUTTONS YES-NO UPDATE answer.
      IF answer = FALSE THEN DO:
        user_path = "".
        RETURN.
      END.
    END.    
  END.
  IF NUM-ENTRIES(loblist) > 0 AND NUM-ENTRIES(loblist) < NUM-ENTRIES(base_lchar) THEN DO:
    ASSIGN answer = FALSE.
    MESSAGE "The Bulk Insert Utility can not be used when LOB fields" SKIP
             "are part of a table definition." SKIP(1)
              loblist "contain LOB fields and will not be loaded." SKIP
              "Do you want to load the remaining files?" SKIP(1)
               VIEW-AS ALERT-BOX ERROR BUTTONS YES-NO UPDATE answer.
    IF answer = FALSE THEN DO:
      user_path = "".
      RETURN.
    END.   
  END.
  ELSE IF NUM-ENTRIES(loblist) > 0 AND NUM-ENTRIES(loblist) = NUM-ENTRIES(base_lchar) THEN DO: 
    MESSAGE "The Bulk Insert Utility can not be used to load " SKIP
             loblist "because LOB fields are present." SKIP
             "Use the Data Admin/Data Dictionary data load. " SKIP(1)
         VIEW-AS ALERT-BOX ERROR.
       ASSIGN user_path = "".
       RETURN.
  END.

  /* subsequent removal of files changed from many to one, so reset ui stuff */
  IF (is-some OR is-all) AND NUM-ENTRIES(base_lchar) = 1 THEN DO:

    ASSIGN user_env[1] = user_longchar
           user_longchar = "".
    FIND DICTDB._File
      WHERE DICTDB._File._Db-recid = drec_db
        AND DICTDB._File._File-name = user_env[1]
        AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
    ASSIGN
      is-some     = FALSE
      is-all      = FALSE
      is-one      = TRUE
      user_env[2] = prefix + (IF DICTDB._File._Dump-name = ?
                    THEN DICTDB._File._File-name ELSE DICTDB._File._Dump-name)
                  + ".d"
      io-file     = TRUE
      io-title    = "Load Data Contents for Table ~"" + user_env[1] + "~""
      base_lchar  = user_env[1].
  END.

END.
IF io-frame = "d" THEN DO:
 IF NOT io-file THEN DO:
    {adecomm/okrun.i  
     &FRAME  = "FRAME read-d-dir" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
    }

    DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-d-dir:
      ENABLE user_env[2]  
             do-screen btn_OK btn_Cancel.     

      UPDATE user_env[2]              
             do-screen 
             btn_OK 
             btn_Cancel
            {&HLP_BTN_NAME}.
            user_env[6] = (IF do-screen THEN "s" ELSE "f").

      RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).
      DISPLAY user_env[2].     

      { prodict/dictnext.i trash }
      canned = FALSE.
    END.
  END.
  
  ELSE DO:
    {adecomm/okrun.i  
     &FRAME  = "FRAME read-d-file" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
    }

    DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-d-file:
      ENABLE user_env[2] btn_File 
             do-screen btn_OK btn_Cancel.

     UPDATE user_env[2] btn_File            
            do-screen btn_OK btn_Cancel  {&HLP_BTN_NAME}.

      DISPLAY user_env[2].
     
      user_env[6] = (IF do-screen THEN "s" ELSE "f").

      { prodict/dictnext.i trash }
      canned = FALSE.
    END.
  END.
END.

ELSE DO:
 {adecomm/okrun.i  
   &FRAME  = "FRAME read-input" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
  }

  DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-input:

    UPDATE user_env[2] btn_File btn_OK btn_Cancel {&HLP_BTN_NAME}.

    { prodict/dictnext.i trash }
    canned = FALSE.
  END.
END.

HIDE FRAME read-input NO-PAUSE.
HIDE FRAME read-d-file NO-PAUSE.
HIDE FRAME read-d-dir NO-PAUSE.
IF canned THEN
  user_path = "".
RETURN.

/*====================================================================*/


/*********************************************************************
* Copyright (C) 2000,2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
Created 02/02/00
        Donna McMann copied from prodict/misc/runload.i so that
        Oracle can do bulk inserts during load.  If any changes
        are made in prodict/misc/runload.i they should also be
        evaluated for this procedure.
  
   {1} - Name of the table to load
   {2} - tolerable load rate (%).  
   {3} - set size, status will be displayed after each set
   {4} - either table name or specific field names to load.
   {5} - expected # load records.  If {2} is either 0 or 100%, then
      	 this is ignored.
         
   History
   fernando    06/20/07  Support for large files      
   kmayur      06/21/11  increased extent of user_env - OE00195067
*/
   
/* Will be "y" or "n" to indicate whether to disable triggers or not */
DEFINE INPUT PARAMETER p_Disable AS CHARACTER NO-UNDO.

DEFINE SHARED STREAM   loaderr.
DEFINE SHARED VARIABLE errs    AS INTEGER NO-UNDO.
DEFINE SHARED VARIABLE recs    AS INT64. /*UNDO*/
DEFINE SHARED VARIABLE xpos    AS INTEGER NO-UNDO.
DEFINE SHARED VARIABLE ypos    AS INTEGER NO-UNDO.

DEFINE        VARIABLE errbyte AS INT64   NO-UNDO.
DEFINE        VARIABLE errline AS INTEGER NO-UNDO.
DEFINE        VARIABLE nxtstop AS INT64   NO-UNDO.
DEFINE        VARIABLE err%    AS INTEGER NO-UNDO.
DEFINE        VARIABLE ans999  AS LOGICAL NO-UNDO.
DEFINE        VARIABLE stopped AS LOGICAL NO-UNDO INIT FALSE.
DEFINE        VARIABLE j       AS INTEGER NO-UNDO.
DEFINE        VARIABLE h1      AS INTEGER NO-UNDO.
DEFINE        VARIABLE h2      AS INTEGER NO-UNDO.
DEFINE        VARIABLE gave-err AS LOGICAL NO-UNDO INITIAL FALSE.

DEFINE SHARED VARIABLE user_env    AS CHARACTER NO-UNDO EXTENT 41.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  IF TERMINAL <> "" THEN DO:
    DEFINE STREAM run_load.
    OUTPUT STREAM run_load TO TERMINAL.
  END.
&ENDIF

ASSIGN
  recs = 0
  errs = 0
  err% = {2}.

IF p_Disable  = "y" THEN
  DISABLE TRIGGERS FOR LOAD OF DICTDB2.{1}.

/* Go through all load records.  When IMPORT hits the end of file or 
   ".", ENDKEY will be generated which will kick us out of this "top"
   loop.
*/
top:
DO WHILE TRUE TRANSACTION:
  /* Issue the start command to the DataServer */
  RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE ("--Bulk-insert Start").
  CLOSE STORED-PROC DICTDBG.send-sql-statement h2 = PROC-STATUS WHERE PROC-HANDLE = h1. 
  ASSIGN nxtstop = recs + {3}.

  /* Go through set of {3} at a time */
  bottom:
  REPEAT FOR DICTDB2.{1}
    WHILE recs < nxtstop ON ENDKEY UNDO,LEAVE BOTTOM:
    IF RETRY THEN DO:
      ASSIGN gave-err = TRUE
             errs = errs + 1.
      IF ERROR-STATUS:NUM-MESSAGES > 0 THEN
      DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
          PUT STREAM loaderr UNFORMATTED
            ">> ERROR READING LINE #" errline 
            " (Offset=" errbyte  "): " ERROR-STATUS:GET-MESSAGE(j) SKIP.
      END.
      ELSE IF p_Disable = "n" THEN
      DO:
         PUT STREAM loaderr UNFORMATTED
	    ">> ERROR READING LINE #" errline
	    " (Offset=" errbyte  "): Unknown error caused by database"
	    " trigger." SKIP.
      END.
      IF (err% = 0) OR
         (err% <> 100 AND errs > ({5} * {2}) / 100) THEN DO:
      	 PUT STREAM loaderr UNFORMATTED
      	    "** Tolerable load error rate is: {2}%." SKIP
      	    "** Loading table {1} is stopped after " errs " error(s)." SKIP.        
         /* DataServer Needs to know that this processing is being aborted */
         RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE ("--Bulk-insert Abort").
         CLOSE STORED-PROC DICTDBG.send-sql-statement h2 = PROC-STATUS WHERE PROC-HANDLE = h1.                	 
         UNDO TOP, LEAVE TOP.
      END.
      NEXT.
    END.

    CREATE {1}.
    ASSIGN
      errbyte = SEEK(INPUT)
      errline = errline + 1
      recs    = recs + 1.

    IMPORT {4} NO-ERROR.

    IF ERROR-STATUS:ERROR THEN DO:
      IF TERMINAL <> "" AND user_env[6] = "s" THEN DO:
         ASSIGN gave-err = TRUE.
         DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
       	    ans999 = yes.
            MESSAGE ERROR-STATUS:GET-MESSAGE(j) SKIP(1)
      	         "Press OK to continue or Cancel to stop processing."
      	       VIEW-AS ALERT-BOX ERROR BUTTONS OK-CANCEL UPDATE ans999.
            IF NOT ans999 THEN DO:
      	      ASSIGN stopped = TRUE.
              /* User wants to stop so DataServer must be notified of abort */
              RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE ("--Bulk-insert Abort").
              CLOSE STORED-PROC DICTDBG.send-sql-statement h2 = PROC-STATUS WHERE PROC-HANDLE = h1.               
              UNDO top, LEAVE top.
            END.
      	 END.
      END.
      UNDO bottom, RETRY bottom.
    END.   /* ERROR raised */

    VALIDATE {1} NO-ERROR. 

    IF ERROR-STATUS:ERROR THEN DO:
      IF TERMINAL <> "" AND user_env[6] = "s" THEN DO:
         ASSIGN gave-err = TRUE.
         DO j = 1 TO  ERROR-STATUS:NUM-MESSAGES:
       	    ans999 = yes.
            MESSAGE ERROR-STATUS:GET-MESSAGE(j) SKIP(1)
      	         "Press OK to continue or Cancel to stop processing."
      	       VIEW-AS ALERT-BOX ERROR BUTTONS OK-CANCEL UPDATE ans999.
            IF NOT ans999 THEN DO:
      	      ASSIGN stopped = TRUE.
              /* User wants to stop so DataServer must be notified of abort */
              RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE ("--Bulk-insert Abort").
              CLOSE STORED-PROC DICTDBG.send-sql-statement h2 = PROC-STATUS WHERE PROC-HANDLE = h1.               
              MESSAGE "validate error" h2 VIEW-AS ALERT-BOX.
              UNDO top, LEAVE top.
            END.
      	 END.
      END.
      UNDO bottom, RETRY bottom.
    END.   /* ERROR raised */
  END. /* end bottom repeat */
  /* Before transaction is ended, DataServer needs send any leftover records in 
     buffer so Commit will get all records.
  */   
  RUN STORED-PROC DICTDBG.send-sql-statement h1 = PROC-HANDLE ("--Bulk-insert End").
  CLOSE STORED-PROC DICTDBG.send-sql-statement h2 = PROC-STATUS WHERE PROC-HANDLE = h1. 
  /* If an error occurred on final end, make sure the DataServer gets a
     rollback by undoing top and user is notified that a problem occurred
     and all records were rolled back.
  */
  IF h2 <> 0 THEN DO.
     IF NOT gave-err THEN
     MESSAGE "An error was received during the bulk insert for {1}," SKIP
             "all records are being backed out." SKIP
          VIEW-AS ALERT-BOX ERROR.
     ASSIGN gave-err = TRUE.
     UNDO top, LEAVE top. 
  END.
  ELSE 
      LEAVE TOP.
END. /* top */

IF stopped THEN 
    RETURN "stopped".
ELSE 
    RETURN.








/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _snd_sql.p - SEND.SQL to Sybase to create Sybase objects. */

/*++
 
Author:     Rob Adams

Component:  Protoxxx   (progress to foreign datamanager)

Purpose:    Read in SQL from a file created by _wrktgen.p
            and use SEND-SQL-STATEMENT stored procedure
            to perform each command inside foreign data manager. 

            NOTE: The output of this file can be adjusted 
                 by using the local environment variables 
                 and the dataserver dependent section at 
                 begining of the code.  

History:    
    21 Sep 1995 Hutegger replaced &DEBUG preprocessor variable with
                        parameter p_debug
     6 Jan 1995 DHM     This becomes a wrapper to include gate/_snd_sql.i
                        to allow for datatype specific r-code
     6 Sep 1994  RLA    Add Oracle drop logic. 
                        Add batch mode output functions
                        Add switching from chained to unchained mode.
                        Add object failure notification. 
     6 Jul 1994  RLA    add some output to let user know we're working
     7 Jun 1994  davidn Added informix specific dependencies.

                         Added comit1_per_stmt  to the local
                        environment.  With the idea that some
                        dataserver do not like to have a comit
                        after every statement.(like informix) 
                        
                        NOTE: The clear_buffers flage is part 
                        of a work around for a bug in running 
                        stored procs.  If there is no output to 
                        retrieve from the dataserver after the 
                        sql statement has been sent, some data
                        servers send back an error message that 
                        progress does not yet no how to handle.
                        Udi is currently working on this, and it
                        should be fixed soon. When the fix goes in,
                        we should be able to get rid of the clear_
                        buffers flag
                        -----davidn 7 Jun 1994 
     2 Jun 1994  RLA    Make generic for all datamanagers. 
    19 May 1994  RLA    Creation.

--*/


{ prodict/gate/_snd_sql.i }
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* ora_ctl.i - Oracle schema control settings */
/*
Note 'NULLZERO':
  There is a problem in Oracle where it treats zero-length character
  fields as NULL values.  To work around this, there is a variable
  called 'nullzero'.  Set this to TRUE if the problem exists, and
  FALSE if "" <> ?.  (Currently set to TRUE for ORACLE 5.1.)

Note 'DATETIME':
  Oracle has a datatype called DATE which is a combination of
  Progress DATE and TIME (INTEGER) fields.  When we extract it, we
  can treat it either as a Progress DATE, a Progress INTEGER, or a
  set of two Progress fields which the gateway merges into one Oracle
  DATE.  The 'datetime' variable is set on the fly when the
  verification code detects this situation.  'TRUE' means
  date/integer fields for the date exist, 'FALSE' means one or the
  other exists, and '?' means the field is not an Oracle DATE field
  or is missing.

Note 'CANDORAW':
  Currently, Progress partially supports RAW and LONG_RAW Oracle
  datatypes.  This is because they can have embedded NULLs (0x00), and
  the Progress language assumes null-terminated strings.  If 'candoraw'
  (can-do-raw) is set to TRUE, this program will treat RAW and LONG_RAW
  datatypes as Progress CHARACTER datatypes.

Note 'TALLOWED':
  This is a list of object types that the gateway supports.  Currently,
  VIEW and TABLE are allowed.  The complete list is:
  "NEXT OBJECT,INDEX,TABLE,CLUSTER,VIEW,SYNONYM,SEQUENCE,UNDEFINED".

Note 'OOBJECTS':
  This contains a list of Oracle objects.  Oracle's obj#.type + 1 can
  be used as an index to this table.
*/

DEFINE VARIABLE nullzero AS LOGICAL   NO-UNDO.
DEFINE VARIABLE datetime AS LOGICAL   NO-UNDO.
DEFINE VARIABLE candoraw AS LOGICAL   NO-UNDO.
DEFINE VARIABLE tallowed AS CHARACTER NO-UNDO.
DEFINE VARIABLE oobjects AS CHARACTER NO-UNDO.

/*
IF "{1}" = "5" THEN ASSIGN
  candoraw = TRUE
  nullzero = TRUE
  oobjects = ? /* not applicable to O/V5 */
  tallowed = "TABLE,VIEW".
*/

IF "{1}" = "6" THEN ASSIGN
  candoraw = TRUE
  nullzero = TRUE /* this may be okay as false */
  oobjects = "NEXT OBJECT,INDEX,TABLE,CLUSTER,VIEW,SYNONYM,SEQUENCE,"
           + "UNDEFINED"
  tallowed = "TABLE,VIEW,SEQUENCE".


ELSE IF "{1}" = "7" THEN ASSIGN
  candoraw = TRUE
  nullzero = TRUE /* this may be okay as false */
  oobjects = "NEXT OBJECT,INDEX,TABLE,CLUSTER,VIEW,SYNONYM,SEQUENCE,"
           + "PROCEDURE,FUNCTION,PACKAGE,PKG BODY,UNDEFINED,TRIGGER,"
           + "UNDEFINED,UNDEFINED,UNDEFINED,UNDEFINED,UNDEFINED,BUFFER"
  tallowed = "TABLE,VIEW,SYNONYM,SEQUENCE,PROCEDURE,FUNCTION,PACKAGE,"
           + "BUFFER".


ELSE IF "{1}" = "8" THEN ASSIGN
  candoraw = TRUE
  nullzero = TRUE /* this may be okay as false */
  oobjects = "NEXT OBJECT,INDEX,TABLE,CLUSTER,VIEW,SYNONYM,SEQUENCE,"
           + "PROCEDURE,FUNCTION,PACKAGE,PKG BODY,UNDEFINED,TRIGGER,"
           + "UNDEFINED,UNDEFINED,UNDEFINED,UNDEFINED,UNDEFINED,BUFFER"
  tallowed = "TABLE,VIEW,SYNONYM,SEQUENCE,PROCEDURE,FUNCTION,PACKAGE,"
           + "BUFFER".
/*
 *  oobjects = "NEXT OBJECT,INDEX,TABLE,CLUSTER,VIEW,SYNONYM,SEQUENCE,"
 *           + "PROCEDURE,FUNCTION,PACKAGE,PKG BODY,UNDEFINED,TRIGGER" 
 *  tallowed = "TABLE,VIEW,SEQUENCE". 
 */



/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* ora_get.i -

This gets from the user a table-name, table-type and table-owner into
user_env[1..3], respectively.  user_env[4] is the Progress file-name
for that Oracle table, or a good guess if there is no corresponding
progress file.  If more than one file is selected, then user_env[1..4]
becomes a set of comma-separated items, containing lists of their
respective names and types.

OUTPUT:
    user_env[1..4] == "" if end-error hit.

INPUT:
    user_env[25]    "{AUTO},<owner>,<type>,<name>,<qualifier>"
                        for autmatically select all or bringing up the 
                            selection-dialog-box, Initial-values for
                            pre-selection-criterias                           
                    

Text Parameters:
    <none>
    
Included in:
    prodict/ora/_ora6get.p
    prodict/ora/_ora7get.p
    
    
History:
    94/08/03    hutegger    extracted to include-file and inserted 
                            preselection-criteria - support
    94/06/03    hutegger    added user_env[25] as "AUTO"-switch
    04/19/06    fernando    Oracle 10g - skip BIN$* tables
*/

&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/ora/ora_ctl.i 8 }
&UNDEFINE DATASERVER


DEFINE VARIABLE c               AS CHARACTER NO-UNDO.
DEFINE VARIABLE edbtyp          AS CHARACTER NO-UNDO INITIAL "ORACLE".
DEFINE VARIABLE hint            AS CHARACTER NO-UNDO INITIAL "".
DEFINE VARIABLE i               AS INTEGER   NO-UNDO.
DEFINE VARIABLE inc_qual        AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE VARIABLE j               AS INTEGER   NO-UNDO.
DEFINE VARIABLE l               AS LOGICAL   NO-UNDO.
DEFINE VARIABLE lim             AS INTEGER   NO-UNDO INITIAL 0.
define variable l_rep-presel    as logical   no-undo initial TRUE.
DEFINE VARIABLE xld             AS INTEGER   NO-UNDO INITIAL 0.
DEFINE VARIABLE rpos1           AS CHARACTER NO-UNDO.
DEFINE VARIABLE rpos2           AS CHARACTER NO-UNDO.
DEFINE VARIABLE rpos3           AS CHARACTER NO-UNDO.
DEFINE VARIABLE redraw          AS LOGICAL   NO-UNDO INITIAL TRUE.
DEFINE VARIABLE canned          AS LOGICAL   NO-UNDO.

&IF "{&WINDOW-SYSTEM}" = "TTY"
 &THEN
  DEFINE VARIABLE lab-qual AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pat-name AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pat-qual AS CHARACTER NO-UNDO.
  DEFINE VARIABLE pat-user AS CHARACTER NO-UNDO.
 &ENDIF

/*
{prodict/gate/gatework.i 
  &new        = "NEW"
  &selvartype = "VARIABLE l"
  &options    = "INITIAL ""*"" "
  } /* Defines WORKFILE: gate-work */
*/

DEFINE BUFFER gate-buff FOR gate-work.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 6 NO-UNDO INITIAL [
  /* 1*/ "You have not selected an ORACLE database.",
  /*Select tables with [RETURN].  Press [F1] to begin work, or [F4] to abort.*/
  /* 2*/ "Press",             /* [F1] */
  /* 3*/ "to begin work, or", /* [F4] */
  /* 4*/ "to abort",          /*.*/
  /*Use [F5] to select a group, or [F6] to unselect a group.*/
  /* 5*/ "to select a group, or", /* [F6] */
  /* 6*/ "to unselect a group"    /*.*/
].


FORM 
  SKIP(1)
  "  Please wait while information is gathered from the ORACLE schema  "
  SKIP(1)
  SPACE(10) hint LABEL "(Searching" FORMAT "x(32)" ")" 
  SKIP(1)
  WITH FRAME gate_wait ROW 6 CENTERED SIDE-LABELS NO-ATTR-SPACE.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
FORM
  "Below is a list of objects from the Oracle database.  Select tables"  SKIP
  "with" /*[RETURN].  Press [F1] to begin work, or [F4] to abort.*/
    hint FORMAT "x(63)"                                                  SKIP
  "Use"  /*[F5] to select a group, or [F6] to unselect a group.*/
    c    FORMAT "x(64)"
  "Each table you choose will be checked against its PROGRESS image."    SKIP
  "If the PROGRESS image of the Oracle table definition is new, missing" SKIP
  "or invalid, this program will automatically update it."               SKIP
  WITH FRAME gate_not OVERLAY WIDTH 80 ROW 3 COLUMN 1 NO-LABELS NO-ATTR-SPACE.

/* in gate/ttygget.i the forms gate_match and gate_tbl contain code  */
/* that accesses the qualifier-fields. Therefore we have to          */
/* include them here in the form-definitions, but without label and  */
/* as small as possible (format "x")                                 */
FORM SKIP(1)
  "Enter MATCHES pattern (use * and . for wildcard pattern)"          SKIP
  "For table names to" l FORMAT "mark/unmark" NO-LABEL NO-ATTR-SPACE  SKIP(1)
    pat-name             FORMAT "x(30)"          LABEL "Object Name"  SKIP
    pat-user             FORMAT "x(30)"          LABEL "Owner Name " 
    lab-qual             FORMAT "x"           NO-LABEL  
    pat-qual             FORMAT "x"           NO-LABEL                SKIP(1)
 WITH FRAME gate_match
  OVERLAY ROW 8 CENTERED SIDE-LABELS ATTR-SPACE.

FORM
  gate-flag FORMAT "*/" NO-LABEL
  gate-name FORMAT "x(30)" LABEL "Object Name"
  gate-user FORMAT "x(26)" LABEL "Object Owner"
  gate-type FORMAT "x(10)" LABEL "Object Type"                 
  gate-qual FORMAT "x"  NO-LABEL                   
 WITH FRAME gate_tbl
  OVERLAY ROW 10 COLUMN 1 ATTR-SPACE
  WIDTH 80 MINIMUM(lim,SCREEN-LINES - 14) DOWN SCROLL 1.

&ENDIF

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

IF user_dbtype <> "ORACLE" THEN DO:
  MESSAGE new_lang[1] /* not oracle */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.


/*----------------------------------------------------------------------*/
/*                          pull in schema-info                         */
/*----------------------------------------------------------------------*/

assign
  l_rep-presel = TRUE.
  
presel:
repeat while l_rep-presel:   /* end for this repeat is in nogatwrk.i */

{prodict/gate/presel.i
  &frame  = "frm_nto"
  &link   = """ """
  &master = """ """
  }

PAUSE 0.
VIEW FRAME gate_wait.

SESSION:IMMEDIATE-DISPLAY = yes.
RUN adecomm/_setcurs.p ("WAIT").

FOR EACH DICTDBG.oracle_users
  WHERE DICTDBG.oracle_users.name MATCHES s_owner
  NO-LOCK
  BY DICTDBG.oracle_users.name:
    
  FOR EACH DICTDBG.oracle_objects
    WHERE DICTDBG.oracle_users.user# = DICTDBG.oracle_objects.owner# 
    AND   CAN-DO(tallowed,ENTRY(DICTDBG.oracle_objects.type + 1,oobjects))
    NO-LOCK
    BY DICTDBG.oracle_objects.name: 

    /* since there are no esc-characters possible in Oracle V6, we */
    /* can't use the wildcards. As soon as we drop V6-support, we  */
    /* can move this lines up into the where-clause                */
    IF  NOT ENTRY(DICTDBG.oracle_objects.type + 1,oobjects) MATCHES s_type
     OR NOT       DICTDBG.oracle_objects.name               MATCHES s_name
     THEN NEXT.
     
    FIND _File
      WHERE _File._Db-recid  = drec_db
      AND   _File._For-Name  = DICTDBG.oracle_objects.name
      AND   _File._For-Owner = DICTDBG.oracle_users.name
      NO-ERROR.

  /* Skip sequence generators created for compatible oracle tables */
  
    IF DICTDBG.oracle_objects.name MATCHES "*_SEQ" THEN
      NEXT.

  /* to prevent schemaholder-tables from beeing updated        */
  /*                                          <hutegger> 94/06 */
    IF available _File
      AND _file._file-name begins "oracle_" THEN NEXT.
      
    /* in Oracle 10g, there is a feature called flashback table which 
       saves deleted tables, by renaming them to BIN$<some-string>.
       We can skip these too.
    */
    IF DICTDBG.oracle_objects.NAME BEGINS "BIN$" THEN
       NEXT.

    DISPLAY DICTDBG.oracle_objects.name @ hint WITH FRAME gate_wait.
  /* exclude existing progress defs? */
  /*IF user_env[6] MATCHES "*x*" AND AVAILABLE _File THEN NEXT.*/
    CREATE gate-work.
    ASSIGN
      lim = lim + 1
      gate-work.gate-user = DICTDBG.oracle_users.name
      gate-work.gate-prog = (IF AVAILABLE _File
                              THEN _File._File-name ELSE ?).
    IF   DICTDBG.oracle_objects.type   =    4
     AND DICTDBG.oracle_objects.name BEGINS "BUFFER_"
     THEN ASSIGN
       gate-work.gate-name = SUBSTR(DICTDBG.oracle_objects.name
                                   ,8
                                   ,-1
                                   ,"character"
                                   )
       gate-work.gate-type = ENTRY(19,oobjects).
     ELSE ASSIGN
       gate-work.gate-name = DICTDBG.oracle_objects.name
       gate-work.gate-type = ENTRY(DICTDBG.oracle_objects.type + 1, oobjects).

  END. /* FOR EACH DICTDBG.oracle_users */
END. /* FOR EACH DICTDBG.oracle_objects */


{prodict/gate/ttygget.i
  &autocond = " where gate-work.gate-user <>  ""SYS"" "
  &block    = "presel"
  &db-type  = " ""ORACLE"" "
  &end      = "end."
  &gq       = " "
  } /* message and leave */


/*----------------------------------------------------------------------*/







/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/ora_lkdf.i

Description:
    defines the link - temp-table 
    
Text-Parameters:  
    &new    "new" or "" for the shared temp-table

    
History:
    hutegger    94/09/11    creation
    
--------------------------------------------------------------------*/
/*h-*/

define {&new} shared temp-table s_ttb_link
            field name       as   character format "x(32)"
            field level      as   integer   format "z9"
            field slctd      as   logical   format "*/ "
            field srchd      as   logical   format "done/open"
            field master     as   character format "x(42)"
            field presel-n   as   character format "x(30)" initial "*"
            field presel-o   as   character format "x(30)" initial "*"
            field presel-q   as   character format "x(30)" initial "*"
            field presel-t   as   character format "x(30)" initial "*"
            field presel-v   as   logical              /*  initial no */
            index us                           srchd level master
            index uit        is unique         master name slctd
            index upi        is unique primary level master name.

define {&new} shared variable s_ldbconct    as character.
define {&new} shared variable s_level       as integer.
define {&new} shared variable s_ldbname     as character.
define {&new} shared variable s_lnkname     as character.
define {&new} shared variable s_master      as character.
define {&new} shared variable s_name-hlp    as character.
define {&new} shared variable s_owner-hlp   as character.
define {&new} shared variable s_qual-hlp    as character.
define {&new} shared variable s_type-hlp    as character.
define {&new} shared variable s_vrfy-hlp    as logical.
define {&new} shared variable s_trig-reass  as logical.

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/ora_mak.i

Description:
    creates the _field-definitions out of the ORACLE-definitions
    
Text-Parameters:
    &data-type      Foreign data-type in PROGRESS-Notation
                    usually DICTDBG.{&file-name}_columns.type#, except
                    when it's "TIME" to support the date/time structure
    &extent         in the range of 0 to n
    &order-offset   gets added to the _field._order
    
Included in:            
    prodict/ora/_ora_mak.p

    
History:
    hutegger    94/07/15    reworked from previous version
    
--------------------------------------------------------------------*/

/* this code gets executed only for the first element of array-field   */
/* so extent-code of field is always ##1 (even with real extent >= 10) */
ASSIGN
  pnam = ( IF {&extent} > 0                      /* Drop the "##1" */
             AND LENGTH (DICTDBG.oracle_columns.name,"character") > 4
             THEN SUBSTRING (DICTDBG.oracle_columns.name, 1, 
               LENGTH (DICTDBG.oracle_columns.name,"character") - 3,
               "character")
             ELSE DICTDBG.oracle_columns.name )
  fnam = pnam.

RUN "prodict/gate/_gat_nam.p" 
    ( INPUT        RECID(DICTDB._File),
      INPUT-OUTPUT pnam).

if not session:batch-mode then 
   DISPLAY DICTDBG.oracle_columns.name @ msg[3] pnam @ msg[4]
      WITH FRAME ora_make.

FIND FIRST w_field
  WHERE w_field.ora_name = fnam
  AND   w_field.ora_type = {&data-type} NO-ERROR. /* needed for date-time - fields */
IF NOT AVAILABLE w_field
  THEN FIND FIRST w_field
  WHERE w_field.ora_name = fnam
  NO-ERROR.

FIND FIRST DICTDBG.oracle_comment
  WHERE DICTDBG.oracle_comment.obj# = DICTDBG.oracle_columns.obj#
    AND DICTDBG.oracle_comment.col# = DICTDBG.oracle_columns.col#
  NO-LOCK NO-ERROR.

ASSIGN
  dtyp    = LOOKUP({&data-type},user_env[12])
  l_init  = ?
  ntyp    = ENTRY(dtyp,user_env[15])
  num_dec = 0
  vfmt    = ?.

CREATE DICTDB._Field.

ASSIGN
  DICTDB._Field._Desc         = ( IF AVAILABLE w_field
                                    THEN w_field.pro_desc
                                  ELSE IF NOT AVAILABLE DICTDBG.oracle_comment
                                    OR DICTDBG.oracle_comment.comment$ = ?
                                    THEN ""
                                    ELSE DICTDBG.oracle_comment.comment$
                                 )
  DICTDB._Field._Extent       = {&extent}
  DICTDB._Field._Field-Name   = ( IF AVAILABLE w_field
                                    THEN w_field.pro_name
                                    ELSE pnam )
  DICTDB._Field._File-recid   = RECID(DICTDB._File)
  DICTDB._Field._Fld-stoff    = DICTDBG.oracle_columns.col#
  DICTDB._Field._For-Name     = fnam
  DICTDB._Field._For-Type     = {&data-type} 
  DICTDB._Field._Initial      = DICTDBG.oracle_columns.default$
  DICTDB._Field._Mandatory    = (DICTDBG.oracle_columns.null$ <> 0)
  DICTDB._Field._Order        = DICTDBG.oracle_columns.col# * 10 + 1000
                              + {&order-offset}.

{ prodict/ora/ora_mak1.i
  &data-type = "{&data-type}"
  &file-name = "oracle_columns"
  &undo      = "NEXT"
  }

/*----------------------------------------------------------------------*/    
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* ora_mak1.i 

Description:
    
    generates the format, initial-values and data-type-multiplicator
    depending on the old progress-data-type, the new oracle-data-type
    and the settings in _ora_typ.p 
    After that the new _field-record gets created and all the values
    assigned
    
Text-Parameters:
    &data-type  foreign data-type
    &file-name  "oracle_columns" or "oracle_arguments"

Included in:
    prodict/ora/ora_mak.i
    prodict/ora/_ora_fun.p
    
History:
    94/08/03    hutegger    creation
    
*/

CASE {&data-type}:

   WHEN    "CHAR" 
   OR WHEN "VARCHAR"
   OR WHEN "VARCHAR2"
   OR WHEN "ROWID"
     THEN DO:
       IF AVAILABLE w_field
         AND w_field.pro_dtype = "character"
         THEN ASSIGN   /* retain old format */
           l_init  = w_field.pro_initial
           num_dec = DICTDBG.{&file-name}.length_
           vfmt    = w_field.pro_Format.
         ELSE ASSIGN   /* new  format */
           num_dec = DICTDBG.{&file-name}.length_
           vfmt    = (IF ENTRY(dtyp,user_env[17],"|") <> "c"
                       THEN ENTRY(dtyp,user_env[17],"|")
                       ELSE "x(" + STRING(DICTDBG.{&file-name}.length_) + ")" ).
       END.

   WHEN    "LONG"
   OR WHEN "RAW"
   OR WHEN "LONGRAW"
     THEN DO:
       IF AVAILABLE w_field
         AND w_field.pro_dtype = "character"
         THEN ASSIGN   /* retain old format */
           l_init = w_field.pro_initial
           vfmt   = w_field.pro_Format.
         ELSE ASSIGN   /* new  format */
           vfmt   = (IF ENTRY(dtyp,user_env[17],"|") <> "c"
                       THEN ENTRY(dtyp,user_env[17],"|")
                       ELSE "x(" + (IF DICTDBG.{&file-name}.length_ = 0
                                      THEN "8"
                                      ELSE STRING(DICTDBG.{&file-name}.length_)) + ")" ).
       END.

   WHEN "NUMBER" 
     THEN DO:
       ASSIGN num_dec = 0.
       IF AVAILABLE w_field
         AND CAN-DO("decimal,integer,logical",w_field.pro_dtype)
         THEN ASSIGN   /* retain old data-type and old format */
           l_init  = w_field.pro_initial
           ntyp    = w_field.pro_dtype
           num_dec = w_field.pro_Decimals
           vfmt    = w_field.pro_Format.
         ELSE IF ENTRY(dtyp,user_env[17],"|") <> "#"
           THEN ASSIGN /* new data-type and format from _ora_typ.p */
             vfmt  = ENTRY(dtyp,user_env[17],"|")
             num_dec = ( IF INDEX(vfmt,".") = 0
                           THEN 0
                           ELSE LENGTH(vfmt,"character") - INDEX(vfmt,".")
                       ).
         ELSE IF DICTDBG.{&file-name}.scale      = ?
           OR    DICTDBG.{&file-name}.precision_ = ?
           THEN ASSIGN /* new data-type and new format */
             ntyp  = "integer"
             vfmt  = "-"    /*  ?,?  =>  ->>>>>>>>9  */ 
                   + FILL(">",MINIMUM(8,DICTDBG.{&file-name}.length_ - 1))
                   + "9".
         ELSE IF DICTDBG.{&file-name}.precision_ <= 9
           AND   DICTDBG.{&file-name}.scale      <= 0
           THEN ASSIGN /* new data-type and new format */
             i     = 1 - DICTDBG.{&file-name}.scale
             ntyp  = "integer"
             vfmt  = "-"    /*  5,-2  =>  ->>999           */ 
                   + FILL(">",DICTDBG.{&file-name}.precision_ - i)
                   + FILL("9",i).
         ELSE IF DICTDBG.{&file-name}.scale <= 0
           THEN ASSIGN
             i     = MINIMUM(29,1 - DICTDBG.{&file-name}.scale)
             vfmt  = "-"    /* 15,-2 =>  ->>>>>>>>>>>>999  */ 
                   + FILL(">",MINIMUM(29,DICTDBG.{&file-name}.precision_) - i)
                   + FILL("9",i).
           ELSE ASSIGN
             num_dec = MINIMUM(10,DICTDBG.{&file-name}.scale)
             i       = DICTDBG.{&file-name}.precision_ 
                     - DICTDBG.{&file-name}.scale
                     + num_dec
             vfmt    = "-"    /* 15,2  =>  ->>>>>>>>>>>>9.99 */
                     + FILL(">",MINIMUM(29,i) - num_dec - 2)
                     + "9." 
                     + FILL("9",num_dec).
       END.
      
   WHEN "FLOAT"
     THEN DO:
       ASSIGN j = INTEGER(DICTDBG.{&file-name}.precision_ * 0.30103).
       IF AVAILABLE w_field
         AND w_field.pro_dtype = "decimal"
         THEN ASSIGN   /* retain old data-type and old format */
           l_init  = w_field.pro_initial
           num_dec = w_field.pro_Decimals
           vfmt    = w_field.pro_Format.
         ELSE IF ENTRY(dtyp,user_env[17],"|") <> "#"
           THEN ASSIGN /* new data-type and format from _ora_typ.p */
             vfmt    = ENTRY(dtyp,user_env[17],"|")
             num_dec = ( IF INDEX(vfmt,".") = 0
                           THEN 0
                           ELSE LENGTH(vfmt,"character") - INDEX(vfmt,".")
                       ).
         ELSE IF j = ?
           THEN ASSIGN /* new data-type and new format */
             num_dec = 10
             vfmt    = "-"    /* ? (:=30) =>  ->>>>>>>>>>>>>>>>>9.9<<<<<<<<<< */
                     + FILL(">",17)
                     + "9.9" 
                     + FILL("<",9).
         ELSE IF j <= 22
           THEN ASSIGN /* new data-type and new format */
             num_dec = 1 + INTEGER(j / 2 - 1.6)
             vfmt    = "-"    /* 12    =>  ->>>>>9.9<<<< */
                     + FILL(">",j - num_dec - 2)
                     + "9.9" 
                     + FILL("<",num_dec - 1).
           ELSE ASSIGN
             num_dec = 1 + MINIMUM(9,INTEGER(j / 2 - 1.6))
             vfmt    = "-"    /* 26    =>  ->>>>>>>>>>>>>9.9<<<<<<<<<< */
                     + FILL(">",MINIMUM(17,j - num_dec - 2))
                     + "9.9" 
                     + FILL("<",num_dec - 1).
       END.

   WHEN "LOGICAL"
     THEN DO:
       IF AVAILABLE w_field
         AND w_field.pro_dtype = "logical"
         THEN ASSIGN   /* retain old data-type and old format */
           l_init = w_field.pro_initial
           vfmt   = w_field.pro_Format.
         ELSE ASSIGN   /* new format */
           vfmt   = (IF ENTRY(dtyp,user_env[17],"|") = "l"
                       THEN "yes/no"
                       ELSE ENTRY(dtyp,user_env[17],"|")
                    ).
       END.
      
   WHEN "DATE"
     THEN DO:
       IF AVAILABLE w_field
         AND w_field.pro_dtype = "date"
         THEN ASSIGN   /* retain old data-type and old format */
           l_init = w_field.pro_initial
           vfmt   = w_field.pro_Format.
         ELSE ASSIGN   /* new format */
           vfmt   = (IF ENTRY(dtyp,user_env[17],"|") = "d"
                       THEN "99/99/99"
                       ELSE ENTRY(dtyp,user_env[17],"|")
                    ).
       END.
      
   WHEN    "TIME"
     THEN DO:
       IF AVAILABLE w_field
         AND w_field.pro_dtype = "integer"
         THEN ASSIGN   /* retain old format */
           l_init = w_field.pro_initial
           vfmt   = w_field.pro_Format.
         ELSE ASSIGN   /* new format */
           vfmt   = (IF ENTRY(dtyp,user_env[17],"|") = "i"
                       THEN "->>>>>>>>9"
                       ELSE ENTRY(dtyp,user_env[17],"|")
                    ).
       END.

   OTHERWISE DO:
       message "Oracle data-type " {&data-type} " is not supported!"  skip
               "skipping this field ..."
               view-as alert-box error buttons ok.
       UNDO, {&undo}.  /* check */        
       END.
   END CASE.   
  
ASSIGN
  DICTDB._Field._Data-type    = ntyp
  DICTDB._Field._Decimals     = num_dec
  DICTDB._Field._Fld-case     = (ntyp = "character") /* could change lateron! */
  DICTDB._Field._Fld-stdtype  = INTEGER(ENTRY(dtyp,user_env[14]))
  DICTDB._Field._Format       = ( IF vfmt = "?" or vfmt = ?
                                    THEN DICTDB._Field._Format
                                    ELSE vfmt ).

IF AVAILABLE w_field
  THEN DO:
    ASSIGN
      DICTDB._Field._Can-Read     = w_field.pro_Can-Read
      DICTDB._Field._Can-Write    = w_field.pro_Can-Writ
      DICTDB._Field._Col-label    = w_field.pro_Col-lbl
      DICTDB._Field._Fld-case     = (ntyp = "character" 
                                        AND w_field.pro_Fld-case)
      DICTDB._Field._Help         = w_field.pro_Help
      DICTDB._Field._Initial      = (IF l_init <> "?" AND l_init <> ? 
                                        THEN l_init
                                        ELSE DICTDB._Field._Initial)
      DICTDB._Field._Label        = w_field.pro_Label
      DICTDB._Field._Mandatory    = ( DICTDB._Field._Mandatory
                                   OR w_field.pro_Mandatory )
      DICTDB._Field._Valexp       = w_field.pro_Valexp
      DICTDB._Field._Valmsg       = w_field.pro_Valmsg.
    DELETE w_field. /* save memory! */
    END.

/*----------------------------------------------------------------------*/    
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/ora_sys.i

Description:
    This string contains a comma-seperated list of the names of all
    system-objects for ORACLE, that are non-queryable.
    For example: Stored-Procedures, Buffers, ...
    This file gets used also from the report-builder -therefore it
    needs to be in a format that complies with C *and* PRGORESS
    
Text-Parameters:  
   none
                                     
History:
    hutegger    95/08   creation
    
--------------------------------------------------------------------*/
/*h-*/

"PROC-TEXT-BUFFER,SEND-SQL-STATEMENT,CloseAllProcs,DS-Close-Cursor"

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2004,2007-2008 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet. 
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/ora/ora_typ.i

Description:
    assignes the correct data-type names according to the type-number
    
Text-Parameters:
    &data-type      Foreign data-type in PROGRESS-Notation
                    usually ds_columns.type#, except
                    when it's "TIME" to support the date/time structure
    &extent         in the range of 0 to n
    &order-offset   gets added to the _field._order
    
Included in:            
    prodict/ora/_ora_pul.p
    
History:
    hutegger    95/03   abstracted from prodict/ora/ora_mak.i
    fernando 06/11/07   Unicode support - adding Unicode data types, and clob support
    fernando 04/07/08   Datetime support
--------------------------------------------------------------------*/
/*h-*/
    
assign 
  l_dt = (IF    ds_columns.type# =  1
             OR ds_columns.type# = 97  THEN
               (IF ds_columns.charsetform = 1 THEN "VARCHAR2" ELSE "NVARCHAR2")
        ELSE IF ds_columns.type# = 96  THEN (IF ds_columns.charsetform = 1 THEN "CHAR" ELSE "NCHAR")
        ELSE IF ds_columns.type# =  2  
             OR ds_columns.type# = 29  THEN "NUMBER"         
        ELSE IF ds_columns.type# =  9  THEN "VARCHAR"
        ELSE IF ds_columns.type# = 11
             OR ds_columns.type# = 104 /* Bug# 20070112-004 */
             OR ds_columns.type# = 69  THEN "ROWID"
        ELSE IF ds_columns.type# = 12  THEN "DATE"
        ELSE IF ds_columns.type# =  8  THEN "LONG"
        ELSE IF ds_columns.type# = 23 
             OR ds_columns.type# = 108 THEN "RAW"
        ELSE IF ds_columns.type# = 24  THEN "LONGRAW"
        ELSE IF ds_columns.type# = 252 THEN "LOGICAL"
        ELSE IF ds_columns.type# = 102 THEN "CURSOR"
        ELSE IF ds_columns.type# = 112 THEN (IF ds_columns.charsetform = 1 THEN "CLOB" ELSE "NCLOB")
        ELSE IF ds_columns.type# = 113 THEN "BLOB"
        ELSE IF ds_columns.type# = 114 THEN "BFILE"
        ELSE IF ds_columns.type# = 180 THEN "TIMESTAMP"
        ELSE IF ds_columns.type# = 181 THEN "TIMESTAMP_TZ"
        ELSE IF ds_columns.type# = 231 THEN "TIMESTAMP_LOCAL"
        ELSE                                "UNDEFINED").

&IF "{&procedure}" <> "YES"
 &THEN   /* this part is only for real columns, not for arguments */
  if      ds_columns.type#      =  2
    and   ds_columns.scale      =  ?
    and   ds_columns.precision_ <> ?  then assign l_dt = "FLOAT".
  else if ds_columns.type#      =  2
    and   ds_columns.precision_ <  0 
    and   ds_columns.scale
        - ds_columns.precision_ > 10  then assign l_dt = "FLOAT".
  &ENDIF
  

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Modified 11/17/97 DLM Added logicals for dump/load, validate and remove
                         obsolete object.
            01/13/98 DLM Added ora_version to know if 2000 or 4000 is now a long.
            03/11/98 DLM Added ora_tspace and ora_ispace so that tablespaces for
                         files and indexes can be entered.   
            02/01/00 DLM Added sqlwidth variable to know if the user wants to
                         use the _Width size instead of the code calculating. 
            05/31/00 DLM Added ora_pdbname for _gat_md9.i to compile.   
            05/30/01 DLM Added ora_owner and ora-collname. 
            10/12/01 DLM Added crtdefault for user to select to dump default values 
            06/25/02 DLM Added shadowcol to know if UPPER function should be used.    
            02/28/03 DLM Removed shadowcol as option
            06/11/07 fernando Unicode and clob support
*/                         

DEFINE {1} SHARED VARIABLE pro_dbname   AS CHARACTER.
DEFINE {1} SHARED VARIABLE pro_conparms AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_dbname   AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_pdbname  AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_version  AS INTEGER.
DEFINE {1} SHARED VARIABLE osh_dbname   AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_username AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_password AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_codepage AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_collname AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_conparms AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_sid      AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_tspace   AS CHARACTER.
DEFINE {1} SHARED VARIABLE ora_ispace   AS CHARACTER.
DEFINE {1} SHARED VARIABLE pcompatible  AS LOGICAL INITIAL TRUE NO-UNDO.
DEFINE {1} SHARED VARIABLE movedata     AS LOGICAL.
DEFINE {1} SHARED VARIABLE loadsql      AS LOGICAL.
DEFINE {1} SHARED VARIABLE rmvobj       AS LOGICAL NO-UNDO.
DEFINE {1} SHARED VARIABLE sqlwidth     AS LOGICAL.
DEFINE {1} SHARED VARIABLE ora_owner    AS CHARACTER.
DEFINE {1} SHARED VARIABLE crtdefault   AS LOGICAL.
DEFINE {1} SHARED VARIABLE iFmtOption   AS INTEGER INITIAL 2 NO-UNDO.
DEFINE {1} SHARED VARIABLE lFormat      AS LOGICAL INITIAL TRUE NO-UNDO.
DEFINE {1} SHARED VARIABLE shadowcol    AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE unicodeTypes AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE lExpandClob   AS LOGICAL   NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE lCharSemantics AS LOGICAL  NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE ora_varlen   AS INTEGER INITIAL 4000.

DEFINE {1} SHARED STREAM dbg_stream.

DEFINE {1} SHARED VARIABLE iShadow        AS INTEGER INITIAL 2 NO-UNDO.
DEFINE {1} SHARED VARIABLE oralang        AS CHARACTER.
DEFINE {1} SHARED VARIABLE nls_up         AS LOGICAL.
DEFINE {1} SHARED VARIABLE migConstraint  AS LOGICAL INITIAL TRUE.
DEFINE {1} SHARED VARIABLE choiceUniquness     AS CHARACTER INITIAL "1" NO-UNDO.
DEFINE {1} SHARED VARIABLE uctype         AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE lcsemantic     AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE {1} SHARED VARIABLE lExpand        AS LOGICAL                  NO-UNDO.
DEFINE {1} SHARED VARIABLE choiceDefault  AS CHARACTER INITIAL "1" NO-UNDO.
/*********************************************************************
* Copyright (C) 2006-2007,2011 by Progress Software Corporation.     *
* All rights reserved.  Prior versions of this work may contain      *
* portions contributed by participants of Possenet.                  *
*                                                                    *
*********************************************************************/

/* Procedure prodict/ora/protoor1.p

    Modified 11/12/97 DLM Removed disconnect of Progress Database,
                          input parameters since shared variable were
                          available and added logic not to load sql. 
             01/13/98 DLM Added check for ORACLE version > 7 so that
                          longs will be assigned correctly.  
             08/31/99 DLM Made final message about running .p for TTY
                          the same as for GUI, an alert-box.  
             09/01/99 DLM Assigned user_env[7] = "n" so DEFAULT value
                          will not be put into the Oracle SQL Script.   
             12/6/99  DLM Added assignment to rmvobj to know if this fails
                          if I can delete schema holder or need just to remove
                          database from existing schema holder. 
             02/01/00 DLM Added handling of sqlwidth parameter.  
             10/12/01 DLM Added logic to handle dumping DEFAULTs     
             06/04/02 DLM Added logic to handle error on creating hidden files 
             06/25/02 DLM Added logic for function based indexes
             10/17/05 KSM Fixed X8OVERRIDE funcionality. 
             06/11/07 fernando   Unicode support
             02/12/09 fernando   Fix output for batch log file
             06/21/11 kmayur  user env set for constraint migration
*/    

&SCOPED-DEFINE UNICODE-MSG-1 "You have chosen to use Unicode data types but the DataServer schema codepage is not 'utf-8'"
&SCOPED-DEFINE UNICODE-MSG-2 "If your ORACLE client NLS setting is set to a Unicode character set, you should set the" + chr(10) + "codepage to utf-8 in this case to avoid data loss"
&SCOPED-DEFINE UNICODE-MSG-3 "You have chosen to use Unicode data types but the schema holder database codepage is not 'utf-8'"
&SCOPED-DEFINE UNICODE-MSG-4 "You must build your schema holder database with a 'utf-8' code page"

            
{ prodict/user/uservar.i }
{ prodict/ora/oravar.i }

DEFINE VARIABLE cmd           AS CHARACTER           NO-UNDO.
DEFINE VARIABLE wait          AS CHARACTER           NO-UNDO.
DEFINE VARIABLE create_h      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE db_exist      AS LOGICAL             NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO  NO-UNDO. 
DEFINE VARIABLE output_file   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE tmp_str       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE l_i           AS INTEGER             NO-UNDO.
DEFINE VARIABLE run_time      AS INTEGER             NO-UNDO.
DEFINE VARIABLE schname       AS CHARACTER           NO-UNDO.
DEFINE VARIABLE dlc_utf_edb   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE schdbcp       AS CHARACTER           NO-UNDO.

DEFINE STREAM strm.

/*------------------------------------------------------------------*/

assign batch_mode    = SESSION:BATCH-MODE
       run_time      = TIME.

IF batch_mode THEN DO:
   PUT STREAM logfile UNFORMATTED
       " " skip
       "{&PRO_DISPLAY_NAME} to Oracle Log" skip(2)
       "Original {&PRO_DISPLAY_NAME} Database:    " pro_dbname skip
       "Other {&PRO_DISPLAY_NAME} db connect parameters : " pro_conparms  skip
       "Oracle Logical Database:       " ora_dbname skip
       "Version of Oracle:             " ora_version skip
       "{&PRO_DISPLAY_NAME} Schema Holder name:   " osh_dbname skip
       "Oracle Username:               " ora_username skip
       "Oracle Tablespace for tables:  " ora_tspace skip
       "Oracle Tablespace for indexes: " ora_ispace skip
       "Compatible structure:          " pcompatible skip
       "Create shadow columns:         " shadowcol skip
       "Field width calculation based on:      " (IF iFmtOption = 1 THEN
                                                    "_Field._Width field"
                                                  ELSE IF (lFormat = FALSE) THEN
                                                    "Calculation"
                                                  ELSE "_Field._Format field")
                                                  SKIP
       "Create objects in Oracle:      " loadsql skip
       "Moved data to Oracle:          " movedata skip
       "Include Defaults:              " crtdefault skip
       "Codepage for Schema Image:     " ora_codepage SKIP
       "Collation Name:                " ora_collname SKIP
       "Unicode Types:                 " unicodeTypes skip
       "Maximum char length:           " ora_varlen SKIP
       "Char semantics:                " lCharSemantics SKIP. 
END.

IF loadsql THEN DO:
 
  IF not batch_mode THEN
     HIDE MESSAGE NO-PAUSE.
  ASSIGN schname = osh_dbname + ".db".
  IF search(schname) <> ? THEN DO:
    CONNECT VALUE(osh_dbname) -1 NO-ERROR.

    if ERROR-STATUS:ERROR then do:
      IF not batch_mode THEN DO:
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
            MESSAGE "Can't connect to Database " osh_dbname.
        &ELSE
            MESSAGE "Can't connect to Database " osh_dbname
              VIEW-AS ALERT-BOX ERROR.
        &ENDIF.
      END.       
      ELSE 
          PUT STREAM logfile UNFORMATTED 
               "Can't connect to Database " osh_dbname skip(2).
      UNDO, RETURN error.
    end.
  end.

  IF CONNECTED (osh_dbname) THEN DO:

    /* Get the physical schema holder database codepage */
    REPEAT l_i = 1 TO NUM-DBS:

      IF LDBNAME(l_i) = osh_dbname THEN
          schdbcp = UPPER(TRIM(DBCODEPAGE(l_i))).
    END.

    ASSIGN rmvobj   = FALSE
           create_h = FALSE.

    CREATE ALIAS DICTDB2 FOR DATABASE VALUE (osh_dbname).
    ASSIGN db_exist = FALSE.
    RUN "prodict/misc/_tstsh.p" (INPUT ora_dbname, OUTPUT db_exist).
    IF db_exist THEN DO:
      IF not batch_mode THEN DO:
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           MESSAGE "Database " ora_dbname " already exists in schema holder " 
                  osh_dbname.
        &ELSE 
           MESSAGE "Database " ora_dbname " already exists in schema holder " 
      	               osh_dbname VIEW-AS ALERT-BOX ERROR.
        &ENDIF
        DISCONNECT VALUE (osh_dbname).
        UNDO, RETURN "indb".
      END. 	                  	           
      ELSE 
         PUT STREAM logfile UNFORMATTED 
            "Database " ora_dbname " already exists in schema holder " 
            osh_dbname skip(2).
          UNDO, RETURN ERROR.
    END. 
    DISCONNECT VALUE (osh_dbname).   
  END. 
  ELSE
    ASSIGN rmvobj = TRUE
           create_h = TRUE.

  IF ora_dbname = pro_dbname OR ora_dbname = osh_dbname THEN DO:
    IF batch_mode THEN 
       PUT STREAM logfile UNFORMATTED 
               "Database " ora_dbname 
               " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database"
                skip(2).
    ELSE DO:
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
           MESSAGE "Database " ora_dbname 
             " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database".
      &ELSE
           MESSAGE "Database " ora_dbname 
             " must not be the same as schema holder or {&PRO_DISPLAY_NAME} Database"
             VIEW-AS ALERT-BOX ERROR.
      &ENDIF
    END.             
    UNDO, RETURN error.
  END.
END.

IF ora_version > 7 THEN DO:
    IF unicodeTypes THEN
       ASSIGN user_env[18] = "NVARCHAR2".
    ELSE
       ASSIGN user_env[18] = "VARCHAR2".
END.
ELSE
  ASSIGN user_env[18] = "long".
  
ASSIGN user_env[1]  = "ALL"
       user_env[2]  = osh_dbname
       user_env[3]  = ""
       user_env[4]  = "n"
       user_env[5]  = ";"
       user_env[6]  = "y"
       user_env[7]  = (IF crtdefault THEN "y" ELSE "n")
       user_env[8]  = "y"
       user_env[9]  = "ALL"
       user_env[10] = string(ora_varlen) /* maximum char column length */
                             + "," + STRING(lExpandClob)  /* expand to clob */
                             + "," + STRING(lCharSemantics) /* use char semantics */
       user_env[11] = "char"
       user_env[12] = "date"
       user_env[13] = "number"
       user_env[14] = "number"
       user_env[15] = "number"
       user_env[16] = "number"
       user_env[17] = "number"
       user_env[19] = "number"
       user_env[20] = "##"
       user_env[22] = "ORACLE"
       user_env[23] = "30"
       user_env[24] = "15"
       user_env[25] = "y"
       user_env[26] = ora_username
       user_env[28] = "30"
       user_env[29] = "26"
       user_env[31] = "-- ** "
       user_env[34] = ora_tspace
       user_env[35] = ora_ispace.
       user_env[36] =  (if migConstraint then "y" else "n"). /* 195067 */
       user_env[38] =  choiceUniquness . /* 195067 */
       user_env[39] =  choiceDefault . /* 195067 */        
       user_env[40] =  (IF nls_up THEN "y" ELSE "n"). /* 195067 */

IF movedata THEN 
     ASSIGN user_env[36] = user_env[36] + ",n,n,n,y".
ELSE
     ASSIGN user_env[36] = user_env[36] + ",n,n,n,n".       
IF user_env[40] = "y"  THEN 
   ASSIGN user_env[41] = oralang.
ELSE
   ASSIGN user_env[41] = "?".

IF pcompatible THEN 
   ASSIGN user_env[27] = "y".
ELSE
   ASSIGN user_env[27] = "no".

IF iFmtOption = 1 THEN 
  ASSIGN user_env[33] = "y".
ELSE IF (lFormat = FALSE) THEN
  ASSIGN user_env[33] = "no".
ELSE
  ASSIGN user_env[33] = "?".

/* Create shadow columns */
IF iShadow = 2 THEN
  ASSIGN user_env[21] = "y".
ELSE 
  ASSIGN user_env[21] = "n".

    /* md0: creates SQL and .d-files */
RUN "prodict/ora/_ora_md0.p".

IF loadsql THEN DO:

  /* check if unicode types and non utf-8 codepage and give warning */
  IF unicodeTypes AND TRIM(ora_codepage) NE "utf-8" THEN DO:
     IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED {&UNICODE-MSG-1} SKIP {&UNICODE-MSG-2} SKIP.
     ELSE
        MESSAGE {&UNICODE-MSG-1} SKIP {&UNICODE-MSG-2} VIEW-AS ALERT-BOX INFO BUTTONS OK.
  END.

  IF create_h THEN DO:
    IF batch_mode THEN DO:
      PUT STREAM logfile UNFORMATTED
              " " skip
              "-- ++ " skip
              "-- Creating empty schema holder " skip
              "-- -- " skip(2).
    END.

    IF unicodeTypes OR TRIM(ora_codepage) = "utf-8" THEN DO:
        dlc_utf_edb = OS-GETENV("DLC").
        dlc_utf_edb = dlc_utf_edb + "/prolang/utf/empty".
        CREATE DATABASE osh_dbname FROM dlc_utf_edb. 
    END.
    ELSE
       CREATE DATABASE osh_dbname FROM "EMPTY".
  END.
  ELSE DO:
    IF unicodeTypes THEN DO:
      IF ( schdbcp <> "UTF-8" ) THEN DO:
        IF batch_mode THEN
          PUT STREAM logfile UNFORMATTED {&UNICODE-MSG-3} SKIP {&UNICODE-MSG-4} SKIP.
        ELSE
          MESSAGE {&UNICODE-MSG-3} SKIP {&UNICODE-MSG-4} VIEW-AS ALERT-BOX INFO BUTTONS OK.
        UNDO, RETURN "undo".
      END.
    END.
  END. 

  IF NOT batch_mode THEN
    HIDE FRAME table-wait NO-PAUSE.

  /* md1: creates SI and ORACLE-Schema using send-sql.p
   *      pulls schema into SI
   *      beautifies SI by comparing it and matching it up with 
   *            the original progress-db
   */

  RUN "prodict/ora/_ora_md1.p".

  IF RETURN-VALUE = "1" THEN DO:
    cmd = "Error creating ORACLE Database - Check logfile " + osh_dbname + 
      	  ".log".
    IF NOT Batch_mode THEN
      MESSAGE cmd view-as alert-box.
    ELSE
      PUT STREAM logfile UNFORMATTED  cmd.  
    UNDO, RETURN error.
  END.  
  ELSE IF RETURN-VALUE = "2" THEN
    UNDO, RETURN ERROR.
  ELSE IF RETURN-VALUE = "3" THEN
    UNDO, RETURN "wrg-ver".
  ELSE IF RETURN-VALUE = "4" THEN
    UNDO, RETURN "wrng-collat".  

  IF batch_mode and NOT logfile_open THEN DO:
    OUTPUT TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
    logfile_open = true.
  END.

  /* See if we were successful. */

  IF NOT CONNECTED (ora_dbname) THEN DO:
    cmd = "Error creating ORACLE Database - Check logfile " + osh_dbname + 
      	  ".log".
    IF NOT Batch_mode THEN
      MESSAGE cmd.
    ELSE
      PUT STREAM logfile UNFORMATTED  cmd.  
    UNDO, RETURN error.
  END.

  ASSIGN cmd = "c" + ora_dbname + ".p".

  OUTPUT STREAM strm TO VALUE (cmd) NO-MAP.

  PUT STREAM strm UNFORMATTED "CONNECT " osh_dbname " -1." SKIP.

  IF ora_conparms <> ? THEN DO:
    IF INDEX(ora_conparms,"@") <> 0 THEN 
         ora_username = ora_username + ora_conparms. 
  END. 

  IF ora_password = "" or ora_password = ? THEN
     PUT STREAM strm UNFORMATTED "CONNECT " ora_dbname " -ld ~"" ora_dbname
        "~" -dt ORACLE -U ~"" ora_username "~"".
  ELSE 
     PUT STREAM strm UNFORMATTED "CONNECT " ora_dbname " -ld ~"" ora_dbname
        "~" -dt ORACLE -U ~"" ora_username "~" -P ~"" ora_password "~"".
 
  IF ora_conparms <> ? THEN DO:
    IF INDEX(ora_conparms,"@") = 0 THEN 
         PUT STREAM strm UNFORMATTED " " ora_conparms.
  END.

  PUT STREAM strm UNFORMATTED "." SKIP.

  OUTPUT STREAM strm CLOSE.

  IF movedata THEN 
  _mvdt:
  DO:
    IF NOT CONNECTED(ora_dbname) THEN DO:
      IF batch_mode THEN
        PUT STREAM logfile UNFORMATTED
          "Database" ora_dbname " not connected.  Unable to load data."  SKIP.
       ELSE
         MESSAGE "Database" ora_dbname " NOT connected.  Unable to load data." SKIP
           VIEW-AS ALERT-BOX.
       LEAVE _mvdt.    
    END.        
    IF batch_mode THEN
       PUT STREAM logfile UNFORMATTED
           "-- ++ " skip
           "-- Loading data into the Oracle database. " skip
           "-- -- " skip(2).
    ELSE
      DISPLAY  " " SKIP 
               "   Loading data into the Oracle Database.  " SKIP(2)
        WITH FRAME ld-dt NO-LABELS THREE-D CENTERED ROW 5 
          TITLE "Moving Data".

    RUN "prodict/ora/_ora_md9.p".

    IF NOT batch_mode THEN
       HIDE FRAME ld-dt NO-PAUSE.

    DISCONNECT VALUE (ora_dbname).
    DISCONNECT VALUE (osh_dbname).
  END.  
end.
IF NOT batch_mode and loadsql THEN 
      MESSAGE "Run pro -p " cmd " to connect to new Oracle database."
            VIEW-AS ALERT-BOX INFORMATION.

ELSE IF batch_mode THEN DO:

   IF NOT logfile_open THEN DO:
      OUTPUT STREAM logfile TO VALUE(output_file) APPEND UNBUFFERED NO-ECHO NO-MAP.
      logfile_open = true.
   END.

   PUT STREAM logfile UNFORMATTED
       " "           skip
       "-- ++ "      skip
       "-- PROTOORA Complete in " STRING(TIME - run_time,"HH:MM:SS")  skip
       "-- -- "      skip(2).
   if loadsql then
       PUT STREAM logfile UNFORMATTED
          " "                                   skip 
          "Run pro -p " cmd
          " to connect to new Oracle database." skip.
END.

/*------------------------------------------------------------------*/


/*********************************************************************
* Copyright (C) 2005,2007-2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Modified D. McMann 12/19/97 Changed labels added toggle boxes
                               for loading sql and moving data.
            D. McMann 01/13/98 Added new env var ora_version.
            D. McMann 04/02/98 Changed load sql default to true
                               98-02-12-011
            D. McMann 12/02/99 Changed compatible label 19990305027
            D. McMann 12/07/99 Added clean up routine when error occurs
            D. McMann 02/07/00 Added sqlwidth support
            D. McMann 04/10/00 Moved environmental variables outside of
                               main so values would not be lost if error
                               occurred 20000121012
            D. McMann 04/12/00 Added long Progress Database path name.
            D. McMann 10/12/01 Added logic to dump defaults if user wants
            D. McMann 06/25/02 Added logic for function based indexes
            D. McMann 10/23/02 Changed BLANK to PASSWORD-FIELD
            D. McMann 11/26/02 Removed Oracle V7 as an option
          K. McIntosh 09/08/05 Added support for Oracle 10 20050318-015
             fernando 06/11/07 Unicode and clob support   
             fernando 08/30/07 More Unicode support stuff       
             fernando 09/14/07 Allow ORACLE version 11
             fernando 08/28/08 Commented out references to lExpandClob - not supported yet.
             kmayur   06/21/11 screen split for constraint migration
             sbehera  02/03/14 Support for oracle 12 version and changed default version to 11
*/            


{ prodict/user/uservar.i NEW }
{ prodict/ora/oravar.i NEW }

DEFINE VARIABLE cmd           AS CHARACTER.
DEFINE VARIABLE wait          AS CHARACTER.
DEFINE VARIABLE create_h      AS LOGICAL.
DEFINE VARIABLE db_exist      AS LOGICAL.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL no. 
DEFINE VARIABLE output_file   AS CHARACTER.
DEFINE VARIABLE tmp_str       AS CHARACTER.
DEFINE VARIABLE run_time      AS INTEGER.
DEFINE VARIABLE err-rtn       AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE old-dictdb    AS CHARACTER NO-UNDO.
DEFINE VARIABLE i             AS INTEGER NO-UNDO.
DEFINE VARIABLE redo          AS LOGICAL NO-UNDO.
DEFINE VARIABLE mvdta         AS LOGICAL NO-UNDO.
DEFINE VARIABLE cFormat       AS CHARACTER 
                           INITIAL "For field widths use:"
                           FORMAT "x(20)" NO-UNDO.
DEFINE VARIABLE wrg-ver       AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE wrng-collat   AS LOGICAL INITIAL FALSE    NO-UNDO.
DEFINE VARIABLE disp_msg1      AS LOGICAL INITIAL TRUE     NO-UNDO.
DEFINE VARIABLE disp_msg2      AS LOGICAL INITIAL TRUE     NO-UNDO.
DEFINE button s_btn_Advanced SIZE 24 by 1.125.
DEFINE STREAM   strm.

ASSIGN redo = FALSE
       batch_mode = SESSION:BATCH-MODE.


FORM
  pro_dbname   FORMAT "x({&PATH_WIDG})"  view-as fill-in size 32 by 1 
    LABEL "Original {&PRO_DISPLAY_NAME} Database" colon 38 SKIP({&VM_WID}) 
  pro_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
    LABEL "Connect parameters for {&PRO_DISPLAY_NAME}" colon 38 SKIP({&VM_WID})
  osh_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Name of Schema holder Database" colon 38 SKIP({&VM_WID})
  ora_dbname   FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "Logical name for ORACLE Database" colon 38 SKIP({&VM_WID})
  ora_version  FORMAT ">9" 
      validate(INPUT ora_version = 8 OR
               INPUT ora_version = 9 OR
               INPUT ora_version = 10 OR 
               INPUT ora_version = 11 OR
               INPUT ora_version = 12,
               "Oracle Version must be 10, 11 or 12") 
      view-as fill-in size 23 by 1
    LABEL "What version of ORACLE" colon 38 SKIP ({&VM_WID})  
  ora_username FORMAT "x(32)"  view-as fill-in size 32 by 1 
    LABEL "ORACLE Owner's Username" colon 38 SKIP({&VM_WID})
  ora_password FORMAT "x(32)"  PASSWORD-FIELD
        view-as fill-in size 32 by 1 
        LABEL "ORACLE User's Password" colon 38 SKIP({&VM_WID})
  ora_conparms FORMAT "x(256)" view-as fill-in size 32 by 1 
     LABEL "ORACLE connect parameters" colon 38 SKIP({&VM_WID})
  ora_codepage FORMAT "x(32)"  view-as fill-in size 32 by 1
     LABEL "Codepage for Schema Image" colon 38 SKIP({&VM_WID}) 
  ora_collname FORMAT "x(32)" VIEW-AS FILL-IN SIZE 32 BY 1
     LABEL "Collation Name" COLON 38 SKIP({&VM_WID})
  ora_varlen FORMAT ">>>9" 
    VALIDATE (INPUT ora_varlen > 0 AND
              INPUT ora_varlen <= 4000,
              "Maximum length must not be greater than 4000") 
         LABEL "Maximum char length"  COLON 38
 /* space(1) lExpandClob view-as toggle-box label "Expand to CLOB"*/ SKIP({&VM_WID})
  " ORACLE tablespace name for:" view-as text SKIP({&VM_WID})   
  ora_tspace FORMAT "x(30)" view-as fill-in size 30 by 1
     LABEL "Tables" colon 8
  ora_ispace FORMAT "x(30)" view-as fill-in size 30 by 1
     LABEL "Indexes" colon 47 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID}) &ELSE SKIP({&VM_WIDG}) &ENDIF
  loadsql view-as toggle-box     label "Load SQL  "  AT 3 SKIP({&VM_WID})
  movedata view-as toggle-box label "Move Data" AT 3 
  s_btn_Advanced label "Advanced..." AT 53 SKIP({&VM_WID})   SPACE(2)
     {prodict/user/userbtns.i}
  WITH FRAME x ROW 
    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 1 &ELSE 2 &ENDIF 
    CENTERED SIDE-labels 
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF
  TITLE "{&PRO_DISPLAY_NAME} DB to ORACLE Conversion".

FORM
  wait FORMAT "x" LABEL
  "Creating tables - Please wait"
  WITH FRAME table-wait ROW SCREEN-LINES - 2 COLUMN 1 NO-BOX
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN VIEW-AS DIALOG-BOX &ENDIF.

/* PROCEDURES */
PROCEDURE cleanup:  
  IF NUM-DBS > 1 THEN DO:   
    IF rmvobj THEN DO:
        DISCONNECT VALUE(osh_dbname).
        RUN prodict/misc/_clproto.p (INPUT osh_dbname, INPUT pro_dbname).
    END.
    ELSE DO:       
      CREATE ALIAS DICTDB FOR DATABASE VALUE(osh_dbname).
      RUN prodict/misc/_del-db.p (INPUT ora_dbname, INPUT osh_dbname, 
                                  INPUT pro_dbname).       
    END.
  END.
END PROCEDURE.


/*   TRIGGERS   */
ON WINDOW-CLOSE of FRAME x
   APPLY "END-ERROR" to FRAME x.


/*----- HELP in OpenEdge DB to Oracle Database -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
on HELP of frame x or CHOOSE of btn_Help in frame x
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&PROGRESS_DB_to_ORACLE_Dlg_Box},
                             INPUT ?).
&ENDIF  

ON VALUE-CHANGED of loadsql IN FRAME x DO:
  IF SELF:screen-value = "yes" THEN 
     movedata:sensitive in frame x = YES.
  ELSE DO:
     movedata:screen-value in frame x = "no".
     movedata = false.
     movedata:sensitive in frame x = NO.
  END.   
END.  

PROCEDURE fill_utf:
 IF ora_varlen = 2000 
 THEN
       ASSIGN  ora_codepage = 'UTF-8'
               ora_codepage:SCREEN-VALUE in frame x= 'UTF-8'
               ora_varlen:SCREEN-VALUE in frame x= "2000".
 ELSE
       ASSIGN  ora_codepage = session:cpinternal
               ora_codepage:SCREEN-VALUE in frame x= session:cpinternal
               ora_varlen:SCREEN-VALUE in frame x= "4000". 
END PROCEDURE.

ON VALUE-CHANGED OF ora_version IN FRAME x DO:
    
    /* when ora_version is 9 and up, we support Unicode data types */
    IF INTEGER(ora_version:SCREEN-VALUE IN FRAME X) >= 9 THEN DO:
        ASSIGN uctype = TRUE
               lcsemantic = TRUE.
        
    END.
    ELSE DO:
        ASSIGN uctype = FALSE
               lcsemantic = FALSE
               ora_codepage = session:cpinternal
               ora_codepage:SCREEN-VALUE = session:CPINTERNAL
               ora_varlen = 4000
               ora_varlen:SCREEN-VALUE = "4000".
    END.

   ora_version = INTEGER(ora_version:SCREEN-VALUE).
END.
    
ON VALUE-CHANGED OF ora_codepage IN FRAME x DO:

 /* if not 9 or above, nothing to be done */
 IF INTEGER(ora_version:SCREEN-VALUE IN FRAME X) >= 9 THEN DO:

    /* if utf-8, we make character semantics the default */
    IF TRIM(SELF:SCREEN-VALUE) = "UTF-8" 
      AND unicodeTypes = FALSE THEN DO:

        ASSIGN lCharSemantics = TRUE
               ora_varlen = 1000
               ora_varlen:SCREEN-VALUE = "1000".

        IF disp_msg2 = TRUE THEN DO:
           disp_msg2 = FALSE.
           MESSAGE "To accommodate for data expansion depending on the database character set, the " SKIP
                   "maximum char length default was automatically modified. Character semantics" SKIP
                   "was also selected. You may have to change them if they do not apply for your" SKIP
                   "configuration or data."
               VIEW-AS ALERT-BOX WARNING BUTTONS OK.
        END.

    END.
 END.

END.

ON LEAVE OF ora_codepage IN FRAME X DO:

    IF unicodeTypes = TRUE THEN DO:
        IF ora_codepage:SCREEN-VALUE NE "UTF-8" THEN
            MESSAGE "It is recommended that you set the schema codepage to UTF-8 when selecting" SKIP
                    "Unicode Types."
                VIEW-AS ALERT-BOX WARNING BUTTONS OK.

    END.
END.

IF LDBNAME ("DICTDB") <> ? THEN
  ASSIGN pro_dbname = LDBNAME ("DICTDB").

IF NOT batch_mode THEN DO:
   {adecomm/okrun.i  
       &FRAME  = "FRAME x" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
   }
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   btn_Help:visible IN FRAME x = yes.
   &ENDIF
END.

IF OS-GETENV("PRODBNAME")   <> ? THEN
  pro_dbname   = OS-GETENV("PRODBNAME").
IF OS-GETENV("PROCONPARMS")   <> ? THEN
  pro_conparms = OS-GETENV("PROCONPARMS").
IF OS-GETENV("SHDBNAME")    <> ? THEN
  osh_dbname   = OS-GETENV("SHDBNAME").
IF OS-GETENV("ORADBNAME")   <> ? THEN
  ora_dbname   = OS-GETENV("ORADBNAME").
IF OS-GETENV("ORAVERSION")   <> ? THEN
  ora_version   = INTEGER(OS-GETENV("ORAVERSION")). 
ELSE
  ora_version = 11.       
IF OS-GETENV("ORAUSERNAME") <> ? THEN
  ora_username = OS-GETENV("ORAUSERNAME").
IF OS-GETENV("ORAPASSWORD") <> ? THEN
  ora_password = OS-GETENV("ORAPASSWORD").
IF OS-GETENV("ORACONPARMS") <> ? THEN
  ora_conparms = OS-GETENV("ORACONPARMS").
IF OS-GETENV("ORACLE_SID") <> ? THEN
  ora_sid = OS-GETENV("ORACLE_SID").
IF OS-GETENV("TABLEAREA") <> ? THEN
  ora_tspace = OS-GETENV("TABLEAREA").
IF OS-GETENV("INDEXAREA") <> ? THEN
  ora_ispace = OS-GETENV("INDEXAREA").            
 
IF OS-GETENV("MOVEDATA")    <> ? THEN
  tmp_str      = OS-GETENV("MOVEDATA").
IF tmp_str BEGINS "Y" THEN movedata = TRUE.

IF OS-GETENV("COMPATIBLE") <> ? THEN DO:
  tmp_str      = OS-GETENV("COMPATIBLE").
  IF tmp_str BEGINS "Y" then pcompatible = TRUE.
  ELSE pcompatible = FALSE.
END. 
ELSE
  pcompatible = TRUE.
     
/* Initialize field width choice */
IF OS-GETENV("SQLWIDTH") <> ? THEN DO:
  tmp_str      = OS-GETENV("SQLWIDTH").
  IF tmp_str BEGINS "Y" THEN iFmtOption = 1.
  ELSE iFmtOption = 2.
END. 
ELSE
  iFmtOption = 2.

IF OS-GETENV("LOADSQL") <> ? THEN DO:
  tmp_str      = OS-GETENV("LOADSQL").
  IF tmp_str BEGINS "Y" then loadsql = TRUE.
  ELSE loadsql = FALSE.
END. 
ELSE
 loadsql = TRUE.

 IF OS-GETENV("ORACODEPAGE") <> ? THEN
   ora_codepage = OS-GETENV("ORACODEPAGE").
 ELSE
   ASSIGN ora_codepage = session:cpinternal.

 IF OS-GETENV("ORACOLLNAME") <> ? THEN
   ora_collname = OS-GETENV("ORACOLLNAME").
 ELSE
   ASSIGN ora_collname = session:CPCOLL.

IF OS-GETENV("CRTDEFAULT") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("CRTDEFAULT").
  IF tmp_str BEGINS "Y" then crtdefault = TRUE.
  ELSE crtdefault = FALSE.
END. 
ELSE 
  ASSIGN crtdefault = FALSE.

IF OS-GETENV("SHADOWCOL") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("SHADOWCOL").
  IF tmp_str BEGINS "Y" 
           THEN iShadow = 2.           
           ELSE iShadow = 1.
END. 
ELSE
  ASSIGN iShadow = 1.

IF OS-GETENV("EXPANDX8") <> ? THEN DO:
    ASSIGN tmp_str  = OS-GETENV("EXPANDX8").
    IF tmp_str BEGINS "Y" THEN 
      ASSIGN lExpand = TRUE
             lFormat = FALSE.
    ELSE 
      ASSIGN lExpand = FALSE
             lFormat = TRUE.
END. 
ELSE
    ASSIGN lExpand = TRUE
           lFormat = FALSE.

IF OS-GETENV("CHARSEMANTICS")  <> ? AND ora_version >= 9 THEN DO:
  tmp_str      = OS-GETENV("CHARSEMANTICS").

  IF tmp_str BEGINS "Y" THEN
      ASSIGN lCharSemantics = TRUE.
END.
ELSE IF ora_version >= 9 AND ora_codepage = "utf-8" THEN
     ASSIGN lCharSemantics = TRUE.

/*
IF OS-GETENV("EXPANDCLOB") <> ? THEN DO:
    ASSIGN tmp_str  = OS-GETENV("EXPANDCLOB").
    IF tmp_str BEGINS "Y" THEN 
        ASSIGN lExpandClob = TRUE.
END.
*/

/* Unicode Types only support for ORACLE 9 and up */

IF OS-GETENV("UNICODETYPES")  <> ? AND ora_version >= 9 THEN DO:
  tmp_str      = OS-GETENV("UNICODETYPES").

  IF tmp_str BEGINS "Y" THEN DO:
      ASSIGN unicodeTypes = TRUE
             lCharSemantics = NO  /* irrelevant */
             /*lExpandClob = NO*/ . /* irrelevant */

      IF OS-GETENV("ORACODEPAGE") = ? THEN
         ASSIGN ora_codepage = 'UTF-8'.
  END.
END.

IF OS-GETENV("VARLENGTH") <> ? THEN DO:
   ASSIGN ora_varlen = integer(OS-GETENV("VARLENGTH")).
   IF ora_varlen < 1000 OR ora_varlen > 4000 THEN
      ora_varlen = 4000.
END.
ELSE DO:

   IF unicodeTypes THEN
      ASSIGN ora_varlen = 2000.
   ELSE IF ora_codepage = "utf-8" THEN
      ASSIGN ora_varlen = 1000.
   ELSE
      ASSIGN ora_varlen = 4000.
END.

IF OS-GETENV("MIGRATECONSTR")   <> ? 
  THEN DO:
   tmp_str = OS-GETENV("MIGRATECONSTR").
   IF tmp_str BEGINS "y" 
     THEN migConstraint = yes.
     ELSE migConstraint = no.
  END.
  ELSE migConstraint = yes.
  
IF OS-GETENV("UNIQUECONSTR")   <> ?
 THEN DO:
  tmp_str  = OS-GETENV("UNIQUECONSTR").
  IF tmp_str BEGINS "y" 
    THEN choiceUniquness = "2".
    ELSE choiceUniquness = "1".
 END.   
    ELSE choiceUniquness = "1".

IF OS-GETENV("NLSUPPER") <> ? AND iShadow = 1
 THEN DO:
   tmp_str  = OS-GETENV("NLSUPPER").
   IF tmp_str BEGINS "Y" 
     THEN DO:
        nls_up = YES.
        IF OS-GETENV("SORTNAME") <> ?
            THEN oralang = OS-GETENV("SORTNAME").
            ELSE 
                 ASSIGN nls_up = NO
                        oralang = "BINARY".
     END.       
     ELSE 
     ASSIGN nls_up = NO
            oralang = "BINARY".
  END.
  ELSE 
  ASSIGN nls_up = NO
         oralang = "BINARY".
        
IF PROGRESS EQ "COMPILE-ENCRYPT" THEN
  ASSIGN mvdta = FALSE.
ELSE
  ASSIGN mvdta = TRUE.


if   pro_dbname   = ldbname("DICTDB") and pro_conparms = "" then 
  assign pro_conparms = "<current working database>".
ON CHOOSE OF s_btn_Advanced in frame X
DO:
     run prodict/ora/_protoora.p.
     run fill_utf.
END.
main-blk:
DO ON ERROR UNDO main-blk, RETRY main-blk:
  IF redo THEN
      RUN cleanup.

  IF logfile_open THEN DO:
     OUTPUT STREAM logfile CLOSE.
     logfile_open = FALSE.
  END.

  IF wrg-ver THEN DO:
     MESSAGE "Unicode support for the DataServer for ORACLE was designed to work" SKIP
             "with ORACLE 9 and above. You have tried to connect to a prior" SKIP
             "version of ORACLE. " SKIP
        &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
              VIEW-AS ALERT-BOX ERROR BUTTONS OK
       &ENDIF
        . /* end of message statement */
     RETURN.
  END.

  run_time = TIME.

  IF ora_version >= 9 THEN
          ASSIGN uctype = TRUE
                 lcsemantic = TRUE.
  ELSE
          ASSIGN uctype = FALSE
                 lcsemantic = FALSE.
  IF wrng-collat THEN DO:
     MESSAGE "Missing or invalid Oracle Language . " SKIP
              &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
              VIEW-AS ALERT-BOX ERROR BUTTONS OK
       &ENDIF
        . /* end of message statement */
     RETURN.
  END.

            
  /*
   * if this is not batch mode, allow override of environment variables.
   */
  PAUSE 0 BEFORE-HIDE.
  IF NOT batch_mode THEN 
  _updtvar: 
   DO WHILE TRUE:
    UPDATE pro_dbname
      pro_conparms
      osh_dbname
      ora_dbname
      ora_version
      ora_username
      ora_password
      ora_conparms
      ora_codepage
      ora_collname
      ora_varlen
      /*lExpandClob*/
      ora_tspace
      ora_ispace
      loadsql
      movedata WHEN mvdta 
      s_btn_Advanced
      btn_OK btn_Cancel 
      &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            btn_Help
      &ENDIF      
      WITH FRAME x.
    
    IF LDBNAME ("DICTDB") <> pro_dbname THEN DO:
      ASSIGN old-dictdb = LDBNAME("DICTDB").
      IF NOT CONNECTED(pro_dbname) THEN
        CONNECT VALUE (pro_dbname) VALUE (pro_conparms) -1 NO-ERROR.              
      
      IF ERROR-STATUS:ERROR OR NOT CONNECTED (pro_dbname) THEN DO:
        DO i = 1 TO  ERROR-STATUS:NUM-MESSAGES:
            MESSAGE ERROR-STATUS:GET-MESSAGE(i).
        END.

        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
            MESSAGE "Unable to connect to {&PRO_DISPLAY_NAME} database".
        &ELSE
            MESSAGE "Unable to connect to {&PRO_DISPLAY_NAME} database" 
             VIEW-AS ALERT-BOX ERROR.
        &ENDIF

        NEXT _updtvar.
      END.
      ELSE 
        CREATE ALIAS DICTDB FOR DATABASE VALUE(pro_dbname).  
    END.
    ELSE
      ASSIGN old-dictdb = LDBNAME("DICTDB").
  
    IF loadsql THEN DO:
      IF Osh_dbname = "" OR osh_dbname = ? THEN DO:
        IF "{&WINDOW-SYSTEM}" <> "TTY" THEN
           MESSAGE "Schema holder database Name is required."  VIEW-AS ALERT-BOX ERROR.
        ELSE
           MESSAGE "Schema holder Database Name is required." .   
        NEXT _updtvar.
      END.

      IF ora_dbname = "" OR ora_dbname = ? THEN DO:
        IF "{&WINDOW-SYSTEM}" <> "TTY" THEN
           MESSAGE "Oracle Database Name is required."  VIEW-AS ALERT-BOX ERROR.
        ELSE
           MESSAGE "Oracle Database Name is required." .   
        NEXT _updtvar.
      END.

      IF ora_username = "" OR ora_username = ? THEN DO:
        IF "{&WINDOW-SYSTEM}" <> "TTY" THEN
           MESSAGE "Oracle User Name is required."  VIEW-AS ALERT-BOX ERROR.
        ELSE
           MESSAGE "Oracle User Name is required." .   
        NEXT _updtvar.
      END.

      IF (ora_password = "" OR ora_password = ?) and
        (INDEX(ora_username, "/") = 0) THEN DO:       
        IF "{&WINDOW-SYSTEM}" <> "TTY" THEN
           MESSAGE "Oracle User Password is required."  VIEW-AS ALERT-BOX ERROR.
        ELSE
           MESSAGE "Oracle User Password is required." .   
        NEXT _updtvar.
      END.

      IF (ora_conparms = "" OR ora_conparms = ?) AND
         (ora_sid = "" OR ora_sid = ?) AND
         (INDEX(ora_username, "@") = 0 AND INDEX(ora_password, "@") = 0) THEN DO:
        IF "{&WINDOW-SYSTEM}" <> "TTY" THEN
           MESSAGE "Oracle connect parameters are required."  VIEW-AS ALERT-BOX ERROR.
        ELSE
           MESSAGE "Oracle connect parameters are required or ORACLE_SID must be set." .   
        NEXT _updtvar.
      END.   
    END.      
    LEAVE _updtvar.
  END.
  ELSE DO:
    IF osh_dbname <> "" AND osh_dbname <> ? THEN
        output_file = osh_dbname + ".log".
    ELSE
        output_file = "protoora.log". 
             
    OUTPUT STREAM logfile TO VALUE(output_file) NO-ECHO NO-MAP UNBUFFERED. 
    logfile_open = true. 
 
    IF pro_dbname = "" OR pro_dbname = ? THEN DO:
      PUT STREAM logfile UNFORMATTED "{&PRO_DISPLAY_NAME} Database name is required." SKIP.
      ASSIGN err-rtn = TRUE.
    END.
    ELSE DO:

        IF LDBNAME ("DICTDB") <> pro_dbname THEN DO:
          ASSIGN old-dictdb = LDBNAME("DICTDB").
          IF NOT CONNECTED(pro_dbname) THEN
            CONNECT VALUE (pro_dbname) VALUE (pro_conparms) -1 NO-ERROR.              
          
          IF ERROR-STATUS:ERROR OR NOT CONNECTED (pro_dbname) THEN DO:
            DO i = 1 TO  ERROR-STATUS:NUM-MESSAGES:
               PUT STREAM logfile UNFORMATTED ERROR-STATUS:GET-MESSAGE(i) skip.
            END.

            PUT STREAM logfile UNFORMATTED "Unable to connect to {&PRO_DISPLAY_NAME} database"
                skip.
            ASSIGN err-rtn = TRUE.
          END.
          ELSE 
            CREATE ALIAS DICTDB FOR DATABASE VALUE(pro_dbname).  
        END.
        ELSE
          ASSIGN old-dictdb = LDBNAME("DICTDB").
    END.
      
    IF loadsql THEN DO:
      IF Osh_dbname = "" OR osh_dbname = ? THEN DO:
         PUT STREAM logfile UNFORMATTED  "Schema holder Database Name is required." SKIP.   
         ASSIGN err-rtn = TRUE.        
      END.
      IF ora_dbname = "" OR ora_dbname = ? THEN DO:
         PUT STREAM logfile UNFORMATTED "Oracle Database Name is required." SKIP.   
         ASSIGN err-rtn = TRUE.
      END.
      IF ora_username = "" OR ora_username = ? THEN DO:
         PUT STREAM logfile UNFORMATTED "Oracle User Name is required." SKIP.   
         ASSIGN err-rtn = TRUE.
      END.
      IF ( ora_password = "" OR ora_password = ? ) AND 
         NOT ora_username BEGINS "/" THEN DO:
         PUT STREAM logfile UNFORMATTED "Oracle User Password is required." SKIP.   
         ASSIGN err-rtn = TRUE.
      END.
      IF (ora_conparms = "" OR ora_conparms = ?) AND
         (ora_sid = "" OR ora_sid = ? ) AND
         ((INDEX(ora_username, "@") = 0) OR (INDEX(ora_password, "@") = 0)) THEN DO:
         PUT STREAM logfile UNFORMATTED "Oracle connect parameters are required or ORACLE_SID must be set." SKIP.   
         ASSIGN err-rtn = TRUE.
      END.
    END.  
    IF err-rtn THEN RETURN.    
  END. 
  ASSIGN redo = TRUE.
  RUN prodict/ora/protoor1.p.
  IF RETURN-VALUE = "indb" THEN DO:
    ASSIGN redo = FALSE.
    UNDO, RETRY.
  END.
  ELSE IF RETURN-VALUE = "wrg-ver" THEN DO:
     ASSIGN wrg-ver = TRUE.

     IF batch_mode THEN DO:
        PUT STREAM logfile UNFORMATTED 
               "Unicode support for the DataServer for ORACLE was designed to work" SKIP
               "with ORACLE 9 and above. You have tried to connect to a prior" SKIP
               "version of ORACLE. " SKIP.
        OUTPUT STREAM logfile CLOSE.
        logfile_open = FALSE.
        RUN cleanup.
     END.

     UNDO main-blk, RETRY main-blk.
  END.
  
  ELSE IF RETURN-VALUE = "wrng-collat" THEN DO:
   ASSIGN wrng-collat = TRUE.

   IF batch_mode THEN DO:
      PUT STREAM logfile UNFORMATTED
             "Missing or invalid Oracle Language" SKIP.
      OUTPUT STREAM logfile CLOSE.
      logfile_open = FALSE.
      RUN cleanup.
   END.

   UNDO main-blk, RETRY main-blk.
  END.

  /*
   * If this is batch mode, make sure we close the output file we
   * opened above and clean up.
   */
  IF logfile_open
   THEN OUTPUT STREAM logfile CLOSE.
 
  IF CONNECTED (osh_dbname) THEN 
    DISCONNECT VALUE (osh_dbname).
 
  IF pro_dbname <> old-dictdb THEN DO:
    DISCONNECT VALUE(pro_dbname).
    IF old-dictdb NE ? THEN
       CREATE ALIAS DICTDB FOR DATABASE VALUE(old-dictdb).   
  END.

END.

/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* Created:  fernando 12/04/07

             Wrapper for ORACLE schema pull that can be executed in batch
             mode.
                  
                  
   Input: p_db_name   - logical name of schema image
          p_obj_name  - object name for object selection
          p_obj_owner - owner name for object selection
          p_obj_type  - type for object selection
          
          p_obj_* can be '*' to match all, a string or a string containing '*'
          (i.e. 'cust*').

          Database must already be connected and the user connected
          must have permissions to query the schema information.

  History:  
 
*/
 
{ prodict/ora/oravar.i NEW }
&SCOPED-DEFINE DATASERVER YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i NEW }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
{ prodict/user/uservar.i NEW}
&UNDEFINE DATASERVER

DEFINE NEW SHARED VARIABLE odb_username AS CHARACTER NO-UNDO.

define input parameter p_db_name       as character. 
DEFINE INPUT PARAMETER obj_name  AS CHAR.
DEFINE INPUT PARAMETER obj_owner  AS CHAR.
DEFINE INPUT PARAMETER obj_qualifier AS CHAR.

DEFINE VARIABLE p_database_type  AS CHAR NO-UNDO.
DEFINE VARIABLE p_user_name      AS CHAR NO-UNDO.

ASSIGN
user_env[2] = p_db_name 
user_env[1] = "upd"
p_user_name = "*".

FIND DICTDB._Db WHERE DICTDB._Db._Db-name = user_env[2].
ASSIGN p_database_type = DBTYPE(p_db_name).

CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(p_db_name) NO-ERROR.

ASSIGN
  user_env[3]   = p_database_type
  cache_dirty   = TRUE
  user_dbname   = user_env[2]
  user_dbtype   = p_database_type
  user_filename = ""
  drec_file     = ?
  drec_db       = RECID(DICTDB._Db)
  user_env[25]  = "AUTO".

/*
** Create objects in the schema holder to match objects in Oracle.
**
** We have to create the record in table s_ttb_link and the variables
** s_* below so that the link table logic in ora_lkm will work properly.
**
*/
do transaction:
    create s_ttb_link.
    assign
       s_ttb_link.level    = 0
       s_ttb_link.master   = ""
       s_ttb_link.name     = ""
       s_ttb_link.slctd    = true
       s_ttb_link.srchd    = false
       s_ttb_link.presel-n = obj_name
       s_ttb_link.presel-o = obj_owner 
       s_ttb_link.presel-t = obj_qualifier.
end. /* transaction */

assign
   s_level      = 0
   s_ldbname    = p_db_name
   s_master     = ""
   s_lnkname    = ""
   s_name-hlp   = "*"
   s_owner-hlp  = p_user_name 
   s_qual-hlp   = "*"
   s_type-hlp   = "*".

RUN prodict/ora/_ora_lkg.p.

find first gate-work NO-ERROR.
IF NOT AVAILABLE gate-work THEN DO:
    MESSAGE "No objects found.".
    RETURN.
END.

RUN prodict/ora/_ora_lks.p.

find first gate-work where gate-work.gate-slct = TRUE no-error.
IF NOT AVAILABLE gate-work THEN DO:
    MESSAGE "No objects selected to be pulled.".
    RETURN.
END.

RUN prodict/ora/_ora_pul.p. 
RUN prodict/gate/_gat_cro.p. 
/***********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

DEFINE OUTPUT PARAMETER j AS INTEGER NO-UNDO.

DEFINE VARIABLE h         AS INTEGER   NO-UNDO.

ASSIGN j = 0.

RUN STORED-PROC DICTDBG.send-sql-statement
    h = PROC-HANDLE NO-ERROR 
    ("select value from nls_database_parameters where parameter = 'NLS_RDBMS_VERSION' ").

IF NOT ERROR-STATUS:ERROR AND h <> ? THEN DO:
   FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = h:
       j = INTEGER(ENTRY(1,DICTDBG.proc-text-buffer.proc-text,".")).
   END.
   CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h. 
END.


/* Procedure getOwner
   We get called when oracle owner is null, so we check if we are using external
   authentication, in which case we try to get user name from database.
   Fix for OE00170689.
 */

DEFINE OUTPUT PARAMETER  ora_owner AS CHARACTER no-undo INIT ?.
DEFINE VARIABLE h         AS INTEGER   NO-UNDO.

   RUN STORED-PROC DICTDBG.send-sql-statement 
       h = PROC-HANDLE NO-ERROR 
       ("SELECT USER FROM DUAL").

   IF NOT ERROR-STATUS:ERROR AND h <> ? THEN DO: 
     FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = h:
           ora_owner = TRIM(proc-text).
     END.

     CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h.
   END. 

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _ora_crn - base constraints for oracle meta-schema 

   Modified:  kmayur 06/21/11 created 

*/

DEFINE INPUT PARAMETER dbkey AS RECID NO-UNDO.

FIND _Db WHERE RECID(_Db) = dbkey NO-LOCK NO-ERROR.

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_constraint" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_constraint"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "con$"
  _File._For-Owner   = "sys"
  _File._Last-change = 2146431
  _File._ianum       = 6
  _File._Hidden      = TRUE.

CREATE _Field. /* file: con$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "NAME"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = YES
  _Field._Format       = "x(30)"
  _Field._Decimal      = 30
  _Field._Order        = 10
  _Field._Fld-stdtype  = 4096
  _Field._Fld-stoff    = 1
  _Field._For-maxsize  = 30
  _Field._For-Name     = "NAME"
  _Field._For-Type     = "VarChar2".


CREATE _Field. /* file: con$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "CON#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "CON#"
  _Field._For-Type     = "number".

FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_cons" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_cons"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "cdef$"
  _File._For-Owner   = "sys"
  _File._Last-change = 2146431
  _File._ianum       = 6
  _File._Hidden      = TRUE.

CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "CON#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "CON#"
  _Field._For-Type     = "number".
  
CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "OBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "OBJ#"
  _Field._For-Type     = "number".  
  
CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "TYPE#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 30
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 3
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "TYPE#"
  _Field._For-Type     = "number".    


CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "ROBJ#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 40
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 4
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "ROBJ#"
  _Field._For-Type     = "number".

CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "RCON#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 50
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 5
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "RCON#"
  _Field._For-Type     = "number".

CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "CONDITION"
  _Field._Data-Type    = "character"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "x(32)"
  _Field._Decimals     = ?
  _Field._Order        = 60
  _Field._Fld-stdtype  = 16384
  _Field._Fld-stoff    = 6
  _Field._For-Maxsize  = 0
  _Field._For-Name = "CONDITION"
  _Field._For-Type = "long".

CREATE _Field. /* file: cdef$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "ENABLED"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = no
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 70
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 7
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "ENABLED"
  _Field._For-Type     = "number".
    
FIND _File
  WHERE _File._Db-recid = dbkey
    AND _File._File-name = "oracle_cons_fld" 
    AND _File._Owner = "_FOREIGN" NO-ERROR.
IF AVAILABLE _File THEN RETURN.

CREATE _File.
ASSIGN
  _File._Db-recid    = dbkey
  _File._File-name   = "oracle_cons_fld"
  _File._For-Type    = "TABLE"
  _File._For-Name    = "ccol$"
  _File._For-Owner   = "sys"
  _File._Last-change = 2146431
  _File._ianum       = 6
  _File._Hidden      = TRUE.

CREATE _Field. /* file: con$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "CON#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 10
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 1
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "CON#"
  _Field._For-Type     = "number".
  
CREATE _Field. /* file: con$ */
ASSIGN
  _Field._File-recid   = RECID(_File)
  _Field._Field-Name   = "COL#"
  _Field._Data-Type    = "integer"
  _Field._Initial      = ?
  _Field._Mandatory    = yes
  _Field._Format       = "->>>>>>>>>9"
  _Field._Order        = 20
  _Field._Fld-stdtype  = 8192
  _Field._Fld-stoff    = 2
  _Field._For-Maxsize  = 12
  _Field._For-Name     = "COL#"
  _Field._For-Type     = "number".  


RETURN.
/***********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/


{ prodict/ora/oravar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE ora_lang            AS CHARACTER  NO-UNDO.

Assign 
      ora_lang = UPPER( "'" +   ENTRY(1,user_env[41],"_") + "'" ).

DEFINE OUTPUT PARAMETER i AS INTEGER NO-UNDO.
DEFINE VARIABLE h         AS INTEGER   NO-UNDO.




RUN STORED-PROC DICTDBG.send-sql-statement
    h = PROC-HANDLE NO-ERROR 
    (" select  count (*)  from V$NLS_VALID_VALUES where PARAMETER ='SORT' 
    and VALUE  like " + ora_lang ).

IF NOT ERROR-STATUS:ERROR AND h <> ? THEN DO:
   FOR EACH DICTDBG.proc-text-buffer WHERE PROC-HANDLE = h:
       i = INTEGER(ENTRY(1,proc-text-buffer.proc-text,".")).
   END.
   
   CLOSE STORED-PROC DICTDBG.send-sql-statement WHERE PROC-HANDLE = h. 
   
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: _protoora.p

Description:   
   This file contains the user interface for the advanced migration 
   window for openEdge DB to ORACLE Server migration. 
 
Author: Kumar Mayur

Date Created: 01/05/2011 

History:


----------------------------------------------------------------------------*/


&Scoped-define FRAME-NAME DEFAULT-FRAME

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS mig_cnst TOGGLE-7 TOGGLE-8 TOGGLE-9 ~
RADIO-SET-5 TOGGLE-13 RADIO-SET-6 BUTTON-1 BUTTON-2 BUTTON-3 
&Scoped-Define DISPLAYED-OBJECTS mig_cnst TOGGLE-7 TOGGLE-8 TOGGLE-9 ~
RADIO-SET-5 TOGGLE-13 RADIO-SET-6 

/* Custom List Definitions                                              */
/* List-1,List-2,List-3,List-4,List-5,List-6                            */

/* ***********************  Control Definitions  ********************** */

{ prodict/user/uservar.i }
{ prodict/ora/oravar.i  }

DEFINE VARIABLE tmp_str       AS CHARACTER                NO-UNDO.
DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.

batch_mode = SESSION:BATCH-MODE.
/* Definitions of the field level widgets                               */
DEFINE BUTTON butt-ok
     LABEL "OK" 
     SIZE 10 BY 1.

DEFINE BUTTON butt-cancel
     LABEL "Cancel" 
     SIZE 10 BY 1.

DEFINE BUTTON butt-help 
     LABEL "Help" 
     SIZE 10 BY 1.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  SIZE 74 BY 3.1.     
     &ELSE SIZE 75 BY 4.5 . &ENDIF.
     
DEFINE RECTANGLE RECT-2
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  SIZE 74 BY 3.1.    
     &ELSE SIZE 75 BY 4.5. &ENDIF.

&IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL FGCOLOR 7
     SIZE 74 BY 1.4. 
&ENDIF.

DEFINE VARIABLE cFormat    AS CHARACTER 
                           INITIAL "For field widths use:"
                           FORMAT "x(21)" NO-UNDO.
DEFINE VARIABLE dFormat    AS CHARACTER 
                           INITIAL "Create case insensitive fields with:"
                           FORMAT "x(37)" NO-UNDO.   
DEFINE VARIABLE Cuniq      AS CHARACTER 
                           INITIAL "Apply Uniqueness as:"
                           FORMAT "x(21)" NO-UNDO.
		   
DEFINE VARIABLE s_res          AS LOGICAL                  NO-UNDO.
DEFINE VARIABLE disp_msg1      AS LOGICAL INITIAL TRUE     NO-UNDO.
DEFINE VARIABLE disp_msg2      AS LOGICAL INITIAL TRUE     NO-UNDO.

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME DEFAULT-FRAME    
     
     pcompatible view-as toggle-box LABEL "Create RECID Field " AT 3  SKIP({&VM_WID})
     unicodeTypes view-as toggle-box label "Use Unicode Types " AT 3
     lCharSemantics VIEW-AS TOGGLE-BOX LABEL "Char semantics" AT 53 SKIP({&VM_WID})
     
     cFormat VIEW-AS TEXT NO-LABEL AT 3
     iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                             "ABL Format", 2
                               HORIZONTAL NO-LABEL SKIP({&VM_WID})
     lExpand VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30" AT 46 SKIP({&VM_WIDG})
     
     dFormat VIEW-AS TEXT NO-LABEL AT 3 SKIP({&VM_WID})
     iShadow VIEW-AS RADIO-SET RADIO-BUTTONS "Function-Based Index", 1,
                                             "Shadow Column", 2
                               HORIZONTAL NO-LABEL  AT 10 SKIP({&VM_WID})
     nls_up view-as toggle-box LABEL "Use Linguistic Sorting" AT 3
     
     oralang FORMAT "x({&PATH_WIDG})"  view-as fill-in  size 15 by 1 
     LABEL "Sort Name"      
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN AT ROW 6.5 COL 30  SKIP({&VM_WIDG})SKIP({&VM_WIDG})
     &ELSE AT 30 SKIP({&VM_WIDG}) SKIP({&VM_WIDG}) &ENDIF   

     migconstraint view-as toggle-box LABEL "Migrate Constraints" AT 3 SKIP({&VM_WID})

     Cuniq VIEW-AS TEXT NO-LABEL AT 3 
     choiceUniquness VIEW-AS RADIO-SET RADIO-BUTTONS
                                "Index Attributes","1",
                                "Constraints","2"
                                HORIZONTAL NO-LABEL SKIP({&VM_WID})
     crtdefault VIEW-AS TOGGLE-BOX LABEL "Include Default" AT 3 SKIP({&VM_WIDG}) SKIP({&VM_WID})
     butt-ok AT 3 
     butt-cancel AT 14
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
         butt-help AT 26
     &ENDIF              
     
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN RECT-1 AT ROW 4.7 COL 2   
     &ELSE RECT-1 AT ROW 4.5 COL 2 &ENDIF      
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-2 AT ROW 8.2 COL 2   
     &ELSE RECT-2 AT ROW 9.5 COL 2 &ENDIF
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-3 AT ROW 11.5 COL 2 &ENDIF       
     
     WITH 1 DOWN  KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
     VIEW-AS DIALOG-BOX TITLE "OpenEdge DB to ORACLE Conversion Advanced Options".


ON CHOOSE OF butt-ok IN FRAME DEFAULT-FRAME 
DO:
  IF oralang:SCREEN-VALUE = "BINARY" AND nls_up:SCREEN-VALUE = "YES" THEN
         MESSAGE 'In order to use a BINARY sort name, uncheck the "Use Linguistic Sorting" checkbox'  view-as alert-box . 
  ELSE DO: 
    Assign pcompatible = (pcompatible:SCREEN-VALUE = "yes").
    Assign migConstraint =  (migConstraint:SCREEN-VALUE = "yes").
    Assign unicodeTypes = (unicodeTypes:SCREEN-VALUE = "yes" ).
    ASSIGN choiceUniquness = choiceUniquness:screen-value.
    ASSIGN iShadow         = INTEGER(iShadow:screen-value).     
    ASSIGN lCharSemantics = (lCharSemantics:SCREEN-VALUE = "yes").
    ASSIGN crtdefault = (crtdefault:SCREEN-VALUE = "YES").
    Assign nls_up = (nls_up:SCREEN-VALUE = "yes").
	ASSIGN lExpand = (lExpand:SCREEN-VALUE = "yes" ).

    oralang = IF oralang:screen-value = "" THEN "" ELSE oralang:screen-value.    
    IF unicodeTypes = TRUE 
    THEN
         ASSIGN ora_varlen = 2000. 
    ELSE 
         ASSIGN ora_varlen = 4000.
           
    IF iFmtOption:SCREEN-VALUE = "1" THEN
      ASSIGN lFormat = ?
             iFmtOption = 1.
    ELSE 
      ASSIGN lFormat = (NOT lExpand)
             iFmtOption = 2.

    IF ora_version >= 9 THEN DO: 
        IF unicodeTypes:SCREEN-VALUE = "yes" THEN
           ASSIGN unicodeTypes = YES.
        IF lCharSemantics:SCREEN-VALUE = "yes" THEN
           ASSIGN lCharSemantics = YES.
    END.
    ELSE
        ASSIGN unicodeTypes = NO
               lCharSemantics = NO.  
   
   APPLY "CLOSE":U TO THIS-PROCEDURE.
   APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
  END. 
END.
   
ON CHOOSE OF butt-cancel in frame DEFAULT-FRAME 
DO:  
   APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
END.

ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME 
DO:
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
END. 

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME DEFAULT-FRAME OR CHOOSE OF butt-help IN FRAME DEFAULT-FRAME
 DO:   
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&OpenEdge_DB_to_ORACLE_Advanced_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

ON VALUE-CHANGED OF unicodeTypes IN FRAME DEFAULT-FRAME DO:

    IF SELF:screen-value = "yes" THEN DO:
        ASSIGN lCharSemantics:SENSITIVE = NO
               lCharSemantics:SCREEN-VALUE = "NO"
               lcsemantic = FALSE.
        IF disp_msg1 = TRUE THEN DO:

            ASSIGN disp_msg1 = FALSE.

            MESSAGE "The maximum char length default value is assuming AL16UTF16 encoding for the national" SKIP
                    "character set on the ORACLE database. For UTF8 encoding, you may have to set it to a" SKIP
                    "lower value depending on the data."
                VIEW-AS ALERT-BOX WARNING BUTTONS OK.
        END.
    END.
    ELSE DO:
        ASSIGN lCharSemantics:SENSITIVE = YES.

    END.
END.


ON VALUE-CHANGED OF iFmtOption IN FRAME DEFAULT-FRAME DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lExpand:CHECKED   = FALSE
           lExpand:SENSITIVE = FALSE
           lFormat           = ?.
  ELSE
    ASSIGN lExpand:CHECKED   = TRUE
           lExpand:SENSITIVE = TRUE
           lFormat           = FALSE.
END.        

ON VALUE-CHANGED OF iShadow IN FRAME DEFAULT-FRAME DO:
  IF SELF:SCREEN-VALUE = "1" THEN DO:
    ASSIGN nls_up:SENSITIVE  = TRUE.
    IF oralang:SCREEN-VALUE = "BINARY" THEN oralang:SENSITIVE = FALSE.
    ELSE oralang:SENSITIVE = TRUE.
  
  END.
  ELSE DO:
    ASSIGN nls_up:SCREEN-VALUE = "no"
    	   nls_up:SENSITIVE  = FALSE
           oralang:SCREEN-VALUE = "BINARY"
           oralang:SENSITIVE = FALSE.
  END.         
END.   

ON VALUE-CHANGED OF nls_up IN FRAME DEFAULT-FRAME DO:
   IF SELF:SCREEN-VALUE = "yes" THEN DO:
    ASSIGN oralang:SENSITIVE = TRUE
           oralang:SCREEN-VALUE = "".
  END.
  ELSE
    ASSIGN oralang:SCREEN-VALUE = "BINARY"
           oralang:SENSITIVE = FALSE.
END.   

ON LEAVE OF oralang IN FRAME DEFAULT-FRAME DO:
  IF SELF:SCREEN-VALUE = "BINARY" THEN DO:
   MESSAGE 'In order to use a BINARY sort name, uncheck the "Use Linguistic Sorting" checkbox'  view-as alert-box . 

   END.
END.

IF NOT batch_mode THEN 
_updtvar: 
  DO WHILE TRUE:
  ASSIGN oralang:SCREEN-VALUE in frame DEFAULT-FRAME = oralang.
  DISPLAY  cFormat dFormat Cuniq WITH FRAME DEFAULT-FRAME.
  UPDATE
        pcompatible     
        lCharSemantics WHEN lcsemantic = TRUE
        unicodeTypes WHEN  uctype = TRUE
        iFmtOption
        lExpand WHEN iFmtOption = 2
        iShadow
        nls_up WHEN iShadow = 1
        oralang WHEN nls_up
        migConstraint
        choiceUniquness
        crtdefault
        butt-ok butt-cancel
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
            butt-help
        &ENDIF               	        
        WITH FRAME DEFAULT-FRAME. 

    IF nls_up:SCREEN-VALUE in frame DEFAULT-FRAME = "YES" 
    THEN DO:
        IF oralang:SCREEN-VALUE in frame DEFAULT-FRAME = "BINARY" THEN DO:
              MESSAGE 'In order to use a BINARY sort name, uncheck the "Use Linguistic Sorting" checkbox'  view-as alert-box . 
              next _updtvar.
        END.      
        ELSE DO:
           ASSIGN  oralang =  oralang:SCREEN-VALUE in frame DEFAULT-FRAME. 
           LEAVE _updtvar. 
        END.
    END.
    ELSE LEAVE _updtvar.         
 END.

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _orc_act.p

Description:   
   This file contains the form for activation and deactivation of Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/admnhlp.i }
{prodict/user/uservar.i}

DEFINE {1} BUTTON OK_BUT  
     LABEL "OK" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CANCEL_BUT 
     LABEL "Cancel" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON HELP_BUT 
     LABEL "Help" 
     SIZE 13 BY 1.
     
&IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL FGCOLOR 7
     SIZE 53 BY 1.4. 
&ENDIF.
     
DEFINE VARIABLE RADIO-SET-1 AS char 
     VIEW-AS RADIO-SET HORIZONTAL
     RADIO-BUTTONS 
          "Activate", "1",
          "Deactivate", "2"
     SIZE 32 BY 1.91 NO-UNDO.
     
DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     LABEL "Constraint type  ." 
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "ALL","PRIMARY","UNIQUE","FOREIGN KEY","CHECK" 
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.
  

DEFINE FRAME DEFAULT-FRAME
     RADIO-SET-1 AT ROW 1.4 COL 4 NO-LABEL WIDGET-ID 2
     Constrainttype AT ROW 4.05 COL 20 COLON-ALIGNED WIDGET-ID 6
     OK_BUT AT ROW 6.5 COL 3 WIDGET-ID 8
     CANCEL_BUT AT ROW 6.5 COL 17 WIDGET-ID 10
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  HELP_BUT AT ROW 6.5 COL 40 &ENDIF
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-1 AT ROW 6.3 COL 2 &ENDIF  
     WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 57 BY 10.05 WIDGET-ID 100
     VIEW-AS DIALOG-BOX TITLE "Activate/Deactivate Constraint Definitions".


ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
END.

ON CHOOSE OF OK_BUT IN FRAME DEFAULT-FRAME
  DO:    
      IF user_dbtype    NE "oracle" then 
	   RUN SAVE.
	   RUN CHECK_DEL.	  
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.
  
ON CHOOSE OF CANCEL_BUT IN FRAME DEFAULT-FRAME
  DO:     
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.   
  
/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME DEFAULT-FRAME OR CHOOSE OF HELP_BUT IN FRAME DEFAULT-FRAME
 DO:   
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&DataServer_Activate_Deactivate_Constraint_Definitions_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF 
RADIO-SET-1 = RADIO-SET-1:screen-value.

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.


PROCEDURE enable_UI :

  DISPLAY Constrainttype RADIO-SET-1 OK_BUT CANCEL_BUT 
  WITH FRAME DEFAULT-FRAME.
  ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL".
  ENABLE Constrainttype RADIO-SET-1 OK_BUT CANCEL_BUT 
          &IF "{&WINDOW-SYSTEM}" <> "TTY"
          &THEN HELP_BUT  
          &ENDIF          
      WITH FRAME DEFAULT-FRAME.
 
END PROCEDURE.

PROCEDURE SAVE:
    
   IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL"  THEN
   DO:
       FOR EACH DICTDB._constraint EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN 
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
    
   IF  Constrainttype:SCREEN-VALUE="PRIMARY"  THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "P" OR DICTDB._constraint._con-type = "PC" 
                     OR DICTDB._constraint._con-type = "MP" :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN   
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.  
     
   IF Constrainttype:SCREEN-VALUE= "UNIQUE" THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "U" EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
    
   IF Constrainttype:SCREEN-VALUE= "CHECK"  THEN
   DO:
       FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "C" EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
    
   IF Constrainttype:SCREEN-VALUE= "FOREIGN KEY"  THEN 
   DO:
       FOR EACH DICTDB._constraint WHERE  DICTDB._constraint._con-type = "F"  EXCLUSIVE-LOCK :
          IF RADIO-SET-1:screen-value = "1" THEN         
	          assign DICTDB._constraint._con-active = true.
         
          ELSE IF RADIO-SET-1:screen-value = "2" THEN  
	          assign DICTDB._constraint._con-active = False.
	   END.
   END.
   
END PROCEDURE.

PROCEDURE CHECK_DEL:

    FOR EACH DICTDB._constraint WHERE ( DICTDB._constraint._Con-Status = "O" OR  DICTDB._constraint._Con-Status = "D"):
        ASSIGN DICTDB._constraint._con-active = False.
    END.    
END.

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _orc_del.p

Description:   
   This file contains the form for the deletion of Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/admnhlp.i }

DEFINE BUTTON OK_BUT 
     LABEL "OK" 
     SIZE 13 BY 1.

DEFINE BUTTON CANCEL_BUT 
     LABEL "Cancel" 
     SIZE 13 BY 1.

DEFINE BUTTON HELP_BUT 
     LABEL "Help" 
     SIZE 13 BY 1.

&IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 1 GRAPHIC-EDGE  NO-FILL FGCOLOR 7
     SIZE 53 BY 1.4. 
&ENDIF.

DEFINE VARIABLE ans AS logical.
DEFINE STREAM   constlog.
DEFINE VARIABLE cnstrpt_name       AS CHARACTER   NO-UNDO.
DEFINE BUFFER   CON_DICTDB         FOR DICTDB._Constraint.

DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     LABEL "Constraint type  ." 
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "ALL","PRIMARY","UNIQUE","FOREIGN KEY","CHECK"
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.

DEFINE FRAME DEFAULT-FRAME
   
     Constrainttype AT ROW 2 COL 20 COLON-ALIGNED WIDGET-ID 6
     OK_BUT  AT ROW 5.5 COL 3 WIDGET-ID 8
     CANCEL_BUT AT ROW 5.5 COL 17 WIDGET-ID 10
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  HELP_BUT AT ROW 5.5 COL 40 &ENDIF  
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN  RECT-1 AT ROW 5.3 COL 2 &ENDIF  
     WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         SIZE 57 BY 8.05 WIDGET-ID 100
     VIEW-AS DIALOG-BOX TITLE "Delete Constraint Definitions".

ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
END.

ON CHOOSE OF OK_BUT IN FRAME DEFAULT-FRAME
  DO:          
	   RUN SAVE.
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.
  
ON CHOOSE OF CANCEL_BUT IN FRAME DEFAULT-FRAME
  DO:     
       APPLY "END-ERROR" TO FRAME DEFAULT-FRAME .
  END.   


/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME DEFAULT-FRAME OR CHOOSE OF HELP_BUT IN FRAME DEFAULT-FRAME
 DO:   
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&ORACLE_DataServer_Delete_Constraints_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
END.


PROCEDURE enable_UI :
  DISPLAY  Constrainttype 
      WITH FRAME DEFAULT-FRAME.
      ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL".
  
  ENABLE Constrainttype OK_BUT CANCEL_BUT 
          &IF "{&WINDOW-SYSTEM}" <> "TTY"
          &THEN HELP_BUT  
          &ENDIF            
      WITH FRAME DEFAULT-FRAME.
 
END PROCEDURE.

PROCEDURE SAVE:

ASSIGN cnstrpt_name = "constraint.lg".
OUTPUT STREAM constlog TO VALUE(cnstrpt_name) UNBUFFERED APPEND NO-ECHO NO-MAP.

  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "ALL"  
  THEN DO :
    MESSAGE "Are you sure you want to delete all constraints from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
        FOR EACH DICTDB._constraint WHERE (DICTDB._constraint._con-type <> "D" AND DICTDB._constraint._con-type <> "M") EXCLUSIVE-LOCK :
            DELETE DICTDB._constraint.
	    END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "PRIMARY"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Primary constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "PC" 
              OR DICTDB._constraint._con-type = "P" OR DICTDB._constraint._con-type = "MP" EXCLUSIVE-LOCK :
            IF CAN-FIND (FIRST CON_DICTDB WHERE CON_DICTDB._Index-Parent-Recid = DICTDB._Constraint._Index-Recid 
                        AND (CON_DICTDB._Con-Status <> "O" AND CON_DICTDB._Con-Status <> "D"))
            THEN          
              PUT STREAM constlog UNFORMATTED " cannot delete constraint " + DICTDB._constraint._con-Name + " as it is referenced by a foreign key"  SKIP.
            ELSE   
	          DELETE DICTDB._constraint.
         END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "UNIQUE"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Unique constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "U" EXCLUSIVE-LOCK :
            IF CAN-FIND (FIRST CON_DICTDB WHERE CON_DICTDB._Index-Parent-Recid = DICTDB._Constraint._Index-Recid 
                     AND (CON_DICTDB._Con-Status <> "O" OR CON_DICTDB._Con-Status <> "D"))
            THEN          
              PUT STREAM constlog UNFORMATTED " cannot delete constraint " + DICTDB._constraint._con-Name + " as it is referenced by a foreign key"  SKIP.
            ELSE   
	          DELETE DICTDB._constraint.
         END.
  END. 

  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "CHECK"
  THEN DO :
    MESSAGE "Are you sure you want to delete all Check constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "C" EXCLUSIVE-LOCK :
	         DELETE DICTDB._constraint.
         END.
  END.
  
  IF  Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME = "FOREIGN KEY"
  THEN DO:
    MESSAGE "Are you sure you want to delete all Foreign constraint(s) from database ?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO  update ans.
      IF ans = YES THEN
         FOR EACH DICTDB._constraint WHERE DICTDB._constraint._con-type = "F" EXCLUSIVE-LOCK :
	         DELETE DICTDB._constraint.
         END.
  END. 
OUTPUT STREAM constlog  CLOSE.  
END./*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _orc_viw.p

Description:   
   This file contains form for View Maintain Foreign Constraints in Oracle.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/user/uservar.i }
{prodict/ora/key/viewmnt.i NEW}

Define var access as logical NO-UNDO.
Define FRAME frame_const. 
Define {1} var sTbLbl2          as char NO-UNDO init "Tables".
Define {1} var cnstLbl2       as char NO-UNDO INIT "Constraints" .
Define {1} var TblRecId         as recid    NO-UNDO. 
Define {1} var Show_Hidden_Tbls as logical init no  NO-UNDO.

DEFINE BUFFER   CON_DICTDB         FOR DICTDB._Constraint.

DEFINE BUTTON btnCreate 
     LABEL "C&reate Constraint..." 
     SIZE 22 BY 1.3.

DEFINE BUTTON btnProps  
     LABEL "Constraint &Properties..." 
     SIZE 24 BY 1.3.

DEFINE BUTTON s_btnDelete  
     LABEL "De&lete Constraint" 
     SIZE 22 BY 1.3.

DEFINE VARIABLE is_error    AS LOGICAL.
DEFINE VARIABLE c_lst_Cnsts AS CHARACTER.
DEFINE VARIABLE c_lstTbls   AS CHARACTER.
DEFINE VARIABLE tbl_fill    AS CHARACTER FORMAT "X(256)":U.
DEFINE VARIABLE cnst_fill   AS CHARACTER FORMAT "X(256)":U.

DEFINE FRAME frame_const
     sTbLbl2  AT ROW 2 COL 7  NO-LABEL format "x(28)" view-as TEXT
     cnstLbl2 AT ROW 2 COL 46 NO-LABEL format "x(28)" view-as TEXT
     tbl_fill AT ROW 2.7 COL 7 NO-LABEL VIEW-AS FILL-IN SIZE 28 BY .9
     c_lstTbls AT ROW 3.86 COL 7 NO-LABEL VIEW-AS SELECTION-LIST SIZE 28 BY 6 SINGLE 
                                   SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL 
     cnst_fill AT ROW 2.7 COL 46 NO-LABEL VIEW-AS FILL-IN SIZE 28 BY .9
     c_lst_Cnsts AT ROW 3.86 COL 46 NO-LABEL VIEW-AS SELECTION-LIST SINGLE 
                                   SCROLLBAR-HORIZONTAL SCROLLBAR-VERTICAL SIZE 28 BY 6
     btnCreate AT ROW 12 COL 4 WIDGET-ID 20
     btnProps AT ROW 12 COL 28.5 WIDGET-ID 22
     s_btnDelete AT ROW 12 COL 55 WIDGET-ID 24
     
    WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 3 ROW 1
         SIZE 80 BY 16
         view-as DIALOG-BOX TITLE "View/Maintain Foreign Constraint Definitions" .
      
assign cnstLbl2:screen-value in FRAME frame_const = cnstLbl2.
assign sTbLbl2:screen-value in FRAME frame_const = sTbLbl2  .

ON CHOOSE OF btnCreate IN FRAME frame_const
   DO:
      IF NOT is_error THEN DO:
          IF c_table_name = "" OR c_table_name = "?" THEN MESSAGE "No table selected, please select a table" VIEW-AS ALERT-BOX ERROR.
          ELSE DO:
              FIND FIRST DICTDB._index OF DICTDB._file WHERE DICTDB._file._file-name = c_table_name 
                                                            AND DICTDB._File._Db-Recid = DbRecid NO-LOCK NO-ERROR. 
              IF DICTDB._Index._Index-name = "default" THEN 
                          MESSAGE " An index is required before creating a constraint, create an index before proceeding" VIEW-AS ALERT-BOX ERROR.
              ELSE RUN prodict/ora/key/constraint.p.    
          END.
          RUN fill_constraint.
       END. 
       ELSE MESSAGE "Please select a valid table" VIEW-AS ALERT-BOX ERROR.         
   END.

ON CHOOSE OF btnProps IN FRAME frame_const 
   DO:
      IF NOT is_error THEN DO:
          constr_name = cnst_fill:screen-value.
          IF constr_name = "" OR constr_name = "?" THEN MESSAGE "No constraint selected, please select a constraint" VIEW-AS ALERT-BOX ERROR.
          ELSE RUN prodict/ora/key/modcons.p.
          RUN fill_constraint.
      END. 
      ELSE MESSAGE "Please select a valid constraint" VIEW-AS ALERT-BOX ERROR.         
   END.       

ON CHOOSE OF s_btnDelete IN FRAME frame_const 
   DO:
      IF NOT is_error THEN DO:
          constr_name = cnst_fill:screen-value.
          IF constr_name = "" OR constr_name = "?" THEN MESSAGE "No constraint selected, please select a constraint" VIEW-AS ALERT-BOX ERROR.
          ELSE RUN prodict/mss/key/del_con.p.
          RUN fill_constraint.
       END.
       ELSE MESSAGE "Please select a valid constraint" VIEW-AS ALERT-BOX ERROR.  
   END.                

ON WINDOW-CLOSE OF FRAME frame_const
   DO:
        APPLY "END-ERROR" TO FRAME frame_const.
   END.

ON VALUE-CHANGED OF c_lstTbls  IN FRAME frame_const
   DO:
       RUN fill_constraint.
   END.


ON LEAVE OF cnst_fill IN FRAME frame_const
DO:
   define var lst_val as char NO-UNDO.
    
   lst_val = c_lst_Cnsts:screen-value IN FRAME frame_const.
   IF lst_val = ? THEN ASSIGN lst_val="".
   IF lst_val BEGINS SELF:screen-value THEN DO:
      cnst_fill:screen-value IN FRAME frame_const = lst_val.
      is_error = FALSE.
   END.   
   ELSE DO:
       is_error = TRUE.
   END.    
END.

ON VALUE-CHANGED OF c_lstTbls IN FRAME frame_const
DO:
   /* Reflect selection in fill-in. */
   IF SELF:screen-value = ? THEN
      Tbl_Fill:screen-value IN FRAME frame_const = "".
   ELSE 
      Tbl_Fill:screen-value in  FRAME frame_const = SELF:screen-value.
   ASSIGN is_error = FALSE.   
   RUN fill_constraint.
END.

ON VALUE-CHANGED OF c_lst_Cnsts  IN FRAME frame_const
DO:
   /* Reflect selection in fill-in. */
   IF SELF:screen-value = ? THEN
      cnst_fill:screen-value IN FRAME frame_const = "".
   ELSE 
      cnst_fill:screen-value in  FRAME frame_const = SELF:screen-value.
   ASSIGN is_error = FALSE.   
END.

PROCEDURE fill_constraint:
   c_table_name = c_lstTbls:screen-value IN FRAME frame_const.   
   c_lst_Cnsts:list-items IN FRAME frame_const = "".  
   FIND FIRST DICTDB._File WHERE DICTDB._File._File-Name =  c_table_name AND DICTDB._FIle._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE(DICTDB._File) THEN
   DO :
      TblRecId = RECID(DICTDB._File).
                    
       FOR EACH _constraint WHERE _File-recid = TblRecId AND _Constraint._Db-Recid = DbRecId NO-LOCK:
          IF (( _constraint._Con-Status = "N" OR _constraint._Con-Status = "C" OR _constraint._Con-Status = "M") 
          AND ( _constraint._Con-type = "C" OR _constraint._Con-type = "P" OR _constraint._Con-type = "MP" OR _constraint._Con-type = "PC"
           OR _constraint._Con-type = "U" OR _constraint._Con-type = "F"))
           THEN DO:
             IF _constraint._Con-type = "F" THEN DO:
               IF CAN-FIND (FIRST CON_DICTDB WHERE CON_DICTDB._Index-recid = _constraint._Index-parent-recid AND CON_DICTDB._Con-Type <> "U")
                 THEN c_lst_Cnsts:ADD-LAST(_constraint._con-name) IN FRAME frame_const.           
             END.
             ELSE c_lst_Cnsts:ADD-LAST(_constraint._con-name) IN FRAME frame_const.
           END.        
       END.	
   END.
     
   IF c_lst_Cnsts:NUM-ITEMS > 0 
   THEN cnst_fill = c_lst_Cnsts:entry(1) IN FRAME frame_const.
   ELSE cnst_fill = "".
   ASSIGN c_lst_Cnsts:screen-value IN FRAME frame_const = cnst_fill.
          cnst_fill:screen-value IN FRAME frame_const   = cnst_fill.
       
END PROCEDURE.

ON LEAVE OF tbl_fill IN FRAME frame_const
DO:
   define var lst_val as char NO-UNDO.
 
   /* If the value entered in the fill-in prefix-matches a value in the
      select list, reset it's value to be the full selection list value. 
      Otherwise, we'll leave it alone. */
   lst_val = c_lstTbls:screen-value IN FRAME frame_const.
   IF lst_val BEGINS SELF:screen-value THEN DO:
      tbl_fill:screen-value IN FRAME frame_const = lst_val.
      ASSIGN is_error = FALSE.
   END.   
   ELSE DO:
       ASSIGN is_error = TRUE.
   END.    
   RUN fill_constraint.
END.

{prodict/mss/key/fillin.i &Frame  = "FRAME frame_const"
                     &CBFill = "Tbl_Fill"
                     &CBList = "c_lstTbls"
                     &CBInit = """"}

{prodict/mss/key/fillin.i &Frame  = "FRAME frame_const"
                     &CBFill = "cnst_fill"
                     &CBList = "c_lst_Cnsts"
                     &CBInit = """"}
       
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
   RUN enable_UI.

   FIND FIRST DICTDB._Db WHERE DICTDB._Db._Db-Name = user_dbname NO-LOCK NO-ERROR.
   IF AVAILABLE (DICTDB._Db)
   THEN DO:
      assign DbRecId = RECID(DICTDB._Db)
             cDbType  = user_dbtype.
   END.
   ELSE DO:
      FIND LAST DICTDB._Db.
         ASSIGN DbRecId = RECID(DICTDB._Db)
                cDbType  = user_dbtype.
   END.
   run adecomm/_tbllist.p 
      	    (INPUT  c_lstTbls:HANDLE in frame frame_const,
      	     INPUT  Show_Hidden_Tbls,
      	     INPUT  DbRecId,
      	     INPUT  "",
             INPUT  " " , /* all foreign types allowed (hutegger 95/06) */
                   /* BUFFER,FUNCTION,PACKAGE,PROCEDURE,SEQUENCE,VIEW", */
      	     OUTPUT access).
   
   IF c_lstTbls:NUM-ITEMS > 0 THEN tbl_fill = c_lstTbls:entry(1) IN FRAME frame_const.
      c_lstTbls:screen-value IN FRAME frame_const = tbl_fill.
      tbl_fill:screen-value IN FRAME frame_const = tbl_fill.

   RUN fill_constraint.     
   IF cDbType = "ORACLE" OR cDbType = "MSS" THEN DO:
       DISABLE  s_btnDelete WITH FRAME frame_const.
       DISABLE  btnCreate WITH FRAME frame_const.
   END. 
     
   IF NOT THIS-PROCEDURE:PERSISTENT THEN
   WAIT-FOR CLOSE OF THIS-PROCEDURE. 
END.

PROCEDURE enable_UI :
  DISPLAY c_lst_Cnsts c_lstTbls tbl_fill cnst_fill
      WITH FRAME frame_const.
  ENABLE c_lst_Cnsts c_lstTbls btnCreate btnProps s_btnDelete tbl_fill cnst_fill
      WITH FRAME frame_const.
END PROCEDURE.

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: check.i

Description:   
   This file contains the form for creating check Constraints.

Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/unique.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-CHECK FOR 
      temp2 SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-CHECK
  QUERY BROWSE-CHECK NO-LOCK DISPLAY
      temp2.fld FORMAT "x(33)":U
      temp2.chk FORMAT "x(33)":U

  WITH NO-ROW-MARKERS SEPARATORS 
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN SIZE 75 BY 3.32 FIT-LAST-COLUMN.
  &ELSE SIZE 75 BY 6 FIT-LAST-COLUMN.
  &ENDIF
  /*    DEFINATION FOR CHECK FRAME  */  
&Scoped-define FRAME-NAME frame_check
&Scoped-define BROWSE-NAME BROWSE-CHECK
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHECK temp2.fld temp2.chk 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHECK 
&Scoped-define QUERY-STRING-BROWSE-CHECK FOR EACH temp2 NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-CHECK OPEN QUERY BROWSE-CHECK FOR EACH temp2 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHECK temp2
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHECK temp2

        
        DEF VAR chintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE chQuery AS HANDLE.
        DEFINE VARIABLE chBrowse AS HANDLE.
        DEFINE VARIABLE chBuffer AS HANDLE.
        DEFINE VARIABLE chField AS HANDLE.
        DEFINE VARIABLE chField1 AS HANDLE.
        DEFINE VARIABLE chField2 AS HANDLE.
        DEFINE VARIABLE chField3 AS HANDLE.
        
        chBrowse = BROWSE BROWSE-CHECK:HANDLE. /* Browse-3 is browser name */
        chQuery  = chBrowse:QUERY.
        chBuffer = chQuery:GET-BUFFER-HANDLE(1).    
    
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 2.6 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 6.3 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 7.1 COL 14 NO-LABEL
     VALIDATE AT ROW 9.2 COL 14 NO-LABEL
     DESC_EDIT AT ROW 11.8 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 14 COL 2 WIDGET-ID 4 NO-LABEL
    
     OK_BUT AT ROW 15 COL 3 WIDGET-ID 26
     CREATE_BUT AT ROW 15 COL 17 WIDGET-ID 28
     CANCEL_BUT AT ROW 15 COL 31 WIDGET-ID 30
     HELP_BUT AT ROW 15 COL 60 WIDGET-ID 32
     "Constraint" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.3 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.9 COL 2 WIDGET-ID 38 
     "Validation" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.4 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10 COL 2 WIDGET-ID 38
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12 COL 2 WIDGET-ID 38     

     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 15.14 WIDGET-ID 100.
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 3.2 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 9 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 10.4 COL 2 
     VALIDATE AT ROW 13.4 COL 2.3
     DESC_EDIT AT ROW 16.4 COL 2 WIDGET-ID 36
    
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30  
    
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 11.4 COL 2 WIDGET-ID 38
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 14.4 COL 2 WIDGET-ID 38
     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
    &ENDIF       
                          
 ASSIGN BROWSE-CHECK:COLUMN-RESIZABLE IN FRAME frame_check        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_check
  DO: 
     ASSIGN is-saved = FALSE.       
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
      RUN check_save.
      IF is-saved THEN
      APPLY "CLOSE":U TO THIS-PROCEDURE.
         RETURN NO-APPLY.                   
     END.             
  END.
ON CHOOSE OF CREATE_BUT IN FRAME frame_check
 DO:
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE RUN check_save.
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_check
  DO:     
     APPLY "CLOSE":U TO THIS-PROCEDURE.
     RETURN NO-APPLY.      
  END.  

ON VALUE-CHANGED OF BROWSE-CHECK IN FRAME frame_check
  DO:
     RUN Fetch_Check_Name.
  END. 

ON ENTRY OF name IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
 END.

ON ENTRY OF EXPRESSION IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
END. 
PROCEDURE Fetch_Check_Name:
 
  DO chintSub = 1 TO chBrowse:NUM-SELECTED-ROWS : 
     
     
     chBrowse:FETCH-SELECTED-ROW(chintSub).

     chField  = chBuffer:BUFFER-FIELD( "fld" ).
     chField1 = chBuffer:BUFFER-FIELD( "chk" ).
     chField2 = chBuffer:BUFFER-FIELD( "rec" ).
     chField3 = chBuffer:BUFFER-FIELD( "exp" ).

     ASSIGN Selected_Idx = chField:BUFFER-VALUE.
  
  END.
  ASSIGN VALIDATE:SCREEN-VALUE IN FRAME frame_check = chField3:BUFFER-VALUE. 
  ASSIGN EXPRESSION:SCREEN-VALUE IN FRAME frame_check = chField1:BUFFER-VALUE. 
run Create_Const_Name.
END PROCEDURE.  

PROCEDURE check :
     &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_check~
     ~{&OPEN-QUERY-BROWSE-CHECK}
          
     HIDE FRAME frame_foreign.   
     HIDE FRAME frame_primary. 
     HIDE FRAME frame_unique.
     VIEW FRAME frame_check. 
     DISPLAY NAME BROWSE-CHECK Active DESC_EDIT EXPRESSION  VALIDATE 
         &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
          WITH FRAME frame_check.
     ASSIGN Active:SCREEN-VALUE IN FRAME frame_check ="yes".
     ENABLE name BROWSE-CHECK Active DESC_EDIT EXPRESSION
         OK_BUT CREATE_BUT CANCEL_BUT 
         &IF "{&WINDOW-SYSTEM}" <> "TTY"
            &THEN HELP_BUT  
         &ENDIF
            WITH FRAME frame_check.
     {&OPEN-BROWSERS-IN-QUERY-frame_check}
     RUN Fetch_Check_Name.
END PROCEDURE.

PROCEDURE check_save:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_check 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:
      num = num + 1.
      CREATE DICTDB._Constraint.
      ASSIGN _Con-Type = "C"
             _Con-Name = name:SCREEN-VALUE IN FRAME frame_check
             _For-Name = "".
      IF ACTIVE:SCREEN-VALUE IN FRAME frame_check = "yes" 
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
      ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_check
             _File-recid = file_rec
             _Con-Status = "N"
             _Con-Expr = EXPRESSION:SCREEN-VALUE IN FRAME frame_check
             _Field-recid = chField2:BUFFER-VALUE
             _Con-Num = num
             _db-recid = DbRecId.
     RUN FILL_TEMP2.
     RUN check.
     &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
     ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="Constraint Created".  &ENDIF  
     ASSIGN is-saved = TRUE.           
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.     
END.  

PROCEDURE check_validate:
      FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Field-Recid = chField2:BUFFER-VALUE AND DICTDB._Constraint._Con-Type = "C"
      AND DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O" AND DICTDB._constraint._Db-Recid = DbRecid
      NO-LOCK NO-ERROR.
      IF AVAILABLE (DICTDB._Constraint)
      THEN DISABLE OK_BUT CREATE_BUT WITH FRAME frame_check.
      ELSE ENABLE OK_BUT CREATE_BUT WITH FRAME frame_check.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: constraint.i

Description:   
   This file contains the forms the base file for creation of Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/


{prodict/ora/key/viewmnt.i  }

DEFINE {1} TEMP-TABLE temp NO-UNDO
    FIELD ind AS CHAR LABEL "Index"
    FIELD pri AS CHAR LABEL "Primary"
    FIELD uni AS CHAR LABEL "Unique"
    FIELD man AS CHAR LABEL "All Columns Mandatory"
    FIELD rec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp2 NO-UNDO
    FIELD fld AS CHAR LABEL "Field"
    FIELD ini AS CHAR LABEL "Initial Value"
    FIELD chk AS CHAR LABEL "Constraint Expression"
    FIELD rec AS RECID LABEL "REC ID"
    FIELD cdf AS CHAR LABEL "Constraint Expression"
    FIELD exp AS CHAR LABEL "valid" .

DEFINE {1} TEMP-TABLE temp-parent NO-UNDO  
    FIELD ptb AS CHAR LABEL "Parent Table"
    FIELD pidx AS CHAR LABEL "Parent Index"
    FIELD prec AS RECID LABEL "REC ID".


DEFINE {1} TEMP-TABLE temp-parent1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "Number".
   

DEFINE {1} TEMP-TABLE temp-child NO-UNDO
    FIELD cidx AS CHAR LABEL "Child Index"
    FIELD crec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp-child1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "NUMBER".
      
    
DEFINE {1} VARIABLE  file_rec       AS RECID     NO-UNDO.
DEFINE {1} VARIABLE  mandatory      AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  A              AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  num            AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  Par_Idx        AS CHAR      NO-UNDO.
DEFINE {1} VARiable  Selected_Idx   AS CHAR      NO-UNDO.
DEFINE {1} VARIABLE  is-saved       AS LOGICAL   NO-UNDO INITIAL FALSE.

DEFINE {1} BUTTON OK_BUT  
     LABEL "&OK" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CREATE_BUT 
     LABEL "&Create" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CANCEL_BUT 
     LABEL "Ca&ncel" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON HELP_BUT 
     LABEL "&Help" 
     SIZE 13 BY 1.

DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Type." 
     &ELSE   LABEL "Constraint Type" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 4
     LIST-ITEMS "PRIMARY","UNIQUE","FOREIGN KEY","CHECK" 
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.

DEFINE VARIABLE child AS CHARACTER FORMAT "X(12)":U 
     LABEL "Child Table" 
     VIEW-AS FILL-IN 
     SIZE 14 BY .92 NO-UNDO.
     
DEFINE {1} VARIABLE EXPRESSION AS CHARACTER
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Constraint ."  
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Constraint." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF     

DEFINE {1} VARIABLE VALIDATE AS CHARACTER 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Validation ." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Validation." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF

DEFINE {1} VARIABLE DESC_EDIT AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 3 NO-UNDO.
     &ENDIF
     
DEFINE {1} VARIABLE DESC_EDIT2 AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 4.3 NO-UNDO.
     &ENDIF     


DEFINE {1} VARIABLE name AS CHARACTER FORMAT "X(80)":U 
     LABEL "Constraint &Name" 
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.

DEFINE {1} VARIABLE Active AS LOGICAL INITIAL no 
     LABEL "Active" 
     VIEW-AS TOGGLE-BOX
     SIZE 11 BY .81 NO-UNDO.
     
DEFINE {1} VARIABLE msg AS CHARACTER FORMAT "X(80)":U 
     LABEL ""
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.
     
DEFINE {1} VARIABLE Primary AS LOGICAL INITIAL no 
     LABEL "Primary" 
     VIEW-AS TOGGLE-BOX
     SIZE 13.4 BY .81 NO-UNDO.

Define {1} var s_Status as char  FORMAT "X(12)":U 
     LABEL "" 
          VIEW-AS FILL-IN 
     SIZE 13.4 BY .81 NO-UNDO.

DEFINE {1} FRAME DEFAULT-FRAME
   &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN Constrainttype AT ROW 1.4 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ELSE Constrainttype AT ROW 1.95 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ENDIF
   WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         &IF "{&WINDOW-SYSTEM}" <> "TTY"
         &THEN SIZE 82 BY 19 WIDGET-ID 100
         &ELSE SIZE 82 BY 24 WIDGET-ID 100
         &ENDIF
         
         VIEW-AS DIALOG-BOX 
         TITLE "Create Foreign Constraint Definition for " + c_table_name .
DEFINE {1} FRAME frame_primary.
DEFINE {1} FRAME frame_foreign.
DEFINE {1} FRAME frame_unique.
DEFINE {1} FRAME frame_check.


ASSIGN FRAME frame_primary:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_foreign:FRAME = FRAME DEFAULT-FRAME:HANDLE   
       FRAME frame_unique:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_check:FRAME = FRAME DEFAULT-FRAME:HANDLE.

ASSIGN num = 0.
FOR EACH DICTDB._Constraint WHERE DICTDB._constraint._Db-Recid = DbRecid:
    IF DICTDB._Constraint._Con-Num > num 
     THEN ASSIGN num = DICTDB._Constraint._Con-Num. 
END.

PROCEDURE TEMP1:

EMPTY TEMP-TABLE temp.

FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._File._Db-Recid = DbRecid NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND _Index._Wordidx <> 1 NO-LOCK:
       CREATE temp.
       ASSIGN ind = DICTDB._index._index-name.
              IF _unique = YES
              THEN ASSIGN uni = "I".
              IF DICTDB._File._Prime-Index = RECID(DICTDB._Index) 
              THEN ASSIGN pri = "I".
              A = RECID(DICTDB._index).
              FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Index-recid = A AND DICTDB._Constraint._Con-Status <> "D"
                                                   AND DICTDB._Constraint._Con-Status <> "O":
                            
                IF (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "PC")               
                   THEN DO:
                   IF pri <> "" THEN pri = pri + " , C".
                                     ELSE pri = "C".
                   END.
                IF (DICTDB._Constraint._Con-Type = "U")
                   THEN DO:
                   IF uni <> "" THEN uni = uni + " , C".
                                     ELSE uni = "C".  
                   END.
               END.    
              ASSIGN mandatory = 0.
              ASSIGN rec = RECID(DICTDB._index).
              FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid = A:
                  FIND FIRST DICTDB._Field where DICTDB._index-field._Field-Recid = RECID(DICTDB._Field).
                  IF DICTDB._Field._Mandatory = NO THEN ASSIGN mandatory = 1.
              END.
              IF mandatory = 0 THEN ASSIGN man = "  I".    
   END.
END.
END PROCEDURE.

PROCEDURE FILL_TEMP2:
EMPTY TEMP-TABLE temp2.
FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._File._Db-Recid = DbRecid NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._Field WHERE DICTDB._Field._file-recid = file_rec NO-LOCK:
      CREATE temp2.
      ASSIGN fld = DICTDB._Field._Field-Name
             ini = DICTDB._Field._Initial
             rec = RECID(DICTDB._Field)
             exp = DICTDB._Field._Valexp
             chk = "".
      A = RECID(DICTDB._Field).
      FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Field-Recid = A AND DICTDB._Constraint._Con-Type = "C"      
           AND DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O":
        IF AVAILABLE(DICTDB._Constraint)  
        THEN DO:
          IF chk = "" THEN  ASSIGN chk = DICTDB._Constraint._Con-Expr.
          ELSE  ASSIGN chk = chk + " ; " + DICTDB._Constraint._Con-Expr.  
        END.
      END.    
   END.
END.      
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: constraint.i

Description:   
   This file contains the form defination for creation of Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/ora/key/foreign.i }

&Scoped-define SELF-NAME Constrainttype

 
  ON VALUE-CHANGED OF Constrainttype IN FRAME DEFAULT-FRAME
  DO:
      RUN TEMP1.
      RUN FILL_TEMP2.
      IF Constrainttype:SCREEN-VALUE="PRIMARY" THEN
      DO:
         RUN primary.                 
      END.          
      
      IF Constrainttype:SCREEN-VALUE="FOREIGN KEY" THEN
      DO:
           RUN foreign.
      END. 
      
      IF Constrainttype:SCREEN-VALUE="UNIQUE" THEN
      DO:  
           RUN unique.
      END.

      IF Constrainttype:SCREEN-VALUE="CHECK" THEN
      DO:  
         RUN check.    
      END.      


  END.

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME frame_primary OR HELP OF FRAME frame_unique OR HELP OF FRAME frame_foreign  OR HELP OF FRAME frame_check
  OR CHOOSE of HELP_BUT IN FRAME frame_primary  OR CHOOSE of HELP_BUT IN FRAME frame_unique 
  OR CHOOSE of HELP_BUT IN FRAME frame_foreign  OR CHOOSE of HELP_BUT IN FRAME frame_check
 DO:
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&ORACLE_DatatServer_Create_Constraints_Dialog}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME frame_primary.
    APPLY "END-ERROR" TO FRAME frame_unique.
    APPLY "END-ERROR" TO FRAME frame_foreign.
    APPLY "END-ERROR" TO FRAME frame_check.
END.  

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enable_UI.
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
    
  ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.   
    
END.

PROCEDURE enable_UI :
  DISPLAY Constrainttype 
      WITH FRAME DEFAULT-FRAME.
  ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME ="PRIMARY".
  ENABLE Constrainttype 
      WITH FRAME DEFAULT-FRAME. 
  RUN TEMP1.
  RUN primary. 
 

END PROCEDURE.
           

PROCEDURE Create_Const_Name:
 DEF VAR L_Idx_Type as CHAR No-UNDO.
 DEF VAR N_Idx_Type as CHAR No-UNDO.
 DEF VAR L_Idx_Type1 as CHAR No-UNDO.
 DEF VAR N_Idx_Type1 as CHAR No-UNDO.
 L_Idx_Type = Constrainttype:screen-value in frame DEFAULT-FRAME.
 IF L_Idx_Type = "Primary" THEN
    Assign L_Idx_Type = "_PKC_"
           N_Idx_Type = "P".
           
  IF L_Idx_Type = "Unique" THEN
    Assign L_Idx_Type = "_UKC_"
           N_Idx_Type = "U".
 
   IF L_Idx_Type = "Check" THEN
    Assign L_Idx_Type = "_CC_"
           N_Idx_Type = "C".

   IF L_Idx_Type = "FOREIGN KEY" THEN
     Assign L_Idx_Type = "_FKC_"
           N_Idx_Type = "F".


 IF N_Idx_Type = "F" THEN 
    L_Idx_Type = L_Idx_Type +  Par_Idx + "-" + Selected_Idx + "-" + "idx".
 ELSE
    L_Idx_Type = L_Idx_Type + c_table_name + "-" + Selected_Idx + "-" + "idx". 
 IF N_Idx_Type = "P" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_primary = L_Idx_Type.
  
 IF N_Idx_Type = "U" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_unique = L_Idx_Type.
   
 IF N_Idx_Type = "C" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_check = L_Idx_Type. 
  
  IF N_Idx_Type = "F" THEN
   ASSIGN name:SCREEN-VALUE IN FRAME frame_foreign = L_Idx_Type. 
   
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="".
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="".
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="".  
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="".   
  &ENDIF
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: foreign.i

Description:   
   This file contains the form for Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/check.i }

/* Query definitions                                                    */
DEFINE {1} VARIABLE modf AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Action." 
     &ELSE   LABEL "Con Action" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "NONE","CASCADE","SET NULL" 
     DROP-DOWN-LIST
     SIZE 19 BY 1 NO-UNDO.
     
DEFINE  VARIABLE counter AS INTEGER NO-UNDO.
DEFINE  VARIABLE flg     AS LOGICAL NO-UNDO.
DEFINE {1} QUERY BROWSE-PAR FOR 
      temp-parent SCROLLING.

DEFINE {1} QUERY BROWSE-PAR1 FOR 
      temp-parent1 SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD FOR 
      temp-child SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD1 FOR 
      temp-child1 SCROLLING.

/* Browse definitions                                                   */

DEFINE {1} BROWSE BROWSE-PAR
    QUERY BROWSE-PAR NO-LOCK DISPLAY
       temp-parent.ptb  FORMAT "x(14)":U
       temp-parent.pidx FORMAT "x(14)":U
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

 DEFINE BROWSE BROWSE-PAR1
    QUERY BROWSE-PAR1 NO-LOCK DISPLAY
       temp-parent1.idxn FORMAT "x(13)":U
       temp-parent1.ctyp FORMAT "x(8)":U
       temp-parent1.fldl 
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD
    QUERY BROWSE-CHILD NO-LOCK DISPLAY
       temp-child.cidx FORMAT "x(30)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD1
    QUERY BROWSE-CHILD1 NO-LOCK DISPLAY
       temp-child1.idxn FORMAT "x(13)":U
       temp-child1.ctyp FORMAT "x(8)":U
       temp-child1.fldl   
    
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

&Scoped-define FRAME-NAME frame_foreign 

/* Definitions for BROWSE BROWSE-PAR                                      */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR temp-parent.ptb temp-parent.pidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR 
&Scoped-define QUERY-STRING-BROWSE-PAR FOR EACH temp-parent NO-LOCK. 
&Scoped-define OPEN-QUERY-BROWSE-PAR OPEN QUERY BROWSE-PAR FOR EACH temp-parent NO-LOCK .
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR temp-parent
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR temp-parent




/* Definitions for BROWSE BROWSE-PAR1                                     */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR1
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR1  temp-parent1.idxn temp-parent1.ctyp temp-parent1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR1
&Scoped-define QUERY-STRING-BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-PAR1 OPEN QUERY BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR1 temp-parent1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR1 temp-parent1


/* Definitions for BROWSE BROWSE-CHILD                                      */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD temp-child.cidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD 
&Scoped-define QUERY-STRING-BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD OPEN QUERY BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD temp-child
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD temp-child

/* Definitions for BROWSE BROWSE-CHILD1                                     */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD1  temp-child1.idxn  temp-child1.ctyp temp-child1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD1 
&Scoped-define QUERY-STRING-BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD1  OPEN QUERY BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD1  temp-child1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD1  temp-child1
  

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.1 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.1 COL 43 WIDGET-ID 300
     BROWSE-CHILD AT ROW 7.6 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 7.6 COL 43 WIDGET-ID 500   
     child AT ROW 6.6 COL 12 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 11.4 COL 2 WIDGET-ID 40
     modf   AT ROW 11.3 COL 43
     DESC_EDIT AT ROW 12.4 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 14.4 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 15.3 COL 3
     CREATE_BUT AT ROW 15.3 COL 17
     CANCEL_BUT AT ROW 15.3 COL 31
     HELP_BUT AT ROW 15.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12.6 COL 2 WIDGET-ID 38
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.3 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 6.7 COL 43 WIDGET-ID 600                  
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
              
     &ELSE
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.4 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.4 COL 39 WIDGET-ID 300
     BROWSE-CHILD AT ROW 10 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 10 COL 39 WIDGET-ID 500   
     child AT ROW 9 COL 13.4 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 16 COL 2 WIDGET-ID 40
     modf   AT ROW 16 COL 43     
     DESC_EDIT AT ROW 17.3 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20.3 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20.3 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20.3 COL 52 WIDGET-ID 30
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 9 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.4 COL 43 WIDGET-ID 600          
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
     &ENDIF
 ASSIGN     
       BROWSE-PAR:COLUMN-RESIZABLE IN FRAME frame_foreign       = TRUE
       BROWSE-PAR1:COLUMN-RESIZABLE IN FRAME frame_foreign      = TRUE
       BROWSE-CHILD:COLUMN-RESIZABLE IN FRAME frame_foreign     = TRUE
       BROWSE-CHILD1:COLUMN-RESIZABLE IN FRAME frame_foreign    = TRUE.       
 
 DEF VAR fnintSub AS INTEGER NO-UNDO.
 DEF VAR chldintSub AS INTEGER NO-UNDO.
 DEF VAR tbllist AS INTEGER NO-UNDO.
 DEF VAR pirec AS INTEGER NO-UNDO.
 DEF VAR cirec AS INTEGER NO-UNDO.

        DEFINE VARIABLE fnQuery AS HANDLE.
        DEFINE VARIABLE fnBrowse AS HANDLE.
        DEFINE VARIABLE fnBuffer AS HANDLE.
        DEFINE VARIABLE fnField AS HANDLE.
        DEFINE VARIABLE fnField1 AS HANDLE.
        DEFINE VARIABLE fnField2 AS HANDLE.
        
	    DEFINE VARIABLE chldQuery AS HANDLE.
        DEFINE VARIABLE chldBrowse AS HANDLE.
        DEFINE VARIABLE chldBuffer AS HANDLE.
        DEFINE VARIABLE chldField1 AS HANDLE.
	    DEFINE VARIABLE chldField2 AS HANDLE.
        
ON CHOOSE OF OK_BUT IN FRAME frame_foreign
  DO:          
          ASSIGN is-saved = FALSE.
          RUN validate_foreign.
          IF is-saved THEN
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.        
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_foreign
 DO:
          RUN validate_foreign.
 END. 

ON CHOOSE OF CANCEL_BUT IN FRAME frame_foreign
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.  
   
ON VALUE-CHANGED OF BROWSE-PAR IN FRAME frame_foreign /* Browse 1 */
DO:
  RUN Fill_Parent_Record.
  RUN Fetch_Foreign_Name.
END.

ON VALUE-CHANGED OF BROWSE-CHILD IN FRAME frame_foreign /* Browse 2 */
DO:
  RUN Fill_Child_Info.
  RUN Fetch_Foreign_Name.

END.

ON ENTRY OF DESC_EDIT IN FRAME frame_foreign
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="". 
  &ENDIF
END. 

ON ENTRY OF name IN FRAME frame_foreign
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="". 
  &ENDIF
 END.
        
PROCEDURE foreign :
   &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_foreign 

     HIDE FRAME frame_primary.   
     HIDE FRAME frame_unique.     
     HIDE FRAME frame_check.    
     VIEW FRAME frame_foreign.
     DISPLAY name BROWSE-PAR  BROWSE-PAR1  child BROWSE-CHILD BROWSE-CHILD1 Active modf DESC_EDIT 
          WITH FRAME frame_foreign.
     ASSIGN child:SCREEN-VALUE IN FRAME frame_foreign = c_table_name.
     ASSIGN Active:SCREEN-VALUE IN FRAME frame_foreign ="yes".
     ASSIGN modf:SCREEN-VALUE IN FRAME frame_foreign ="NONE".
     ENABLE  name BROWSE-PAR  BROWSE-PAR1   BROWSE-CHILD BROWSE-CHILD1 Active modf DESC_EDIT
                  OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF
     WITH FRAME frame_foreign.
    {&OPEN-BROWSERS-IN-QUERY-frame_foreign}

RUN Fill_Par_Table_Index.
RUN Fill_Parent_Record.
RUN Fill_Child_Index.
RUN Fill_Child_Info. 
RUN Fetch_Foreign_Name.


  
END PROCEDURE.

PROCEDURE Fill_Par_Table_Index:
   EMPTY TEMP-TABLE temp-parent.
   FOR EACH DICTDB._file WHERE DICTDB._File._Db-Recid = DbRecid:
              FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = RECID(DICTDB._file) NO-LOCK:
               
               ASSIGN pirec = RECID(DICTDB._index).
               FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = pirec AND 
               (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "PC" 
                   OR DICTDB._Constraint._Con-Type = "MP" ) NO-LOCK NO-ERROR.
               IF AVAILABLE (DICTDB._Constraint) THEN
               DO: 
                CREATE temp-parent.
                 ASSIGN  temp-parent.ptb = DICTDB._file._file-name
                         temp-parent.pidx = DICTDB._Index._Index-name
                         temp-parent.prec = pirec.
               END.
	      END.
    END.
    
{&OPEN-QUERY-BROWSE-PAR}
END PROCEDURE.



PROCEDURE Fill_Parent_Record:

    fnBrowse = BROWSE BROWSE-PAR:HANDLE. 
    fnQuery  = fnBrowse:QUERY.
    fnBuffer = fnQuery:GET-BUFFER-HANDLE(1). 
    
    DO fnintSub = 1 TO fnBrowse:NUM-SELECTED-ROWS:
           fnBrowse:FETCH-SELECTED-ROW(fnintSub).
           fnField  = fnBuffer:BUFFER-FIELD( "ptb" ).
	       fnField1 = fnBuffer:BUFFER-FIELD( "pidx" ).
	       fnField2 = fnBuffer:BUFFER-FIELD( "prec" ).
    END.
  IF CAN-FIND (FIRST temp-parent) THEN
      ASSIGN Par_Idx = fnField1:BUFFER-VALUE.
  ELSE MESSAGE " No Primary constraint(s) have been defined, Foreign Key cannot be created " view-as alert-box warning.
  EMPTY TEMP-TABLE temp-parent1.
  counter = 0.
  FIND FIRST _file WHERE _file._file-name = TRIM(fnField:BUFFER-VALUE) AND DICTDB._File._Db-Recid = DbRecid NO-LOCK NO-ERROR .
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = fnField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  fnField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.
      counter = counter + 1.
      CREATE temp-parent1.
      ASSIGN            temp-parent1.idxn = DICTDB._FIELD._Field-name 
                        temp-parent1.ctyp = DICTDB._FIELD._Data-Type
		                temp-parent1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER")
		                temp-parent1.fnum = counter.

  END.
    {&OPEN-QUERY-BROWSE-PAR1} 

END PROCEDURE.

PROCEDURE Fill_Child_Index:
EMPTY TEMP-TABLE temp-child.
FOR EACH DICTDB._file where DICTDB._file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._File._Db-Recid = DbRecid:
 file_rec = RECID(DICTDB._file).
              FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND _Index._Wordidx <> 1 NO-LOCK:
               CREATE temp-child.
	       ASSIGN 
	             temp-child.cidx = DICTDB._Index._Index-name
	             temp-child.crec = RECID(DICTDB._index).
	       END.
	        
 END.
 {&OPEN-QUERY-BROWSE-CHILD}
 END PROCEDURE.


PROCEDURE Fill_Child_Info:

    chldBrowse = BROWSE BROWSE-CHILD:HANDLE. 
    chldQuery  = chldBrowse:QUERY.
    chldBuffer = chldQuery:GET-BUFFER-HANDLE(1).

    DO chldintSub = 1 TO chldBrowse:NUM-SELECTED-ROWS:
           chldBrowse:FETCH-SELECTED-ROW(chldintSub).
	       chldField1 = chldBuffer:BUFFER-FIELD( "cidx" ).
	       chldField2 = chldBuffer:BUFFER-FIELD( "crec" ).
    END.

  EMPTY TEMP-TABLE temp-child1.
  counter = 0.
  
  FIND FIRST _file WHERE _file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._File._Db-Recid = DbRecid NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = chldField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  chldField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.

      CREATE temp-child1.
      counter = counter + 1.
      ASSIGN            temp-child1.idxn = DICTDB._FIELD._Field-name 
                        temp-child1.ctyp = DICTDB._FIELD._Data-Type
		                temp-child1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER")
		                temp-child1.fnum = counter.

      END.
  
  {&OPEN-QUERY-BROWSE-CHILD1}


	  
END PROCEDURE.


PROCEDURE Fetch_Foreign_Name:
   chldBrowse = BROWSE BROWSE-CHILD:HANDLE. 
   chldQuery  = chldBrowse:QUERY.
   chldBuffer = chldQuery:GET-BUFFER-HANDLE(1).

   DO chldintSub = 1 TO chldBrowse:NUM-SELECTED-ROWS:
           chldBrowse:FETCH-SELECTED-ROW(chldintSub).
	       chldField1 = chldBuffer:BUFFER-FIELD( "cidx" ).
	       chldField2 = chldBuffer:BUFFER-FIELD( "crec" ).
   
     
     ASSIGN Selected_Idx = chldField1:BUFFER-VALUE.
   END.
run Create_Const_Name.
END PROCEDURE.
 
PROCEDURE foreign_save:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_foreign 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:
       num = num + 1.
       CREATE DICTDB._Constraint.
        ASSIGN _Con-Type = "F"
               _Con-Name = name:SCREEN-VALUE IN FRAME frame_foreign
               _For-Name = "".
        IF ACTIVE:SCREEN-VALUE IN FRAME frame_foreign = "yes" 
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
        ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_foreign  
               _con-misc2[1] = modf:SCREEN-VALUE IN FRAME frame_foreign
               _File-recid = file_rec
               _Con-Status = "N"
               _Index-recid = chldField2:BUFFER-VALUE
               _Index-parent-recid = fnField2:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
       RUN TEMP1.
       RUN foreign.
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="Constraint Created".  &ENDIF 
       ASSIGN is-saved = TRUE.           
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.               
END.

PROCEDURE validate_foreign:
        
        assign flg=TRUE.
        FOR EACH temp-child1:
          FIND FIRST temp-parent1 WHERE Temp-parent1.fnum = temp-child1.fnum NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (temp-parent1) THEN DO:
             MESSAGE "Number of Fields do not match" VIEW-AS ALERT-BOX ERROR.
             ASSIGN flg = FALSE.
          END. 
          ELSE DO:
          IF Temp-parent1.ctyp <> temp-child1.ctyp AND flg = TRUE
           THEN DO:
              MESSAGE "Field Types do not match" VIEW-AS ALERT-BOX ERROR.
              flg = FALSE.
           END.
          END. 
        END.  
        FOR EACH temp-parent1:
          FIND FIRST temp-child1 WHERE Temp-parent1.fnum = temp-child1.fnum NO-LOCK NO-ERROR.
          IF NOT AVAILABLE (temp-child1) THEN DO:
             MESSAGE "Number of fields do not match" VIEW-AS ALERT-BOX ERROR. 
             ASSIGN flg = FALSE.
          END. 
          ELSE DO:
          IF temp-child1.ctyp <> temp-parent1.ctyp AND flg = TRUE
           THEN DO:
              MESSAGE "Field Types do not match" VIEW-AS ALERT-BOX ERROR.
              flg = FALSE.
           END.
          END. 
        END.          
                
        IF flg THEN DO:        
           RUN foreign_save.      
        END.       
END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modcheck.i

Description:   
   This file contains the form for modification of Check Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/moduni.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-CHECK FOR 
      temp2 SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-CHECK
  QUERY BROWSE-CHECK NO-LOCK DISPLAY
      temp2.fld FORMAT "x(33)":U
      temp2.chk FORMAT "x(33)":U

  WITH NO-ROW-MARKERS SEPARATORS 
  &IF "{&WINDOW-SYSTEM}" <> "TTY"
  &THEN SIZE 75 BY 3.32 FIT-LAST-COLUMN.
  &ELSE SIZE 75 BY 6 FIT-LAST-COLUMN.
  &ENDIF
  /*    DEFINATION FOR CHECK FRAME  */  
&Scoped-define FRAME-NAME frame_check
&Scoped-define BROWSE-NAME BROWSE-CHECK
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHECK temp2.fld temp2.chk 
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHECK 
&Scoped-define QUERY-STRING-BROWSE-CHECK FOR EACH temp2 NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-CHECK OPEN QUERY BROWSE-CHECK FOR EACH temp2 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHECK temp2
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHECK temp2

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 2.6 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 6.3 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 7.1 COL 14 NO-LABEL
     VALIDATE AT ROW 9.2 COL 14 NO-LABEL
     DESC_EDIT AT ROW 11.8 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 14 COL 2 WIDGET-ID 4 NO-LABEL
    
     OK_BUT AT ROW 15 COL 3 WIDGET-ID 26
     CREATE_BUT AT ROW 15 COL 17 WIDGET-ID 28
     CANCEL_BUT AT ROW 15 COL 31 WIDGET-ID 30
     HELP_BUT AT ROW 15 COL 60 WIDGET-ID 32
     "Constraint" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.3 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 7.9 COL 2 WIDGET-ID 38 
     "Validation" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 9.4 COL 2 WIDGET-ID 38
     "Expression:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.1 COL 2 WIDGET-ID 38
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12 COL 2 WIDGET-ID 38  

     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 15.14 WIDGET-ID 100.
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-CHECK AT ROW 3.2 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 9 COL 2 WIDGET-ID 40
     EXPRESSION AT ROW 10.4 COL 2 
     VALIDATE AT ROW 13.4 COL 2.3
     DESC_EDIT AT ROW 16.4 COL 2 WIDGET-ID 36
    
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30  
    
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 11.4 COL 2 WIDGET-ID 38
     "Expression" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 14.4 COL 2 WIDGET-ID 38
     WITH FRAME frame_check
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
    &ENDIF       
                          
 ASSIGN BROWSE-CHECK:COLUMN-RESIZABLE IN FRAME frame_check        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_check
  DO:          
      IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
      THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
      ELSE DO:
        RUN check_save.
        APPLY "CLOSE":U TO THIS-PROCEDURE.
        RETURN NO-APPLY.                   
      END.              
  END.
ON CHOOSE OF CREATE_BUT IN FRAME frame_check
 DO:
     IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check = "" OR EXPRESSION:SCREEN-VALUE IN FRAME frame_check = ?
     THEN MESSAGE " The constraint expression cannot be left blank" VIEW-AS ALERT-BOX ERROR.
     ELSE DO:
       RUN check_save.
       RUN FILL_TEMP2.
       RUN check.
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF 
     END.  
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_check
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.  

ON ENTRY OF EXPRESSION IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT IN FRAME frame_check
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_check ="". 
  &ENDIF
END. 

PROCEDURE check :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_check~
           ~{&OPEN-QUERY-BROWSE-CHECK}
           
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           
           HIDE FRAME frame_unique.
           VIEW FRAME frame_check. 
           DISPLAY NAME BROWSE-CHECK Active DESC_EDIT EXPRESSION  VALIDATE 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                    WITH FRAME frame_check.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_check =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_check ="yes".
           IF chek <> "" THEN EXPRESSION:SCREEN-VALUE IN FRAME frame_check = chek.
           ASSIGN DESC_EDIT:SCREEN-VALUE IN FRAME frame_check = descrip.

           IF user_dbtype    NE "oracle" then 
           ENABLE BROWSE-CHECK Active DESC_EDIT EXPRESSION
                    OK_BUT CREATE_BUT CANCEL_BUT  
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                    WITH FRAME frame_check.
           ELSE
           ENABLE BROWSE-CHECK DESC_EDIT 
                    OK_BUT CREATE_BUT CANCEL_BUT  
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                    WITH FRAME frame_check.

           {&OPEN-BROWSERS-IN-QUERY-frame_check}
        FIND FIRST  _constraint where _con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
        FOR EACH temp2 WHERE rec = _constraint._field-recid NO-LOCK:
           curr-rec = ROWID(temp2).
           REPOSITION BROWSE-CHECK TO ROWID curr-rec.
        END.
END PROCEDURE.

PROCEDURE check_save:
    FOR EACH _constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid:
      IF EXPRESSION:SCREEN-VALUE IN FRAME frame_check <> _Con-Expr THEN 
      MESSAGE "Check Constraint expression changed" VIEW-AS ALERT-BOX INFORMATION.

      IF ACTIVE:SCREEN-VALUE IN FRAME frame_check = "yes" THEN
         ASSIGN _Con-Active = TRUE.
      ELSE ASSIGN _Con-Active = FALSE.
         ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_check. 
         ASSIGN _Con-Status = "C"
                _Con-Expr = EXPRESSION:SCREEN-VALUE IN FRAME frame_check.         
    END.  
END.          
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modcons.i

Description:   
   This file contains the forms the base code for modification of Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/viewmnt.i  }

DEFINE {1} TEMP-TABLE temp NO-UNDO
    FIELD ind AS CHAR LABEL "Index"
    FIELD pri AS CHAR LABEL "Primary"
    FIELD uni AS CHAR LABEL "Unique"
    FIELD man AS CHAR LABEL "All Columns Mandatory"
    FIELD rec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp2 NO-UNDO
    FIELD fld AS CHAR LABEL "Field"
    FIELD ini AS CHAR LABEL "Initial Value"
    FIELD chk AS CHAR LABEL "Constraint Expression"
    FIELD rec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp-parent NO-UNDO  
    FIELD ptb AS CHAR LABEL "Parent Table"
    FIELD pidx AS CHAR LABEL "Parent Index"
    FIELD prec AS RECID LABEL "REC ID".


DEFINE {1} TEMP-TABLE temp-parent1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "Number".
   

DEFINE {1} TEMP-TABLE temp-child NO-UNDO
    FIELD cidx AS CHAR LABEL "Child Index"
    FIELD crec AS RECID LABEL "REC ID".

DEFINE {1} TEMP-TABLE temp-child1 NO-UNDO
    FIELD idxn AS CHAR LABEL "Name"
    FIELD ctyp AS CHAR LABEL "Type"
    FIELD fldl AS INTEGER LABEL "Length"
    FIELD fnum AS INTEGER LABEL "NUMBER".
      
DEFINE {1} VARIABLE  file_rec AS RECID   NO-UNDO.
DEFINE {1} VARIABLE  mandatory AS INTEGER   NO-UNDO.
DEFINE {1} VARIABLE  A   AS INTEGER NO-UNDO.
DEFINE {1} VARIABLE  I   AS INTEGER NO-UNDO.
DEFINE {1} VARIABLE  Par_Idx AS CHAR NO-UNDO.
DEFine {1} VARiable  Selected_Idx as CHAR NO-UNDO.
DEFine {1} VARiable  act as CHAR NO-UNDO.
DEFine {1} VARiable  chek as CHAR NO-UNDO.
DEFine {1} VARiable  descrip as CHAR NO-UNDO.
DEFINE {1} VARIABLE  const_type AS CHAR NO-UNDO.
DEFINE {1} VARIABLE  curr-rec AS ROWID  NO-UNDO.

DEFINE {1} BUTTON OK_BUT  
     LABEL "&OK" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CREATE_BUT 
     LABEL "&Save" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON CANCEL_BUT 
     LABEL "&Cancel" 
     SIZE 13 BY 1.

DEFINE {1} BUTTON HELP_BUT 
     LABEL "&Help" 
     SIZE 13 BY 1.

DEFINE {1} VARIABLE Constrainttype AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Type." 
     &ELSE   LABEL "Constraint Type" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 4
     LIST-ITEMS "PRIMARY","UNIQUE","FOREIGN KEY","CHECK" 
     DROP-DOWN-LIST
     SIZE 20 BY 1 NO-UNDO.

DEFINE VARIABLE child AS CHARACTER FORMAT "X(12)":U 
     LABEL "Child Table" 
     VIEW-AS FILL-IN 
     SIZE 14 BY .92 NO-UNDO.
     
DEFINE {1} VARIABLE EXPRESSION AS CHARACTER
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Constraint ."  
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Constraint." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF     

DEFINE {1} VARIABLE VALIDATE AS CHARACTER 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN LABEL "Validation ." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 2 NO-UNDO.
     &ELSE 
           LABEL "Validation." 
           VIEW-AS EDITOR SCROLLBAR-VERTICAL
           SIZE 49 BY 3 NO-UNDO.
     &ENDIF

DEFINE {1} VARIABLE DESC_EDIT AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 3 NO-UNDO.
     &ENDIF
     
DEFINE {1} VARIABLE DESC_EDIT2 AS CHARACTER 
     LABEL "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN SIZE 49 BY 2 NO-UNDO.
     &ELSE SIZE 49 BY 4.3 NO-UNDO.
     &ENDIF     

     
DEFINE {1} VARIABLE msg AS CHARACTER FORMAT "X(80)":U 
     LABEL ""
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.
     
DEFINE {1} VARIABLE name AS CHARACTER FORMAT "X(80)":U 
     LABEL "Constraint &Name" 
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.

DEFINE {1} VARIABLE Active AS LOGICAL INITIAL no 
     LABEL "Active" 
     VIEW-AS TOGGLE-BOX
     SIZE 11 BY .81 NO-UNDO.

DEFINE {1} FRAME DEFAULT-FRAME
   &IF "{&WINDOW-SYSTEM}" <> "TTY"
   &THEN Constrainttype AT ROW 1.4 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ELSE Constrainttype AT ROW 1.95 COL 17 COLON-ALIGNED WIDGET-ID 2
   &ENDIF
   WITH 1 DOWN KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 1
         &IF "{&WINDOW-SYSTEM}" <> "TTY"
         &THEN SIZE 82 BY 19 WIDGET-ID 100
         &ELSE SIZE 82 BY 24 WIDGET-ID 100
         &ENDIF
         
         VIEW-AS DIALOG-BOX 
         TITLE "Modify Foreign Constraint Definition for " + c_table_name .
         
DEFINE {1} FRAME frame_primary.
DEFINE {1} FRAME frame_foreign.
DEFINE {1} FRAME frame_unique.
DEFINE {1} FRAME frame_check.


ASSIGN FRAME frame_primary:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_foreign:FRAME = FRAME DEFAULT-FRAME:HANDLE   
       FRAME frame_unique:FRAME = FRAME DEFAULT-FRAME:HANDLE
       FRAME frame_check:FRAME = FRAME DEFAULT-FRAME:HANDLE.

PROCEDURE TEMP1:

EMPTY TEMP-TABLE temp.

FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._File._Db-Recid = DbRecid NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND _Index._Wordidx <> 1 NO-LOCK:
       CREATE temp.
       ASSIGN ind = DICTDB._index._index-name.
              IF _unique = YES
              THEN ASSIGN uni = "I".
              IF DICTDB._File._Prime-Index = RECID(DICTDB._Index) 
              THEN ASSIGN pri = "I".
              A = RECID(DICTDB._index).
              FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Index-recid = A AND DICTDB._Constraint._Con-Status <> "D"
                                                               AND DICTDB._Constraint._Con-Status <> "O":
                            
                IF (DICTDB._Constraint._Con-Type = "P" OR DICTDB._Constraint._Con-Type = "MP" OR DICTDB._Constraint._Con-Type = "PC")               
                   THEN DO:
                   IF pri <> "" THEN pri = pri + " , C".
                                     ELSE pri = "C".
                   END.
                IF (DICTDB._Constraint._Con-Type = "U")
                   THEN DO:
                   IF uni <> "" THEN uni = uni + " , C".
                                     ELSE uni = "C".  
                   END.
               END.    
              ASSIGN mandatory = 0.
              ASSIGN rec = RECID(DICTDB._index).
              FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid = A:
                  FIND FIRST DICTDB._Field where DICTDB._index-field._Field-Recid = RECID(DICTDB._Field).
                  IF DICTDB._Field._Mandatory = NO THEN ASSIGN mandatory = 1.
              END.
              IF mandatory = 0 THEN ASSIGN man = "  I".    
   END.
END.
  FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND 
           DICTDB._Constraint._Con-status <> "O" AND DICTDB._Constraint._Con-status <> "D" 
                                  AND DICTDB._Constraint._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE DICTDB._Constraint THEN DO:
     ASSIGN act = "n".
     ASSIGN chek = DICTDB._Constraint._Con-Expr. 
     ASSIGN descrip =  DICTDB._Constraint._con-desc. 
     IF DICTDB._Constraint._con-active = TRUE THEN ASSIGN act = "t".
  END.
END PROCEDURE.

PROCEDURE FILL_TEMP2:
EMPTY TEMP-TABLE temp2.
FOR EACH DICTDB._file WHERE DICTDB._file._file-name = c_table_name AND DICTDB._File._Db-Recid = DbRecid NO-LOCK:
   file_rec = RECID(DICTDB._file).
   FOR EACH DICTDB._Field WHERE DICTDB._Field._file-recid = file_rec NO-LOCK:
      CREATE temp2.
      ASSIGN fld = DICTDB._Field._Field-Name
             ini = DICTDB._Field._Initial
             rec = RECID(DICTDB._Field).
      A = RECID(DICTDB._Field).
      FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND DICTDB._Constraint._Field-Recid = A 
       AND DICTDB._Constraint._Con-Type = "C" AND DICTDB._Constraint._Con-Status <> "D" 
                                                 AND DICTDB._Constraint._Con-Status <> "O" NO-LOCK NO-ERROR.
        IF AVAILABLE(DICTDB._Constraint)  
        THEN ASSIGN chk = DICTDB._Constraint._Con-Expr.
      
   END.
END.    
   FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND 
           DICTDB._Constraint._Con-status <> "O" AND DICTDB._Constraint._Con-status <> "D" 
                                  AND DICTDB._Constraint._Db-Recid = DbRecId NO-LOCK NO-ERROR.
   IF AVAILABLE DICTDB._Constraint THEN DO:
     ASSIGN act = "n".
     ASSIGN chek = DICTDB._Constraint._Con-Expr. 
     ASSIGN descrip =  DICTDB._Constraint._con-desc. 
     IF DICTDB._Constraint._con-active = TRUE THEN ASSIGN act = "t".
  END.    
END PROCEDURE.


  FOR EACH DICTDB._Constraint WHERE DICTDB._Constraint._Con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid NO-LOCK:
     IF (DICTDB._Constraint._con-type = "PC" OR DICTDB._Constraint._con-type = "P" OR
            DICTDB._Constraint._con-type = "MP") THEN ASSIGN const_type ="PRIMARY".
     IF DICTDB._Constraint._con-type = "C" THEN ASSIGN const_type ="CHECK".
     IF DICTDB._Constraint._con-type = "U" THEN ASSIGN const_type ="UNIQUE".
     IF DICTDB._Constraint._con-type = "F" THEN ASSIGN const_type ="FOREIGN KEY".
  END. 
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modcons.p

Description:   
   This file contains the form for modification Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/modforg.i }

&Scoped-define SELF-NAME Constrainttype


ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
DO:
    APPLY "END-ERROR" TO FRAME frame_primary.
    APPLY "END-ERROR" TO FRAME frame_unique.
    APPLY "END-ERROR" TO FRAME frame_foreign.
    APPLY "END-ERROR" TO FRAME frame_check.
END.  

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME frame_primary OR HELP OF FRAME frame_unique OR HELP OF FRAME frame_foreign  OR HELP OF FRAME frame_check
  OR CHOOSE of HELP_BUT IN FRAME frame_primary  OR CHOOSE of HELP_BUT IN FRAME frame_unique 
  OR CHOOSE of HELP_BUT IN FRAME frame_foreign  OR CHOOSE of HELP_BUT IN FRAME frame_check
 DO:
    RUN adecomm/_adehelp.p (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&ORACLE_DataServer_View_Modify_Contraint_Properties_Dialog_Box}, 
      	       	     	      INPUT ?).
 END.
&ENDIF

MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
 
  RUN enable_UI.  
  IF NOT THIS-PROCEDURE:PERSISTENT THEN
    WAIT-FOR CLOSE OF THIS-PROCEDURE.
    
  ON WINDOW-CLOSE OF FRAME DEFAULT-FRAME  
    APPLY "END-ERROR" TO FRAME DEFAULT-FRAME.
  
    
    
END.

PROCEDURE enable_UI :
  DISPLAY Constrainttype 
      WITH FRAME DEFAULT-FRAME.
  ASSIGN Constrainttype:SCREEN-VALUE IN FRAME DEFAULT-FRAME =const_type.
    
     RUN TEMP1.
     RUN FILL_TEMP2.
     
     IF  const_type ="PRIMARY" THEN RUN primary.
     IF  const_type ="CHECK" THEN RUN check.
     IF  const_type ="UNIQUE" THEN RUN unique.
     IF  const_type ="FOREIGN KEY" THEN RUN foreign.

   IF cDbType = "MSS" OR cDbType = "ORACLE" THEN DO:
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT2 WITH FRAME frame_primary.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT2 WITH FRAME frame_unique.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT WITH FRAME frame_foreign.
       DISABLE  OK_BUT CREATE_BUT DESC_EDIT WITH FRAME frame_check.
   END.  

END PROCEDURE.
           

/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modforg.i

Description:   
   This file contains the form for modification of Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/ora/key/modcheck.i }
DEFINE {1} VARIABLE modf AS CHARACTER FORMAT "X(12)":U 
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN  LABEL "Constraint Action." 
     &ELSE   LABEL "Con Action" 
     &ENDIF
    
     VIEW-AS COMBO-BOX INNER-LINES 3
     LIST-ITEMS "NONE","CASCADE","SET NULL" 
     DROP-DOWN-LIST
     SIZE 19 BY 1 NO-UNDO.
DEFINE  VARIABLE counter AS INTEGER NO-UNDO.
DEFINE  VARIABLE flg     AS LOGICAL NO-UNDO.
DEFINE {1} QUERY BROWSE-PAR FOR 
      temp-parent SCROLLING.

DEFINE {1} QUERY BROWSE-PAR1 FOR 
      temp-parent1 SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD FOR 
      temp-child SCROLLING.

DEFINE {1} QUERY BROWSE-CHILD1 FOR 
      temp-child1 SCROLLING.

/* Browse definitions                                                   */

DEFINE {1} BROWSE BROWSE-PAR
    QUERY BROWSE-PAR NO-LOCK DISPLAY
       temp-parent.ptb  FORMAT "x(14)":U
       temp-parent.pidx FORMAT "x(14)":U
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

 DEFINE BROWSE BROWSE-PAR1
    QUERY BROWSE-PAR1 NO-LOCK DISPLAY
       temp-parent1.idxn FORMAT "x(13)":U
       temp-parent1.ctyp FORMAT "x(8)":U
       temp-parent1.fldl 
       
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD
    QUERY BROWSE-CHILD NO-LOCK DISPLAY
       temp-child.cidx FORMAT "x(30)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 35 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 35 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

DEFINE BROWSE BROWSE-CHILD1
    QUERY BROWSE-CHILD1 NO-LOCK DISPLAY
       temp-child1.idxn FORMAT "x(13)":U
       temp-child1.ctyp FORMAT "x(8)":U
       temp-child1.fldl   
    
    WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 37 BY 3.5 FIT-LAST-COLUMN.
    &ELSE SIZE 39 BY 6 FIT-LAST-COLUMN.
    &ENDIF 

&Scoped-define FRAME-NAME frame_foreign 

/* Definitions for BROWSE BROWSE-PAR                                      */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR temp-parent.ptb temp-parent.pidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR 
&Scoped-define QUERY-STRING-BROWSE-PAR FOR EACH temp-parent NO-LOCK. 
&Scoped-define OPEN-QUERY-BROWSE-PAR OPEN QUERY BROWSE-PAR FOR EACH temp-parent NO-LOCK .
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR temp-parent
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR temp-parent




/* Definitions for BROWSE BROWSE-PAR1                                     */
&Scoped-define FRAME-NAME frame_foreign
&Scoped-define BROWSE-NAME BROWSE-PAR1
&Scoped-define FIELDS-IN-QUERY-BROWSE-PAR1  temp-parent1.idxn temp-parent1.ctyp temp-parent1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PAR1
&Scoped-define QUERY-STRING-BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-PAR1 OPEN QUERY BROWSE-PAR1 FOR EACH temp-parent1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PAR1 temp-parent1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PAR1 temp-parent1


/* Definitions for BROWSE BROWSE-CHILD                                      */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD temp-child.cidx
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD 
&Scoped-define QUERY-STRING-BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD OPEN QUERY BROWSE-CHILD FOR EACH temp-child NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD temp-child
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD temp-child

/* Definitions for BROWSE BROWSE-CHILD1                                     */
&Scoped-define FIELDS-IN-QUERY-BROWSE-CHILD1  temp-child1.idxn  temp-child1.ctyp temp-child1.fldl
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-CHILD1 
&Scoped-define QUERY-STRING-BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define OPEN-QUERY-BROWSE-CHILD1  OPEN QUERY BROWSE-CHILD1  FOR EACH temp-child1 NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-CHILD1  temp-child1
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-CHILD1  temp-child1
  

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.1 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.1 COL 43 WIDGET-ID 300
     BROWSE-CHILD AT ROW 7.6 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 7.6 COL 43 WIDGET-ID 500   
     child AT ROW 6.6 COL 12 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 11.4 COL 2 WIDGET-ID 40
     modf   AT ROW 11.3 COL 43 
     DESC_EDIT AT ROW 12.4 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 14.4 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 15.3 COL 3
     CREATE_BUT AT ROW 15.3 COL 17
     CANCEL_BUT AT ROW 15.3 COL 31
     HELP_BUT AT ROW 15.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 12.6 COL 2 WIDGET-ID 38
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.3 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 6.7 COL 43 WIDGET-ID 600          
     "# = Virtual Index" VIEW-AS TEXT
          SIZE 24 BY .69 AT ROW 11.4 COL 16 WIDGET-ID 600        
        
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
              
     &ELSE
     name AT ROW 1.2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PAR AT ROW 3.4 COL 2 WIDGET-ID 200 
     BROWSE-PAR1 AT ROW 3.4 COL 39 WIDGET-ID 300
     BROWSE-CHILD AT ROW 10 COL 2 WIDGET-ID 400
     BROWSE-CHILD1 AT ROW 10 COL 39 WIDGET-ID 500   
     child AT ROW 9 COL 13.4 COLON-ALIGNED WIDGET-ID 84
     ACTIVE AT ROW 16 COL 2 WIDGET-ID 40
     modf   AT ROW 16 COL 43     
     DESC_EDIT AT ROW 17.3 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20.3 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20.3 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20.3 COL 52 WIDGET-ID 30
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 9 COL 43 WIDGET-ID 600
     "Index Key Composite Fields" VIEW-AS TEXT
          SIZE 28 BY .62 AT ROW 2.4 COL 43 WIDGET-ID 600          
     WITH FRAME frame_foreign
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.
     &ENDIF
     
 ASSIGN
       BROWSE-PAR:COLUMN-RESIZABLE IN FRAME frame_foreign       = TRUE
       BROWSE-PAR1:COLUMN-RESIZABLE IN FRAME frame_foreign      = TRUE
       BROWSE-CHILD:COLUMN-RESIZABLE IN FRAME frame_foreign     = TRUE
       BROWSE-CHILD1:COLUMN-RESIZABLE IN FRAME frame_foreign    = TRUE.       
 
 DEF VAR fnintSub AS INTEGER NO-UNDO.
 DEF VAR chldintSub AS INTEGER NO-UNDO.
 DEF VAR tbllist AS INTEGER NO-UNDO.
 DEF VAR pirec AS INTEGER NO-UNDO.
 DEF VAR cirec AS INTEGER NO-UNDO.

        DEFINE VARIABLE fnQuery AS HANDLE.
        DEFINE VARIABLE fnBrowse AS HANDLE.
        DEFINE VARIABLE fnBuffer AS HANDLE.
        DEFINE VARIABLE fnField AS HANDLE.
        DEFINE VARIABLE fnField1 AS HANDLE.
        DEFINE VARIABLE fnField2 AS HANDLE.
        
	    DEFINE VARIABLE chldQuery AS HANDLE.
        DEFINE VARIABLE chldBrowse AS HANDLE.
        DEFINE VARIABLE chldBuffer AS HANDLE.
        DEFINE VARIABLE chldField1 AS HANDLE.
	    DEFINE VARIABLE chldField2 AS HANDLE.
        
ON CHOOSE OF OK_BUT IN FRAME frame_foreign
  DO:          
          RUN foreign_save.
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.        
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_foreign
 DO:
       RUN foreign_save.
       RUN TEMP1.
       RUN foreign.
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF          
 END. 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_foreign
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END. 
  
ON VALUE-CHANGED OF BROWSE-PAR IN FRAME frame_foreign /* Browse 1 */
DO:
  RUN Fill_Parent_Record.
END.

ON VALUE-CHANGED OF BROWSE-CHILD IN FRAME frame_foreign /* Browse 2 */
DO:
  RUN Fill_Child_Info.
END.

ON ENTRY OF DESC_EDIT IN FRAME frame_foreign
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_foreign ="". 
  &ENDIF
END. 
       
PROCEDURE foreign :
   &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_foreign 

     HIDE FRAME frame_clustered.
     HIDE FRAME frame_primary.   
     HIDE FRAME frame_unique.    
     HIDE FRAME frame_default.    
     HIDE FRAME frame_check.    
     VIEW FRAME frame_foreign.
     DISPLAY name BROWSE-PAR  BROWSE-PAR1  child BROWSE-CHILD BROWSE-CHILD1 Active modf DESC_EDIT 
          WITH FRAME frame_foreign.
     ASSIGN child:SCREEN-VALUE IN FRAME frame_foreign = c_table_name.
     ASSIGN name:SCREEN-VALUE IN FRAME frame_foreign = constr_name.
     FIND FIRST  DICTDB._constraint where DICTDB._constraint._con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
     IF AVAILABLE DICTDB._constraint THEN DO:
       ASSIGN modf:SCREEN-VALUE IN FRAME frame_foreign = DICTDB._constraint._Con-Misc2[1].
     END.   
     IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_foreign ="yes".
     ASSIGN DESC_EDIT:SCREEN-VALUE IN FRAME frame_foreign = descrip.
     IF user_dbtype    NE "oracle" then 
        ENABLE  BROWSE-PAR  BROWSE-PAR1   BROWSE-CHILD BROWSE-CHILD1 Active DESC_EDIT
                  OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
     WITH FRAME frame_foreign.
     ELSE
         ENABLE  BROWSE-PAR  BROWSE-PAR1   BROWSE-CHILD BROWSE-CHILD1 DESC_EDIT
                  OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
         WITH FRAME frame_foreign.

    {&OPEN-BROWSERS-IN-QUERY-frame_foreign}

RUN Fill_Par_Table_Index.
RUN Fill_Parent_Record.
RUN Fill_Child_Index.
RUN Fill_Child_Info. 


  
END PROCEDURE.

PROCEDURE Fill_Par_Table_Index:
   EMPTY TEMP-TABLE temp-parent.
   FOR EACH DICTDB._file WHERE DICTDB._File._Db-Recid = DbRecid:
              FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = RECID(DICTDB._file) NO-LOCK:
               
               ASSIGN pirec = RECID(DICTDB._index).
               FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = pirec AND 
               (DICTDB._Constraint._Con-Type = "P" OR
                DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" ) NO-LOCK NO-ERROR.
               IF AVAILABLE (DICTDB._Constraint) THEN
               DO:
               CREATE temp-parent. 
                   ASSIGN temp-parent.ptb = DICTDB._file._file-name.                
               ASSIGN   temp-parent.pidx = DICTDB._Index._Index-name
                        temp-parent.prec = pirec.
               END.
	      END.
    END.
 {&OPEN-QUERY-BROWSE-PAR}
   FIND FIRST  DICTDB._constraint where _con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
   IF AVAILABLE _constraint THEN DO:
      FIND FIRST temp-parent WHERE prec = _constraint._index-parent-recid NO-LOCK NO-ERROR.
      curr-rec = ROWID(temp-parent).
      REPOSITION BROWSE-PAR TO ROWID curr-rec.
   END.
END PROCEDURE.



PROCEDURE Fill_Parent_Record:
    fnBrowse = BROWSE BROWSE-PAR:HANDLE. 
    fnQuery  = fnBrowse:QUERY.
    fnBuffer = fnQuery:GET-BUFFER-HANDLE(1). 
    
    DO fnintSub = 1 TO fnBrowse:NUM-SELECTED-ROWS:
           fnBrowse:FETCH-SELECTED-ROW(fnintSub).
           fnField  = fnBuffer:BUFFER-FIELD( "ptb" ).
	       fnField1 = fnBuffer:BUFFER-FIELD( "pidx" ).
	       fnField2 = fnBuffer:BUFFER-FIELD( "prec" ).
    END.
  ASSIGN Par_Idx = fnField1:BUFFER-VALUE.
  EMPTY TEMP-TABLE temp-parent1.
 
  FIND FIRST _file WHERE _file._file-name = TRIM(fnField:BUFFER-VALUE) AND DICTDB._File._Db-Recid = DbRecid  NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = fnField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  fnField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.
      CREATE temp-parent1.
      ASSIGN            temp-parent1.idxn = DICTDB._FIELD._Field-name 
                        temp-parent1.ctyp = DICTDB._FIELD._Data-Type
		                temp-parent1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER").

  END.
    {&OPEN-QUERY-BROWSE-PAR1} 

END PROCEDURE.

PROCEDURE Fill_Child_Index:

 EMPTY TEMP-TABLE temp-child.
 FOR EACH DICTDB._file where DICTDB._file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._File._Db-Recid = DbRecid:
 file_rec = RECID(DICTDB._file).
           FOR EACH DICTDB._index WHERE DICTDB._index._file-recid = file_rec AND _Index._Wordidx <> 1 NO-LOCK:
               CREATE temp-child.
	       ASSIGN 
	             temp-child.cidx = DICTDB._Index._Index-name
	             temp-child.crec = RECID(DICTDB._index).
	       END.
	        
 END.
 {&OPEN-QUERY-BROWSE-CHILD}
  FIND FIRST  DICTDB._constraint where DICTDB._constraint._con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
  IF AVAILABLE DICTDB._constraint THEN DO:
    FIND FIRST temp-child WHERE crec = DICTDB._constraint._index-recid NO-LOCK NO-ERROR.
     IF AVAILABLE temp-child THEN DO:
       curr-rec = ROWID(temp-child).
       REPOSITION BROWSE-CHILD TO ROWID curr-rec.
     END.
     ELSE DO:
      CREATE temp-child.
	  ASSIGN 
	    temp-child.cidx = "#" + constr_name
	    temp-child.crec = 0.  
	    curr-rec = ROWID(temp-child).
	    {&OPEN-QUERY-BROWSE-CHILD}
       REPOSITION BROWSE-CHILD TO ROWID curr-rec.         
     END.
  END.   
END PROCEDURE.


PROCEDURE Fill_Child_Info:

    chldBrowse = BROWSE BROWSE-CHILD:HANDLE. 
    chldQuery  = chldBrowse:QUERY.
    chldBuffer = chldQuery:GET-BUFFER-HANDLE(1).

    DO chldintSub = 1 TO chldBrowse:NUM-SELECTED-ROWS:
           chldBrowse:FETCH-SELECTED-ROW(chldintSub).
	       chldField1 = chldBuffer:BUFFER-FIELD( "cidx" ).
	       chldField2 = chldBuffer:BUFFER-FIELD( "crec" ).
    END.

  EMPTY TEMP-TABLE temp-child1.
  IF chldField2:BUFFER-VALUE <> 0
  THEN DO:
  FIND FIRST _file WHERE _file._file-name = child:SCREEN-VALUE IN FRAME frame_foreign AND DICTDB._File._Db-Recid = DbRecid  NO-LOCK NO-ERROR.
  FIND FIRST DICTDB._index where  DICTDB._index._Index-name = chldField1:BUFFER-VALUE
                                and  DICTDB._index._file-recid = RECID(DICTDB._File) No-Lock no-error.
  FOR EACH DICTDB._index-field where DICTDB._index-field._Index-recid =  chldField2:BUFFER-VALUE NO-LOCK:
       find dictdb._field of dictdb._index-field no-lock.

      CREATE temp-child1.

      ASSIGN            temp-child1.idxn = DICTDB._FIELD._Field-name 
                        temp-child1.ctyp = DICTDB._FIELD._Data-Type
		                temp-child1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER").

      END.
  END.
  ELSE DO:
  FIND FIRST DICTDB._constraint WHERE DICTDB._constraint._con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
      FOR EACH DICTDB._constraint-Keys WHERE DICTDB._constraint-Keys._Con-Recid   = RECID(DICTDB._constraint):
       FIND FIRST DICTDB._field of DICTDB._constraint-Keys NO-LOCK NO-ERROR.
       CREATE temp-child1.

       ASSIGN           temp-child1.idxn = DICTDB._FIELD._Field-name 
                        temp-child1.ctyp = DICTDB._FIELD._Data-Type
		                temp-child1.fldl = LENGTH(DICTDB._FIELD._Field-name, "CHARACTER").

     END.
  END.  
  {&OPEN-QUERY-BROWSE-CHILD1}


	  
END PROCEDURE.
 
PROCEDURE foreign_save:
       FOR EACH _constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid:
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_foreign = "yes" THEN
          ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT:SCREEN-VALUE IN FRAME frame_foreign.
          ASSIGN _Con-Status = "C".         
       END.  
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: modpri.i

Description:   
   This file contains the form for modification of Primary Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/modcons.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-PRIMARY FOR 
      temp SCROLLING.
      
            /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-PRIMARY
  QUERY BROWSE-PRIMARY NO-LOCK DISPLAY
      temp.ind FORMAT "x(20)":U
      temp.pri FORMAT "x(12)":U
      temp.uni FORMAT "x(12)":U
      temp.man FORMAT "x(15)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR PRIAMRY FRAME  */    
&Scoped-define FRAME-NAME frame_primary 
  
&Scoped-define BROWSE-NAME BROWSE-PRIMARY
&Scoped-define FIELDS-IN-QUERY-BROWSE-PRIMARY temp.pri temp.uni temp.ind  temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PRIMARY 
&Scoped-define QUERY-STRING-BROWSE-PRIMARY FOR EACH temp NO-LOCK.     
&Scoped-define OPEN-QUERY-BROWSE-PRIMARY OPEN QUERY BROWSE-PRIMARY FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PRIMARY temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PRIMARY temp    

        DEF VAR pintSub AS INTEGER NO-UNDO.
        DEFINE VARIABLE pQuery AS HANDLE.
        DEFINE VARIABLE pBrowse AS HANDLE.
        DEFINE VARIABLE pBuffer AS HANDLE.
        DEFINE VARIABLE pField AS HANDLE.
        DEFINE VARIABLE pField1 AS HANDLE.
        DEFINE VARIABLE pField2 AS HANDLE.
        DEFINE VARIABLE pField3 AS HANDLE.
        DEFINE VARIABLE pField4 AS HANDLE.
        DEFINE VARIABLE pField5 AS HANDLE.
                
        pBrowse = BROWSE BROWSE-PRIMARY:HANDLE. 
        pQuery  = pBrowse:QUERY.
        pBuffer = pQuery:GET-BUFFER-HANDLE(1).

FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16  WIDGET-ID 100.     
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 79 BY 21  WIDGET-ID 100.
    &ENDIF              
                      
 ASSIGN  BROWSE-PRIMARY:COLUMN-RESIZABLE IN FRAME frame_primary        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_primary
  DO:  
         RUN primary_save.
         APPLY "CLOSE":U TO THIS-PROCEDURE.
         RETURN NO-APPLY.      
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_primary
 DO:
         RUN primary_save.
         RUN TEMP1.
         RUN primary.
         &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
         ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF 
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_primary
 DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
 END. 

ON ENTRY OF DESC_EDIT2 IN FRAME frame_primary
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
  &ENDIF
END.

PROCEDURE primary :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_primary ~
           ~{&OPEN-QUERY-BROWSE-PRIMARY}
           
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_unique.     
           HIDE FRAME frame_check.     
           VIEW FRAME frame_primary.
           DISPLAY  name BROWSE-PRIMARY Active DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_primary.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_primary =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_primary ="yes".
           ASSIGN DESC_EDIT2:SCREEN-VALUE IN FRAME frame_primary = descrip.
           IF user_dbtype    NE "oracle" then           
               ENABLE  BROWSE-PRIMARY Active DESC_EDIT2 
                 OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF   
                  WITH FRAME frame_primary.
           ELSE
               ENABLE  BROWSE-PRIMARY DESC_EDIT2 
                 OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF   
                  WITH FRAME frame_primary.

          {&OPEN-BROWSERS-IN-QUERY-frame_primary}
          FIND FIRST  DICTDB._constraint where _con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid  NO-LOCK NO-ERROR.
          FOR EACH temp WHERE rec = _constraint._index-recid NO-LOCK:
             curr-rec = ROWID(temp).
             REPOSITION BROWSE-PRIMARY TO ROWID curr-rec.
          END.
END PROCEDURE.

PROCEDURE primary_save:
           FOR EACH _constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid:
             IF ACTIVE:SCREEN-VALUE IN FRAME frame_primary = "yes" THEN
             ASSIGN _Con-Active = TRUE.
             ELSE ASSIGN _Con-Active = FALSE. 
             ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_primary. 
             ASSIGN _Con-Status = "C".                    
           END.  
END PROCEDURE.           
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: moduni.i

Description:   
   This file contains the form for modification of unique Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/user/uservar.i}
{prodict/ora/key/modpri.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-UNIQUE FOR 
      temp SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-UNIQUE
  QUERY BROWSE-UNIQUE NO-LOCK DISPLAY
      temp.ind FORMAT "x(20)":U
      temp.pri FORMAT "x(12)":U
      temp.uni FORMAT "x(12)":U
      temp.man FORMAT "x(15)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR UNIQUE FRAME  */  
&Scoped-define FRAME-NAME frame_unique 
&Scoped-define BROWSE-NAME BROWSE-UNIQUE
&Scoped-define FIELDS-IN-QUERY-BROWSE-UNIQUE temp.pri temp.uni temp.ind temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-UNIQUE 
&Scoped-define QUERY-STRING-BROWSE-UNIQUE FOR EACH temp NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-UNIQUE OPEN QUERY BROWSE-UNIQUE FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-UNIQUE temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-UNIQUE temp
        
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
     
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.   
     &ENDIF                  
                      
 ASSIGN BROWSE-UNIQUE:COLUMN-RESIZABLE IN FRAME frame_unique        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_unique
  DO: 
          RUN unique_save.
          APPLY "CLOSE":U TO THIS-PROCEDURE.
          RETURN NO-APPLY.         
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_unique
 DO:
          RUN unique_save.
          RUN TEMP1.
          RUN unique.
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
          ASSIGN msg:SCREEN-VALUE ="Constraint Modified".  &ENDIF 
 END. 
 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_unique
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_unique
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="". 
  &ENDIF
END.

PROCEDURE unique :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_unique ~
           ~{&OPEN-QUERY-BROWSE-UNIQUE}
           
           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           HIDE FRAME frame_check.  
           VIEW FRAME frame_unique.
           DISPLAY name BROWSE-UNIQUE Active DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                    WITH FRAME frame_unique.
           ASSIGN name:SCREEN-VALUE IN FRAME frame_unique =  constr_name.
           IF act = "t" THEN Active:SCREEN-VALUE IN FRAME frame_unique ="yes".
           ASSIGN DESC_EDIT2:SCREEN-VALUE IN FRAME frame_unique = descrip.
           IF user_dbtype    NE "oracle" then 
               ENABLE BROWSE-UNIQUE Active DESC_EDIT2 
                   OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                  WITH FRAME frame_unique.
           ELSE
                ENABLE BROWSE-UNIQUE  DESC_EDIT2 
                   OK_BUT CREATE_BUT CANCEL_BUT 
                &IF "{&WINDOW-SYSTEM}" <> "TTY"
                &THEN HELP_BUT  
                &ENDIF 
                 WITH FRAME frame_unique.

            {&OPEN-BROWSERS-IN-QUERY-frame_unique}
        FIND FIRST DICTDB._constraint where _con-name = constr_name AND DICTDB._Constraint._Db-Recid = DbRecid NO-LOCK NO-ERROR.
        FOR EACH temp WHERE rec = _constraint._index-recid NO-LOCK:
           curr-rec = ROWID(temp).
           REPOSITION BROWSE-UNIQUE TO ROWID curr-rec.
        END.  
END PROCEDURE.

PROCEDURE unique_save:
           
           FOR EACH _constraint where _con-name = constr_name AND DICTDB._constraint._Db-Recid = DbRecid:
             IF ACTIVE:SCREEN-VALUE IN FRAME frame_unique = "yes" THEN
             ASSIGN _Con-Active = TRUE.
             ELSE ASSIGN _Con-Active = FALSE. 
             ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_unique. 
             ASSIGN _Con-Status = "C".                    
           END.  
END.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: primary.i

Description:   
   This file contains the form for Primary Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/constraint.i }

/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-PRIMARY FOR 
      temp SCROLLING.
      
            /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-PRIMARY
  QUERY BROWSE-PRIMARY NO-LOCK DISPLAY
      temp.ind FORMAT "x(20)":U
      temp.pri FORMAT "x(12)":U
      temp.uni FORMAT "x(12)":U
      temp.man FORMAT "x(15)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR PRIAMRY FRAME  */    
&Scoped-define FRAME-NAME frame_primary 
  
&Scoped-define BROWSE-NAME BROWSE-PRIMARY
&Scoped-define FIELDS-IN-QUERY-BROWSE-PRIMARY temp.pri temp.uni temp.ind temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-PRIMARY 
&Scoped-define QUERY-STRING-BROWSE-PRIMARY FOR EACH temp NO-LOCK.     
&Scoped-define OPEN-QUERY-BROWSE-PRIMARY OPEN QUERY BROWSE-PRIMARY FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-PRIMARY temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-PRIMARY temp    

        DEF VAR pri_chk_clus AS INTEGER NO-UNDO.
        DEF VAR pintSub AS INTEGER NO-UNDO.

        DEFINE VARIABLE pQuery AS HANDLE.
        DEFINE VARIABLE pBrowse AS HANDLE.
        DEFINE VARIABLE pBuffer AS HANDLE.
        DEFINE VARIABLE pField AS HANDLE.
        DEFINE VARIABLE pField1 AS HANDLE.
        DEFINE VARIABLE pField2 AS HANDLE.
        DEFINE VARIABLE pField3 AS HANDLE.
        DEFINE VARIABLE pField4 AS HANDLE.
        DEFINE VARIABLE pField5 AS HANDLE.
                
        pBrowse = BROWSE BROWSE-PRIMARY:HANDLE. 
        pQuery  = pBrowse:QUERY.
        pBuffer = pQuery:GET-BUFFER-HANDLE(1).
  
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN 
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 388
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16  WIDGET-ID 100.
     
    &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-PRIMARY AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
 
     WITH FRAME frame_primary
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 79 BY 21  WIDGET-ID 100.
    &ENDIF              
 ASSIGN  BROWSE-PRIMARY:COLUMN-RESIZABLE IN FRAME frame_primary        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_primary
  DO:     
           ASSIGN is-saved = FALSE.
           RUN check_primary_save.
         IF is-saved THEN
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END.


ON CHOOSE OF CREATE_BUT IN FRAME frame_primary
 DO:
          RUN check_primary_save.
 END. 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_primary
  DO:     
           APPLY "CLOSE":U TO THIS-PROCEDURE.
           RETURN NO-APPLY.      
  END. 
  
ON VALUE-CHANGED OF BROWSE-PRIMARY IN FRAME frame_primary
  DO:
      RUN Fetch_Primary_Name.
  END.   


ON ENTRY OF name IN FRAME frame_primary
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_primary
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="". 
  &ENDIF
END.

PROCEDURE Fetch_Primary_Name:
 
  DO pintSub = 1 TO pBrowse:NUM-SELECTED-ROWS : 
     
     
           pBrowse:FETCH-SELECTED-ROW(pintSub).

           pField  = pBuffer:BUFFER-FIELD( "ind" ).
           pField1 = pBuffer:BUFFER-FIELD( "pri" ).
           pField3 = pBuffer:BUFFER-FIELD( "uni" ).
           pField4 = pBuffer:BUFFER-FIELD( "man" ).
           pField5 = pBuffer:BUFFER-FIELD( "rec" ).
           
           ASSIGN Selected_Idx = pField:BUFFER-VALUE.
  
  END.
run Create_Const_Name.
END PROCEDURE.

PROCEDURE primary :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_primary ~
           ~{&OPEN-QUERY-BROWSE-PRIMARY}

           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_unique.    
           HIDE FRAME frame_check.     
           VIEW FRAME frame_primary.
           DISPLAY  name BROWSE-PRIMARY Active DESC_EDIT2 
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                   WITH FRAME frame_primary.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_primary ="yes".
           ENABLE  name BROWSE-PRIMARY Active DESC_EDIT2 
                 OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF
                 WITH FRAME frame_primary.
          {&OPEN-BROWSERS-IN-QUERY-frame_primary}
         
          RUN Fetch_Primary_Name.
END PROCEDURE.

PROCEDURE primary_save:
   
   IF pField3:BUFFER-VALUE = "I , C" OR pField3:BUFFER-VALUE = "C" THEN DO:
      MESSAGE "Unique constraint already exists on this Index, Primary constraint cannot be" SKIP
              "created on the same Index" VIEW-AS ALERT-BOX ERROR.
   END.
   ELSE DO:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_primary 
                     AND DICTDB._Constraint._Db-Recid = DbRecId  AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:
           num = num + 1.
           CREATE DICTDB._Constraint.
           ASSIGN _Con-Type = "PC".
           ASSIGN   _Con-Name = name:SCREEN-VALUE IN FRAME frame_primary
                    _For-Name = "".
           IF ACTIVE:SCREEN-VALUE IN FRAME frame_primary = "yes" THEN
           ASSIGN _Con-Active = TRUE.
           ELSE _Con-Active = FALSE.
           ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_primary
               _File-recid = file_rec
               _Con-Status = "N"
               _Index-recid = pField5:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
          RUN TEMP1.
          RUN primary.  
          &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
           ASSIGN msg:SCREEN-VALUE IN FRAME frame_primary ="Constraint Created". &ENDIF  
          ASSIGN is-saved = TRUE.                         
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.               
  END.     
END PROCEDURE.           

PROCEDURE check_primary_save:
         
         IF temp.man <> "  I" THEN
             MESSAGE "For creation of Primary constraint all Columns of the Index Should be mandatory" VIEW-AS ALERT-BOX ERROR.
          
         ELSE DO: 
          FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._File-Recid = file_rec
                               AND (DICTDB._Constraint._Con-Type = "P"  OR
                                           DICTDB._Constraint._Con-Type = "PC" OR DICTDB._Constraint._Con-Type = "MP" )
                               AND Dictdb._constraint._Con-Status <> "D" AND DICTDB._constraint._Con-Status <> "O" NO-LOCK NO-ERROR.
           IF AVAILABLE (DICTDB._Constraint)THEN 
           DO:
                MESSAGE "Primary constraint already exists in this table" VIEW-AS ALERT-BOX ERROR.
           END.               
           ELSE DO:
             RUN primary_save.           
           END.
         END.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: unique.i

Description:   
   This file contains the form for unique Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/
{prodict/ora/key/primary.i }


/* Query definitions                                                    */
DEFINE {1} QUERY BROWSE-UNIQUE FOR 
      temp SCROLLING.
      
      /* Browse definitions                                                   */
DEFINE {1} BROWSE BROWSE-UNIQUE
  QUERY BROWSE-UNIQUE NO-LOCK DISPLAY
      temp.ind FORMAT "x(20)":U
      temp.pri FORMAT "x(12)":U
      temp.uni FORMAT "x(12)":U
      temp.man FORMAT "x(15)":U
  WITH NO-ROW-MARKERS SEPARATORS
    &IF "{&WINDOW-SYSTEM}" <> "TTY"
    &THEN SIZE 75 BY 4.52 FIT-LAST-COLUMN.
    &ELSE SIZE 75 BY 8.3 FIT-LAST-COLUMN.
    &ENDIF 

/*    DEFINATION FOR UNIQUE FRAME  */  
&Scoped-define FRAME-NAME frame_unique 
&Scoped-define BROWSE-NAME BROWSE-UNIQUE
&Scoped-define FIELDS-IN-QUERY-BROWSE-UNIQUE temp.pri temp.uni temp.ind temp.man
&Scoped-define ENABLED-FIELDS-IN-QUERY-BROWSE-UNIQUE 
&Scoped-define QUERY-STRING-BROWSE-UNIQUE FOR EACH temp NO-LOCK.    
&Scoped-define OPEN-QUERY-BROWSE-UNIQUE OPEN QUERY BROWSE-UNIQUE FOR EACH temp NO-LOCK.
&Scoped-define TABLES-IN-QUERY-BROWSE-UNIQUE temp
&Scoped-define FIRST-TABLE-IN-QUERY-BROWSE-UNIQUE temp
        
        DEF VAR uintSub AS INTEGER NO-UNDO.
        DEF VAR irec AS INTEGER   NO-UNDO.

        DEFINE VARIABLE uQuery AS HANDLE.
        DEFINE VARIABLE uBrowse AS HANDLE.
        DEFINE VARIABLE uBuffer AS HANDLE.
        DEFINE VARIABLE uField AS HANDLE.
        DEFINE VARIABLE uField1 AS HANDLE.
        DEFINE VARIABLE uField2 AS HANDLE.
        DEFINE VARIABLE uField3 AS HANDLE.
        DEFINE VARIABLE uField4 AS HANDLE.
        DEFINE VARIABLE uField5 AS HANDLE.
        
        uBrowse = BROWSE BROWSE-UNIQUE:HANDLE. /* Browse-3 is browser name */
        uQuery  = uBrowse:QUERY.
        uBuffer = uQuery:GET-BUFFER-HANDLE(1).    
    
FORM
     &IF "{&WINDOW-SYSTEM}" <> "TTY"
     &THEN
     name AT ROW 1.46 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.36 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 8.6 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 10 COL 14 WIDGET-ID 36 NO-LABEL
     msg AT ROW 12.1 COL 2 WIDGET-ID 4 NO-LABEL
     OK_BUT AT ROW 13.3 COL 3
     CREATE_BUT AT ROW 13.3 COL 17
     CANCEL_BUT AT ROW 13.3 COL 31
     HELP_BUT  AT ROW 13.3 COL 60
     "Description:" VIEW-AS TEXT
          SIZE 11 BY .62 AT ROW 10.2 COL 2 WIDGET-ID 38
     "I  - Indicates Progress Index Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 14.5 COL 2 WIDGET-ID 600
     "C - Indicates Constraint Property" VIEW-AS TEXT
          SIZE 50 BY .62 AT ROW 15.3 COL 2 WIDGET-ID 600
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 2.4
         SIZE 80 BY 16 WIDGET-ID 100.
     
     &ELSE
     name AT ROW 2 COL 17 COLON-ALIGNED WIDGET-ID 4
     BROWSE-UNIQUE AT ROW 3.76 COL 76 RIGHT-ALIGNED WIDGET-ID 200
     Active AT ROW 13 COL 2 WIDGET-ID 40
     DESC_EDIT2 AT ROW 15 COL 2 WIDGET-ID 36
     OK_BUT AT ROW 20 COL 18 WIDGET-ID 26
     CREATE_BUT AT ROW 20 COL 35 WIDGET-ID 28
     CANCEL_BUT AT ROW 20 COL 52 WIDGET-ID 30
     WITH FRAME frame_unique
         NO-BOX KEEP-TAB-ORDER OVERLAY 
         SIDE-LABELS NO-UNDERLINE THREE-D 
         AT COL 1 ROW 3
         SIZE 80 BY 21 WIDGET-ID 100.   
     &ENDIF                  
 ASSIGN BROWSE-UNIQUE:COLUMN-RESIZABLE IN FRAME frame_unique        = TRUE.         


ON CHOOSE OF OK_BUT IN FRAME frame_unique
  DO: 
       ASSIGN is-saved = FALSE.
       RUN unique_save.
      IF is-saved THEN
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.         
  END.

ON CHOOSE OF CREATE_BUT IN FRAME frame_unique
 DO:
       RUN unique_save.       
 END. 
 
ON CHOOSE OF CANCEL_BUT IN FRAME frame_unique
  DO:     
       APPLY "CLOSE":U TO THIS-PROCEDURE.
       RETURN NO-APPLY.      
  END.
    
  ON VALUE-CHANGED OF BROWSE-UNIQUE IN FRAME frame_unique
  DO:
      
      RUN unique_validate.
      RUN Fetch_Unique_Name.
  END. 

ON ENTRY OF name IN FRAME frame_unique
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="". 
  &ENDIF
 END.

ON ENTRY OF DESC_EDIT2 IN FRAME frame_unique
 DO:
  &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
  ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique ="". 
  &ENDIF
END.

PROCEDURE Fetch_Unique_Name:
 
  DO uintSub = 1 TO uBrowse:NUM-SELECTED-ROWS : 
     
     
           uBrowse:FETCH-SELECTED-ROW(uintSub).

           uField  = uBuffer:BUFFER-FIELD( "ind" ).
           uField1 = uBuffer:BUFFER-FIELD( "pri" ).
           uField3 = uBuffer:BUFFER-FIELD( "uni" ).
           uField4 = uBuffer:BUFFER-FIELD( "man" ).
           uField5 = uBuffer:BUFFER-FIELD( "rec" ).
           
           ASSIGN Selected_Idx = uField:BUFFER-VALUE.
  
  END.
run Create_Const_Name.
END PROCEDURE.  

PROCEDURE unique :
           &Scoped-define OPEN-BROWSERS-IN-QUERY-frame_unique ~
           ~{&OPEN-QUERY-BROWSE-UNIQUE}

           HIDE FRAME frame_foreign.   
           HIDE FRAME frame_primary. 
           HIDE FRAME frame_check.  
           VIEW FRAME frame_unique.
           DISPLAY name BROWSE-UNIQUE Active DESC_EDIT2
               &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN msg &ENDIF           
                    WITH FRAME frame_unique.
           ASSIGN Active:SCREEN-VALUE IN FRAME frame_unique ="yes".
           ENABLE name BROWSE-UNIQUE Active DESC_EDIT2 
                    OK_BUT CREATE_BUT CANCEL_BUT 
                 &IF "{&WINDOW-SYSTEM}" <> "TTY"
                 &THEN HELP_BUT  
                 &ENDIF 
                  WITH FRAME frame_unique.
            {&OPEN-BROWSERS-IN-QUERY-frame_unique}
           
           RUN Fetch_Unique_Name.           
           RUN unique_validate.
END PROCEDURE.

PROCEDURE unique_save:
    IF NOT CAN-FIND (FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Con-Name = name:SCREEN-VALUE IN FRAME frame_unique 
                     AND DICTDB._Constraint._Db-Recid = DbRecId AND DICTDB._constraint._Con-Status <> "O" AND
                             DICTDB._constraint._Con-Status <> "D") 
    THEN DO:         
          num = num + 1.
          CREATE DICTDB._Constraint.
          ASSIGN _Con-Type = "U"
               _Con-Name = name:SCREEN-VALUE IN FRAME frame_unique
               _For-Name = "".
          IF ACTIVE:SCREEN-VALUE IN FRAME frame_unique = "yes" 
          THEN ASSIGN _Con-Active = TRUE.
          ELSE ASSIGN _Con-Active = FALSE.
          ASSIGN _Con-Desc = DESC_EDIT2:SCREEN-VALUE IN FRAME frame_unique
               _File-recid = file_rec
               _Con-Status = "N"
               _Index-recid = uField5:BUFFER-VALUE
               _Con-Num = num
               _db-recid = DbRecId.
       RUN TEMP1.
       RUN unique.   
       &IF "{&WINDOW-SYSTEM}" <> "TTY"  &THEN
       ASSIGN msg:SCREEN-VALUE IN FRAME frame_unique = "Constraint Created".  &ENDIF 
     ASSIGN is-saved = TRUE.           
    END.       
    ELSE
      MESSAGE "Constraint with this name already exists in the DB" VIEW-AS ALERT-BOX ERROR.                  
END.          
          
PROCEDURE unique_validate:
         
    FIND FIRST DICTDB._Constraint WHERE DICTDB._Constraint._Index-Recid = uField5:BUFFER-VALUE AND(DICTDB._Constraint._con-type = "U" OR
         DICTDB._Constraint._con-type = "P" OR DICTDB._Constraint._con-type = "PC" OR DICTDB._Constraint._con-type = "MP")
         AND (DICTDB._Constraint._Con-Status <> "D" AND DICTDB._Constraint._Con-Status <> "O") AND DICTDB._Constraint._Db-Recid = DbRecid      
   NO-LOCK NO-ERROR.
   IF AVAILABLE (DICTDB._Constraint) 
   THEN DO:
       DISABLE OK_BUT WITH FRAME frame_unique.
       DISABLE CREATE_BUT WITH FRAME frame_unique.
   END.   
   ELSE
       ENABLE  OK_BUT CREATE_BUT WITH FRAME frame_unique.
END.         
          
/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: viewmnt.i

Description:   
   This file contains variables for View Maintain Foreign Constraints.

HISTORY
Author: Kumar Mayur

Date Created:08/05/2011
----------------------------------------------------------------------------*/

{prodict/admnhlp.i }

Define {1} shared variable c_table_name   as character NO-UNDO.
Define {1} shared variable constr_name  as character NO-UNDO.
Define {1} shared variable DbRecId      as recid    NO-UNDO.       
Define {1} shared variable cDbType          as char NO-UNDO./*********************************************************************
* Copyright (C) 2008 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* pro_fld - field editor for Progress files */

/*
dfields is NOT AVAILABLE to create, otherwise contains record to
UPDATE.

When you come into this routine, the field name is already set on the
form.
*/

/* Modification History:
     D. McMann 03/31/98 Added display of _Field-rpos
     DLM       07/13/98 Added _Owner to _File Find
     DLM       11/16/98 Added missed _Owner for pick list
     Mario B.  11/16/98 Added trigger to check for duplicate order numbers
     DLM       05/28/03 Changed HELP text for valid data types 20030528-050
     DLM       07/28/03 Added support for new data types
     DLM       07/29/03 Added value-change of area and caps for size
     DLM       08/12/03 Added logic for prompt for field name with clob and blobs.
     DLM       08/22/03 Increased size of format field to accomidate datetime-tz largest
                        format
     DLM       08/28/03 Changed size limits for Blob and Clobs
     DLM       09/03/03 Changed format of lob-size 20030829-039
     DLM       09/18/03 Changed DESC field to be an editor widget 20030610-041
     DLM       10/21/03 Removed "WHEN COPIED" from display of inindex.
     DLM       10/21/03 Remove UCS2 from code page selection list
     KSM       03/02/05 Removed extra commas in arealist 20050223-091
     KSM       03/04/05 Added (- 1) to Gigabyte calculation for 
                        Max-Size 20050223-001 
     KSM       03/07/05 Added validation to Max-Size field for LOBs
                        20050223-002
    fernando   05/24/06 int64 support - initial value                        
    fernando   06/08/06 int64 support - type change
    fernando   08/10/06 Handle too many tables in db - 20060717-022
    fernando   06/26/08 Filter out schema tables for encryption
*/     

DEFINE INPUT  PARAMETER ronly   AS CHARACTER             NO-UNDO.
DEFINE INPUT  PARAMETER junk2   AS RECID                 NO-UNDO.
DEFINE OUTPUT PARAMETER changed AS LOGICAL INITIAL FALSE NO-UNDO.

DEFINE SHARED BUFFER dfields FOR dictdb._Field.

DEFINE VARIABLE answer    AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE c         AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE copied    AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE i         AS INTEGER                   NO-UNDO.
DEFINE VARIABLE inindex   AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE inother   AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE inview    AS LOGICAL                   NO-UNDO.
DEFINE VARIABLE j         AS INTEGER                   NO-UNDO.
DEFINE VARIABLE neworder  AS INTEGER                   NO-UNDO.
DEFINE VARIABLE lobarea  AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE arealist  AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE areaname  AS CHARACTER INITIAL ?       NO-UNDO.
DEFINE VARIABLE areaMtText AS CHARACTER                NO-UNDO.
DEFINE VARIABLE cpname    AS CHARACTER INITIAL ?       NO-UNDO.
DEFINE VARIABLE cplist    AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE colname   AS CHARACTER INITIAL ?       NO-UNDO.
DEFINE VARIABLE collist   AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE lob-size  AS CHARACTER FORMAT "x(10)" INITIAL "100M" NO-UNDO.
DEFINE VARIABLE size-type AS CHARACTER FORMAT "x"      NO-UNDO.
DEFINE VARIABLE wdth      AS DECIMAL                   NO-UNDO.
DEFINE VARIABLE hldcp     AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE allow_type_change AS LOGICAL           NO-UNDO INIT NO.
DEFINE VARIABLE s_Dtype    AS CHARACTER                 NO-UNDO.
DEFINE VARIABLE s_Initial  AS CHARACTER                 NO-UNDO.
define variable lNoArea    as logical no-undo.
define variable hLabel     as handle no-undo.
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }
{ prodict/pro/fldfuncs.i }
{ prodict/pro/arealabel.i }
/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  /* 1*/ "This field is used in a View or Index - cannot delete.",
  /* 2*/ "This field is used in a View - cannot rename.",
  /* 3*/ "This name is already used by a different field in this file",
  /* 4*/ "There is a field in these tables", /* make sure 4..6 fit in the */
  /* 5*/ "with the same name, pick one to", /* frame format 'x(31)'      */
  /* 6*/ ?, /*see below*/                   /* frame name 'frm_top'      */
  /* 7*/ "You must enter a field name here",
  /* 8*/ "create new field",
  /* 9*/ "Attempt to add with same name as existing field - switching to MODIFY",
  /*10*/ "You can only change an integer field to int64",
  /*11*/ "Invalid data type for a pre-10.1B database",
  /*12*/ "Initial Value has value too large for field type"
].
new_lang[6] = "copy, or press [" + KBLABEL("END-ERROR") + "].".

FORM
  dfields._Field-name LABEL "  Field-Name" FORMAT "x(32)"
    VALIDATE(KEYWORD(dfields._Field-name) = ?,
      "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SPACE
  dfields._Data-type  LABEL "   Data-Type" FORMAT "x(11)"  SKIP
  s_Dtype             LABEL "   Data-Type" FORMAT "x(11)"  
                      AT ROW-OF dfields._Data-type COL-OF dfields._Data-type SKIP
  dfields._Format     LABEL "      Format" FORMAT "x(32)" 
  dfields._Extent     LABEL "     Extent" FORMAT ">>>>"  SKIP

  dfields._Label      LABEL "       Label" FORMAT "x(30)" SPACE(3)
  dfields._Decimals   LABEL "    Decimals" FORMAT ">>>>9" SKIP
  
  dfields._Col-label  LABEL "Column-label" FORMAT "x(30)" SPACE(3)
  dfields._Order      LABEL "       Order" FORMAT ">>>>9"  SKIP

  dfields._Initial    LABEL "     Initial" FORMAT "x(30)" SPACE(3)
  s_Initial           LABEL "     Initial" FORMAT "x(30)" 
                      AT ROW-OF dfields._Initial COL-OF dfields._Initial SPACE(3)
  dfields._Mandatory  LABEL "   Mandatory" FORMAT "yes/no" "(Not Null)" SKIP

  inview              LABEL "Component of-> View" inindex LABEL "Index" 
  dfields._Field-rpos LABEL "Position" FORMAT ">>>>9" 
  dfields._Fld-case   LABEL "Case-sensitive" FORMAT "yes/no" SKIP

  dfields._Valexp     LABEL "Valexp"       VIEW-AS EDITOR
                                           INNER-CHARS 63 INNER-LINES 2
                                           BUFFER-LINES 6 SKIP
  dfields._Valmsg     LABEL "Valmsg"       FORMAT "x(63)" SKIP
  dfields._Help       LABEL "  Help"       FORMAT "x(63)" SKIP
  dfields._Desc       LABEL "  Desc"       VIEW-AS EDITOR
                                           INNER-CHARS 63 INNER-LINES 2
                                           BUFFER-LINES 6 SKIP 
  HEADER ""
  WITH FRAME pro_fld NO-BOX ATTR-SPACE OVERLAY SIDE-LABELS
  ROW (SCREEN-LINES - 19) COLUMN 1 SCROLLABLE.

FORM
    dfields._Field-name LABEL "Field Name" COLON 11 FORMAT "x(32)"
      VALIDATE(KEYWORD(dfields._Field-name) = ?,
        "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SPACE
    areaname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 
             LABEL "Area" COLON 11  
    space areaMtText no-label format "x(20)"  skip(1)
    skip(1)
    lob-size LABEL "Max Size" COLON 11 SKIP
    dfields._Order LABEL "Order" COLON 11 SKIP
    dfields._Desc  LABEL "Desc" COLON 11  VIEW-AS EDITOR
                                             INNER-CHARS 58 INNER-LINES 3
                                             BUFFER-LINES 6 SKIP 
    WITH FRAME pro-blob VIEW-AS DIALOG-BOX
    SIDE-LABELS ROW 2 COLUMN 5 
    TITLE "Blob Field Attributes".

FORM
    dfields._Field-name LABEL "Field Name" COLON 11 FORMAT "x(32)"
    VALIDATE(KEYWORD(dfields._Field-name) = ?,
      "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SKIP
    areaname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 
             LABEL "Area" COLON 11  
    space areaMtText no-label format "x(20)"  skip(1)
    lob-size LABEL "Max Size" COLON 11 SKIP
    dfields._Order LABEL "  Order" COLON 11 SKIP
    dfields._Desc  LABEL "Desc" COLON 11  VIEW-AS EDITOR
                                             INNER-CHARS 58 INNER-LINES 3
                                             BUFFER-LINES 6 SKIP 
    WITH FRAME mod-blob VIEW-AS DIALOG-BOX
    SIDE-LABELS ROW 2 COLUMN 5 
    TITLE "Blob Field Attributes".

FORM
    dfields._Field-name LABEL "Field Name" COLON 15 FORMAT "x(32)"
    areaname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 
             LABEL "Area" COLON 15 
    space areaMtText no-label format "x(20)"  skip(1)
    lob-size LABEL "Max Size" COLON 15 SKIP
    dfields._Order LABEL "Order" COLON 15 SKIP
    dfields._fld-case LABEL "Case Sensitive" COLON 15 SKIP
    cpname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 SORT
           LABEL "Code Page" COLON 15 SKIP
          
    colname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 SORT
            LABEL "Collation" COLON 15 SKIP
    
    dfields._Desc LABEL "Desc" COLON 15  VIEW-AS EDITOR
                                             INNER-CHARS 58 INNER-LINES 3
                                             BUFFER-LINES 6 SKIP 
    WITH FRAME pro-clob VIEW-AS DIALOG-BOX
    SIDE-LABELS ROW 2 CENTERED 
    TITLE "Clob Field Attributes".

FORM
    dfields._Field-name LABEL "Field name" COLON 15 FORMAT "x(32)"
    VALIDATE(KEYWORD(dfields._Field-name) = ?,
      "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SKIP
    areaname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 
             LABEL "Area" COLON 15 
    space areaMtText no-label format "x(20)"  skip(1)
    lob-size LABEL "Max Size" COLON 15 SKIP
    dfields._Order LABEL "Order" COLON 15 SKIP
    dfields._fld-case LABEL "Case Sensitive" COLON 15 SKIP
    cpname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1
           LABEL "Code Page" COLON 15 SKIP
  
    colname VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1
            LABEL "Collation" COLON 15 SKIP
   
    dfields._Desc LABEL "Desc" COLON 15 VIEW-AS EDITOR
                                             INNER-CHARS 58 INNER-LINES 3
                                             BUFFER-LINES 6 SKIP 
    WITH FRAME mod-clob VIEW-AS DIALOG-BOX
    SIDE-LABELS ROW 2 CENTERED 
    TITLE "Clob Field Attributes".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

FORM
  new_lang[4] FORMAT "x(37)" SKIP
  new_lang[5] FORMAT "x(37)" SKIP
  new_lang[6] FORMAT "x(37)" SKIP
  WITH FRAME frm_top OVERLAY NO-ATTR-SPACE NO-LABELS
  ROW pik_row - 5 COLUMN pik_column.

/* ---------------Internal Procedures--------------------------------*/
PROCEDURE set-code-page:
  DEFINE VARIABLE all-cp AS CHARACTER        NO-UNDO.
  DEFINE VARIABLE i      AS INTEGER          NO-UNDO.

  ASSIGN all-cp = GET-CODEPAGES.
 
  DO i = 1 TO NUM-ENTRIES(all-cp):
    IF i = 1 THEN
      ASSIGN cplist = ENTRY(i,all-cp).
    ELSE DO:
      IF ENTRY(i,all-cp) <> "undefined" AND ENTRY(i,all-cp) <> "UCS2" THEN
        ASSIGN cplist = cplist + "," + ENTRY(i,all-cp).
    END.
  END.
  RETURN.
END PROCEDURE.

/* ---------------Triggers------------------------------------------*/
ON GO OF FRAME pro-blob DO:
  IF NEW dfields THEN DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:  
    IF wdth = ? OR wdth = 0  THEN
      APPLY "leave" TO lob-size IN FRAME pro-blob.
    
    if not lNoArea then
    do:
        IF areaname:SCREEN-VALUE IN FRAME pro-blob <> ? THEN
            ASSIGN lobarea = areaname:SCREEN-VALUE IN FRAME pro-blob.
        FIND DICTDB._Area WHERE DICTDB._Area._Area-name =  lobarea NO-LOCK.          
        dfields._Fld-stlen = DICTDB._Area._Area-number.           
    end.  
        
    ASSIGN dfields._Format = "x(8)"
           dfields._Fld-Misc2[1] = CAPS(lob-size:SCREEN-VALUE) 
           dfields._Width = wdth
           dfields._Initial = ?
           dfields._Order = INTEGER(dfields._Order:SCREEN-VALUE)        
           dfields._Field-name = dfields._Field-name:SCREEN-VALUE IN FRAME /*pro_fld*/ pro-blob
           dfields._Desc = dfields._Desc:SCREEN-VALUE
           areaname = ?
           wdth = ?.

  END.  
END.

ON GO OF FRAME mod-blob DO:
  IF lob-size ENTERED THEN
      APPLY "leave" TO lob-size IN FRAME mod-blob.

  ASSIGN dfields._Fld-Misc2[1] = CAPS(lob-size)
         dfields._Width = wdth
         dfields._Order = INTEGER(dfields._Order:SCREEN-VALUE)        
         dfields._Desc = dfields._Desc:SCREEN-VALUE
         dfields._Field-name = dfields._Field-name:SCREEN-VALUE.
    ASSIGN changed = TRUE.
END.

ON GO OF FRAME pro-clob DO:

  FIND DICTDB._DB WHERE RECID(DICTDB._DB) = drec_db NO-LOCK.
  IF NEW dfields THEN DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:  
    IF wdth = ? OR wdth = 0  THEN
      APPLY "leave" TO lob-size IN FRAME pro-clob.

    IF lobarea = ? AND lNoArea = FALSE THEN
      APPLY "value-changed" TO areaname IN FRAME pro-clob.

    IF cpname:SCREEN-VALUE IN FRAME pro-clob <> "*Use DB Code Page" AND
       (colname:SCREEN-VALUE IN FRAME pro-clob = "*Use DB Collation" OR
        colname:SCREEN-VALUE IN FRAME pro-clob = ?) THEN DO:

       APPLY "leave" TO cpname IN FRAME pro-clob.
       MESSAGE "You must select a collation for the selected code page"
                VIEW-AS ALERT-BOX ERROR.
       NEXT-PROMPT colname.
       RETURN NO-APPLY.
    END.
      
    IF cpname:SCREEN-VALUE IN FRAME pro-clob = "*Use DB Code Page" AND DICTDB._Db._Db-xl-name = "undefined" THEN DO:
      MESSAGE "The database code page is 'undefined' " SKIP
              "A clob cannot be defined with this code page." SKIP(1)
              "Select a code page other than '*Use DB Code Page'." SKIP
          VIEW-AS ALERT-BOX ERROR.
      RETURN NO-APPLY.
    END.
    if lNoArea = false then
    do:
        FIND DICTDB._Area WHERE DICTDB._Area._Area-name =  lobarea NO-LOCK.    
        ASSIGN dfields._Fld-stlen = DICTDB._Area._Area-number.
    end.
    else
        assign dfields._Fld-stlen = 0.
        
    assign dfields._Format = "x(8)"
           dfields._Fld-Misc2[1] = CAPS(lob-size:SCREEN-VALUE IN FRAME pro-clob)
           dfields._Width = wdth
           dfields._Initial = ?
           dfields._Order = INTEGER(dfields._Order:SCREEN-VALUE IN FRAME pro-clob) 
           dfields._Fld-case = LOGICAL(dfields._Fld-case:SCREEN-VALUE IN FRAME pro-clob)
           dfields._Desc = dfields._Desc:SCREEN-VALUE
           dfields._Field-name = dfields._Field-name:SCREEN-VALUE IN FRAME pro-clob /*pro_fld*/
           areaname = ?
           wdth = ?
           cpname = ?
           colname = ?.

    IF cpname:SCREEN-VALUE <> "*Use DB Code Page" THEN
      ASSIGN dFields._Charset = INPUT FRAME pro-clob cpname:SCREEN-VALUE
             dFields._Collation = INPUT FRAME pro-clob colname:SCREEN-VALUE
             dFields._Attributes1 = 2.                                      
    ELSE
      ASSIGN dFields._Charset = _Db._Db-xl-name
             dFields._Collation = _Db._Db-coll-name
            dFields._Attributes1 = 1. 
   
  END.  
END.

ON GO OF FRAME mod-clob DO:
  IF lob-size ENTERED THEN
      APPLY "leave" TO lob-size IN FRAME mod-clob.

  ASSIGN dfields._Fld-Misc2[1] = CAPS(lob-size)
         dfields._Width = wdth
         INPUT FRAME mod-clob dfields._Order    
         INPUT FRAME mod-clob dfields._Fld-case
         INPUT FRAME mod-clob dfields._Desc
         INPUT FRAME mod-clob dfields._Field-name.
    ASSIGN changed = TRUE.
END.

ON value-changed OF areaname IN FRAME pro-blob DO:
  ASSIGN lobarea = areaname:SCREEN-VALUE.
  RETURN.
END.

ON value-changed OF areaname IN FRAME pro-clob DO:
  ASSIGN lobarea = areaname:SCREEN-VALUE.
  RETURN.
END.

ON LEAVE OF lob-size IN FRAME pro-blob,
            lob-size IN FRAME mod-blob DO:
  IF NEW dfields THEN 
    ASSIGN lob-size = CAPS(lob-size:SCREEN-VALUE IN FRAME pro-blob).
  ELSE
    ASSIGN lob-size = CAPS(lob-size:SCREEN-VALUE IN FRAME mod-blob).

  /* If the first character is not numeric then return an error
     and reset to the original, or default, value. */
  IF NOT isNumeric(SUBSTRING(lob-size,1,1)) THEN DO:
    MESSAGE "Blob field size must begin with a numeric character!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    IF NEW dfields THEN
      lob-size:SCREEN-VALUE IN FRAME pro-blob = "100M".
    ELSE
      lob-size:SCREEN-VALUE IN FRAME mod-blob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.
  /* Check to see if the user specified an invalid format to the input.
     For instance, they can't begin with an alpha char, they can't
     use invalid alpha chars and, once they've specified a valid char,
     no other values are valid. */
  ELSE IF badFormat("BLOB","lob-size",lob-size) THEN DO:
    MESSAGE "Blob field size contains invalid characters!" SKIP(1)
            "Please enter a numeric value followed by one of" SKIP
            "the following alphabetic values:" SKIP(1) 
            "      B = Bytes    " SKIP
            "K or KB = Kilobytes" SKIP
            "M or MB = Megabytes" SKIP
            "G or GB = Gigabytes" SKIP
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    IF NEW dfields THEN
      lob-size:SCREEN-VALUE IN FRAME pro-blob = "100M".
    ELSE
      lob-size:SCREEN-VALUE IN FRAME mod-blob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.
  IF INDEX(lob-size, "K") <> 0 THEN
    ASSIGN size-type = "K".
  ELSE IF INDEX(lob-size, "M") <> 0 THEN
    ASSIGN size-type = "M".
  ELSE IF INDEX(lob-size, "G") <> 0 THEN
    ASSIGN size-type = "G".
  ELSE IF INDEX(lob-size, "B") <> 0 THEN
    ASSIGN size-type = "B".
  ELSE IF 
      INDEX("ACDEFHIJLNOPQRSTUVWXYZ", 
            SUBSTRING(lob-size, LENGTH(lob-size), 1)) <> 0 THEN DO:
    MESSAGE "Size of blob must be expressed as #B, #K, #M, or #G"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    IF NEW dfields THEN
      lob-size:SCREEN-VALUE IN FRAME pro-blob = "100M".
    ELSE
      lob-size:SCREEN-VALUE IN FRAME mod-blob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.    
  ELSE DO:
    ASSIGN size-type = "B"
           lob-size = lob-size + "B".
    IF NEW dfields THEN
       lob-size:SCREEN-VALUE IN FRAME pro-blob = lob-size.
    ELSE
       lob-size:SCREEN-VALUE IN FRAME mod-blob = lob-size.
  END.

  CASE size-type:
    WHEN "K" THEN DO:
        ASSIGN wdth = 
            INTEGER(TRIM(SUBSTRING(lob-size, 1, (INDEX(lob-size, "K") - 1)))).
        ASSIGN wdth = (wdth * 1024).
    END.
    WHEN "M" THEN DO:
        ASSIGN wdth = 
            INTEGER(TRIM(SUBSTRING(lob-size, 1, (INDEX(lob-size, "M") - 1)))).
        ASSIGN wdth = (wdth * (1024 * 1024)).
    END.
    WHEN "G" THEN
        ASSIGN wdth = 
            INTEGER(TRIM(SUBSTRING(lob-size, 1, (INDEX(lob-size, "G") - 1))))
               wdth = (wdth * (1024 * 1024 * 1024) - 1 ).
    OTHERWISE
        ASSIGN wdth = 
            INTEGER(TRIM(SUBSTRING(lob-size, 1, (INDEX(lob-size, "B") - 1)))). 
  END CASE.

  IF wdth < 1 OR wdth > 1073741823 THEN DO:
    MESSAGE "Size of Blob must be between 1B and 1G" SKIP
                "The default value is 100M" SKIP
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        /* Set size to default 1Mb */
     IF NEW dfields THEN
       lob-size:SCREEN-VALUE IN FRAME pro-blob = "100M".
     ELSE
       lob-size:SCREEN-VALUE IN FRAME mod-blob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.
END.

ON LEAVE OF dfields._Order IN FRAME pro-blob DO:
  IF CAN-FIND(FIRST dictdb._Field WHERE dictdb._Field._File-recid = drec_file 
              AND dictdb._Field._Order = INPUT dfields._Order 
              AND dictdb._Field._Order <> dfields._Order) THEN DO:
            MESSAGE "Order number" TRIM(INPUT dfields._Order) "already exists." 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            /* set order number back to its current value */
            dfields._Order:SCREEN-VALUE = STRING(neworder).
         RETURN NO-APPLY.
  END.
END.

ON LEAVE OF dfields._Order IN FRAME mod-blob DO:
  IF CAN-FIND(FIRST dictdb._Field WHERE dictdb._Field._File-recid = drec_file 
              AND dictdb._Field._Order = INPUT dfields._Order 
              AND dictdb._Field._Order <> dfields._Order) THEN DO:
            
      MESSAGE "Order number" TRIM(INPUT dfields._Order) "already exists." 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            /* set order number back to its current value */
            dfields._Order:SCREEN-VALUE = STRING(neworder).
         RETURN NO-APPLY.
  END.
END.

ON LEAVE OF dfields._Initial IN FRAME pro_fld,
            s_Initial IN FRAME pro_fld
DO:
    IF dfields._Data-type = "INT64" OR 
	( allow_type_change AND INPUT FRAME pro_fld s_Dtype = "INT64") THEN DO:
       IF DECIMAL(SELF:SCREEN-VALUE) > 9223372036854775807 OR 
          DECIMAL(SELF:SCREEN-VALUE) < -9223372036854775808 THEN DO:
           MESSAGE new_lang[12].
           RETURN NO-APPLY.
       END.
    END.
    ELSE IF dfields._Data-type = "INTEGER" THEN DO:
       IF DECIMAL(SELF:SCREEN-VALUE) > 2147483647 OR 
          DECIMAL(SELF:SCREEN-VALUE) < -2147483648 THEN DO:
           MESSAGE new_lang[12].
           RETURN NO-APPLY.
       END.
    END.

END.

ON LEAVE OF lob-size IN FRAME pro-clob,
            lob-size IN FRAME mod-clob
DO:
  IF NEW dfields THEN
    ASSIGN lob-size = CAPS(lob-size:SCREEN-VALUE IN FRAME pro-clob).
  ELSE
    ASSIGN lob-size = CAPS(lob-size:SCREEN-VALUE IN FRAME mod-clob).

  /* If the first character is not numeric then return an error
     and reset to the original, or default, value. */
  IF NOT isNumeric(SUBSTRING(lob-size,1,1)) THEN DO:
    MESSAGE "Blob field size must begin with a numeric character!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    IF NEW dfields THEN
      lob-size:SCREEN-VALUE IN FRAME pro-clob = "100M".
    ELSE
      lob-size:SCREEN-VALUE IN FRAME mod-blob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.
  /* Check to see if the user specified an invalid format to the input.
     For instance, they can't begin with an alpha char, they can't
     use invalid alpha chars and, once they've specified a valid char,
     no other values are valid. */
  IF badFormat("CLOB","lob-size",lob-size) THEN DO:
    MESSAGE "Clob field size contains invalid characters!" SKIP(1)
            "Please enter a numeric value followed by one of" SKIP
            "the following alphabetic values:" SKIP(1)
            "      B = Bytes    " SKIP
            "K or KB = Kilobytes" SKIP
            "M or MB = Megabytes" SKIP
            "G or GB = Gigabytes" SKIP
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    IF NEW dfields THEN
      lob-size:SCREEN-VALUE IN FRAME pro-clob = "100M".
    ELSE
      lob-size:SCREEN-VALUE IN FRAME mod-blob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.
  IF INDEX(lob-size, "K") <> 0 THEN
    ASSIGN size-type = "K".
  ELSE IF INDEX(lob-size, "M") <> 0 THEN
    ASSIGN size-type = "M".
  ELSE IF INDEX(lob-size, "G") <> 0 THEN
    ASSIGN size-type = "G".
  ELSE IF INDEX(lob-size, "B") <> 0 THEN
    ASSIGN size-type = "B".
  ELSE IF INDEX("ACDEFHIJLNOPQRSTUVWXYZ", 
                SUBSTRING(lob-size, LENGTH(lob-size), 1)) <> 0 THEN DO:
    MESSAGE "Size of blob must be expressed as #B, #K, #M, or #G"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    IF NEW dfields THEN
      lob-size:SCREEN-VALUE IN FRAME pro-clob = "100M".
    ELSE
      lob-size:SCREEN-VALUE IN FRAME mod-clob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.    
  ELSE DO:
    ASSIGN size-type = "B"
           lob-size = lob-size + "B".
    IF NEW dfields THEN
       lob-size:SCREEN-VALUE IN FRAME pro-clob = lob-size.
    ELSE
       lob-size:SCREEN-VALUE IN FRAME mod-clob = lob-size.
  END.

  CASE size-type:
    WHEN "K" THEN DO:
        ASSIGN wdth = INTEGER(TRIM(SUBSTRING(lob-size, 1, 
                                             (INDEX(lob-size, "K") - 1)))).
        ASSIGN wdth = (wdth * 1024).
    END.
    WHEN "M" THEN DO:
        ASSIGN wdth = INTEGER(TRIM(SUBSTRING(lob-size, 1, 
                                             (INDEX(lob-size, "M") - 1)))).
        ASSIGN wdth = (wdth * (1024 * 1024)).
    END.
    WHEN "G" THEN
        ASSIGN wdth = INTEGER(TRIM(SUBSTRING(lob-size, 1, 
                                             (INDEX(lob-size, "G") - 1))))
               wdth = (wdth * (1024 * 1024 * 1024) - 1).
    OTHERWISE
        ASSIGN wdth = INTEGER(TRIM(SUBSTRING(lob-size, 1, 
                                             (INDEX(lob-size, "B") - 1)))). 
  END CASE.

  IF wdth < 1 OR wdth > 1073741823 THEN DO:
    MESSAGE "Size of Blob must be between 1B and 1G" SKIP
                "The default value is 100M" SKIP
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        /* Set size to default 1Mb */
     IF NEW dfields THEN
       lob-size:SCREEN-VALUE IN FRAME pro-clob = "100M".
     ELSE
       lob-size:SCREEN-VALUE IN FRAME mod-clob = dfields._Fld-Misc2[1].
    RETURN NO-APPLY.
  END.
END.

ON LEAVE OF cpname IN FRAME pro-clob DO:
 /* ASSIGN colname:LIST-ITEMS IN FRAME pro-clob = "".*/
  IF cpname:SCREEN-VALUE <> "*Use DB Code Page" THEN DO:
    ASSIGN hldcp = GET-COLLATIONS(cpname:SCREEN-VALUE)
           cpname = cpname:SCREEN-VALUE.
        
    DO i = 1 TO NUM-ENTRIES(hldcp):
      IF i = 1 THEN
        ASSIGN collist = ENTRY(i, hldcp)
               colname = collist
               colname:SCREEN-VALUE IN FRAME pro-clob = collist.
      ELSE
        ASSIGN collist = collist + "," + ENTRY(i, hldcp).

    END.
    ASSIGN colname:LIST-ITEMS IN FRAME pro-clob = collist.
  END.
  ELSE DO:
    RUN set-code-page.
    ASSIGN cplist = "*Use DB Code page" + "," + cplist
           collist = "*Use DB Collation"
           cpname:LIST-ITEMS IN FRAME pro-clob = cplist
           colname:LIST-ITEMS IN FRAME pro-clob = collist
           cpname:SCREEN-VALUE = "*Use DB Code page"
           colname:SCREEN-VALUE = "*Use DB Collation".
     
  END.
  RETURN.
END.

ON LEAVE OF s_Dtype IN FRAME pro_fld  DO:
    DEFINE VAR cValue AS CHAR.
    IF NOT NEW dfields THEN DO:
        cValue = INPUT FRAME pro_fld s_Dtype.

        IF cValue NE "int" AND cValue NE "integer"
            AND cValue NE "int64" THEN DO:
            MESSAGE new_lang[10].
            RETURN NO-APPLY.
        END.
    END.
END.

IF NOT AVAILABLE dfields THEN DO:
  CLEAR FRAME pro_fld NO-PAUSE.
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    PROMPT-FOR _Field-name WITH FRAME pro_fld.
    IF INPUT FRAME pro_fld _Field-name = "" THEN DO:
      MESSAGE new_lang[7]. /* nothing entered! */
      UNDO,RETRY.
    END.
  END.
  IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN DO:
    HIDE FRAME pro_fld NO-PAUSE.
    RETURN.
  END.
  FIND FIRST dfields WHERE dfields._File-recid = drec_file
    AND dfields._field-name = INPUT FRAME pro_fld _Field-name NO-ERROR.
  IF AVAILABLE dfields THEN MESSAGE new_lang[9].
END.

copied = FALSE.
IF AVAILABLE dfields THEN DO: /*---------------------------------------------*/
  ASSIGN
    inindex    = CAN-FIND(FIRST dictdb._Index-field 
                          where dictdb._Index-field._Field-recid = recid(dfields))
    inview     = CAN-FIND(FIRST dictdb._View-ref
                 WHERE dictdb._View-ref._Ref-Table = user_filename
                   AND dictdb._View-ref._Base-Col = dfields._Field-name)
    neworder   = dfields._Order
    wdth       = 0.
  
END. /*---------------------------------------------------------------------*/
ELSE DO: /*-----------------------------------------------------------------*/
  FIND LAST dictdb._Field USE-INDEX _Field-Position
    WHERE dictdb._Field._File-recid = drec_file NO-ERROR.
  ASSIGN
    inindex    = FALSE
    inview     = FALSE
    inother    = CAN-FIND(FIRST dictdb._Field 
                          WHERE dictdb._Field._Field-name = INPUT FRAME pro_fld dfields._Field-name)
    neworder   = (IF AVAILABLE _Field THEN dictdb._Field._Order + 10 ELSE 10)
    pik_column = 40
    pik_row    = SCREEN-LINES - 10
    pik_hide   = TRUE
    pik_init   = ""
    pik_title  = ""
    pik_list   = ""
    pik_wide   = FALSE
    pik_multi  = FALSE
    pik_number = FALSE
    pik_count  = 1
    pik_list[1] = "<<" + new_lang[8] + ">>". /* <<create new field>> */

  IF inother THEN DO:
    EMPTY TEMP-TABLE ttpik NO-ERROR.

    IF l_cache_tt THEN DO:
        CREATE ttpik.
        ASSIGN ttpik.i_number = 1
               ttpik.c_name = pik_list[1].
    END.

    FOR EACH dictdb._Field
      WHERE dictdb._Field._Field-name = INPUT FRAME pro_fld dfields._Field-name:
        FOR EACH dictdb._File OF _Field
          WHERE dictdb._File._Db-recid = drec_db AND RECID(dictdb._File) <> drec_file
            AND (dictdb._File._Owner = "PUB" OR dictdb._File._Owner = "_FOREIGN")
          BY dictdb._File._File-name:
          ASSIGN
            pik_count = pik_count + 1.
            /* 20060717-022
               if we have too many tables, need to use temp-table, in case there are
               too many fields with the same name.
            */
            IF l_cache_tt THEN DO:
                CREATE ttpik.
                ASSIGN ttpik.i_number = pik_count
                       ttpik.c_name = _File._File-name.
                RELEASE ttpik.
            END.
            ELSE
                pik_list[pik_count] = _File._File-name.
        END.
    END.

  END.
 
  /* since we can't tell if a field is in another (non-progress)
  schema, we have to wait until we attempt the join above to eliminate
  those candidates.  hence, the following test: */
  IF pik_count <= 1 THEN DO:
      EMPTY TEMP-TABLE ttpik NO-ERROR.
      inother = FALSE.
  END.

  IF inother THEN _in-other: DO:
    PAUSE 0.
    DISPLAY new_lang[4 FOR 3] WITH FRAME frm_top.
    RUN "prodict/user/_usrpick.p".
    HIDE FRAME frm_top NO-PAUSE.
    IF pik_return = 0 OR pik_first BEGINS "<<" THEN LEAVE _in-other.
    FIND dictdb._File WHERE dictdb._File._Db-recid = drec_db AND dictdb._File._File-name = pik_first
                 AND (dictdb._File._Owner = "PUB" OR dictdb._File._Owner = "_FOREIGN" ).
    FIND dictdb._Field OF dictdb._File WHERE dictdb._Field._Field-name =
                                                 INPUT FRAME pro_fld dfields._Field-name.
    ASSIGN
      copied     = TRUE.

    DISPLAY
      dictdb._Field._Field-name @ dfields._Field-name /*match case*/
      dictdb._Field._Data-type  @ dfields._Data-type
      dictdb._Field._Format     @ dfields._Format
      dictdb._Field._Label      @ dfields._Label
      dictdb._Field._Col-label  @ dfields._Col-label
      dictdb._Field._Initial    @ dfields._Initial
      dictdb._Field._Extent     @ dfields._Extent
      dictdb._Field._Decimals   @ dfields._Decimals
      neworder           @ dfields._Order
      dictdb._Field._Mandatory  @ dfields._Mandatory
      dictdb._Field._Fld-case   @ dfields._Fld-case
      dictdb._Field._Field-rpos @ dfields._Field-rpos
      dictdb._Field._Valmsg     @ dfields._Valmsg
      dictdb._Field._Help       @ dfields._Help
            
      WITH FRAME pro_fld.

    /* Can't seem to do @ on a view-as editor widget so: */
    ASSIGN dfields._Valexp:screen-value in frame pro_fld = dictdb._Field._Valexp
           dfields._Desc:SCREEN-VALUE IN FRAME pro_fld = dictdb._Field._Desc.

    EMPTY TEMP-TABLE ttpik NO-ERROR.
  END.
 
  CREATE dfields.
  dfields._File-recid = drec_file.
END. /*---------------------------------------------------------------------*/

DISPLAY inview inindex /* WHEN copied*/ WITH FRAME pro_fld.
 
 
NEXT-PROMPT dfields._Data-type WITH FRAME pro_fld.
IF NEW dfields THEN DO:
  DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    SET
      dfields._Field-name
        VALIDATE(NOT CAN-FIND(dictdb._Field
          WHERE dictdb._Field._File-recid = drec_file
            AND dictdb._Field._Field-name = INPUT dfields._Field-name),
        "")
      dfields._Data-type
        VALIDATE(dfields._Data-type <> ?,"")
      WITH FRAME pro_fld.
    IF dfields._Data-type = ? OR 
        /* don't allow int64 if this is a pre-101b db */
        (is-pre-101b-db AND dfields._Data-type = "int64") THEN DO:
        IF dfields._Data-type = "int64" THEN
           MESSAGE new_lang[11].
        UNDO,RETRY.
    END.
  END.
  IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN DO:
    IF NEW dfields THEN DELETE dfields.
    HIDE FRAME pro_fld NO-PAUSE.
    RETURN.
  END.
  allow_type_change = NO.
END.
ELSE DO:
    
    /* if this is a pre-101b db, don't allow type change */
    IF dfields._Data-type = "integer" AND NOT is-pre-101b-db THEN
       ASSIGN allow_type_change = YES
              s_Dtype = dfields._Data-type.
END.
 
 
IF NOT copied THEN 
    DISPLAY
        dfields._Field-name /*match case*/
        dfields._Data-type
        dfields._Format
        dfields._Label
        dfields._Col-label
        dfields._Initial
        dfields._Extent
        dfields._Decimals
        neworder @ dfields._Order
        dfields._Mandatory
        dfields._Fld-case
        dfields._Field-rpos
        dfields._Valexp
        dfields._Valmsg
        dfields._Help
        dfields._Desc
    WITH FRAME pro_fld.
 
find dictdb._file where recid(dictdb._file) = drec_file no-lock.
lNoArea = dictdb._file._file-attributes[1] and dictdb._file._file-attributes[2] = false.

/* adjust lable to mid position - this is done to math up with for default tenant,
   but we do it always for consistency */
assign
    hLabel = areaname:side-label-handle in frame pro-blob
    hLabel:row = hLabel:row + 1
    hLabel = areaname:side-label-handle in frame pro-clob
    hLabel:row = hLabel:row + 1
    hLabel = areaname:side-label-handle in frame mod-blob
    hLabel:row = hLabel:row + 1
    hLabel = areaname:side-label-handle in frame mod-clob
    hLabel:row = hLabel:row + 1
   /* Align other selection list labels as well for consistency */   
   
    hLabel = colname:side-label-handle in frame pro-clob
    hLabel:row = hLabel:row + 1
    hLabel = colname:side-label-handle in frame mod-clob
    hLabel:row = hLabel:row + 1
    hLabel = cpname:side-label-handle in frame pro-clob
    hLabel:row = hLabel:row + 1
    hLabel = cpname:side-label-handle in frame mod-clob
    hLabel:row = hLabel:row + 1
    .
  

if dictdb._file._file-attributes[1] and dictdb._file._file-attributes[2] then
do:
    assign
        areaMtText = "(for default tenant)":T20
        areaMtText:row in frame pro-blob = 3
        areaMtText:row in frame pro-clob = 3
        areaMtText:row in frame mod-blob = 3
        areaMtText:row in frame mod-clob = 3
        areaMtText:screen-value in frame pro-blob = areaMtText
        areaMtText:screen-value in frame pro-clob = areaMtText
        areaMtText:screen-value in frame mod-blob = areaMtText
        areaMtText:screen-value in frame mod-clob = areaMtText
        .
end.


/*
setAreaLabel(areaname:handle in FRAME pro-blob,dictdb._File._File-Attributes[1]). 
setAreaLabel(areaname:handle in FRAME pro-clob,dictdb._File._File-Attributes[1]). 
setAreaLabel(areaname:handle in FRAME mod-blob,dictdb._File._File-Attributes[1]). 
setAreaLabel(areaname:handle in FRAME mod-clob,dictdb._File._File-Attributes[1]). 
 */
IF ronly = "r/o" THEN DO:
  IF dfields._Data-type = "BLOB" OR dfields._Data-type = "CLOB" THEN 
  DO:
      if lnoArea then
      do:
          areaname = "".
      end.
      else do:    
          IF dfields._Field-rpos <> ? THEN 
          DO:
              
              FIND dictdb._storageobject WHERE dictdb._Storageobject._Db-recid = drec_db
                                         AND dictdb._Storageobject._Object-type = 3
                                         AND dictdb._Storageobject._Object-number = dfields._Fld-stlen
                                         and dictdb._Storageobject._Partitionid = 0
                                         NO-LOCK.
              FIND dictdb._Area WHERE dictdb._Area._Area-number = dictdb._StorageObject._Area-number NO-LOCK.
          END.
          ELSE
              FIND dictdb._Area WHERE dictdb._Area._Area-number = dfields._Fld-stlen NO-LOCK.
              
          ASSIGN areaname:LIST-ITEMS IN FRAME pro-blob = dictdb._Area._Area-name
                 lob-size = dfields._Fld-Misc2[1].
      end.
      DISPLAY areaname 
              lob-size 
              dfields._Order 
              dfields._Desc 
              dfields._Field-name  WITH FRAME pro-blob. 
     
      IF dfields._Data-type = "CLOB" THEN 
      DO :
          ASSIGN  
                 cpname:LIST-ITEMS IN FRAME pro-clob = dfields._Charset
                 colname:LIST-ITEMS IN FRAME pro-clob = dfields._Collation.
            
          DISPLAY dfields._Fld-case
                  cpname 
                  colname WITH FRAME pro-clob. 
      END.
  END.
  { prodict/user/userpaus.i }
  HIDE FRAME pro_fld NO-PAUSE.
  RETURN.
END.

IF dfields._Data-type = "BLOB" THEN DO:
  IF NEW dfields THEN DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
 
    ASSIGN arealist = ?
           lobarea = ?.
    
    if lnoArea then
    do:
        lobarea = "".
    end.    
    else do:    
        FOR EACH DICTDB._Area WHERE DICTDB._Area._Area-num > 6
                                AND DICTDB._Area._Area-type = 6
                                AND NOT CAN-DO ({&INVALID_AREAS}, DICTDB._Area._Area-name)
                                NO-LOCK. 
          IF CAN-FIND(FIRST DICTDB._File WHERE RECID(DICTDB._File) = drec_file
                                           AND DICTDB._File._ianum = DICTDB._Area._Area-Num) THEN
              ASSIGN lobarea = DICTDB._Area._Area-name.
          IF arealist = ? THEN
            ASSIGN arealist = DICTDB._Area._Area-name.            
          ELSE
            ASSIGN arealist = arealist + "," + DICTDB._Area._Area-name.
        END.
      
        IF NUM-ENTRIES(arealist) = 1 THEN
          ASSIGN arealist = arealist.
        
        FIND DICTDB._Area WHERE DICTDB._Area._Area-number = 6 NO-LOCK.
        
        IF lobarea = ? THEN
          ASSIGN lobarea = DICTDB._Area._Area-name.
    
        IF arealist = ? THEN 
          ASSIGN arealist = DICTDB._Area._Area-name.           
        ELSE
          ASSIGN arealist = arealist + "," + DICTDB._Area._Area-name.
    
        ASSIGN areaname:LIST-ITEMS IN FRAME pro-blob = arealist.
    end.
                  
    DISPLAY areaname  lob-size neworder @ dfields._Order dfields._Desc dfields._Field-name WITH FRAME pro-blob.
    ASSIGN areaname:SCREEN-VALUE = lobarea.
    SET areaname when lNoArea = false lob-size dfields._Order dfields._Desc  dfields._Field-name WITH FRAME pro-blob.    
  
  END.
  ELSE DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    if not lNoArea then
    do:
        IF dfields._Field-rpos <> ? THEN DO:
          FIND dictdb._storageobject WHERE dictdb._Storageobject._Db-recid = drec_db
                                AND dictdb._Storageobject._Object-type = 3
                                AND dictdb._Storageobject._Object-number = dfields._Fld-stlen
                                and dictdb._Storageobject._Partitionid = 0
                               NO-LOCK.
          FIND DICTDB._Area WHERE DICTDB._Area._Area-number = dictdb._StorageObject._Area-number NO-LOCK.
        END.
        ELSE
          FIND DICTDB._Area WHERE DICTDB._Area._Area-number = dfields._Fld-stlen NO-LOCK.
    
        ASSIGN areaname:LIST-ITEMS IN FRAME mod-blob = DICTDB._Area._Area-name
               lob-size = dfields._Fld-Misc2[1]. 
    end.
    DISPLAY  dfields._Field-name areaname lob-size dfields._Order dfields._Desc WITH FRAME mod-blob.
    UPDATE lob-size dfields._Order dfields._Desc dfields._Field-name WITH FRAME mod-blob. 
  END.   
END.
ELSE IF dfields._Data-type = "CLOB" THEN DO:
  IF NEW dfields THEN DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    
    
    ASSIGN arealist = ?
           lobarea = ?
           cplist = ?
           collist = ?.
    if lNoarea then
        lobarea = "".
    else 
    do:   
        FOR EACH DICTDB._Area WHERE DICTDB._Area._Area-num > 6
                                AND DICTDB._Area._Area-type = 6
                                AND NOT CAN-DO ({&INVALID_AREAS}, DICTDB._Area._Area-name)
                                NO-LOCK. 
          IF CAN-FIND(FIRST DICTDB._File WHERE RECID(DICTDB._File) = drec_file
                                           AND DICTDB._File._ianum = DICTDB._Area._Area-Num) THEN
              ASSIGN lobarea = DICTDB._Area._Area-name.
          IF arealist = ? THEN
            ASSIGN arealist = DICTDB._Area._Area-name.            
          ELSE
            ASSIGN arealist = arealist + "," + DICTDB._Area._Area-name.
        END.
      
        IF NUM-ENTRIES(arealist) = 1 THEN
          ASSIGN arealist = arealist.
        
        FIND DICTDB._Area WHERE DICTDB._Area._Area-number = 6 NO-LOCK.
        
        IF lobarea = ? THEN
          ASSIGN lobarea = DICTDB._Area._Area-name.
    
        IF arealist = ? THEN 
          ASSIGN arealist = DICTDB._Area._Area-name.           
        ELSE
          ASSIGN arealist = arealist + "," + DICTDB._Area._Area-name.
    
        ASSIGN areaname:LIST-ITEMS IN FRAME pro-clob = arealist.
    end.
    
    RUN set-code-page.
    
    ASSIGN cplist = "*Use DB Code page" + "," + cplist
           collist = "*Use DB Collation"
           cpname:LIST-ITEMS IN FRAME pro-clob = cplist
           colname:LIST-ITEMS IN FRAME pro-clob = collist.           
                
    DISPLAY dfields._Field-name areaname lob-size neworder @ dfields._Order
            dfields._Fld-case cpname colname dfields._Desc WITH FRAME pro-clob.

    ASSIGN areaname:SCREEN-VALUE IN FRAME pro-clob = lobarea
           cpname:SCREEN-VALUE IN FRAME pro-clob = "*Use DB Code page"
           colname:SCREEN-VALUE IN FRAME pro-clob = "*Use DB Collation".

    SET areaname when lNoArea = false lob-size dfields._Order 
        dfields._Fld-case cpname colname dfields._Desc dfields._Field-name WITH FRAME pro-clob.
  END.
  ELSE DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
    if lNoArea then
       areaname = "".
    else do:
        IF dfields._Field-rpos <> ? THEN DO:
          FIND dictdb._storageobject WHERE dictdb._Storageobject._Db-recid = drec_db
                                AND dictdb._Storageobject._Object-type = 3
                                AND dictdb._Storageobject._Object-number = dfields._Fld-stlen
                                and dictdb._Storageobject._Partitionid = 0
                               NO-LOCK.
        
          FIND DICTDB._Area WHERE DICTDB._Area._Area-number = dictdb._StorageObject._Area-number NO-LOCK.
    
        END.
        ELSE
          FIND DICTDB._Area WHERE DICTDB._Area._Area-number = dfields._Fld-stlen NO-LOCK.
    
        ASSIGN areaname:LIST-ITEMS IN FRAME mod-clob = DICTDB._Area._Area-name.
    end.
    assign   
          lob-size = dfields._Fld-Misc2[1]
           cpname:LIST-ITEMS IN FRAME mod-clob = dfields._Charset
           colname:LIST-ITEMS IN FRAME mod-clob = dfields._Collation.
    DISPLAY dfields._Field-name areaname lob-size dfields._Order dfields._Fld-case
            cpname colname dfields._Desc WITH FRAME mod-clob.

    UPDATE lob-size dfields._Order 
        dfields._Fld-case WHEN NOT inindex dfields._Desc dfields._Field-name
        WITH FRAME mod-clob. 
  END.   
END.
ELSE DO:
  NEXT-PROMPT dfields._Format WITH FRAME pro_fld.
  DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:

  /* Dis-allow duplicate order numbers */
    ON LEAVE OF dfields._Order IN FRAME pro_fld DO:
      IF CAN-FIND(FIRST dictdb._Field WHERE
                        dictdb._Field._File-recid = drec_file AND
                        dictdb._Field._Order = INPUT dfields._Order AND
                        dictdb._Field._Order <> dfields._Order) THEN DO:
            MESSAGE "Order number" TRIM(INPUT dfields._Order) "already exists." 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            /* set order number back to its current value */
            dfields._Order:SCREEN-VALUE = STRING(neworder).
         RETURN NO-APPLY.
      END.
    END.

    /* in case the user changes the type to int64, we would fail if the Initial value
       was set to a value that can't fit into an integer, because we don't update the
       field's type in the SET statement below. So we need to store the Initial value
       in a variable and assign it to the real _Initial later on, after the type gets
       changed.
    */
    ASSIGN s_Initial = dfields._Initial.

    IF allow_type_change THEN
        DISPLAY s_Dtype WITH FRAME pro_fld.

    DISPLAY s_initial WITH FRAME pro_fld.

    SET
    dfields._Field-name WHEN NOT INPUT dfields._Field-name BEGINS "_"  
    s_Dtype WHEN allow_type_change /* dfields._Data-type */
    dfields._Format
    dfields._Label
    dfields._Col-label
    s_initial /*dfields._Initial*/
    dfields._Extent    WHEN NEW dfields
    dfields._Decimals  WHEN INPUT dfields._Data-type = "decimal"
    dfields._Order
    dfields._Mandatory
    dfields._Fld-case WHEN INPUT dfields._Data-type = "character"
                        AND (NEW dfields OR NOT inindex)
    dfields._Valexp
    dfields._Valmsg
    dfields._Help
    dfields._Desc
    WITH FRAME pro_fld.

    IF dfields._Field-name ENTERED AND NOT NEW dfields AND inview THEN DO:
      MESSAGE new_lang[2]. /* sorry, used in view */
      UNDO,RETRY.
    END.

    /* check for int -> int64 change */
    IF NOT NEW dfields AND allow_type_change THEN DO:
        IF dfields._Data-type NE INPUT FRAME pro_fld s_Dtype  THEN DO:
            IF INPUT FRAME pro_fld s_Dtype = "int64" THEN DO:
                RUN prodict/pro/_pro_int64.p.
                
                IF RETURN-VALUE NE "mod" THEN
                    UNDO, RETRY.

                /* make the change now - can't do it on the SET statement or
                   we would get error 171 even if the type was not changed
                 */
                ASSIGN dfields._Data-type = "int64".
            END.
        END.
    END.

    /* in case the data type was changed to int64, need to assign Initial after the type
       gets changed 
    */
    ASSIGN dFields._Initial = s_Initial.

    ASSIGN
      dfields._Valexp = (IF TRIM(dfields._Valexp) = "" 
                                           THEN ? 
                                           ELSE TRIM(dfields._Valexp)).
    changed = TRUE.
  END.
END.

IF KEYFUNCTION(LASTKEY) = "END-ERROR" AND NEW dfields THEN DELETE dfields.

HIDE FRAME pro_fld NO-PAUSE.
RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* sql_fld - field editor for Progress/SQL files */

/*
dfields is NOT AVAILABLE to create, otherwise contains record to
UPDATE (you ain't spoz'ta create with Progress/SQL files).

When you come into this routine, the field name is already set on the
form.
*/

DEFINE INPUT  PARAMETER ronly AS CHARACTER            NO-UNDO.
DEFINE INPUT  PARAMETER junk2 AS RECID                NO-UNDO.
DEFINE OUTPUT PARAMETER junk3 AS LOGICAL INITIAL TRUE NO-UNDO.

DEFINE SHARED BUFFER dfields FOR _Field.
DEFINE VARIABLE fld_val AS CHARACTER EXTENT 4 NO-UNDO.
DEFINE VARIABLE foreign AS LOGICAL            NO-UNDO.
DEFINE VARIABLE i       AS INTEGER            NO-UNDO.
DEFINE VARIABLE inindex AS LOGICAL            NO-UNDO.
DEFINE VARIABLE inview  AS LOGICAL            NO-UNDO.
DEFINE VARIABLE j       AS INTEGER            NO-UNDO.

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 2 NO-UNDO INITIAL [
  /* 1*/ "Cannot delete {&PRO_DISPLAY_NAME}/SQL fields.  Use ALTER TABLE/DROP COLUMN.",
  /* 2*/ "Cannot create {&PRO_DISPLAY_NAME}/SQL fields.  Use ALTER TABLE/ADD COLUMN."
].

FORM
  dfields._Field-name LABEL "  Field-Name" FORMAT "x(32)"
    VALIDATE(KEYWORD(dfields._Field-name) = ?,
      "This name conflicts with a {&PRO_DISPLAY_NAME} reserved keyword.") SPACE
  dfields._Data-type  LABEL    "Data-Type" FORMAT "x(9)"  SKIP

  dfields._Format     LABEL "      Format" FORMAT "x(30)" SPACE(3)
  dfields._Extent     LABEL    "   Extent" FORMAT ">>>>"  SKIP

  dfields._Label      LABEL "       Label" FORMAT "x(30)" SPACE(4)
  foreign         NO-LABEL  FORMAT "  Length:/Decimals:" NO-ATTR-SPACE SPACE(0)
  dfields._Decimals NO-LABEL               FORMAT ">>>>9" SKIP

  dfields._Col-label  LABEL "Column-label" FORMAT "x(30)" SPACE(3)
  dfields._Order      LABEL    "    Order" FORMAT ">>>9"  SKIP

  dfields._Initial    LABEL "     Default" FORMAT "x(30)" SPACE(3)
  dfields._Mandatory  LABEL    " Not Null" FORMAT "yes/no" "(Mandatory)" SKIP

  inview             LABEL "Component of-> View" inindex LABEL "Index" SPACE(9)
  dfields._Fld-case   LABEL "Case-sensitive" FORMAT "yes/no" SKIP

/*dfields._Valexp     LABEL "Valexp"       FORMAT "x(70)" SKIP*/
  fld_val[1]         LABEL "Valexp"       FORMAT "x(63)" SKIP
  fld_val[2]         LABEL "      "       FORMAT "x(63)" SKIP
  fld_val[3]         LABEL "      "       FORMAT "x(63)" SKIP
  fld_val[4]         LABEL "      "       FORMAT "x(63)" SKIP
  dfields._Valmsg     LABEL "Valmsg"       FORMAT "x(63)" SKIP
  dfields._Help       LABEL "  Help"       FORMAT "x(63)" SKIP
  dfields._Desc       LABEL "  Desc"       FORMAT "x(70)" SKIP
  HEADER ""
  WITH FRAME sql_fld NO-BOX ATTR-SPACE OVERLAY SIDE-LABELS
  ROW (SCREEN-LINES - 18) COLUMN 1.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

IF NOT AVAILABLE dfields THEN
  FIND FIRST dfields
    WHERE dfields._File-recid= drec_file
    USING FRAME sql_fld _Field-name NO-ERROR.

IF NOT AVAILABLE dfields THEN DO:
  MESSAGE new_lang[2]. /* cannot create */
  { prodict/user/userpaus.i }
  HIDE MESSAGE NO-PAUSE.
  RETURN.
END.

ASSIGN
  inindex = CAN-FIND(FIRST _Index-field OF dfields)
  inview  = CAN-FIND(FIRST _View-ref
            WHERE _View-ref._Ref-Table = user_filename
              AND _View-ref._Base-Col = dfields._Field-name).

{ prodict/dictsplt.i
  &src=dfields._Valexp &dst=fld_val &num=4 &len=63 &chr=" " }

DISPLAY
  inview inindex
  (dfields._Data-type = "character") @ foreign
  dfields._Field-name
  dfields._Data-type
  dfields._Format
  dfields._Label
  dfields._Col-label
  dfields._Initial
  dfields._Extent
  dfields._Decimals
  dfields._Order
  dfields._Mandatory
  dfields._Fld-case
/*dfields._Valexp*/
  fld_val[1 FOR 4]
  dfields._Valmsg
  dfields._Help
  dfields._Desc
  WITH FRAME sql_fld.
NEXT-PROMPT dfields._Format WITH FRAME sql_fld.

IF ronly = "r/o" THEN DO:
  { prodict/user/userpaus.i }
  HIDE FRAME sql_fld NO-PAUSE.
  RETURN.
END.

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  SET
  /*dfields._Field-name*/
  /*dfields._Data-type*/
    dfields._Format
    dfields._Label
    dfields._Col-label
    dfields._Initial
  /*dfields._Extent*/
  /*dfields._Decimals*/
  /*dfields._Order*/
  /*dfields._Mandatory*/
    dfields._Fld-case WHEN NOT inindex AND INPUT dfields._Data-type = "character"
  /*dfields._Valexp*/
    TEXT(fld_val[1 FOR 4])
    dfields._Valmsg
    dfields._Help
    dfields._Desc
    WITH FRAME sql_fld.

  ASSIGN
    dfields._Valexp = fld_val[1] + " " + fld_val[2] + " "
                   + fld_val[3] + " " + fld_val[4]
    dfields._Valexp = (IF dfields._Valexp = "" THEN ? ELSE dfields._Valexp).
END.

HIDE FRAME sql_fld NO-PAUSE.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*-----------------------------------------------------------------------

File:
    prodict/pro/_pro_sys.p
    
Description:
    depending on the input code this routines either creates/updates
    the metaschema-info for the foreign db, or returns specifique info.

Input Parameter:
    system      a   add meta-schema tables
                c   can-delete this _db? (:= no userdefined tables?)
                f   supply list of foreign-names of foreign meta-schema
                p   supply list of progress-names of foreign meta-schema
                q   query for capabilities
                u   supply list of un{dump|load}able foreign object-types

Output Parameter:
    system      a       none
                c       "ok"  or  ""  for "can-delete"  or  "can't delete"
                f,p,u   list of objects
                q       list of allowed/supported functions/features
                
History:
    07/13/98    D. McMann   Added _Owner to _File Find
    95/08       hutegger    added support for "f" and "p"; plus 
                            auto-update functionality for meta-schema
    94/08       hutegger    Index-Capabilities: u changed from 
                            unique-index-allowed to 
                            change-uniqueness-allowed   and
                            removed the "u" from the capab-string

-----------------------------------------------------------------------*/
/*h-*/

/*===========================  DEFINITIONS ============================*/

DEFINE INPUT        PARAMETER dbkey  AS RECID     NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER system AS CHARACTER NO-UNDO.

DEFINE VARIABLE               l_schema-ok   AS LOGICAL   NO-UNDO.
DEFINE VARIABLE               l_sys-obj     AS CHARACTER NO-UNDO.
DEFINE VARIABLE               l_sys-obj-f   AS CHARACTER NO-UNDO.

/*=============================  TRIGGERS  ============================*/

/*=======================  INTERNAL PROCEDURES  =======================*/

/*=========================  INITIALIZATIONS  =========================*/

/* initialize system-objects list */
assign
  l_sys-obj   = ""
  l_sys-obj-f = "".
/* NOTE: If you add a new foreign-meta-schema table be sure to append
 *       its progress-name and foreign-name TO THE END of the lists
 *       above. This way we automatically upgrade old schemaholders
 *       with the new tables.
 */

/* check if meta-schema is up-to-date * /
find first DICTDB._File
  where RECID(DICTDB._File) = dbkey
  and   DICTDB._File._File-name = entry(num-entries(l_sys-obj),l_sys-obj)
  AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN" )
  no-lock no-error. / **/
assign
  l_schema-ok = available DICTDB._File OR dbkey = ?.

/*============================  MAIN CODE  ============================*/


/*
system = "f" for list of foreign-names of meta-schema-objects
-------------------------------------------------------------
*/
IF      system BEGINS "f"
 then assign system = l_sys-obj-f.


/*
system = "p" for list of progress-names of meta-schema-objects
--------------------------------------------------------------
*/
ELSE IF system BEGINS "p"
 then assign system = l_sys-obj.


/*
system = "a" for add system tables
----------------------------------
*/
ELSE IF system BEGINS "a" THEN DO: /* add meta-schema definitions */
END.


/*
system = "c" for can-remove system tables
-----------------------------------------
*/
ELSE IF system BEGINS "c" THEN DO: /* can remove entire schema? */
  /* return OK if the database contains no user files and can be deleted */
  FIND FIRST _File WHERE _File._Db-recid = dbkey NO-ERROR.
  system = STRING(AVAILABLE _File,"/ok").
END.


/*
system = "q" for query
----------------------
  ENTRY 1 = valid database options
            a=after_add, c=can_delete, d=do_delete, u=userid/passwd_supported
  ENTRY 2 = valid file options
            a=add, c=can_copy_fields, d=delete, f=chg_foreign_name,
            g=get_foreign_name, n=can_add_new_fields, o=get_ownername,
            r=rename, s=chg_foreign_size, t=chg_foreign_type
  ENTRY 3 = valid index options
            a=add, b=idxbuild, d=delete, i=inactivate_index,
            n=non-unique_indexes_allowed, r=rename, s=set_primary,
            u=change_uniqueness_allowed, w=word_index, 
             #=index-number-to-be-generated
  ENTRY 4 = load size
  ENTRY 5 = db class and naming conventions
            0=progress_db 1=stand_alone_file 2=part_of_database
            l=logical_name_applies, p=physical_name_applies
  ENTRY 6 = max number index components
  ENTRY 7 = name of sysadmin user ("SA", "DBA", "SYSTEM", "MANAGER", etc.)
  ENTRY 8 = name of system tables ("SYS.*", etc.)
  ENTRY 9 = three-letter dictionary code
  ENTRY 10 = valid sequence options
            a=can_add, d=can_delete, m=can-modify-anything-beyond-name
            n=has_foreign_name o=has_owner, r=can_rename, s=seq_supported
  ENTRY 11 = default-value for code-page
*/
ELSE IF system BEGINS "q" THEN DO:
  system = "u,acdnr,abdinrsw,100,0lp,16,,,pro,admrs,ibm850".
  /* ",o,binsu,100,0lp,16,,,pro" if SQL file */
END.


/*
system = "u" for unloadable/undumpable file types
-------------------------------------------------
*/
ELSE IF system BEGINS "u" THEN DO:
  system = "".
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

{ prodict/user/uservar.i }

DEFINE INPUT-OUTPUT PARAMETER io-dtype     AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-length    AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-pro-type  AS CHARACTER NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER io-gate-type AS CHARACTER NO-UNDO.
DEFINE       OUTPUT PARAMETER io-format    AS CHARACTER NO-UNDO.

assign
  user_env[12] = ?
  user_env[14] = ?.

RETURN.
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*
   FILE: prodict/pro/fldfuncs.i
   
   Description:
     Include file containing functions for use in the Data Dictionary
     Field Properties dialogs.
     
   Created: March 3, 2005  K. McIntosh
   History: 
--------------------------------------------------------------------------- */

/*------------------------------Functions-----------------------------------*/    

/*--------------------------------------------------------------------------*/
/* Name: isNumeric                                                          */
/* Purpose: Check a character to determine if it is numeric                 */
/* Return Type: LOGICAL                                                     */
/* Parameters: INPUT pcChar AS CHARACTER - Character to test                */
/* Note:                                                                    */
/*--------------------------------------------------------------------------*/
FUNCTION isNumeric RETURNS LOGICAL
    ( INPUT pcChar AS CHARACTER ):
  RETURN CAN-DO("1,2,3,4,5,6,7,8,9,0",pcChar).
END FUNCTION.

/*--------------------------------------------------------------------------*/
/* Name: badFormat                                                          */
/* Purpose: Check a string to determine if it's format is bad               */
/* Return Type: LOGICAL                                                     */
/* Parameters: INPUT pcDataType AS CHARACTER  - Data-Type of field string is    */
/*                                              intended for                    */
/*             INPUT pcField    AS CHARACTER - _Field Field to test format for */
/*             INPUT pcFormat   AS CHARACTER - Format value                    */
/* Note:       This function returns a value of TRUE if the format is       */
/*             actually bad.                                                */
/*--------------------------------------------------------------------------*/
FUNCTION badFormat RETURNS LOGICAL
     ( INPUT pcDataType AS CHARACTER,
       INPUT pcField    AS CHARACTER,
       INPUT pcFormat   AS CHARACTER ):
  DEFINE VARIABLE iPos      AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iLobWdth  AS INTEGER     NO-UNDO.
  DEFINE VARIABLE iLastNum  AS INTEGER     NO-UNDO.
  
  DEFINE VARIABLE lHitAlpha AS LOGICAL     NO-UNDO.
  
  DEFINE VARIABLE cLobType  AS CHARACTER   NO-UNDO.

  CASE pcDataType:
    WHEN "CLOB" OR WHEN "BLOB" THEN DO:
      CASE pcField:
        WHEN "lob-size" THEN DO:
          
          CHK-NUM: /* Check for numbers after the first letter. */
          DO iPos = 1 TO LENGTH(pcFormat):
            IF isNumeric(SUBSTRING(pcFormat,iPos,1)) AND
               NOT lHitAlpha THEN NEXT.
            ELSE IF isNumeric(SUBSTRING(pcFormat,iPos,1)) THEN 
              RETURN TRUE.
            ELSE lHitAlpha = TRUE.
            IF (lHitAlpha = TRUE) AND
               iLastNum = 0 THEN
              iLastNum = iPos - 1.
          END.
          /* If we never hit a letter it's perfectly legitimate. */
          IF NOT lHitAlpha THEN RETURN FALSE.

          /* Make sure that only the supported alpha characters are used. */
          ASSIGN iLobWdth = INTEGER(SUBSTRING(pcFormat,1,iLastNum))
                 cLobType = SUBSTRING(pcFormat,iLastNum + 1).
          IF NOT CAN-DO("B,K,KB,M,MB,G,GB",cLobType) THEN
            RETURN TRUE.

          RETURN FALSE.
        END.
      END CASE.
    END. /* When LOB */
  END CASE.

END FUNCTION. /* badFormat */
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _pro_int64.p

Description:   
   Display and handle the int->int64 change confirmation dialog box.

Returns: "mod" if user OK'ed change
      	 "" if user Cancels.

Author: Fernando de Souza
                      
Date Created: 06/08/06

Modified:

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE NEW GLOBAL SHARED VARIABLE l_show AS LOGICAL NO-UNDO INIT NO
                                             VIEW-AS TOGGLE-BOX.

DEFINE BUTTON b_yes LABEL "Yes" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON b_no LABEL "No"   {&STDPH_OKBTN} AUTO-ENDKEY.

Define var retval as char NO-UNDO init "". /* return value */

form
   SKIP({&TFM_WID})
   "If you change this field's data type to int64,  you will not be able to":t71  at  3 
      	       	    view-as TEXT 
    SKIP
   "change the data type back to integer after you commit the changes.":t70  at  3 
      	       	    view-as TEXT 
    SKIP
    "To revert this change back, you will need to dump/load this table.":t72  at  3 
                      view-as TEXT 
    SKIP
     "Do you really want to change this field's data type?"  at  3 
                      view-as TEXT 

    SKIP(1)
    l_show LABEL "&Don't show me this again (for this session)" AT 3

   {adecomm/okform.i
      &STATUS = no
      &OK     = b_yes
      &CANCEL = b_no
      }
   
   with frame confirmation
        DEFAULT-BUTTON b_yes CANCEL-BUTTON b_no
        NO-LABELS  CENTERED
        view-as DIALOG-BOX TITLE "Confirmation of data type change".

/*------------------------------Trigger Code---------------------------------*/

/*----- SELECTION of OK BUTTON or GO -----*/
/*
on GO of frame confirmation	   /* or OK due to AUTO-GO */
do:

end.
*/

/*------------------------------Mainline Code--------------------------------*/

/* assume that the user is ok with the change if they chose not to see this message */
IF l_show THEN
   RETURN "mod".

/* Run time layout for button area. */
{adecomm/okrun.i  
   &FRAME = "frame confirmation" 
   &BOX   = "s_rect_Btns"
   &OK    = "b_yes" 
   &CANCEL = "b_no"
}

do ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE  ON STOP UNDO, LEAVE:
      update b_yes  	      
      	     b_no
             l_show
      	     with frame confirmation.

      ASSIGN retval = "mod".
             l_show = INPUT FRAME confirmation l_show.
end.

hide frame confirmation.
return retval.



/*********************************************************************
* Copyright (C) 2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/pro/_alt-buf-driver.p

Description:
    Driver program for utilities on alternate buffer pool.

Input-Parameters:
    cMode: edit - edit settings

Output-Parameters:
    none
    
History:
    03/12/09  fernando   created

--------------------------------------------------------------------*/
                                
DEFINE INPUT PARAMETER cMode AS CHARACTER NO-UNDO.
DEFINE VARIABLE cMsg         AS CHARACTER NO-UNDO.

/*DEF VAR cMode AS CHAR INIT "edit".*/

{prodict/misc/misc-funcs.i}
{prodict/sec/sec-pol.i}

DEF VAR myObjAttributesCache AS prodict.pro._obj-attrib-util.

IF NOT CAN-DO("edit",cMode) THEN DO:
    MESSAGE 'Called with an invalid context'
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN ERROR. 
END.

IF NOT CONNECTED("DICTDB") THEN DO:
    MESSAGE "DICTDB database is required but it is not connected!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to access this utility!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.
  
IF CAN-DO("READ-ONLY",DBRESTRICTIONS("DICTDB")) THEN DO:
    MESSAGE "The dictionary is in read-only mode - alterations not allowed."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot run this utility with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

DO TRANSACTION ON ERROR UNDO, LEAVE
               ON STOP  UNDO, LEAVE:
   /* this will acquire a schema lock for us on the DICTDB database */
   myObjAttributesCache = NEW prodict.pro._obj-attrib-util().

   RUN prodict/pro/_alt-buf-sel.p (INPUT myObjAttributesCache,
                                   OUTPUT DATASET dsObjAttrs BY-REFERENCE).
    
   IF CAN-FIND(FIRST ttObjAttrs) THEN DO:
      /* now we have the objects selected by the user */

      IF cMode = "edit" THEN DO:
          RUN prodict/pro/_alt-buf-edit.p(INPUT myObjAttributesCache,
                                          INPUT DATASET dsObjAttrs BY-REFERENCE).
          /* if something goes wrong, an error is thrown and we don't get to the
             next statement.
          */
          cMsg = 'Changes committed.'.
      END.
   END.
                
   CATCH ae AS PROGRESS.Lang.AppError:
       /* 'edit' mode returns error if user did not commit, so that we undo
          the transaction. If message is blank, no need to display anything.
       */
       IF ae:GetMessage(1) NE "" THEN
          MESSAGE  ae:GetMessage(1) 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       DELETE OBJECT ae.
   END CATCH.
   FINALLY:
      IF VALID-OBJECT(myObjAttributesCache) THEN
         DELETE OBJECT myObjAttributesCache NO-ERROR.
   END FINALLY.

END.
 
/* display message when all was ok, outside the transaction so that the
   message doesn't hold the transaction open if the user leaves for a while.
*/
IF cMsg NE '' THEN
    MESSAGE cMsg
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
/*********************************************************************
* Copyright (C) 2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/pro/_alt-buf-edit.p

Description:
    Interface for assigning objects to an alternate buffer pool

Input-Parameters:
    myObjAtribObj - _obj-attrib-util object
    dsObjAttrs - dataset with objects selected by user for editing

Output-Parameters:
    none
    
History:
    03/12/09  fernando   created

                            
--------------------------------------------------------------------*/
CREATE WIDGET-POOL.

{prodict/sec/sec-pol.i}
{adecomm/adestds.i}

DEFINE INPUT PARAMETER myObjAtribObj AS CLASS prodict.pro._obj-attrib-util.
DEFINE INPUT PARAMETER DATASET FOR dsObjAttrs.

DEFINE VARIABLE isEditing       AS LOGICAL NO-UNDO.
DEFINE VARIABLE Committed       AS LOGICAL NO-UNDO.
DEFINE VARIABLE onlyOne         AS LOGICAL NO-UNDO.
DEFINE VARIABLE pprompt         AS CHARACTER NO-UNDO.
DEFINE VARIABLE pattern         AS CHARACTER NO-UNDO INITIAL "*".
DEFINE VARIABLE cHelp           AS CHARACTER NO-UNDO.
DEFINE VARIABLE firstUpdate     AS LOGICAL   NO-UNDO INITIAL YES.
DEFINE VARIABLE cObjType        AS CHARACTER NO-UNDO.

/* temp-table for review option */
DEFINE TEMP-TABLE ttReport NO-UNDO
    FIELD obj-name     AS CHAR
    FIELD obj-type     AS CHAR
    FIELD obj-buf-pool AS CHAR
    INDEX obj-name IS UNIQUE obj-name obj-type.

/* temp-table for copy option */
DEFINE TEMP-TABLE ttCopy NO-UNDO
    FIELD seq          AS INT
    FIELD obj-name     AS CHAR
    FIELD obj-type     AS CHAR
    FIELD obj-buf-pool AS CHAR
    INDEX obj-name IS UNIQUE seq obj-name.

DEFINE VARIABLE cbPool AS CHARACTER FORMAT "X(32)":U
    LABEL "Buffer Pool"
     VIEW-AS COMBO-BOX INNER-LINES 3
     DROP-DOWN-LIST SORT
  &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN SIZE 30 BY 1 &ELSE SIZE 42 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE objType AS CHARACTER FORMAT "X(36)":U 
     LABEL "Object Type" 
     VIEW-AS FILL-IN 
     SIZE 36 BY 1 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN SIZE 77 BY 5
&ELSE SIZE 78 BY 3.5 &ENDIF .

DEFINE BUTTON Btn_Commit AUTO-GO 
     LABEL "Co&mmit" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Review
     LABEL "Re&view" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Save 
     LABEL "&Save" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Copy 
     LABEL "Co&py..." 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Revert 
     LABEL "&Revert" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Select_Some   LABEL "&Select Some...".
DEFINE BUTTON Btn_Deselect_Some LABEL "&Deselect Some...".

DEFINE BUTTON btn_Ok     LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN   &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN   /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
   &GLOBAL-DEFINE   STATUS NO
   &GLOBAL-DEFINE   BOX_BTN   &BOX = "rect_Btns"
   &SCOPED-DEFINE   ORIG_OKBOX {&OKBOX}
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
   &GLOBAL-DEFINE   BOX_BTN
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF

/* main browse */
DEFINE QUERY BrowseList FOR ttObjAttrs SCROLLING.
DEFINE BROWSE BrowseList
    QUERY BrowseList NO-LOCK DISPLAY
    ttObjAttrs.disp-name COLUMN-LABEL "Object Name" FORMAT "x(66)":U WIDTH 66
    WITH NO-LABELS NO-ROW-MARKERS
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 77 BY 9 
&ELSE
    SIZE 78 BY 9
&ENDIF
     FIT-LAST-COLUMN.

/* browse for copy option */
DEFINE QUERY browse-Copy FOR ttCopy.
DEFINE BROWSE browse-Copy
   QUERY browse-Copy NO-LOCK DISPLAY
   ttCopy.obj-name COLUMN-LABEL "Object Name" FORMAT "x(65)":U WIDTH 66
   cObjType COLUMN-LABEL "Type" FORMAT "x(4)":U WIDTH 5
   WITH NO-LABELS MULTIPLE SIZE 77 BY 9 FIT-LAST-COLUMN.

/* ************************  Frame Definitions  *********************** */

/* main frame */
DEFINE FRAME Dialog-Frame
     BrowseList AT ROW 1.95 COL 2 WIDGET-ID 2
     objType  AT ROW 11.5 COL 14 COLON-ALIGNED WIDGET-ID 4 
     cbPool
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 14 COL 3
       &ELSE AT ROW 12.7 COL 14 COLON-ALIGNED &ENDIF WIDGET-ID 6
     Btn_Save 
        &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 12 COL 67
        &ELSE AT ROW 11.7 COL 67 &ENDIF WIDGET-ID 8
     Btn_Copy 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 13 COL 67
       &ELSE  AT ROW 12.7 COL 67 &ENDIF WIDGET-ID 10
     Btn_Revert 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 14 COL 67
       &ELSE AT ROW 13.7 COL 67 &ENDIF WIDGET-ID 12
     Btn_Commit AT ROW 15.57 COL 2
     Btn_Cancel AT ROW 15.57 COL 14
     Btn_Review AT ROW 15.57 COL 26 WIDGET-ID 16
     &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
       Btn_Help AT ROW 15.57 COL 69 
     &ENDIF
     "Objects (* = changed):" VIEW-AS TEXT
          SIZE 35 BY .62 AT ROW 1.24 COL 2 WIDGET-ID 22
     RECT-1 
      &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 11 COL 1
      &ELSE AT ROW 11.4 COL 2 &ENDIF WIDGET-ID 24
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
     SPACE(.5) SKIP(1)
&ENDIF
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Alternate Buffer Pool Maintenance"
         DEFAULT-BUTTON Btn_Commit CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
  BROWSE BrowseList:HELP = KBLABEL("GO") + "=Commit " +
                           KBLABEL("END-ERROR") + "=Cancel " +
                           KBLABEL("F5") + "=Copy " +
                           KBLABEL("F6") + "=Revert " +
                           KBLABEL("F7") + "=Review".
      
&ENDIF

/* frame for copy option */
DEFINE FRAME SelectionCopy
   "If you want to copy the setting from the current object to other object(s),"
   VIEW-AS TEXT AT ROW 1 COL 2
   "select them on the list below." 
   VIEW-AS TEXT AT ROW 1.7 COL 2
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
    Btn_Select_Some   AT 15 WIDGET-ID 2
    Btn_Deselect_Some  AT 45 WIDGET-ID 4
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SKIP(.1) &ENDIF
    browse-Copy AT 1 WIDGET-ID 6
   {prodict/user/userbtns.i}
WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
    SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
    TITLE "Copy Current Setting To"
    DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel WIDGET-ID 300.

/* frame for select - deselect some */
DEFINE FRAME  obj_patt
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pprompt  FORMAT "x(40)" NO-LABEL at 2 view-as TEXT
   "Use '*' and '.' for wildcard patterns.":t45 at 2 view-as TEXT 
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pattern  FORMAT "x(50)"   LABEL "Object Name":t17 at 2
   {prodict/user/userbtns.i}
   with view-as DIALOG-BOX TITLE "Select Objects by Pattern Match"
        SIDE-LABELS CENTERED THREE-D
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.

/*adjust buttons to be in the middle for tty */
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN

  DEFINE VARIABLE eff_frame_width1 AS DECIMAL.  /* effective frame width */

  /* first for the main frame */
  ASSIGN eff_frame_width1 = FRAME Dialog-Frame:WIDTH-CHARS - 
                          FRAME Dialog-Frame:BORDER-LEFT-CHARS - 
                          FRAME Dialog-Frame:BORDER-RIGHT-CHARS.

  /* no help button for tty, and buttons in the middle */
   btn_Commit:COLUMN IN FRAME Dialog-Frame  = (eff_frame_width1 -
                          btn_Commit:WIDTH-CHARS IN FRAME Dialog-Frame -
                          btn_Cancel:WIDTH-CHARS IN FRAME Dialog-Frame -
                          btn_Review:WIDTH-CHARS IN FRAME Dialog-Frame -
                           5 ) / 2.
   btn_Cancel:COLUMN IN FRAME Dialog-Frame = btn_Commit:COLUMN IN FRAME Dialog-Frame + 
                            btn_Commit:WIDTH-CHARS IN FRAME Dialog-Frame + 
                                2.5.
   btn_Review:COLUMN IN FRAME Dialog-Frame = btn_Cancel:COLUMN IN FRAME Dialog-Frame + 
                            btn_Cancel:WIDTH-CHARS IN FRAME Dialog-Frame + 
                                2.5.
&ENDIF

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame
DO:
  IF isEditing THEN DO:
      MESSAGE 'You are currently editing the setting for an object.' SKIP
              'Either save or cancel the changes.'
          VIEW-AS ALERT-BOX INFO BUTTONS OK.
      RETURN NO-APPLY.
  END. 
  
  APPLY "END-ERROR":U TO SELF.
END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN

/*----- HELP -----*/

ON CHOOSE OF Btn_Help IN FRAME Dialog-Frame /* Help */
OR HELP OF FRAME Dialog-Frame
DO: /* Call Help Function (or a simple message). */
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Alternate_Buffer_Pool_Maintenance_Dialog_Box},
                               INPUT ?).
  
END.

on HELP of frame obj_patt OR CHOOSE of Btn_Help in frame obj_patt
DO:
   IF FRAME obj_patt:TITLE = "Select Objects by Pattern Match" THEN
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Select_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
   ELSE 
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Deselect_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
END.      	       	


&ENDIF

&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN

ON ANY-PRINTABLE OF BrowseList IN FRAME Dialog-Frame
DO:
    DEF VAR ch   AS CHAR NO-UNDO.
    DEF VAR curr AS CHAR NO-UNDO.

    /* simulate search on tty so user can find object that starts with a given character */
    ch = CHR(LASTKEY).

    BrowseList:FETCH-SELECTED-ROW(1).
    curr = ttObjAttrs.obj-name.

    IF ttObjAttrs.obj-name BEGINS ch THEN DO:
        FIND FIRST ttObjAttrs WHERE obj-name > curr NO-ERROR.

        IF NOT AVAILABLE ttObjAttrs THEN
           FIND FIRST ttObjAttrs WHERE obj-name BEGINS ch NO-ERROR.
    END.
    ELSE
       FIND FIRST ttObjAttrs WHERE obj-name BEGINS ch NO-ERROR.

    IF AVAILABLE ttObjAttrs AND obj-name BEGINS ch THEN DO:
        REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs).
        APPLY "VALUE-CHANGED" TO BrowseList.
    END.
    ELSE
        BrowseList:FETCH-SELECTED-ROW(1).
END.

&ENDIF

ON VALUE-CHANGED OF BrowseList IN FRAME Dialog-Frame
DO:
    DO WITH FRAME Dialog-Frame:
        
        ASSIGN objType = ttObjAttrs.obj-type.

        IF ttObjAttrs.area-buf-pool NE "Primary" THEN
           ASSIGN objType = objType + "  (Area Level Pool: Alternate)".

        cbPool = ttObjAttrs.obj-buf-pool.

        DISPLAY objType cbPool WITH FRAME Dialog-Frame.

        /* if there are changes that can be undone, enable the revert button */
        Btn_Revert:SENSITIVE = (IF ttObjAttrs.disp-name BEGINS "*" THEN YES ELSE NO).

        /* only enable copy if there was a change, and not only one object on the lsit */
        IF NOT onlyOne THEN
           Btn_Copy:SENSITIVE = Btn_Revert:SENSITIVE.
    END.
END.

ON VALUE-CHANGED OF cbPool IN FRAME Dialog-Frame
DO:
    RUN StartEdit.                    
    
END.

ON CHOOSE OF Btn_Save IN FRAME Dialog-Frame 
DO:
    DEFINE VARIABLE reverted AS LOGICAL NO-UNDO.

    DO WITH FRAME Dialog-Frame :

        /* if this is the first update to an object, get an exclusive lock on
           the schema, so that other users get blocked when trying to 
           change any schema table.
        */
        IF firstUpdate THEN DO ON STOP UNDO, RETURN NO-APPLY:
            myObjAtribObj:getDbLock(YES).
            firstUpdate = NO.
        END.

        ttObjAttrs.obj-buf-pool = cbPool:SCREEN-VALUE.

        /* signal that this has changes with an asterisk */
        ttObjAttrs.disp-name = "*" + ttObjAttrs.obj-name.

        /* let's see if this changed the record to the previous state, meaning that
           now there are no effective changes to the record
        */
        FIND FIRST bfttObjAttrs WHERE 
            ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        IF AVAILABLE bfttObjAttrs THEN DO:
            IF bfttObjAttrs.obj-buf-pool = ttObjAttrs.obj-buf-pool THEN DO:
                /* same values, so reject the changes that happened until now */
                BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().
                reverted = YES.
            END.
        END.

        /* refresh column in browse in case we added the asterisk above */
        /* fetch record just in case we lost it due to the reject-row-changes above */
        BrowseList:FETCH-SELECTED-ROW(1).
        DISPLAY ttObjAttrs.disp-name WITH BROWSE BrowseList.

        RUN EndEdit.

        IF reverted THEN
            MESSAGE "This reverted the object setting to its original state." SKIP
                    "You can use the 'Revert' button instead."
                    VIEW-AS ALERT-BOX INFO.

    END.            
END.

ON CHOOSE OF Btn_Copy IN FRAME Dialog-Frame 
DO:
   RUN DoCopy.

   /* refresh the browse in case there were changes made */
   BROWSE BrowseList:REFRESH().

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

    RUN EndEdit.
END.

ON CHOOSE OF Btn_Revert IN FRAME Dialog-Frame 
DO:
    IF INDEX(SELF:LABEL, "Revert") > 0 THEN DO:
        /* we will reject any changes to get the original record before any changes were done */
        FIND FIRST bfttObjAttrs WHERE  ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        IF AVAILABLE bfttObjAttrs THEN DO:
           BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().

            /* refresh column in browse to remove the asterisk */
            /* fetch record since we lost it due to the reject-row-changes */
            BrowseList:FETCH-SELECTED-ROW(1).
            DISPLAY ttObjAttrs.disp-name WITH BROWSE BrowseList.
        END.
    END.

    RUN EndEdit.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 

  ON F5 OF FRAME Dialog-Frame ANYWHERE DO:
    IF Btn_Copy:SENSITIVE IN FRAME Dialog-Frame THEN
       APPLY "CHOOSE" TO Btn_Copy IN FRAME Dialog-Frame.
    ELSE DO:
        BELL.
        RETURN NO-APPLY.
    END.
  END.
             
  ON F6 OF FRAME Dialog-Frame ANYWHERE DO:
    IF Btn_Revert:SENSITIVE IN FRAME Dialog-Frame THEN
       APPLY "CHOOSE" TO Btn_Revert IN FRAME Dialog-Frame.
    ELSE DO:
        BELL.
        RETURN NO-APPLY.
    END.
  END.

  ON F7 OF FRAME Dialog-Frame ANYWHERE DO:
    IF Btn_Review:SENSITIVE IN FRAME Dialog-Frame THEN
       APPLY "CHOOSE" TO Btn_Review IN FRAME Dialog-Frame.
    ELSE DO:
        BELL.
        RETURN NO-APPLY.
    END.
  END.

&ENDIF

ON GO OF FRAME Dialog-Frame 
DO:
  DEF VAR answer AS LOGICAL NO-UNDO.

  IF isEditing THEN DO:
     APPLY "CHOOSE" TO Btn_Save.
     RETURN NO-APPLY.
  END.

  /* if nothing to commit, return */
  IF NOT btn_Commit:SENSITIVE THEN DO:
     BELL.
     RETURN NO-APPLY.
  END.

  MESSAGE 'You are about to save the changes to the database.' SKIP
          'Do you want to proceed ?'
       VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.

  IF answer = NO THEN
     RETURN NO-APPLY.

  /* doCommit will return an error when commit doesn't go through, so we return no-apply and 
     let the user decide what to do.
  */
  DO ON ERROR UNDO, RETURN NO-APPLY.
     RUN doCommit.
  END.
END.


ON END-ERROR OF  FRAME Dialog-Frame OR
   CHOOSE OF Btn_Cancel IN FRAME Dialog-Frame 
DO:
    
    IF isEditing THEN DO:
       APPLY "CHOOSE" TO Btn_Revert.
       RETURN NO-APPLY.
    END.

  /* checkUpdatesBeforeExit will return an error when commit doesn't go through, so we 
     return no-apply and let the user decide what to do.
  */
  DO ON ERROR UNDO, RETURN NO-APPLY:
     RUN checkUpdatesBeforeExit.
  END.

END.

ON CHOOSE OF Btn_Review IN FRAME Dialog-Frame 
DO:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.

    DEF VAR iCount        AS INT      NO-UNDO.
    DEF VAR lUnassigned   AS LONGCHAR NO-UNDO.
    DEF VAR lReport       AS LONGCHAR
        VIEW-AS EDITOR LARGE SCROLLBAR-VERTICAL
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN 
        SIZE 97 BY 15
&ELSE 
        SIZE 77 BY 15 
&ENDIF
        FONT 0 /* fixed font */  NO-UNDO.

    /* now look at the after and before table and see what has really changed */
    FOR EACH bfttObjAttrs:

        FIND FIRST bttObjAttrs WHERE ROWID(bttObjAttrs) = BUFFER bfttObjAttrs:AFTER-ROWID.

        /* should always find it and BUFFER bfttObjAttrs:ROW-STATE = ROW-MODIFIED since we
           only have modified records
        */
        
        IF bttObjAttrs.obj-buf-pool NE bfttObjAttrs.obj-buf-pool THEN DO:
            ASSIGN iCount = iCount + 1.

            IF bttObjAttrs.obj-buf-pool = "Primary" THEN DO:
                lUnassigned = lUnassigned + "  " + bttObjAttrs.obj-name  
                           + " (" + bttObjAttrs.obj-type + ")" + CHR(10).
            END.
            ELSE DO:
                CREATE ttReport.
                ASSIGN ttReport.obj-name = bttObjAttrs.obj-name
                       ttReport.obj-type = bttObjAttrs.obj-type
                       ttReport.obj-buf-pool = bttObjAttrs.obj-buf-pool.
            END.
        END.
        
    END.

    IF iCount > 0 THEN DO:

        lReport =   "Summary of changes to alternate buffer pool" + CHR(10)
                  + "===========================================".

        /* assigned ones */
        FOR EACH ttReport WHERE ttReport.obj-buf-pool NE "Primary" BREAK BY ttReport.obj-buf-pool:
             IF FIRST-OF (ttReport.obj-buf-pool) THEN
                 lReport = lReport + CHR(10) + CHR(10) + 
                           "Assign the following objects to the " + ttReport.obj-buf-pool + 
                           " buffer pool:" + CHR(10).

            lReport = lReport + "  " + ttReport.obj-name 
                      + " (" + ttReport.obj-type + ")" + CHR(10).
            DELETE ttReport.
        END.

        IF lUnassigned NE "" THEN
           lReport = lReport + CHR(10) + CHR(10)
                     + "Assign the following objects to the Primary buffer pool:" +
                      CHR(10) + lUnassigned .

        lReport = lReport + CHR(10) + CHR(10) + "Total number of changes: " + STRING(iCount).

        EMPTY TEMP-TABLE ttReport NO-ERROR.

        /* build a very simple frame and display the report */
        DEFINE BUTTON bClose LABEL "&Close" 
            &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &then SIZE 15 BY 1.14 &ENDIF 
            TOOLTIP "Close window" AUTO-ENDKEY.
        
        DEFINE FRAME frame-report
            lReport NO-LABEL AT ROW 1 COL 1 WIDGET-ID 2 PFCOLOR 0
            bClose 
               &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 16 COL 36
               &ELSE AT ROW 16.4 COL 42 &ENDIF WIDGET-ID 4
            WITH KEEP-TAB-ORDER OVERLAY 
                 SIDE-LABELS NO-UNDERLINE THREE-D CENTERED
                 TITLE "Review changes"
                 VIEW-AS DIALOG-BOX CANCEL-BUTTON bClose DEFAULT-BUTTON bClose
                 &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN  SIZE 99 BY 18
                 &ELSE SIZE 80 BY 18 &ENDIF .
                 
        ON WINDOW-CLOSE OF FRAME frame-report
        DO:
           APPLY 'CHOOSE' TO bClose.
        END.

        DO ON ENDKEY UNDO, LEAVE:
           DISPLAY lReport WITH FRAME frame-report.
           ASSIGN  lReport:READ-ONLY= YES
                   lReport:SENSITIVE = YES.
           UPDATE bClose WITH FRAME frame-report.
        END.
    END.
    ELSE
        MESSAGE "There are no changes to the alternate buffer pool"
        &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN 
        VIEW-AS ALERT-BOX INFO BUTTONS OK &ENDIF .
END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME Dialog-Frame:PARENT eq ?
THEN FRAME Dialog-Frame:PARENT = ACTIVE-WINDOW.

/* Run time layout for button areas for SelectionCopy and obj_patt frames */
{adecomm/okrun.i  
   &FRAME  = "FRAME SelectionCopy" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

{adecomm/okrun.i  
   &FRAME  = "FRAME obj_patt" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  /* start tracking-changes */
  TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = YES.

  RUN populateCombo.

  RUN enable_UI.

  /* get the first row to display the details  */
  APPLY "VALUE-CHANGED" TO BrowseList.

  WAIT-FOR GO OF FRAME Dialog-Frame.
END.
RUN disable_UI.

/* if we got here and the user did not save the changes, we return
   error to the caller so that it undoes the transaction, if there is
   one.
*/
IF NOT Committed THEN 
   RETURN ERROR.


/* **********************  Internal Procedures  *********************** */

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN

/* assign the help string for the widgets on TTY */
PROCEDURE assignHelp:
    IF isEditing THEN
        ASSIGN cHelp = KBLABEL("GO") + "=Save  " +
                       KBLABEL("END-ERROR") + "=Reset"
               cbPool:HELP IN FRAME Dialog-Frame = cHelp
               Btn_Save:HELP = cHelp
               Btn_Review:HELP = cHelp
               Btn_Revert:HELP = cHelp.
    ELSE DO:
        ASSIGN cHelp = BrowseList:HELP IN FRAME Dialog-Frame
               cbPool :HELP    = cHelp
               Btn_Save:HELP     = cHelp
               Btn_Revert:HELP   = cHelp
               Btn_Copy:HELP     = cHelp
               Btn_Cancel:HELP   = cHelp
               Btn_Commit:HELP   = cHelp
               Btn_Review:HELP   = cHelp.
    END.
END PROCEDURE.

&ENDIF

/* PROCEDURE: checkUpdatesBeforeExit
 *            Called when user wants to exit. Check if there are chnages and alert 
 *            to that fact so they get a chance to save them.
 */
PROCEDURE checkUpdatesBeforeExit:
   DEF VAR answer AS LOGICAL NO-UNDO.

   /* if there are any errors trying to save the chnages, we return error */
   IF CAN-FIND (FIRST bfttObjAttrs NO-LOCK) THEN 
   DO ON ERROR UNDO, RETURN ERROR:
       
       /* initialize as the cancel button */
       ASSIGN answer = ?.

       MESSAGE 'You have not saved the current changes to the database.' SKIP
               'The changes will be lost once you exit this utility.' SKIP(1)
               'Do you wish to save the changes before you exit?'
           VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL UPDATE answer.

       IF answer = ? THEN
          RETURN ERROR /*cancel */.
       ELSE IF answer = YES THEN DO:
           /* doCommit will return an error when commit doesn't go through, so we 
             return error. Caller should return no-apply and let the user decide what to do.
           */
           RUN doCommit.
       END.

   END.

END PROCEDURE.

/* PROCEDURE: disable_UI
 *            Disable widgets
 */
PROCEDURE disable_UI :
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

/* PROCEDURE: doCommit
 *            Commit changes to the database
 */
PROCEDURE doCommit:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.
    DEFINE VARIABLE answer AS LOGICAL NO-UNDO.

    /* check if there are any that haven't been changed */
    FIND FIRST bttObjAttrs WHERE NOT bttObjAttrs.disp-name BEGINS "*" NO-ERROR.
    IF AVAILABLE bttObjAttrs THEN DO:
        MESSAGE "Some of the selected objects have not been changed." SKIP
                "Do you want to proceed?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
        IF answer = NO THEN DO:
            REPOSITION BrowseList TO ROWID ROWID(bttObjAttrs).
            APPLY "VALUE-CHANGED" TO BrowseList IN FRAME Dialog-Frame.
            RETURN ERROR.
        END.
    END.

    /* now pass the changes to our utility object and save them to the db */
    myObjAtribObj:updateSettings(INPUT ?, INPUT DATASET dsObjAttrs BY-REFERENCE).

    /* if updateSettings throws error, we won't get here, will get in the catch block below */
    ASSIGN Committed = YES.

    CATCH e AS PROGRESS.Lang.ProError:
       MESSAGE 'Failed to save changes.' skip e:GetMessage(1)
           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       
       DELETE OBJECT e.
       /* we return error which then will get propagated so that we let the user decide what to do */
       RETURN ERROR.
       
    END CATCH.

END PROCEDURE.

/* PROCEDURE: doCopy
 *            Copy settings from current object to other object(s)
 */
PROCEDURE doCopy:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.

    DEF VAR rRowid   AS ROWID NO-UNDO.

    ON WINDOW-CLOSE OF FRAME SelectionCopy
    DO:
         APPLY "END-ERROR":U TO SELF.
    END.

    ON ROW-DISPLAY OF browse-Copy IN FRAME SelectionCopy
    DO:
        CASE ttCopy.obj-type:
            WHEN "TABLE" THEN
                cObjType = "Tbl".
            WHEN "INDEX" THEN
                cObjType = "Idx".
            OTHERWISE
                cObjType = ttCopy.obj-type.
        END CASE.
    END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN

    ON CHOOSE OF Btn_Help IN FRAME SelectionCopy /* Help */
    OR HELP OF FRAME SelectionCopy
    DO: /* Call Help Function (or a simple message). */
        RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                                   INPUT "CONTEXT", 
                                   INPUT {&Copy_Current_Setting_To},
                                   INPUT ?).  
    END.
&ENDIF

    ON CHOOSE OF Btn_Select_Some IN FRAME SelectionCopy
    DO:
       DEFINE VARIABLE n        AS INT    NO-UNDO.
       DEFINE VARIABLE rrowid   AS ROWID  NO-UNDO.

       ASSIGN n = browse-Copy:FOCUSED-ROW.

       ASSIGN FRAME obj_patt:TITLE = "Select Objects by Pattern Match"
              pprompt = "Enter name of object to select.".

       display pprompt with frame obj_patt.

       do ON ENDKEY UNDO, LEAVE:
          update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
              with frame obj_patt.

          pattern = TRIM(pattern).
          IF pattern = "*" THEN
             browse-Copy:SELECT-ALL().
          ELSE DO:
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
              /* can't have this since this causes issues with selected rows
                 on multi-select browse on tty - OE00172180 
              */
              browse-Copy:SET-REPOSITIONED-ROW(n,"conditional").
&ENDIF
              /* don't look at the one selected on the main browse, as it's
                 not in browse-Copy - see open query below.
              */
              FOR EACH ttCopy WHERE ttCopy.obj-name NE ttObjAttrs.obj-name AND
                              ttCopy.obj-buf-pool NE ttObjAttrs.obj-buf-pool AND
                              ttCopy.obj-name MATCHES pattern.
                  /* store the rowid of the first row selected so we move
                     focus to it later.
                  */
                  IF rrowid = ? THEN
                      rrowid = ROWID(ttCopy).
                  REPOSITION browse-Copy TO ROWID ROWID(ttCopy).
                  browse-Copy:SELECT-ROW(browse-Copy:FOCUSED-ROW).
              END.

              /* move to the first selected, if any*/
              IF rrowid NE ? THEN
                  REPOSITION browse-Copy TO ROWID rrowid.
          END.

    &IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
        /* On tty Windows, we end up with a weird behavior, as if a line in the browse is
           selected, even though the focus in on something else, so this does the trick.
        */
        IF SELF:TYPE NE "Browse" THEN
           APPLY "leave" TO browse-Copy.
        APPLY "entry" TO SELF.
    &ENDIF

       END.
    END.

    ON CHOOSE OF Btn_Deselect_Some IN FRAME SelectionCopy
    DO:
       DEFINE VAR nRows AS INTEGER NO-UNDO.
       DEFINE VAR i     AS INTEGER NO-UNDO.

       ASSIGN FRAME obj_patt:TITLE = "Deselect Objects by Pattern Match"
              pprompt = "Enter name of object to deselect.".

       display pprompt with frame obj_patt.

       do ON ENDKEY UNDO, LEAVE:
          update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
               with frame obj_patt.

          pattern = TRIM(pattern).
          nRows = browse-Copy:NUM-SELECTED-ROWS.

          IF nRows > 0 THEN DO:
              IF pattern = "*" THEN
                 browse-Copy:DESELECT-ROWS().
              ELSE DO:
                   rpt-blk:
                   REPEAT i = 1 TO nRows:
                       browse-Copy:FETCH-SELECTED-ROW(i).
                       IF ttCopy.obj-name MATCHES pattern THEN DO:
                            browse-Copy:DESELECT-SELECTED-ROW(i).
                            /* now that we have deselected the row, decrement the counters */
                            ASSIGN i = i - 1
                                   nRows = nRows - 1.
                       END.
                   END.
              END.
          END.
       END.
    END.

    ON GO OF FRAME SelectionCopy
    DO:
        DEF VAR i        AS INT     NO-UNDO.
        DEF VAR j        AS INT     NO-UNDO.
        DEF VAR cPool    AS CHAR    NO-UNDO.

        ASSIGN i = browse-Copy:NUM-SELECTED-ROWS IN FRAME SelectionCopy.
        IF i = 0 THEN DO:
            MESSAGE "Select ay least one object or press Cancel"
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.

            RETURN NO-APPLY.
        END.

        cPool = ttObjAttrs.obj-buf-pool.

        REPEAT j = 1 TO i:
            browse-Copy:FETCH-SELECTED-ROW(j).
            FIND FIRST bttObjAttrs WHERE bttObjAttrs.obj-name = ttCopy.obj-name AND
                bttObjAttrs.obj-type = ttCopy.obj-type.
            /* if the values are different, assign them */
            IF bttObjAttrs.obj-buf-pool NE cPool THEN DO:
                ASSIGN bttObjAttrs.obj-buf-pool = cPool
                       bttObjAttrs.disp-name = "*" + bttObjAttrs.obj-name.

                /* let's see if this changed the record to the previous state, meaning that
                   now there are no effective changes to the record
                */
                FIND FIRST bfttObjAttrs WHERE 
                    ROWID(bfttObjAttrs) = BUFFER bttObjAttrs:BEFORE-ROWID NO-ERROR.
                IF AVAILABLE bfttObjAttrs THEN DO:
                    IF bfttObjAttrs.obj-buf-pool = bttObjAttrs.obj-buf-pool THEN DO:
                        /* same values, so reject the changes that happened until now */
                        BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().
                    END.
                END.
            END.
        END.
    END.

    DO ON ERROR UNDO, LEAVE
       ON STOP UNDO, LEAVE
       ON ENDKEY UNDO, LEAVE: /* trap errors */

        /* check if there is any with a different setting */
        FIND FIRST bttObjAttrs 
             WHERE bttObjAttrs.obj-buf-pool NE
                   ttObjAttrs.obj-buf-pool NO-ERROR.

        IF NOT AVAILABLE bttObjAttrs THEN DO:
           MESSAGE "All objects on the list already have the same setting as"
                   "the current one." 
               VIEW-AS ALERT-BOX INFO.

        END.
        ELSE DO:

            IF NOT CAN-FIND (FIRST ttCopy) THEN DO:
                /* populate the table the first time */
                FOR EACH bttObjAttrs:
                    CREATE ttCopy.
                    ASSIGN ttcopy.seq = bttObjAttrs.seq-num
                           ttCopy.obj-name = bttObjAttrs.obj-name
                           ttCopy.obj-type = bttObjAttrs.obj-type
                           ttCopy.obj-buf-pool = bttObjAttrs.obj-buf-pool.
                    RELEASE ttCopy.
                END.
            END.
            ELSE DO:
                /* make sure the table is up-to-date */
                FOR EACH bttObjAttrs:
                    FIND FIRST ttCopy WHERE ttCopy.obj-name EQ bttObjAttrs.obj-name AND
                               ttCopy.obj-type EQ bttObjAttrs.obj-type.
                    ASSIGN ttCopy.obj-buf-pool = bttObjAttrs.obj-buf-pool.
                    RELEASE ttCopy.
                END.
            END.
    
            /* exclude the currently selected one from the Copy browse */
            FIND ttCopy WHERE ttCopy.obj-name EQ ttObjAttrs.obj-name AND
                ttCopy.obj-type EQ ttObjAttrs.obj-type NO-LOCK.
            rRowid = ROWID(ttCopy).
            RELEASE ttCopy.
    
            /* show only the objects that have different settings */
            OPEN QUERY browse-Copy FOR EACH ttCopy WHERE 
               ROWID(ttCopy) NE rRowid AND 
               ttCopy.obj-buf-pool NE ttObjAttrs.obj-buf-pool.
    
            DISPLAY browse-Copy WITH FRAME SelectionCopy.
    
            ENABLE browse-Copy Btn_Select_Some Btn_Deselect_Some Btn_OK Btn_Cancel
                &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
                WITH FRAME SelectionCopy.
    
            WAIT-FOR GO OF FRAME SelectionCopy.
    
            CLOSE QUERY browse-Copy.
        END.
    END.

    /* we are done one way or the other */
    HIDE FRAME SelectionCopy.

END PROCEDURE.

/* PROCEDURE: enable_UI
 *            Enable widgets
 */
PROCEDURE enable_UI :
  DISPLAY BrowseList cbPool WITH FRAME Dialog-Frame.
  ENABLE RECT-1 BrowseList cbPool Btn_Cancel
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
      /*Btn_Save*/
      WITH FRAME Dialog-Frame.

  VIEW FRAME Dialog-Frame.
  OPEN QUERY BrowseList FOR EACH ttObjAttrs NO-LOCK INDEXED-REPOSITION.

  /* remember that user selected just 1 object, so we don't enable the Copy option */
  IF QUERY BrowseList:NUM-RESULTS = 1 THEN
      ASSIGN onlyOne = YES.

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
  /* assign help */
  RUN assignHelp.
&ENDIF

END PROCEDURE.

/* PROCEDURE: EndEdit
 *            Called when user reset or save changes to current object
 */
PROCEDURE EndEdit:
    
    ASSIGN isEditing = NO
           Btn_Revert:LABEL IN FRAME Dialog-Frame = "&Revert".

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
    RUN assignHelp.
&ENDIF

    DISABLE Btn_Save Btn_Revert WITH FRAME Dialog-Frame.
    ENABLE BrowseList Btn_Cancel WITH FRAME Dialog-Frame.

    /* get values from record */
    APPLY "VALUE-CHANGED" TO BrowseList.
    
    ASSIGN btn_Commit:SENSITIVE = CAN-FIND (FIRST bfttObjAttrs NO-LOCK)
           btn_Review:SENSITIVE = btn_Commit:SENSITIVE.
      
     /* go back to the browse */ 
     APPLY "ENTRY" TO BrowseList.
END PROCEDURE.

/* PROCEDURE: populateCombo
 *            Populate combo-box with pool names
 */
PROCEDURE populateCombo:         
    DEFINE VARIABLE cList         AS CHAR    NO-UNDO.

   ASSIGN cbPool:LIST-ITEMS IN FRAME Dialog-Frame = myObjAtribObj:BufferPoolNames.
 
END PROCEDURE.

/* PROCEDURE: startEdit
 *            Called when user makes a change to the current object
 */
PROCEDURE startEdit:

    ASSIGN isEditing = YES
           Btn_Revert:LABEL IN FRAME Dialog-Frame = "&Reset".

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
    RUN assignHelp.

    APPLY "ENTRY" TO SELF.
&ENDIF


    ENABLE Btn_Save Btn_Revert WITH FRAME Dialog-Frame.
    DISABLE BrowseList Btn_Copy Btn_Commit Btn_Cancel WITH FRAME Dialog-Frame.


END PROCEDURE.
/*********************************************************************
* Copyright (C) 2009-2010 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/pro/_alt-buf-sel.p

Description:
    Interface for choosing objects for alternate buffer pool

Input-Parameters:
    myObjAtribObj - _obj-attrib-util object
    dsObjAttrs - dataset with objects selected by user

Output-Parameters:
    none
    
History:
    03/12/09  fernando   created

--------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

USING prodict.pro.*.

ROUTINE-LEVEL ON ERROR UNDO, THROW.

{prodict/sec/sec-pol.i}
{adecomm/adestds.i}

/* Parameters Definitions ---                                           */

DEFINE INPUT  PARAMETER myObjAtribObj AS CLASS _obj-attrib-util.
DEFINE OUTPUT PARAMETER DATASET FOR dsObjAttrs.

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE pprompt             AS CHARACTER NO-UNDO.
DEFINE VARIABLE pattern             AS CHARACTER NO-UNDO INITIAL "*".
DEFINE VARIABLE cHeader             AS CHARACTER NO-UNDO EXTENT 2 FORMAT "X(77)".
DEFINE VARIABLE cHelp               AS CHARACTER NO-UNDO.
DEFINE VARIABLE cPreviousPoolSel    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cObjFlag            AS CHARACTER NO-UNDO.
DEFINE VARIABLE cObjType            AS CHARACTER NO-UNDO.

DEFINE VARIABLE msg                 AS CHARACTER NO-UNDO EXTENT 1 INITIAL
    ["Select at least one object or press Cancel"
    ].

DEFINE BUTTON btn_Ok     LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN   &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN   /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
   &GLOBAL-DEFINE   STATUS NO
   &GLOBAL-DEFINE   BOX_BTN   &BOX = "rect_Btns"
   &SCOPED-DEFINE   ORIG_OKBOX {&OKBOX}
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
   &GLOBAL-DEFINE   BOX_BTN
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF


/* ***********************  Control Definitions  ********************** */

DEFINE BUTTON Btn_Select_Some 
     LABEL "&Select Some..." .

DEFINE BUTTON Btn_Deselect_Some 
     LABEL "&Deselect Some...". 

DEFINE RECTANGLE Rect1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 76 BY 5.
&ELSE SIZE 77 BY 2.73 &ENDIF.

/*DEFINE VARIABLE TogTables AS LOGICAL INITIAL YES 
     LABEL "&Tables" 
     VIEW-AS TOGGLE-BOX
     SIZE 14.6 BY .81 NO-UNDO. */

DEFINE VARIABLE TogIndex AS LOGICAL INITIAL YES 
     LABEL "Show &Indexes" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 18.6 BY .81 &endif NO-UNDO.

DEFINE VARIABLE TogLobs AS LOGICAL INITIAL NO 
     LABEL "Show &LOBs" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 16.6 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE cSelPool AS CHARACTER
    LABEL "&Pool(s) Filter"
    VIEW-AS SELECTION-LIST MULTIPLE SORT
    INNER-CHARS 20 
    INNER-LINES &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN 3 &ELSE 2 &ENDIF
    NO-UNDO.

DEFINE QUERY BrowseList FOR ttObjAttrs SCROLLING.

DEFINE BROWSE BrowseList
    QUERY BrowseList NO-LOCK DISPLAY
        ttObjAttrs.disp-name COLUMN-LABEL "Object Name" FORMAT "x(65)":U WIDTH 65
       cObjFlag COLUMN-LABEL "Flag" FORMAT "X":U 
    &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN WIDTH 1 &ELSE WIDTH 2 &ENDIF
       cObjType COLUMN-LABEL "Type" FORMAT "x(4)":U WIDTH 4
    WITH NO-LABELS MULTIPLE
    &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 76 BY 7 
    &ELSE
    SIZE 77 BY 9 
    &ENDIF
    FIT-LAST-COLUMN.

/* ************************  Frame Definitions  *********************** */

/* frame for select / deselect some */
DEFINE FRAME  obj_patt
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pprompt  FORMAT "x(40)" NO-LABEL at 2 view-as TEXT
   "Use '*' and '.' for wildcard patterns.":t45 at 2 view-as TEXT 
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pattern  FORMAT "x(50)"   LABEL "Object Name":t17 at 2
   {prodict/user/userbtns.i}
   with view-as DIALOG-BOX TITLE "Select Objects by Pattern Match"
        SIDE-LABELS CENTERED THREE-D
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.

/* don't want box for this one */
&UNDEFINE OKBOX
&GLOBAL-DEFINE OKBOX NO

/* main frame */
DEFINE FRAME ObjSelFrame
     cHeader[1] NO-LABEL VIEW-AS TEXT
          SIZE 75 BY .62 
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 1 COL 2
          &ELSE AT ROW 1 COL 2 WIDGET-ID 30 &ENDIF          
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    cHeader[2] NO-LABEL VIEW-AS TEXT
         SIZE 75 BY .62 AT ROW 2 COL 2
&ENDIF          
     Btn_Select_Some 
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 15
       &ELSE AT ROW 2 COL 20 WIDGET-ID 8 &ENDIF
     Btn_Deselect_Some
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 45
       &ELSE AT ROW 2 COL 38  WIDGET-ID 8 &ENDIF
      "(* = not in the primary buffer pool)" VIEW-AS TEXT
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
            AT ROW 5 COL 1
&ELSE
            SIZE 75 BY .62 AT ROW 3.2 COL 2
&ENDIF
     BrowseList
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 6 COL 1
       &ELSE AT ROW 4 COL 2 WIDGET-ID 2  &ENDIF 
     TogIndex 
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 3
       &ELSE AT ROW 13.4 COL 3 WIDGET-ID 12 &ENDIF
     TogLobs
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 15 COL 3
       &ELSE AT ROW 14.4 COL 3 WIDGET-ID 14 &ENDIF
    Rect1
      &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 13 COL 1
      &ELSE AT ROW 13.2 COL 2 WIDGET-ID 10 &ENDIF 
    cSelPool
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 30
       &ELSE AT ROW 13.5 COL 33 WIDGET-ID 18 &ENDIF
    {prodict/user/userbtns.i}
    WITH 
         VIEW-AS DIALOG-BOX ROW 1 CENTERED
         KEEP-TAB-ORDER SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Object Selector"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.

/* revert to original value */
&UNDEFINE OKBOX
&GLOBAL-DEFINE OKBOX {&ORIG_OKBOX}

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME ObjSelFrame /* Object Selector */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
/*----- HELP -----*/

ON CHOOSE OF Btn_Help IN FRAME ObjSelFrame /* Help */
OR HELP OF FRAME ObjSelFrame
DO: /* Call Help Function  */
  
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Alternate_Buffer_Pool_Object_Selector_Dialog_Box},
                               INPUT ?).
END.

on HELP of frame obj_patt OR CHOOSE of Btn_Help in frame obj_patt
DO:
   IF FRAME obj_patt:TITLE = "Select Objects by Pattern Match" THEN
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Select_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
   ELSE 
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Deselect_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
END.      	       	

&ENDIF

ON ROW-DISPLAY OF BrowseList
DO:
    /* to save space, make the obj type shorter */
    CASE ttObjAttrs.obj-type:
        WHEN "TABLE" THEN
            cObjType = "Tbl".
        WHEN "INDEX" THEN
            cObjType = "Idx".
        OTHERWISE
            cObjType = ttObjAttrs.obj-type.
    END CASE.

    /* cObjFlag = '*' when not in primary buffer pool */
    IF ttObjAttrs.obj-buf-pool = "PRIMARY" THEN
       cObjFlag = "".
    ELSE
       cObjFlag = "*".
END.

ON GO OF FRAME ObjSelFrame
DO:
    DEFINE VARIABLE nRows  AS INTEGER NO-UNDO.
    DEFINE VARIABLE i      AS INTEGER NO-UNDO.

    /* make sure there is at least one object selected */
    nRows = BrowseList:NUM-SELECTED-ROWS NO-ERROR.
    IF nRows <= 0 THEN DO:
        MESSAGE msg[1]
         VIEW-AS ALERT-BOX ERROR BUTTONS OK.

        RETURN NO-APPLY.
    END.
    
   REPEAT i = 1 TO nRows:
       BrowseList:FETCH-SELECTED-ROW(i).
       ASSIGN ttObjAttrs.obj-selected = YES.
   END.

   /* only leave the selected ones */
   FOR EACH ttObjAttrs WHERE ttObjAttrs.obj-selected = NO.
       DELETE ttObjAttrs.
   END.
END.

ON VALUE-CHANGED OF cSelPool IN FRAME ObjSelFrame
DO:
IF SELF:SCREEN-VALUE = ? THEN DO:
        /* make sure something is selected in the selection list */
        SELF:SCREEN-VALUE = cPreviousPoolSel.
        RETURN NO-APPLY.
    END.

    /* if hiding objects, warn user if he has selected such objects 
       since they will be automatically deselected.
    */
    RUN confirmBeforeShowChange(INPUT SELF).
    IF RETURN-VALUE = "NO-APPLY" THEN DO:
        SELF:SCREEN-VALUE = "".
        SELF:SCREEN-VALUE = cPreviousPoolSel.
        APPLY "ENTRY" TO SELF.
        RETURN NO-APPLY.
    END.
    
    /* ok to change value */
    cPreviousPoolSel = SELF:SCREEN-VALUE.
    RUN refreshObjList.
END.

ON END-ERROR OF FRAME ObjSelFrame OR
   CHOOSE OF Btn_Cancel IN FRAME ObjSelFrame
DO:
    DEFINE VARIABLE answer AS LOGICAL NO-UNDO.
    DEFINE VARIABLE nRows  AS INTEGER NO-UNDO.

    /* ask for confirmation if user tried to cancel and there are objects selected */
    nRows = BrowseList:NUM-SELECTED-ROWS NO-ERROR.
    IF nRows > 0 THEN DO:
        MESSAGE "There are objects selected. Are you sure you want to close this window ?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    
        IF NOT answer THEN
            RETURN NO-APPLY.
    END.

    EMPTY TEMP-TABLE ttObjAttrs NO-ERROR.
END.

ON VALUE-CHANGED OF TogIndex IN FRAME ObjSelFrame OR
   /*VALUE-CHANGED OF TogTables IN FRAME ObjSelFrame OR*/
   VALUE-CHANGED OF TogLobs IN FRAME ObjSelFrame
DO: 
    IF SELF:SCREEN-VALUE = "no" THEN DO:

        /* if hiding objects with specific type, warn user if he has selected
           such objects since they will be automatically deselected.
        */
       RUN confirmBeforeShowChange(INPUT SELF).
       IF RETURN-VALUE = "NO-APPLY" THEN DO:
           SELF:SCREEN-VALUE = "yes".
           APPLY "ENTRY" TO SELF.
           RETURN NO-APPLY.
       END.
    END.

    RUN refreshObjList.
    
END.

ON CHOOSE OF Btn_Select_Some IN FRAME ObjSelFrame
DO:
   DEFINE VARIABLE n               AS INT     NO-UNDO.
   DEFINE VARIABLE poolFilter      AS CHAR    NO-UNDO.
   DEFINE VARIABLE cTypes          AS CHAR    NO-UNDO.
   DEFINE VARIABLE rrowid          AS ROWID   NO-UNDO.

   ASSIGN n = BrowseList:FOCUSED-ROW.

   ASSIGN FRAME obj_patt:TITLE = "Select Objects by Pattern Match"
          pprompt = "Enter name of object to select.".

   display pprompt with frame obj_patt.
 
   do ON ENDKEY UNDO, LEAVE:
      update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
          with frame obj_patt.

      pattern = TRIM(pattern).
      IF pattern = "*" THEN
         BrowseList:SELECT-ALL().
      ELSE DO:
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
          /* can't have this since this causes issues with selected rows
             on multi-select browse on tty - OE00172180 
          */
          BrowseList:SET-REPOSITIONED-ROW(n,"conditional").
&ENDIF
          /* get the objects that are displayed now */
          RUN getCurrentOptions(OUTPUT cTypes, OUTPUT poolFilter).
          
          FOR EACH ttObjAttrs WHERE ttObjAttrs.obj-name MATCHES pattern.
              /* Let's avoid repositioning to a record that we know it's
                 not been displayed, or the reposition will fail!
              */
              IF CAN-DO(cTypes,ttObjAttrs.obj-type) THEN DO:
                  IF poolFilter = ? 
                     OR CAN-DO (poolFilter, ttObjAttrs.obj-buf-pool) THEN DO:
                      /* store the rowid of the first row selected so we move
                         focus to it later.
                      */
                      IF rrowid = ? THEN
                         rrowid = ROWID(ttObjAttrs).
                     REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs).
                     BrowseList:SELECT-ROW(BrowseList:FOCUSED-ROW).
                  END.
              END.
          END.

          /* move to the first selected, if any */
          IF rrowid NE ? THEN
              REPOSITION BrowseList TO ROWID rrowid.
      END.
    
&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty Windows, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

   END.
END.

ON CHOOSE OF Btn_Deselect_Some IN FRAME ObjSelFrame
DO:
   DEFINE VAR nRows AS INTEGER NO-UNDO.
   DEFINE VAR i     AS INTEGER NO-UNDO.

   ASSIGN FRAME obj_patt:TITLE = "Deselect Objects by Pattern Match"
          pprompt = "Enter name of object to deselect.".
     
   display pprompt with frame obj_patt.
 
   do ON ENDKEY UNDO, LEAVE:
      update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
           with frame obj_patt.
      
      nRows = BrowseList:NUM-SELECTED-ROWS.
     
      IF nRows > 0 THEN DO:
          pattern = TRIM(pattern).
          IF pattern = "*" THEN
             BrowseList:DESELECT-ROWS().
          ELSE DO:
               rpt-blk:
               REPEAT i = 1 TO nRows:
                   BrowseList:FETCH-SELECTED-ROW(i).
                   IF ttObjAttrs.obj-name MATCHES pattern THEN DO:
                        BrowseList:DESELECT-SELECTED-ROW(i).
                        /* now that we have deselected the row, decrement the counters */
                        ASSIGN i = i - 1
                               nRows = nRows - 1.
                   END.
               END.
          END.
      END.
   END.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
  ON F5 OF FRAME ObjSelFrame ANYWHERE DO:
     APPLY "CHOOSE" TO Btn_Select_Some IN FRAME ObjSelFrame.
  END.

  ON F6 OF FRAME ObjSelFrame ANYWHERE DO:
     APPLY "CHOOSE" TO Btn_Deselect_Some IN FRAME ObjSelFrame.
  END.

  ON F7 OF FRAME ObjSelFrame ANYWHERE DO:
     APPLY "ENTRY" TO TogIndex IN FRAME ObjSelFrame.
  END.
             
&ENDIF

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME ObjSelFrame:PARENT eq ?
THEN FRAME ObjSelFrame:PARENT = ACTIVE-WINDOW.

RUN populateValues.

IF NOT CAN-FIND (FIRST ttObjAttrs) THEN DO:
   MESSAGE "There are no objects that can be assigned to the alternate" +
               "~nbuffer pool through this client."
           VIEW-AS ALERT-BOX INFO BUTTONS OK.
   RETURN ERROR.
END.

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
ASSIGN cHeader[1] = "Select one or more objects with the [SPACEBAR] key."
       cHeader[2] = "Press [" + KBLABEL("GO") + "] to go to the next screen.".
&ELSE
ASSIGN cHeader[1] = "Select one or more objects and hit the OK button to go to the next screen.".
&ENDIF

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
/* assign help for all elements */
ASSIGN cHelp = KBLABEL("GO") + "=OK " +
                             KBLABEL("END-ERROR") + "=Cancel  " +
                             KBLABEL("F5") + "/"  +
                             KBLABEL("F6") + "=Select/Deselect Some  " +
                             KBLABEL("F7") + "=Focus to Filter"
        BROWSE BrowseList:HELP = cHelp
        Btn_Select_Some:HELP = cHelp
        Btn_Deselect_Some:HELP = cHelp
        TogIndex:HELP = cHelp
        TogLobs:HELP = cHelp
        cSelPool:HELP = cHelp
        Btn_OK:HELP = cHelp
        Btn_Cancel:HELP = cHelp.
       
&ENDIF

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME obj_patt" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

{adecomm/okrun.i  
   &FRAME  = "FRAME ObjSelFrame" 
   &OKBOX  = NO
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  /* set the display name as the object name */
  FOR EACH ttObjAttrs:
      ttObjAttrs.disp-name = ttObjAttrs.obj-name.
  END.

  /* default to the ones not in the alternate buffer pool */
  ASSIGN cSelPool = "Primary"
         cPreviousPoolSel = cSelPool.

  RUN enable_UI.

  /* warn that multi-tenant tables will not appear on the list */
  IF myObjAtribObj:hasMTEnabledTables THEN DO:
      MESSAGE "Multi-tenant enabled tables will not appear on the list"
              VIEW-AS ALERT-BOX WARNING BUTTONS OK.
  END.

  WAIT-FOR GO OF FRAME ObjSelFrame.
END.
RUN disable_UI.


/* **********************  Internal Procedures  *********************** */

/* If user is changing the objects to be display, let user know that any selected
   objects that are not going to be displayed will be deselected.
*/   
PROCEDURE confirmBeforeShowChange:
    DEFINE INPUT  PARAMETER hObj AS HANDLE NO-UNDO.
    
    DEFINE VARIABLE answer     AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE cType      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE poolFilter AS CHAR      NO-UNDO INIT ?.
    DEFINE VARIABLE nRows      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i          AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cEntry     AS CHAR      NO-UNDO.

    nRows = BrowseList:NUM-SELECTED-ROWS IN FRAME ObjSelFrame.

    /* the object we get here is what is getting changed */
    IF hObj:NAME = "TogIndex" THEN
       ASSIGN cType = "Index".
    ELSE IF hObj:NAME = "TogLobs" THEN
            ASSIGN cType = "CLOB,BLOB".
    ELSE IF hObj:NAME = "cSelPool" THEN DO:
        /* see which pool is going to get hidden */
        REPEAT i = 1 TO NUM-ENTRIES(cPreviousPoolSel):
            cEntry = ENTRY(i,cPreviousPoolSel).
            IF LOOKUP(cEntry,cSelPool:SCREEN-VALUE) = 0 THEN DO:
                IF poolFilter EQ ? THEN
                    poolFilter = cEntry.
                ELSE
                    poolFilter = poolFilter + "," + cEntry.
            END.
        END.
    END.
    
    IF nRows > 0 THEN DO:
       rpt-blk:
       REPEAT i = 1 TO nRows:
           BrowseList:FETCH-SELECTED-ROW(i).
           /* if type is being turned off and objects with that type were selected,
              or displaying different pool and obj is going to get hidden
              then warn user that those objects will get deselected.
           */
           IF ((cType NE "" AND CAN-DO(cType, ttObjAttrs.obj-type)) 
               OR (poolFilter NE ? AND CAN-DO(poolFilter, ttObjAttrs.obj-buf-pool))) THEN DO:
               MESSAGE "You have selected objects which will get deselected"
                   SKIP "when changing this setting. Do you want to continue?"
                   VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE answer.

               IF NOT answer THEN DO:
                  RETURN "NO-APPLY".
               END.
               LEAVE rpt-blk. /* get out of loop */
           END.
       END.
    END.

    RETURN "".
END.

PROCEDURE disable_UI :
  /* Hide all frames */
  HIDE FRAME ObjSelFrame.
END PROCEDURE.

PROCEDURE enable_UI :
  DISPLAY cHeader[1] 
&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
      cHeader[2] 
&ENDIF
      BrowseList /*TogTables*/
          TogIndex TogLobs cSelPool Rect1
      WITH FRAME ObjSelFrame.
  ENABLE BrowseList Btn_Select_Some Btn_Deselect_Some /*TogTables*/ TogIndex
         TogLobs cSelPool Btn_OK Btn_Cancel
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
      WITH FRAME ObjSelFrame.

  VIEW FRAME ObjSelFrame.

  RUN refreshObjList.

END PROCEDURE.


PROCEDURE populateValues:         
    DEF VAR cList AS CHAR NO-UNDO.

    /* populate the dataset */
    myObjAtribObj:getTableList(OUTPUT DATASET dsObjAttrs BY-REFERENCE).

    cList = myObjAtribObj:BufferPoolNames NO-ERROR.
    IF NOT (cList = ? OR cList = "") THEN DO:
       ASSIGN cSelPool:LIST-ITEMS IN FRAME ObjSelFrame = cList.
    END.

END.

PROCEDURE refreshObjList:
    DEFINE VARIABLE poolFilter     AS CHAR      NO-UNDO.
    DEFINE VARIABLE cTypes         AS CHARACTER NO-UNDO.
    DEFINE VARIABLE nRows          AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i              AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFocused       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cQueryStr      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE needtoSelect   AS LOGICAL   NO-UNDO.

    RUN getCurrentOptions(OUTPUT cTypes, OUTPUT poolFilter).

    /* mantain selected rows */
    nRows = BrowseList:NUM-SELECTED-ROWS IN FRAME ObjSelFrame.
    
    IF nRows > 0 THEN DO:

       REPEAT i = 1 TO nRows:
           BrowseList:FETCH-SELECTED-ROW(i).
           /* only keep track of objects that need to be reselected after we reopen the
              query.
           */
           IF CAN-DO(cTypes,ttObjAttrs.obj-type) THEN DO:
               IF poolFilter = ? 
                  OR CAN-DO(poolFilter, ttObjAttrs.obj-buf-pool) THEN
              ASSIGN ttObjAttrs.obj-selected = YES.
           END.
       END.
    END.

    CLOSE QUERY BrowseList.

    /* build query based on the options the user selected on what objects to be displayed */
    IF CAN-FIND(FIRST ttObjAttrs WHERE obj-selected = YES) THEN
       ASSIGN needToSelect = YES
              cQueryStr = "PRESELECT ".
    ELSE
        cQueryStr = "FOR ".

    cQueryStr = cQueryStr + "EACH ttObjAttrs WHERE CAN-DO(" 
                + QUOTER(cTypes) + ",ttObjAttrs.obj-type) ".

    IF poolFilter NE ? THEN DO:
       cQueryStr = cQueryStr + 'AND CAN-DO( ' + 
                   QUOTER(poolFilter) + ',ttObjAttrs.obj-buf-pool) '.
    END.
    
    cQueryStr = cQueryStr + " NO-LOCK" /*+ (IF NOT needToSelect THEN " INDEXED-REPOSITION" ELSE "")*/ .

    QUERY BrowseList:QUERY-PREPARE(cQueryStr).
    QUERY BrowseList:QUERY-OPEN().

    IF CAN-FIND(FIRST ttObjAttrs WHERE obj-selected = YES) THEN DO:
       FOR EACH ttObjAttrs WHERE obj-selected = YES:
           /* try to re-select the rows */
           REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs) NO-ERROR.
           IF NOT ERROR-STATUS:ERROR THEN
              BrowseList:SELECT-ROW(BrowseList:FOCUSED-ROW).
           ASSIGN obj-selected = NO.
       END.
    END.

    /* if no objects are available, can't select/deselect all */
    ASSIGN  Btn_Select_Some:SENSITIVE = QUERY BrowseList:NUM-RESULTS > 0
            Btn_Deselect_Some:SENSITIVE = Btn_Select_Some:SENSITIVE.


&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty Windows, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

END.

PROCEDURE getCurrentOptions:
    DEFINE OUTPUT PARAMETER cTypes         AS CHAR NO-UNDO.
    DEFINE OUTPUT PARAMETER poolFilter     AS CHAR NO-UNDO.

    /*DEFINE VARIABLE showTables  AS LOGICAL NO-UNDO.*/
    DEFINE VARIABLE showIndexes   AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE showLobs      AS LOGICAL   NO-UNDO.

    ASSIGN /*showTables = TogTables:SCREEN-VALUE IN FRAME ObjSelFrame = "yes"*/
           showIndexes = TogIndex:SCREEN-VALUE IN FRAME ObjSelFrame = "yes"
           showLobs = TogLobs:SCREEN-VALUE IN FRAME ObjSelFrame = "yes".

    poolFilter = cSelPool:SCREEN-VALUE.

    ASSIGN cTypes = "Table".
    IF showIndexes THEN
        ASSIGN cTypes = cTypes + ",Index".
    IF showLobs THEN
        ASSIGN cTypes = cTypes + ",CLOB,BLOB".

END.
/*********************************************************************
* Copyright (C) 2008-2009,2012 by Progress Software Corporation. All *
* rights reserved.                                                   *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_obj-attrib-util.cls

Description:
    Object for interfacing with object attributes, such as alternate buffer
    pool, that can be assigned throught the ABL
        
History:
    07/01/08  fernando   created
    08/09/12  rkumar     fixed issue with alternate buffer pool settings
                            
--------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
USING Progress.Database.*.

ROUTINE-LEVEL ON ERROR UNDO, THROW.

CLASS prodict.pro._obj-attrib-util:

{prodict/sec/sec-pol.i}

&SCOPED-DEFINE TABLE_TYPE "Table"
&SCOPED-DEFINE INDEX_TYPE "Index"
&SCOPED-DEFINE CLOB_TYPE  "Clob"
&SCOPED-DEFINE BLOB_TYPE  "Blob"


DEFINE PRIVATE VARIABLE myDBConfig    AS DBConfig  NO-UNDO.
DEFINE PRIVATE VARIABLE myStorage     AS Storage   NO-UNDO.
DEFINE PRIVATE VARIABLE seq           AS INTEGER   NO-UNDO.
DEFINE PRIVATE VARIABLE hDB           AS HANDLE    NO-UNDO.
DEFINE PRIVATE VARIABLE m_hasMTEnabledTables AS LOGICAL NO-UNDO.

DEFINE PUBLIC PROPERTY FillAreaNum AS LOGICAL
    GET.
    SET.

DEFINE PUBLIC PROPERTY BufferPoolNames AS CHARACTER
    GET():
       RETURN "Alternate,Primary".
    END GET.

DEFINE PUBLIC PROPERTY hasMTEnabledTables AS LOGICAL
    GET():
        RETURN m_hasMTEnabledTables.
    END GET.

DEFINE PRIVATE PROPERTY nextSeqNum AS INTEGER
    GET():
         /* get next value if the instantiator is adding records to the temp-table */
         ASSIGN seq = seq + 1.
         RETURN seq.
    END GET.

DEFINE PROTECTED PROPERTY DbRecid AS RECID 
    GET():
         /* if the first time, create the dynamic buffer object */
         IF DbRecid = ? then 
	 do on error undo, throw : 
	     CREATE BUFFER hDb FOR TABLE myDBConfig:LogicalDBName + "._Db".
             IF VALID-HANDLE(hDB) THEN hDB:FIND-FIRST("").
             DbRecid = hDb:recid. 
	     finally:
                 hDB:BUFFER-RELEASE().
	         delete object hDb.  
	     end.
	end.
	return DbRecid. 
    END.
    private set.

CONSTRUCTOR _obj-attrib-util():
    getDBConfigObj("DICTDB").
END CONSTRUCTOR.

CONSTRUCTOR _obj-attrib-util(INPUT cDbName AS CHAR):
    getDBConfigObj(cDbName).
END CONSTRUCTOR.

METHOD PRIVATE VOID getDBConfigObj (INPUT cDbName AS CHAR):
   DEFINE VARIABLE lOk AS LOGICAL     NO-UNDO.
   DEFINE VARIABLE cOrig AS CHAR      NO-UNDO.

    myDBConfig = NEW DBConfig(cDbName).

    /* _dctadmn.p used DICTDB, but DICTDB may not be the db we are looking at */
    IF cDbName NE "DICTDB":U AND (LDBNAME("DICTDB") NE cDbName) THEN DO:
       cOrig = LDBNAME("DICTDB").
       CREATE ALIAS DICTDB FOR DATABASE VALUE(cDbName).
    END.

    RUN prodict/_dctadmn.p ( INPUT USERID(cDbName), OUTPUT lOk ).

    IF cOrig NE ? AND cOrig NE "" THEN
       CREATE ALIAS DICTDB FOR DATABASE VALUE(cOrig).
    
    IF NOT lOk THEN DO:
        /* make sure we delete the object now */
       DELETE OBJECT myDBConfig NO-ERROR.
       UNDO, THROW NEW Progress.Lang.AppError("You must be a Security Administrator to maintain object attributes.", 14893).
    END.

    IF NOT myDBConfig:VersionSupportsAlternateBufferPool THEN DO:
        /* make sure we delete the object now */
       DELETE OBJECT myDBConfig NO-ERROR.
       /* The specified database server does not support this function. (4634) */
       UNDO, THROW NEW Progress.Lang.AppError("The specified database server does not support maintenance of object attributes.", 4634).
    END.

    /* get a share lock on the schema so no one can make changes to it
       while we are in the same transaction.
    */
    getDbLock(NO).

    CATCH e AS PROGRESS.Lang.ProError:
       DEFINE VARIABLE cError AS CHAR    NO-UNDO.
       DEFINE VARIABLE iNum   AS INTEGER NO-UNDO.

       IF VALID-OBJECT(myDBConfig) THEN
           DELETE OBJECT myDBConfig.

       ASSIGN iNum = e:GetMessageNum(1).

       CASE iNum:
           WHEN 14888 THEN
               cError = "Database is not connected.".
           WHEN 14893 THEN
               cError = "You must be a Security Administrator to maintain object attributes.".
           WHEN 4634 THEN                           
               cError = e:GetMessage(1).
           OTHERWISE
               cError=  'Error: ' + e:GetMessage(1).
       END CASE.

       DELETE OBJECT e.

       /* throw an application error */
       UNDO, THROW NEW Progress.Lang.AppError(cError, iNum).
    END CATCH. 

END METHOD.

/* get list of objects (table/index/lob) that are assigned.
   The code is database reference-free - we use the db passed to the constructor.
*/
METHOD PUBLIC VOID getTableList(OUTPUT DATASET dsObjAttrs):

    DEFINE VARIABLE cTmp    AS CHAR   NO-UNDO.
    DEFINE VARIABLE hQuery1 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery2 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery3 AS HANDLE NO-UNDO.

    DEFINE VARIABLE hFile   AS HANDLE NO-UNDO.
    DEFINE VARIABLE hField  AS HANDLE NO-UNDO.
    DEFINE VARIABLE hIndex  AS HANDLE NO-UNDO.
    DEFINE VARIABLE cType   AS CHAR   NO-UNDO.

    EMPTY TEMP-TABLE ttObjAttrs NO-ERROR.
    ASSIGN seq = 0 /* initial */
           cTmp = myDBConfig:LogicalDBName  + "._File".

    /* will not suppress errors - which will get thrown back to the caller */
    CREATE BUFFER hFile FOR TABLE cTmp.

    CREATE QUERY hQuery1.
    hQuery1:SET-BUFFERS(hFile).
    hQuery1:QUERY-PREPARE("FOR EACH " + cTmp + " WHERE ((_File-number > 0 AND _File-number < 32000) OR _File-name BEGINS '_aud-')"
                            + " AND _Owner = 'PUB' USE-INDEX _File-name" ).
    hQuery1:QUERY-OPEN().

    REPEAT ON ERROR UNDO, THROW:
       hQuery1:GET-NEXT(NO-LOCK).  
       IF hQuery1:QUERY-OFF-END THEN
          LEAVE.

       /* don't do multi-tenant tables */
       IF hFile:BUFFER-FIELD("_File-attributes"):BUFFER-VALUE(1) = YES THEN DO:
          m_hasMTEnabledTables = YES.
          NEXT.
       END.

       getBufferPool(INPUT hFile::_File-number,
                     INPUT hFile::_File-name,
                     INPUT hFile::_ianum,
                     INPUT {&TABLE_TYPE}).

       /* look for fields */
        IF NOT VALID-HANDLE(hField) THEN DO:
           CREATE BUFFER hField FOR TABLE myDBConfig:LogicalDBName + "._Field".
        
           CREATE QUERY hQuery2.
           hQuery2:SET-BUFFERS(hField).
        END.

        hQuery2:QUERY-PREPARE("FOR EACH _Field WHERE (_Field._Data-type = 'CLOB' OR _Field._Data-type = 'BLOB')"
                              + " AND _File-recid = " + STRING(hFile:RECID) ).
        hQuery2:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery2:GET-NEXT(NO-LOCK).  
            IF hQuery2:QUERY-OFF-END THEN
               LEAVE.

            /* use values from pre-processor so all of them show up with
               first letter as uppercase.
            */
            IF hField::_Data-type = {&BLOB_TYPE} THEN
                cType = {&BLOB_TYPE}.
            ELSE
                cType = {&CLOB_TYPE}.

            getBufferPool(INPUT hField::_Fld-stlen,
                          INPUT hFile::_File-name
                               + "." + hField::_Field-name,
                          INPUT ?,
                          INPUT cType).
        END.
        hQuery2:QUERY-CLOSE().

        /* look for indexes */
        IF NOT VALID-HANDLE(hIndex) THEN DO:
           CREATE BUFFER hIndex FOR TABLE myDBConfig:LogicalDBName + "._Index".
        
           CREATE QUERY hQuery3.
           hQuery3:SET-BUFFERS(hIndex).
        END.

        hQuery3:QUERY-PREPARE("FOR EACH _Index WHERE _File-recid = " + STRING(hFile:RECID)).
        hQuery3:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery3:GET-NEXT(NO-LOCK).  
            IF hQuery3:QUERY-OFF-END THEN
               LEAVE.

            getBufferPool(INPUT hIndex::_Idx-num,
                          INPUT hFile::_File-name 
                                + "." + hIndex::_Index-name,
                          INPUT hIndex::_ianum,
                          INPUT {&INDEX_TYPE}).
        END.
        hQuery3:QUERY-CLOSE().
    END.

    hQuery1:QUERY-CLOSE().

   /* OUTPUT TO objects.txt.
    FOR EACH ttObjAttrs.
        EXPORT ttObjAttrs.
    END.
    OUTPUT CLOSE.*/

    CATCH e AS PROGRESS.Lang.ProError:
       UNDO, THROW NEW Progress.Lang.AppError(e:GetMessage(1), e:GetMessageNum(1)).
    END CATCH.
    FINALLY:
        DELETE OBJECT hQuery1 NO-ERROR.
        DELETE OBJECT hQuery2 NO-ERROR.
        DELETE OBJECT hQuery3 NO-ERROR.
        DELETE OBJECT hFile   NO-ERROR.
        DELETE OBJECT hField  NO-ERROR.
        DELETE OBJECT hIndex  NO-ERROR.
    END FINALLY.
        
END METHOD.

/* get list of table and/or its indexes and LOB columns that can be assigned */
METHOD PUBLIC VOID getObjectList(INPUT cTableName AS CHARACTER,
                                 OUTPUT DATASET dsObjAttrs):

    DEFINE VARIABLE cTmp    AS CHAR   NO-UNDO.
    DEFINE VARIABLE hQuery1 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery2 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery3 AS HANDLE NO-UNDO.

    DEFINE VARIABLE hFile   AS HANDLE NO-UNDO.
    DEFINE VARIABLE hField  AS HANDLE NO-UNDO.
    DEFINE VARIABLE hIndex  AS HANDLE NO-UNDO.
    DEFINE VARIABLE cType   AS CHAR   NO-UNDO.

    EMPTY TEMP-TABLE ttObjAttrs NO-ERROR.
    ASSIGN seq = 0 /* initial */
           cTmp = myDBConfig:LogicalDBName  + "._File".

    /* will not suppress errors - which will get thrown back to the caller */
    CREATE BUFFER hFile FOR TABLE cTmp.

    CREATE QUERY hQuery1.
    hQuery1:SET-BUFFERS(hFile).
    hQuery1:QUERY-PREPARE("FOR EACH " + cTmp + " WHERE _File-name = '" +
                            cTableName + "' AND _Owner = 'PUB' USE-INDEX _File-name" ).
    hQuery1:QUERY-OPEN().

    REPEAT ON ERROR UNDO, THROW:
       hQuery1:GET-NEXT(NO-LOCK).  
       IF hQuery1:QUERY-OFF-END THEN
          LEAVE.

       /* don't do multi-tenant tables */
       IF hFile:BUFFER-FIELD("_File-attributes"):BUFFER-VALUE(1) = YES THEN DO:
           m_hasMTEnabledTables = YES.
           NEXT.
       END.

       getBufferPool(INPUT hFile::_File-number,
                     INPUT hFile::_File-name,
                     INPUT hFile::_ianum,
                     INPUT {&TABLE_TYPE}).

       /* look for fields */
        IF NOT VALID-HANDLE(hField) THEN DO:
           CREATE BUFFER hField FOR TABLE myDBConfig:LogicalDBName + "._Field".
        
           CREATE QUERY hQuery2.
           hQuery2:SET-BUFFERS(hField).
        END.

        hQuery2:QUERY-PREPARE("FOR EACH _Field WHERE (_Field._Data-type = 'CLOB' OR _Field._Data-type = 'BLOB')"
                              + " AND _File-recid = " + STRING(hFile:RECID) ).
        hQuery2:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery2:GET-NEXT(NO-LOCK).  
            IF hQuery2:QUERY-OFF-END THEN
               LEAVE.

            /* use values from pre-processor so all of them show up with
               first letter as uppercase.
            */
            IF hField::_Data-type = {&BLOB_TYPE} THEN
                cType = {&BLOB_TYPE}.
            ELSE
                cType = {&CLOB_TYPE}.

            getBufferPool(INPUT hField::_Fld-stlen,
                          INPUT hFile::_File-name
                               + "." + hField::_Field-name,
                          INPUT ?,
                          INPUT cType).
        END.
        hQuery2:QUERY-CLOSE().

        /* look for indexes */
        IF NOT VALID-HANDLE(hIndex) THEN DO:
           CREATE BUFFER hIndex FOR TABLE myDBConfig:LogicalDBName + "._Index".
        
           CREATE QUERY hQuery3.
           hQuery3:SET-BUFFERS(hIndex).
        END.

        hQuery3:QUERY-PREPARE("FOR EACH _Index WHERE _File-recid = " + STRING(hFile:RECID)).
        hQuery3:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery3:GET-NEXT(NO-LOCK).  
            IF hQuery3:QUERY-OFF-END THEN
               LEAVE.

            getBufferPool(INPUT hIndex::_Idx-num,
                          INPUT hFile::_File-name 
                                + "." + hIndex::_Index-name,
                          INPUT hIndex::_ianum,
                          INPUT {&INDEX_TYPE}).
        END.
        hQuery3:QUERY-CLOSE().
    END.

    hQuery1:QUERY-CLOSE().

   /* OUTPUT TO objects.txt.
    FOR EACH ttObjAttrs.
        EXPORT ttObjAttrs.
    END.
    OUTPUT CLOSE.*/

    CATCH e AS PROGRESS.Lang.ProError:
       UNDO, THROW NEW Progress.Lang.AppError(e:GetMessage(1), e:GetMessageNum(1)).
    END CATCH.
    FINALLY:
        DELETE OBJECT hQuery1 NO-ERROR.
        DELETE OBJECT hQuery2 NO-ERROR.
        DELETE OBJECT hQuery3 NO-ERROR.
        DELETE OBJECT hFile   NO-ERROR.
        DELETE OBJECT hField  NO-ERROR.
        DELETE OBJECT hIndex  NO-ERROR.
    END FINALLY.
        
END METHOD.

/* Given an object name and type, get info on get the object attributes.
*/
METHOD PUBLIC VOID getObjectAttributes(INPUT objName AS CHAR, 
                                       INPUT objectType AS CHAR, 
                                       OUTPUT DATASET dsObjAttrs):
    DEFINE VARIABLE cTable AS CHAR NO-UNDO.
    DEFINE VARIABLE cObj   AS CHAR NO-UNDO.

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name EQ objName AND
                                        ttObjAttrs.obj-type EQ objectType NO-ERROR.
    IF NOT AVAILABLE ttObjAttrs THEN DO:

       /* if not on the table yet, we will check if we can get it now */
       findAndAdd(INPUT NO, ?, objName, objectType).
    END.
    ELSE DO:
        refreshBufferPoolInfo(ttObjAttrs.obj-name, objectType).
    END.

END METHOD.

/* Given an object num and type,  get info on get the object attributes.
*/
METHOD PUBLIC VOID getObjectAttributes(INPUT objNum AS INTEGER, 
                                       INPUT objectType AS CHAR, 
                                       OUTPUT DATASET dsObjAttrs):

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-num = objNum AND 
        ttObjAttrs.obj-type = objectType NO-ERROR.

    IF NOT AVAILABLE ttObjAttrs THEN DO:
       /* if not on the table yet, we will check if we can get it now */
       findAndAdd(INPUT YES, objNum, ?, objectType).
    END.
    ELSE DO:
        refreshBufferPoolInfo(ttObjAttrs.obj-name, objectType).
    END.

END METHOD.

/* Given an object num and type, get the object attributes such as 
   alt buf pool setting.
   The object name is also passed. If we can't find an entry for it, we create it as
   a placeholder.
*/
METHOD PUBLIC VOID getObjectAttributes(INPUT objNum AS INTEGER, 
                                       INPUT objName AS CHAR, 
                                       INPUT objectType AS CHAR, 
                                       OUTPUT DATASET dsObjAttrs):

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = objName AND 
        ttObjAttrs.obj-type = objectType NO-ERROR.

    IF NOT AVAILABLE ttObjAttrs THEN DO:
        getBufferPool(INPUT objNum, INPUT objName, INPUT ?, 
                      INPUT objectType).
    END.
    ELSE DO:
        refreshBufferPoolInfo(ttObjAttrs.obj-name, objectType).
    END.

END METHOD.

/* update object attributes for the objects in the dataset */
METHOD PUBLIC VOID updateSettings (INPUT callerForCallBack AS HANDLE,
                                   INPUT DATASET dsObjAttrs):

    DEFINE BUFFER bAfter FOR ttObjAttrs.
    DEF VAR fullobjName       AS CHAR    NO-UNDO.
    DEF VAR tableName         AS CHAR    NO-UNDO.
    DEF VAR objName           AS CHAR    NO-UNDO.
    DEF VAR objType           AS CHAR    NO-UNDO.
    DEFINE VARIABLE myStorage AS Storage NO-UNDO.

    /* now go through all the changed records and make the necessary 
       changes.
    */
    main-trans:
    DO TRANS ON ERROR UNDO, THROW:

         FOR EACH bfttObjAttrs ON ERROR UNDO, THROW
            ON STOP UNDO, LEAVE: /* catches canceled lock */

            FIND FIRST bAfter WHERE ROWID(bAfter) = BUFFER bfttObjAttrs:AFTER-ROWID.
            ASSIGN fullobjName = bAfter.obj-name
                   objType = bAfter.obj-type
                   tableName = ENTRY(1,fullobjName,".").

            CASE bAfter.obj-type:
                WHEN {&TABLE_TYPE} THEN DO:
                    myStorage = myDBConfig:GetTable(tableName).
                    IF myStorage:CanAssignAlternateBufferPool THEN
                       myStorage:ObjectLevelBufferPool = bAfter.obj-buf-pool.
                    ELSE
                       UNDO main-trans, THROW NEW Progress.Lang.AppError("Cannot set buffer pool for object", 15250).

                    DELETE OBJECT myStorage.
                END.
                WHEN {&INDEX_TYPE} OR 
                    WHEN {&CLOB_TYPE} OR 
                    WHEN {&BLOB_TYPE} THEN DO:

                    IF NUM-ENTRIES(fullobjName,".") > 1 THEN
                       objName = ENTRY(2,fullobjName,".").

                    IF bAfter.obj-type = {&INDEX_TYPE} THEN DO:
                       myStorage = myDBConfig:GetIndex(tableName, objName).  
                       IF myStorage:CanAssignAlternateBufferPool THEN
                          myStorage:ObjectLevelBufferPool = bAfter.obj-buf-pool.
                       ELSE
                           UNDO main-trans, THROW NEW Progress.Lang.AppError("Cannot set buffer pool for object", 15250).

                       DELETE OBJECT myStorage.
                    END.
                    ELSE DO:
                       myStorage = myDBConfig:GetLOB(tableName, objName).
                       IF myStorage:CanAssignAlternateBufferPool THEN
                          myStorage:ObjectLevelBufferPool = bAfter.obj-buf-pool.
                       ELSE
                           UNDO main-trans, THROW NEW Progress.Lang.AppError("Cannot set buffer pool for object", 15250).

                       DELETE OBJECT myStorage.
                    END.

                END.
                OTHERWISE
                    UNDO main-trans, THROW NEW Progress.Lang.AppError("Invalid object type: " + bAfter.obj-type, 1).
            END CASE.

            CATCH e AS PROGRESS.Lang.ProError:
                DEFINE VARIABLE cError    AS CHAR    NO-UNDO.
                DEFINE VARIABLE iNum      AS INTEGER NO-UNDO.
                DEFINE VARIABLE lContinue AS LOGICAL NO-UNDO.
                
                ASSIGN  iNum = e:GetMessageNum(1)
                        cError = "Error: ".
    
                IF iNum NE 12536 THEN
                   cError = cError + e:GetMessage(1).
    
                DELETE OBJECT e.
    
                IF iNum = 12536 THEN /* can't get schema lock */
                   STOP.
    
                    cError = cError + " (Object: " + fullobjName +
                             " Type: "   + objType + ")".
    
                /* if callback is set up, caller wants to be notified or
                   errors and deal with them. If we should continue, we 
                   will just move on to the next record. If not, we undo
                   the transaction and return.
                   If not callback is defined, we throw an error.
                */
                IF callerForCallBack NE ? THEN DO:
                    RUN attrsErrorCallback IN callerForCallBack 
                         (INPUT cError, OUTPUT lContinue) NO-ERROR.
                    IF NOT lContinue THEN
                         UNDO main-trans, LEAVE main-trans.
                    NEXT.
                END.
    
                /* throw an application error */
                UNDO, THROW NEW Progress.Lang.AppError(cError, iNum).
            END CATCH.
        END.
    END.

END METHOD.

/* For the load process - cache settings from the .df */
METHOD PUBLIC VOID cacheObjForLoad (INPUT cObjName AS CHAR,
                                    INPUT objType  AS CHAR,
                                    INPUT objNum   AS INT,
                                    INPUT-OUTPUT cValue AS CHAR):
DEFINE VARIABLE cTmp    AS CHAR    NO-UNDO.

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = cObjName
         AND ttObjAttrs.obj-type = objType NO-ERROR.

    IF NOT AVAILABLE ttObjAttrs THEN DO:

        /* we are only called by the load process, but make sure the object name has the
           information needed.
        */
        cTmp = ENTRY(1,cObjName, ".").
        IF cTmp = "" OR cTmp = ? THEN
            UNDO, THROW NEW Progress.Lang.AppError("Invalid object name: "+ cObjName, 1).
        IF objType NE {&TABLE_TYPE} THEN DO:
            IF NUM-ENTRIES(cObjName, ".") = 2 THEN
               cTmp = ENTRY(2,cObjName, ".").
            ELSE
                ASSIGN cTmp = "".

            IF cTmp = "" OR cTmp = ? THEN
                UNDO, THROW NEW Progress.Lang.AppError("Invalid object name: " + cObjName, 1).
        END.


        TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = NO.

        /* let's get the info for this object, in case there is one, 
           but don't do it if object number is zero, which means the 
           object is being created in the same transaction.
        */
        IF objNum NE 0 THEN
            getObjectAttributes(INPUT cObjName, 
                                INPUT objType, 
                                OUTPUT DATASET dsObjAttrs BY-REFERENCE).

        FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = cObjName
             AND ttObjAttrs.obj-type = objType NO-ERROR.
        IF NOT AVAILABLE ttObjAttrs THEN DO:
            /* if this is a new object, it won't have any info on it */
            CREATE ttObjAttrs.
            ASSIGN ttObjAttrs.seq-num = nextSeqNum
                   ttObjAttrs.obj-name = cObjName
                   ttObjAttrs.obj-type = objType
                   ttObjAttrs.obj-num = objNum
                   ttObjAttrs.obj-buf-pool = ?.
        END.

        TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = YES.
    END.

    IF obj-buf-pool NE cValue THEN DO:
       ASSIGN ttObjAttrs.obj-buf-pool = cValue.
    END.
END METHOD.

/* For the load process - save attribute settings that we cached from the .df */
METHOD PUBLIC LOGICAL cacheSaveSettings(INPUT  callerProc     AS handle, 
                                        OUTPUT invalidObjName AS CHAR):

     DEFINE VARIABLE fixedAll  AS LOGICAL NO-UNDO.

     /* check if there are any changes at all */
     IF NOT CAN-FIND (FIRST bfttObjAttrs) THEN 
        RETURN YES.

     fixedAll = cacheFixObjNumBeforeUpdate().

     /* if we find a record with an invalid obj num, then we can't move on because
        we have some transaction above us that is holding up the creation of the objects.
        So if we couldn't fix them up, return no 
     */
     IF NOT fixedAll THEN DO:
         ASSIGN invalidObjName = ttObjAttrs.obj-name.
         RETURN NO.
     END.

     /* if not yet locked, get a lock on the schema so no one can make 
        changes to it while we are in this transaction.
     */
     getDbLock(YES).

     /* this throws an error if we fail to save some change. Caller must catch the error */
     updateSettings(INPUT callerProc, INPUT DATASET dsObjAttrs BY-REFERENCE).

     RETURN YES.
END METHOD.

/* this gets called when the caller wants us to get a lock on the _db
   so that no other user can make changes while we have the info cached 
*/
METHOD PUBLIC VOID getDbLock(INPUT lExclusive AS LOGICAL):

    /* if the first time, create the dynamic buffer object */
    IF NOT VALID-HANDLE(hDB) THEN
        CREATE BUFFER hDB FOR TABLE myDBConfig:LogicalDBName + "._Db" NO-ERROR.
    IF VALID-HANDLE(hDB) THEN DO:
        IF lExclusive  THEN
           hDB:FIND-FIRST("", EXCLUSIVE-LOCK) NO-ERROR.
        ELSE
           hDB:FIND-FIRST("", SHARE-LOCK) NO-ERROR.

        IF hDB:AVAILABLE THEN
           hDB:BUFFER-RELEASE().
    END.

END METHOD.


/* This is called through the load process to fix up the object number on the records in the
   temp-table before going through with the update of the settings.
*/
METHOD PRIVATE LOGICAL cacheFixObjNumBeforeUpdate():
   DEFINE VARIABLE cTable   AS CHAR    NO-UNDO.
   DEFINE VARIABLE cObj     AS CHAR    NO-UNDO.
   DEFINE VARIABLE fixedAll AS LOGICAL NO-UNDO INIT YES.

   DEFINE VARIABLE hFile  AS HANDLE NO-UNDO.
   DEFINE VARIABLE hField AS HANDLE NO-UNDO.
   DEFINE VARIABLE hIndex AS HANDLE NO-UNDO.

   /* go through changed records and see if we have any recors to fix up.
      Note that they will still remain invalid if there is a transaction outside the
      load process
    */
   FOR EACH bfttObjAttrs.
         FIND FIRST ttObjAttrs WHERE ROWID(ttObjAttrs) = BUFFER bfttObjAttrs:AFTER-ROWID.
         
         IF ttObjAttrs.obj-num = ? THEN DO:
             /* this is the case where the table/field/index was newly created. Need to
                refind the _File record and get the obj number.
             */
             ASSIGN cTable = ENTRY(1,ttObjAttrs.obj-name,".").
             IF ttObjAttrs.obj-type NE {&TABLE_TYPE} THEN
                 ASSIGN cObj = ENTRY(2,ttObjAttrs.obj-name,".").

             IF NOT VALID-HANDLE(hFile) THEN DO:
                 /* will assume that by now we can create the buffer */
                 CREATE BUFFER hFile FOR TABLE myDBConfig:LogicalDBName + "._File".
             END.

             hFile:FIND-FIRST("where _File-name = " + QUOTER(ctable), NO-LOCK).
             IF hFile::_File-number > 0 THEN DO:
                 IF ttObjAttrs.obj-type = {&TABLE_TYPE} THEN
                    ttObjAttrs.obj-num = hFile::_File-number.
                 ELSE IF ttObjAttrs.obj-type = {&INDEX_TYPE} THEN DO:
                     IF NOT VALID-HANDLE(hIndex) THEN DO:
                         /* will assume that by now we can create the buffer */
                         CREATE BUFFER hIndex FOR TABLE myDBConfig:LogicalDBName + "._Index".
                     END.

                     hIndex:FIND-FIRST("where _Index-name = " + QUOTER(cObj) 
                                       + " AND _File-recid = " + STRING(hFile:RECID), NO-LOCK).

                     IF hIndex::_Idx-num > 0 THEN DO:
                         ttObjAttrs.obj-num = hIndex::_Idx-num.
                     END.
                     ELSE
                         fixedAll = NO.
                 END.
                 ELSE DO: /* lobs */
                     IF NOT VALID-HANDLE(hField) THEN DO:
                         /* will assume that by now we can create the buffer */
                         CREATE BUFFER hField FOR TABLE myDBConfig:LogicalDBName + "._Field".
                     END.

                     hField:FIND-FIRST("where _Field-name = " + QUOTER(cObj) 
                                       + " AND _File-recid = " + STRING(hFile:RECID), NO-LOCK).

                     /* for lobs, the _Fld-stlen field is set to the area number upon creation. So
                        it won't be zero, and I can't assume that it hasn't been created if
                        it's the area number, since it may have gotten it once it got created.
                     */
                     ttObjAttrs.obj-num = hField::_Fld-stlen.
                 END.
             END.
             ELSE
                 fixedAll = NO.
         END.
   END.

   IF VALID-HANDLE(hFile) THEN
       DELETE OBJECT hFile.
   IF VALID-HANDLE(hField) THEN
       DELETE OBJECT hField.
   IF VALID-HANDLE(hIndex) THEN
       DELETE OBJECT hIndex.

   RETURN fixedAll.

END METHOD.

/* Database reference-free code to look for objects in the db (table/index/lobs),
   and add them to the temp-table with alternate buffer pool info.
   We use the db passed to the constructor.
*/
METHOD PRIVATE VOID findAndAdd(INPUT numMode AS LOGICAL, INPUT objNum AS INT, 
                               INPUT objName AS CHAR, INPUT objectType AS CHAR):
    DEFINE VARIABLE cTable AS CHAR NO-UNDO.
    DEFINE VARIABLE cObj   AS CHAR NO-UNDO.

    DEFINE VARIABLE hFile  AS HANDLE NO-UNDO.
    DEFINE VARIABLE hField AS HANDLE NO-UNDO.
    DEFINE VARIABLE hIndex AS HANDLE NO-UNDO.

    CREATE BUFFER hFile FOR TABLE myDBConfig:LogicalDBName + "._File" NO-ERROR.
    IF NOT VALID-HANDLE(hFile) THEN
       RETURN.

    IF NOT numMode THEN DO:
       /* It must be a string for table, or table.obj-name for indexes and LOBs */
       ASSIGN ctable = ENTRY(1,objName, ".").
       IF objectType NE {&TABLE_TYPE} THEN DO:
          IF NUM-ENTRIES(objName,".") = 2 THEN
             cObj = ENTRY(2,objName, ".").
       END.
    END.

    hFile:FIND-FIRST("where " 
                     + (IF numMode THEN "_File-number = " + STRING(objNum) 
                        ELSE "_File-name = " + QUOTER(ctable)) 
                     + " AND _Owner = 'PUB'" 
                     + (IF numMode THEN "" ELSE " USE-INDEX _File-name"), NO-LOCK) NO-ERROR.

    /* don't do multi-tenant tables */
    IF hFile:AVAILABLE AND 
        hFile:BUFFER-FIELD("_File-attributes"):BUFFER-VALUE(1) = YES THEN DO:
        m_hasMTEnabledTables = YES.
    END.
    ELSE IF hFile:AVAILABLE AND (hFile::_File-name BEGINS "_aud-" OR
          (hFile::_File-number > 0 AND hFile::_file-number < 32000)) THEN DO:

    IF objectType = {&TABLE_TYPE} THEN
       getBufferPool(INPUT hFile::_File-number,
                     INPUT hFile::_File-name,
                     INPUT hFile::_ianum,
                     INPUT {&TABLE_TYPE}).
       ELSE IF objectType = {&INDEX_TYPE} THEN DO:

          CREATE BUFFER hIndex FOR TABLE myDBConfig:LogicalDBName + "._Index" NO-ERROR.
          IF NOT VALID-HANDLE(hIndex) THEN DO:
            DELETE OBJECT hFile NO-ERROR.
            RETURN.
          END.

          hIndex:FIND-FIRST("where " 
                            + (IF numMode THEN "_Idx-num = " + STRING(objNum) 
                               ELSE "_Index-name = " + QUOTER(cObj) + " AND _File-recid = " + STRING(hFile:RECID)) 
                            + (IF numMode THEN "" ELSE " USE-INDEX _File/Index"), NO-LOCK) NO-ERROR.
          IF hIndex:AVAILABLE THEN
             getBufferPool(INPUT hIndex::_Idx-num,
                           INPUT hFile::_File-name 
                                + "." + hIndex::_Index-name,
                           INPUT hIndex::_ianum,
                           INPUT {&INDEX_TYPE}).
       END.
       ELSE IF objectType = {&CLOB_TYPE} OR objectType = {&BLOB_TYPE} THEN DO:
           CREATE BUFFER hField FOR TABLE myDBConfig:LogicalDBName + "._Field" NO-ERROR.
           IF NOT VALID-HANDLE(hField) THEN DO:
              DELETE OBJECT hFile NO-ERROR.
              RETURN.
           END.

           hField:FIND-FIRST("where _Data-type = " + QUOTER(objectType) + " AND "
                             + (IF numMode THEN "_Fld-stlen = " + STRING(objNum) 
                                ELSE "_Field-name = " + QUOTER(cObj) + " AND _File-recid = " + STRING(hFile:RECID)) 
                             + (IF numMode THEN "" ELSE " USE-INDEX _File/_Field"), NO-LOCK) NO-ERROR.
           IF hField:AVAILABLE THEN
              getBufferPool(INPUT hField::_Fld-stlen,
                            INPUT hFile::_File-name
                                   + "." + hField::_Field-name,
                            INPUT ?,
                            INPUT hField::_Data-type).
       END.
    END.

    IF VALID-HANDLE(hFile) THEN
        DELETE OBJECT hFile.
    IF VALID-HANDLE(hField) THEN
        DELETE OBJECT hField.
    IF VALID-HANDLE(hIndex) THEN
        DELETE OBJECT hIndex.
END METHOD.

METHOD PRIVATE VOID addObject(INPUT objNum AS INTEGER, 
                              INPUT objName AS CHAR, 
                              INPUT objArea AS INT,
                              INPUT objType AS CHAR,
                              INPUT myStorage AS Storage):

    CREATE ttObjAttrs.
    ASSIGN ttObjAttrs.seq-num = nextSeqNum
           ttObjAttrs.obj-num = objNum
           ttObjAttrs.obj-type = objType
           ttObjAttrs.obj-name = objName
           ttObjAttrs.obj-area = objArea.

   fillAltBufPoolInfo(INPUT ttObjAttrs.seq-num,
                      INPUT myStorage).


    CATCH e AS PROGRESS.Lang.ProError:
        /* temp-table is no-undo, so if we failed to create the record, just 
           delete it now, and throw the exception to the caller which will get
           thrown all the way to the driver procedure.
        */
        DELETE ttObjAttrs NO-ERROR.
        UNDO, THROW e.
    END.
END METHOD.


METHOD PRIVATE VOID getBufferPool(INPUT objNum AS INT,
                                  INPUT fullName AS CHAR,
                                  INPUT objArea AS INT,
                                  INPUT objectType AS CHAR):

DEFINE VARIABLE hStorage  AS HANDLE  NO-UNDO.
DEFINE VARIABLE cTmp      AS CHAR    NO-UNDO.
DEFINE VARIABLE cType     AS CHAR    NO-UNDO.
DEFINE VARIABLE tableName AS CHAR    NO-UNDO.
DEFINE VARIABLE objName   AS CHAR    NO-UNDO.
DEFINE VARIABLE myStorage AS Storage NO-UNDO.

   ASSIGN tableName = ENTRY(1,fullName,".").

   IF NUM-ENTRIES(fullName,".") > 1 THEN
      objName = ENTRY(2,fullName,".").

   IF objectType = {&TABLE_TYPE} THEN
      myStorage = myDBConfig:GetTable(tableName).
   ELSE IF objectType = {&INDEX_TYPE} THEN
       myStorage = myDBConfig:GetIndex(tableName, objName).
   ELSE IF objectType = {&CLOB_TYPE} OR objectType = {&BLOB_TYPE} THEN
       myStorage = myDBConfig:GetLob(tableName, objName).

   IF VALID-OBJECT(myStorage) AND myStorage:CanAssignAlternateBufferPool THEN
   DO:
      /* find the area num*/
      IF FillAreaNum THEN DO:
         /* for lobs and _aud- tables, we have to always find the area through the
             _Storageobject table.
         */
              IF objectType = {&TABLE_TYPE} THEN
                  cType = "1".
              ELSE IF objectType = {&INDEX_TYPE} THEN
                  cType = "2".
              ELSE
                  cType = "3".
                  
              ASSIGN cTmp= myDBConfig:LogicalDBName  + "._Storageobject".
              CREATE BUFFER hStorage FOR TABLE cTmp NO-ERROR.
              hStorage:FIND-FIRST("where _Db-recid = " + string(DbRecid) + " AND _Object-type = " + cType + " AND _Object-number = "
                                  + STRING(objNum), NO-LOCK) NO-ERROR.
	      IF hStorage:AVAILABLE THEN DO:
                     objArea = hStorage::_Area-number.
                     hStorage:BUFFER-RELEASE().
                  END.
                  DELETE OBJECT hStorage NO-ERROR.
              END.

      addObject(INPUT objNum,
                INPUT fullName,
                INPUT objArea,
                INPUT objectType,
                INPUT myStorage).
   END.

   DELETE OBJECT myStorage NO-ERROR.

END METHOD.

METHOD PRIVATE VOID refreshBufferPoolInfo(INPUT fullName   AS CHAR,
                                          INPUT objectType AS CHAR):

DEFINE VARIABLE tableName AS CHAR    NO-UNDO.
DEFINE VARIABLE objName   AS CHAR    NO-UNDO.
DEFINE VARIABLE myStorage AS Storage NO-UNDO.

   ASSIGN tableName = ENTRY(1,fullName,".").

   IF NUM-ENTRIES(fullName,".") > 1 THEN
      objName = ENTRY(2,fullName,".").

   IF objectType = {&TABLE_TYPE} THEN
      myStorage = myDBConfig:GetTable(tableName).
   ELSE IF objectType = {&INDEX_TYPE} THEN
       myStorage = myDBConfig:GetIndex(tableName, objName).
   ELSE IF objectType = {&CLOB_TYPE} OR objectType = {&BLOB_TYPE} THEN
       myStorage = myDBConfig:GetLob(tableName, objName).

   IF VALID-OBJECT(myStorage) THEN DO:

       IF myStorage:CanAssignAlternateBufferPool THEN
          fillAltBufPoolInfo(ttObjAttrs.seq-num, myStorage).

       DELETE OBJECT myStorage.
   END.
END.

METHOD PRIVATE VOID fillAltBufPoolInfo(INPUT seqNum AS INT,
                                       INPUT myStorage AS Storage):

 ASSIGN ttObjAttrs.obj-buf-pool = myStorage:ObjectLevelBufferPool
        ttObjAttrs.area-buf-pool = myStorage:AreaLevelBufferPool.

END METHOD.


DESTRUCTOR _obj-attrib-util():

    IF VALID-HANDLE (hDb) THEN
       DELETE OBJECT hDB.

    IF VALID-OBJECT(myDBConfig) THEN
       DELETE OBJECT myDBConfig.
END DESTRUCTOR.

END CLASS.


 
 /*------------------------------------------------------------------------
    File        : prodict.pro.domain-model
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Fri Feb 18 2011
    Notes       : 
  ----------------------------------------------------------------------*/
routine-level on error undo, throw.
using Progress.Lang.* from propath.
using prodict.pro._pro-model from propath.

class prodict.pro._domain-model inherits  _pro-model: 
    {daschema/domain.i}
    
    define dataset dsDomain for ttDomain.
      
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
		
	constructor public _domain-model (  ):
		super ("Domain",dataset dsDomain:handle).		
	end constructor.
  
 
end class. /*************************************************************/
  /* Copyright (c) 2011 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _domain-sel-browse
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     :  
    Notes       : Define with frame in order to be added to other frames
                  (cannot do that with static browse)
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

 
using prodict.misc._browse from propath.
 
class prodict.pro._domain-sel-browse inherits _browse :  
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
    {daschema/domain.i}
 
 	define query qDomain for ttDomain scrolling.

    define browse bDomain query qDomain
        display Name format "x(64)" label "Domain"  width 32
                TenantName format "x(32)" label "Tenant"  
/*                DomainTypeName format "x(32)" label "Type" width 15*/
             
                IsEnabled 
        WITH NO-ROW-MARKERS SEPARATORS  
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 5 DOWN   NO-BOX
         &ELSE 10 DOWN   &ENDIF 
         FIT-LAST-COLUMN.
         
 	define frame Browse-Frame
      bDomain    
      with
      three-d no-box
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
         centered
        &ENDIF
      no-underline scrollable  overlay.  
      /* title "Tenants" set from Presenter:title */
    
    constructor public _domain-sel-browse ():
        super (bDomain:handle in frame Browse-Frame ).    
    end constructor.
     	
	constructor public _domain-sel-browse (hParent as handle ):
		super (bDomain:handle in frame Browse-Frame ). 	   
	    Parent = hParent.	
	end constructor.
 
end class. /*************************************************************/
  /* Copyright (c) 2011 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _domain-sel-nonmt-browse
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : Rajinder Kamboj
    Created     :  
    Notes       : Define with frame in order to be added to other frames for non-mt database
                  (cannot do that with static browse)
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

 
using prodict.misc._browse from propath.


class prodict.pro._domain-sel-nonmt-browse inherits _browse :  
    /*------------------------------------------------------------------------------
       Purpose:  																	  
       Notes:  																	  
	------------------------------------------------------------------------------*/
    {daschema/domain.i}
	   
    define query qDomain for ttDomain scrolling.
    define browse bDomain query qDomain
    display Name format "x(64)" label "Domain"  width 32
            IsEnabled 
    WITH NO-ROW-MARKERS SEPARATORS  
    &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 5 DOWN   NO-BOX
    &ELSE 10 DOWN   &ENDIF 
    FIT-LAST-COLUMN.
         
    define frame Browse-Frame
      bDomain    
      with three-d no-box
     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      centered
     &ENDIF
     no-underline scrollable  overlay.  
     /* title "Tenants" set from Presenter:title */

     constructor public _domain-sel-nonmt-browse ():
        super (bDomain:handle in frame Browse-Frame ).    
     end constructor.
     	
     constructor public _domain-sel-nonmt-browse (hParent as handle ):
       super (bDomain:handle in frame Browse-Frame ). 	   
       Parent = hParent.	
     end constructor.

end class. /*************************************************************/
  /* Copyright (c) 2011 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _domain-sel-presenter
    Purpose     : Browse and select domain
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Mon Feb 21  
    Notes       : 
	
    Modifications:
    04/18/11 Rajinder Kamboj - added functionality to hide Tenant column for Non-MT database.
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

using prodict.misc._browse from propath.
using prodict.pro._pro-presenter from propath.
using prodict.pro._domain-model from propath.
using prodict.pro._pro-sel-dialog-gui from propath.
using prodict.pro._pro-sel-dialog-tty from propath.

class prodict.pro._domain-sel-presenter inherits _pro-presenter: 
    
    constructor public _domain-sel-presenter ( ):
		super ().
	end constructor. 
  
    method protected override void Create():
        define variable mbrowse as _browse no-undo.
        if can-find(first dictdb._tenant) then		
           mbrowse = new prodict.pro._domain-sel-browse(). 
        else
           mbrowse = new prodict.pro._domain-sel-nonmt-browse(). 
        Model = new _domain-model ().
        if session:window-system = "tty" then
        do:
            this-object:View = new _pro-sel-dialog-tty (this-object, mbrowse).
        end.
        else
            this-object:View = new _pro-sel-dialog-gui (this-object, mbrowse).
    end method.
   
end class. /*************************************************************/
  /* Copyright (c) 2011 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _imodel
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     :  
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.
using prodict.misc._query from propath.

interface prodict.pro._imodel: 
    define public property EntityName as character no-undo get. set.
    method public void FetchData(). 
    method public void FetchData(pcQuery as character). 
    method public void FetchData(pcTable as char extent,pcQuery as character extent). 
    method public _query GetQuery(pcTable as char).
    method public _query GetQuery(i as int).
end interface./*************************************************************/
/* Copyright (c) 2011 by Progress Software Corporation.      */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from Progress Software Corporation. */
/*************************************************************/ 
 /*------------------------------------------------------------------------
    File        : _presenter
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     :  
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

interface prodict.pro._ipresenter: 
    
	define public event RowSelected  signature void ( ).

	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
    define public property Title as char no-undo get. set.
    define public property Col as decimal no-undo get. set.
    define public property Row as decimal no-undo get. set.
    define public property HelpId as integer no-undo get. set.
    define public property QueryString as character no-undo get. set. 
    define public property BindingHandle as handle no-undo get. set. 
    
    method public void Selected().     
    method public void Init( ).    
    method public logical Wait( ).    
    method public void ShowHelp( ).    
   
    method public logical Position(pcWhere as char).  
    method public void Sort(pcColumn as char).  
    
    method public char ColumnValue(pccolumn as char).  
    
       
end interface. /*************************************************************/
  /* Copyright (c) 2010 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _iview
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : 2011
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

interface prodict.pro._iview: 
    method public void View(  ).
    method public void Hide(  ).
    method public void Enable(  ).
    method public void Disable(  ).
    method public void Display(  ).    
    method public void Init(  ).
    method public void Close():
    method public void Cancel():
    method public void Ok():
    method public void ShowSort(pccolumn as char  ).    
      
  
    method public logical Wait(  ).  
end interface. 
 /*------------------------------------------------------------------------
    File        : prodict.pro._pro-model
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Fri Feb 18 2011
    Notes       : 
  ----------------------------------------------------------------------*/
routine-level on error undo, throw.

using Progress.Lang.* from propath.

using OpenEdge.DataAdmin.Binding.ServiceAdapter from propath.
 
using OpenEdge.DataAdmin.Message.IFetchResponse from propath.
using OpenEdge.DataAdmin.Message.IFetchRequest from propath.
using OpenEdge.DataAdmin.Message.FetchRequest from propath.

using prodict.misc._query from propath.
using prodict.pro._imodel from propath.

class prodict.pro._pro-model implements _imodel: 
     
    define private variable serviceAdapter as ServiceAdapter no-undo.
    define private variable dataQueries    as _query  extent no-undo.
    define private variable cTables        as character no-undo.
    /* passed to serviceadpater DataAccessFactory */
    define public property EntityName as character no-undo get. set.
  
    define protected property DatasetHandle as handle no-undo get. set.
	
    /*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
		
	constructor public _pro-model (name as char,datasethdl as handle):
		define variable i as integer no-undo.
		super ().		
		DatasetHandle = datasethdl.
		extent(dataQueries) = DatasetHandle:num-buffers.
		EntityName = name.
		/* lookup  */
		do i = 1 to DatasetHandle:num-buffers:
		    cTables = cTables + (if i = 1 then "" else ",") + DatasetHandle:get-buffer-handle(i):name.
        end.        
        
		ServiceAdapter = new ServiceAdapter(ldbname("dictdb")).
	    ServiceAdapter:RequestComplete:Subscribe(DataRefreshed).     
	end constructor.
    
    method public _query GetQuery(pcTable as char):
        define variable i as integer no-undo.
        
        i = lookup(pcTable,cTables).
        if i = 0 then 
            undo, throw new AppError("Table " + pcTable + " not found in Model " + EntityName).
        if not valid-object(dataQueries[i]) then
            dataQueries[i] = CreateQuery(i).
        
        return dataQueries[i].
    end method. 
     
    method public _query GetQuery(i as int):
        if i > DatasetHandle:num-buffers then 
            undo, throw new AppError(String(i) +  " is out of range for num tables in Model " + EntityName).
        if not valid-object(dataQueries[i]) then
            dataQueries[i] = CreateQuery(i).    
        return dataQueries[i].
    end method.  
    
    method protected _query CreateQuery(pcTable as char):
        define variable newquery as _query no-undo.
        newquery = new _query(DatasetHandle:get-buffer-handle(pcTable)).
        return newquery.
    end method.
    
    method protected _query CreateQuery(i as int):
        define variable newquery as _query no-undo.
        newquery = new _query(DatasetHandle:get-buffer-handle(i)).
        return newquery.
    end method.
    
    method public void FetchData():
        define variable msg as IFetchRequest no-undo.
        msg = new FetchRequest(EntityName,"",DatasetHandle).
        FetchData(msg).   
    end method.
        
    method public void FetchData(pcTables as char extent,pcQueries as character extent):  
        define variable msg as IFetchRequest no-undo.  
        define variable cBuffer as character no-undo.
        define variable i as integer no-undo.
        msg = new FetchRequest(EntityName,"",DatasetHandle). 
        do i = 1 to extent(pctables):
           msg:SetTableQuery(pcTables[i],pcQueries[i]).
        end.        
        FetchData(msg).  
    end method.
    
    method public void FetchData(pcQuery as character):
        define variable cBuffers as character extent 1 no-undo.
        define variable cQueries as character extent 1 no-undo.  
        cBuffers[1] = DatasetHandle:get-buffer-handle(1):name.
        cQueries[1] = pcQuery.
        this-object:FetchData(cBuffers,cQueries).         
    end method.
    
    method protected void FetchData(msg as IFetchRequest): 
        ServiceAdapter:FetchData(msg).
    end method.

    method protected void DataRefreshed(msg as IFetchResponse): 
        define variable hBuffer as handle no-undo.
        if msg:DataHandle <> DatasetHandle then
        do:
            DatasetHandle:copy-dataset(msg:DataHandle,yes,yes).
        end.
    end method.
    

	/*------------------------------------------------------------------------------
			Purpose: Remove the queries 																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
	destructor public _pro-model ( ):
        define variable i as integer no-undo.
        do i = 1 to extent(dataQueries):
            if valid-object(dataQueries[i]) then
                delete object dataQueries[i] .
        end.
	end destructor.
     
end class./*************************************************************/
/* Copyright (c) 2011 by Progress Software Corporation.      */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from Progress Software Corporation. */
/*************************************************************/ 
 /*------------------------------------------------------------------------
    File        : prodict.pro._pro-sel-presenter
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Mon Feb 21 00:10:09 EST 2011
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

using prodict.pro._imodel from propath.
using prodict.pro._iview from propath.
using prodict.pro._ipresenter from propath.
using prodict.misc._query from propath.

class prodict.pro._pro-presenter abstract implements _ipresenter: 
    
	define public event RowSelected  signature void ( ).
    
    define public property HelpId as integer no-undo 
        get. 
        set.
	
	define public property Title as char no-undo  
        get. 
        set.
    
    define public property Col as decimal no-undo init 1
        get. 
        set.
    
    define public property Row as decimal no-undo init 1
        get. 
        set.
          
    define protected property Model as _imodel no-undo get. set.	
    define protected property View as _iview no-undo get. set.
	
	define public property QueryString as character no-undo 
    	get.
    	set. 
    
    define public property DataView as _query no-undo 
        get.
        set. 
    
    define public property BindingHandle as handle no-undo 
        get.
        set. 
        	
	define variable mLastSort as character no-undo.
	
	constructor protected _pro-presenter ( ):
		super ().
	end constructor. 

	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
    method public void Selected():
        RowSelected:Publish().
    end method.    
    
    /* implement in subclass to create View and Model */ 
    method abstract protected void Create().
    
    method protected _query GetDataView():
        return Model:GetQuery(1).
    end method.
         
	method public void Init(  ): 
        this-object:Create().
        if QueryString > "" then
            Model:FetchData(QueryString).
        else
            Model:FetchData().
        DataView = GetDataView(). 
        DataView:Init(). 
        BindingHandle = DataView:QueryHandle.
        this-object:View:Init().	 
        return.
    end method.    
    
    method public logical Wait(  ): 
        Init().
        return this-object:View:Wait().
    end.
    
    method public char ValueList (pcColumns as char,pcFormat as char,pcDelimiter as char ):
        return DataView:ValueList(pccolumns,pcFormat,pcDelimiter).       
    end method.    
      
    method public char ColumnValue(pccolumn as char).
        return DataView:ColumnValue(pccolumn).  
    end method.
    
    method public void Sort(pcColumn as char).
        define variable cpos as character extent no-undo.
          /* @TODO sort should be moved to _query */
        if mLastSort = pcColumn then
        do:
            mLastSort = "".
            pcColumn = pccolumn + " descending".
        end.       
        else 
           mLastSort = pcColumn.
        
        cPos = DataView:GetPosition().
        DataView:QueryString = "for each " + DataView:Table + " by " + pcColumn + " indexed-reposition".
        DataView:OpenQuery().
        DataView:SetPosition(cPos).
        /* @TODO change to more generic data refresh event in View */
        this-object:View:ShowSort(pcColumn).
    end method.
    
    method public void ShowHelp( ):  
        if HelpId <> 0 then
            run "adecomm/_adehelp.p" ("admn", 
                                      "CONTEXT", 
                                      HelpId,
                                       ? ). 
    end method.    
         
    method public logical Position(pcWhere as char):  
        define variable hbuffer as handle no-undo.      
        return DataView:SetPosition(pcWhere).  
    end method.    

	/*------------------------------------------------------------------------------
			Purpose: Get rid of dependant objects 																	  
			Notes: As of current the View has a Presenter property that prevents GC 																	  
	------------------------------------------------------------------------------*/
	destructor public _pro-presenter ( ):
        delete object this-object:View no-error.
        delete object this-object:Model no-error.
	end destructor.
      
end class./*************************************************************/
/* Copyright (c) 2011 by Progress Software Corporation.      */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from Progress Software Corporation. */
/*************************************************************/ 
 /*------------------------------------------------------------------------
    File        : _pro-sel-dialog-gui
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Mon Feb 21 00:10:09 EST 2011
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

using prodict.misc._browse from propath.   
using prodict.pro._ipresenter from propath.
using prodict.pro._pro-sel-dialog from propath.

class prodict.pro._pro-sel-dialog-gui inherits _pro-sel-dialog:  
    define variable mb  as _browse no-undo.
 	
 	define button btnCancel label "Ca&ncel" auto-end-key size 15 by .95  .
    define button btnOk auto-go label "&OK" size 15 by .95. 
    define button BtnHelp label "&Help" size 15 by .95. 
    
 	define frame Dialog-Frame
       
      btnOk at row 1 col 1  
      btnCancel at row 1 col 16
      BtnHelp at row 1  col 31
      with
      
      view-as dialog-box three-d
      keep-tab-order side-labels
      no-underline no-box  centered overlay.  
       
    constructor public _pro-sel-dialog-gui (pPresenter as _ipresenter, pbrowse as _browse ):
        super (pPresenter,frame Dialog-Frame:handle,pbrowse).   
        mb = pbrowse.
    end constructor.
    
    method public override void Layout():
         
         frame Dialog-Frame:title = Presenter:title.
         /* adjust width to fit browse */
/*         frame Dialog-Frame:width = mb:width.*/
         /* set row from presenter (ignore Col - keep centered) */
         /* NOTE - GPF if row is set before width (because it is centered? ) */
         frame Dialog-Frame:row = Presenter:row.
         frame Dialog-Frame:col = Presenter:col.
         frame Dialog-Frame:width = mb:width + 1.7.
 
         frame Dialog-Frame:height = mb:height + 3 .
/*         frame Dialog-Frame:height = 14.*/
         btnOk:row = frame Dialog-Frame:height - btnOk:height - 0.7.
         btnCancel:row = frame Dialog-Frame:height - btnCancel:height - 0.7.
         btnhelp:row = frame Dialog-Frame:height - btnhelp:height - 0.7  .
         btnhelp:col = frame Dialog-Frame:width - btnhelp:width - 1. /* */
    
    end method.   
    
    method public override void WidgetEvent(pcname as char):
       case pcname:
           when "Help" then 
           do:
               Presenter:ShowHelp().
           end.
           otherwise super:WidgetEvent(pcName).    
       end.               
    end method.
    
    method public override void Init(  ):        
        on "choose" of btnhelp in frame Dialog-Frame 
            persistent run widgetEvent in widgetHandler("Help").
        super:Init().
         
    end method.   
    
    method public override void Enable(): 
	    super:Enable().
	    enable btnOk btnCancel btnHelp 
	    with frame Dialog-Frame.
	end method. 

end class. /*************************************************************/
  /* Copyright (c) 2011,2014 by progress Software Corporation. */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _pro-sel-dialog-tty
    Purpose     : 
    Syntax      : 
    Description : general selection dialog  
    Author(s)   : hdaniels
    Created     :  
    Notes       : This compiles and runs on gui, but differs from gui as follows:
                  - no rectangles
                  - no help button 
                  - simplified sizing (override Layout()) 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

using prodict.misc._browse from propath. 
using prodict.pro._ipresenter from propath.
using prodict.pro._pro-sel-dialog from propath.
class prodict.pro._pro-sel-dialog-tty inherits _pro-sel-dialog:  
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
 
    define button btnCancel label "Ca&ncel" auto-end-key size 11 by 1.
    define button btnOk label "&OK" auto-go size 11 by 1.
  	define variable mb as prodict.misc._browse no-undo.
  	
  	/* the button's row will be adjusted in the Layout override below */
 	define frame Dialog-Frame       
        btnOk      at row 1 col 2  
        btnCancel  at row 1 col 14       
        with view-as dialog-box three-d
        keep-tab-order side-labels
        no-underline scrollable centered overlay.  
    
     /* pass presenter and browse - the browse will be parented to the frame in super*/   
    constructor public _pro-sel-dialog-tty (pPresenter as _ipresenter,pbrowse as _browse ):
        super (pPresenter,frame Dialog-Frame:handle,pbrowse ).
        mb =   pbrowse.  
    end constructor.
 
    method public override void Layout():
          
         frame Dialog-Frame:title = Presenter:title.
         /* adjust width to fit browse */
         frame Dialog-Frame:width = mb:width. 
         /* set row from presenter (ignore Col - keep centered) */
         /* NOTE - GPF if row is set before width (because it is centered? ) */
         frame Dialog-Frame:row = Presenter:row .
       
      
         /* set frame height to take all available space 
            and adjust buttons and browse accordingly */
         /* If tty screen is maximised, adjust the frame height to display the records using SCREEN-LINES */
         frame Dialog-Frame:height = SCREEN-LINES - Presenter:Row.

         mb:Height = frame Dialog-Frame:height - 4.
         btnOk:row = frame Dialog-Frame:height - 2.
         btnCancel:row = frame Dialog-Frame:height - 2.
      
    end method.   
        
    method public override void Enable(): 
	    enable btnOk btnCancel with frame Dialog-Frame.
	    super:Enable().
	end method. 
 
end class. 
 /*------------------------------------------------------------------------
    File        : _pro-sel-dialog
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Mon Feb 21 00:10:09 EST 2011
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.
using prodict.misc._iwidgethandler. 
using prodict.misc._browse. 

using prodict.pro._tenant-sel-presenter from propath.
using prodict.pro._iview from propath.
using prodict.pro._ipresenter from propath.

class prodict.pro._pro-sel-dialog implements _iview, _iwidgethandler:  
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
    
    define protected property Presenter as _ipresenter no-undo get. set.	
    
 	define variable h as handle no-undo.
  	define variable mFrame as handle no-undo.
    define variable mBrowse as _browse no-undo.
    
    define protected property WidgetHandler as handle no-undo get. set.
    
	constructor public _pro-sel-dialog (pPresenter as _ipresenter, hframe as handle, pbrowse as _browse ):
		super ().
		mFrame = hframe.
		Presenter = pPresenter.   
        mBrowse =  pbrowse. 
        mBrowse:parent = mFrame. 
        run prodict/misc/_eventhandler.p persistent set WidgetHandler (this-object).
	end constructor.
	   
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
    method public void View(  ):
        mFrame:visible = true.
        mBrowse:View().
        return.
    end method.  
    
    method public void Hide(  ):
        mFrame:hidden = true.       
        return.
    end method.  
    
    method public void Disable(  ):
        mBrowse:Disable().       
        return.
    end method.  
    
    method public void WidgetEvent(pcname as char):

       case pcname:
           when "close" then do:
               Close().
           end.    
       end.               
   
    end method.
    
    method public void Close():
        apply "end-error" to mframe.  
    end method.    
   
    method public void Cancel():
    end method.    
   
    method public void Ok():
/*        Presenter:Selected().*/
        apply "go" to mframe.
    end method.    
    
    method public void Display(  ):
        
    end method.  
    
    method public void Enable(  ):
        
        mBrowse:Enable().  
       
        return.
    end method.  
    
    method public void Layout(  ):
        mFrame:Title = Presenter:Title.
        mFrame:column = Presenter:Col no-error.
        mFrame:row = Presenter:Row no-error.
        return.
    end method.  
    
	method public void Init(  ):
	    Layout().
	   
	    mBrowse:Sort:Subscribe(Presenter:Sort).
        mBrowse:DefaultAction:Subscribe(Ok).
	  
	    on window-close of mframe 
	        persistent run widgetEvent in widgetHandler("close").
	    
	    mBrowse:Query = Presenter:BindingHandle.
	
	    mBrowse:Init().
		 
    	this-object:Enable(). 
		 
		this-object:View().  
	 
/*		mBrowse:SetFocus().*/
   end method.    
    
    method public logical Wait(  ):
        define variable lok as logical no-undo.
        define variable h as handle no-undo.
        h = mBrowse:Browse.
        do on error undo, leave 
           on end-key undo, leave:           
            
            wait-for "GO" of mFrame focus h.
            lok = true.
        end.
        
        pause 0 before-hide.
        mFrame:hidden = true.
        return lok.   
    end method.    
    
    method public void ShowSort(pccolumn as char  ):
        mBrowse:ShowSort(pcColumn).
    end method.
    
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
	destructor public _pro-sel-dialog ( ):
        delete object WidgetHandler no-error.
	end destructor.
    
     
end class./*************************************************************/
 /* Copyright (c) 2010 by progress Software Corporation.      */
 /*                                                           */
 /* all rights reserved.  no part of this program or document */
 /* may be  reproduced in  any form  or by  any means without */
 /* permission in writing from progress Software Corporation. */
 /*************************************************************/
/*------------------------------------------------------------------------
    File        : _pro_area_list.p
    Purpose     : return a list of area names 
    Author(s)   : hdaniels - copied from old code - added type 2
    Created     : Fri Dec 17 EST 2010
    Notes       : If pfilerecid is passed
                  - the file area is added as first item in list.  
                  - only type 2 areas area added to the list 
                  
                  The schema area is added last in the list, 
                  (unless it was added first when file has no area.)        
  ----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
/* passed when filling area for index or field  */
define input  parameter  pFileRecid    as recid    no-undo.

define input  parameter  pInvalidAreas as character no-undo. 
/* delimiter - commas in area names allowed */
define input  parameter  pdlm          as character no-undo.    
define output parameter  pAreas        as character no-undo.

define variable cSkipArea as character no-undo.
define buffer b_file for dictdb._File. 

define variable lMt as logical no-undo.
/* ***************************  Main Block  *************************** */
if pdlm = "" or pdlm = ? then 
   pdlm = chr(1).
   
if pFileRecid <> ? then 
do:
    find b_file where recid(b_file) = pFileRecid no-lock.
    lMt = b_file._file-attributes[1].
    if not lMt or  b_file._file-attributes[2] = true then
    do:     
        IF b_file._File-number <> ? THEN DO:
            FIND dictdb._storageobject WHERE dictdb._Storageobject._Db-recid      = b_file._Db-recid 
                                         AND dictdb._Storageobject._Object-type   = 1
                                         AND dictdb._Storageobject._Object-number = b_file._File-Number 
                                         and dictdb._Storageobject._Partitionid = 0 
                                      NO-LOCK NO-ERROR.
            IF AVAILABLE dictdb._StorageObject and dictdb._StorageObject._Area-number <> 0 THEN            
                FIND DICTDB._Area 
                    WHERE DICTDB._Area._Area-number = dictdb._StorageObject._Area-number NO-LOCK NO-ERROR.           
        END.
        ELSE
            FIND DICTDB._Area WHERE DICTDB._Area._Area-num = b_file._ianum NO-LOCK NO-ERROR.
            
        if avail DICTDB._Area then
        do:
            pAreas = dictdb._Area._area-name + pdlm.
            cSkipArea = dictdb._Area._area-name.
        end.
    end.
end.

for each DICTDB._Area  fields (_Area-num _Area-type _Area-name _Area-clustersize)
         where DICTDB._Area._Area-num > 6 
         and DICTDB._Area._Area-type = 6 
         and not can-do(pInvalidAreas, DICTDB._AREA._Area-name)
         and DICTDB._Area._Area-name <> cSkipArea
         and ((not lMt) 
              or   
              (DICTDB._Area._Area-clustersize = 8 
               or
               DICTDB._Area._Area-clustersize = 64 
               or
               DICTDB._Area._Area-clustersize = 512))  
         no-lock:
             
     pAreas = pAreas + DICTDB._Area._Area-name + pdlm.
end.
if not lmt then
do:
    find DICTDB._Area where DICTDB._Area._Area-num = 6 no-lock no-error.
    if avail DICTDB._Area 
    and not can-do(pInvalidAreas, DICTDB._AREA._Area-name) then
        pAreas = pAreas + DICTDB._Area._Area-name.
end.
pAreas = right-trim(pAreas,pdlm).  /*************************************************************/
 /* Copyright (c) 2011 by progress Software Corporation.      */
 /*                                                           */
 /* all rights reserved.  no part of this program or document */
 /* may be  reproduced in  any form  or by  any means without */
 /* permission in writing from progress Software Corporation. */
 /*************************************************************/
/*------------------------------------------------------------------------
    File        : _pro_domain_list.p
    Purpose     : return a list of _sec_authentication-domain names 
    Author(s)   : hdaniels 
    Created     :  
    Notes       : used by prodict/user/_usruchg.p and prodict/gui/_guiuchg.p        
  ----------------------------------------------------------------------*/
using prodict.pro._domain-model.
using prodict.misc._query.

/* ***************************  Definitions  ************************** */
/* usertable or all   */
define input  parameter  pcType    as character    no-undo.
/* delimiter - commas in area names allowed */
define input  parameter  pdlm          as character no-undo.    
define output parameter  pDomains      as character no-undo.

define variable cSkipArea as character no-undo.
define variable Model as _domain-model no-undo.
define variable DataView as _query no-undo.

/* ***************************  Main Block  *************************** */

Model = new _domain-model ().
if pcType > "" then   
    Model:FetchData("for each ttdomain where ttdomain.DomainTypeName = " + quoter(pcType)).
else
    Model:FetchData().
        
DataView = Model:GetQuery("ttdomain"). 
 
DataView:Init(). 
pDomains = DataView:ValueList("Name","",pdlm).
delete object Model.
catch e2 as Progress.Lang.Error :
	message e2:GetMessage(1) skip
	        if session:error-stack-trace then e2:CallStack else ""
    view-as alert-box.	
end catch.
 /*********************************************************************
* Copyright (C) 2010 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _pro_mt_seq.p

Description:   
   Display and handle the multi-tenant change confirmation dialog box.

Returns: "" if user OK'ed change
      	 "error" if user Cancels.

Modified:

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/pro/confirmmt.i }

DEFINE NEW GLOBAL SHARED VARIABLE gl_prompt_mt_seq AS LOGICAL NO-UNDO INIT NO
                                             VIEW-AS TOGGLE-BOX.


DEFINE BUTTON b_yes LABEL "Yes" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON b_no LABEL "No"   {&STDPH_OKBTN} AUTO-ENDKEY.

Define var retval as char NO-UNDO init "". /* return value */
 
define variable cText as character no-undo. 
define variable cConfirm as character no-undo. 
form
   SKIP({&TFM_WID})
   ctext 
   view-as editor size 75 by 2 no-box  
   at  3
   SKIP
   cconfirm at  3 
   view-as TEXT 
   SKIP(1)
   gl_prompt_mt_seq   AT 3

   {adecomm/okform.i
      &STATUS = no
      &OK     = b_yes
      &CANCEL = b_no
      }
   
   with frame confirmation
        DEFAULT-BUTTON b_yes CANCEL-BUTTON b_no
        NO-LABELS  CENTERED
        view-as DIALOG-BOX TITLE "Confirmation of multi-tenancy".

/*------------------------------Trigger Code---------------------------------*/

/*----- SELECTION of OK BUTTON or GO -----*/
/*
on GO of frame confirmation	   /* or OK due to AUTO-GO */
do:

end.
*/

/*------------------------------Mainline Code--------------------------------*/

/* assume that the user is ok with the change if they chose not to see this message */
IF gl_prompt_mt_seq THEN
   RETURN "".

/* Run time layout for button area. */
{adecomm/okrun.i  
   &FRAME = "frame confirmation" 
   &BOX   = "s_rect_Btns"
   &OK    = "b_yes" 
   &CANCEL = "b_no"
}
retval = "error".
do ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE  ON STOP UNDO, LEAVE
with frame confirmation:
      cText = confirmSequence().   
      cConfirm = confirmYes("s":U,no). /* t = table */
      cConfirm:format = "x(" + string(length(cconfirm)) + ")".
      gl_prompt_mt_seq:label = showAgain().
      display cText cConfirm.
      update b_yes  	      
      	     b_no
             gl_prompt_mt_seq
      	     with frame confirmation.

      ASSIGN retval = "".
             gl_prompt_mt_seq.
end.

hide frame confirmation.
return retval.



/*********************************************************************
* Copyright (C) 2010 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _pro_mt_table.p

Description:   
   Display and handle the multi-tenant change confirmation dialog box.

Returns: "" if user OK'ed change
      	 "error" if user Cancels.

Modified:

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES

{adecomm/adestds.i}
{ prodict/pro/confirmmt.i }

DEFINE NEW GLOBAL SHARED VARIABLE gl_prompt_mt_tbl AS LOGICAL NO-UNDO INIT NO
                                             VIEW-AS TOGGLE-BOX.


DEFINE INPUT  PARAMETER pKeepdefault AS LOGICAL NO-UNDO.
DEFINE OUTPUT PARAMETER pIsbad AS LOGICAL INITIAL FALSE NO-UNDO.

DEFINE BUTTON b_yes LABEL "Yes" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON b_no LABEL "No"   {&STDPH_OKBTN} AUTO-ENDKEY.

define variable cText as character no-undo. 
 
form
/*   SKIP({&TFM_WID})*/
   ctext 
   view-as editor size 76 by 14 no-box  
   at  2
/*   SKIP          */
/*   cconfirm at  2*/
/*   view-as TEXT*/
   SKIP(1)
   gl_prompt_mt_tbl   AT 2

   {adecomm/okform.i
      &STATUS = no
      &OK     = b_yes
      &CANCEL = b_no
      }
   
   with frame confirmation
        DEFAULT-BUTTON b_yes CANCEL-BUTTON b_no
        NO-LABELS  CENTERED
        view-as DIALOG-BOX TITLE "Confirmation of multi-tenancy".

/*------------------------------Trigger Code---------------------------------*/

/*----- SELECTION of OK BUTTON or GO -----*/
/*
on GO of frame confirmation	   /* or OK due to AUTO-GO */
do:

end.
*/

/*------------------------------Mainline Code--------------------------------*/

/* assume that the user is ok with the change if they chose not to see this message */
IF gl_prompt_mt_tbl THEN
   RETURN "".

/* Run time layout for button area. */
{adecomm/okrun.i  
   &FRAME = "frame confirmation" 
   &BOX   = "s_rect_Btns"
   &OK    = "b_yes" 
   &CANCEL = "b_no"
}
pIsBad = true.
do ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE  ON STOP UNDO, LEAVE
with frame confirmation:
      cText = confirmTable(pKeepDefault)  .
      gl_prompt_mt_tbl:label = showAgain().
      display cText.
      layout(ctext:handle). 
      update b_yes  	      
      	     b_no
             gl_prompt_mt_tbl
      	     with frame confirmation.

      ASSIGN pIsBad = false.
             gl_prompt_mt_tbl.
end.

hide frame confirmation.




 
 /*------------------------------------------------------------------------
    File        : prodict.pro.tenant-model
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Fri Feb 18 2011
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.* from propath.

using OpenEdge.DataAdmin.Binding.ServiceAdapter from propath.
using OpenEdge.DataAdmin.Binding.Connection from propath.

using OpenEdge.DataAdmin.Message.IFetchRequest from propath.


using OpenEdge.DataAdmin.Message.FetchRequest from propath.
using prodict.misc._query from propath.

class prodict.pro._tenant-model inherits prodict.pro._pro-model: 
    {daschema/tenant.i}
    
    define dataset dsTenant for ttTenant.
      
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
		
	constructor public _tenant-model (  ):
		super ("Tenant",dataset dsTenant:handle).		
	end constructor.
  
   
end class. /*************************************************************/
  /* Copyright (c) 2011 by progress Software Corporation.      */
  /*                                                           */
  /* all rights reserved.  no part of this program or document */
  /* may be  reproduced in  any form  or by  any means without */
  /* permission in writing from progress Software Corporation. */
  /*************************************************************/
 /*------------------------------------------------------------------------
    File        : _tenant-sel-dialog
    Purpose     : 
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Mon Feb 21 00:10:09 EST 2011
    Notes       : Define with static frame in order to be added to other frames
                  (cannot do that with static browse)
  ----------------------------------------------------------------------*/

using Progress.Lang.*.
 
 
using prodict.misc._browse from propath.
 
class prodict.pro._tenant-sel-browse inherits _browse :  
	/*------------------------------------------------------------------------------
			Purpose:  																	  
			Notes:  																	  
	------------------------------------------------------------------------------*/
    {daschema/tenant.i}
 
 	define query qTenant for ttTenant scrolling.

    define browse bTenant query qTenant
        display Name format "x(32)"
                Id  format "->>>>9"
                ExternalId format "x(200)" width 25
                Type       format "x(8)"   
        WITH NO-ROW-MARKERS SEPARATORS  
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 7 DOWN   NO-BOX
         &ELSE 10 DOWN   &ENDIF 
         FIT-LAST-COLUMN.
         
 	define frame Browse-Frame
      bTenant    
      with
      three-d no-box
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
         centered
        &ENDIF
      no-underline scrollable  overlay.  
      /* title "Tenants" set from Presenter:title */
    
    constructor public _tenant-sel-browse ():
        super (btenant:handle in frame Browse-Frame ).    
    end constructor.
     	
	constructor public _tenant-sel-browse (hParent as handle ):
		super (btenant:handle in frame Browse-Frame ). 	   
	    Parent = hParent.	
	end constructor.
 
end class./*************************************************************/
/* Copyright (c) 2011 by Progress Software Corporation.      */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from Progress Software Corporation. */
/*************************************************************/ 
 /*------------------------------------------------------------------------
    File        : _tenant-sel-presenter
    Purpose     : Browse and select tenant
    Syntax      : 
    Description : 
    Author(s)   : hdaniels
    Created     : Mon Feb 21  
    Notes       : 
  ----------------------------------------------------------------------*/

using Progress.Lang.*.

using prodict.misc._browse from propath.
using prodict.pro._pro-presenter from propath.
using prodict.pro._tenant-model from propath.
using prodict.pro._pro-sel-dialog-gui from propath.
using prodict.pro._pro-sel-dialog-tty from propath.

{prodict/admnhlp.i}
        
class prodict.pro._tenant-sel-presenter inherits _pro-presenter: 
    
    constructor public _tenant-sel-presenter ( ):
		super ().
	end constructor. 
  
    method protected override void Create():
        define variable mbrowse as _browse no-undo.
        mbrowse = new prodict.pro._tenant-sel-browse(). 
        Model = new _tenant-model ().
        if session:window-system = "tty" then
        do:
            this-object:View = new _pro-sel-dialog-tty (this-object ,mbrowse).
        end.
        else do:
            HelpId = {&Select_Tenant_Dialog_Box}.
            this-object:View = new _pro-sel-dialog-gui (this-object,mbrowse).
        end.
    end method.
   
end class./*************************************************************/
/* Copyright (c) 1984-2010 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*
   File: prodict/pro/arealabel.i
   
   Description:
     Include file containing functions for area visual state 
     in the Data Dictionary Table Properties dialogs 
     (TTY and create and edit GUI).
    Author(s)   : hdaniels

    Created     : Thu Jun 17 2010
    Notes       :
  ----------------------------------------------------------------------*/
 
function setKeepDefault returns logical(phkeepdefault as handle,pCheck as log ):
    if phKeepDefault:type = "toggle-box" then 
        phKeepDefault:checked = pCheck.
    else
        phKeepDefault:screen-value = string(pCheck).
end.    

function hideArea returns logical(phAreaField as handle):
     if phAreaField:type  = "fill-in" then
         phAreaField:screen-value = "".
     else do:
         phAreaField:add-first (" ").
         phAreaField:screen-value = "".
         
/*         phAreaField:hidden  = true.*/
     end.    
end.    

function showArea returns logical(phAreaField as handle,pcvalue as char,plnew as log):
    if phAreaField:type  = "fill-in" then 
    do:
       if phAreaField:screen-value = "" then
            phAreaField:screen-value = pcvalue.
    end.
    else do:       
        phAreaField:delete(" ").
        if plNew then 
            phAreaField:screen-value = pcvalue.
         
    end.
end.    



function getKeepDefault returns logical(phkeepdefault as handle):
   return  if phKeepDefault:type = "toggle-box" 
           then phKeepDefault:checked
           else phKeepDefault:input-value.
end.    

function setAreaState returns logical 
            (plMt as log, /*multi tenant*/
             plKeepDefault as log,
             plChange as log,  /* changing (not display of current) */
             plNew as log,     /*create (not edit) */
             phKeepDefault as handle,  
             phAreaField as handle,
             phAreaButton as handle, /* some screens have a "home made" combo */
             pcAreaValue as char):
    
    define variable lMtChange as log no-undo.
       
    if plChange and valid-handle(self) and self:name = "_File-attributes" and self <> phKeepDefault then
       lMtChange = true.
      
    if plMt then
    do: 
        if lMtChange then 
        do:
            setKeepDefault(phKeepDefault,true).
            plKeepDefault = true.
        end.   
        phKeepDefault:sensitive = plChange and plNew.  
        phAreaField:sensitive = plnew and plKeepDefault and plChange.
        if not plKeepDefault then 
        do:
            hideArea(phAreaField).
            if valid-handle(phAreaButton) then 
               phAreaButton:sensitive = false.
        end.
        else do: 
            showArea(phAreaField,pcAreaValue,plnew).
            if valid-handle(phAreaButton) then 
               phAreaButton:sensitive = true.
        end.
    end.
    else do:
        if lMtChange then 
             setKeepDefault(phKeepDefault,false).
        phKeepDefault:sensitive = false.
        phAreaField:sensitive = plnew.
        
        showArea(phAreaField,pcAreaValue,plnew).
        
        if valid-handle(phAreaButton) then 
               phAreaButton:sensitive = true.
    end.
    if phKeepDefault:sensitive then 
        phKeepDefault:move-before-tab-item (phAreaField).
    return true. /* not used */
end. 
 /*********************************************************************
* Copyright (C) 2010 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: confirmmt.i

Description:   
   functions with text for multi-tenant change confirmation dialog box.

Returns:  
    
Author: hdaniels
                      
Date Created: 06/27/10

Modified:

----------------------------------------------------------------------------*/
&GLOBAL-DEFINE WIN95-BTN YES

function layout returns logical (ed as handle):
    define variable dHeight as decimal no-undo.
    define variable hWidget as handle no-undo.
    dHeight = ed:height.
    ed:inner-lines = ed:num-lines.
    hWidget = ed:next-sibling.
    do while valid-handle(hWidget):
        hWidget:row = hWidget:row -  (dHeight - ed:height).
        hWidget = hWidget:next-sibling.
    end.     
    ed:frame:height = ed:frame:height - (dHeight - ed:height).  
    return true.
end function.   

function showAgain returns char (): 
     return "&Don't show me this again (for this session)".
end function.

function confirmYes returns char (pcObject as char,plkeepdefault as log):     
     return "Confirm that you want to multi-tenant enable this " 
     + (if pcobject = "s" then "sequence" else if pcobject = "t" then "table" else pcObject)
     + (if pcobject = "t" and plkeepdefault = false then " and delete the data" else "")
     + ".".
end function.

function confirmSequence returns char ():
   return "The multi-tenant change cannot be reverted after you commit the changes.".
end function.


function confirmTable returns char (plKeepDefault as log):
    define variable ctext as character no-undo.
    define variable inumtenants as integer no-undo. 
    define variable iimmediatetenants as integer no-undo. 
    define variable ctenants as char  no-undo. 
    define variable cAllocation as char  no-undo. 
    define variable cRule as char  no-undo. 
    define variable cWarning as char  no-undo. 
    define variable cDataDelete as char  no-undo. 
    define variable cAllOrOne as char  no-undo. 
    
    /* count the number of tenants to shpw in the message, but give up if many many 
      don't count the default and super */
    
    for each dictdb._tenant where dictdb._tenant._tenant-type = 1 no-lock:
       inumtenants = inumtenants + 1.
       if dictdb._tenant._tenant-allocation-default = "immediate" then
          iimmediatetenants = iimmediatetenants + 1.
        
       
       if inumtenants = 1001 then
          leave.
    end. 
    
    if not plkeepdefault then 
         cDataDelete =  "The choice to not keep the default area will cause all existing data in the table to be deleted.". 
    if inumtenants = 0 then 
    do:
        cText = "The change to make this into a multi-tenant table cannot be reverted after the transaction has been committed.".
    end.    
    else do:
        if inumtenants > 1000 then
        do:
            cAllocation = "The partitions will be allocated according to the defaults settings of the (more than 1000) regular tenants.".
        end.
        else do:
            ctenants = "the " + string(inumtenants) + " existing regular tenants".
            if inumtenants = 1 then
               cAllOrOne = "The single existing regular tenant is".
            else
               cAllOrOne = "All of " + ctenants + " are".   
            
            cAllOrOne =  cAllOrOne + " defined to allocate partitions". 
            
            if iimmediatetenants > 0 then
            do: 
                cRule = "immediately according to the default area settings on the tenant.".              
                if iimmediatetenants lt inumtenants then                           
                   cAllocation = 
                        "The partitions for " + string(iimmediatetenants)
                      + " of " + ctenants + " will be allocated " + cRule 
                      + " The remaining partitions are defined to be allocated by tenant or individually later.".
                 else
                    cAllocation = 
                       cAllOrOne + " " + cRule.
                                      
            end.
            else 
              cAllocation = cAllOrOne + " by tenant or individually later.".
             
        end.    
        
        cWarning = "The change to make this into a multi-tenant table will cause new storage partitions to be created" 
                + " for the table, indexes and lob fields for each regular tenant.".
        
           
        cText = cWarning
                 
            + " " + cAllocation 
            + chr(10) + chr (10)
      + "You cannot change the table to not be multi tenant-enabled after you commit the changes."
      /*
      + chr(10) + chr (10)
      + " If you want to customize the area allocation per tenant and object you should use" 
      + " OpenEdge Management or the Multi-tenant Data Dictionary API."
      */
      .

    end.
    if cDataDelete > "" then 
       ctext = cText + chr(10) + chr(10) + cDataDelete. 
    
    return cText
           + "~n~n" 
           + confirmYes("t":U,plKeepDefault).   
    
end function.    

    
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _usershw.p

Description:
   Display the output of an operation (errors etc) in an editor widget.
 
Input:
   user_env[5] MATCHES "*s*" to allow searching ("browse" mode) 
      (NOT CURRENTLY SUPPORTED)
   user_env[6] and user_env[7] contain text for message lines: 
      instructions for use of ok and cancel buttons.
      (If both message lines are null, only the OK button will be shown.)

Input Parameter:
   p_Help - Help context Id

Returns: "ok" or "cancel".
   
Author: Laura Stern

Date Created: 10/02/92

----------------------------------------------------------------------------*/

{ prodict/user/uservar.i }

DEFINE INPUT PARAMETER p_Help AS INTEGER NO-UNDO.
DEFINE VARIABLE sho_file  AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE sho_pages AS CHARACTER EXTENT 1024 NO-UNDO. 
DEFINE VARIABLE sho_limit AS INTEGER               NO-UNDO.
DEFINE VARIABLE sho_title AS CHARACTER             NO-UNDO.
DEFINE VARIABLE only_OK	     AS LOGICAL	     	    NO-UNDO.
DEFINE VARIABLE ix           AS INTEGER             NO-UNDO.
DEFINE VARIABLE stat         AS LOGICAL             NO-UNDO.
DEFINE VARIABLE sho_instruct AS CHARACTER EXTENT 2  NO-UNDO.
DEFINE VARIABLE sho_editor   AS CHARACTER           NO-UNDO
      VIEW-AS EDITOR SIZE 76 BY 10 SCROLLBAR-VERTICAL.

FORM sho_editor      AT 2     	       	     	      SKIP
     sho_instruct[1] AT 2 VIEW-AS TEXT FORMAT "X(70)" SKIP
     sho_instruct[2] AT 2 VIEW-AS TEXT FORMAT "X(70)"
     {prodict/user/userbtns.i} 
     WITH FRAME sho_stuff 
     ROW 3 CENTERED NO-LABELS DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
     VIEW-AS DIALOG-BOX TITLE sho_title.

/*============================= Trigger ==================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame sho_stuff
   or CHOOSE of btn_Help in frame sho_stuff
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT p_Help,
      	       	     	     INPUT ?).
&ENDIF

ON WINDOW-CLOSE OF FRAME sho_stuff
   APPLY "END-ERROR" TO FRAME sho_stuff.

/*========================== Mainline Code ===============================*/

ASSIGN
   sho_instruct[1] = user_env[6]
   sho_instruct[2] = user_env[7].

/* Fill the editor widget with the data (either sho_pages or sho_file) */
IF sho_file = ? THEN
   DO ix = 1 to sho_limit:
      sho_pages[ix] = sho_pages[ix] + CHR(10).
      IF OPSYS = "DOS" THEN
         sho_pages[ix] = sho_pages[ix] + CHR(13).
      stat = sho_editor:insert-string(sho_pages[ix]) IN FRAME sho_stuff.
   END.
ELSE
   stat = sho_editor:read-file(sho_file) IN FRAME sho_stuff.

ASSIGN
   sho_editor:FONT IN FRAME sho_stuff = 0  /* make it a fixed font */
   sho_editor:PFCOLOR IN FRAME sho_stuff = 0
   sho_editor:SENSITIVE IN FRAME sho_stuff = yes  
   sho_editor:READ-ONLY IN FRAME sho_stuff = yes
   only_OK = (IF user_env[6] = "" AND user_env[7] = "" THEN yes ELSE no).

/* Adjust the graphical rectangle and the ok and cancel buttons */
IF only_OK THEN DO:
  btn_Cancel:VISIBLE IN FRAME sho_stuff = no.
  {adecomm/okrun.i  
     &FRAME  = "FRAME sho_stuff" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     &CANCEL =
     {&HLP_BTN}
  }
END.
ELSE DO:
  {adecomm/okrun.i  
     &FRAME  = "FRAME sho_stuff" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
  }
END.

DISPLAY sho_instruct[1] sho_instruct[2] WITH FRAME sho_stuff.
DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   IF only_OK THEN
      UPDATE btn_OK {&HLP_BTN_NAME} WITH FRAME sho_stuff.
   ELSE
      UPDATE btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME sho_stuff.
   HIDE FRAME sho_stuff NO-PAUSE.
   RETURN "ok".
END.

HIDE FRAME sho_stuff NO-PAUSE.
RETURN "cancel".


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*----------------------------------------------------------------------------

File: prodict/gate/_usr_dif.p

Description:   
   Displays gate-edit in an editor-widget. 
   Designed to run persistently and get the following events to 
   invoke the following methods:
   
Input: 
   "U1"     new gate-work-recid in s_gw-recid
   "U2"     delete procedure

Output:
    none
 
History:
    hutegger    95/03   creation

----------------------------------------------------------------------------*/
/*h-*/

/* this file gets used only with GUI, so we make it an empty file for TTY
 */
&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN

&SCOPED-DEFINE DATASERVER YES
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
&UNDEFINE DATASERVER

define input parameter p_prc_parent as handle.

define shared variable s_edt_diff   as character     NO-UNDO.
define shared variable s_tgl_upd    as logical       NO-UNDO.

define        variable l_wdw_diff   as widget-handle NO-UNDO.

/* create window */
if SESSION:DISPLAY-TYPE = "GUI":U
 then create window l_wdw_diff
   assign
         HIDDEN             = YES
         TITLE              = "Schema-Verify - Detected Differences"
         HEIGHT             = 14
         WIDTH              = 69
         MAX-HEIGHT         = 14
         MAX-WIDTH          = 69
         VIRTUAL-HEIGHT     = 14
         VIRTUAL-WIDTH      = 69
         RESIZE             = no
         SCROLL-BARS        = no
         STATUS-AREA        = no
         BGCOLOR            = ?
         FGCOLOR            = ?
         KEEP-FRAME-Z-ORDER = yes
         THREE-D            = yes
         MESSAGE-AREA       = no
         SENSITIVE          = yes.
 else assign l_wdw_diff = CURRENT-WINDOW.

/*================================Forms====================================*/

form
                                                        skip({&TFM_WID})
   "Verifying this object resulted in these messages:" 
                                    at  2 view-as TEXT  skip({&VM_WID})
   s_edt_diff                       at  2 no-label
                        view-as EDITOR 
                        scrollbar-horizontal scrollbar-vertical
                        inner-chars 58 inner-lines 12   skip({&VM_WID})
                        space(1)
   s_tgl_upd                        at 2 view-as text label "Update" 
   {adecomm/okform.i
      &BOX    = rect_btns
      &CANCEL = " "
      &HELP   = "{&HLP_BTN_NAME}"
      &OK     = btn_OK
      &OTHER  = " "
      &STATUS = no
      }
  with side-labels
       row 1 column 1
       title "Verify - Report"
       frame l_frm_diff.

/*===============================Triggers==================================*/

/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN
  on HELP of frame l_frm_diff OR CHOOSE of btn_Help in frame l_frm_diff
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                               INPUT {&Schema_Verify_Dlg_Box},
                               INPUT ?).
 &ENDIF
 
/*----- U1 of PROCEDURE -----*/
on  U1 of THIS-PROCEDURE do: /* refresh with new values */

  display
    s_edt_diff s_tgl_upd
    with frame l_frm_diff in window l_wdw_diff.

  end.

/*----- WINDOW-CLOSE of dialog -----*/
on WINDOW-CLOSE of frame l_frm_diff
  apply "END-ERROR" to frame l_frm_diff.

/*----- U2 of PROCEDURE -----*/
on  U2     of THIS-PROCEDURE do: /* parent wants to close me */
  if SESSION:DISPLAY-TYPE = "GUI":U
   then delete widget l_wdw_diff.
  delete procedure THIS-PROCEDURE.
  end.

/*----- CLOSE of PROCEDURE -----*/
on  CLOSE  of THIS-PROCEDURE /* I want to close myself -> msg to parent */
 or CHOOSE of btn_ok in frame l_frm_diff do:
  APPLY "U1" to p_prc_parent.
  if SESSION:DISPLAY-TYPE = "GUI":U
   then delete widget l_wdw_diff.
  delete procedure THIS-PROCEDURE.
  end.


/*============================Mainline code============================*/
 

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME l_frm_diff" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   &CANCEL = "  " 
   {&HLP_BTN}
}

do with frame l_frm_diff:
  assign
    s_edt_diff:read-only = yes
    btn_ok:label         = "Close"
    l_wdw_diff:width-p   = frame l_frm_diff:width-p /* - 10*/
    l_wdw_diff:height-p  = frame l_frm_diff:height-p
    s_edt_diff:width-p   = /*min(s_edt_diff:width-p
                           ,*/ frame l_frm_diff:width-p
                           - frame l_frm_diff:border-left-p
                           - frame l_frm_diff:border-right-p
                           - 2 * s_edt_diff:x
                                    /* )*/
    l_wdw_diff:x = session:width-p - l_wdw_diff:width-p - 10
    THIS-PROCEDURE:current-window = l_wdw_diff.
  end.
  
do ON ERROR   UNDO, LEAVE
   ON END-KEY UNDO, LEAVE:

  display
    s_edt_diff
    s_tgl_upd
    with frame l_frm_diff in window l_wdw_diff.
  enable
    s_edt_diff
/*  s_tgl_upd */
    btn_OK
    {&HLP_BTN_NAME}
    with frame l_frm_diff in window l_wdw_diff.
  view l_wdw_diff.
  end.

  &ENDIF   /* "{&WINDOW-SYSTEM}" <> "TTY" */
/*=====================================================================*/
/*********************************************************************
* Copyright (C) 2000,2007,2011 by Progress Software Corporation. All *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/user/_usr_gsl.p

Description:
    
    User-Interface for _xxx_get.p-programs
    
    Asks user for selection-criterias for the objects to be displayed 
    and selectable in the followup-list
                
Input-Output Parameters:
    p_name       object-name for pre-selection of objects
    p_owner      owner-name for pre-selection of objects
    p_qual       qualifier for pre-selection of objects
    p_type       object-type for pre-selection of objects
    p_frame      name of the frame to use
    
called from:
    odb/_odb_get.p
    ora/_ora6get.p
    ora/_ora7get.p
    syb/syb_getp.i
    
History:
    hutegger    94/07/29    creation
    mcmann      05/21/02    Added logic for user to select outputting to file instead of screen
    mcmann      06/05/03    Changed p_owner default to user doing selection of object.
    kmcintos    04/13/04    Added support for ODBC type DB2/400 by changing "Object Owner"
                            label to "Owner/Library"
    knavneet    02/21/07    Changed the label from Owner/Library to Collection/Library in case of DB2/400
                            Changed the label from Owner/Library to Owner in case of other data sources.  
    fernando    04/07/08    Support for datetime fo MSS/ORACLE 
    rkumar      02/03/09    Changes to support iSeries driver- OE00179889
    knavneet    04/28/09    BLOB support for MSS - OE00178319
    sdash       04/09/13    command line tool for update/add objects from foreign DB - OE00196459
--------------------------------------------------------------------*/        
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

{prodict/gate/gatework.i 
  &options    = "format ""x(30)"" "
  &SelVarType = "INPUT-OUTPUT PARAMETER p"
  }

define input        parameter p_frame    as   character.
define input        parameter p_link     as   character.
define input        parameter p_master   as   character.

define variable               canned     as   logical init yes.
define variable               l_link     as   character format "x(30)".
define variable               l_verify   as   logical.
define variable               cBestRowid as   character initial "Select 'Best' ROWID Index"
                                              FORMAT "x(27)" NO-UNDO.
define variable               isClobEnabled   as   logical init yes .
define variable               isBlobEnabled   as   logical init yes .
define variable               recid_verify    as   logical init false .
define variable               tmp_str         as   character.

DEFINE VARIABLE batch_mode    AS LOGICAL INITIAL NO       NO-UNDO.


batch_mode = SESSION:BATCH-MODE.

form
                                                          skip({&VM_WIDG})
  l_link    label "Link-Path  "  format "x(30)" colon 18  skip({&VM_WIDG})
  p_name    label "Object &Name"                 colon 18  skip({&VM_WIDG})
  p_type    label "Object &Type"                 colon 18  skip({&VM_WIDG})
  p_owner   label "&Owner"                colon 18  skip({&VM_WIDG})
  SPACE (1) p_vrfy    label "&Verify only objects that currently exist in the schema holder"
            view-as TOGGLE-BOX skip({&VM_WIDG})
  p_datetime LABEL "Default to OpenEdge DATETIME" view-as TOGGLE-BOX 
        at column-of p_vrfy row-of p_vrfy  skip({&VM_WIDG})
  SPACE (1) p_outf    LABEL "Output differences to file" VIEW-AS TOGGLE-BOX 
  {prodict/user/userbtns.i}
 with frame frm_link
  centered row 3 attr-space
  overlay side-labels
  view-as dialog-box default-button btn_ok cancel-button btn_cancel
  TITLE " Pre-Selection Criteria For Schema Pull ".
  
form
                                             skip({&VM_WIDG})
  p_name    label "Object &Name"   colon 18   skip({&VM_WIDG})
/*  p_type    label "Object &Type"  colon 18   skip({&VM_WIDG})*/
  p_owner   label "&Owner"  colon 18   skip({&VM_WIDG})
  p_qual    label "&Qualifier  "   colon 18   skip({&VM_WIDG})
  SPACE (1) p_vrfy    label "&Verify only objects that currently exist in the schema holder"
            view-as TOGGLE-BOX
  p_datetime LABEL "Default to OpenEdge DATETIME" view-as TOGGLE-BOX 
      at column-of p_vrfy row-of p_vrfy  skip({&VM_WIDG})
  p_lob LABEL "Default to OpenEdge LOB for: " view-as TOGGLE-BOX       
      at column-of p_vrfy  row-of p_vrfy skip
  p_clobtype LABEL " CLOBs" VIEW-AS TOGGLE-BOX at col 35  row-of p_vrfy + 1 
  p_blobtype LABEL " BLOBs" VIEW-AS TOGGLE-BOX at col 48  row-of p_vrfy + 1 skip({&VM_WIDG})
  p_primary LABEL "Designate Primary/Clustered index as ROWID" view-as TOGGLE-BOX 
    at column-of p_vrfy  row-of p_vrfy + 2  skip({&VM_WIDG})
  cBestRowid view-as Text no-label
    at column-of p_vrfy + 4 row-of p_vrfy + 2.9 skip({&VM_WIDG})
  p_best  LABEL "Using" VIEW-AS RADIO-SET HORIZONTAL RADIO-BUTTONS
     "OE Schema", 1,
     "Foreign schema", 2
      AT column-of p_vrfy + 4 row-of p_vrfy + 3.7 skip({&VM_WID})
  p_recidcompat LABEL "Provide RECID Compatibility" view-as TOGGLE-BOX
    at column-of p_vrfy  row-of p_vrfy + 4.6  skip({&VM_WIDG})
      
  SPACE (1) p_outf    LABEL "Output differences to file" VIEW-AS TOGGLE-BOX 
  {prodict/user/userbtns.i}
  with frame frm_ntoq
  centered row 3 attr-space
  overlay side-labels 
  view-as dialog-box default-button btn_ok cancel-button btn_cancel
  TITLE " Pre-Selection Criteria For Schema Pull ".
  
form
                                             skip({&VM_WIDG})
  p_name    label "Object &Name"   colon 18   skip({&VM_WIDG})
  p_type    label "Object &Type"   colon 18   skip({&VM_WIDG})
  p_owner   label "&Owner"  colon 18   skip({&VM_WIDG})
  SPACE (1) p_vrfy    label "&Verify only objects that currently exist in the schema holder"
            view-as TOGGLE-BOX skip({&VM_WIDG})
  SPACE (1) p_outf    LABEL "Output differences to file" VIEW-AS TOGGLE-BOX 
  {prodict/user/userbtns.i}
 with frame frm_nto
  centered row 3 attr-space
  overlay side-labels
  view-as dialog-box default-button btn_ok cancel-button btn_cancel
  TITLE " Pre-Selection Criteria For Schema Pull ".

form
                                             skip({&VM_WIDG})
  p_name    label "Object &Name"   colon 20   skip({&VM_WIDG})
  p_owner   label "&Collection/Library"  colon 20   skip({&VM_WIDG})
  p_qual    label "&Qualifier  "   colon 20   skip({&VM_WIDG})
  SPACE (1) p_vrfy    label "&Verify only objects that currently exist in the schema holder"
            view-as TOGGLE-BOX skip({&VM_WIDG})
  SPACE (1) p_outf    LABEL "Output differences to file" VIEW-AS TOGGLE-BOX 
  {prodict/user/userbtns.i}
 with frame frm_as400
  centered row 3 attr-space
  overlay side-labels
  view-as dialog-box default-button btn_ok cancel-button btn_cancel
  TITLE " Pre-Selection Criteria For Schema Pull ".
  

/*---------------------------  TRIGGERS  ---------------------------*/


&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
  on HELP of frame frm_ntoq
    or CHOOSE of btn_Help in frame frm_ntoq
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
 			      INPUT {&Presel_Schema_Pull_Qual_Dlg_Box},
			      INPUT ?).
  on HELP of frame frm_link
    or CHOOSE of btn_Help in frame frm_link
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
 			      INPUT {&Presel_Schema_Pull_Dlg_Box},
			      INPUT ?).
  on HELP of frame frm_nto
    or CHOOSE of btn_Help in frame frm_nto
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
			      INPUT {&Presel_Schema_Pull_Dlg_Box},
			      INPUT ?).
  on HELP of frame frm_as400
    or CHOOSE of btn_Help in frame frm_as400
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
			      INPUT {&Presel_Schema_Pull_Dlg_Box},
			      INPUT ?).
  &ENDIF
  
on GO of frame frm_link do:
  assign
    p_name  = p_name:screen-value  in frame frm_link
    p_owner = p_owner:screen-value in frame frm_link
    p_type  = p_type:screen-value  in frame frm_link
    .
  end.
  
on GO of frame frm_ntoq do:
  assign
    p_name  = p_name:screen-value  in frame frm_ntoq
    p_owner = p_owner:screen-value in frame frm_ntoq
    p_qual  = p_qual:screen-value  in frame frm_ntoq
   .
  end.
  
on GO of frame frm_nto do:
  assign
    p_name  = p_name:screen-value  in frame frm_nto
    p_owner = p_owner:screen-value in frame frm_nto
    p_type  = p_type:screen-value  in frame frm_nto
    .
  end.

on GO of frame frm_as400 do:
  assign
    p_name  = p_name:screen-value  in frame frm_as400
    p_owner = p_owner:screen-value in frame frm_as400
    p_qual  = p_qual:screen-value  in frame frm_as400
    .
  end.

on WINDOW-CLOSE of frame frm_link
   apply "END-ERROR" to frame frm_link.
    
on WINDOW-CLOSE of frame frm_ntoq
   apply "END-ERROR" to frame frm_ntoq.

on WINDOW-CLOSE of frame frm_nto
   apply "END-ERROR" to frame frm_nto.

on WINDOW-CLOSE of frame frm_as400
   apply "END-ERROR" to frame frm_as400.
    
/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

/*------------------------------------------------------------------*/
/* Default owner to userid of person doing the pull of objects.  20030605-037 */
/* AS/400- Default owner is set to userid in case default library 
   is not specified while creating the driver DSN-		 OE00179889 */
IF INDEX(USERID("DICTDBG"), "/") > 0 THEN
    ASSIGN p_owner = SUBSTRING(USERID("DICTDBG"), 1, (INDEX( USERID("DICTDBG"), "/") - 1)).
ELSE IF INDEX(USERID("DICTDBG"), "@") > 0 THEN
    ASSIGN p_owner = SUBSTRING(USERID("DICTDBG"), 1, (INDEX( USERID("DICTDBG"), "@") - 1)).
ELSE IF (p_frame NE "frm_as400" AND USERID("DICTDBG") NE "") 
        OR (p_frame = "frm_as400" AND (p_owner = "*" OR p_owner = "" OR p_owner = ? )) THEN 
	     ASSIGN  p_owner = USERID("DICTDBG").

IF OS-GETENV("RECIDONLY") <> ? THEN DO:
  ASSIGN tmp_str  = OS-GETENV("RECIDONLY").
  IF tmp_str BEGINS "Y" THEN 
     ASSIGN  recid_verify = TRUE.
  ELSE 
     ASSIGN  recid_verify = FALSE.
END.

IF DBTYPE("DICTDBG") EQ "ORACLE" AND p_owner = "" THEN
   RUN prodict/ora/_get_orauser.p (OUTPUT p_owner).

do on ENDKEY undo,leave:

  assign l_verify = user_env[25] begins "compare"
                 or user_env[25] begins "auto-compare".

  if p_frame = "frm_link":U
   then do:  /* frame frm_link */
    
    if not l_verify then 
      ASSIGN p_outf:hidden in frame frm_link = TRUE
             p_vrfy:hidden in frame frm_link = TRUE.
    
    /* for verify, or db-link, don't display date/datetime overrride option */
    IF l_verify OR p_link <> ""  THEN 
       ASSIGN p_datetime:hidden in frame frm_link = TRUE.

    {adecomm/okrun.i  
      &FRAME  = "FRAME frm_link" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
      }

    if p_link <> ""
     then assign
      l_link = p_master + p_link
      l_link = substring(l_link,
                         max(1,length(l_link,"character") - 30),
                         -1,
                         "character").
     else assign l_link = "<Local DB>":L30.
      
    display l_link with frame frm_link.
      
    update
      p_name
      p_type 
      p_owner 
      p_vrfy when l_verify
      p_outf WHEN l_verify
      p_datetime WHEN not l_verify AND p_link = "" 
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
     with frame frm_link.
  
    hide frame frm_link no-pause.
    assign canned = false.
    end.     /* frame frm_link */
  
  else if p_frame = "frm_ntoq":U 
   then do:  /* frame frm_ntoq */
 
ASSIGN        p_clobtype:sensitive in frame frm_ntoq = FALSE
              p_blobtype:sensitive in frame frm_ntoq = FALSE
              p_lob:sensitive in frame frm_ntoq = TRUE
	      p_lob = FALSE
	      p_clobtype = TRUE
	      p_blobtype = TRUE.
    if not recid_verify then 
      ASSIGN p_recidcompat:HIDDEN IN FRAME frm_ntoq = TRUE.

    if not l_verify then 
      ASSIGN p_outf:HIDDEN IN FRAME frm_ntoq = TRUE
             p_vrfy:hidden in frame frm_ntoq = TRUE.

    IF NOT CAN-DO("MSS",DBTYPE("DICTDBG")) or l_verify THEN
    DO:
      ASSIGN p_lob:hidden in frame frm_ntoq = TRUE.
      ASSIGN p_clobtype:hidden in frame frm_ntoq = TRUE.
      ASSIGN p_blobtype:hidden in frame frm_ntoq = TRUE.
      ASSIGN p_datetime:hidden in frame frm_ntoq = TRUE.
      ASSIGN p_primary:hidden in frame frm_ntoq = TRUE.
      ASSIGN cBestRowid:hidden in frame frm_ntoq = TRUE.
      ASSIGN p_best:hidden in frame frm_ntoq = TRUE.
      ASSIGN p_recidcompat:hidden in frame frm_ntoq = TRUE.
   END.
    ELSE DO:
        /* move it one row below - the frame definitions has it on the same
           line as the previous widget so that when we don't have to display
           it, it doesn't leave a big gap on the UI */
        ASSIGN p_lob:ROW in frame frm_ntoq = p_lob:ROW in frame frm_ntoq + 1.
/*        ASSIGN p_blobtype = TRUE.
               p_blobtype:sensitive in frame frm_ntoq = FALSE.
        ASSIGN p_clobtype = TRUE.
               p_clobtype:sensitive in frame frm_ntoq = FALSE.*/
    END.

  ON VALUE-CHANGED of p_lob IN FRAME frm_ntoq DO:
    IF SELF:screen-value = "no" THEN DO:
     ASSIGN 
           p_clobtype:sensitive IN FRAME frm_ntoq = FALSE
           p_blobtype:sensitive IN FRAME frm_ntoq = FALSE.
    END.
    ELSE DO:
    ASSIGN 
           p_clobtype:screen-value in frame frm_ntoq = "yes"
           p_blobtype:screen-value in frame frm_ntoq = "yes"
           isBlobEnabled = TRUE
           isClobEnabled = TRUE
           p_clobtype = TRUE
           p_blobtype = TRUE
           p_clobtype:sensitive IN FRAME frm_ntoq = TRUE
           p_blobtype:sensitive IN FRAME frm_ntoq = TRUE.
    END.
  END.

  ON VALUE-CHANGED of p_clobtype IN FRAME frm_ntoq DO:
    IF SELF:screen-value = "no" THEN DO:
     p_clobtype = false.
     isClobEnabled = false.
    END.
    ELSE DO:
     p_clobtype = TRUE.
     isClobEnabled = TRUE.
    END.

     if isBlobEnabled = no and isClobEnabled = no then 
       ASSIGN p_lob:screen-value in frame frm_ntoq = "no".
     else 
       ASSIGN p_lob:screen-value in frame frm_ntoq = "yes".

  END. 


  ON VALUE-CHANGED of p_blobtype IN FRAME frm_ntoq DO:
    IF SELF:screen-value = "no" THEN DO:
     p_blobtype = false.
     isBlobEnabled = false.
    END.
    ELSE DO:
     p_blobtype = TRUE.
     isBlobEnabled = TRUE.
    END.

/*     assign p_lob:sensitive in frame frm_ntoq = TRUE.*/
     if isBlobEnabled = no and isClobEnabled = no then 
       ASSIGN p_lob:screen-value in frame frm_ntoq = "no".
     else 
       ASSIGN p_lob:screen-value in frame frm_ntoq = "yes".
    
  END. 

  ON VALUE-CHANGED of p_best IN FRAME frm_ntoq DO:
    IF SELF:screen-value = "2" THEN DO:
       p_recidcompat = false.
       assign p_recidcompat:sensitive in frame frm_ntoq = FALSE.
    END.
    ELSE assign p_recidcompat:sensitive in frame frm_ntoq = TRUE.
  END.

 IF NUM-ENTRIES(user_env[25]) = 9
   THEN ASSIGN
     p_name  = ENTRY(1,user_env[25])
     p_owner = ENTRY(2,user_env[25])
     p_qual  = ENTRY(3,user_env[25])
     p_datetime = LOGICAL(ENTRY(4,user_env[25]))
     p_vrfy = LOGICAL(ENTRY(5,user_env[25]))
     p_lob = LOGICAL(ENTRY(6,user_env[25]))
     p_blobtype = LOGICAL(ENTRY(7,user_env[25]))
     p_clobtype = LOGICAL(ENTRY(8,user_env[25]))
     p_best = INTEGER(ENTRY(9,user_env[25])).

   {adecomm/okrun.i  
      &FRAME  = "FRAME frm_ntoq" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
      }

    update
      p_name
      p_owner
      p_qual
      p_vrfy when l_verify
      p_outf WHEN l_verify
      p_datetime WHEN not l_verify and DBTYPE("DICTDBG") EQ "MSS"
      p_lob WHEN not l_verify and DBTYPE("DICTDBG") EQ "MSS"
      p_clobtype WHEN p_lob and not l_verify and DBTYPE("DICTDBG") EQ "MSS"
      p_blobtype WHEN p_lob and not l_verify and DBTYPE("DICTDBG") EQ "MSS"
      p_primary  WHEN not l_verify and DBTYPE("DICTDBG") EQ "MSS"
      cBestRowid  WHEN not l_verify and DBTYPE("DICTDBG") EQ "MSS"
      p_best  WHEN not l_verify and DBTYPE("DICTDBG") EQ "MSS"      
      p_recidcompat WHEN not l_verify and DBTYPE("DICTDBG") EQ "MSS"  AND recid_verify 
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
     with frame frm_ntoq.
  
    hide frame frm_ntoq no-pause.
    assign canned = false.

    end.     /* frame frm_ntoq */

  else if p_frame = "frm_as400":U 
   then do:  /* frame frm_as400 */
 
    if not l_verify then 
      ASSIGN p_outf:HIDDEN IN FRAME frm_as400 = TRUE
             p_vrfy:hidden in frame frm_as400 = TRUE.

    {adecomm/okrun.i  
      &FRAME  = "FRAME frm_as400" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
      }

    update
      p_name
      p_owner
      p_qual
      p_vrfy when l_verify
      p_outf WHEN l_verify
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
     with frame frm_as400.
  
    hide frame frm_as400 no-pause.
    assign canned = false.

    end.     /* frame frm_as400 */ 
  
  else if p_frame = "frm_nto":U
   then do:  /* frame frm_nto */
 
    if not l_verify then 
      ASSIGN p_outf:HIDDEN IN FRAME frm_nto = TRUE
             p_vrfy:hidden in frame frm_nto = TRUE.

    {adecomm/okrun.i  
      &FRAME  = "FRAME frm_nto" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
      }

    update
      p_name
      p_type
      p_owner
      p_vrfy when l_verify
      p_outf WHEN l_verify
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
     with frame frm_nto.
  
    hide frame frm_nto no-pause.
    assign canned = false.
    
    end.     /* frame frm_nto */
    
  end.  /* do on endkey undo, leave */
RETURN if canned then "cancel":U else "ok":U.
  
/*------------------------------------------------------------------*/        
/***********************************************************************
* Copyright (C) 2000,2006,2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* useradmn - set Security Administrators */

using OpenEdge.DataAdmin.DataAdminService from propath.
using OpenEdge.DataAdmin.IAdministrator from propath.
 
{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE ans         AS LOGICAL             NO-UNDO.
DEFINE VARIABLE canned      AS LOGICAL   INIT TRUE NO-UNDO.
DEFINE VARIABLE i           AS INTEGER             NO-UNDO.
DEFINE VARIABLE j           AS INTEGER             NO-UNDO.
DEFINE VARIABLE mass        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE msg-num     AS INTEGER   INITIAL 0 NO-UNDO.
DEFINE VARIABLE orig        AS CHARACTER           NO-UNDO.
DEFINE VARIABLE security    AS CHARACTER EXTENT  4 NO-UNDO.
DEFINE VARIABLE user-exists AS LOGICAL             NO-UNDO.
DEFINE VARIABLE msgSecuAdm AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 52 INNER-LINES 1 NO-UNDO.
DEFINE VARIABLE instrSecu1 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 20 INNER-LINES 7 NO-UNDO.
DEFINE VARIABLE instrSecu2 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 52 INNER-LINES 7 NO-UNDO.
DEFINE VARIABLE instrSecu3 AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 72 INNER-LINES 1 NO-UNDO.
DEFINE VARIABLE cr AS CHARACTER NO-UNDO.

define variable administrator       as  IAdministrator no-undo.
define variable service             as  DataAdminService no-undo.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /* 1*/ "This function only works on {&PRO_DISPLAY_NAME} databases.",
  /* 2*/ "You may not use this function with a blank userid.",
  /* 3*/ "You must be a Security Administrator to execute this function.",
  /* 4*/ "You cannot change a security field to exclude yourself.",
  /* 5*/ "At least one security-administrator must be defined as a user.",
  /* 6*/ "Are you sure that you want to make this change?",
  /* 7*/ "The dictionary is in read-only mode - alterations not allowed."
].

FORM 
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN 
  msgSecuAdm NO-LABEL AT 2 SKIP
&ELSE
  "Enter login ids to control who can change security.      " AT 2 SKIP
&ENDIF
  security[1] FORMAT "x(63)" {&STDPH_FILL}    	        AT 2 SKIP({&VM_WID})
  security[2] FORMAT "x(63)" {&STDPH_FILL}     	      	AT 2 SKIP({&VM_WID})
  security[3] FORMAT "x(63)" {&STDPH_FILL}    	      	AT 2 SKIP({&VM_WID})
  security[4] FORMAT "x(63)" {&STDPH_FILL}    	        AT 2 SKIP({&VM_WIDG})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN 
  instrSecu1 NO-LABEL at 2
  instrSecu2 NO-LABEL at ROW-OF instrSecu1 COLUMN 24 SKIP
  instrSecu3 NO-LABEL at 2
&ELSE
  {prodict/user/usersecu.i}  /* instructions */
&ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME security 
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN 
      CENTERED THREE-D
&ELSE
      ROW 2
&ENDIF
      NO-LABELS ATTR-SPACE 
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX TITLE "Security Administrators".

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  ASSIGN msgSecuAdm:SCREEN-VALUE =
     "Enter login ids to control who can change security.".
  msgSecuAdm:READ-ONLY = yes.
  
  cr = chr(10).
  
  ASSIGN instrSecu1:SCREEN-VALUE =
  "Examples:" + cr +
  "" +  cr +
  "*" +  cr +
  "<user>,<user>,etc." + cr +
  "!<user>,!<user>,*" + cr +
  "acct*" + cr +
  "" + cr.
  
  ASSIGN instrSecu3:SCREEN-VALUE =
    "Note: Spaces used in the permission string will be taken literally.".
  /*"Do not use spaces in the string (they will be taken literally).".*/
  
  ASSIGN instrSecu2:SCREEN-VALUE =
  "" +  cr +
  "" +  cr +
  " -  All users (login Ids) are allowed access." +  cr +
  "-  Only these users have access." + cr +
  "-  All except these users have access." + cr +
  "-  Only users that begin with ~"acct~" allowed." + cr +
  "".
  
  instrSecu1:READ-ONLY = yes.
  instrSecu2:READ-ONLY = yes.
  instrSecu3:READ-ONLY = yes.
&ENDIF
  
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN 
/*----- HELP -----*/
on HELP of frame security
   or CHOOSE of btn_Help in frame security
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Security_Administrators_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


ON GO OF FRAME security
DO:
  ASSIGN
    INPUT FRAME security security[1] 
    INPUT FRAME security security[2] 
    INPUT FRAME security security[3] 
    INPUT FRAME security security[4].   

  ASSIGN
    user-exists = TRUE
    mass        = security[1] + "," + security[2] + ","
                + security[3] + "," + security[4]
    i           = INDEX(mass,",,").

  DO WHILE i > 0:
    ASSIGN
      mass = SUBSTRING(mass,1,i) + SUBSTRING(mass,i + 2)
      i    = INDEX(mass,",,").
  END.
  DO WHILE (LENGTH(mass) > 0) AND SUBSTRING(mass,LENGTH(mass),1) = ",":
    mass = SUBSTRING(mass,1,LENGTH(mass) - 1).
  END.
  
  IF mass <> orig THEN 
  DO:
    ans = FALSE.
    MESSAGE new_lang[6] 
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE ans.
    IF NOT ans THEN RETURN NO-APPLY.
  END.
  
  administrator:Administrators = mass.
  service:UpdateAdministrator(administrator).
  
  catch e as Progress.Lang.Error :
        
      if  e:GetMessageNum(1) > 0 and e:GetMessageNum(1) < 8 then
           message
               new_lang[e:GetMessageNum(1)] 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      else  
          message               
                e:GetMessageNum(1)
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                
      APPLY "ENTRY" TO security[1] IN FRAME security.
      RETURN NO-APPLY.          
  end catch.
END.

ON WINDOW-CLOSE OF FRAME security
   APPLY "END-ERROR" TO FRAME security.

/*============================Mainline code===============================*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  ENABLE msgSecuAdm instrSecu1 instrSecu2 InstrSecu3 WITH FRAME security.
&ENDIF

service = new DataAdminService(ldbname("DICTDB")).
do on error undo, throw:
    
    /* note: can probably be removed as the AdministratorSource checks dbtype("dictdb") */
    IF user_dbtype <> "PROGRESS" THEN 
        undo, throw new Progress.Lang.AppError(new_lang[1],1). /* dbtype okay */

    administrator = service:GetAdministrator().
   
    catch e as Progress.Lang.Error :
        
        if  e:GetMessageNum(1) > 0 and e:GetMessageNum(1) < 8 then
            message
                new_lang[e:GetMessageNum(1)] 
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        else  
            message               
                e:GetMessageNum(1)
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        user_path = "".
        RETURN.            
    end catch.
 
end.
 
ASSIGN
  security    = ""
  security[1] = administrator:Administrators
  orig        = administrator:Administrators.
DO j = 1 TO 3:
  IF LENGTH(security[j]) > 63 THEN DO:
    IF SUBSTRING(security[j],64,1) = "," THEN
      ASSIGN security[j + 1 ] = SUBSTRING(security[j], 65)
             security[j] = SUBSTRING(security[j], 1, 63).
    ELSE
      ASSIGN security[j + 1 ] = SUBSTRING(security[j], 64)
             security[j] = SUBSTRING(security[j], 1, 63)
             i = R-INDEX(security[j], ",")
             security[j + 1] = SUBSTRING(security[j],i + 1) + security[j + 1]
             security[j    ] = SUBSTRING(security[j],1,i - 1).
  END.
  ELSE
    ASSIGN j = 3.
END.

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME security" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}

DO ON ENDKEY UNDO,LEAVE ON ERROR UNDO, LEAVE:
  PAUSE 0.
  UPDATE security btn_OK btn_Cancel {&HLP_BTN_NAME}
      	 WITH FRAME security.
  canned = FALSE.
END.

HIDE FRAME security NO-PAUSE.
IF canned THEN
  user_path = "".
RETURN.


/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* _usrauto.p - editor for auto-connect progress dbs 
 *
 * HISTORY:
 * 04/12/00 by DLM - Added long path name support
 * 07/14/98 by DLM - Added _Owner to _File finds 
 * 07/13/94 by gfs - 94-06-28-062
 * 07/12/94 by gfs - 94-06-28-098, 94-06-29-035, 94-06-29-076.
 */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer   AS LOGICAL                NO-UNDO.
DEFINE VARIABLE args     AS CHARACTER EXTENT  5    NO-UNDO.
DEFINE VARIABLE i        AS INTEGER                NO-UNDO.
DEFINE VARIABLE in_trans AS LOGICAL                NO-UNDO.
DEFINE VARIABLE j        AS INTEGER                NO-UNDO.
DEFINE VARIABLE qbf#     AS INTEGER   INITIAL 1    NO-UNDO.
DEFINE VARIABLE qbf#list AS CHARACTER              NO-UNDO.
DEFINE VARIABLE qbf_disp AS RECID     INITIAL ?    NO-UNDO.
DEFINE VARIABLE qbf_home AS RECID                  NO-UNDO.
DEFINE VARIABLE qbf_rec  AS RECID                  NO-UNDO.
DEFINE VARIABLE qbf_was  AS INTEGER   INITIAL 2    NO-UNDO.
DEFINE VARIABLE redraw   AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE ctr      AS INTEGER                NO-UNDO.
DEFINE VARIABLE rc       AS LOGICAL   INITIAL NO   NO-UNDO.
DEFINE BUFFER   xdb     FOR DICTDB._Db.

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE qbf AS CHARACTER EXTENT 9 NO-UNDO INITIAL [
  "Next", "Prev", "First", "Last", "Add", "Modify", "Delete", "Undo", "Exit"
].
FORM
  qbf[1] /*Next*/   FORMAT "x(4)" HELP "Look at the next connect record."
  qbf[2] /*Prev*/   FORMAT "x(4)" HELP "Look at the previous connect record."
  qbf[3] /*First*/  FORMAT "x(5)" HELP "Look at the first connect record."
  qbf[4] /*Last*/   FORMAT "x(4)" HELP "Look at the last connect record."
  qbf[5] /*Add*/    FORMAT "x(3)" HELP "Add a new connect record."
  qbf[6] /*Modify*/ FORMAT "x(6)" HELP "Update the displayed connect record."
  qbf[7] /*Delete*/ FORMAT "x(6)" HELP "Delete the displayed connect record."
  qbf[8] /*Undo*/   FORMAT "x(4)"
    HELP "Undo this session's changes to the connect records."
  qbf[9] /*Exit*/   FORMAT "x(4)"
    HELP "Exit, save changes, and return to menu."
  WITH FRAME qbf NO-BOX NO-LABELS ATTR-SPACE
  ROW SCREEN-LINES - 2 CENTERED.

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  /* 1*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 2*/ "You do not have permission to use this option.",
  /* 3*/ "You have reached the last connect record in the table.",
  /* 4*/ "You have reached the first connect record in the table.",
  /* 5*/ "Are you sure that you want to remove the connect record for",
  /* 6*/ "Undo all changes since this option entered from menu?",
  /* 7*/ "You haven't yet made changes that need to be undone!",
  /* 8*/ "You cannot delete an autoconnect record for a connected database.",
  /* 9*/ "This name already used for a sub-schema or auto-connect record.",
  /*10*/ "Logical name may not be left blank or unknown.",
  /*11*/ "You cannot use the same logical name as the currently selected database.",
  /*12*/ "Physical name may not be left blank or unknown."
].

DO FOR DICTDB._Db:
  FORM
    _Db-name LABEL "Database Name" SKIP
    WITH FRAME db_list ROW 1 COLUMN 1 ATTR-SPACE 13 DOWN SCROLL 1 USE-TEXT.

  FORM
    _Db-name LABEL "Logical Database Name" AT 2 SKIP
    " Physical Database Name:" SKIP
    _Db-addr FORMAT "x({&PATH_WIDG})" view-as FILL-IN SIZE 51 by 1 NO-LABEL AT 5 SKIP (1)
    " CONNECT statement parameters for auto-connect:" SKIP
    args[1] AT 5 FORMAT "x(51)" NO-LABEL SKIP
    args[2] AT 5 FORMAT "x(51)" NO-LABEL SKIP
    args[3] AT 5 FORMAT "x(51)" NO-LABEL SKIP
    args[4] AT 5 FORMAT "x(51)" NO-LABEL SKIP
    args[5] AT 5 FORMAT "x(51)" NO-LABEL SKIP (1)
    " If the above-named {&PRO_DISPLAY_NAME} database is referenced in a "    SKIP
    " program, and is not connected, the parameters stored here "  SKIP
    " will be used for an ~"auto-connect~". For DataServers, use " SKIP
    " the Edit Connection Information Utility. " SKIP
   WITH FRAME db_long ROW 1 COLUMN 17 ATTR-SPACE SIDE-LABELS.
END.

/*
123456789012345678901234567890123456789012345678901234567890123456789012345678

12345678901234567
+--------------++-------------------------------------------------------------+
| idx1         || Database name: ____________                                 |
| index2       ||                                                             |
| idx3         || Enter physical database name below:                         |
|              ||    :___________________________________________________     |
|              ||                                                             |
|              || Enter UNIX-style parameters for auto-connection below:      |
| index-4      ||    :___________________________________________________     |
| idx_5        ||    :___________________________________________________     |
| ix#6         ||    :___________________________________________________     |
| index007     ||    :___________________________________________________     |
| 123456789012 ||    :___________________________________________________     |
|              || When the above-named database is called for in a PROGRESS   |
|              || program, and PROGRESS sees that the above-named database is |
|              || not connected, but the current database is connected, the   |
|              || parameters stored here will be used for an "auto-connect".  |
|              || NOTE: Please use "Edit Connection Parameters..." in the     |
|              ||       "DataServer" menu for Non-PROGRESS databases.         |
+--------------++-------------------------------------------------------------+
*/

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/*===============================Triggers=================================*/

ON LEAVE of _Db-name IN FRAME db_long
DO:
   RUN "adecomm/_valname.p" (INPUT SELF:SCREEN-VALUE, INPUT no, OUTPUT answer).
   IF NOT answer THEN
      RETURN NO-APPLY.
END.

ON LEAVE of _Db-addr IN FRAME db_long
DO:
   _Db-addr:SCREEN-VALUE = REPLACE(_Db-addr:SCREEN-VALUE, ".db", "").
END.

ON GO OF FRAME db_long 
DO:
   DEFINE VAR scr_val AS CHAR               NO-UNDO.
   DEFINE VAR i       AS INT                NO-UNDO. /* counter */
   DEFINE VAR rc      AS LOGICAL INITIAL no NO-UNDO. /* result code */

   IF _Db-addr:SCREEN-VALUE = "" OR
      _Db-addr:SCREEN-VALUE = ?  THEN DO:
        MESSAGE new_lang[12] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        APPLY "ENTRY" TO _Db-addr IN FRAME db_long.
        RETURN NO-APPLY.
   END.
   _Db-addr:SCREEN-VALUE = REPLACE(_Db-addr:SCREEN-VALUE, ".db", "").
   scr_val = _Db-Name:SCREEN-VALUE IN FRAME db_long.
   IF scr_val = "" OR scr_val = "?" THEN DO:
      MESSAGE new_lang[10] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      APPLY "ENTRY" TO _Db-Name IN FRAME db_long.
      RETURN NO-APPLY.
   END.
   IF LDBNAME(user_dbname) = _Db-Name:SCREEN-VALUE THEN DO:
      MESSAGE new_lang[11] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      APPLY "ENTRY" to _Db-Name IN FRAME db_long.
      RETURN NO-APPLY.
   END.
END.
/*============================Mainline code===============================*/

DO FOR DICTDB._File:
  FIND _File "_Db" WHERE _File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[2] /* no permission */
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
  END.
  /* In qbf#list, negative numbers are the negated subscripts */
  /* from new_lang[] to display when that option is disabled. */
  qbf#list = "1,2,3,4,"
           + (IF dict_rog THEN "-1" ELSE
              IF NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN "-2" ELSE "5")
           + "," +
             (IF dict_rog THEN "-1" ELSE
              IF NOT CAN-DO(_Can-write ,USERID("DICTDB")) THEN "-2" ELSE "6")
           + "," +
             (IF dict_rog THEN "-1" ELSE
              IF NOT CAN-DO(_Can-delete,USERID("DICTDB")) THEN "-2" ELSE "7")
           + "," +
             (IF dict_rog THEN "-1" ELSE
              IF NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN "-2" ELSE "8")
           + ",9,10".
END.

qbf_block:
DO FOR DICTDB._Db TRANSACTION ON ERROR UNDO,RETRY:

  in_trans = FALSE. /* no changes made yet */
  FIND FIRST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
  PAUSE 0.
  VIEW FRAME db_list.
  VIEW FRAME db_long.

  DO WHILE TRUE:
    qbf_rec = RECID(_Db).

    IF redraw THEN DO:
      FIND FIRST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      ASSIGN
        qbf_disp = ?
        qbf_home = RECID(_Db)
        redraw   = FALSE.
      DISPLAY qbf WITH FRAME qbf.
      IF qbf_rec <> ? THEN FIND _Db WHERE RECID(_Db) = qbf_rec NO-ERROR.
      ASSIGN
        qbf_rec = RECID(_Db)
        j       = (IF FRAME-LINE(db_list) = 0 THEN 1 ELSE FRAME-LINE(db_list))
        i       = 3.
      UP j - 1 WITH FRAME db_list.
      IF j > 1 THEN DO i = 2 TO j WHILE AVAILABLE _Db:
        FIND PREV _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      END.
      IF NOT AVAILABLE _Db THEN DO:
        FIND FIRST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
        j = i - 2.
      END.
      DO i = 1 TO FRAME-DOWN(db_list):
        IF AVAILABLE _Db THEN
          DISPLAY _Db-name WITH FRAME db_list.
        ELSE
          CLEAR FRAME db_list NO-PAUSE.
        COLOR DISPLAY VALUE(IF RECID(_Db) = qbf_rec AND RECID(_Db) <> ?
          THEN "MESSAGES" ELSE "NORMAL") _Db-name WITH FRAME db_list.
        DOWN WITH FRAME db_list.
        FIND NEXT _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      END.
      IF qbf_rec <> ? THEN
        FIND _Db WHERE RECID(_Db) = qbf_rec NO-ERROR.
      UP FRAME-DOWN(db_list) - j + 1 WITH FRAME db_list.
    END.

    IF qbf_was <> FRAME-LINE(db_list) THEN DO WITH FRAME db_list:
      i = FRAME-LINE.
      DOWN qbf_was - i.
      COLOR DISPLAY NORMAL _Db-name.
      DOWN i - qbf_was.
      IF AVAILABLE _Db THEN COLOR DISPLAY MESSAGES _Db-name.
      qbf_was = FRAME-LINE.
    END.

    ASSIGN
      args[1] = (IF AVAILABLE _Db THEN _Db-comm ELSE "")
      args[2] = ""
      args[3] = ""
      args[4] = ""
      args[5] = "".
    IF LENGTH(args[1]) > 51 THEN ASSIGN
      i       = R-INDEX(args[1]," ",51)
      args[2] = SUBSTRING(args[1],i + 1)
      args[1] = SUBSTRING(args[1],1,i).
    IF LENGTH(args[2]) > 51 THEN ASSIGN
      i       = R-INDEX(args[2]," ",51)
      args[3] = SUBSTRING(args[2],i + 1)
      args[2] = SUBSTRING(args[2],1,i).
    IF LENGTH(args[3]) > 51 THEN ASSIGN
      i       = R-INDEX(args[3]," ",51)
      args[4] = SUBSTRING(args[3],i + 1)
      args[3] = SUBSTRING(args[3],1,i).
    IF LENGTH(args[4]) > 51 THEN ASSIGN
      i       = R-INDEX(args[4]," ",51)
      args[5] = SUBSTRING(args[4],i + 1)
      args[4] = SUBSTRING(args[4],1,i).

/*
    READKEY PAUSE 0.
    IF LASTKEY = -1 AND AVAILABLE _Db AND qbf_disp <> RECID(_Db) THEN DO:
      DISPLAY _Db-name args WITH FRAME db_long.
      qbf_disp = RECID(_Db).
    END.
*/
    IF AVAILABLE _Db AND qbf_disp <> RECID(_Db) THEN DO:
      DISPLAY _Db-name _Db-addr args WITH FRAME db_long.
      qbf_disp = RECID(_Db).
    END.


    ON CURSOR-LEFT BACK-TAB.
    ON CURSOR-RIGHT     TAB.
    _choose: DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF qbf# >= 1 AND qbf# <= 9 THEN NEXT-PROMPT qbf[qbf#] WITH FRAME qbf.
      CHOOSE FIELD qbf NO-ERROR AUTO-RETURN WITH FRAME qbf.
      qbf# = FRAME-INDEX.
      IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND CHR(LASTKEY) <> "."
        AND NOT qbf[qbf#] BEGINS CHR(LASTKEY) THEN UNDO,RETRY _choose.
    END.
    ON CURSOR-LEFT  CURSOR-LEFT.
    ON CURSOR-RIGHT CURSOR-RIGHT.
    i = LOOKUP(KEYFUNCTION(LASTKEY),"CURSOR-DOWN,CURSOR-UP,,END,,,,,.").
    IF i > 0 THEN qbf# = i.
    i = LOOKUP(KEYFUNCTION(LASTKEY),"PAGE-DOWN,PAGE-UP,,,,,,,END-ERROR").
    IF i > 0 THEN qbf# = i.
    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN
      qbf# = (IF qbf_rec = qbf_home THEN 4 ELSE 3).
    HIDE MESSAGE NO-PAUSE.

    IF qbf# <> 5 AND qbf# < 8 AND NOT AVAILABLE _Db THEN NEXT.

    IF ENTRY(qbf#,qbf#list) BEGINS "-" THEN DO:
      MESSAGE new_lang[- INTEGER(ENTRY(qbf#,qbf#list))]. /* not allowed */
      NEXT.
    END.
    IF qbf# > 2 THEN redraw = TRUE.

    IF qbf# = 1 THEN DO: /*---------------------------------- start of NEXT */
      FIND NEXT _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      IF NOT AVAILABLE _Db THEN DO:
        MESSAGE new_lang[3].
        FIND LAST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      END.
      ELSE DO WITH FRAME db_list:
        IF FRAME-LINE = FRAME-DOWN THEN qbf_was = qbf_was - 1.
        IF FRAME-LINE = FRAME-DOWN THEN SCROLL UP. ELSE DOWN.
      END.
    END. /*---------------------------------------------------- end of NEXT */
    ELSE
    IF qbf# = 2 THEN DO: /*---------------------------------- start of PREV */
      FIND PREV _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      IF NOT AVAILABLE _Db THEN DO:
        MESSAGE new_lang[4].
        FIND FIRST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      END.
      ELSE DO WITH FRAME db_list:
        IF FRAME-LINE = 1 THEN qbf_was = qbf_was + 1.
        IF FRAME-LINE = 1 THEN SCROLL DOWN. ELSE UP.
      END.
    END. /*---------------------------------------------------- end of PREV */
    ELSE
    IF qbf# = 3 THEN DO: /*--------------------------------- start of FIRST */
      FIND FIRST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      UP FRAME-LINE(db_list) - 1 WITH FRAME db_list.
      MESSAGE new_lang[4].
    END. /*--------------------------------------------------- end of FIRST */
    ELSE
    IF qbf# = 4 THEN DO: /*---------------------------------- start of LAST */
      FIND LAST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
      DOWN FRAME-DOWN(db_list) - FRAME-LINE(db_list) WITH FRAME db_list.
      MESSAGE new_lang[3].
    END. /*---------------------------------------------------- end of LAST */
    ELSE
    IF qbf# = 5 THEN DO: /*----------------------------------- start of ADD */
      DISPLAY "" @ _Db-name "" @ _Db-addr
        "" @ args[1] "" @ args[2] "" @ args[3] "" @ args[4] "" @ args[5]
        WITH FRAME db_long.
      COLOR DISPLAY NORMAL _Db-name WITH FRAME db_list.
      RELEASE _Db.
      DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        PROMPT-FOR _Db-name _Db-addr TEXT(args) WITH FRAME db_long.

        FIND FIRST _Db WHERE _Db-name = INPUT FRAME db_long _Db-name NO-ERROR.
        IF AVAILABLE _Db THEN DO:
          MESSAGE new_lang[9]. /* already used */
          UNDO,RETRY.
        END.
        CREATE _Db.
        ASSIGN
          _Db-name _Db-addr args
          _Db-type  = "PROGRESS"
          _Db-slave = FALSE
          _Db-comm  = args[1] + " " + args[2] + " "
                    + args[3] + " " + args[4] + " " + args[5]
          in_trans  = TRUE.
        DOWN FRAME-DOWN(db_list) - FRAME-LINE(db_list) WITH FRAME db_list.
      END.
      IF NOT AVAILABLE _Db AND qbf_rec <> ? THEN
        FIND _Db WHERE RECID(_Db) = qbf_rec.
      IF AVAILABLE _Db THEN
        COLOR DISPLAY MESSAGES _Db-name WITH FRAME db_list.
    END. /*----------------------------------------------------- end of ADD */
    ELSE
    IF qbf# = 6 AND qbf_rec <> ? THEN DO: /*--------------- start of MODIFY */
      DISPLAY _Db-name _Db-addr args WITH FRAME db_long.
      _qbf6: DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
        SET _Db-name _Db-addr TEXT(args) WITH FRAME db_long.

        FIND FIRST xdb
          WHERE xdb._Db-name = INPUT FRAME db_long _Db-name
            AND RECID(xdb) <> RECID(_Db) NO-ERROR.
        IF AVAILABLE xdb THEN DO:
          MESSAGE new_lang[9]. /* already used */
          UNDO _qbf6,RETRY _qbf6.
        END.
      END.
      ASSIGN
        in_trans = TRUE
        _Db-comm = args[1] + " " + args[2] + " "
                 + args[3] + " " + args[4] + " " + args[5].
      IF _Db-name ENTERED THEN
        DOWN FRAME-DOWN(db_list) - FRAME-LINE(db_list) WITH FRAME db_list.
    END. /*-------------------------------------------------- end of MODIFY */
    ELSE
    IF qbf# = 7 AND qbf_rec <> ? THEN _qbf7: DO: /*-------- start of DELETE */
      IF CONNECTED(_Db-name) THEN DO:
        MESSAGE new_lang[8]. /* can't delete connected db */
        LEAVE _qbf7.
      END.
      answer = FALSE. /* are you sure... delete? */
      RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT answer,?,?,
        new_lang[5] + ' "' + _Db-name + '"?').
      IF answer THEN DO:
        IF user_dbname = _Db-name THEN        
            ASSIGN user_dbname = "".
            
        DELETE _Db.
        FIND FIRST _Db WHERE _Db-type = "PROGRESS" AND NOT _Db-local NO-ERROR.
        UP FRAME-LINE(db_list) - 1 WITH FRAME db_list.
        IF NOT AVAILABLE _Db THEN
          DISPLAY "" @ _Db-name
            "" @ args[1] "" @ args[2] "" @ args[3] "" @ args[4] "" @ args[5]
            WITH FRAME db_long.
      END.
      in_trans = in_trans OR answer.
    END. /*-------------------------------------------------- end of DELETE */
    ELSE
    IF qbf# = 8 THEN DO: /*---------------------------------- start of UNDO */
      IF in_trans THEN DO:
        answer = FALSE. /* undo session? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[6]).
        IF answer THEN UNDO qbf_block,RETRY qbf_block.
      END.
      ELSE
        MESSAGE new_lang[7]. /* what changed? */
    END. /*---------------------------------------------------- end of UNDO */
    ELSE
    IF qbf# = 9 THEN /*-------------------------------------- start of EXIT */
      LEAVE qbf_block.
    /*--------------------------------------------------------- end of EXIT */

  END. /* iterating block */
END. /* scoping block */

HIDE FRAME qbf     NO-PAUSE.
HIDE FRAME db_long NO-PAUSE.
HIDE FRAME db_list NO-PAUSE.
RETURN.

/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* userblnk - prevent blank user from accessing data 

   Modified: DLM 07/13/98 Added _Owner to _File Find
             KSM 10/19/05 Skip over _aud tables - 20051019-019

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 11 NO-UNDO INITIAL [
  /* 1*/ "This function only works on {&PRO_DISPLAY_NAME} databases.",
  /* 2*/ "You may not use this function with a blank userid.",
  /* 3*/ "You must be a Security Administrator to execute this function.",
  /* 4*/ "Blank userid now has no permissions.",
  /* 5*/ "No changes needed to be made to the permissions.",
  /* 6*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 7*/ "You are about to prevent the blank userid from",
  /* 8*/ "accessing your database.  Users who are not",
  /* 9*/ "listed in the data security fields will not",
  /*10*/ "be able to compile procedures with this database.",
  /*11*/ "Do you wish to continue?"
].

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

DEFINE VARIABLE cont    AS LOGICAL           NO-UNDO.
DEFINE VARIABLE msg-num AS INTEGER INITIAL 0 NO-UNDO.

RUN "prodict/_dctadmn.p" (INPUT USERID(user_dbname),OUTPUT cont).
IF dict_rog                  THEN msg-num = 6. /* r/o mode    */
IF NOT cont                  THEN msg-num = 3. /* secu admin? */
IF USERID(user_dbname) = ""  THEN msg-num = 2. /* userid set? */
IF user_dbtype <> "PROGRESS" THEN msg-num = 1. /* dbtype okay */

IF msg-num <> 0 THEN DO:
  MESSAGE new_lang[msg-num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

cont = FALSE.
MESSAGE new_lang[7]  SKIP
      	new_lang[8]  SKIP   
      	new_lang[9]  SKIP
        new_lang[10] SKIP(1)
      	new_lang[11]
        VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE cont.
IF NOT cont THEN RETURN.

run adecomm/_setcurs.p ("WAIT").
cont = FALSE.
FOR EACH _File
  WHERE _File._Db-recid = drec_db
    AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" )
    AND (CAN-DO(_Can-read,"")   OR CAN-DO(_Can-write,"")
      OR CAN-DO(_Can-create,"") OR CAN-DO(_Can-delete,"")):
  /* If this is an auditing table, skip it. */
  IF _File-Name BEGINS "_aud" THEN DO:
    cont = TRUE.
    NEXT.
  END.

  IF CAN-DO(_Can-read,"")   THEN _Can-read   = "!," + _Can-read.
  IF CAN-DO(_Can-write,"")  THEN _Can-write  = "!," + _Can-write.
  IF CAN-DO(_Can-create,"") THEN _Can-create = "!," + _Can-create.
  IF CAN-DO(_Can-delete,"") THEN _Can-delete = "!," + _Can-delete.
  cont = TRUE.
END.
run adecomm/_setcurs.p ("").

MESSAGE new_lang[IF cont THEN 4 ELSE 5] 
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

RETURN.






/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*
This program generates a COPY assignment for copying the contents of
one buffer to another.

History: 07/14/98 DLM Added _Owner to _File finds
         04/13/00 DLM Added support for long path names

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer AS LOGICAL   NO-UNDO.
DEFINE VARIABLE canned AS LOGICAL   NO-UNDO INIT TRUE.
DEFINE VARIABLE fo     AS CHARACTER NO-UNDO.
{prodict/misc/filesbtn.i}

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 4 NO-UNDO INITIAL [
  /* 1*/ "You do not have permission to use this option.",
  /* 2*/ "A file named",
  /* 3*/ "already exists.",
  /* 4*/ "Overwrite it?"
].

FORM 
  SKIP({&TFM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Output File"
  btn_File SKIP ({&VM_WIDG})
  "NOTE:  Only Non-LOB fields will be included in the output file" AT 2
    VIEW-AS TEXT SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME gencopys
  SIDE-LABELS CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX 
  TITLE " Generate ASSIGN for Copying ~"" + user_env[1] + "~" ".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame gencopys
   or CHOOSE of btn_Help in frame gencopys
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Generate_Assign_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


ON GO OF FRAME gencopys
DO:
  DEFINE VAR fil AS CHAR NO-UNDO.

  fil = fo:SCREEN-VALUE IN FRAME gencopys.

  IF SEARCH(fil) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] fil new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fo IN FRAME gencopys.
      RETURN NO-APPLY.
    END.
  END.
END.

ON CHOOSE OF btn_File in frame gencopys DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fo:handle in frame gencopys /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON LEAVE OF fo in frame gencopys
   fo:screen-value in frame gencopys = 
        TRIM(fo:screen-value in frame gencopys).

ON WINDOW-CLOSE OF FRAME gencopys
   APPLY "END-ERROR" TO FRAME gencopys.

/*============================Mainline code===============================*/

DO FOR DICTDB._File:
  FIND _File "_File" WHERE _File._Owner = "PUB" NO-LOCK.
  answer = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Field" WHERE _File._Owner = "PUB" NO-LOCK.
  answer = answer AND CAN-DO(_Can-read,USERID("DICTDB")).
  IF NOT answer THEN DO:
    MESSAGE new_lang[1] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
  END.
END.

PAUSE 0.
ASSIGN
  fo = LC(user_env[1]) + ".i".

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME gencopys" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  UPDATE fo btn_File btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME gencopys.
   
  /* Do it */
  user_env[1] = fo.
  RUN "prodict/misc/_wrkcgen.p".
  canned = FALSE.
END.

IF canned THEN 
  user_path = "".

HIDE FRAME gencopys NO-PAUSE.
RETURN.




/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* usercold - file freeze/unfreeze program 

   Modified: DLM 07/13/98 Added _Owner to _File Find
   
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE before AS LOGICAL                         NO-UNDO.
DEFINE VARIABLE hint   AS CHARACTER INITIAL ""            NO-UNDO.
DEFINE VARIABLE okay   AS LOGICAL                         NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 13 NO-UNDO INITIAL [
  /* 1*/ "You do not have permission to freeze or unfreeze tables.",
  /* 2*/ "WARNING: If you make dictionary changes for", /* 32-char filename */
  /* 3*/ "you will have to recompile all procedures referencing it!",
  /* 4*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 5*/ "", /* reserved */
  /* 6*/ "Are you sure that you want to do this?",
  /* 7*/ "", /* reserved */
  /* 8*/ "Changing the VIEW structure may cause {&PRO_DISPLAY_NAME}/SQL to malfunction.",
  /* 9*/ "It is not recommended that you proceed.",
  /*10*/ "Changing FAST TRACK tables may disable FAST TRACK for this database.",
  /*11*/ "The potential exists to lose *ALL* FAST TRACK data.",
  /*12*/ "Changing the {&PRO_DISPLAY_NAME} meta-schema tables can disable",
  /*13*/ "the dictionary, FAST TRACK, and most application programs."
].

&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN  
&GLOBAL-DEFINE LINEUP 6
&ELSEIF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN  
&GLOBAL-DEFINE LINEUP 7
&ELSE
&GLOBAL-DEFINE LINEUP 8
&ENDIF
FORM
  SKIP({&TFM_WID})
  _File._File-Name LABEL "Table" VIEW-AS TEXT COLON {&LINEUP} 
        SKIP({&VM_WID})
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
  _File._Frozen    VIEW-AS TOGGLE-BOX LABEL "&Frozen" 
        COLON {&LINEUP} 
&ELSE
  _File._Frozen LABEL "Frozen" COLON {&LINEUP}
&ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME freezing 
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Freeze/Unfreeze Table".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame freezing
   or CHOOSE of btn_Help in frame freezing
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Freeze_Unfreeze_Table_Dlg_Box},
                                               INPUT ?).
&ENDIF

ON WINDOW-CLOSE OF FRAME freezing
   APPLY "END-ERROR" TO FRAME freezing.


/*============================Mainline code===============================*/

IF dict_rog THEN DO:
  MESSAGE new_lang[4] /* look but don't touch */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

/*check runtime privileges for _file and _field */
FIND _File WHERE _File._File-name =  "_File"
             AND _File._Owner = "PUB".
FIND _Field OF _File WHERE _Field._Field-name = "_Frozen".
IF   NOT CAN-DO(_File._Can-write,USERID("DICTDB"))
  OR NOT CAN-DO(_Field._Can-write,USERID("DICTDB")) THEN DO:
  MESSAGE new_lang[1] /* no permission */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

FIND _File WHERE _Db-recid = drec_db AND _File-name = user_env[1]
             AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ).

okay = TRUE.
IF _File-Number >= -6 AND _File-Number <= -1 THEN  /* meta-schema */
  MESSAGE new_lang[12] SKIP new_lang[13] SKIP new_lang[6]
    VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE okay.
ELSE IF _File-Number >= -29 AND _File-Number <= -7 THEN /* fast track */
  MESSAGE new_lang[10] SKIP new_lang[11] SKIP new_lang[6]
    VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE okay.
ELSE IF _File-Number >= -32 AND _File-Number <= -30 THEN /* views */
  MESSAGE new_lang[8] SKIP new_lang[9] SKIP new_lang[6]
    VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE okay.
ELSE IF _File-Number > 32767 THEN
    ASSIGN okay = FALSE.    	    	    	    	/* SQL92 views. */

IF NOT okay THEN DO:
  user_path = "".
  RETURN.
END.

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME freezing" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}
before = _File._Frozen.
DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  DISPLAY _File._File-Name WITH FRAME freezing.
  UPDATE  _File._Frozen 
                btn_OK  btn_Cancel {&HLP_BTN_NAME} WITH FRAME freezing.
END.

IF before AND before <> _File._Frozen THEN DO:
  MESSAGE new_lang[2] '"' + _File-name + '"' SKIP /* change warning */
                new_lang[3]                                               /* recompile warning */
                VIEW-AS ALERT-BOX WARNING BUTTONS OK.
END.

HIDE FRAME freezing NO-PAUSE.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrdbox.p - dialog box routine - gets a true/false value from user 
 
   History:  D. McMann 11/19/98 Added assignment of answer to FALSE
                                98-11-19-021


Input text comes in 'question' parameter, and may be any length.  This
program splits it up into 45-character chunks, breaking at spaces.
Embedded '!' marks get translated into line-feeds (like in
column-labels).
*/


/* The yes-val and not-val parms are supported for backward compatibility 
   of API but are no longer supported.  The buttons will always be
   "Yes" and "No".
*/
DEFINE INPUT-OUTPUT PARAMETER answer   AS LOGICAL   NO-UNDO.
DEFINE INPUT        PARAMETER yes-val  AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER not-val  AS CHARACTER NO-UNDO.
DEFINE INPUT        PARAMETER question AS CHARACTER NO-UNDO.

/* s-alert uses a carat instead of ! (why?) */
ASSIGN question = REPLACE(question, "!", "^").

RUN adecomm/_s-alert.p 
   (INPUT-OUTPUT answer, INPUT "QUESTION", 
    INPUT "YES-NO",      INPUT question).

/*********************************************************************
* Copyright (C) 2007,2011 by Progress Software Corporation. All      *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* userdump - user interface and defaults setup for dumping */

/*
IN:
  user_env[1] = "ALL" or comma-separated list of files 
                or it may be in user_longchar, if list was too big.

  user_env[9] = type of dump (e.g. .df or .d or bulk-load file)
                "4"   = dump file definitions with AS/400 stuff
                "5"   = dump file definitions in V5 format
                "a"   = dump auto-connect records
                "c"   = dump collation tables
                "b"   = make bulkload description file
                "d"   = dump definitions
                "f"   = dump data file contents
                "s"   = dump sequence definitions
                "k"   = dump sequence values
                "u"   = dump user file contents
                "v"   = dump view file contents
                "x"   = dump audit policy records as XML
                "t"   = dump audit policy records as Text
                "e"   = dump application audit event records
                "y"   = dump audit data
                "i"   = dump database identification properties
                "o"   = dump database options
                "h"   = dump security authentication records
                "m"   = dump security permissions
            
OUT:
  user_env[1] = same as IN
  user_env[2] = physical file or directory name for some output
  user_env[3] = "MAP <name>" or "NO-MAP" OR ""
  user_env[4] = comma separated list of table numbers for which triggers 
                should be disabled.
                (only used for dump data file contents, "f").
  user_env[5] = "<source-code-page>,<target-code-page>" or "UNDEFINED"
                (only for .df- and .d-files!)  /*hutegger*/
  user_env[9] = same as IN
  user_env[26] = "y" or "n" to dump Field._Field-rpos or not.
  user_env[30] = lob dir
  user_env[31] = "" or " NO-LOBS" 
  user_env[32] = tenant  
  user_env[33] = tenant dir
  user_env[34] = tenant lob dir
  
  
history:
    mcmann      08/12/03    Add GET-DIR functionality
    mcmann      00/04/13    Added support for long path names
    Mario B     99/03/15    Added user_env[26] for conditional dump of 
                            _Field._Field-rpos
    mcmann      98/07/13    Added _Owner to _File finds
    gfs         95/05/31    allow dumping of hidden files if flag set
    gfs         94/11/04    add check for _File._Can-dump
    gfs         94/11/01    changed code-page to code page
    gfs         94/07/30    fixed dialogs
    gfs         94/06/23    changed default value logic for codepage
    hutegger    94/02/22    code-page support
    hutegger    94/05/04    change default-value for mapping to "NO-MAP"
    mcmann      03/02/04    Added LOB Directory
    mcmann      03/06/13    Removed lob directory from dump of df file
    mcmann      03/10/17    Add NO-LOCK statement to _Db find in support 
                            of on-line schema add
    kmcintos    04/04/05    Added frames and additional logic for auditing
                            support
    kmcintos    06/07/05    Added context help ids for auditing options.
    kmcintos    07/27/05    Removed reference to unused longchar variable.
    fernando    03/14/06    Handle case with too many tables selected - bug 20050930-006.
    fernando    08/10/07    Enhancing label of dmp-rpos - OE00154917
    fernando    12/13/07    Handle long list of "some" selected tables
    rkamboj     08/16/11   Added new terminology for security items and windows.
    rkamboj 	11/11/2011 Fixed issue of dump data for Lob field. bug OE00214956.
*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/fhidden.i}

IF CAN-DO("y,t,x",user_env[9]) AND
   user_env[1] = ? THEN DO:
  user_path = "".
  RETURN.
END.

DEFINE VARIABLE answer   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE canned   AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE base     AS CHARACTER  NO-UNDO.
DEFINE VARIABLE class    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE comma    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE dump-as  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE err      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE i        AS INTEGER    NO-UNDO.
DEFINE VARIABLE io-file  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE io-mapc  AS CHARACTER  NO-UNDO.
DEFINE VARIABLE io-mapl  AS INTEGER    NO-UNDO INITIAL 0.
DEFINE VARIABLE io-title AS CHARACTER  NO-UNDO.
DEFINE VARIABLE is-all   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-one   AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-some  AS LOGICAL    NO-UNDO.
DEFINE VARIABLE msg-num  AS INTEGER    NO-UNDO INITIAL 0.
DEFINE VARIABLE nodump   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE prefix   AS CHARACTER  NO-UNDO.
DEFINE VARIABLE trash    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE dis_trig AS CHARACTER  NO-UNDO.
DEFINE VARIABLE dmp-rpos AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE inclob   AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE s_res    AS LOGICAL    NO-UNDO.
DEFINE VARIABLE base_lchar AS LONGCHAR NO-UNDO.
DEFINE VARIABLE numCount   AS INTEGER  NO-UNDO.
DEFINE VARIABLE cItem      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE isCpUndefined AS LOGICAL NO-UNDO.

define variable UseDefaultDirs as logical no-undo.
define variable RootDirectory as character no-undo.

define variable labelDirShared as character no-undo 
        init "Shared Directory (blank = current directory):":t55. 

define variable labelDirRoot as character no-undo 
        init "Root Directory (blank = current directory):":t55. 

define variable isSuperTenant as logical no-undo.
/* used for file and sequence dump */
define variable isAllMultiTenant as logical no-undo. 
define variable isAnyMultiTenant as logical no-undo.

define variable gLobFolderName as character no-undo init "lobs".
define variable gGroupFolderName as character no-undo init "groups".
define variable gUseDefaultOut   as character no-undo init "<default>".
define variable gFileName      as character no-undo.
define variable labelDir as character no-undo.

{prodict/misc/filesbtn.i}

DEFINE BUTTON btn_dir
  SIZE 11 by 1.
  
DEFINE BUTTON btn_dir2
  SIZE 11 by 1 .

DEFINE BUTTON btn_dirRoot
  SIZE 11 by 1 .

DEFINE BUTTON btn_dirMT
  SIZE 11 by 1 .

DEFINE BUTTON btn_dirMTLOB
  SIZE 11 by 1 .

DEFINE BUTTON btn_tenant
  SIZE 18 by 1 .
define variable radioTenantDir as char view-as radio-set  
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
            horizontal
            radio-buttons "Subdirectory","tenant","Input directory","Shared","Other","Other"
            label "Tenant Directory".
         
         &ELSE
             vertical  
             radio-buttons "Subdirectoy","tenant","Input directory","Shared","Other","Other"
             label "Tenant Directory".
         &ENDIF    

define variable radioLobDir as char view-as radio-set  
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
            horizontal
            radio-buttons "Subdirectory","tenant","Input directory","Shared","Other","Other"
            label "LOB Directory".
         
         &ELSE
             vertical  
             radio-buttons "Subdirectoy","tenant","Input directory","Shared","Other","Other"
             label "Tenant Directory".
         &ENDIF    


define variable radioTenantLobDir as char view-as radio-set  
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
            horizontal
            radio-buttons "Subdirectory","L","Lob directory","T","Other","O"
            label "Tenant Lob Directory".
         
         &ELSE
             vertical  
             radio-buttons "Subdirectoy","tenant","Lob directory","Shared","Other","Other"
             label "Tenant Lob Directory".
         &ENDIF    


&IF "{&OPSYS}" <> "MSDOS" and "{&OPSYS}" <> "WIN32" &THEN
    &SCOPED-DEFINE SLASH /
&ELSE 
    &SCOPED-DEFINE SLASH ~~~\
&ENDIF

FORM SKIP({&TFM_WID})
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                 COLON 12 VIEW-AS FILL-IN SIZE 40 BY 1
                 LABEL "Output File"
     btn_File    SKIP ({&VM_WIDG})
     user_env[5] {&STDPH_FILL} FORMAT "x(80)" 
                 COLON 12 VIEW-AS FILL-IN SIZE 40 BY 1
                 LABEL "Code Page"
              
     {prodict/user/userbtns.i}
  
  WITH FRAME write-def-file
       SIDE-LABELS ATTR-SPACE CENTERED 
       DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                 COLON 15 VIEW-AS FILL-IN SIZE 40 BY 1
                 LABEL "Output File"
     btn_File    SKIP ({&VM_WIDG})
     user_env[5] {&STDPH_FILL} FORMAT "x(80)" 
                 COLON 15 VIEW-AS FILL-IN SIZE 40 BY 1
                 LABEL "Code Page" SKIP ({&VM_WIDG})
     dmp-rpos    VIEW-AS TOGGLE-BOX COLON 15 
                 LABEL "Include &POSITION for .r / Binary Load Compatibility"
                 
     {prodict/user/userbtns.i}

  WITH FRAME write-output-file
       SIDE-LABELS ATTR-SPACE CENTERED 
       DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                 COLON 15 VIEW-AS FILL-IN SIZE 40 BY 1
                 LABEL "Output File"
     btn_File                                     
     
     {prodict/user/userbtns.i}
     
  WITH FRAME write-output-file-nocp
       SIDE-LABELS ATTR-SPACE CENTERED 
       DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                 COLON 15 VIEW-AS FILL-IN SIZE 40 BY 1
                 LABEL "Output File"  btn_File  SKIP({&VM_WIDG})
     &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
       "  Include LOB:" VIEW-AS TEXT AT 2  
       inclob LABEL "yes/no" view-as toggle-box SKIP({&VM_WIDG}) 
       "LOB Directory:" VIEW-AS TEXT AT 2  
       user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                    NO-LABEL VIEW-AS FILL-IN 
                    SIZE 40 BY 1 SKIP({&VM_WIDG})
     &ELSE
       "  Include LOB:" VIEW-AS TEXT AT 2  
       inclob LABEL "yes/no" view-as toggle-box SKIP({&VM_WIDG}) 
       user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                    COLON 15 VIEW-AS FILL-IN SIZE 40 BY 1 
                    LABEL "Lob Directory" 
       btn_dir LABEL "Dir..."  SKIP ({&VM_WIDG})
     &ENDIF
     user_env[5] {&STDPH_FILL} FORMAT "x(80)" 
                 COLON 15 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Code Page" SKIP ({&VM_WIDG})

     {prodict/user/userbtns.i}
  
  WITH FRAME write-boutput-file
       SIDE-LABELS ATTR-SPACE CENTERED 
       DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
 
  &IF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN  
    &GLOBAL-DEFINE RADBTNVOFF 1.2
    &GLOBAL-DEFINE RADBTNHOFF 13
    &GLOBAL-DEFINE FILLCH 55
  &ELSE
    &GLOBAL-DEFINE RADBTNVOFF 0.9
    &GLOBAL-DEFINE RADBTNHOFF 12
    &GLOBAL-DEFINE FILLCH 47
  &ENDIF

  

  FORM SKIP({&TFM_WID})
       "Output File:":t20       VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
       btn_File                 SKIP({&VM_WIDG})
       "  Include LOB:"         VIEW-AS TEXT AT 2  
       inclob                   LABEL "yes/no" 
                                view-as toggle-box SKIP({&VM_WID}) 
       "LOB Directory:"         VIEW-AS TEXT AT 2 
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1 
       btn_dir                  LABEL "Dir..." SKIP ({&VM_WIDG})
       "Character Mapping:":t26 VIEW-AS TEXT AT 2
       io-mapl                  VIEW-AS RADIO-SET
                                RADIO-BUTTONS "NO-MAP", 1, "Map", 2 AT 2 
                                SKIP({&VM_WIDG})
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                
       {prodict/user/userbtns.i}
       
       io-mapc                  {&STDPH_FILL} FORMAT "X(20)"
                                AT ROW-OF io-mapl    + {&RADBTNVOFF} 
                                   COLUMN-OF io-mapl + {&RADBTNHOFF}
    WITH FRAME write-dump-file
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       "Effective Tenant:":t20            VIEW-AS TEXT AT 2
       user_env[32]             {&STDPH_FILL} FORMAT "x(32)" 
                                AT 2 VIEW-AS FILL-IN                                
                                SIZE 40 BY 1
       btn_tenant               LABEL "Select Tenant..." SKIP({&VM_WIDG})
       UseDefaultDirs            at 2 label "Use Default Location (create subdirectories if necessary)"  
         view-as toggle-box SKIP({&VM_WID})                                     
       "Root directory (blank = current directory):":t50       VIEW-AS TEXT AT 2
       RootDirectory            {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN SIZE 47 BY 1
       btn_dirroot              LABEL "Dir..." SKIP ({&VM_WIDG})
       "Output File:":t20       VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN SIZE 47 BY 1
       btn_File                 SKIP({&VM_WIDG})
       inclob                   AT 2 LABEL "Include LOB" 
                                view-as toggle-box SKIP({&VM_WID}) 
       "LOB Directory (blank = current directory):":t50         VIEW-AS TEXT AT 2 
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN SIZE 47 BY 1 
       btn_dir                  LABEL "Dir..." SKIP ({&VM_WIDG})
       "Character Mapping:":t26 VIEW-AS TEXT AT 2
       io-mapl                  VIEW-AS RADIO-SET
                                RADIO-BUTTONS "NO-MAP", 1, "Map", 2 AT 2 
                                SKIP({&VM_WIDG})
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 47 BY 1
                                
       {prodict/user/userbtns.i}
       
       io-mapc                  {&STDPH_FILL} FORMAT "X(20)"
                                AT ROW-OF io-mapl    + {&RADBTNVOFF} 
                                   COLUMN-OF io-mapl + {&RADBTNHOFF}
    WITH FRAME write-dump-file-mt
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".
 
  FORM SKIP({&TFM_WID})
       user_env[33]  colon 17   NO-LABEL  
                VIEW-AS RADIO-SET /*size 50 by 1*/ HORIZONTAL RADIO-BUTTONS  
                 "Multi-Tenant Only", "Tenant", 
                 "Shared Only","Shared",
                 "All","All"  SKIP({&VM_WID}) 
       user_env[32]     {&STDPH_FILL} LABEL "Effective Tenant" FORMAT "x(32)" 
                         colon 17 VIEW-AS FILL-IN                                
                         SIZE 40 BY 1
       btn_tenant        LABEL "Select Tenant..." SKIP({&VM_WIDG})
       UseDefaultDirs    label "Use Default Location (create subdirectory if necessary)"  
                         view-as toggle-box colon 17 SKIP({&VM_WID})                                     
       RootDirectory     {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                         colon 17 label "Root Directory"
                         VIEW-AS FILL-IN SIZE 47 BY 1
       
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
       
       btn_dirroot       LABEL "Dir..." 
      
       &ENDIF
        
       SKIP ({&VM_WIDG})
       
       user_env[2]       {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                         COLON 17 VIEW-AS FILL-IN SIZE 47 BY 1
                         LABEL "Output File"
       btn_File          SKIP ({&VM_WIDG})
       user_env[5]       {&STDPH_FILL} FORMAT "x(80)" 
                         COLON 17 VIEW-AS FILL-IN SIZE 40 BY 1
                         LABEL "Code Page"
              
     {prodict/user/userbtns.i}
  WITH FRAME write-dump-seq-mt
       SIDE-LABELS ATTR-SPACE CENTERED 
       DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  
  
  FORM SKIP({&TFM_WID})
       "Output File:":t20       VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
       btn_File                 SKIP({&VM_WIDG})
       "Character Mapping:":t26 VIEW-AS TEXT AT 2
       io-mapl                  VIEW-AS RADIO-SET
                                RADIO-BUTTONS "NO-MAP", 1, "Map", 2 AT 2    
                                SKIP({&VM_WIDG})
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                
       {prodict/user/userbtns.i}
  
       io-mapc                  {&STDPH_FILL} FORMAT "X(20)"
                                AT ROW-OF io-mapl    + {&RADBTNVOFF} 
                                   COLUMN-OF io-mapl + {&RADBTNHOFF}
      WITH FRAME write-dump-file-nobl
           NO-LABELS NO-ATTR-SPACE CENTERED 
           DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
           VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       "Output Directory (blank = current directory):":t63 
                                VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1   
       btn_dir2                 LABEL "Dir..." SKIP({&VM_WIDG})
       "  Include LOB:"         VIEW-AS TEXT AT 2 inclob 
                                LABEL "yes/no" 
                                view-as toggle-box SKIP({&VM_WIDG})
       "LOB Directory (blank = current directory)" VIEW-AS TEXT AT 2
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1  
       btn_dir                  LABEL "Dir..."  SKIP({&VM_WIDG})
       "Character Mapping:":t26 VIEW-AS TEXT AT 2
       io-mapl                  VIEW-AS RADIO-SET
                                RADIO-BUTTONS "NO-MAP", 1, "Map", 2 
                                AT 2 SKIP({&VM_WIDG})
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                
       {prodict/user/userbtns.i}
    
       io-mapc                  {&STDPH_FILL} FORMAT "X(20)"
                                AT ROW-OF io-mapl    + {&RADBTNVOFF} 
                                   COLUMN-OF io-mapl + {&RADBTNHOFF}
    WITH FRAME write-dump-dir
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       "Effective Tenant:":t20            VIEW-AS TEXT AT 2
       user_env[32]             {&STDPH_FILL} FORMAT "x(32)" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE 40 BY 1   
       btn_tenant               LABEL "Select Tenant..." SKIP({&VM_WIDG})
       UseDefaultDirs        at 2 label "Use Default Location (create subdirectories if necessary)"  
         view-as toggle-box SKIP({&VM_WID})                                     
       
        labelDir  view-as text format "x(54)"   
                                 AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1   
       btn_dir2                 LABEL "Dir..." SKIP({&VM_WIDG})
       "Tenant Directory (blank = current directory):":t53 
                                VIEW-AS TEXT AT 2
       user_env[33]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1   
       btn_dirMT                LABEL "Dir..." SKIP({&VM_WIDG})
       
       inclob                   AT 2 LABEL "Include LOB" 
                                view-as toggle-box SKIP({&VM_WIDG})
       "LOB Directory (blank = current directory):":t53 VIEW-AS TEXT AT 2
                                 
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1  
       btn_dir                  LABEL "Dir..."  SKIP({&VM_WIDG})
       
       "Tenant LOB Directory (blank = current directory):":t53 VIEW-AS TEXT AT 2
       user_env[34]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1   
       btn_dirMTLOB                LABEL "Dir..." SKIP({&VM_WIDG})
      
       "Character Mapping:":t26 VIEW-AS TEXT AT 2
       io-mapl                  VIEW-AS RADIO-SET
                                RADIO-BUTTONS "NO-MAP", 1, "Map", 2 
                                AT 2 SKIP({&VM_WIDG})
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                
       {prodict/user/userbtns.i}
    
       io-mapc                  {&STDPH_FILL} FORMAT "X(20)"
                                AT ROW-OF io-mapl    + {&RADBTNVOFF} 
                                   COLUMN-OF io-mapl + {&RADBTNHOFF}
    WITH FRAME write-dump-dir-mt
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".


  FORM SKIP({&TFM_WID})
       "Output Directory (blank = current directory):":t63 
                                VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1   
       btn_dir2                 LABEL "Dir..." SKIP({&VM_WIDG})
       "  Include LOB:"         VIEW-AS TEXT AT 2 
       inclob                   LABEL "yes/no" 
                                view-as toggle-box SKIP
       "LOB Directory (blank = current directory):" VIEW-AS TEXT AT 2
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1  
       btn_dir                  LABEL "Dir..." SKIP({&VM_WIDG})
       
      "Code Page:":t18          VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                SKIP({&VM_WID})
       
       {prodict/user/userbtns.i}
       
    WITH FRAME write-audit-data
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

    FORM SKIP({&TFM_WID})
         "Output Directory (if different from current directory):":t63 
                                  VIEW-AS TEXT AT 2
         user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                  AT 2 VIEW-AS FILL-IN 
                                  SIZE {&FILLCH} BY 1   
         btn_dir2                 LABEL "Dir..." SKIP({&VM_WIDG})
         "Character Mapping:":t26 VIEW-AS TEXT AT 2
         io-mapl                  VIEW-AS RADIO-SET
                                  RADIO-BUTTONS "NO-MAP", 1, "Map", 2 
                                  AT 2 SKIP({&VM_WIDG})
         "Code Page:":t18         VIEW-AS TEXT AT 2
         user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                  AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                  
         {prodict/user/userbtns.i}
    
         io-mapc                  {&STDPH_FILL} FORMAT "X(20)"
                                  AT ROW-OF io-mapl    + {&RADBTNVOFF} 
                                     COLUMN-OF io-mapl + {&RADBTNHOFF}
    WITH FRAME write-dump-dir-nobl
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       "Output Directory (if different from current directory):":t63 
                                VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE {&FILLCH} BY 1   
       btn_dir2                 LABEL "Dir..." SKIP({&VM_WIDG})
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                
       {prodict/user/userbtns.i}
       
    WITH FRAME write-dump-dir-cdpg
         NO-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

&ELSE       /* tty */
  FORM SKIP({&TFM_WID})
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Output File"  
       btn_File                 SKIP({&VM_WIDG})
       "Include LOB:"           VIEW-AS TEXT AT 4 
       inclob                   LABEL "yes/no" 
                                view-as toggle-box SKIP({&VM_WID})
       "LOB Directory:"         VIEW-AS TEXT at 2 
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  
                                VIEW-AS FILL-IN SIZE 40 BY 1 SKIP({&VM_WIDG})
       io-mapc                  {&STDPH_FILL} LABEL "Character Mapping"
                                FORMAT "x(20)" COLON 19
       "(Blank = Default Map; use"       COLON 41
       "~"NO-MAP~" to turn off mapping)" COLON 41 SKIP ({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page" SKIP({&VM_WIDG})
                                
       {prodict/user/userbtns.i}
   
    WITH FRAME write-dump-file
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       user_env[32]             {&STDPH_FILL} FORMAT "x(32)"     
                                colon 22 VIEW-AS FILL-IN size 33 by 1  /* size to align button..*/         
                                LABEL "Effective Tenant"  
       btn_Tenant               LABEL "Select Tenant..." SKIP({&VM_WID})
       "Use Default Location:"           VIEW-AS TEXT AT 2
       UseDefaultDirs           colon 22 view-as toggle-box 
                                label " (Create subdirectories if necessary)"
       RootDirectory            {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"
                                colon 22 label "Root Directory"     
                                VIEW-AS FILL-IN SIZE 41 BY 1 
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 22 VIEW-AS FILL-IN SIZE 41 BY 1
                                LABEL "Output File"  
       btn_File                 SKIP({&VM_WIDG})
       "Include LOB:"           VIEW-AS TEXT AT 11 
       inclob                   LABEL " " 
                                view-as toggle-box SKIP({&VM_WID})
       "LOB Directory:"         VIEW-AS TEXT at  9
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  
                                VIEW-AS FILL-IN SIZE 41 BY 1 SKIP({&VM_WIDG})
       io-mapc                  {&STDPH_FILL} LABEL "Character Mapping"
                                FORMAT "x(20)" COLON 22
       "(Blank = Default Map; use"       COLON 43
       "~"NO-MAP~" to turn off mapping)" COLON 43 SKIP ({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 22 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page" SKIP({&VM_WIDG})
                                
       {prodict/user/userbtns.i}
   
    WITH FRAME write-dump-file-mt
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".
  
  FORM SKIP({&TFM_WID})
       user_env[33]  colon 22   NO-LABEL  
                VIEW-AS RADIO-SET /*size 50 by 1*/ HORIZONTAL RADIO-BUTTONS  
                 "Multi-Tenant Only", "Tenant", 
                 "Shared Only","Shared",
                 "All","All"  SKIP({&VM_WID}) 
       user_env[32]             {&STDPH_FILL} FORMAT "x(32)"     
                                colon 22 VIEW-AS FILL-IN size 33 by 1  /* size to align button..*/         
                                LABEL "Effective Tenant"  
       btn_Tenant               LABEL "Select Tenant..." SKIP({&VM_WIDG})
       "Use Default Location:"           VIEW-AS TEXT AT 2
       UseDefaultDirs           colon 22 view-as toggle-box label " (Create tenant subdirectory if necessary)"
       RootDirectory            {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"
                                colon 22 label "Root Directory"     
                                VIEW-AS FILL-IN SIZE 41 BY 1 
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 22 VIEW-AS FILL-IN SIZE 41 BY 1
                                LABEL "Output File"  
       btn_File                 SKIP({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 22 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page" SKIP({&VM_WIDG})
       {prodict/user/userbtns.i}
  WITH FRAME write-dump-seq-mt
       NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
       DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
       VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".
  
  FORM SKIP({&TFM_WID})
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Output File"  
       btn_File                 SKIP({&VM_WIDG})
       io-mapc                  {&STDPH_FILL} LABEL "Character Mapping"
                                FORMAT "x(20)" COLON 19
       "(Blank = Default Map; use"       COLON 41
       "~"NO-MAP~" to turn off mapping)" COLON 41 SKIP({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page" SKIP({&VM_WIDG})
                                
       {prodict/user/userbtns.i}
    
    WITH FRAME write-dump-file-nobl
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

   FORM  
      SKIP({&VM_WIDG})
       user_env[32]             {&STDPH_FILL} FORMAT "x(32)"     
                                colon 22 VIEW-AS FILL-IN         
                                LABEL "Effective Tenant"  
       btn_Tenant               LABEL "Select Tenant..." SKIP({&VM_WIDG})
       "Use Default Location:"           VIEW-AS TEXT AT 2
       UseDefaultDirs        colon 22 view-as toggle-box label " (Create subdirectories if necessary)"
    
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                colon 22 VIEW-AS FILL-IN SIZE 51 BY 1
                                LABEL "Shared Directory" SKIP SKIP({&VM_WID}) 
      
       user_env[33]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                colon 22 VIEW-AS FILL-IN SIZE 51 BY 1
                                LABEL "Tenant Directory" SKIP({&VM_WIDG})
       "Include LOB:"           VIEW-AS TEXT AT 11
       inclob                   colon 22 LABEL " (X = yes)" view-as toggle-box 
                                SKIP({&VM_WIDG})     
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  
                                colon 26 VIEW-AS FILL-IN SIZE 47 BY 1  
                                LABEL "Shared LOB Directory" SKIP
       user_env[34]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  
                                colon 26  VIEW-AS FILL-IN SIZE 47 BY 1        
                                LABEL "Tenant LOB Directory" SKIP({&VM_WIDG})
       io-mapc                  {&STDPH_FILL} LABEL "Character Mapping"
                                FORMAT "x(20)" COLON 22
       "(Blank = Default Map; use"       COLON 44
       "~"NO-MAP~" to turn off mapping)" COLON 44 SKIP({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 22 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page"
                                
       {prodict/user/userbtns.i}
       
    WITH FRAME write-dump-dir-mt
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".


FORM SKIP({&TFM_WID})
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 17 VIEW-AS FILL-IN SIZE 50 BY 1
                                LABEL "Output Directory" SKIP({&VM_WID})
       "(Blank = Current Directory)" VIEW-AS TEXT COLON 19 SKIP({&VM_WIDG})
       
       
       "Include LOB:"           VIEW-AS TEXT AT 6 
       inclob                   LABEL "yes/no" view-as toggle-box 
                                SKIP({&VM_WID})     
       "LOB Directory:"         VIEW-AS TEXT AT 4
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"  
                                VIEW-AS FILL-IN SIZE 40 BY 1 SKIP({&VM_WID})
       "(Blank = Current Directory)" VIEW-AS TEXT COLON 19 SKIP({&VM_WIDG})
       io-mapc                  {&STDPH_FILL} LABEL "Character Mapping"
                                FORMAT "x(20)" COLON 19
       "(Blank = Default Map; use"       COLON 41
       "~"NO-MAP~" to turn off mapping)" COLON 41 SKIP({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page"
                                
       {prodict/user/userbtns.i}
       
    WITH FRAME write-dump-dir
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".



  FORM SKIP({&TFM_WID})
       "Output Directory (if different from current directory):":t63 
                                VIEW-AS TEXT AT 2
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE 50 BY 1 SKIP({&VM_WIDG})
       "  Include LOB:"         VIEW-AS TEXT AT 2 
       inclob                   LABEL "yes/no" view-as toggle-box 
                                SKIP({&VM_WID})
       "LOB Directory: (Blank = Current Directory)" VIEW-AS TEXT AT 2
       user_env[30]             {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                AT 2 VIEW-AS FILL-IN 
                                SIZE 50 BY 1 SKIP({&VM_WIDG})
                                
       "Code Page:":t18         VIEW-AS TEXT AT 2
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
                                SKIP({&VM_WID})

       {prodict/user/userbtns.i}
       
    WITH FRAME write-audit-data
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 17 VIEW-AS FILL-IN SIZE 50 BY 1
                                LABEL "Output Directory"  SKIP({&VM_WID})
       "(Blank = Current Directory)" VIEW-AS TEXT COLON 19 SKIP ({&VM_WIDG})
       io-mapc                  {&STDPH_FILL} LABEL "Character Mapping"
                                FORMAT "x(20)" COLON 19
       "(Blank = Default Map; use"       COLON 41
       "~"NO-MAP~" to turn off mapping)" COLON 41 SKIP({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page"
    
       {prodict/user/userbtns.i}
    
    WITH FRAME write-dump-dir-nobl
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

  FORM SKIP({&TFM_WID})
       user_env[2]              {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                                COLON 17 VIEW-AS FILL-IN SIZE 50 BY 1
                                LABEL "Output Directory"  SKIP({&VM_WID})
       "(Blank = Current Directory)" VIEW-AS TEXT COLON 19 SKIP ({&VM_WIDG})
       user_env[5]              {&STDPH_FILL} FORMAT "x(80)" 
                                COLON 19 VIEW-AS FILL-IN SIZE 40 BY 1
                                LABEL "Code Page"
    
       {prodict/user/userbtns.i}
    
    WITH FRAME write-dump-dir-cdpg
         NO-LABELS SIDE-LABELS NO-ATTR-SPACE CENTERED 
         DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
         VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

&ENDIF

/*=============================== Functions =================================*/
function getTenantName returns char(pctenant as char):
    define variable lok     as logical no-undo.
    define variable hbuffer as handle no-undo. 
    define variable cValue   as character no-undo.
    
    CREATE BUFFER hbuffer FOR TABLE "DICTDB._tenant".
    lok = hbuffer:find-unique ("where _tenant._Tenant-name = " + quoter(pcTenant)) no-error.
    if lok then 
        cValue = hBuffer::_tenant-name.
    
    delete object hbuffer.    
    return cValue.
end function. 

function setEffectiveTenant returns logical(pctenant as char):
    set-effective-tenant(pcTenant,"DICTDB").
    return true.
    catch e as Progress.Lang.Error :
    	message e:GetMessage(1)
        view-as alert-box error.	
        return false.
    end catch.
end function. 

function refreshMapping returns logical (hMap as handle,hField as handle):
    
   IF hMap:SCREEN-VALUE = "1" THEN DO:
        hField:SENSITIVE = FALSE.
        hField:SCREEN-VALUE = "".
   END.
   ELSE DO:
        io-mapc = "".
        hField:SENSITIVE = TRUE.
        hField:MOVE-AFTER-TAB-ITEM(hMap).
   END.
end.
 
function refreshDir return logical
                   (newDir as char):
    
     assign   
         user_env[33] = newdir + "{&SLASH}" + user_env[32]
         user_env[30] = newdir + "{&SLASH}" + gLobFolderName
         user_env[34] = newdir + "{&SLASH}" + user_env[32] + "{&SLASH}" + gLobFolderName
         user_env[2]  = newDir.
        
     return true.    
end function. 

/* refresh variables depending in tenant (use_env[32]) and Rootdirectory
   Call whenever one of them has changed  (used by write-dump-seq-mt) 
   (Could also be used to refresh if gFileName and gLobFolderName changes)
   */
function refreshSeqDefaults return logical():
     define variable cSlash     as character no-undo init "/".     
     define variable cBackSlash as character no-undo init "~\".     
     define variable iBack      as integer no-undo.
     define variable iForward   as integer no-undo.
     define variable cUseSlash  as character no-undo.     
     define variable cDir       as character no-undo.
      
     if UseDefaultDirs then
     do:
         iback = r-index(RootDirectory,cBackSlash).
         iforward = r-index(RootDirectory,cSlash).
         if iback > iforward then 
             cUseSlash = cBackSlash.
         else
             cUseSlash  = cSlash.
             
         if RootDirectory <> "" then
         do:
             cdir = RootDirectory + cUseSlash. 
         end.
         assign   
             user_env[2] =  cdir + user_env[32] + cUseSlash + gFileName.
         return true. 
     end. 
     else if user_env[33] <> "Tenant" then
     do:
         user_env[2] = gFileName.
         return true.
     end.
     return false.    
end function.

/* refresh variables depending in tenant (use_env[32]) and Rootdirectory
   Call whenever one of them has changed  (used by write-dump-file-mt) 
   (Could also be used to refresh if gFileName and gLobFolderName changes)
   */
function refreshFileDefaults return logical():
     define variable cSlash     as character no-undo init "/".     
     define variable cBackSlash as character no-undo init "~\".     
     define variable iBack      as integer no-undo.
     define variable iForward   as integer no-undo.
     define variable cUseSlash  as character no-undo.     
     define variable cDir       as character no-undo.
     if UseDefaultDirs then
     do:
         iback = r-index(RootDirectory,cBackSlash).
         iforward = r-index(RootDirectory,cSlash).
         if iback > iforward then 
             cUseSlash = cBackSlash.
         else
             cUseSlash  = cSlash.
             
         if RootDirectory <> "" then
         do:
             cdir = RootDirectory + cUseSlash. 
         end.
         assign   
             user_env[2] =  cdir + user_env[32] + cUseSlash + gFileName
             user_env[30] = cdir + user_env[32] + cUseSlash + gLobFolderName.
         return true. 
     end. 
     return false.    
end function.  

/* refresh variables depending in tenant (use_env[32]) and Rootdirectory
   Call whenever one of them has changed  (used by write-dump-dir-file) 
   (Could also be used to refresh if gFileName and gLobFolderName changes)
   */
function refreshDirDefaults return logical():
     define variable cSlash     as character no-undo init "/".     
     define variable cBackSlash as character no-undo init "~\".     
     define variable iBack      as integer no-undo.
     define variable iForward   as integer no-undo.
     define variable cUseSlash  as character no-undo.     
     define variable cDir       as character no-undo.
     if UseDefaultDirs then
     do:
         iback = r-index(user_env[2],cBackSlash).
         iforward = r-index(user_env[2],cSlash).
         if iback > iforward then 
             cUseSlash = cBackSlash.
         else
             cUseSlash  = cSlash.
             
         if user_env[2] <> "" then
         do:
             cdir = user_env[2] + cUseSlash. 
         end.
         assign   
             user_env[33] = cdir + user_env[32]  
             user_env[30] = cdir + gLobFolderName
             user_env[34] = cdir + user_env[32]  + cUseSlash + gLobFolderName.
         return true. 
     end. 
     return false.    
end function.  
 
function refreshDirMTState returns logical ():    
   
    assign 
        UseDefaultDirs =  UseDefaultDirs:checked in frame write-dump-dir-mt
        inclob            =  inclob:checked in frame write-dump-dir-mt
        user_env[2]:sensitive in frame write-dump-dir-mt = UseDefaultDirs or (isAllMultitenant = false)
  
        user_env[2]:screen-value in frame write-dump-dir-mt = if user_env[2]:sensitive then user_env[2]
                                                                 else ""
        user_env[33]:sensitive  in frame write-dump-dir-mt = not UseDefaultDirs
        
        user_env[30]:screen-value in frame write-dump-dir-mt = if inclob then user_env[30] else ""
        user_env[30]:sensitive in frame write-dump-dir-mt = UseDefaultDirs = false and inclob
        user_env[34]:screen-value in frame write-dump-dir-mt = if inclob then user_env[34] else ""
        user_env[34]:sensitive in frame write-dump-dir-mt = UseDefaultDirs = false and inclob
       
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
         btn_dir2:sensitive  in frame write-dump-dir-mt = 
                    user_env[2]:sensitive  in frame write-dump-dir-mt
         btn_dirMt:sensitive  in frame write-dump-dir-mt = 
                    user_env[33]:sensitive  in frame write-dump-dir-mt
         btn_dir:sensitive  in frame write-dump-dir-mt = 
                    user_env[30]:sensitive  in frame write-dump-dir-mt
         btn_dirmtLob:sensitive  in frame write-dump-dir-mt = 
                    user_env[34]:sensitive  in frame write-dump-dir-mt
   
     &ENDIF 
     
       .
end.     


function refreshSeqMTState returns logical ():    
    assign 
        UseDefaultDirs =  UseDefaultDirs:checked in frame write-dump-seq-mt
        RootDirectory:sensitive in frame write-dump-seq-mt = UseDefaultDirs
        RootDirectory:screen-value in frame write-dump-seq-mt = if UseDefaultDirs then RootDirectory
                                                                 else ""
        user_env[2]:sensitive  in frame write-dump-seq-mt = not UseDefaultDirs
        btn_file:sensitive  in frame write-dump-seq-mt = 
                    user_env[2]:sensitive  in frame write-dump-seq-mt
       
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
         btn_dirRoot:sensitive  in frame write-dump-seq-mt = 
                    RootDirectory:sensitive  in frame write-dump-seq-mt
     &ENDIF 
       .
end.     

function refreshFileMTState returns logical ():    
     
    assign 
        UseDefaultDirs =  UseDefaultDirs:checked in frame write-dump-file-mt
        inclob            =  inclob:checked in frame write-dump-file-mt
        RootDirectory:sensitive in frame write-dump-file-mt = UseDefaultDirs
        RootDirectory:screen-value in frame write-dump-file-mt = if UseDefaultDirs then RootDirectory
                                                                 else ""
        user_env[2]:sensitive  in frame write-dump-file-mt = not UseDefaultDirs
        user_env[30]:screen-value in frame write-dump-file-mt = if inclob then user_env[30] else ""
        user_env[30]:sensitive in frame write-dump-file-mt = UseDefaultDirs = false and inclob
        btn_file:sensitive  in frame write-dump-file-mt = 
                    user_env[2]:sensitive  in frame write-dump-file-mt
       
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
         btn_dirRoot:sensitive  in frame write-dump-file-mt = 
                    RootDirectory:sensitive  in frame write-dump-file-mt
         btn_dir:sensitive  in frame write-dump-file-mt = 
                    user_env[30]:sensitive  in frame write-dump-file-mt
   
     &ENDIF 
     
       .
end.     

function refreshDirMT returns logical ():  
     if refreshDirDefaults() then 
     do: 
         user_env[33]:screen-value in frame write-dump-DIR-mt = user_env[33].
         if inclob:checked in frame write-dump-DIR-mt then
            assign
                user_env[30]:screen-value in frame write-dump-DIR-mt = user_env[30]
                user_env[34]:screen-value in frame write-dump-DIR-mt = user_env[34].
     
     end.           
end.      

function refreshSeqMT returns logical ():  
     if refreshSeqDefaults() then 
     do: 
         user_env[2]:screen-value in frame write-dump-seq-mt = user_env[2].
     end.           
end.      

function refreshFileMT returns logical ():  
     if refreshFileDefaults() then 
     do: 
         user_env[2]:screen-value in frame write-dump-file-mt = user_env[2].
         if inclob:checked   in frame write-dump-file-mt then
             user_env[30]:screen-value in frame write-dump-file-mt = user_env[30].
     end.           
end.      

function validDirectory returns logical ( cValue as char):
  
    IF cValue <> "" THEN 
    DO:
        if not (cValue begins "/" or cvalue begins "~\" or index(cValue,":") <> 0) then
            cValue = "./" + cValue.  
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        return SUBSTRING(FILE-INFO:FILE-TYPE,1,1) = "D".
    END.
    
    
    return true.
 
end function. /* validateDirectory */

function createDirectoryIf returns logical ( cdirname as char):

    define variable iStat as integer no-undo.
    define variable lslash as character no-undo.
	/* rootpath to create at correct place */
	if index(cdirname,"/") <> 0 then lslash = "/".
       else lslash = "~\". 
    if index(cdirname,lslash) = 0 
      and RootDirectory:screen-value in frame write-dump-file-mt <> "" 
      and isSuperTenant then
          assign cdirname = RootDirectory:screen-value in frame write-dump-file-mt 
                            + lslash + cdirname.
    						
    if not validdirectory(cdirname) then
    do:
	    OS-CREATE-DIR VALUE(cdirname). 
        iStat = OS-ERROR. 
        
        if iStat <> 0 then
           MESSAGE "Cannot create directory " + cdirname + ". System error:" iStat
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return istat = 0.
    end.
    return true.
end function. /* validateDirectory */

function refreshDirInSeqUI returns logical ():    
      
     if validDirectory(RootDirectory:screen-value in frame write-dump-seq-mt) then
     do: 
         RootDirectory = right-trim(RootDirectory:screen-value in frame write-dump-seq-mt,"/~\.").
         
         refreshSeqMT().  
         return true.
     end.
     return false.    
end function. 

function refreshDirInFileUI returns logical ():    
      
     if validDirectory(RootDirectory:screen-value in frame write-dump-file-mt) then
     do: 
         RootDirectory = right-trim(RootDirectory:screen-value in frame write-dump-file-mt,"/~\.").
         
         refreshFileMT().  
         return true.
     end.
     return false.    
end function.  

function refreshDirInDirUI returns logical ():      
     if validDirectory(user_env[2]:screen-value in frame write-dump-dir-mt) then
     do: 
         user_env[2] = right-trim(user_env[2]:screen-value in frame write-dump-dir-mt,"/~\.").        
         refreshDirMT().  
         return true.
     end.
     return false.    
end function.  

function refreshTenantInDirUI returns logical ():    
     define variable newTenantName as character no-undo.
     newTenantName = getTenantName(user_env[32]:screen-value in frame write-dump-dir-mt). 
     if newTenantName > "" then
     do: 
         user_env[32] = newTenantName.
         refreshDirMT().  
         return true.
     end.
     return false.    
end function. 

function refreshTenantInFileUI returns logical ():    
     define variable newTenantName as character no-undo.
     newTenantName = getTenantName(user_env[32]:screen-value in frame write-dump-file-mt). 
     if newTenantName > "" then
     do: 
         user_env[32] = newTenantName.
         refreshFileMT().  
         return true.
     end.
     return false.    
end function.  

function refreshTenantInSeqUI returns logical ():    
     define variable newTenantName as character no-undo.
     newTenantName = getTenantName(user_env[32]:screen-value in frame write-dump-seq-mt). 
     if newTenantName > "" then
     do: 
         user_env[32] = newTenantName.
         refreshSeqMT().  
         return true.
     end.
     return false.    
end function.  


  
function selectTenant return logical (hTenant as handle):
    define variable tenantdlg as prodict.pro._tenant-sel-presenter no-undo.
    tenantdlg = new  prodict.pro._tenant-sel-presenter ().
    do with frame write-dump-dir-mt:
           &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        /* adjust the browse aligned and under field (at least try...) */   
        if  hTenant:frame:row < 0 then  /* this does not really work with large negative */                  
            tenantdlg:Row = (hTenant:row + hTenant:height) + 0.5.
        else 
            tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row + 0.5.
        tenantdlg:Col = hTenant:col + hTenant:frame:col .
           &ELSE
        
        tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row.
       
           &ENDIF
    end.
    tenantdlg:QueryString = "for each ttTenant where ttTenant.type <> 'super'".
    tenantdlg:Title = "Select Tenant".
  
/*    glInSelect = true. /* stop end-error anywhere trigger */*/ 
    if tenantdlg:Wait() then
    do: 
        hTenant:screen-value = tenantdlg:ColumnValue("ttTenant.name").
        apply "value-changed" to hTenant.
    end.
/*    glInSelect = false.*/
 
end.  

function validateFile returns logical ( cfile as char):
   
    IF cfile <> "" THEN 
    DO:
        /* check file name entered */
        FILE-INFO:FILE-NAME = cfile.
        IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 
        OR SUBSTRING(cfile,LENGTH(cfile),1,"CHARACTER":U) = "{&SLASH}" THEN 
        DO:
            MESSAGE "The file name entered is invalid." VIEW-AS ALERT-BOX ERROR.
            RETURN false.
        END.
    END.
    
    return true.
end function. /* validatefile */



function validateDirectory returns logical ( cValue as char):
   
    IF cValue <> "" THEN 
    DO:
        if not validDirectory(cValue) then
        DO:
            MESSAGE "Directory " + cValue + " does not exist!" SKIP(1)
            "Please enter a valid directory name."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    /*
            MESSAGE FILE-INFO:FILE-NAME "is not a directory or can not be found" 
            VIEW-AS ALERT-BOX ERROR.
      */
        return false.
    END.
    return true.
  END.
end function. /* validateDirectory */

function validateFileExists returns logical ( cFile as char): 
    define variable prefix    as character no-undo.
    define variable basename  as character no-undo.
    
    RUN prodict/misc/osprefix.p
      ( INPUT  cfile,
        OUTPUT prefix,
        OUTPUT basename
        ).
    
    if basename = cfile then 
        assign cfile = "./" + cfile.
  
    IF io-file AND (SEARCH(cfile) <> ?) THEN 
    DO:
       answer = FALSE.
       MESSAGE "A file already exists with the name:" SKIP cfile SKIP(1) "Overwrite?"
               VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
       IF NOT answer THEN 
       DO:
          return false. 
       END.
    end.
    return true.   
end function.  

function validateDirectoryExists returns logical ( cValue as char, cname as char): 
  DEFINE VAR dir   AS CHAR    NO-UNDO.
  DEFINE VAR exist AS LOGICAL NO-UNDO.
  DEFINE VAR fil   AS CHAR    NO-UNDO.
  DEFINE VAR i     AS INTEGER NO-UNDO.

  assign
    dir     = cValue
    exist   = false.
  
  if dir = "" then assign dir = "./".
  
  DO i = 1 to NUM-ENTRIES(user_env[1]) WHILE NOT exist:
    ASSIGN fil = dir + ENTRY(i,user_env[1]) + ".d".
    IF (SEARCH(fil) <> ?) THEN ASSIGN exist = true.
  END.
    
  IF exist THEN DO:
    answer = FALSE.
    MESSAGE "One or more of the files already exist in the " + cname + "." SKIP 
            "Overwrite them?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      return false.
    END.
  END.
  return true.
end.

function validateTenantName returns logical(ctenant as char):
    define variable lok as logical no-undo.
    if cTenant = "" then
    do:
        MESSAGE "Please specify which Tenant to dump data for."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false. 
    end.
    if getTenantName(cTenant) = "" then 
    do:
        MESSAGE "There is no Tenant with name " +  ctenant + " in the database."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false.
    end.
    return true.
end function. 

function saveDefaultLOB returns logical(useLob as log,lobdirname as char):
     IF useLob = false THEN
         ASSIGN user_env[31] = " NO-LOBS"
                user_env[40] = "".
     ELSE
         ASSIGN user_env[31] = ""
                user_env[40] = lobdirname.
     
end function. 

function saveLOB returns logical(useLob as log,lobdir as char):
     IF useLob = false THEN
         ASSIGN user_env[31] = " NO-LOBS"
                user_env[30] = "".
      ELSE
         ASSIGN user_env[31] = ""
                user_env[30] = lobdir.
end function. 

function saveLOBMT returns logical(useLob as log,lobdir as char,lobdirMT as char):
    saveLOB(useLOB,lobDir).
    IF useLob = false THEN
        user_env[34] = "".
    else
        user_env[34] = lobdirMT.    
end function.    


function trimScreenValue returns logical (h as handle):
     h:SCREEN-VALUE = TRIM(h:SCREEN-VALUE).
end function.     

function validateDirScreenValue returns logical (h as handle):
     trimScreenValue(h).
     return validateDirectory(h:SCREEN-VALUE).
end function.     

function appendFolderName returns char (ppath as char, pfolder as char):
    define variable iback    as integer no-undo.
    define variable iforward as integer no-undo.
    define variable ilength  as integer no-undo.
    define variable cSlash   as character no-undo init "/".
    define variable cBackSlash   as character no-undo init "~\".
    if pPath = "" then 
        return pfolder.
    iback = r-index(pPath,cBackSlash).
    iforward = r-index(pPath,cSlash).
    if iback = 0 and iforward = 0 then
        return pPath + cSlash + pfolder. 
    ilength = length(pPath).
    if iback = ilength or iforward = ilength then 
        return pPath + pfolder.
    if iForward > 0 then  
        return pPath + cSlash + pfolder.
    if iBack > 0 then    
        return pPath + cBackSlash + pfolder.
    
end.


 

 


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
ON HELP OF FRAME write-output-file OR 
   CHOOSE OF btn_Help IN FRAME write-output-file
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_Dlg_Box},
                             INPUT ? ).

on HELP of frame write-boutput-file
   or CHOOSE of btn_Help in frame write-boutput-file
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Make_Bulk_Load_Dlg_Box},
                             INPUT ?).

on HELP of frame write-def-file 
   or CHOOSE of btn_Help in frame write-def-file
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Dump_Stuff_Dlg_Box},
                             INPUT ?).

on HELP of frame write-dump-file 
   or CHOOSE of btn_Help in frame write-dump-file
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&Dump_Data_Contents_Dlg_Box},
                              INPUT ?).

ON HELP OF FRAME write-dump-file-nobl OR
   CHOOSE OF btn_Help IN FRAME write-dump-file-nobl
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_Dlg_Box},
                             INPUT ? ).

on HELP of frame write-dump-dir
   or CHOOSE of btn_Help in frame write-dump-dir
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_Some_Dlg_Box},
                             INPUT ?).

on HELP of frame write-dump-dir-mt
   or CHOOSE of btn_Help in frame write-dump-dir-mt
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_Some_Dlg_Box},
                             INPUT ?).

ON HELP OF FRAME write-audit-data OR 
   CHOOSE OF btn_Help IN FRAME write-audit-data
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             /* Temporary stub till help file is written */
                             INPUT {&Dump_Data_Contents_Dlg_Box},
                             INPUT ?).

ON HELP OF FRAME write-dump-dir-nobl OR 
   CHOOSE OF btn_Help IN FRAME write-dump-dir-nobl
  RUN "adecomm/_adehelp.p" ( INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_Dlg_Box},
                             INPUT ? ).

ON HELP OF FRAME write-output-file-nocp OR 
   CHOOSE OF btn_Help IN FRAME write-output-file-nocp
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Dump_Database_Options_Dialog_Box},
                             INPUT ? ).
            
ON HELP OF FRAME write-dump-dir-cdpg OR 
   CHOOSE OF btn_Help IN FRAME write-dump-dir-cdpg
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_Dlg_Box},
                             INPUT ? ).
ON HELP OF FRAME write-dump-file-mt OR 
   CHOOSE OF btn_Help IN FRAME write-dump-file-mt
   RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Dump_Data_Contents_for_Some_Tables_Multi_tenant_enabled_Dialog_Box},
                             INPUT ? ). 

ON CHOOSE OF btn_dir in frame write-dump-file
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[30]:handle in frame write-dump-file /*Fillin*/,
         INPUT "Find Lob Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dir in frame write-dump-file-mt
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[30]:handle in frame write-dump-file-mt /*Fillin*/,
         INPUT "Find Lob Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
  
ON CHOOSE OF btn_dirMT in frame write-dump-dir-mt   
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[33]:handle in frame write-dump-dir-mt /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dirMTLOB in frame write-dump-dir-mt   
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[34]:handle in frame write-dump-dir-mt /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dir2 in frame write-dump-dir
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[2]:handle in frame write-dump-dir /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dir2 in frame write-dump-dir-mt
do:
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[2]:handle in frame write-dump-dir-mt /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
  apply "value-changed" to user_env[2]  in frame write-dump-dir-mt. 
end.
  
ON CHOOSE OF btn_dir2 in frame write-audit-data
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[2]:handle in frame write-audit-data /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
  
ON CHOOSE OF btn_dir2 in frame write-dump-dir-nobl
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[2]:handle in frame write-dump-dir-nobl /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dir2 in frame write-dump-dir-cdpg
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[2]:handle in frame write-dump-dir-cdpg /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dir in frame write-dump-dir-mt
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[30]:handle in frame write-dump-dir-mt /*Fillin*/,
         INPUT "Find Lob Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).  

ON CHOOSE OF btn_dir in frame write-dump-dir
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[30]:handle in frame write-dump-dir /*Fillin*/,
         INPUT "Find Lob Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
 
ON CHOOSE OF btn_dir in frame write-audit-data
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[30]:handle in frame write-audit-data /*Fillin*/,
         INPUT "Find Lob Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dir in frame write-boutput-file
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT user_env[30]:handle in frame write-boutput-file /*Fillin*/,
         INPUT "Find Lob Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).

ON CHOOSE OF btn_dirRoot in frame write-dump-file-mt 
do:  
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT RootDirectory:handle in frame write-dump-file-mt /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
  apply "value-changed" to RootDirectory in frame write-dump-file-mt. 
end.


ON CHOOSE OF btn_dirRoot in frame write-dump-seq-mt 
do:  
  RUN "prodict/misc/_dirbtn.p"
       ( INPUT RootDirectory:handle in frame write-dump-seq-mt /*Fillin*/,
         INPUT "Choose Dump Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
  apply "value-changed" to RootDirectory in frame write-dump-seq-mt. 
end.

&ENDIF /* IF NOT TTY */


/*----- ON GO or OK -----*/
ON GO OF FRAME write-output-file
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  fil = user_env[2]:SCREEN-VALUE IN FRAME write-output-file.
  /* check file name entered */
  FILE-INFO:FILE-NAME = fil.
  IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 OR
    SUBSTRING(fil,LENGTH(fil),1,"CHARACTER":U) = "{&SLASH}" THEN DO:
    MESSAGE "The file name entered is invalid." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO user_env[2].
    RETURN NO-APPLY.
  END.
    
  RUN prodict/misc/osprefix.p
    ( INPUT  fil,
      OUTPUT prefix,
      OUTPUT basename
      ).
  if basename = fil then assign fil = "./" + fil.
  
  IF /*io-file AND*/ (SEARCH(fil) <> ?) THEN DO:
    answer = FALSE.
    MESSAGE "A file already exists with the name:" SKIP fil SKIP(1) "Overwrite?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-output-file.
      RETURN NO-APPLY.
    END. 
  END.

  /* Assign value of toggle to user_env[26] for dump of _Field._Field-rpos */
  ASSIGN dmp-rpos.
  user_env[26] = (IF NOT dmp-rpos THEN "n" ELSE "y").
END. /* ON "GO" OF write-output-file */

/*----- ON GO or OK -----*/
ON GO OF FRAME write-output-file-nocp
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  fil = user_env[2]:SCREEN-VALUE IN FRAME write-output-file-nocp.
  /* check file name entered */
  FILE-INFO:FILE-NAME = fil.
  IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 OR
    SUBSTRING(fil,LENGTH(fil),1,"CHARACTER":U) = "{&SLASH}" THEN DO:
    MESSAGE "The file name entered is invalid." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO user_env[2].
    RETURN NO-APPLY.
  END.
    
  RUN prodict/misc/osprefix.p
    ( INPUT  fil,
      OUTPUT prefix,
      OUTPUT basename
      ).
  if basename = fil then assign fil = "./" + fil.
  
  IF /*io-file AND*/ (SEARCH(fil) <> ?) THEN DO:
    answer = FALSE.
    MESSAGE "A file already exists with the name:" SKIP fil SKIP(1) "Overwrite?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-output-file-nocp.
      RETURN NO-APPLY.
    END. 
  END.

END. /* ON "GO" OF write-output-file-nocp */

ON GO OF FRAME write-boutput-file
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  fil = user_env[2]:SCREEN-VALUE IN FRAME write-boutput-file.
  /* check file name entered */
  FILE-INFO:FILE-NAME = fil.
  IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 OR
    SUBSTRING(fil,LENGTH(fil),1,"CHARACTER":U) = "{&SLASH}" THEN DO:
    MESSAGE "The file name entered is invalid." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO user_env[2].
    RETURN NO-APPLY.
  END.
    
  RUN prodict/misc/osprefix.p
    ( INPUT  fil,
      OUTPUT prefix,
      OUTPUT basename
      ).
  if basename = fil then assign fil = "./" + fil.
  
  IF /*io-file AND*/ (SEARCH(fil) <> ?) THEN DO:
    answer = FALSE.
    MESSAGE "A file already exists with the name:" SKIP fil SKIP(1) "Overwrite?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-boutput-file.
      RETURN NO-APPLY.
    END. 
  END.
  user_env[26] =  "n" .
END. /* ON "GO" OF write-boutput-file */


ON GO OF FRAME write-def-file
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  fil = user_env[2]:SCREEN-VALUE IN FRAME write-def-file.
  /* check file name entered */
  FILE-INFO:FILE-NAME = fil.
  IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 OR
    SUBSTRING(fil,LENGTH(fil),1,"CHARACTER":U) = "{&SLASH}" THEN DO:
    MESSAGE "The file name entered is invalid." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO user_env[2].
    RETURN NO-APPLY.
  END.

  RUN prodict/misc/osprefix.p
    ( INPUT  fil,
      OUTPUT prefix,
      OUTPUT basename
      ).
  if basename = fil then assign fil = "./" + fil.
  
  IF /*io-file AND*/ (SEARCH(fil) <> ?) THEN DO:
    answer = FALSE.
    MESSAGE "A file already exists with the name:" SKIP fil SKIP(1) "Overwrite?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-def-file.
      RETURN NO-APPLY.
    END.
  END.
END. /* ON "GO" OF write-def-file */

ON GO OF FRAME write-dump-file
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  do with frame write-dump-file:
    
    io-mapc = io-mapc:SCREEN-VALUE. /*To cover GUI case where not in UPDATE*/
  
    if not validateFile(user_env[2]:SCREEN-VALUE) then
    do:
        APPLY "ENTRY" TO user_env[2].
        RETURN NO-APPLY.
    END.
    
    if not validateFileExists(user_env[2]:SCREEN-VALUE) then
    do:
        APPLY "ENTRY" TO user_env[2].
        RETURN NO-APPLY.
    END.
    saveLob(inclob:checked in frame write-dump-file,user_env[30]:screen-value in frame write-dump-file).
  end.
END. /* ON "GO" OF write-dump-file */

ON GO OF FRAME write-dump-file-mt
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  do with frame write-dump-file-mt:
    
    io-mapc = io-mapc:SCREEN-VALUE. /*To cover GUI case where not in UPDATE*/
    
    if not validateTenantName(user_env[32]:screen-value) then
    do:
        apply "entry" to user_env[32].
        return no-apply. 
    end. 
    
    /* Validate this when use defaults. It is not directly used 
       but it is prepended to other directories when valid 
      (invalid values are not prepended, and the user might have 
       thought it was, so we need to tell them that the root is wrong)  */
    if UseDefaultdirs
    and not validateDirectory(RootDirectory:screen-value in frame write-dump-file-mt) then 
    do:
        apply "entry" to RootDirectory IN FRAME write-dump-file-mt.
        
        return no-apply.
    end.    

    if not UseDefaultDirs then
    do:
        if not validateFile(user_env[2]:SCREEN-VALUE) then
        do:
            if user_env[2]:sensitive then
                apply "ENTRY" to user_env[2].
            else
                apply "ENTRY" to UseDefaultDirs.
            
            return no-apply.
        end. 
        
        if not validateDirectory(user_env[30]:screen-value) then 
        do:
            if user_env[30]:sensitive then
                apply "ENTRY" to user_env[30].
            else
                apply "ENTRY" to UseDefaultDirs.
        
            return no-apply. 
        end. 
    end. /* not usedefaultdirs */
    
    if not validateFileExists(user_env[2]:SCREEN-VALUE) then
    do:
        if user_env[2]:sensitive then
            apply "ENTRY" to user_env[2].
        else
            apply "ENTRY" to UseDefaultDirs.
    
        return no-apply.     
    end.
    
    if UseDefaultDirs then 
    do:
        if not createDirectoryIf(user_env[32]:screen-value) then 
        do:
           apply "entry" to UseDefaultDirs.
           return no-apply.     
        end.
        if not createDirectoryIf(user_env[30]:screen-value) then 
        do:
           apply "entry" to UseDefaultDirs.
           return no-apply.     
        end.
    end.    
    assign user_env[32].
    
    if not setEffectiveTenant(user_env[32]) then
    do:
        apply "entry" to user_env[32].
        return no-apply.    
    end.
    if UseDefaultDirs then
    do:
        saveDefaultLob(inclob:checked in frame write-dump-file-mt,gLobFolderName).
    end.
    else  
        saveLob(inclob:checked in frame write-dump-file-mt,user_env[30]:screen-value in frame write-dump-file-mt).
  end.
END. /* ON "GO" OF write-dump-file-mt */


ON GO OF FRAME write-dump-seq-mt
DO:
  DEFINE VAR basename AS CHAR NO-UNDO.
  DEFINE VAR fil      AS CHAR NO-UNDO.
  DEFINE VAR prefix   AS CHAR NO-UNDO.

  do with frame write-dump-seq-mt:
    assign 
        frame write-dump-seq-mt user_env[33].
    
    if user_env[33] <> "SHARED" then
    do:  
        if not validateTenantName(user_env[32]:screen-value) then
        do:
            apply "entry" to user_env[32].
            return no-apply. 
        end. 
    end.
    
    /* Validate this when use defaults. It is not directly used 
       but it is prepended to other directories when valid 
      (invalid values are not prepended, and the user might have 
       thought it was, so we need to tell them that the root is wrong)  */
    if UseDefaultdirs
    and not validateDirectory(RootDirectory:screen-value) then 
    do:
        apply "entry" to RootDirectory.
        
        return no-apply.
    end.    

    if not UseDefaultDirs then
    do:
        if not validateFile(user_env[2]:SCREEN-VALUE IN FRAME write-dump-seq-mt) then
        do:
            if user_env[2]:sensitive IN FRAME write-dump-seq-mt then
                apply "ENTRY" to user_env[2] IN FRAME write-dump-seq-mt.
            else
                apply "ENTRY" to UseDefaultDirs IN FRAME write-dump-seq-mt.
            
            return no-apply.
        end.        
    end. /* not usedefaultdirs */
    
    if not validateFileExists(user_env[2]:SCREEN-VALUE) then
    do:
        if user_env[2]:sensitive then
            apply "ENTRY" to user_env[2].
        else
            apply "ENTRY" to UseDefaultDirs.
    
        return no-apply.     
    end.
    
    if UseDefaultDirs then 
    do:
        if not createDirectoryIf(user_env[32]:screen-value) then 
        do:
           apply "entry" to UseDefaultDirs.
           return no-apply.     
        end.
    end.

    assign 
        frame write-dump-seq-mt user_env[32].
    if user_env[33] <> "SHARED" then
    do:  
        if not setEffectiveTenant(user_env[32]) then
        do:
            apply "entry" to user_env[32].
            return no-apply.    
        end.
    end.
  end.
END. /* ON "GO" OF write-dump-seq-mt */



ON GO OF FRAME write-dump-file-nobl DO:
  DEFINE VAR basename AS CHARACTER NO-UNDO.
  DEFINE VAR fil      AS CHARACTER NO-UNDO.
  DEFINE VAR prefix   AS CHARACTER NO-UNDO.

  io-mapc = io-mapc:SCREEN-VALUE. /*To cover GUI case where not in UPDATE*/
  fil = user_env[2]:SCREEN-VALUE IN FRAME write-dump-file-nobl.
  /* check file name entered */
  FILE-INFO:FILE-NAME = fil.
  IF INDEX(FILE-INFO:FILE-TYPE,"D") > 0 OR
     SUBSTRING(fil,LENGTH(fil),1,"CHARACTER":U) = "{&SLASH}" THEN DO:
    MESSAGE "The file name entered is invalid." VIEW-AS ALERT-BOX ERROR.
    APPLY "ENTRY" TO user_env[2].
    RETURN NO-APPLY.
  END.

  RUN prodict/misc/osprefix.p ( INPUT  fil,
                                OUTPUT prefix,
                                OUTPUT basename ).
  IF basename = fil THEN 
    ASSIGN fil = "./" + fil.
  
  IF io-file AND (SEARCH(fil) <> ?) THEN DO:
    answer = FALSE.
    MESSAGE "A file already exists with the name:" SKIP fil SKIP(1) "Overwrite?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-dump-file-nobl.
      RETURN NO-APPLY.
    END.
  END.

END. /* ON "GO" OF write-dump-file */

ON GO OF FRAME write-dump-dir
DO:    
  do with frame write-dump-dir: 
      io-mapc = io-mapc:SCREEN-VALUE. /*To cover GUI case where not in UPDATE*/
  
      if not validateDirectory(user_env[2]:screen-value) then 
      do:
         apply "entry" to user_env[2].
         return no-apply. 
      end. 
        
      if not validateDirectory(user_env[30]:screen-value) then 
      do:
         apply "entry" to user_env[30].
         return no-apply. 
      end. 
      
      /* the validations below ask questions and should be after regular errors */
      
      if not validateDirectoryExists(user_env[2]:screen-value,"output directory") then
      do:
         apply "entry" to user_env[2].
         return no-apply. 
      end. 
      
      if not validateDirectoryExists(user_env[30]:screen-value,"LOB directory") then
      do:
         apply "entry" to user_env[30].
         return no-apply. 
      end. 
      
      saveLob(inclob:checked,user_env[30]:screen-value).
    end.
END. /* ON "GO" OF write-dump-dir */

on go of frame write-dump-dir-mt
do:
    do with frame write-dump-dir-mt:    
      io-mapc = io-mapc:SCREEN-VALUE. /*To cover GUI case where not in UPDATE*/  
      
      if not validateTenantName(user_env[32]:screen-value) then
      do:
          apply "entry" to user_env[32].
          return no-apply. 
      end. 
      if not validateDirectory(user_env[2]:screen-value) then 
      do:
          apply "entry" to user_env[2].
          return no-apply. 
      end. 
      
      if UseDefaultDirs then 
      do:
          if not createDirectoryIf(user_env[33]:screen-value) then 
          do:
              apply "entry" to UseDefaultDirs.
              return no-apply.     
          end.
          if not createDirectoryIf(user_env[30]:screen-value) then 
          do:
              apply "entry" to UseDefaultDirs.
              return no-apply.     
          end.
          if not createDirectoryIf(user_env[34]:screen-value) then 
          do:
              apply "entry" to UseDefaultDirs.
              return no-apply.     
          end.
          
      end.    
      else do:          
          if not validateDirectory(user_env[33]:screen-value) then 
          do:
              apply "entry" to user_env[33].
              return no-apply. 
          end. 
          
          if not validateDirectory(user_env[30]:screen-value) then 
          do:
              apply "entry" to user_env[30].
              return no-apply. 
          end. 
          
          if not validateDirectory(user_env[34]:screen-value) then 
          do:
              apply "entry" to user_env[34].
              return no-apply. 
          end. 
      end.
      
      /* the validations below ask questions and should be after regular errors */
      if not validateDirectoryExists(user_env[2]:screen-value,"output directory") then
      do:
          apply "entry" to user_env[2].
          return no-apply. 
      end. 
      
      if not validateDirectoryExists(user_env[33]:screen-value,"tenant directory") then
      do:
          apply "entry" to user_env[33].
          return no-apply. 
      end. 
      
      if not validateDirectoryExists(user_env[30]:screen-value,"LOB directory") then
      do:
          apply "entry" to user_env[30].
          return no-apply. 
      end. 
      
      if not validateDirectoryExists(user_env[34]:screen-value,"tenant LOB directory") then
      do:
          apply "entry" to user_env[34].
          return no-apply. 
      end. 
      assign user_env[32].
    
      if not setEffectiveTenant(user_env[32]) then
      do:
         apply "entry" to user_env[32].
         return no-apply.    
      end.
      if UseDefaultDirs then
      do:
          user_env[37] = gGroupFolderName.
          saveDefaultLob(inclob:checked in frame write-dump-dir-mt,gLobFolderName).
      end.
      else  
          saveLobMt(inclob:checked in frame write-dump-dir-mt,user_env[30],user_env[34]).
    end.
end. /* ON "GO" OF write-dump-dir-mt */

ON GO OF FRAME write-audit-data
DO:
  DEFINE VARIABLE cDir    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE lExist  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE cFile   AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE iFile   AS INTEGER     NO-UNDO.
  DEFINE VARIABLE cSlash  AS CHARACTER   NO-UNDO.

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    cSlash = "/".
  &ELSE 
    cSlash = "~\".
  &ENDIF

  cDir = user_env[2]:SCREEN-VALUE IN FRAME write-audit-data.

  IF cDir = "" THEN cDir = ".".
  FILE-INFO:FILE-NAME = cDir.
  lExist = (FILE-INFO:FULL-PATHNAME NE ?).
  IF NOT lExist THEN DO:
    MESSAGE "Directory " + cDir + " does not exist!" SKIP(1)
            "Please enter a valid directory name."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME write-audit-data.
    RETURN NO-APPLY.
  END.

  lExist = FALSE.
  DO i = 1 TO NUM-ENTRIES(user_env[1])
      WHILE NOT lExist:
    FILE-INFO:FILE-NAME = TRIM(cDir,cSlash) + cSlash + 
        ENTRY(i,user_env[1]) + ".ad".
    lExist = (FILE-INFO:FULL-PATHNAME NE ?).
  END.

  IF lExist THEN DO:
    answer = FALSE.
    MESSAGE "One or more of the files already exist in this directory." SKIP 
            "Overwrite them?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-audit-data.
      RETURN NO-APPLY.
    END.
  END.

   IF inclob:SCREEN-VALUE IN FRAME write-audit-data = "no" THEN
      ASSIGN user_env[31] = " NO-LOBS"
             user_env[30] = "".
  ELSE
      ASSIGN user_env[31] = ""
             user_env[30] = user_env[30]:SCREEN-VALUE IN FRAME write-audit-data.
END. /* ON "GO" OF write-audit-data */

ON GO OF FRAME write-dump-dir-nobl
DO:
  DEFINE VARIABLE cDir    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE lExist  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE cFile   AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE iFile   AS INTEGER     NO-UNDO.
  DEFINE VARIABLE cSlash  AS CHARACTER   NO-UNDO.

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    cSlash = "/".
  &ELSE 
    cSlash = "~\".
  &ENDIF

  cDir = user_env[2]:SCREEN-VALUE IN FRAME write-audit-data.

  IF cDir = "" THEN cDir = ".".
  FILE-INFO:FILE-NAME = cDir.
  lExist = (FILE-INFO:FULL-PATHNAME NE ?).
  IF NOT lExist THEN DO:
    MESSAGE "Directory " + cDir + " does not exist!" SKIP(1)
            "Please enter a valid directory name."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME write-audit-data.
    RETURN NO-APPLY.
  END.

  lExist = FALSE.
  DO i = 1 TO NUM-ENTRIES(user_env[1])
      WHILE NOT lExist:
    FILE-INFO:FILE-NAME = TRIM(cDir,cSlash) + cSlash + 
        ENTRY(i,user_env[1]) + ".d".
    lExist = (FILE-INFO:FULL-PATHNAME NE ?).
  END.

  IF lExist THEN DO:
    answer = FALSE.
    MESSAGE "One or more of the files already exist in this directory." SKIP 
            "Overwrite them?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-audit-data.
      RETURN NO-APPLY.
    END.
  END.

  io-mapc = io-mapc:SCREEN-VALUE. /*To cover GUI case where not in UPDATE*/
END. /* ON "GO" OF write-dump-dir-nobl */

ON GO OF FRAME write-dump-dir-cdpg
DO:
  DEFINE VARIABLE cDir    AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE lExist  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE cFile   AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE iFile   AS INTEGER     NO-UNDO.
  DEFINE VARIABLE cSlash  AS CHARACTER   NO-UNDO.

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    cSlash = "/".
  &ELSE 
    cSlash = "~\".
  &ENDIF

  cDir = user_env[2]:SCREEN-VALUE IN FRAME write-dump-dir-cdpg.

  IF cDir = "" THEN cDir = ".".
  FILE-INFO:FILE-NAME = cDir.
  lExist = (FILE-INFO:FULL-PATHNAME NE ?).
  IF NOT lExist THEN DO:
    MESSAGE "Directory " + cDir + " does not exist!" SKIP(1)
            "Please enter a valid directory name."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME write-dump-dir-cdpg.
    RETURN NO-APPLY.
  END.

  lExist = FALSE.
  DO i = 1 TO NUM-ENTRIES(user_env[1])
      WHILE NOT lExist:
    FILE-INFO:FILE-NAME = TRIM(cDir,cSlash) + cSlash + 
        ENTRY(i,user_env[1]) + ".d".
    lExist = (FILE-INFO:FULL-PATHNAME NE ?).
  END.

  IF lExist THEN DO:
    answer = FALSE.
    MESSAGE "One or more of the files already exist in this directory." SKIP 
            "Overwrite them?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME write-dump-dir-cdpg.
      RETURN NO-APPLY.
    END.
  END.
END. /* ON "GO" OF write-dump-dir-cdpg */

IF user_env[9] = "x" THEN DO:
  ON CHOOSE OF btn_Cancel IN FRAME write-output-file
    APPLY "WINDOW-CLOSE" TO FRAME write-output-file.
END.

IF user_env[9] = "t" THEN DO:
  ON CHOOSE OF btn_Cancel IN FRAME write-dump-dir-cdpg
    APPLY "WINDOW-CLOSE" TO FRAME write-dump-dir-cdpg.
END.

/*----- ON WINDOW-CLOSE -----*/
on WINDOW-CLOSE of frame write-output-file
   apply "END-ERROR" to frame write-output-file.
   
on END-ERROR of frame write-output-file
   assign user_env[1] = ?
          user_longchar = (IF isCpUndefined THEN user_longchar ELSE ?).


on WINDOW-CLOSE of frame write-output-file-nocp
   apply "END-ERROR" to frame write-output-file-nocp.
on END-ERROR of frame write-output-file-nocp
   ASSIGN user_env[1] = ?
          user_longchar = (IF isCpUndefined THEN user_longchar ELSE ?).

on WINDOW-CLOSE of frame write-boutput-file
   apply "END-ERROR" to frame write-boutput-file.
on WINDOW-CLOSE of frame write-dump-file
   apply "END-ERROR" to frame write-dump-file.
on WINDOW-CLOSE of frame write-dump-file-mt
   apply "END-ERROR" to frame write-dump-file-mt.
on WINDOW-CLOSE of frame write-dump-seq-mt
   apply "END-ERROR" to frame write-dump-seq-mt.
ON WINDOW-CLOSE OF FRAME write-dump-file-nobl
   APPLY "END-ERROR" TO FRAME write-dump-file-nobl.
on WINDOW-CLOSE of frame write-dump-dir
   apply "END-ERROR" to frame write-dump-dir.
on WINDOW-CLOSE of frame write-dump-dir-mt
   apply "END-ERROR" to frame write-dump-dir.
on WINDOW-CLOSE of frame write-audit-data
   apply "END-ERROR" to frame write-audit-data.
ON END-ERROR OF FRAME write-audit-data
   user_env[1] = ?.
ON CHOOSE OF btn_cancel IN FRAME write-audit-data
   user_env[1] = ?.
on WINDOW-CLOSE of frame write-dump-dir-nobl
   apply "END-ERROR" to frame write-dump-dir-nobl.
on WINDOW-CLOSE of frame write-dump-dir-cdpg
   apply "END-ERROR" to frame write-dump-dir-cdpg.
ON END-ERROR OF FRAME write-dump-dir-cdpg
   ASSIGN user_env[1] = ?
          user_longchar = (IF isCpUndefined THEN user_longchar ELSE ?).

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[2] IN FRAME write-output-file
do:   
   do with frame write-output-file:      
      trimScreenValue(user_env[2]:handle). 
   end.
end.

ON LEAVE OF user_env[2] in frame write-output-file-nocp
do:   
   do with frame write-output-file-nocp:      
      trimScreenValue(user_env[2]:handle). 
   end.
end.

ON LEAVE OF user_env[2] in frame write-boutput-file
do:   
   do with frame write-boutput-file:      
      trimScreenValue(user_env[2]:handle). 
   end.
end.

ON LEAVE OF user_env[2] in frame write-dump-file
do:   
   do with frame write-dump-file:      
      trimScreenValue(user_env[2]:handle). 
   end.
end.

ON LEAVE OF user_env[2] IN FRAME write-dump-file-nobl
do:   
   do with frame write-dump-file-nobl:      
      trimScreenValue(user_env[2]:handle). 
   end.
end.

ON LEAVE OF user_env[2] in frame write-dump-dir DO:
    do with frame write-dump-dir:      
        if not validateDirScreenValue(user_env[2]:handle) then
            RETURN NO-APPLY.
    end.
END.


ON LEAVE OF user_env[2] IN FRAME write-audit-data DO:
    do with frame write-audit-data:      
        if not validateDirScreenValue(user_env[2]:handle) then
            RETURN NO-APPLY.
    end.
END.

ON LEAVE OF user_env[2] IN FRAME write-dump-dir-nobl DO:
    do with frame write-dump-dir-nobl:      
        if not validateDirScreenValue(user_env[2]:handle) then
            RETURN NO-APPLY.
    end.
END. /* ON "LEAVE" OF user_env[2] IN write-dump-dir-nobl */

ON LEAVE OF user_env[2] in frame write-dump-dir-cdpg DO:
    do with frame write-dump-dir-cdpg:      
        if not validateDirScreenValue(user_env[2]:handle) then
            RETURN NO-APPLY.
    end.
END. /* ON "LEAVE" OF user_env[2] IN write-dump-dir-cdpg */

ON LEAVE OF user_env[30] in frame write-dump-file DO:
    do with frame write-dump-file:      
        if not validateDirScreenValue(user_env[30]:handle) then
            RETURN NO-APPLY.
    end.
END. /* ON "LEAVE" OF user_env[30] IN write-dump-file */

ON LEAVE OF user_env[30] in frame write-dump-dir DO:
    do with frame write-dump-dir:      
        if not validateDirScreenValue(user_env[30]:handle) then
            RETURN NO-APPLY.
    end.
END. /* ON "LEAVE" OF user_env[30] IN write-dump-dir */

ON LEAVE OF user_env[30] IN FRAME write-audit-data DO:
    do with frame write-audit-data:      
        if not validateDirScreenValue(user_env[30]:handle) then
            RETURN NO-APPLY.
    end.
END. /* ON "LEAVE" OF user_env[30] IN write-audit-data */

ON VALUE-CHANGED OF inclob IN FRAME write-boutput-file DO:
  IF inclob:SCREEN-VALUE IN FRAME write-boutput-file = "no" THEN
    ASSIGN user_env[30]:SENSITIVE IN FRAME write-boutput-file = FALSE
           user_env[30]:SCREEN-VALUE IN FRAME write-boutput-file = ""
           user_env[30] = "".
  ELSE
    user_env[30]:SENSITIVE IN FRAME write-boutput-file = TRUE.
END. /* ON "VALUE-CHANGED" OF inclob IN write-boutput-file */


ON VALUE-CHANGED OF inclob IN FRAME write-dump-file 
DO:
    IF SELF:screen-value = "yes" THEN
      ASSIGN user_env[30]:sensitive in frame write-dump-file = YES
             s_res = user_env[30]:MOVE-AFTER-TAB-ITEM(inclob:HANDLE).
    ELSE
     ASSIGN user_env[30]:SENSITIVE IN FRAME write-dump-file = NO.            

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
     IF SELF:screen-value = "yes" THEN
       ASSIGN btn_dir:SENSITIVE IN FRAME write-dump-file = YES
              s_res = btn_dir:MOVE-AFTER-TAB-ITEM(user_env[30]:HANDLE).
     ELSE 
       ASSIGN btn_dir:SENSITIVE IN FRAME write-dump-file = NO.
   &ENDIF
END. /* ON "VALUE-CHANGED" OF inclob IN write-dump-file */

ON VALUE-CHANGED OF inclob IN FRAME write-dump-file-mt 
DO:
    refreshFileMTState().
END. /* ON "VALUE-CHANGED" OF inclob IN write-dump-file */

ON VALUE-CHANGED OF inclob IN FRAME write-dump-dir-mt 
DO:
    refreshDirMTState().
END. /* ON "VALUE-CHANGED" OF inclob IN write-dump-file */


ON VALUE-CHANGED OF inclob IN FRAME write-dump-dir 
DO:
    IF SELF:screen-value = "yes" THEN
      ASSIGN user_env[30]:sensitive in frame write-dump-dir = YES
             s_res = user_env[30]:MOVE-AFTER-TAB-ITEM(inclob:HANDLE).           
    ELSE 
     ASSIGN user_env[30]:SENSITIVE IN FRAME write-dump-dir = NO.
            
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
     IF SELF:screen-value = "yes" THEN
       ASSIGN btn_dir:SENSITIVE IN FRAME write-dump-dir = YES
              s_res = btn_dir:MOVE-AFTER-TAB-ITEM(user_env[30]:HANDLE).
     ELSE
       ASSIGN btn_dir:SENSITIVE IN FRAME write-dump-dir = NO.
   &ENDIF
END. /* ON "VALUE-CHANGED" OF inclob IN write-dump-dir */

ON VALUE-CHANGED OF inclob IN FRAME write-audit-data 
DO:
    IF SELF:SCREEN-VALUE = "yes" THEN
      ASSIGN user_env[30]:SENSITIVE IN FRAME write-audit-data = YES
             s_res = user_env[30]:MOVE-AFTER-TAB-ITEM(inclob:HANDLE).           
    ELSE 
     ASSIGN user_env[30]:SENSITIVE IN FRAME write-audit-data = NO.
            
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
     IF SELF:SCREEN-VALUE = "yes" THEN
       ASSIGN btn_dir:SENSITIVE IN FRAME write-audit-data = YES
              s_res = btn_dir:MOVE-AFTER-TAB-ITEM(user_env[30]:HANDLE).
     ELSE
       ASSIGN btn_dir:SENSITIVE IN FRAME write-audit-data = NO.
   &ENDIF
END. /* ON "VALUE-CHANGED" OF inclob IN write-audit-data */

ON VALUE-CHANGED OF user_env[2] IN FRAME write-dump-dir-mt
do:
    refreshDirInDirUI().   
end.    

ON VALUE-CHANGED OF user_env[2] IN FRAME write-dump-file-mt
do:
    assign frame write-dump-file-mt user_env[2].
end.    

ON VALUE-CHANGED OF user_env[32] IN FRAME write-dump-file-mt
do:
    refreshTenantInFileUI().
end. 

ON VALUE-CHANGED OF user_env[32] IN FRAME write-dump-dir-mt
do:
    refreshTenantInDirUI().
end. 

ON VALUE-CHANGED OF user_env[32] IN FRAME write-dump-seq-mt
do:
    refreshTenantInSeqUI().
end. 


ON VALUE-CHANGED OF user_env[30] IN FRAME write-dump-file-mt
do:
    assign frame write-dump-file-mt user_env[30].
end. 

ON VALUE-CHANGED OF user_env[30] IN FRAME write-dump-dir-mt
do:
    assign frame write-dump-dir-mt user_env[30].
end.
 
ON VALUE-CHANGED OF user_env[33] IN FRAME write-dump-dir-mt
do:
    assign frame write-dump-dir-mt user_env[33].
end. 

ON VALUE-CHANGED OF user_env[33] IN FRAME write-dump-seq-mt
do:
    assign frame write-dump-seq-mt user_env[33].
    case user_env[33]:
        
        when "Tenant" then 
        do:
            UseDefaultDirs:sensitive in frame write-dump-seq-mt = true. 
            UseDefaultDirs:checked in frame write-dump-seq-mt = true.
            user_env[32]:sensitive in frame write-dump-seq-mt = true.
            user_env[32]:screen-value in frame write-dump-seq-mt = user_env[32].
        end.
        when "Shared" then 
        do:
            UseDefaultDirs:sensitive in frame write-dump-seq-mt = false. 
            UseDefaultDirs:checked in frame write-dump-seq-mt = false.            
            user_env[32]:sensitive in frame write-dump-seq-mt = false.
            user_env[32]:screen-value in frame write-dump-seq-mt = "".
        end.
        otherwise /*when "All" then */
        do:
            UseDefaultDirs:sensitive in frame write-dump-seq-mt = true. 
            UseDefaultDirs:checked in frame write-dump-seq-mt = false.
            user_env[32]:sensitive in frame write-dump-seq-mt = true.
            user_env[32]:screen-value in frame write-dump-seq-mt = user_env[32].
            
        end.
    end.
    btn_Tenant:sensitive in frame write-dump-seq-mt = 
          user_env[32]:sensitive in frame write-dump-seq-mt.
    if UseDefaultDirs:checked <> UseDefaultDirs then
         apply "value-changed" to UseDefaultDirs in frame write-dump-seq-mt.
 

end. 

ON VALUE-CHANGED OF user_env[34] IN FRAME write-dump-dir-mt
do:
    assign frame write-dump-dir-mt user_env[34].
end. 

ON VALUE-CHANGED OF RootDirectory IN FRAME write-dump-file-mt
do:
    refreshDirInFileUI(). 
end.

ON VALUE-CHANGED OF RootDirectory IN FRAME write-dump-seq-mt
do:
    refreshDirInSeqUI(). 
end.

    
ON VALUE-CHANGED OF UseDefaultDirs IN FRAME write-dump-file-mt
do:
    assign FRAME write-dump-file-mt UseDefaultDirs.
    if UseDefaultDirs then
        refreshFileMT(). 
    
    refreshFileMtState().
end.

ON VALUE-CHANGED OF UseDefaultDirs IN FRAME write-dump-seq-mt
do:
    assign FRAME write-dump-seq-mt UseDefaultDirs.
/*    if UseDefaultDirs then*/
        refreshSeqMT(). 
    
    refreshSeqMtState().
end.

ON VALUE-CHANGED OF UseDefaultDirs IN FRAME write-dump-dir-mt
do:
    assign FRAME write-dump-dir-mt UseDefaultDirs.
    if UseDefaultDirs then
        refreshDirMT(). 
    
    refreshDirMtState().
end.


/* code-page-stuff    <hutegger> 94/02 */
  
{prodict/user/usrdump1.i
  &frame    = "write-dump-dir"
  &variable = "user_env[5]"
  }  /* checks if user_env[5] contains convertable code-page */

{prodict/user/usrdump1.i
  &frame    = "write-dump-dir-mt"
  &variable = "user_env[5]"
}  /* checks if user_env[5] contains convertable code-page */
  
{prodict/user/usrdump1.i
  &frame    = "write-dump-dir-nobl"
  &variable = "user_env[5]"
  }  /* checks if user_env[5] contains convertable code-page */

{prodict/user/usrdump1.i
  &frame    = "write-dump-file"
  &variable = "user_env[5]"
  }  /* checks if user_env[5] contains convertable code-page */

{prodict/user/usrdump1.i
  &frame    = "write-dump-file-mt"
  &variable = "user_env[5]"
 }  /* checks if user_env[5] contains convertable code-page */
 
{prodict/user/usrdump1.i
      &frame    = "write-dump-file-nobl"
      &variable = "user_env[5]"
      }  /* checks if user_env[5] contains convertable code-page */

{prodict/user/usrdump1.i
  &frame    = "write-output-file"
  &variable = "user_env[5]"
  }  /* checks if user_env[5] contains convertable code-page */
  
 {prodict/user/usrdump1.i
  &frame    = "write-boutput-file"
  &variable = "user_env[5]"
  }  /* checks if user_env[5] contains convertable code-page */ 
  
ON CHOOSE OF btn_Tenant IN FRAME write-dump-dir-mt
DO:
    do with frame write-dump-dir-mt:
       selectTenant(user_env[32]:handle).
    end.
END.

ON CHOOSE OF btn_Tenant IN FRAME write-dump-file-mt
DO:
    do with frame write-dump-file-mt:
       selectTenant(user_env[32]:handle).
    end.
END.

ON CHOOSE OF btn_Tenant IN FRAME write-dump-seq-mt
DO:
    do with frame write-dump-seq-mt:
       selectTenant(user_env[32]:handle).
    end.
END.  

/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame write-output-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-output-file /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame write-output-file-nocp DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-output-file-nocp /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame write-boutput-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-boutput-file /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.

ON CHOOSE OF btn_File in frame write-dump-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-dump-file /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.

ON CHOOSE OF btn_File in frame write-dump-file-mt DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-dump-file-mt /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.

ON CHOOSE OF btn_File in frame write-dump-seq-mt DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-dump-seq-mt /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.


ON CHOOSE OF btn_File IN FRAME write-dump-file-nobl DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:HANDLE IN FRAME write-dump-file-nobl /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT NO                 /*Must exist*/).
END.

ON CHOOSE OF btn_File in frame write-def-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame write-def-file /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.
 
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  

ON VALUE-CHANGED OF io-mapl IN FRAME write-dump-file DO:
   refreshMapping(io-mapl:handle in frame write-dump-file,
                  io-mapc:handle in frame write-dump-file).
END. /* ON "VALUE-CHANGED" OF io-mapl IN write-dump-file */

ON VALUE-CHANGED OF io-mapl IN FRAME write-dump-file-mt DO:
   refreshMapping(io-mapl:handle in frame write-dump-file-mt,
                  io-mapc:handle in frame write-dump-file-mt).
END. /* ON "VALUE-CHANGED" OF io-mapl IN write-dump-file-mt */


ON VALUE-CHANGED OF io-mapl IN FRAME write-dump-file-nobl DO:
   refreshMapping(io-mapl:handle in frame write-dump-file-nobl,
                  io-mapc:handle in frame write-dump-file-nobl).
END. /* ON "VALUE-CHANGED" OF io-mapl IN write-dump-file-nobl */

ON VALUE-CHANGED OF io-mapl IN FRAME write-dump-dir DO:
    refreshMapping(io-mapl:handle in frame write-dump-dir,
                  io-mapc:handle in frame write-dump-dir).
END. /* ON "VALUE-CHANGED" OF io-mapl IN write-dump-dir */

ON VALUE-CHANGED OF io-mapl IN FRAME write-dump-dir-mt DO:
    refreshMapping(io-mapl:handle in frame write-dump-dir-mt,
                  io-mapc:handle in frame write-dump-dir-mt).
END. /* ON "VALUE-CHANGED" OF io-mapl IN write-dump-dir-mt */


ON VALUE-CHANGED OF io-mapl IN FRAME write-dump-dir-nobl DO:
    refreshMapping(io-mapl:handle in frame write-dump-dir-nobl,
                  io-mapc:handle in frame write-dump-dir-nobl).
END. /* ON "VALUE-CHANGED" OF io-mapl IN write-dump-dir-nobl */

&ENDIF
/*============================Mainline code===============================*/

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

ASSIGN
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
  io-mapc  = "NO-MAP"
&ENDIF
  class    = SUBSTRING(user_env[9],1,1)
  io-file  = TRUE
  prefix   = ""
  dmp-rpos:HIDDEN IN FRAME write-output-file = 
  (IF class = "d" THEN FALSE ELSE TRUE).


/* for "some" operations, if user_env[1] is empty, then we got a bug
   list in user_longchar 
*/
IF user_env[1] = "" AND (class = "f" OR class = "d" OR class = "b") THEN
   ASSIGN is-some  = (user_longchar MATCHES "*,*").
ELSE
   ASSIGN is-some  = (user_env[1] MATCHES "*,*").
 
ASSIGN
      is-all   = (user_env[1] = "ALL")
      is-one   = NOT is-all AND NOT is-some 
      user_env[37] = ""  
      user_env[40] = ""  
      .

if int(dbversion("dictdb")) > 10 then
do:
   isSuperTenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
   
end.

/* Set default value for codepage gfs:94-04-28-043 */
IF user_env[5] = "" OR user_env[5] = ? THEN DO:
  IF SESSION:CHARSET = "UNDEFINED" THEN 
  DO:
    FIND FIRST _db NO-LOCK.
    ASSIGN user_env[5]  = _db._db-xl-name. /* db codepage */
  END.
  ELSE IF SESSION:STREAM  = "UNDEFINED" THEN
    ASSIGN user_env[5]  = SESSION:CHARSET.
  ELSE ASSIGN user_env[5] = SESSION:STREAM.
  ASSIGN user_env[5]:SENSITIVE = true.
END.

IF user_env[1] <> "" AND 
   NOT is-all  AND 
   NOT is-some AND
   NOT CAN-DO("y,t,x",user_env[9]) THEN DO FOR _File:
  FIND _File WHERE _Db-recid = drec_db AND _File-name = user_env[1]
               AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ).
  dump-as = (IF _File._Dump-name = ?
            THEN SUBSTRING(_File._File-name,1,8)
            ELSE _File._Dump-name).
END.
 

/*----------------------------------------------*/ /* DUMP FILE DEFINITIONS */
IF class = "d" OR class = "4" THEN DO FOR _File:
  FIND _File WHERE _File._File-name = "_Db"
               AND _File._Owner = "PUB".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  
  FIND _File WHERE _File._File-name = "_File"
               AND _File._Owner = "PUB".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  FIND _File WHERE _File._File-name = "_Field"
               AND _File._Owner = "PUB".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  FIND _File where _File._File-name = "_Index"
               AND _File._Owner = "PUB".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF is-all OR is-some 
   then do:
    if PDBNAME(user_dbname) <> ?
     THEN RUN "prodict/misc/osprefix.p"
             ( INPUT PDBNAME(user_dbname),
               OUTPUT trash,
               OUTPUT dump-as
               ).
      else assign dump-as = user_dbname.
     end.          
  ASSIGN
    user_env[2] = (IF class = "4" THEN "_trgdefs.df"
                  ELSE prefix + dump-as + ".df")
    io-title    = (IF class = "4" THEN "Dump Database Triggers for "
                  ELSE "Dump Data Definitions for ")
                + (IF is-all THEN "All Tables"
                  ELSE IF is-some THEN "Some Tables"
                  ELSE "Table" + ' "' + user_env[1] + '"').

END. /* IF class = "d" OR "4" */

/*--------------------------------------------*/ /* DUMP DATA FILE CONTENTS */
ELSE IF class = "f" THEN DO FOR _File:

  nodump = "u".
  { prodict/dictgate.i &action=undumpload
    &dbtype=user_dbtype &dbrec=drec_db &output=nodump
  }

  FIND _File "_File".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  
  IF is-one OR is-some THEN
  DO:
      /* if user_env[1] is "", then value is in user_longchar */
      IF user_env[1] NE "" THEN DO:
          IF isCpUndefined THEN
             base = user_env[1].
          ELSE
             base_lchar = user_env[1].
      END.
      ELSE
          base_lchar = user_longchar.

  END.
  ELSE
      base = "".

  ASSIGN
    user_env[2] = prefix + (IF is-all OR is-some THEN "" ELSE dump-as + ".d")
    
    io-file     = NOT is-all AND NOT is-some
    io-title    = "Dump Data Contents for "
                + (IF is-all THEN "All Tables"
                  ELSE IF is-some THEN "Some Tables"
                  ELSE "Table" + ' "' + user_env[1] + '"')
    user_env[1] = ""
    user_longchar = (IF isCpUndefined THEN user_longchar ELSE "")
    comma       = ""
    i           = 1.

  /* If user had selected ALL, fill base array with list of files.  
     Otherwise, it is already set to file list.
  */
  IF is-all THEN FOR EACH _File
    WHERE _File._File-number > 0
      AND (IF NOT fHidden THEN NOT _File._Hidden ELSE _File._File-Number > 0)
      AND _File._Tbl-Type <> "V"
      AND _File._Db-recid = drec_db
      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" )
      AND CAN-DO(_File._Can-read,USERID(user_dbname))
      AND CAN-DO(_File._Can-dump,USERID(user_dbname))
      AND (nodump = "" OR NOT CAN-DO(nodump,_File._For-type))
    BY _File._File-name:
       IF (isCpUndefined) THEN
           base = base + (IF base = "" THEN "" ELSE ",") + _File._File-name.
       ELSE
           base_lchar = base_lchar + (IF base_lchar = "" THEN "" ELSE ",") + _File._File-name.
  END.

  /* Run through the file list and cull out the ones that the user
     is not allowed to dump for some reason.
  */
  user_env[4] = "".
  
  IF isCpUndefined THEN
      ASSIGN numCount = NUM-ENTRIES(base).
  ELSE
      ASSIGN numCount = NUM-ENTRIES(base_lchar).
  isAllMultiTenant = ?.
  DO i = 1 TO numCount:
    err = ?.
    dis_trig = "y".

    IF isCpUndefined THEN
        cItem = ENTRY(i,base).
    ELSE
        cItem = ENTRY(i,base_lchar).

    FIND _File
      WHERE _File._Db-recid = drec_db AND _File._File-name = cItem
        AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ).
    IF NOT CAN-DO(_File._Can-read,USERID(user_dbname)) OR 
       NOT CAN-DO(_File._Can-dump,USERID(user_dbname)) THEN
      err = _File._File-name
        + " will not be dumped due to insufficient privileges.".
    ELSE 
    IF nodump <> "" AND CAN-DO(nodump,_File._For-type) THEN
      err = "".
        /*SUBSTITUTE("&1 is a &2 &3 and cannot be dumped.",
          _File._File-name,user_dbtype,_File._For-type).*/
    ELSE DO:
      {prodict/dump/dtrigchk.i &OK = answer}
      IF NOT answer THEN DO:
         MESSAGE "You do not have privileges to dump table" _File._File-name 
                 SKIP
                 "with triggers disabled.  Do you want to dump this table" SKIP
                 "anyway even though the FIND trigger will fire?"
                 VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL UPDATE answer.
         IF answer = no THEN
            err = "".  /* don't do this table but no more messages */
         ELSE IF answer = yes THEN DO:
            err = ?.   /* include this table in dump */
            dis_trig = "n".
         END.
         ELSE DO:    /* cancel the dump operation */
            user_path = "".
            RETURN.
         END.
      END.
    END.

    IF err = ? THEN DO:

      /* now we will only put the table number of tables that we will not
         disable triggers for, which is the exception (for most cases).
      */
      IF dis_trig = "n" THEN DO:
          IF user_env[4] = "" THEN
             user_env[4] = STRING(_File._File-number).
          ELSE
              user_env[4] = user_env[4] + "," + STRING(_File._File-number).
      END.

      IF isCpUndefined THEN
         user_env[1] = user_env[1] + comma + _File._File-name.
      ELSE
         user_longchar = user_longchar + comma + _File._File-name.

      ASSIGN comma       = ",".
    END.
    ELSE IF err <> "" THEN DO:
      answer = TRUE.
      IF NUM-ENTRIES(IF isCpUndefined THEN base ELSE base_lchar) = 1 THEN DO:
         MESSAGE err VIEW-AS ALERT-BOX ERROR BUTTONS OK.
         user_path = "".
         RETURN.
      END.
      ELSE DO:
         MESSAGE err SKIP "Do you want to continue?"
            VIEW-AS ALERT-BOX ERROR BUTTONS YES-NO UPDATE answer.
         IF answer = FALSE THEN DO:
            user_path = "".
            return.
         END.
      END.
    END.
    if isSuperTenant then 
    do:         
        if isAnyMultiTenant = false then 
            isAnyMultiTenant = _file._file-attributes[1].
       
        if isAllMultiTenant = ? or isAllMultiTenant then
           isAllMultiTenant = _file._file-attributes[1].   
    end.
    
  END.  /* end of DO i = 2 TO numCount */
  if isAllMultiTenant = ? then
        isAllMultiTenant = false. 
  
  /* subsequent removal of files changed from many to one, so reset ui stuff */
  IF (is-some OR is-all) AND 
     NUM-ENTRIES((IF isCpUndefined THEN user_env[1] ELSE user_longchar)) = 1 THEN DO:

    IF NOT isCpUndefined THEN
       assign user_env[1] = user_longchar
              user_longchar ="".

    FIND _File
      WHERE _File._Db-recid = drec_db
        AND _File._File-name = user_env[1]
      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ).
    
    ASSIGN  
      is-some     = FALSE
      is-all      = FALSE
      is-one      = TRUE
      user_env[2] = prefix + (IF _File._Dump-name = ?
                    THEN _File._File-name ELSE _File._Dump-name)
                  + ".d"
      io-file     = TRUE
      io-title    = "Dump Data Contents for Table ~"" + user_env[1] + "~""
      base        = user_env[1].
  END. /* IF is-some OR is-all */
  ELSE DO:
      /* set multitenant flag to identify tenant specific data dump for file */
      if int(dbversion("dictdb")) > 10 then 
      do:
          if io-file then
          do:
              FIND _File
              WHERE _File._Db-recid = drec_db
                AND _File._File-name = cItem /* Fixed 209398*/
                AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ).
         
          end.    
      end. 
      
      IF NOT isCpUndefined THEN DO:
          /* see if we can put user_longchar into user_env[1] */
          ASSIGN user_env[1] = user_longchar NO-ERROR.
          IF NOT ERROR-STATUS:ERROR THEN
             ASSIGN user_longchar = "".
          ELSE
             ASSIGN user_env[1] = "".
      END.
      
  END.

END. /* IF class = "f" */

/*-----------------------------------------------------*/ /* DUMP SEQ DEFS */
ELSE IF class = "s" THEN DO FOR _File:
  FIND _File "_Sequence".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  
  ASSIGN
    user_env[2] = prefix + "_seqdefs.df"
    io-title    = "Dump Sequence Definitions".
 
END.

/*-----------------------------------------------------*/ /* DUMP SEQ VALS */
ELSE IF class = "k" THEN DO FOR _File:
  FIND _File "_Sequence".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN
    user_env[2] = prefix + "_seqvals.d"
    io-title    = "Dump Sequence Current Values".
  if isSuperTenant then 
  do:      
  
     isAllMultiTenant = ?.
     FOR EACH _Sequence where _Db-recid = drec_db and NOT _Sequence._Seq-name BEGINS "$" no-lock:
        if isAnyMultiTenant = false then 
            isAnyMultiTenant = _Sequence._Seq-attributes[1].
       
        if isAllMultiTenant = ? or isAllMultiTenant then
           isAllMultiTenant = _Sequence._Seq-attributes[1].   
           
     end. 
     if isAllMultiTenant = ? then
        isAllMultiTenant = false.
      
  end.
END.

/*------------------------------------------*/ /* DUMP AUTO-CONNECT RECORDS */
ELSE IF class = "a" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN
    user_env[2] = prefix + "_auto.df"
    io-title    = "Dump Auto-Connect Records".
END.

/*-----------------------*/ /* DUMP AUDIT POLICIES - AS XML */
ELSE IF class = "x" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN io-title    = "Dump Audit Policies as XML"
         user_env[5] = "UTF-8"
         user_env[5]:SENSITIVE IN FRAME write-output-file = FALSE.
END.

/*------------------*/ /* DUMP DATABASE OPTIONS */
ELSE IF class = "o" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  io-title    = "Dump Database Options".
END.

/*------------------*/ /* DUMP SECURITY AUTHENTICATION RECORDS */
ELSE IF class = "h" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  io-title    = "Dump Security Domains" /* Security Authentication Records" */.
END.

/*------------------*/ /* DUMP SECURITY PERMISSIONS */
ELSE IF class = "m" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  io-title    = "Dump Security Permissions".
END.

/*--------------------------------------*/ /* DUMP APPLICATION AUDIT EVENTS */
ELSE IF class = "e" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  io-title    = "Dump Application Audit Events".
END.

/*---------------------------------------*/ /* DUMP AUDIT POLICIES - AS TEXT */
ELSE IF class = "t" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  io-title    = "Dump Audit Policies as Text".  
END.

/*---------------------------------------*/ /* DUMP AUDIT DATA */
ELSE IF class = "y" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-Read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  io-title    = "Dump Audit Data".
END.

/*------------------------------------------*/ /* DUMP COLLATION stuff */
ELSE IF class = "c" THEN DO FOR _File:
  FIND _File "_Db".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN
    user_env[2] = prefix + "_tran.df"
    io-title    = "Dump Collation Tables".
END.

/*--------------------------------------------*/ /* DUMP USER FILE CONTENTS */
ELSE IF class = "u" THEN DO FOR _File:
  FIND _File "_User".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN
    user_env[2] = prefix + "_user.d"
    io-title    = "Dump User Table Contents".
END.

/*--------------------------------------------*/ /* DUMP VIEW FILE CONTENTS */
ELSE IF class = "v" THEN DO FOR _File:
  FIND _File "_View".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 2.
  ASSIGN
    user_env[2] = prefix + "_view.d"
    io-title    = "Dump SQL Views".
END.

/*---------------------------------*/ /* DUMP FILE DEFINITIONS IN V5 FORMAT */
ELSE IF class = "5" THEN DO FOR _File:
  FIND _File "_File".
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN msg-num = 3.
  FIND _File "_Field".
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN msg-num = 3.
  FIND _File "_Index".
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 4.
  IF is-all OR is-some  
   then do:
    if PDBNAME(user_dbname) <> ?
     THEN RUN "prodict/misc/osprefix.p"
             ( INPUT PDBNAME(user_dbname),
               OUTPUT trash,
               OUTPUT dump-as
               ).
      else assign dump-as = user_dbname.
     end.          
  ASSIGN
    user_env[2] = prefix + dump-as + ".df"
    io-title    = "Dump Definitions in V5 Format for "
                + (IF is-all THEN "All Tables"
                  ELSE IF is-some THEN "Some Tables"
                  ELSE "Table" + ' "' + user_env[1] + '"').
END. /* IF class = "5" */
/*-------------------------------------*/ /* MAKE BULKLOAD DESCRIPTION FILE */
ELSE IF class = "b" THEN DO FOR _File:
  FIND _File "_File".
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN msg-num = 3.
  FIND _File "_Field".
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN msg-num = 3.
  FIND _File "_Index".
  IF NOT CAN-DO(_File._Can-read,USERID("DICTDB")) THEN msg-num = 3.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 5.
  IF is-all OR is-some  
   then do:
    if PDBNAME(user_dbname) <> ?
      THEN RUN "prodict/misc/osprefix.p"
              ( INPUT PDBNAME(user_dbname),
              OUTPUT trash,
              OUTPUT dump-as
              ).
      else assign dump-as = user_dbname.
     end.          
  ASSIGN
    user_env[2] = prefix + dump-as + ".fd"
    io-title    = "Make Bulk Load Description File for "
                + (IF is-all THEN "All Tables"
                  ELSE IF is-some THEN "Some Tables"
                  ELSE "Table" + ' "' + user_env[1] + '"').
END. /* IF class = "b" */

IF msg-num > 0 THEN DO:
  MESSAGE (
    IF      msg-num = 1 THEN
      "Cannot dump User information from a non-{&PRO_DISPLAY_NAME} database."
    ELSE IF msg-num = 2 THEN
      "Cannot dump View information from a non-{&PRO_DISPLAY_NAME} database."
    ELSE IF msg-num = 3 THEN
      "You do not have permission to use this option."
    ELSE IF msg-num = 4 THEN
      "You can only dump definitions in V5 format for {&PRO_DISPLAY_NAME} databases."
    ELSE /*IF msg-num = 5 THEN*/
      "You can only create bulkload description files for {&PRO_DISPLAY_NAME} databases.")
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END. /* msgnum > 0 */

/* Adjust the graphical rectangle and the ok and cancel buttons */
IF class = "f" THEN DO:
   IF io-file THEN DO:
       if isAnyMultiTenant then 
       do:
         {adecomm/okrun.i  
            &FRAME  = "FRAME write-dump-file-mt" 
            &BOX    = "rect_Btns"
            &OK     = "btn_OK" 
            {&CAN_BTN}
            {&HLP_BTN}
          } 
       end.
       else 
       do:
          {adecomm/okrun.i  
            &FRAME  = "FRAME write-dump-file" 
            &BOX    = "rect_Btns"
            &OK     = "btn_OK" 
            {&CAN_BTN}
            {&HLP_BTN}
          } 
     end.
   END.
   ELSE IF isAnyMultiTenant then
   DO:
     {adecomm/okrun.i  
        &FRAME  = "FRAME write-dump-dir-mt" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
     }
   END.
   ELSE DO:
     {adecomm/okrun.i  
        &FRAME  = "FRAME write-dump-dir" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
   }
   END.
END. /* class = "f" */
ELSE IF class = "y" THEN DO:
  {adecomm/okrun.i  
     &FRAME  = "FRAME write-audit-data" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
  }
  ASSIGN io-title    = "Dump Audit Data"
         inclob      = FALSE.
END.

ELSE IF class = "i" THEN DO:
  {adecomm/okrun.i  
     &FRAME  = "FRAME write-dump-file-nobl" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
  }
  ASSIGN io-title    = "Dump Database Identification Properties"
         user_env[2] = "_db-detail.d".
END.
ELSE IF CAN-DO("o",class) THEN DO:
  {adecomm/okrun.i
   &FRAME  = "FRAME write-output-file-nocp"
   &BOX    = "rect_Btns"
   &OK     = "btn_OK"
   {&CAN_BTN}
   {&HLP_BTN}
  }
END.
ELSE IF CAN-DO("m,t",class) THEN DO:
  {adecomm/okrun.i
   &FRAME  = "FRAME write-dump-dir-cdpg"
   &BOX    = "rect_Btns"
   &OK     = "btn_OK"
   {&CAN_BTN}
   {&HLP_BTN}
  }
END.
ELSE IF class = "h" THEN DO:
  {adecomm/okrun.i
   &FRAME  = "FRAME write-dump-dir-nobl"
   &BOX    = "rect_Btns"
   &OK     = "btn_OK"
   {&CAN_BTN}
   {&HLP_BTN}
  }
END.
else 
if class = "5"  /* version 5 .df */
or class = "k"  /* sequence def's */
or class = "s"  /* sequence-values */ THEN 
DO:
    /* moved with update since there are addtionl logic to decide Mt or not
    (ALL of these should really be moved where they are used) */
END.
ELSE DO:
  IF class <> "b" THEN DO:
    {adecomm/okrun.i  
       &FRAME  = "FRAME write-output-file" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
       {&HLP_BTN}
    }
  END.
  ELSE DO:
    {adecomm/okrun.i  
     &FRAME  = "FRAME write-boutput-file" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
    }
  END.
END.

 
PAUSE 0.
user_env[3] = "".

/* If name contains the .db, remove it */
IF INDEX(user_env[2],".db") > 0 THEN
        SUBSTRING(user_env[2],INDEX(user_env[2],".db"),3,"RAW") = "".

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  if class = "k" and isAnyMultiTenant then 
  do WITH FRAME write-dump-seq-mt:
      {adecomm/okrun.i  
        &FRAME  = "FRAME write-dump-seq-mt" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
      }
      assign 
          UseDefaultDirs = true
          user_env[32]  = get-effective-tenant-name("dictdb")
          user_env[33]  =  "Tenant"
                           
          gFileName = user_env[2].
              
      refreshSeqDefaults().  
      /*
      if isAllMultiTenant then
      do:
          user_env[33]:disable("Tenant") in frame write-dump-seq-mt .
          user_env[33]:disable("All").
      end.      
      */
      display 
          user_env[33]
          user_env[32]
          UseDefaultDirs
          user_env[2]
          user_env[5]. 
      
      ENABLE user_env[33]
             user_env[32]
             btn_Tenant
             UseDefaultDirs
             RootDirectory
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
             btn_DirRoot 
           &ENDIF 
             user_env[2] 
             btn_File      
             user_env[5]
             btn_OK 
             btn_Cancel
             {&HLP_BTN_NAME}.
          
      refreshSeqMTState().
      wait-for "go" of frame write-dump-seq-mt.
      assign 
          frame write-dump-seq-mt user_env[32]
          frame write-dump-seq-mt user_env[33]
          frame write-dump-seq-mt user_env[2]
          frame write-dump-seq-mt user_env[5].
       
       if user_env[33] = "ALL" then
           assign
               user_env[32] = "" 
               user_env[33] = "".
  
  end.
  else 
  if class = "5"  /* version 5 .df */
  or class = "k"  /* sequence def's */
  or class = "s"   /* sequence-values */ THEN
  do: 
     {adecomm/okrun.i  
       &FRAME  = "FRAME write-def-file" 
       &BOX    = "rect_Btns"
       &OK     = "btn_OK" 
       {&CAN_BTN}
       {&HLP_BTN}
     }  
      
     UPDATE user_env[2] 
          btn_File      
          user_env[5]
          btn_OK 
          btn_Cancel
          {&HLP_BTN_NAME}
          WITH FRAME write-def-file.
  end.
  ELSE IF class = "b" THEN
      UPDATE UNLESS-HIDDEN user_env[2] 
           btn_File
       inclob
       user_env[30]
       &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
        btn_dir
       &ENDIF
           user_env[5] 
           btn_OK 
           btn_Cancel
           {&HLP_BTN_NAME}
           WITH FRAME write-boutput-file.
  ELSE IF class = "o" THEN
      UPDATE UNLESS-HIDDEN user_env[2]
                           btn_File
                           btn_OK
                           btn_Cancel
                           {&HLP_BTN_NAME}
         WITH FRAME write-output-file-nocp.
  ELSE IF CAN-DO("t,m",class) THEN DO:
    IF class = "t" THEN DO:
      DISPLAY user_env[5] WITH FRAME write-dump-dir-cdpg.
      UPDATE UNLESS-HIDDEN user_env[2]
                           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
                             btn_Dir2
                           &ENDIF
                           btn_OK
                           btn_Cancel
                           {&HLP_BTN_NAME}
         WITH FRAME write-dump-dir-cdpg.
    END.
    ELSE
      UPDATE UNLESS-HIDDEN user_env[2]
                           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
                             btn_Dir2
                           &ENDIF
                           user_env[5]
                           btn_OK
                           btn_Cancel
                           {&HLP_BTN_NAME}
         WITH FRAME write-dump-dir-cdpg.
  END.
  ELSE IF class = "h" THEN
    UPDATE user_env[2] 
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
              btn_dir2
           &ENDIF
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
             io-mapl 
           &ELSE
             io-mapc 
           &ENDIF
           user_env[5] btn_OK btn_Cancel {&HLP_BTN_NAME}
       WITH FRAME write-dump-dir-nobl.
  ELSE IF class = "i" THEN
    UPDATE user_env[2] 
           btn_File   
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
             io-mapl
           &ELSE
             io-mapc 
           &ENDIF
           user_env[5] 
           btn_OK 
           btn_Cancel
           {&HLP_BTN_NAME}
           WITH FRAME write-dump-file-nobl.
  ELSE IF class = "y" THEN DO:
    DISPLAY inclob user_env[30] user_env[5]
        WITH FRAME write-audit-data.
    UPDATE user_env[2] 
             &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
                btn_dir2
             &ENDIF
             btn_OK btn_Cancel {&HLP_BTN_NAME}
           WITH FRAME write-audit-data.
  END.
  ELSE IF class <> "f" THEN DO:
    IF class = "x" THEN DO:
      DISPLAY user_env[5] WITH FRAME write-output-file.
      UPDATE UNLESS-HIDDEN user_env[2] 
           btn_File    
           dmp-rpos
           btn_OK 
           btn_Cancel
           {&HLP_BTN_NAME}
           WITH FRAME write-output-file.
    END.
    ELSE
      UPDATE UNLESS-HIDDEN user_env[2] 
           btn_File    
           user_env[5] 
           dmp-rpos
           btn_OK 
           btn_Cancel
           {&HLP_BTN_NAME}
           WITH FRAME write-output-file.
  END.
  ELSE DO:
    IF io-file THEN
    do:
    
       if isAnyMultiTenant then
       do WITH FRAME write-dump-file-mt:
          assign 
              UseDefaultDirs = true
              user_env[32]  = get-effective-tenant-name("dictdb")
              gFileName = user_env[2].
              
          refreshFileDefaults(). 
         
          display 
              user_env[32]
              UseDefaultDirs
              user_env[2]
              user_env[30] 
              inclob
              user_env[5].
            
          &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
          display  io-mapl . 
          /* establish tab-order */
          enable   
              user_env[32] 
              btn_Tenant 
              UseDefaultDirs 
              RootDirectory
              btn_dirroot
              user_env[2]
              btn_file
              inclob  
              user_env[30]
              btn_dir
              io-mapl
              user_env[5]
              btn_OK 
              btn_Cancel
              {&HLP_BTN_NAME}
              .
          &else
          
          display  io-mapc. 
          enable   
              user_env[32] 
              btn_Tenant 
              UseDefaultDirs 
              RootDirectory
              user_env[2]
              btn_file
              inclob  
              user_env[30]
              io-mapc
              user_env[5]
              btn_OK 
              btn_Cancel
              {&HLP_BTN_NAME}
              .
              
          &endif
          
          refreshFileMTState().
          
          wait-FOR "GO" OF FRAME write-dump-file-mt. 
          
          assign
              frame write-dump-file-mt user_env[32]
              frame write-dump-file-mt RootDirectory 
              frame write-dump-file-mt UseDefaultDirs
              frame write-dump-file-mt user_env[2]
              frame write-dump-file-mt inclob
              frame write-dump-file-mt user_env[30] 
              frame write-dump-file-mt user_env[5]
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
              frame write-dump-file-mt io-mapl
          &ELSE
              frame write-dump-file-mt io-mapc
          &ENDIF
           .  
           if UseDefaultDirs then
           do:
             /* don't pass file name 
                it makes it difficult to create lob dir 
                the file name will be added by _dmpdefs if 
                use default */  
               user_env[2]  = RootDirectory.
               user_env[33] = gUseDefaultOut.
           end.
        end.
        else 
           UPDATE user_env[2]  
              btn_File   
              inclob
              user_env[30]
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
              btn_dir
              io-mapl
           &ELSE
              io-mapc 
           &ENDIF
              user_env[5] 
              btn_OK 
              btn_Cancel
           {&HLP_BTN_NAME}
           WITH FRAME write-dump-file.
    end.
    ELSE DO:
        if isANyMultiTenant then
        do WITH FRAME write-dump-dir-mt:
           
           assign 
              UseDefaultDirs = true
              user_env[32] = get-effective-tenant-name("dictdb").
            
            refreshDirDefaults().  
            
            display 
                user_env[32] 
                UseDefaultDirs
                user_env[2] 
                user_env[33] 
                inclob
                user_env[30]
                user_env[34]
                user_env[5] 
                .
            &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
            if isAllMultiTenant then 
               labeldir = labelDirRoot.
            else
               labeldir = labelDirShared. 
                 
            disp io-mapl labeldir.
           
            enable user_env[32] 
                   btn_Tenant 
                   UseDefaultDirs
                   user_env[2] 
                   btn_dir2
                   user_env[33] 
                   btn_dirMT
                   inclob
                   user_env[30]
                   btn_dir
                   user_env[34]
                   btn_dirMTLOB
                   io-mapl 
                   user_env[5] 
                   btn_OK 
                   btn_Cancel 
                   {&HLP_BTN_NAME}.
            
            &ELSE
            if isAllMultiTenant then 
               user_env[2]:label in frame write-dump-dir-mt = "Root Directory".
            else
               user_env[2]:label in frame write-dump-dir-mt = "Shared Directory". 
                    
             display  io-mapc .
             enable user_env[32] 
                    btn_Tenant 
                    UseDefaultDirs
                    user_env[2] 
                    user_env[33] 
                    inclob
                    user_env[30]
                    user_env[34]
                    io-mapc 
                    user_env[5] 
                    btn_OK 
                    btn_Cancel 
                   {&HLP_BTN_NAME}.
            
            &ENDIF
            
            refreshDirMTState().
            wait-for "go" of frame  write-dump-dir-mt.
            assign frame write-dump-dir-mt user_env[2] 
                   frame write-dump-dir-mt user_env[32] 
                   frame write-dump-dir-mt user_env[33] when not UseDefaultDirs
                   frame write-dump-dir-mt inclob
                   frame write-dump-dir-mt user_env[30] 
                   frame write-dump-dir-mt user_env[34]
               &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN      
               
                   frame write-dump-dir-mt io-mapc
                   frame write-dump-dir-mt io-mapl

               &ELSE
               
                   frame write-dump-dir-mt io-mapc
               
               &ENDIF    
                   frame write-dump-dir-mt user_env[5]. 
             if UseDefaultDirs then
                 user_env[33] = gUseDefaultOut.
        end. /* do WITH FRAME write-dump-dir-mt*/
        else  /* not isMultiTenant */
            UPDATE 
                user_env[2] 
                     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
                btn_dir2
                     &ENDIF
                inclob
                user_env[30]
                     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
                btn_dir
                io-mapl 
                     &ELSE
                   io-mapc 
                 &ENDIF
                user_env[5] 
                btn_OK 
                btn_Cancel 
                {&HLP_BTN_NAME}
           WITH FRAME write-dump-dir.
        
    END.
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
      CASE io-mapl:
          WHEN 1 THEN user_env[3] = "NO-MAP".
          WHEN 2 THEN user_env[3] = io-mapc.
      END CASE.
    &ELSE
      IF io-mapc <> "" THEN user_env[3] = io-mapc.
    &ENDIF
  END.
  IF NOT io-file THEN
  do:   
    RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).
    if isANyMultiTenant then
    do:
       if user_env[33] <> gUseDefaultOut then
           RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[33]).
    end.
  end.    
  { prodict/dictnext.i trash }
  canned = FALSE.
END.

HIDE MESSAGE NO-PAUSE.

HIDE FRAME write-output-file NO-PAUSE.
HIDE FRAME write-dump-file NO-PAUSE.
HIDE FRAME write-dump-dir NO-PAUSE.
HIDE FRAME write-output-file-nocp NO-PAUSE.

IF canned THEN
  user_path = "".
RETURN.

/**** procedures  *************************************************************/
 
procedure walkFrame:
    define input parameter hWidget as handle no-undo.
    define variable cc as character no-undo.
   
    hwidget = hWidget:first-child.
    hwidget = hwidget:first-child.
 
    /* move everything up to fill the empty space from user_env[2] and [30] */ 
    do while valid-handle(hwidget):    
        cc = cc + (if hWidget:name = ? then hwidget:type else hwidget:name) + chr(10).  
        hWidget = hWidget:next-sibling.
 
    end.    
    message cc
    view-as alert-box.
 end.    /*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrebox.p - error dialog box routine - displays a message, then returns */

/*
Input text comes in 'question' parameter, and may be any length.
This program splits it up into 45-character chunks, breaking at
spaces.  Embedded '!' marks get translated into line-feeds (like
in column-labels).
*/

DEFINE INPUT PARAMETER question AS CHARACTER NO-UNDO.
DEFINE VARIABLE ans AS LOGICAL NO-UNDO.

/* s-alert uses a carat instead of ! (why?) */
question = REPLACE(question, "!", "^").  

RUN adecomm/_s-alert.p 
   (INPUT-OUTPUT ans, INPUT "ERROR", 
    INPUT "OK",       INPUT question).

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrexpo.p - get fields, etc. for export */

/*
This program does the initial for both 'sylk' and 'dif' format dumps.

IN:
user_env[1] = db filename to export
user_env[9] = 'dif' for dif format
            = 'sylk' for sylk format
            = 'ascii' for ascii format
            = 'ws' for wordstar format
            = 'word' for microsoft word format
            = 'wperf' for wordperfect format
            = 'ofisw' for btos ofiswriter format

OUT:
user_env[ 1] = db filename to export
user_env[ 2] = 'WHERE' clause
user_env[ 3] = 'BY' clause
user_env[ 4] = export '.dif', '.slk', or '.txt' filename
user_env[ 5] = count of field names to export
user_env[ 6] = comma-delimited list of field names to export
user_env[ 7] = ?, or filename to save generated code
user_env[ 8] = y/n, include field headers (_dmpasci.p only)
user_env[ 9] = format type
user_env[10] = field delimiter character (_dmpasci.p only)
user_env[11] = field separator character (_dmpasci.p only)
user_env[12] = line delimiter character (_dmpasci.p only)
user_env[13] = line starter character (_dmpasci.p only)
user_env[14] = "y" - disable triggers, "n" - do not disable triggers

HISTORY:
03/04/03 by mcmann Added block for blobs and clobs
04/17/01 by mcmann Added ldbname to compile check and delete of temp file.
                   20010412-001
07/13/98 by mcmann Added _Owner to _File finds
08/01/95 by tomn - added support for mnemonics
07/28/94 by gfs - added context-sensitive help to export dlg.
07/08/94 by gfs - added validation to the ascii export frame
06/24/94 by gfs - added syntax check to validate WHERE and/or BY
06/23/94 by gfs - previous change backed out - will go in 7.4
06/23/94 by gfs - changed field labels for ascii export.
10/15/03 D. McMann  Add support for datetime and datetime-tz  

*/
{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

DEFINE VARIABLE anywhere  AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE anysort   AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE canned    AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE allorsome AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE dis_trigs AS LOGICAL INITIAL NO    NO-UNDO.
DEFINE VARIABLE dummyl    AS LOGICAL               NO-UNDO.
DEFINE VARIABLE i         AS INTEGER               NO-UNDO.
DEFINE VARIABLE typ       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE upath     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE out_lbl   AS CHAR FORMAT "X(13)" NO-UNDO INIT "&Output File:".
define variable isSuperTenant as logical no-undo.
define variable isMultiTenant as logical no-undo.

 
define variable gTenant  as character no-undo.
define variable cTenantlabel as character format "x(30)" no-undo init "Effective Tenant:".
define button btnTenant size 18 by 1 label "Select Tenant...".
 

{prodict/misc/filesbtn.i}

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 5 NO-UNDO INITIAL [
  /*1,2*/ "Fields for", "Export",
  /*  3*/ "You do not have permission to read from this table.",
  /*  4*/ "A file already exists with the name:",
  /*  5*/ "Overwrite it?"
].

/*---------------- FRAME export-stuff --------------------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
&GLOBAL-DEFINE EDITLINES 2
&GLOBAL-DEFINE FILLCH    55
&ELSE
&GLOBAL-DEFINE EDITLINES 3
&GLOBAL-DEFINE FILLCH    57
&ENDIF
FORM
  SKIP({&TFM_WID})
  cTenantlabel no-label AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  gTenant at 2 no-label format "x(32)"  VIEW-AS fill-in size 48  by 1  btntenant skip ({&VM_WID})
  out_lbl AT 2 VIEW-AS TEXT NO-LABEL SKIP({&VM_WID})
  user_env[4] {&STDPH_FILL} NO-LABEL FORMAT "x({&PATH_WIDG})" AT 2 
        VIEW-AS FILL-IN SIZE {&FILLCH} BY 1
  btn_File  SKIP ({&VM_WIDG})
  "Fields to Export:    " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  allorsome VIEW-AS RADIO-SET RADIO-BUTTONS "&Selected", no, "All (&Max 255)", yes
            NO-LABEL AT 2 SKIP({&VM_WIDG})
  "Records to Export:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  anywhere VIEW-AS RADIO-SET RADIO-BUTTONS "&All", no, "Use &WHERE-Clause ", yes
                       NO-LABEL AT 2
  user_env[2] NO-LABEL FORMAT "X(128)"
        VIEW-AS EDITOR INNER-LINES {&EDITLINES} INNER-CHARS 40 
        SCROLLBAR-VERTICAL {&STDPH_ED4GL_SMALL}
        AT ROW-OF anywhere COLUMN 26 SKIP({&VM_WIDG})
  "Record Sorting:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  anysort VIEW-AS RADIO-SET RADIO-BUTTONS "Use &Primary Index", 
        no, "Use &BY-Clause", yes NO-LABEL AT 2
  user_env[3] NO-LABEL FORMAT "x(128)" 
        VIEW-AS EDITOR INNER-LINES {&EDITLINES} INNER-CHARS 40 
        SCROLLBAR-VERTICAL {&STDPH_ED4GL_SMALL}
        AT ROW-OF anysort COLUMN 26 SKIP({&VM_WIDG})
  "Database Triggers: " AT 2 VIEW-AS TEXT /*SKIP({&VM_WID})*/
  dis_trigs VIEW-AS TOGGLE-BOX LABEL "&Disable During Export"
         SKIP({&VM_WIDG})
     "  NOTE: LOB or Array fields cannot be exported and are excluded from the list." AT 3 VIEW-AS TEXT SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME export-stuff
  CENTERED SIDE-LABELS SCROLLABLE 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Export " + (IF user_env[9] EQ "ascii" THEN "Text" ELSE user_env[9]).
  
  /* Added to support "Output File:" fill-in label mnemonic (tomn 8/1/95) */
  ASSIGN
    user_env[4]:SIDE-LABEL-HANDLE IN FRAME export-stuff = out_lbl:HANDLE
    user_env[4]:LABEL = out_lbl
    gTenant:SIDE-LABEL-HANDLE IN FRAME export-stuff = cTenantLabel:HANDLE
    cTenantLabel:LABEL IN FRAME export-stuff = cTenantLabel.
&ELSE
FORM
  SKIP(.5)
  cTenantlabel no-label AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  /* the size 42 is just used to right-align buttons */
  gTenant at 4 no-label format "x(32)" view-as fill-in size 42 by 1 
  btntenant skip ({&VM_WID})
  "Output File:" AT 2 SKIP
  user_env[4] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" NO-LABEL AT 4
        VIEW-AS FILL-IN SIZE 50 BY 1 
  btn_File SKIP(1)
  "WHERE-Clause Criteria for Records to be Exported (Default = All):" 
                                                                                        AT 2 VIEW-AS TEXT SKIP
  user_env[2] NO-LABEL FORMAT "x(60)"               AT 4 SPACE(1)  SKIP(1)

  "BY-Clause for Sorting Records (Default = Use Primary Index):"     
        AT 2 VIEW-AS TEXT SKIP
  user_env[3] NO-LABEL  FORMAT "x(60)"                  AT 4           SKIP(1)

  allorsome FORMAT "All/Some"
    LABEL "Export (A)ll Fields (max 255) Or (S)elected Fields" AT 2   SKIP
  "(LOB or Array fields cannot be exported and are excluded from the list)" 
                                                                                        AT 4 VIEW-AS TEXT SKIP(1)

  dis_trigs LABEL "Disable Triggers During Export?" AT 2 
  {prodict/user/userbtns.i}
  WITH FRAME export-stuff
  ROW 2 CENTERED SIDE-LABELS SCROLLABLE 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Export " + (IF user_env[9] EQ "ascii" THEN "Text" ELSE user_env[9]).
  
  assign
     gTenant:SIDE-LABEL-HANDLE IN FRAME export-stuff = cTenantLabel:HANDLE
     cTenantLabel:LABEL IN FRAME export-stuff = cTenantLabel.
&ENDIF

/*---------------- FRAME export-ascii --------------------------------------*/
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
&GLOBAL-DEFINE LINEUP 19
&ELSE
&GLOBAL-DEFINE LINEUP 21
&ENDIF
FORM
  SKIP({&TFM_WID})
  user_env[13] {&STDPH_FILL} LABEL "Record &Start String" FORMAT "x(20)" 
        COLON {&LINEUP} SKIP ({&VM_WID})
  user_env[12] {&STDPH_FILL} LABEL "Record &End String" FORMAT "x(20)" 
        COLON {&LINEUP} SKIP({&VM_WIDG})
  user_env[10] {&STDPH_FILL} LABEL "Field &Delimiter" FORMAT "x(20)" 
        COLON {&LINEUP} SKIP ({&VM_WID})
  user_env[11] {&STDPH_FILL} LABEL "Field Se&parator" FORMAT "x(20)" 
        COLON {&LINEUP} SKIP ({&VM_WIDG})
  "Note: three-digit octal codes are allowed,"
        AT 2 VIEW-AS TEXT SKIP
  "such as ~~012." AT 2 VIEW-AS TEXT
  {prodict/user/userbtns.i}
  WITH FRAME export-ascii
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Output Record Formatting".
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*=============================Functions=================================*/  
function selectTenant return logical (hTenant as handle):
    define variable tenantdlg as prodict.pro._tenant-sel-presenter no-undo.
    tenantdlg = new  prodict.pro._tenant-sel-presenter ().
    do with frame write-dump-dir-mt:
           &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        /* adjust the browse aligned and under field (at least try...) */   
        if  hTenant:frame:row < 0 then  /* this does not really work with large negative */                  
            tenantdlg:Row = (hTenant:row + hTenant:height) + 2.
        else 
            tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row + 0.5.
        tenantdlg:Col = hTenant:col + hTenant:frame:col .
           &ELSE
        
        tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row.
       
           &ENDIF
    end.
    tenantdlg:QueryString = "for each ttTenant where ttTenant.type <> 'super'".
    tenantdlg:Title = "Select Tenant".
  
/*    glInSelect = true. /* stop end-error anywhere trigger */*/ 
    if tenantdlg:Wait() then
    do: 
        hTenant:screen-value = tenantdlg:ColumnValue("ttTenant.name").
        apply "value-changed" to hTenant.
    end.
/*    glInSelect = false.*/
 
end.  

function getTenantName returns char(pctenant as char):
    define variable lok     as logical no-undo.
    define variable hbuffer as handle no-undo. 
    define variable cValue   as character no-undo.
    
    CREATE BUFFER hbuffer FOR TABLE "DICTDB._tenant".
    lok = hbuffer:find-unique ("where _tenant._Tenant-name = " + quoter(pcTenant)) no-error.
    if lok then 
        cValue = hBuffer::_tenant-name.
    
    delete object hbuffer.    
    return cValue.
end function. 

function validateTenantName returns logical(ctenant as char):
    define variable lok as logical no-undo.
    if cTenant = "" then
    do:
        MESSAGE "Please specify which Tenant to dump data for."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false. 
    end.
    if getTenantName(cTenant) = "" then 
    do:
        MESSAGE "There is no Tenant with name " +  ctenant + " in the database."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false.
    end.
    return true.
end function. 

/*=============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame export-stuff
   or CHOOSE of btn_Help in frame export-stuff DO:
   IF user_env[2]:SELECTION-TEXT <> "" OR user_env[3]:SELECTION-TEXT <> "" THEN 
   DO:
     IF user_env[2]:SELECTION-TEXT <> "" THEN
       RUN "adecomm/_kwhelp.p" (INPUT user_env[2]:HANDLE,
                                INPUT "admn",
                                INPUT {&Export_Stuff_Dlg_Box}).
     IF user_env[3]:SELECTION-TEXT <> "" THEN
       RUN "adecomm/_kwhelp.p" (INPUT user_env[3]:HANDLE,
                                INPUT "admn",
                                INPUT {&Export_Stuff_Dlg_Box}).
   END.
   ELSE  
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                    INPUT {&Export_Stuff_Dlg_Box},
                                                 INPUT ?).
END.

on HELP of frame export-ascii
   or CHOOSE of btn_Help in frame export-ascii
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Output_Record_Dlg_Box},
                                               INPUT ?).
&ENDIF


/*----- ON GO or OK -----*/
ON GO OF FRAME export-stuff
DO:
  run Validate_Frame (user_env[4]:HANDLE IN FRAME export-stuff,
                      dis_trigs:HANDLE IN FRAME export-stuff,
                      gTenant:handle in frame export-stuff).
  if RETURN-VALUE = "error" THEN
     RETURN NO-APPLY.
END.

ON WINDOW-CLOSE OF FRAME export-stuff
   APPLY "END-ERROR" TO FRAME export-stuff.
ON WINDOW-CLOSE OF FRAME export-ascii
   APPLY "END-ERROR" TO FRAME export-ascii.

/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame export-stuff DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[4]:handle in frame export-stuff /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.

on choose of btnTenant in frame export-stuff
do:
     selectTenant(gTenant:handle in frame export-stuff).
end.    

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[4] in frame export-stuff
   user_env[4]:screen-value in frame export-stuff = 
        TRIM(user_env[4]:screen-value in frame export-stuff).

ON LEAVE OF user_env[11] IN FRAME export-ascii DO:
    IF user_env[11]:SCREEN-VALUE = "~"" OR user_env[11]:SCREEN-VALUE = "~'" THEN DO:
        MESSAGE "Quote marks cannot be used as separators."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RETURN NO-APPLY.
    END.
END.

ON GO OF FRAME export-ascii DO:
    IF user_env[10]:SCREEN-VALUE = user_env[11]:SCREEN-VALUE THEN DO:
        MESSAGE "You can not use the same character for delimiter and separator."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        APPLY "ENTRY" TO user_env[10] IN FRAME export-ascii.
        RETURN NO-APPLY.
    END.
END.

/*----- WHERE-Clause and BY-Clause radio-sets ------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
ON VALUE-CHANGED OF anywhere IN FRAME export-stuff DO:
   IF anywhere:SCREEN-VALUE = "no" THEN DO:
        user_env[2]:SENSITIVE = FALSE.
        user_env[2]:SCREEN-VALUE = "".
   END.
   ELSE DO:
        user_env[2]:SENSITIVE = TRUE.
        user_env[2]:SCREEN-VALUE = "WHERE ".
        dummyl = user_env[2]:MOVE-AFTER-TAB-ITEM(anywhere:HANDLE).
        user_env[2]:CURSOR-OFFSET = 7.
        APPLY "ENTRY" TO user_env[2].
   END.
END.
ON VALUE-CHANGED OF anysort IN FRAME export-stuff DO:
   IF anysort:SCREEN-VALUE = "no" THEN DO:
        user_env[3]:SENSITIVE = FALSE.
        user_env[3]:SCREEN-VALUE = "".
   END.
   ELSE DO:
        user_env[3]:SENSITIVE = TRUE.
        user_env[3]:SCREEN-VALUE = "BY ".
        dummyl = user_env[3]:MOVE-AFTER-TAB-ITEM(anysort:HANDLE).
        user_env[3]:CURSOR-OFFSET = 4.
        APPLY "ENTRY" TO user_env[3].
   END.
END.

&ENDIF

/*==========================Mainline code================================*/

FIND _File WHERE _Db-recid = drec_db AND _File-name = user_env[1]
             AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ).

IF NOT CAN-DO(_File._Can-read,USERID(user_dbname)) THEN DO:
  MESSAGE new_lang[3] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path =  "".
  RETURN.
END.

if int(dbversion("dictdb")) > 10 then
do:
   isSuperTenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
   if isSuperTenant and _File._file-attributes[1] then
      isMultiTenant = true. 
end.
 
ASSIGN
  typ          = user_env[9]
  user_env[ 2] = ""
  user_env[ 3] = ""
  user_env[ 6] = ""
  user_env[ 7] = ?
  user_env[ 8] = "n"
  user_env[ 9] = CAPS(typ)
  user_env[13] = "".

{adecomm/okrun.i  
      &FRAME  = "FRAME export-stuff" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
}
IF typ = "ascii" THEN DO:
  {adecomm/okrun.i  
      &FRAME  = "FRAME export-ascii" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
  }
END.

DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:

  CASE typ:
        WHEN "dif" THEN
            user_env[4] = user_env[1] + ".dif".
        WHEN "sylk" THEN
            user_env[4] = user_env[1] + ".slk".
        WHEN "ascii" THEN
            user_env[ 4] = user_env[1] + ".txt".
        WHEN "ws" THEN
          ASSIGN
            user_env[ 4] = user_env[1] + ".dat"
            user_env[ 9] = "WORDSTAR"
            user_env[10] = "~""
            user_env[11] = ","
            user_env[12] = "~~015~~012".
        WHEN "word" THEN
          ASSIGN
            user_env[ 4] = user_env[1] + ".doc"
            user_env[ 8] = "y"
            user_env[ 9] = "MICROSOFT WORD"
            user_env[10] = ""     /* was: "~"" */
            user_env[11] = CHR(9) /* was: ","  */
            user_env[12] = "~~015~~012".
        WHEN "wperf" THEN
          ASSIGN
            user_env[ 4] = user_env[1] + ".dat"
            user_env[ 9] = "WORDPERFECT"
            user_env[10] = ""
            user_env[11] = "~~022~~015~~012"  /* ctrl-R cr lf */
            user_env[12] = "~~005~~015~~012". /* ctrl-E cr lf */
        WHEN "ofisw" THEN
          ASSIGN
            user_env[ 4] = user_env[1] + ".dat"
            user_env[ 9] = "OFISWRITER"
            user_env[10] = ""
            user_env[11] = "|"    /* field sep */
            user_env[12] = "~~012" /* end-of-line */
            user_env[13] = "*".   /* record marker */
  END CASE.        
  if not isMultiTenant then
  do:
      gTenant:hidden in frame export-stuff = true. 
      cTenantlabel:hidden in frame export-stuff = true. 
      
      btnTenant:hidden in frame export-stuff = true.  
      
      run adjustframe(FRAME export-stuff:handle).
  end.    
  else do:
      display cTenantlabel with frame export-stuff.
      gTenant = get-effective-tenant-name("dictdb").
  end.
 

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  
  
  UPDATE
    gTenant when isMultiTenant 
    btnTenant when isMultiTenant
    user_env[4] btn_File
    allorsome
    anywhere
    anysort
    dis_trigs
    btn_OK btn_Cancel {&HLP_BTN_NAME}
    WITH FRAME export-stuff.
  IF anywhere THEN 
     user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME export-stuff.
  IF anysort THEN 
     user_env[3] = user_env[3]:SCREEN-VALUE IN FRAME export-stuff.
&ELSE
  UPDATE
    gTenant when isMultiTenant 
    btnTenant when isMultiTenant
    user_env[4] 
    btn_File
    user_env[2]
    user_env[3]
    allorsome
    dis_trigs
    btn_OK btn_Cancel {&HLP_BTN_NAME}
    WITH FRAME export-stuff.
&ENDIF
  IF typ = "ascii" 
  THEN DO:
    ASSIGN
      user_env[13] = ""
      /* Use 012 on all opsys, currently bug in quoter with 015,012 */
      /* Our dump and reload works fine on DOS and OS2 with just 012. */
      /*
      user_env[12] = (IF CAN-DO("MSDOS,OS2",OPSYS) THEN "~~015~~012" ELSE "~~012")
      */
      user_env[12] = "~~012"
      user_env[10] = "~""
      user_env[11] = ",".

    UPDATE
    
      user_env[13] /*line starter*/
      user_env[12] /*line term*/
      user_env[10] /*quoting char*/
      user_env[11] /*field delimiter*/
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME export-ascii.
      
  END.
  canned = FALSE.
END.

IF canned THEN DO:
  user_path = "".
  HIDE FRAME export-stuff NO-PAUSE.
  HIDE FRAME export-ascii NO-PAUSE.
  RETURN.
  END.


&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
IF NOT anywhere THEN user_env[2] = "".
IF NOT anysort THEN user_env[3] = "".
&ELSE
IF TRIM(user_env[2]) = "all" THEN user_env[2] = "".
IF user_env[2] <> "" AND NOT (user_env[2] BEGINS "WHERE ") THEN 
        user_env[2] = "WHERE " + user_env[2]. /*qual*/
IF user_env[3] <> "" AND NOT (user_env[3] BEGINS "BY ") THEN 
        user_env[3] = "BY " + user_env[3].    /*sort*/
&ENDIF
user_env[14] = (if dis_trigs then "y" else "n").

IF allorsome THEN DO:
  FOR EACH _Field OF _File WHERE _Field._Extent = 0 
                             AND _Field._Data-type <> "BLOB" 
                             AND _Field._Data-type <> "CLOB"
                             AND _Field._Data-type <> "XLOB"
                              BY _Field._Order:
    ASSIGN
      i           = i + 1
      user_env[6] = user_env[6]
                  + (IF i = 1 THEN "" ELSE ",")
                  + _Field._Field-name.
    IF i = 255 THEN LEAVE.
  END.
  user_env[5] = STRING(i).
END.
ELSE DO:
  ASSIGN
    pik_column = 25
    pik_row    = 4
    pik_hide   = TRUE
    pik_init   = ""
    pik_wide   = FALSE
    pik_count  = 0
    pik_list   = ""
    pik_multi  = TRUE
    pik_number = TRUE
    pik_title  = new_lang[1] + " " + user_env[9] + " " + new_lang[2].
  FOR EACH _Field OF _File WHERE _Field._Extent = 0
                             AND _Field._Data-type <> "BLOB" 
                             AND _Field._Data-type <> "CLOB"
                             AND _Field._Data-type <> "XLOB"
                             BY _Field._Order:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = _Field._Field-name.
  END.
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN "prodict/user/_usrpick.p".
  &ELSE
    pik_help = {&Fields_For_Export_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF
  pik_return = MINIMUM(pik_return,255).
  DO i = 1 TO pik_return:
    user_env[6] = user_env[6]
                + (IF i = 1 THEN "" ELSE ",")
                + pik_list[pik_chosen[i]].
  END.
  user_env[5] = STRING(pik_return).
END.

IF user_env[6] = "" THEN user_path = "".

 
if isMultiTenant then 
    set-effective-tenant(gTenant,"dictdb").

{ prodict/dictnext.i upath }


     
HIDE FRAME export-stuff NO-PAUSE.
HIDE FRAME export-ascii NO-PAUSE.
RETURN.


/*==========================Internal Procedures=========================*/
/* this is really adjust frame after hide  of tenant */ 
procedure adjustFrame:      
    define input  parameter pframe  as handle no-undo.
    define variable hWidget  as handle no-undo.
    define variable deAdjust as decimal no-undo.
    
    deAdjust = if session:window-system = "TTY" then 1 else 1.8. 
    hwidget = pframe:first-child.
    hwidget = hwidget:first-child.
    do while valid-handle(hwidget):
        if hwidget:hidden = false then
           hwidget:row = hwidget:row - deAdjust.
        hwidget= hwidget:next-sibling.
    end.   
    pframe:scrollable = false. 
    pframe:height = pframe:height - deAdjust. 
end.    
 
/*----------------------------------------------------------
   Do frame validation when user hits OK or GO.

   Input Parameter: 
      p_file    = name of file to export to
      p_disable = disable trigger widget (yes or no)

   Returns: "error" or "".
----------------------------------------------------------*/
PROCEDURE Validate_Frame:
   DEFINE INPUT PARAMETER p_file    AS WIDGET-HANDLE NO-UNDO.
   DEFINE INPUT PARAMETER p_disable AS WIDGET-HANDLE NO-UNDO.
   DEFINE INPUT PARAMETER p_tenant  AS WIDGET-HANDLE NO-UNDO.
   DEFINE VARIABLE        ok        AS LOGICAL       NO-UNDO.
   DEFINE VARIABLE        tmpfile   AS CHARACTER     NO-UNDO.
   
   if isMultiTenant then 
   do:
       if not validateTenantName(p_tenant:screen-value) then
       do:
           apply "entry" to p_tenant.
           return "error".
       end.        
   end.    
   
   /* See if user has permission to import with triggers
      disabled.  If not, ask if he wants to continue
      anyway.
   */
   IF p_disable:SCREEN-VALUE = "yes" THEN
   DO:
      /*{prodict/dump/ltrigchk.i &OK = ok}*/
      Define var trig_found as logical NO-UNDO.

      trig_found = no.
      find _File-trig of _File where _File-trig._Event = "FIND" NO-ERROR.
      if AVAILABLE _File-trig then
        trig_found = yes.

      if trig_found then
         ok = CAN-DO(_File._Can-Load,USERID(user_dbname)).
      else
         ok = yes.
      IF NOT ok THEN DO:
         MESSAGE "You do not have permission to export" SKIP 
                 "with triggers disabled."
                 VIEW-AS ALERT-BOX ERROR BUTTON OK.
         p_disable:SCREEN-VALUE = "no".
         RETURN "error".
      END.
   END.

  IF SEARCH(p_file:SCREEN-VALUE) <> ? THEN DO:
    ok = false.
    MESSAGE new_lang[4] SKIP p_file:SCREEN-VALUE SKIP(1)  new_lang[5] 
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE ok.
    IF NOT ok THEN DO:
      APPLY "ENTRY" TO p_file.
      RETURN "error".
    END.
  END.
  /* gfs: check to see if what was entered compiles */
  IF user_env[2]:SCREEN-VALUE IN FRAME export-stuff <> "" OR
     user_env[3]:SCREEN-VALUE IN FRAME export-stuff <> "" THEN
  DO:
     RUN "adecomm/_tmpfile.p"(INPUT "", INPUT ".adm", OUTPUT tmpfile).
     OUTPUT TO VALUE(tmpfile) NO-MAP.
        PUT UNFORMATTED
           "OUTPUT TO " user_env[4] "." SKIP
           "FOR EACH " LDBNAME("DICTDB") "." user_env[1] " "
                        user_env[2]:SCREEN-VALUE " "
                        user_env[3]:SCREEN-VALUE ":" SKIP
           "END." SKIP
           "OUTPUT CLOSE.".
     OUTPUT CLOSE.
     COMPILE VALUE(tmpfile) NO-ERROR.
     IF COMPILER:ERROR THEN
     DO:
       MESSAGE "The syntax entered for WHERE and/or BY is invalid." CHR(10)
               "Re-check the syntax you entered." VIEW-AS ALERT-BOX
               ERROR BUTTONS OK.
       IF user_env[2]:SCREEN-VALUE <> "" THEN APPLY "ENTRY" TO user_env[2].
       ELSE APPLY "ENTRY" TO user_env[3].
       OS-DELETE VALUE(tmpfile).
       RETURN "ERROR".
     END. 
     OS-DELETE VALUE(tmpfile).
     RETURN "".
  END.
  
END.

/***********************************************************************
* Copyright (C) 2000,2006,2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/


/* This doesn't compile on Windows, but we don't need it there so
   just ifdef the whole thing out.
*/
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN


/* _usrfchg.p - calls the field editors, which are based on userfchg.i 


   Modified: 06/18/98 D. McMann changed DTYPE_RAW from 6 to 8
             07/14/98 D. McMann Added _Owner to _File finds
             08/03/99 Mario B. reset cursor keyes on stop. Bug# 98-12-04-003
             02/04/03 D. McMann Added support for LOB 
             07/28/03 D. McMann More support for Clobs
             04/09/08 fernando  Datetime support for ORACLE
 */
/*
To make this program visually more appealing, multiple frame
definitions are used and switched between.  This way, if you have short
field names, more are listed on the screen at a time.  This causes some
rather convoluted logic for display/update, since depending on the size
of the data, the ch6, ch4 or ch2 frame must be selected.
*/

{ prodict/user/uservar.i }
{ prodict/dictvar.i }

DEFINE VARIABLE alfa-ord AS LOGICAL INITIAL  TRUE NO-UNDO.
DEFINE VARIABLE answer   AS LOGICAL               NO-UNDO.
DEFINE VARIABLE c        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE can-add  AS LOGICAL               NO-UNDO.
DEFINE VARIABLE can-copy AS LOGICAL               NO-UNDO.
DEFINE VARIABLE glob     AS CHARACTER EXTENT 0512 NO-UNDO.
DEFINE VARIABLE glob#    AS INTEGER               NO-UNDO.
DEFINE VARIABLE gobrowse AS INTEGER               NO-UNDO.
DEFINE VARIABLE hint     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE i        AS INTEGER               NO-UNDO.
DEFINE VARIABLE inbrowse AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE inindex  AS LOGICAL               NO-UNDO. /* idx part */
DEFINE VARIABLE intrans  AS LOGICAL               NO-UNDO.
DEFINE VARIABLE inview   AS LOGICAL               NO-UNDO. /* view part */
DEFINE VARIABLE j        AS INTEGER               NO-UNDO.
DEFINE VARIABLE namxx    AS CHARACTER EXTENT    6 
      	       	     	      	      CASE-SENS   NO-UNDO.
DEFINE VARIABLE odbtyp   AS CHARACTER             NO-UNDO. /* list of ODBC-types */
DEFINE VARIABLE qbf#     AS INTEGER   INITIAL   1 NO-UNDO.
DEFINE VARIABLE recache  AS LOGICAL               NO-UNDO.
DEFINE VARIABLE redraw   AS LOGICAL               NO-UNDO.
DEFINE VARIABLE romode   AS LOGICAL               NO-UNDO.
DEFINE VARIABLE rsave    AS RECID     INITIAL   ? NO-UNDO.
DEFINE VARIABLE xc       AS INTEGER               NO-UNDO. /* column-num */
DEFINE VARIABLE xd       AS INTEGER               NO-UNDO. /* frame-down */
DEFINE VARIABLE xl       AS INTEGER   INITIAL   0 NO-UNDO. /* line-num */
DEFINE VARIABLE xm       AS INTEGER   INITIAL   0 NO-UNDO. /* max-length */
DEFINE VARIABLE xr       AS INTEGER   INITIAL   0 NO-UNDO. /* row-num */
DEFINE VARIABLE xs       AS INTEGER               NO-UNDO. /* size-switch */
DEFINE VARIABLE oldname  AS CHAR      CASE-SENS   NO-UNDO. 
DEFINE VARIABLE newname  AS CHAR      CASE-SENS   NO-UNDO.
DEFINE VARIABLE oldtype  AS CHAR                  NO-UNDO. 
DEFINE VARIABLE newtype  AS CHAR                  NO-UNDO.
DEFINE VARIABLE dtype    AS INTEGER               NO-UNDO. /* data type code# */
DEFINE VARIABLE syntax   AS LOGICAL INITIAL yes   NO-UNDO. /* for triggers */

DEFINE NEW SHARED BUFFER dfields FOR _Field.

/* Symbolic constants for dtype values. These match the underlying dtype
   value. */
&global-define 	  DTYPE_CHARACTER   1
&global-define 	  DTYPE_DATE  	    2
&global-define 	  DTYPE_LOGICAL     3
&global-define 	  DTYPE_INTEGER	    4
&global-define 	  DTYPE_DECIMAL	    5
&global-define 	  DTYPE_RAW   	    8
&global-define 	  DTYPE_RECID 	    7
&global-define 	  DTYPE_BLOB 	    18
&global-define 	  DTYPE_CLOB 	    19
&global-define 	  DTYPE_XLOB       20 
&global-define 	  DTYPE_DATETM     34
&global-define 	  DTYPE_DATETMTZ   40


xd = SCREEN-LINES - 8.

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 28 NO-UNDO INITIAL [
  /* 1*/ "This field is used in a View - cannot delete.",
  /* 2*/ "This field is used in an Index - cannot delete.",
  /* 3*/ "Are you sure that you want to delete the field named",
  /* 4*/ "This is a {&PRO_DISPLAY_NAME}/SQL table.  Use ALTER TABLE/DROP COLUMN.",
  /* 5*/ "This is a {&PRO_DISPLAY_NAME}/SQL table.  Use ALTER TABLE/ADD COLUMN.",
  /* 6*/ ?, /* see below */
  /* 7*/ "You can only use Copy on native {&PRO_DISPLAY_NAME} tables.",
  /* 8*/ "Reserved for future expansion.",
  /* 9*/ "You have reached the last field in the table.",
  /*10*/ "You have reached the first field in the table.",
  /*11*/ "This operation is not supported on this table type.",
  /*12*/ "The dictionary is in read-only mode - alterations not allowed.",
  /*13*/ "The field name you supplied is not a legal {&PRO_DISPLAY_NAME} identifier.",
  /*14*/ "Currently Defined Fields",
  /*15*/ "Total Fields",
  /*16*/ "You cannot add fields here for this type of table definition.",
  /*17*/ "You do not have permission to use this option.",
  /*18*/ "There are no fields defined for this table yet.",
  /*19*/ "You haven't yet made changes that need to be undone!",
  /*20*/ "Field added successfully.  You may now add another field.",
  /*21*/ "The field list will be redrawn when you are done adding fields.",
  /*22*/ "Use the cursor-motion keys to select a field, or type its name",
  /*23*/ "This table definition is FROZEN.  No changes allowed.",
  /*24*/ "There are more than 512 fields.  Only 512 will be shown.",
  /*25*/ "Fields are now shown", /* goes with 26 and 27 */
  /*26*/ "alphabetically.",
  /*27*/ "by Order number.",
  /*28*/ "This is a {&PRO_DISPLAY_NAME}/SQL92 table cannot be modified."
].

new_lang[6] = "Are you sure that you want to undo all changes since the "
            + "Field Editor was started?".

/* 
   ********NOTE********
   If this array changes search for QBF_CHANGE to find unobvious
   places that need updating.
   ********************
*/
DEFINE VARIABLE qbf AS CHARACTER EXTENT 15 NO-UNDO INITIAL [
  "NextPage", "PrevPage", "Add",          "Modify",  "Delete",     "Copy", 
  "Triggers", "View-As",  "StringAttrs", "GoIndex", "SwitchTable","Browse", 
  "Order",    "Undo", 	  "Exit"
].

&global-define  NEXT 	   1
&global-define  PREV 	   2
&global-define  ADD	       3
&global-define  MODIFY	   4
&global-define  DELETE	   5
&global-define  COPY 	   6
&global-define  TRIGS	   7
&global-define  VIEWAS	   8
&global-define  STRINGATTR 9
&global-define  GOINDEX	   10
&global-define  SWITCH	   11 
&global-define  BROWSE	   12
&global-define  ORDER	   13
&global-define  UNDO	   14
&global-define  EXIT	   15

&global-define  UP	       16
&global-define  DOWN 	   17
&global-define  TYPEDNAM   18


FORM
  qbf[ 1] /*NextPage*/    FORMAT "x(08)" AT 2
    HELP "See the next page of fields."
  qbf[ 2] /*PrevPage*/    FORMAT "x(08)" AT 15
    HELP "See the previous page of fields."
  qbf[ 3] /*Add*/         FORMAT "x(03)" AT 25
    HELP "Add a new field."
  qbf[ 4] /*Modify*/      FORMAT "x(06)" AT 38
    HELP "Update or Rename a field."
  qbf[ 5] /*Delete*/      FORMAT "x(06)" AT 46
    HELP "Remove a field."
  qbf[ 6] /*Copy*/        FORMAT "x(04)" AT 54
    HELP "Copy fields from another table definition." 
  qbf[ 7] /*Triggers*/    FORMAT "x(08)" AT 60
    HELP "Define or modify triggers." 
  qbf[ 8] /*View-As*/     FORMAT "x(07)" AT 70
    HELP "Add or Update a VIEW-AS phrase for this field." SKIP

  qbf[ 9] /*StringAttrs*/ FORMAT "x(11)" AT 2
    HELP "Edit String Attributes for Label and Other Fields"
  qbf[10] /*GoIndex*/     FORMAT "x(07)" AT 15
    HELP "Go to the Index Editor."
  qbf[11] /*SwitchTable*/ FORMAT "x(11)" AT 25
    HELP "Switch to a different table."
  qbf[12] /*Browse*/      FORMAT "x(06)" AT 38
    HELP "Browse through field definitions for this table."
  qbf[13] /*Order*/       FORMAT "x(05)" AT 46
    HELP "Show fields in alpha or ~"order~" order."
  qbf[14] /*Undo*/        FORMAT "x(04)" AT 54
    HELP "Undo this session's changes to the field structures."
  qbf[15] /*Exit*/        FORMAT "x(04)" AT 60
    HELP "Exit Field Editor."
  HEADER ""  
  WITH FRAME qbf ATTR-SPACE NO-LABELS NO-BOX
  WIDTH 80 CENTERED 
  ROW SCREEN-LINES - 5.


/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/* FORMS START */ /*-------------------------------------------------------*/

FORM
  namxx[1] FORMAT "x(12)" ATTR-SPACE SPACE(0)
  namxx[2] FORMAT "x(12)"
  namxx[3] FORMAT "x(12)" ATTR-SPACE SPACE(0)
  namxx[4] FORMAT "x(12)"
  namxx[5] FORMAT "x(12)" ATTR-SPACE SPACE(0)
  namxx[6] FORMAT "x(12)"
  WITH FRAME ch6 WIDTH 80 NO-LABELS NO-ATTR-SPACE NO-BOX
  ROW 3 COLUMN 1 xd DOWN USE-TEXT.

FORM
  namxx[1] FORMAT "x(18)" ATTR-SPACE SPACE(0)
  namxx[2] FORMAT "x(18)"
  namxx[3] FORMAT "x(18)" ATTR-SPACE SPACE(0)
  namxx[4] FORMAT "x(18)"
  WITH FRAME ch4 WIDTH 80 NO-LABELS NO-ATTR-SPACE NO-BOX
  ROW 3 COLUMN 1 xd DOWN USE-TEXT.

FORM SPACE
  namxx[1] FORMAT "x(32)" SPACE(2)
  namxx[2] FORMAT "x(32)"
  WITH FRAME ch2 WIDTH 80 NO-LABELS ATTR-SPACE NO-BOX
  ROW 3 COLUMN 1 xd DOWN USE-TEXT.

FORM
  c FORMAT "x(80)" SKIP
  WITH FRAME shadow1 NO-BOX NO-LABELS NO-ATTR-SPACE WIDTH 80 
  ROW 2 COLUMN 1 USE-TEXT.

FORM
  c FORMAT "x(80)" SKIP
  WITH FRAME shadow2 NO-BOX NO-LABELS NO-ATTR-SPACE WIDTH 80 
  ROW SCREEN-LINES - 2 COLUMN 1 USE-TEXT.  


/* FORMS END */ /*---------------------------------------------------------*/

FIND _File "_Field" WHERE _File._Owner = "PUB" NO-LOCK.
IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
  MESSAGE new_lang[17] VIEW-AS ALERT-BOX ERROR BUTTONS OK. /* no permission */
  user_path = "".
  RETURN.
END.
ASSIGN
  alfa-ord    = (IF     user_env[19] = "alpha" THEN TRUE
                ELSE IF user_env[19] = "order" THEN FALSE ELSE alfa-ord)
  romode      = NOT CAN-DO(_Can-write,USERID("DICTDB"))
  odbtyp      = {adecomm/ds_type.i
                  &direction = "ODBC"
                  &from-type = "odbtyp"
                  }.

FIND _File WHERE RECID(_File) = drec_file.

qbf_block:
DO FOR dfields TRANSACTION ON ERROR UNDO,RETRY:

  { prodict/dictgate.i &action=query &dbtype=user_dbtype &dbrec=? &output=c }
  FIND FIRST dfields OF _File NO-ERROR.
  ASSIGN
    can-add  = INDEX(ENTRY(2,c),"n") > 0
    can-copy = INDEX(ENTRY(2,c),"c") > 0
    xs       = 0 /* initially, must be <>2 and <>4 and <>6 */
    i        = LENGTH(new_lang[14])
    c        = FILL("-",INTEGER(39.0 - i / 2)) + " " + new_lang[14] + " "
             + FILL("-",INTEGER(38.5 - i / 2))
    redraw   = TRUE
    recache  = TRUE
    intrans  = FALSE.
  
  /* Allow add and copy of fields if database is ODBC and file type BUFFER */
  /****** 
    (los 1/3/95) comment out for now - until 7.4. The field editor for
    odbc type databases (_odb_fld.p) was never set up for adding and it
    doesn't work. The user will get stuck right away when they try to enter
    a data type. It was decided that for 7.3, user's could create the
    table (actually view) in the sybase database and then suck it in.
    Rather than allowing add and then having it not work in an obvious way,
    we won't let them add at all.  In 7.4 it should be fixed.
*/
  IF CAN-DO(odbtyp, user_dbtype) AND 
     _File._For-Owner = ?        AND
     _File._For-Name  = "NONAME" AND
     _File._For-Type  = "BUFFER" THEN
        ASSIGN can-add  = yes
               can-copy = yes.
  /******/
               
  /*PAUSE 0.*/
  DISPLAY c WITH FRAME shadow1.
  DISPLAY qbf WITH FRAME qbf.

  qbf_loop:
  DO WHILE TRUE ON ERROR UNDO,RETRY:

    IF recache THEN DO:
      ASSIGN
        redraw  = TRUE
        recache = FALSE
        xm      = 0
        glob    = ""
        glob#   = 0.

      IF alfa-ord THEN
      	get_fields_alpha:
        FOR EACH _Field OF _File BY _Field._Field-name:
      	  IF glob# = 512 THEN DO:
      	     MESSAGE new_lang[24].
      	     LEAVE get_fields_alpha.
      	  END.
          ASSIGN
            glob#       = glob# + 1
            glob[glob#] = _Field._Field-name
            xm          = MAXIMUM(xm,LENGTH(_Field._Field-name)).
        END.
      ELSE
      	get_fields_order:
        FOR EACH _Field OF _File BY _Field._Order:
      	  IF glob# = 512 THEN DO:
      	     MESSAGE new_lang[24].
      	     LEAVE get_fields_order.
      	  END.
          ASSIGN
            glob#       = glob# + 1
            glob[glob#] = _Field._Field-name
            xm          = MAXIMUM(xm,LENGTH(_Field._Field-name)).
        END.
    END.

    IF redraw THEN DO:
      ASSIGN
        i  = xs
        xs = (IF xm <= 12 THEN 6 ELSE IF xm <= 18 THEN 4 ELSE 2)
        c  = FILL("-",78 - LENGTH(new_lang[15] + STRING(glob#)))
           + new_lang[15] + ": " + STRING(glob#).
      IF i <> xs THEN xl = 0. /* if switch frames, reset page number to top */
      DISPLAY c WITH FRAME shadow2.

      IF i = xs THEN .
      ELSE IF i  = 2 THEN CLEAR FRAME ch2 ALL NO-PAUSE.
      ELSE IF i  = 4 THEN CLEAR FRAME ch4 ALL NO-PAUSE.
      ELSE IF i  = 6 THEN CLEAR FRAME ch6 ALL NO-PAUSE.

      IF i = xs THEN .
      ELSE IF i  = 2 THEN HIDE  FRAME ch2     NO-PAUSE.
      ELSE IF i  = 4 THEN HIDE  FRAME ch4     NO-PAUSE.
      ELSE IF i  = 6 THEN HIDE  FRAME ch6     NO-PAUSE.

      IF      xs = 2 THEN VIEW  FRAME ch2.
      ELSE IF xs = 4 THEN VIEW  FRAME ch4.
      ELSE IF xs = 6 THEN VIEW  FRAME ch6.

      IF      xs = 2 THEN UP MAXIMUM(0,FRAME-LINE(ch2) - 1) WITH FRAME ch2.
      ELSE IF xs = 4 THEN UP MAXIMUM(0,FRAME-LINE(ch4) - 1) WITH FRAME ch4.
      ELSE IF xs = 6 THEN UP MAXIMUM(0,FRAME-LINE(ch6) - 1) WITH FRAME ch6.

      ASSIGN
        redraw = FALSE
        xl     = (IF xd * xs > glob# OR xl < 0 THEN 0
                 ELSE MINIMUM(xl,TRUNCATE(glob# / xs,0) * xs))
        j      = xl + 1.
      DO i = 1 TO xd:
        ASSIGN
          namxx[1] = (IF j < 513 THEN glob[j    ] ELSE "")
          namxx[2] = (IF j < 512 THEN glob[j + 1] ELSE "")
          namxx[3] = (IF j < 511 THEN glob[j + 2] ELSE "")
      	  namxx[4] = (IF j < 510 THEN glob[j + 3] ELSE "")
      	  namxx[5] = (IF j < 509 THEN glob[j + 4] ELSE "")
      	  namxx[6] = (IF j < 508 THEN glob[j + 5] ELSE "").

        IF      xs = 6 AND j > glob# THEN CLEAR FRAME ch6 NO-PAUSE.
        ELSE IF xs = 4 AND j > glob# THEN CLEAR FRAME ch4 NO-PAUSE.
        ELSE IF xs = 2 AND j > glob# THEN CLEAR FRAME ch2 NO-PAUSE.
        ELSE IF xs = 6 THEN DISPLAY
          namxx[1] WHEN namxx[1] <> INPUT FRAME ch6 namxx[1]
          namxx[2] WHEN namxx[2] <> INPUT FRAME ch6 namxx[2]
          namxx[3] WHEN namxx[3] <> INPUT FRAME ch6 namxx[3]
          namxx[4] WHEN namxx[4] <> INPUT FRAME ch6 namxx[4]
          namxx[5] WHEN namxx[5] <> INPUT FRAME ch6 namxx[5]
          namxx[6] WHEN namxx[6] <> INPUT FRAME ch6 namxx[6]
          WITH FRAME ch6.  
        ELSE IF xs = 4 THEN DISPLAY
          namxx[1] WHEN namxx[1] <> INPUT FRAME ch4 namxx[1]
          namxx[2] WHEN namxx[2] <> INPUT FRAME ch4 namxx[2]
          namxx[3] WHEN namxx[3] <> INPUT FRAME ch4 namxx[3]
          namxx[4] WHEN namxx[4] <> INPUT FRAME ch4 namxx[4]
          WITH FRAME ch4.
        ELSE DISPLAY
          namxx[1] WHEN namxx[1] <> INPUT FRAME ch2 namxx[1]
          namxx[2] WHEN namxx[2] <> INPUT FRAME ch2 namxx[2]
          WITH FRAME ch2.
        j = j + xs.
        IF i = xd THEN .
        ELSE IF xs = 6 THEN DOWN WITH FRAME ch6.
        ELSE IF xs = 4 THEN DOWN WITH FRAME ch4.
        ELSE                DOWN WITH FRAME ch2.
      END.
    END.

    IF inbrowse THEN DO WHILE TRUE:
      IF      xs = 6 THEN DOWN xr - FRAME-LINE(ch6) WITH FRAME ch6.
      ELSE IF xs = 4 THEN DOWN xr - FRAME-LINE(ch4) WITH FRAME ch4.
      ELSE                DOWN xr - FRAME-LINE(ch2) WITH FRAME ch2.

      IF xs = 6 THEN DO:
        IF INPUT FRAME ch6 namxx[xc] = "" THEN xc = 1.
        COLOR DISPLAY MESSAGES namxx[xc] WITH FRAME ch6.
      END.
      ELSE IF xs = 4 THEN DO:
        IF INPUT FRAME ch4 namxx[xc] = "" THEN xc = 1.
        COLOR DISPLAY MESSAGES namxx[xc] WITH FRAME ch4.
      END.
      ELSE DO:
        IF INPUT FRAME ch2 namxx[xc] = "" THEN xc = 1.
        COLOR DISPLAY MESSAGES namxx[xc] WITH FRAME ch2.
      END.

      READKEY.

      IF      xs = 6 THEN COLOR DISPLAY NORMAL namxx[xc] WITH FRAME ch6.
      ELSE IF xs = 4 THEN COLOR DISPLAY NORMAL namxx[xc] WITH FRAME ch4.
      ELSE                COLOR DISPLAY NORMAL namxx[xc] WITH FRAME ch2.

      qbf# = 0.
      IF KEYFUNCTION(LASTKEY) = "CURSOR-RIGHT"
        AND xl + xr * xs - xs + xc < glob# THEN DO:
        xc = xc + 1.
        IF xc <= xs THEN NEXT.
        ASSIGN xc = 1  qbf# = (IF xr = xd THEN {&NEXT} ELSE {&DOWN}).
      END.
      ELSE IF KEYFUNCTION(LASTKEY) = "CURSOR-LEFT"
        AND xl + xr * xs - xs + xc > 1 THEN DO:
        xc = xc - 1.
        IF xc > 0 THEN NEXT.
        ASSIGN xc = xs  qbf# = (IF xr = 1 THEN {&PREV} ELSE {&UP}).
      END.
      ELSE IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN"   THEN qbf# = {&NEXT}.
      ELSE IF KEYFUNCTION(LASTKEY) = "PAGE-UP"     THEN qbf# = {&PREV}.
      ELSE IF KEYFUNCTION(LASTKEY) = "GET"         THEN qbf# = {&SWITCH}.
      ELSE IF KEYFUNCTION(LASTKEY) = "CURSOR-UP"
              AND xr <> 1                          THEN qbf# = {&UP}.
      ELSE IF KEYFUNCTION(LASTKEY) = "CURSOR-UP"
              AND xr =  1                          THEN qbf# = {&PREV}.
      ELSE IF KEYFUNCTION(LASTKEY) = "CURSOR-DOWN"
              AND xr <> xd                         THEN qbf# = {&DOWN}.
      ELSE IF KEYFUNCTION(LASTKEY) = "CURSOR-DOWN"
              AND xr =  xd                         THEN qbf# = {&NEXT}.
      ELSE IF LASTKEY > 32 AND CHR(LASTKEY) <> ""  THEN ASSIGN
        hint = hint + CHR(LASTKEY)
        qbf# = {&TYPEDNAM}.
      ELSE IF CAN-DO("END-ERROR,RETURN,GO",KEYFUNCTION(LASTKEY)) THEN DO:
        hint = (IF   xs = 6 THEN INPUT FRAME ch6 namxx[xc]
             ELSE IF xs = 4 THEN INPUT FRAME ch4 namxx[xc]
             ELSE                INPUT FRAME ch2 namxx[xc]).
        FIND dfields OF _File WHERE dfields._Field-name = hint.
        ASSIGN
          hint     = ""
          qbf#     = gobrowse
          inbrowse = FALSE.
        DISPLAY qbf[qbf#] WITH FRAME qbf.
        COLOR PROMPT MESSAGES qbf[qbf#] WITH FRAME qbf.
        STATUS DEFAULT.
        IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN NEXT qbf_loop.
      END.
      IF qbf# > 0 THEN LEAVE.
    END.
    ELSE DO:
      ON CURSOR-LEFT BACK-TAB.
      ON CURSOR-RIGHT     TAB.
      _choose:
      DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE
         ON STOP  UNDO,LEAVE:  /* Added ON STOP BUG# 98-12-04-003 */
        IF qbf# < 1 OR qbf# > {&EXIT} THEN qbf# = 1.
        IF qbf# >= 1 AND qbf# <= {&EXIT} THEN
      	  NEXT-PROMPT qbf[qbf#] WITH FRAME qbf.
        CHOOSE FIELD qbf AUTO-RETURN
          GO-ON ("PAGE-UP" "PAGE-DOWN" "PREV-PAGE" "NEXT-PAGE" PF9 PF15)
          WITH FRAME qbf.
        qbf# = FRAME-INDEX.
        IF LASTKEY = -1 OR  
          (KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND CHR(LASTKEY) <> "."
          AND NOT qbf[qbf#] BEGINS CHR(LASTKEY)) THEN UNDO,RETRY _choose. 
      END.
      ON CURSOR-LEFT  CURSOR-LEFT.
      ON CURSOR-RIGHT CURSOR-RIGHT.
      /* Trap CTRL-BREAK (STOP).  BUG# 98-12-04-003 */
      IF LASTKEY = -1 THEN
	 RETURN.

      /* NOTE: When QBF_CHANGEs this must be updated to match it. */
      i = LOOKUP(KEYFUNCTION(LASTKEY),
        "PAGE-DOWN,PAGE-UP,,,,,,,,GET,,,,,END-ERROR").
      IF CHR(LASTKEY) = "." THEN qbf# = {&EXIT}.
      IF i > 0 THEN qbf# = i.

      /* NOTE: When QBF_CHANGEs this might need updating. */
      IF qbf# = {&MODIFY} OR qbf# = {&DELETE} OR 
      	 qbf# = {&BROWSE} OR qbf# = {&TRIGS}  OR
      	 qbf# = {&VIEWAS} OR qbf# = {&STRINGATTR} THEN DO:
        IF NOT CAN-FIND(FIRST dfields OF _File) THEN DO:
          MESSAGE new_lang[18]. /* no fields to play with */ 
          NEXT qbf_loop.
        END.
        DISPLAY CAPS(qbf[qbf#]) @ qbf[qbf#] WITH FRAME qbf.
        COLOR PROMPT NORMAL qbf[qbf#] WITH FRAME qbf.

      	/* Reset qbf# temporarily to flag that we should go pick
      	   a field first. */
        ASSIGN
          gobrowse = qbf#
          inbrowse = ? /* signal start of inbrowse */
          qbf#     = {&TYPEDNAM}
          hint     = (IF AVAILABLE dfields THEN dfields._Field-name ELSE "").
        STATUS DEFAULT new_lang[22]. /* use cursor keys or type name */
      END.
    END.

    HIDE MESSAGE NO-PAUSE.

    ASSIGN
      c = KEYFUNCTION(LASTKEY)
      i = (
      	  /* NOTE: When QBF_CHANGEs this might need updating. */
          IF qbf# < {&ADD} OR qbf# > {&STRINGATTR} THEN 0
          ELSE IF _File._Frozen   THEN 23  /* sorry, frozen */
          ELSE IF dict_rog        THEN 12  /* sorry, dict in r/o mode */
          ELSE IF romode          THEN 17  /* sorry, r/o to you */
          ELSE IF qbf# = {&ADD} AND NOT can-add THEN 16 /* cant add flds  */
          ELSE IF qbf# = {&COPY} AND NOT can-copy THEN 7 /* cant copy flds */
          ELSE IF qbf# = {&ADD} AND _File._Db-lang > 0 THEN 5 /* sql tbl */
          ELSE 0).
    IF i > 0 THEN DO:
      MESSAGE new_lang[i]. 
      NEXT qbf_loop.
    END.

    IF qbf# = {&NEXT} THEN DO:    /*-------------------- start of NEXT-PAGE */
      i = MINIMUM(xl + xs * xd,TRUNCATE((glob# - 1)/ xs,0) * xs).
      IF i < 512 THEN
      ASSIGN  
        xl     = i
        xr     = 1
        redraw = TRUE.
    END.
    /*---------------------------------------------------- end of NEXT-PAGE */
    ELSE
    IF qbf# = {&PREV} THEN ASSIGN /*-------------------- start of PREV-PAGE */
      xl     = MAXIMUM(0,xl - xs * xd)
      redraw = TRUE.
    /*---------------------------------------------------- end of PREV-PAGE */
    ELSE
    IF qbf# = {&ADD} THEN DO: /*------------------------------ start of ADD */
      ASSIGN
        answer = TRUE
        rsave  = ?.
      PAUSE 0.
      DO WHILE answer ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        RELEASE dfields.
        { prodict/user/userfchg.i fld r/w ? answer }
        answer = FALSE.
        IF AVAILABLE dfields THEN DO:
          ASSIGN
            answer  = KEYFUNCTION(LASTKEY) <> "END-ERROR"
            intrans = TRUE
            redraw  = TRUE
            recache = TRUE.
          MESSAGE new_lang[20]. /* fld added, add nxt */
          MESSAGE new_lang[21]. /* redraw deferred */
        END.
      END.
    END. /*----------------------------------------------------- end of ADD */
    ELSE
    IF qbf# = {&MODIFY} THEN DO: /*------------------------ start of MODIFY */
      IF _File._Db-lang > 1 THEN MESSAGE new_lang[28].
      ELSE DO:
        ASSIGN
        i       = dfields._Order
        oldname = dfields._Field-name
        oldtype = dfields._Data-type
        rsave = ?.
        PAUSE 0.
        { prodict/user/userfchg.i fld r/w ? answer }
        ASSIGN
      	  newname = dfields._Field-name
          newtype = dfields._Data-type
          intrans = intrans OR answer
          redraw  = NOT AVAILABLE dfields
                    OR oldname <> newname
                    OR (NOT alfa-ord AND i <> dfields._Order)
                    /* date/datetime change */
                    OR (user_dbtype = "ORACLE" AND oldtype NE newtype)
          recache = redraw.
      END.
    END. /*-------------------------------------------------- end of MODIFY */
    ELSE
    IF qbf# = {&DELETE} THEN DO: /*------------------------ start of DELETE */
      ASSIGN
        rsave   = ?
        inview  = AVAILABLE dfields
                  AND CAN-FIND(FIRST _View-ref WHERE
                  _View-ref._Ref-Table = _File._File-name
                  AND _View-ref._Base-Col = dfields._Field-name)
        inindex = AVAILABLE dfields
                  AND CAN-FIND(FIRST _Index-field WHERE
                  _Index-field._Field-recid = RECID(dfields)).
      IF _File._Db-lang > 0 THEN MESSAGE new_lang[4]. /* sorry sql table */
      ELSE IF inview  THEN MESSAGE new_lang[1]. /* in view  */
      ELSE IF inindex THEN MESSAGE new_lang[2]. /* in index */
      ELSE DO:
        answer = FALSE.
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,
          new_lang[3] + ' "' + dfields._Field-name + '"?'). /*r-u-sure*/
        IF answer THEN DELETE dfields.
        ASSIGN
          redraw  = answer
          recache = answer
          intrans = intrans OR answer.
      END.
    END. /*-------------------------------------------------- end of DELETE */
    ELSE
    IF qbf# = {&COPY} THEN DO: /*---------------------------- start of COPY */
      ASSIGN
        rsave   = ?
        recache = TRUE
        redraw  = TRUE.
      RUN "prodict/user/_usrfcpy.p".
      IF user_env[9] = "yes" THEN intrans = TRUE.
    END. /*---------------------------------------------------- end of COPY */
    ELSE
    IF qbf# = {&TRIGS} THEN DO: /*----------------------- start of TRIGGERS */
      rsave = ?.
      PAUSE 0.
      RUN "prodict/user/_usrftrg.p"
      	 (INPUT (romode OR dict_rog OR _File._Frozen), 
      	  INPUT _File._File-Name, 
      	  INPUT-OUTPUT syntax,
      	  OUTPUT answer).
      IF answer THEN intrans = TRUE.
    END. /*------------------------------------------------ end of TRIGGERS */
    ELSE
    IF qbf# = {&VIEWAS} THEN DO: /*----------------------- start of VIEWAS  */
      rsave = ?.
      PAUSE 0.
      CASE dfields._Data-type:
	    WHEN "Character"   THEN dtype = {&DTYPE_CHARACTER}.
	    WHEN "Date"        THEN dtype = {&DTYPE_DATE}.
	    WHEN "Logical"     THEN dtype = {&DTYPE_LOGICAL}.
	    WHEN "Integer"     THEN dtype = {&DTYPE_INTEGER}.
	    WHEN "Decimal"     THEN dtype = {&DTYPE_DECIMAL}.
	    WHEN "RECID"       THEN dtype = {&DTYPE_RECID}.
        WHEN "BLOB"        THEN dtype = {&DTYPE_BLOB}.
        WHEN "CLOB"        THEN dtype = {&DTYPE_CLOB}.
        WHEN "DateTime"    THEN dtype = {&DTYPE_DATETM}.
        WHEN "DateTime-TZ" THEN dtype = {&DTYPE_DATETMTZ}.
      END.

      IF dfields._Data-type = "BLOB" THEN DO:
        MESSAGE "View-As statements can not be created for Blob Fields."
          VIEW-AS ALERT-BOX ERROR.
      END.
      ELSE IF dfields._Data-type = "CLOB" THEN DO:
        MESSAGE "View-As statements can not be created for Clob Fields."
          VIEW-AS ALERT-BOX ERROR.
      END.
      ELSE DO:
        RUN "adecomm/_viewas.p"
      	 (INPUT (romode OR dict_rog OR _File._Frozen), INPUT dtype,
      	  INPUT dfields._Data-type, INPUT-OUTPUT dfields._View-as, 
      	  OUTPUT answer).
        IF answer THEN intrans = TRUE.
      END.
    END. /*------------------------------------------------ end of VIEWAS   */
    ELSE
    IF qbf# = {&GOINDEX} THEN /*------------------------- start of GO-INDEX */
      user_path =  "_usrichg".
      /* see qbf#={&EXIT} */
    /*----------------------------------------------------- end of GO-INDEX */
    ELSE
    IF qbf# = {&STRINGATTR} THEN DO: /*---------------- start of STRINGATTR */
      rsave = ?.
      PAUSE 0.
      IF dfields._Data-type = "BLOB" THEN DO:
        MESSAGE "String attributes can not be created for Blob Fields."
          VIEW-AS ALERT-BOX ERROR.
      END.
      ELSE IF dfields._Data-type = "CLOB" THEN DO:
        MESSAGE "String attributes can not be created for Clob Fields."
          VIEW-AS ALERT-BOX ERROR.
      END.
      ELSE DO:
        RUN "adecomm/_fldsas.p"
      	 (INPUT (romode OR dict_rog OR _File._Frozen), BUFFER dfields,
      	  OUTPUT answer).
        IF answer THEN intrans = TRUE.
      END.
    END. /*---------------------------------------------- end of STRINGATTR */
    ELSE
    IF qbf# = {&SWITCH} THEN /*----------------------- start of SWITCH-FILE */
      user_path = "1=,_usrtget,_usrfchg".  /* see qbf#={&EXIT} */
    /*-------------------------------------------------- end of SWITCH-FILE */
    ELSE
    IF qbf# = {&BROWSE} THEN DO: /*------------------------ start of BROWSE */
      rsave = ?.
      PAUSE 0.
      { prodict/user/userfchg.i fld r/o ? answer }
      
      IF KEYFUNCTION(LASTKEY) <> "END-ERROR" THEN DO:
        DISPLAY CAPS(qbf[{&BROWSE}]) @ qbf[{&BROWSE}] WITH FRAME qbf.
        COLOR PROMPT NORMAL qbf[{&BROWSE}] WITH FRAME qbf.
        ASSIGN
          gobrowse = {&BROWSE}
          inbrowse = ? /* signal start of inbrowse */
          qbf#     = {&TYPEDNAM}
          hint     = (IF AVAILABLE dfields THEN dfields._Field-name ELSE "").
        STATUS DEFAULT new_lang[22]. /* use cursor keys or type name */
      END.
    END. /*-------------------------------------------------- end of BROWSE */
    ELSE
    IF qbf# = {&ORDER} THEN DO: /*-------------------- start of ALPHA/ORDER */
      ASSIGN
	recache  = TRUE
	redraw   = TRUE
	alfa-ord = NOT alfa-ord.
      message new_lang[25] (IF alfa-ord THEN new_lang[26] ELSE new_lang[27]).
    END.
    /*-------------------------------------------------- end of ALPHA/ORDER */
    ELSE
    IF qbf# = {&UNDO} THEN DO: /*---------------------------- start of UNDO */
      IF intrans THEN DO:
        ASSIGN
          recache = TRUE
          redraw  = TRUE
          answer  = FALSE.
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,INPUT new_lang[6]). /*undo sess?*/
        IF answer THEN UNDO qbf_block,RETRY qbf_block.
      END.
      ELSE
        MESSAGE new_lang[19]. /* what changes? */
    END. /*---------------------------------------------------- end of UNDO */
    /* no ELSE here! */
    IF qbf# = {&GOINDEX} OR qbf# = {&SWITCH} OR
       qbf# = {&EXIT} THEN DO: /*---------------------------- start of EXIT */
      LEAVE qbf_block.
    END. /*---------------------------------------------------- end of EXIT */
    /*--------------------------------------------------------- end of EXIT */
    ELSE
    IF qbf# = {&UP} THEN DO: /*------------------------- start of CURSOR-UP */
      IF xr = 1 AND xl > 0 THEN DO:
        xl = xl - xs.
        IF      xs = 6 THEN SCROLL DOWN WITH FRAME ch6.
        ELSE IF xs = 4 THEN SCROLL DOWN WITH FRAME ch4.
        ELSE IF xs = 2 THEN SCROLL DOWN WITH FRAME ch2.
      END.
      ELSE
      IF xr > 1 THEN xr = xr - 1.
    END. /*----------------------------------------------- end of CURSOR-UP */
    ELSE
    IF qbf# = {&DOWN} THEN DO: /*--------------------- start of CURSOR-DOWN */
      IF xr = xd AND xl + xr * xs + xc <= glob# THEN DO:
        xl = xl + xs.
        IF      xs = 6 THEN SCROLL UP WITH FRAME ch6.
        ELSE IF xs = 4 THEN SCROLL UP WITH FRAME ch4.
        ELSE IF xs = 2 THEN SCROLL UP WITH FRAME ch2.
      END.
      ELSE
      IF xl + xr * xs + xc <= glob# THEN xr = xr + 1.
    END. /*--------------------------------------------- end of CURSOR-DOWN */

    /* no ELSE here! Navigate amongst the field names by typing. */
    IF qbf# = {&TYPEDNAM} THEN DO: /*------------------ start of TYPED-HINT */
      rsave = RECID(dfields).
      FIND FIRST dfields OF _File
        WHERE dfields._Field-name BEGINS hint NO-ERROR.
      IF NOT AVAILABLE dfields AND hint <> "" THEN DO:
        hint = SUBSTRING(hint,LENGTH(hint),1).
        FIND FIRST dfields OF _File
          WHERE dfields._Field-name BEGINS hint NO-ERROR.
      END.
      IF NOT AVAILABLE dfields AND rsave <> ? THEN
        FIND dfields WHERE RECID(dfields) = rsave.
      IF AVAILABLE dfields THEN
        DO i = 1 TO glob# WHILE glob[i] <> dfields._Field-name: END.
      ELSE
        i = 1.
      IF i >= xl + 1 AND i < xl + xd * xs THEN
        ASSIGN
          xr = TRUNCATE((i - xl + xs - 1) / xs,0)
          xc = i - xl - xr * xs + xs.
      ELSE
        ASSIGN
          redraw = TRUE
          xl     = TRUNCATE((i - 1) / xs,0) * xs
          xr     = 1
          xc     = i - xl - xr * xs + xs.
      /* inbrowse = ? means initial pass to set up position */
      IF inbrowse = ? THEN ASSIGN inbrowse = TRUE hint = "".
    END. /*---------------------------------------------- end of TYPED-HINT */

  END. /* loop end */
END. /* scope end */

HIDE FRAME ch2     NO-PAUSE.
HIDE FRAME ch4     NO-PAUSE.
HIDE FRAME ch6     NO-PAUSE.
HIDE FRAME qbf     NO-PAUSE.
HIDE FRAME shadow1 NO-PAUSE.
HIDE FRAME shadow2 NO-PAUSE.

ASSIGN
  dict_dirty   = dict_dirty OR intrans
  user_env[19] = STRING(alfa-ord,"alpha/order").

RETURN.


&ENDIF


/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *                         *
**********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrfcpy.p - Field Update copy subroutine (called from _usrfchg.p) 

   History: D. McMann 07/09/98 Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                               to FIND of _File.
            d> McMann 07/29/03 Added support for BLOBS and CLOBS
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

DEFINE VARIABLE fldExist    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE hold        AS CHARACTER NO-UNDO.
DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
DEFINE VARIABLE maxpos      AS INTEGER   NO-UNDO.
DEFINE VARIABLE new-name    AS CHARACTER NO-UNDO.
DEFINE VARIABLE fldOrder    AS INTEGER   NO-UNDO.
DEFINE VARIABLE canned      AS LOGICAL   NO-UNDO.
DEFINE VARIABLE answer	    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE skip_fld    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE any_copied  AS LOGICAL   NO-UNDO init no.
define variable NoArea      as logical   no-undo.
define variable CopyNoArea  as logical   no-undo.
define variable CopyArea    as logical   no-undo.
define variable Arealist    as character no-undo.
define variable cmsg        as character no-undo.    
 
define variable dataType    as character no-undo.
 
DEFINE BUFFER   copy_fld  FOR _Field.

Define var cmbArea as char NO-UNDO
   view-as COMBO-BOX size 32 by 1.  

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /* 1*/ "Source Tables",
  /* 2*/ "Fields in",
  /* 3*/ "Copying field",
  /* 4*/ "There are no available tables to copy from.",
  /* 5*/ "There are no fields in the requested table.",
  /* 6*/ "Field copying completed.",
  /* 7*/ "Name is still not unique."
].

FORM
  "This field already exists in the destination" SKIP
  "table.  If you still want to copy it, give it" SKIP
  "a unique name.  Otherwise, press" hold FORMAT "x(10)" SKIP
  "and it will be skipped." SKIP(1)
  new-name FORMAT "x(32)" 
  {prodict/user/userbtns.i}
  WITH FRAME rename-me 
  ROW 7 CENTERED NO-LABELS ATTR-SPACE DEFAULT-BUTTON btn_OK
  VIEW-AS DIALOG-BOX.

FORM SKIP(1)
  "To copy fields from another table," SKIP
  "first you will be allowed to"       SKIP
  "select the table.  Then, mark the"  SKIP
  "fields in that table that you want" SKIP
  "to copy using" hold FORMAT "x(20)" SKIP(1)
  WITH FRAME copy-note OVERLAY ROW 4 COLUMN 2 NO-LABELS NO-ATTR-SPACE
       USE-TEXT.

/* Form which allows user to select an area. */
DEFINE FRAME selectarea    
   "You are copying a lob field from a table with no default Area." at 2 skip
   cmsg format "x(60)" view-as text no-label skip(1)
   new-Name format "x(32)" colon 12 label "Field Name" skip
   dataType format "x(11)" colon 12 label "Data Type" skip
   cmbArea  FORMAT "x(32)" colon 12 label "Area" skip
   {prodict/user/userbtns.i}
   WITH 
   ROW 5 CENTERED side-labels ATTR-SPACE DEFAULT-BUTTON btn_OK
   VIEW-AS DIALOG-BOX.
   

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

PAUSE 0.

ASSIGN
  user_env[9] = "no" /* this is the "anything done" flag */
  pik_chosen  = 0
  pik_column  = 38
  pik_count   = 0
  pik_hide    = TRUE
  pik_init    = ""
  pik_list    = ""
  pik_multi   = FALSE
  pik_number  = FALSE
  pik_row     = 4
  pik_title   = new_lang[1] /* Source Tables */
  pik_wide    = FALSE.

EMPTY TEMP-TABLE ttpik NO-ERROR.

FOR EACH _File WHERE _File._Db-recid = drec_db 
                 AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                 AND NOT _File._Hidden
                  BY _File._File-name:

    ASSIGN pik_count = pik_count + 1.

    /* 20060717-022
       if we have too many tables, need to use temp-table, in case there are
       too many fields with the same name.
    */
    IF l_cache_tt THEN DO:
        CREATE ttpik.
        ASSIGN ttpik.i_number = pik_count
               ttpik.c_name = _File._File-name.
        RELEASE ttpik.
    END.
    ELSE
      ASSIGN
        pik_list[pik_count] = _File._File-name.
END.

IF pik_count = 0 THEN DO:
  MESSAGE new_lang[4]. /* ain't no files */
  RETURN.
END.

DISPLAY "[" + KBLABEL("RETURN") + "]." @ hold WITH FRAME copy-note.

RUN "prodict/user/_usrpick.p".
IF pik_return = 0 THEN DO:
  HIDE FRAME copy-note NO-PAUSE.
  RETURN.
END.

EMPTY TEMP-TABLE ttpik NO-ERROR.

FIND _file where recid(_file) = drec_File.
/* we need to know if the TO table requires area in case the FROM does not have one */
NoArea = _file._file-attributes[1] and _file._file-attributes[2] = false.

FIND _File WHERE _File._Db-recid = drec_db 
             AND _File._File-name = pik_first
             AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").

ASSIGN
/* we need to know if the FROM table does not have area in case the TO requires one */
  CopyNoArea = _file._file-attributes[1] and _file._file-attributes[2] = false
  pik_column = 38
  pik_hide   = TRUE
  pik_init   = ""
  pik_row    = 4
  pik_title  = new_lang[2] /* Source Fields of */
             + ' "' + _File._File-name + '"'
  pik_wide   = FALSE
  pik_count  = 0
  pik_list   = ""
  pik_chosen = 0
  pik_multi  = TRUE
  pik_number = FALSE.

FOR EACH _Field OF _File BY _Field._Field-name:
  ASSIGN
    pik_count = pik_count + 1
    pik_list[pik_count] = _Field._Field-name.
END.

IF pik_count = 0 THEN DO:
  MESSAGE new_lang[5]. /* ain't no fields */
  HIDE FRAME copy-note NO-PAUSE.
  RETURN.
END.

RUN "prodict/user/_usrpick.p".
HIDE FRAME copy-note NO-PAUSE.
IF pik_return = 0 THEN RETURN.

FIND LAST copy_fld
  WHERE copy_fld._File-recid = drec_file
  USE-INDEX _Field-Position NO-ERROR.
ASSIGN
  user_env[9] = "yes"
  maxpos      = (IF AVAILABLE copy_fld
                THEN TRUNCATE(copy_fld._Order / 10 + 1,0) * 10
                ELSE 10).

/* Adjust the ok and cancel buttons */
{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME rename-me"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}
 
 /* Adjust the ok and cancel buttons */
{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME selectarea"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}
 
 
_copy:
DO TRANSACTION i = 1 TO pik_return:
  FIND copy_fld OF _File
    WHERE copy_fld._Field-name = pik_list[pik_chosen[i]].
  ASSIGN
    fldOrder  = (IF CAN-FIND(_Field
               WHERE _Field._File-recid = drec_file
                 AND _Field._Order = copy_fld._Order)
               THEN maxpos
               ELSE copy_fld._Order)
    fldExist = CAN-FIND(_Field
               WHERE _Field._File-recid = drec_file
                 AND _Field._Field-name = copy_fld._Field-name)
    new-name = copy_fld._Field-name
    maxpos   = TRUNCATE(MAXIMUM(maxpos,fldOrder) / 10 + 1,0) * 10
    skip_fld = FALSE
    canned   = FALSE
    cmbArea = "" 
    CopyArea = true. 
 
  IF fldExist THEN DO:
    DISPLAY "[" + KBLABEL("CLEAR") + "]" @ hold new-name WITH FRAME rename-me.

    /*----- ON CLEAR (SKIP) -----*/
    ON "CLEAR" OF new-name IN FRAME rename-me DO:
      DISPLAY ? @ new-name WITH FRAME rename-me.
      skip_fld = TRUE.
      APPLY "GO" TO FRAME rename-me.
    END.
  
    /*-----GO OF RENAME FRAME -----*/
    ON GO OF FRAME rename-me DO:
      DEFINE VAR nname AS CHAR NO-UNDO.

      if skip_fld THEN 
      	 RETURN.

      nname = new-name:SCREEN-VALUE IN FRAME rename-me.
      RUN "adecomm/_valname.p" (INPUT nname, INPUT no, OUTPUT answer).
      IF NOT answer THEN DO:
      	 APPLY "ENTRY" TO new-name IN FRAME rename-me.
      	 RETURN NO-APPLY.
      END.
  
      IF CAN-FIND(_Field WHERE _Field._File-recid = drec_file
      		  AND _Field._Field-name = nname) THEN DO:
      	message new_lang[7] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RETURN NO-APPLY.
      END.
    END.
  
    canned = TRUE.  /* assume we won't finish -for now */
    DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
      SET new-name btn_OK btn_Cancel WITH FRAME rename-me.
      canned = FALSE.
    END.
  END.

  HIDE FRAME rename-me NO-PAUSE.
  
  IF canned THEN LEAVE _copy.
  IF skip_fld THEN NEXT _copy.
   
  if (copy_fld._Data-type = "BLOB" or copy_fld._Data-type = "CLOB") then
  do:
      /* tell prodict/dump/copy_fld.i to not copy _Fld-stlen */
      CopyArea = false.
       
      /* if we copy lob with no area to file with area then prompt for area */ 
      if (CopyNoArea and not NoArea) then
      do with frame selectarea:
         
          if AreaList = "" then
          do:
              cmbArea:delimiter  = chr(1).
              cmsg = "Select an Area and press OK or press" + " [" + KBLABEL("CLEAR") + "] " + "to skip it.".
              /*----- ON CLEAR (SKIP) -----*/
          
              ON "CLEAR" OF cmbArea IN FRAME selectarea DO:
                  skip_fld = TRUE.
                  APPLY "GO" TO FRAME selectarea.
              END.
              
              run prodict/pro/_pro_area_list(drec_file,{&INVALID_AREAS},cmbArea:delimiter, output  AreaList).
          
              cmbArea:list-items = AreaList.
              cmbArea:screen-value = cmbArea:entry(1).
          end.
          canned = true.
          
          display  cmsg 
                   new-name
                   copy_fld._data-type @ dataType. 
          /* set each time - see bug workaround below */         
          cmbArea:inner-lines = min(cmbArea:num-items,10).          
          do ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
              update cmbArea
                     btn_Ok 
                     btn_Cancel.
              assign cmbArea.  /* update doesn't work with combo */          
              canned = false.
          end.
          
          hide frame selectarea.  
          /* bug workaround - innerlines is taken into account when viewing again and causes error */
          cmbArea:inner-lines = 1.        
          
          IF canned THEN LEAVE _copy.
          IF skip_fld THEN NEXT _copy.
           
      end.  /* from lob has no area  */
  end. /* lob */  
   
  PAUSE 0.
  MESSAGE new_lang[3] copy_fld._Field-Name.
  CREATE _Field.
 
  ASSIGN
    _Field._Field-Name   = new-name
    _Field._Order        = fldOrder
    _Field._File-recid   = drec_file
    _Field._Data-type    = copy_fld._Data-type
    _Field._Format       = copy_fld._Format
    _Field._Initial      = copy_fld._Initial.
  { prodict/dump/copy_fld.i &from=copy_fld &to=_Field &all=false &copyarea=CopyArea}
  
  IF _field._Data-type = "BLOB" or _Field._Data-type = "CLOB" then
  do:

      if copy_fld._Field-rpos <> ? THEN 
      DO:
          if cmbArea > "" then 
          do:
              FIND _Area where _Area._area-name = cmbArea no-lock.
              ASSIGN _field._Fld-stlen = _Area._Area-Number.
          end.    
          else if NoArea then 
          do:     
              assign _field._Fld-stlen = 0.
          end.
          else do:   
              FIND _storageobject WHERE _Storageobject._Db-recid = drec_db
                                    AND _Storageobject._Object-type = 3
                                    AND _Storageobject._Object-number = copy_fld._Fld-stlen
                                    AND _Storageobject._Partitionid    = 0
                                    NO-LOCK.
              ASSIGN _field._Fld-stlen = _StorageObject._Area-number.
          end. 
      end. 
      IF _Field._Data-type = "CLOB" THEN 
      DO:
          ASSIGN _Field._Charset = copy_fld._Charset
                 _Field._Collation = copy_fld._Collation
                 _Field._Attributes1 = copy_fld._Attributes1.
      END.
  end. /* LOB */
  any_copied = yes.
  
END. /* for each copy_fld */

PAUSE 0.
IF any_copied THEN
   MESSAGE new_lang[6]. /* all done */
RETURN.

  
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* This program generates explicit FRAME definitions from file
definitions in the database.  These frame definitions can then
be customized.

This is especially useful if the default frame for a file won't
fit completely on the screen.  This program allows you to make
a form statement up that matches the default frame, and then you
can remove the fields that are not necessary. 

D. McMann 04/13/00 Added support for long path name
D. McMann 03/05/03 Added support for blocking LOB fields

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE canned AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE fa     AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE fl     AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE fm     AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE fo     AS CHARACTER               NO-UNDO.
DEFINE VARIABLE fq     AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE fs     AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE ft     AS CHAR      INITIAL "N" NO-UNDO.
DEFINE VARIABLE fv     AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE diff   AS DECIMAL                 NO-UNDO.
DEFINE VARIABLE lablhndl AS WIDGET-HANDLE         NO-UNDO.
{prodict/misc/filesbtn.i}

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 4 NO-UNDO INITIAL [
  /* 1*/ "A file named",
  /* 2*/ "already exists.",
  /* 3*/ "Overwrite it?",
  /* 4*/ "You do not have permission to use this option."
].
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
&IF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN  
&GLOBAL-DEFINE COL2COLON 43
&GLOBAL-DEFINE COL2LEFT  30
&GLOBAL-DEFINE COL1COLON 12
&GLOBAL-DEFINE FILLCH    36
&ELSE
&GLOBAL-DEFINE COL2COLON 42
&GLOBAL-DEFINE COL2LEFT  29
&GLOBAL-DEFINE COL1COLON 12
&GLOBAL-DEFINE FILLCH    32
&ENDIF
FORM 
  SKIP({&TFM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE {&FILLCH} BY 1
         LABEL "Output File"
  btn_File SKIP ({&VM_WIDG})
  fq VIEW-AS TOGGLE-BOX LABEL "Fully Qualified Names" AT 2
  fa VIEW-AS TOGGLE-BOX LABEL "Fully Expanded Arrays" COLON {&COL2LEFT} 
        SKIP({&VM_WIDG})
  fl VIEW-AS RADIO-SET RADIO-BUTTONS 
        "Dictionary", yes, "Explicit", no, "None", ?
        LABEL "Labeling" COLON {&COL1COLON}
  fs VIEW-AS RADIO-SET RADIO-BUTTONS "Side", yes, "Top", no, "None", ?
        LABEL "Labels" COLON {&COL2COLON} SKIP({&VM_WIDG})
  fv VIEW-AS RADIO-SET RADIO-BUTTONS 
        "Dictionary", yes, "Explicit", no, "None", ?
        LABEL "Validation" COLON {&COL1COLON} SKIP({&VM_WIDG})
  fm VIEW-AS RADIO-SET RADIO-BUTTONS "Dictionary", yes, "Explicit", no
     LABEL "Formatting" COLON {&COL1COLON} SKIP ({&VM_WIDG})
    "NOTE:  Only Non-LOB fields will be included in the output file" AT 2
    VIEW-AS TEXT SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}
  ft VIEW-AS RADIO-SET RADIO-BUTTONS "Normal", "N", "Dialog-Box", "D", 
        "Overlay", "O", "Top-only", "T"
       LABEL "Frame Type" AT ROW-OF fv COLUMN-OF fv /*Adjust horiz later*/

  WITH FRAME genframe
  SIDE-LABELS CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Generate FORM for ~"" + user_env[1] + "~" ".
&ELSE
FORM 
  SKIP({&TFM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" COLON 13 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Output File"
  btn_File SKIP ({&VM_WIDG})
  fq FORMAT "Yes/No"    LABEL "Fully Qualify Names?" COLON 23 SKIP(0.1)
  fa FORMAT "Yes/No"    LABEL "Fully Expand Arrays?" COLON 23 SKIP(1)
  ft FORMAT "X(1)"  LABEL "Frame Type"           COLON 13
    "(N)ormal/(D)ialog/(O)verlay/(T)op-Only"         AT    22 SKIP(0.1)
  fm FORMAT "Dict/Expl" LABEL "Formatting"           COLON 13
    "Dictionary/Explicit"                                        AT    22 SKIP
  fv FORMAT "Dict/Expl" LABEL "Validation"           COLON 13
    "Dictionary/Explicit/?=None"                                 AT    22 SKIP
  fl FORMAT "Dict/Expl" LABEL "Labeling"             COLON 13
    "Dictionary/Explicit/?=None"                     AT    22 SKIP 
  fs FORMAT "Side/Top"  LABEL "Labels"               COLON 13
    "Side/Top/?=None"                                AT    22 SKIP(1)
   "NOTE:  Only Non-LOB fields will be included in the output file" AT 2
    VIEW-AS TEXT SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME genframe
  SIDE-LABELS CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Generate FORM for ~"" + user_env[1] + "~" ".
&ENDIF
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame genframe
   or CHOOSE of btn_Help in frame genframe
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Generate_Form_Dlg_Box},
                                               INPUT ?).
&ENDIF


ON GO OF FRAME genframe
DO:
  DEFINE VAR fil AS CHAR NO-UNDO.

  fil = fo:SCREEN-VALUE IN FRAME genframe.

  IF SEARCH(fil) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[1] fil new_lang[2] SKIP new_lang[3]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fo IN FRAME genframe.
      RETURN NO-APPLY.
    END.
  END.

  IF fl:SCREEN-VALUE IN FRAME genframe = ? OR 
     fs:SCREEN-VALUE IN FRAME genframe = ? THEN DO:
    ASSIGN fl = ? fs = ?.
    DISPLAY fl fs WITH FRAME genframe.
  END.
END.

ON CHOOSE OF btn_File in frame genframe DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fo:handle in frame genframe /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON LEAVE OF fo in frame genframe
   fo:screen-value in frame genframe = 
        TRIM(fo:screen-value in frame genframe).

ON WINDOW-CLOSE OF FRAME genframe
   APPLY "END-ERROR" TO FRAME genframe.



/*============================Mainline code===============================*/

DO FOR DICTDB._File:
  FIND _File "_File".
  answer = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_Field".
  answer = answer AND CAN-DO(_Can-read,USERID("DICTDB")).
  IF NOT answer THEN DO:
    MESSAGE new_lang[4] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
  END.
END.

PAUSE 0.
ASSIGN
  fo = LC(user_env[1]) + ".f".

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
  /*Have to move ft over so its colon lines up with the fs guy--alas,
  form statement doesn't allow ROW-OF fv COLON {&COL2COLON}*/
  ASSIGN 
    FRAME genframe:width = FRAME genframe:width + 2
    diff = fs:COLUMN - ft:COLUMN
    ft:COLUMN = fs:COLUMN
    lablhndl = ft:SIDE-LABEL-HANDLE
    lablhndl:COLUMN = lablhndl:COLUMN + diff.
&ENDIF

  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
    &FRAME  = "FRAME genframe" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }
UPDATE fo btn_File fq fa ft fm fv fl fs 
               btn_OK btn_Cancel {&HLP_BTN_NAME}
         WITH FRAME genframe.

  /* Do the work */
  ASSIGN
    user_env[1] = fo
    user_env[2] = STRING(fq,"Y/N")
    user_env[3] = STRING(fa,"Y/N")
    user_env[4] = STRING(fm,"N/Y")
    user_env[5] = STRING(fv,"D/E")
    user_env[6] = STRING(fl,"D/E")
    user_env[7] = (IF fs THEN "S" ELSE IF NOT fs THEN "T" ELSE "N")
    user_env[8] = ft.
  
  RUN "prodict/misc/_wrkfgen.p".
  canned = FALSE.
END.

IF canned THEN
  user_path = "".

HIDE FRAME genframe NO-PAUSE.
RETURN.

/***********************************************************************
* Copyright (C) 2000,2006,2008 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* userfglo - Perform a global field name change 

History - 07/09/98 D. McMann Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") to
                             For Each statements
          12/30/98 Mario B   Changed leave trigger on field new-name to GO
	                     trigger so that GO/CANCEL could be accessed if
                             data in new-name was not valid.  Bug 98-06-29-011.
          03/28/02 D. McMann Changed size of name fields to 32 SCC 20020218-023
                             Issue 3977 
          06/10/02 D. McMann Added check for new SESSION attribute schema change.
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

DEFINE VARIABLE answer   AS LOGICAL           NO-UNDO.
DEFINE VARIABLE canned   AS LOGICAL INIT TRUE NO-UNDO.
DEFINE VARIABLE c        AS CHARACTER         NO-UNDO.
DEFINE VARIABLE i        AS INTEGER           NO-UNDO.
DEFINE VARIABLE isfroz   AS LOGICAL           NO-UNDO.
DEFINE VARIABLE issql    AS LOGICAL           NO-UNDO.
DEFINE VARIABLE isview   AS LOGICAL           NO-UNDO.
DEFINE VARIABLE new-name AS CHARACTER         NO-UNDO.
DEFINE VARIABLE num      AS INTEGER INITIAL 0 NO-UNDO.
DEFINE VARIABLE old-name AS CHARACTER         NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 20 NO-UNDO INITIAL [
  /*    1*/ "All Fields In Database",
  /*    2*/ "The given name is not in any known table.",
  /*    3*/ "The new name is already in use in some table.",
  /*    4*/ "", /* reserved */
  /*    5*/ "The dictionary is in read-only mode - alterations not allowed.",
  /*    6*/ "You do not have permission to use this option.",
  /*    7*/ "This field is used in a View - cannot rename.",
  /*    8*/ "One or more of the tables is Frozen - cannot rename.",
  /*    9*/ "This field name is used by {&PRO_DISPLAY_NAME}/SQL - cannot rename.",
  /*   10*/ "This is a schema field - it cannot be renamed.",
  /*11,12*/ "Are you sure that you want to carry out this global",
            "search and replace operation on field names?",
  /*13,14*/ "Changing", "to",
  /*15,16*/ "This field name occurs in", "tables",
  /*17,18*/ "Searching fields to be renamed...", "done.",
  /*   19*/ "There are no user-defined fields in this database.",
  /*   20*/ "SESSION:SCHEMA-CHANGE set to New Objects, changes not allowed."
].

FORM
  SKIP(1)
  "This program will let you rename a field throughout all"    SKIP
  "tables.  In order for this to work, the 'target' name (the" SKIP
  "name you change to) must not be in use in any table in the" SKIP
  "database before the rename."                                SKIP(1)
  old-name FORMAT "x(32)" LABEL "Old Field Name" SKIP(1)
  new-name FORMAT "x(32)" LABEL "New Field Name" SKIP(1)
  c        FORMAT "x(18)" LABEL "To list all fields, press this key" 
  {prodict/user/userbtns.i}
  WITH FRAME everything 
  SIDE-LABELS ROW 4 CENTERED ATTR-SPACE DEFAULT-BUTTON btn_OK
  VIEW-AS DIALOG-BOX TITLE "Global Field Name Change".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*===============================Triggers=================================*/

/*----- GET of OLD NAME or NEW NAME -----*/
ON GET OF old-name IN FRAME everything, new-name IN FRAME everything 
DO:
  DEFINE BUFFER xtbl FOR _File.
  DEFINE BUFFER xfld FOR _Field.

  IF pik_count = 0 THEN
   FOR EACH xtbl WHERE xtbl._Db-recid = drec_db
                   AND (xtbl._Owner = "PUB" OR xtbl._Owner = "_FOREIGN"),
     EACH xfld OF xtbl
     WHERE xfld._Field-name < "_"
     BREAK BY xfld._Field-name:
     IF FIRST-OF(xfld._Field-name) THEN ASSIGN
       pik_count = pik_count + 1
       pik_list[pik_count] = xfld._Field-name.
   END.
  IF pik_count > 0 THEN RUN "prodict/user/_usrpick.p".
  IF pik_return > 0 THEN 
      ASSIGN SELF:SCREEN-VALUE = pik_first.            
END.

/*----- LEAVE OF OLD NAME -----*/

ON LEAVE of old-name IN FRAME everything
DO:
  DEFINE VARIABLE name AS CHARACTER    NO-UNDO.
  DEFINE BUFFER bField FOR _Field.
  DEFINE BUFFER bFile FOR _File.

  name = TRIM(Self:SCREEN-VALUE).

  /* We already know the field name exists.  Just
     make sure it's not a schema field. 
  */
  IF INPUT FRAME everything old-name BEGINS "_" THEN DO:

    FIND FIRST bField where bField._Field-Name = NAME NO-LOCK NO-ERROR.
    IF AVAILABLE bField THEN DO:
        /* if one of the encryption schema tables, act as if it doesn't exist */
        FIND FIRST bFile OF bField WHERE 
            NOT CAN-DO({&INVALID_SCHEMA_TABLES},bFile._File-name) NO-LOCK NO-ERROR.
        IF NOT AVAILABLE bFile THEN
            RELEASE bField.
    END.

    IF NOT AVAILABLE bField THEN
        MESSAGE new_lang[2]. /* unknwon name */
    ELSE
        MESSAGE new_lang[10]. /* schema field */

    BELL.
    RETURN NO-APPLY.
  END.

END.

/*----- LEAVE OF new NAME -----*/

ON LEAVE of new-name IN FRAME everything
DO:
  DEFINE VARIABLE name AS CHARACTER    NO-UNDO.
  DEFINE BUFFER bField FOR _Field.
  DEFINE BUFFER bFile FOR _File.

  name = TRIM(Self:SCREEN-VALUE).

  FIND FIRST bField where bField._Field-Name = NAME NO-LOCK NO-ERROR.
  IF AVAILABLE bField THEN DO:
      /* if one of the encryption schema tables, act as if it doesn't exist 
         It will get blocked in _valname.p (ON GO) as an invalid name due
         to the underscore at the beginning of the name
      */
      FIND FIRST bFile OF bField NO-LOCK.
      IF CAN-DO({&INVALID_SCHEMA_TABLES},bFile._File-name) THEN
          RELEASE bField.
  END.

  IF AVAILABLE bField THEN DO:
      MESSAGE new_lang[3].
      RETURN NO-APPLY.
  END.

END.

/*----- ON GO -----*/
/* Was a leave trigger, but that was preventing access to OK/CANCEL btns */
ON GO OF frame everything
DO:
  RUN "adecomm/_valname.p"
    (INPUT FRAME everything new-name,INPUT no,OUTPUT answer).
  IF NOT answer THEN
  DO:
     APPLY "ENTRY" TO new-name IN FRAME everything.
     RETURN NO-APPLY.
  END.
END.

/*============================Mainline code===============================*/

DO FOR _File:
  FIND _File WHERE _File._File-name = "_Field"
               AND _File._Owner = "PUB".
  FIND FIRST _Field WHERE _Field._Field-name < "_" 
                      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
  IF NOT CAN-DO(_Can-write,USERID("DICTDB"))      THEN num = 6.
  ELSE IF dict_rog                                THEN num = 5.
  ELSE IF NOT AVAILABLE _Field                    THEN num = 19.
  ELSE
    IF SESSION:SCHEMA-CHANGE = "New Objects"   THEN num = 20.
    
END.
IF num > 0 THEN DO:
  MESSAGE new_lang[num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

ASSIGN
  pik_count  = 0
  pik_column = 40
  pik_row    = 4
  pik_title  = new_lang[1] /* All Fields In Database */
  pik_wide   = FALSE
  pik_hide   = TRUE
  pik_multi  = FALSE
  pik_number = FALSE
  c          = "[" + KBLABEL("GET") + "]"
  isfroz     = FALSE
  issql      = FALSE
  isview     = FALSE.

/* Adjust the ok and cancel buttons */
{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME everything"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}

PAUSE 0.
DISPLAY c WITH FRAME everything.

_loop:
DO ON ERROR UNDO,NEXT ON ENDKEY UNDO,LEAVE:
  SET
    old-name
      VALIDATE(CAN-FIND(FIRST _Field
        WHERE _Field._Field-name = old-name),new_lang[2])
    new-name
    btn_OK btn_Cancel
    WITH FRAME everything.

  ASSIGN
    old-name = LC(old-name)
    new-name = LC(new-name).
  DISPLAY old-name new-name WITH FRAME everything.

  canned = FALSE.
END.

IF canned THEN DO:
  user_path = "".
  HIDE FRAME everything NO-PAUSE.
  HIDE MESSAGE NO-PAUSE.
  RETURN.
END.

MESSAGE new_lang[17]. /* Searching fields 2-B renamed... */
FOR EACH _File WHERE _File._Db-recid = drec_db
                 AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN"),
  EACH _Field OF _File
  WHERE _Field._Field-name = old-name
  WHILE NOT (isfroz OR issql OR isview):
    ASSIGN
      isfroz = _File._Frozen
      isview = CAN-FIND(FIRST _View-ref WHERE
               _View-ref._Ref-Table = _File._File-name
               AND _View-ref._Base-Col = _Field._Field-name)
      issql  = _File._Db-lang > 0
      num    = num + 1.
END.
HIDE MESSAGE NO-PAUSE.
MESSAGE new_lang[17] new_lang[18]. /* searching done */

IF isfroz OR issql OR isview THEN DO:
  IF      isview THEN MESSAGE new_lang[7] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  ELSE IF isfroz THEN MESSAGE new_lang[8] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  ELSE IF issql  THEN MESSAGE new_lang[9] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  HIDE FRAME everything NO-PAUSE.
  HIDE MESSAGE NO-PAUSE.
  RETURN.
END.

answer = TRUE.
RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT answer,?,?,
  new_lang[13] + ' "' + old-name + '" ' +
  new_lang[14] + ' "' + new-name + '".!' +
  new_lang[15] + " " + STRING(num) + " " + new_lang[16] + ".!!" +
  new_lang[11] + " " + new_lang[12]).
IF answer THEN
  FOR EACH _File WHERE _File._Db-recid = drec_db
                   AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN"),
    EACH _Field OF _File
    WHERE _Field._Field-name = old-name:
    _Field._Field-name = new-name.
  END.
ELSE
  user_path = "".

HIDE FRAME everything NO-PAUSE.
HIDE MESSAGE NO-PAUSE.
RETURN.




/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrfixd.p

pik_count  - number of elements in      (was pik_chextent)
pik_list   - list of elements in        (was pik_chlist)
pik_lower  - lower values for list of elements
pik_upper  - upper values for list of elements
*/

/*input:*/
DEFINE SHARED VARIABLE pik_count AS INTEGER               NO-UNDO.
DEFINE SHARED VARIABLE pik_list  AS CHARACTER EXTENT 2000 NO-UNDO.

/*output:*/
DEFINE SHARED VARIABLE pik_lower AS INTEGER   EXTENT 2000 NO-UNDO.
DEFINE SHARED VARIABLE pik_upper AS INTEGER   EXTENT 2000 NO-UNDO.

/*local:*/
DEFINE        VARIABLE p_flow    AS INTEGER               NO-UNDO.
DEFINE        VARIABLE p_down    AS INTEGER               NO-UNDO.
DEFINE        VARIABLE p_recid   AS INTEGER INITIAL     1 NO-UNDO.
DEFINE        VARIABLE p_init    AS INTEGER INITIAL     ? NO-UNDO.
DEFINE        VARIABLE p_line    AS INTEGER               NO-UNDO.
DEFINE        VARIABLE p_loop    AS INTEGER               NO-UNDO.
DEFINE        VARIABLE p_redraw  AS LOGICAL INITIAL  TRUE NO-UNDO.
DEFINE        VARIABLE p_spot    AS INTEGER               NO-UNDO.
DEFINE        VARIABLE i         AS INTEGER               NO-UNDO.

/*frame:*/
FORM
  pik_list[p_recid] FORMAT "x(32)"
  pik_lower[p_recid] FORMAT ">>>>>"
  pik_upper[p_recid] FORMAT ">>>>>"
  WITH FRAME pick SCROLL 1 NO-LABELS ATTR-SPACE
  p_down DOWN ROW 3 CENTERED
  TITLE "Fixed-Length Field Columns". 

IF pik_count <= 0 THEN RETURN.

ASSIGN
  p_recid = 1
  p_down  = MINIMUM(pik_count,SCREEN-LINES - 8).

DO WHILE TRUE WITH FRAME pick:

  p_recid = MINIMUM(pik_count,MAXIMUM(p_recid,1)).

  IF p_redraw THEN DO:
    ASSIGN
      p_line = MAXIMUM(1,FRAME-LINE)
      p_spot = p_recid - (IF p_init = ? THEN p_line ELSE p_init) + 1.
    UP p_line - 1.
    IF p_spot < 1 THEN ASSIGN
      p_spot  = 1
      p_line  = 1
      p_recid = 1.
    DO p_flow = p_spot TO p_spot + p_down - 1:
      IF p_flow > pik_count THEN DO:
        CLEAR NO-PAUSE.
      END.
      ELSE DO:
        DISPLAY
          pik_list[p_flow]  @ pik_list[p_recid]
          pik_lower[p_flow] @ pik_lower[p_recid]
          pik_upper[p_flow] @ pik_upper[p_recid].
      END.
      IF p_flow < p_spot + p_down - 1 THEN DOWN 1.
    END.
    p_line = (IF p_init = ? THEN p_line ELSE p_init).
    UP p_down - p_line.
    ASSIGN
      p_init     = ?
      p_redraw   = FALSE.
  END.

  DISPLAY pik_list[p_recid].
  
  /* The user is going to stay in this loop until he enters a valid pair
   * or hits F4
   */
  DO WHILE TRUE:
   UPDATE pik_lower[p_recid] pik_upper[p_recid]
    EDITING:
      READKEY.
      APPLY (IF CAN-DO(
          "*-UP,*-DOWN,GO,END,HOME,MOVE,GET,END-ERROR"
          ,KEYFUNCTION(LASTKEY))
        THEN KEYCODE(KBLABEL("GO")) ELSE LASTKEY).
    END.
    /* If user wants to bail out, zero out arrays and leave block */
    IF KEYFUNCTION(lastkey) = "END-ERROR" THEN DO:
      DO i = 1 TO p_recid:
        ASSIGN pik_lower[i] = 0
               pik_upper[i] = 0.
      END.
      LEAVE.
    END.
    /* Error checking on the pair entered */
    IF pik_lower[p_recid] > pik_upper[p_recid] THEN
      MESSAGE "The starting column cannot be larger than the ending column"
        VIEW-AS ALERT-BOX ERROR.
    ELSE IF pik_lower[p_recid] EQ 0                 OR 
            pik_upper[p_recid] EQ 0                 THEN
           MESSAGE "Columns must be greater than zero." VIEW-AS ALERT-BOX ERROR.
    ELSE LEAVE. /* OK */
  END.
  
  IF CAN-DO("RETURN,CURSOR-DOWN,TAB",KEYFUNCTION(LASTKEY))
    AND p_recid < pik_count THEN DO:
    p_recid = p_recid + 1.
    IF FRAME-LINE = FRAME-DOWN THEN
      SCROLL UP.
    ELSE
      DOWN.
  END.
  ELSE
  IF CAN-DO("CURSOR-UP,BACK-TAB",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
    p_recid = p_recid - 1.
    IF FRAME-LINE = 1 THEN
      SCROLL DOWN.
    ELSE
      UP.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN ASSIGN
    p_recid  = p_recid + p_down
    p_redraw = TRUE.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN ASSIGN
    p_recid  = p_recid - p_down
    p_redraw = TRUE.
  ELSE
  IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
    ASSIGN
      p_recid  = 1
      p_redraw = TRUE.
    UP FRAME-LINE - 1.
  END.
  ELSE
  IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
    ASSIGN
      p_recid  = pik_count
      p_redraw = TRUE.
    DOWN p_down - FRAME-LINE.
  END.
  ELSE
  IF CAN-DO("GO,GET,END-ERROR",KEYFUNCTION(LASTKEY)) THEN LEAVE.

  p_line = 1.
END.

HIDE FRAME pick NO-PAUSE.
RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* userfnum - resequences all _Order fields in a file to multiples of
              <x>, starting with <y>.
              
   History:  D. McMann 06/10/02 Added check for new SESSION attribute
                                schema change.           
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE fa      AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE fb      AS INTEGER INITIAL 10    NO-UNDO.
DEFINE VARIABLE fi      AS INTEGER INITIAL 10    NO-UNDO.
DEFINE VARIABLE msg     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE msg-num AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE numfld  AS INTEGER               NO-UNDO.
DEFINE VARIABLE canned  AS LOGICAL INITIAL TRUE  NO-UNDO.

DEFINE BUFFER xfile FOR _File.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 11 NO-UNDO INITIAL [
  /*  1*/ "The dictionary is in read-only mode - alterations not allowed.",
  /*  2*/ "You do not have permission to use this option.",
  /*  3*/ "You cannot change the order of {&PRO_DISPLAY_NAME}/SQL columns.",
  /*  4*/ "The definitions for this table have been frozen.",
  /*  5*/ "Starting number and/or increment will cause Order to",
  /*  6*/ "overflow when renumbering.  Please try smaller values.",
  /*7-9*/ "Table ", "contains", "fields.",
  /* 10*/ "There are no fields in this table to be renumbered.",
  /* 11*/ "SESSION:SCHEMA-CHANGE set to New Objects, changes not allowed."
].

FORM SKIP(1)
  fa AT 2 LABEL "Sort by Field Name or Order"
     FORMAT "Field Name/Order" "(F/O)" SKIP(1)
  fb AT 2 LABEL "Start Numbering From"
     FORMAT ">>>>9"
     VALIDATE(fb >= 0,"Starting number must be a non-negative integer") SKIP
  fi AT 2 LABEL "   Increment Each By"
     FORMAT ">>>>9"
     VALIDATE(fi > 0,"Increment must be a positive integer") SKIP(1)
  msg AT 2 FORMAT "x(30)" NO-LABEL
  {prodict/user/userbtns.i}
  WITH FRAME reseq 
  SIDE-LABELS ATTR-SPACE ROW 5 CENTERED DEFAULT-BUTTON btn_OK 
  VIEW-AS DIALOG-BOX
  TITLE " Resequence Order of Fields in ~"" + _File._File-name + "~" ".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


FIND _File WHERE RECID(_File) = drec_file.
numfld = _File._numfld - 1.

FIND xfile "_Field".
IF NOT CAN-DO(xfile._Can-write,USERID("DICTDB")) THEN msg-num = 2.
ELSE IF _File._Db-lang > 0                       THEN msg-num = 3.
ELSE IF _File._Frozen                            THEN msg-num = 4.
ELSE IF dict_rog                                 THEN msg-num = 1.
ELSE IF numfld = 0                               THEN msg-num = 10.
ELSE IF SESSION:SCHEMA-CHANGE = "New Objects"    THEN msg-num = 11.
.

IF msg-num > 0 THEN DO:
  MESSAGE new_lang[msg-num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

/* Adjust the ok and cancel buttons */
{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME reseq"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}

PAUSE 0. 
/* File "x" contains <y> fields. */
DISPLAY
   new_lang[7] + new_lang[8] + ' ' + STRING(numfld) + ' ' + new_lang[9]
   @ msg WITH FRAME reseq.

DISPLAY fa fb fi WITH FRAME reseq.
work_loop:
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  SET fa fb fi btn_OK btn_Cancel WITH FRAME reseq.
  IF fb + fi * (numfld - 1) > 99999 THEN DO:
    MESSAGE new_lang[5].
    MESSAGE new_lang[6].
    UNDO work_loop,RETRY work_loop.
  END.
  canned = FALSE.
END.

HIDE FRAME reseq NO-PAUSE.

IF canned THEN
  user_path = "".
ELSE DO:
  ASSIGN
    user_env[1] = STRING(fa,"f/o")
    user_env[2] = STRING(fb)
    user_env[3] = STRING(fi).

   RUN "prodict/misc/_wrkfnum.p".
END.

RETURN.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*
-------------------------------------------------------------------------------
FIELD-TRIGGERS:

                                                               Override- Check
             Trigger Programs                                  able      CRC?
             ------------------------------------------------  -----     -----
 for ASSIGN: ________________________________________________  ___       __ 

       	      (press [PUT] to edit trigger source)
-------------------------------------------------------------------------------

dfields contains buffer for field that triggers belong to.

   Input Parameters:
      p_romode  - True if we're in read-only mode.
      p_tblname - Name of the table this field belongs to.      

   Input-Output Parameters:
      p_Check   - Do we check trigger syntax or not.  New setting will
      	       	  be returned so this is sticky for editing session.

   Output Parameters:
      p_changed - set to true if triggers were added/modified/deleted.
      
   Modified:  01/31/03 D. McMann Assign triggers can not be created for Blob fields.      
              07/28/03 D. McMann Block CLOB Fields
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE INPUT   	     PARAMETER p_romode   AS LOGICAL   NO-UNDO.
DEFINE INPUT   	     PARAMETER p_tblname  AS CHARACTER NO-UNDO. 
DEFINE INPUT-OUTPUT  PARAMETER p_Check 	  AS LOGICAL   NO-UNDO.
DEFINE OUTPUT  	     PARAMETER p_changed  AS LOGICAL   NO-UNDO.

DEFINE SHARED BUFFER dfields FOR _Field.
DEFINE	      BUFFER ft      FOR _Field-Trig.

DEFINE VARIABLE pname	    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE override    AS LOGICAL 	  NO-UNDO.
DEFINE VARIABLE crc	    AS LOGICAL    NO-UNDO.
DEFINE VARIABLE event	    AS CHARACTER  NO-UNDO init "Assign". 
DEFINE VARIABLE compfile    AS CHARACTER  NO-UNDO init "".
DEFINE VARIABLE do-get	    AS CHARACTER  NO-UNDO.
DEFINE VARIABLE go-key	    AS INTEGER    NO-UNDO.
DEFINE VARIABLE old_crc_val AS INTEGER    NO-UNDO.
DEFINE VARIABLE new_crc_val AS INTEGER    NO-UNDO.


FORM
  "Override-"	      at 62 view-as TEXT
  "Check"	      at 73 view-as TEXT SKIP 
  "Trigger Programs"  at 14 view-as TEXT  
  "able?"	      at 62 view-as TEXT 
  "CRC?"	      at 73 view-as TEXT SKIP(1)

  pname    at 2  FORMAT "x(45)" LABEL "For ASSIGN" 
  override at 62 NO-LABEL 
  crc      at 73 NO-LABEL SKIP

  SPACE(12) "(removing the trigger file name deletes the trigger)" SKIP(1)
  SPACE(12) do-get FORMAT "x(45)" NO-LABEL
  {prodict/user/userbtns.i}
  WITH FRAME fldtrig
    SIDE-LABELS DEFAULT-BUTTON btn_OK SCROLLABLE
    VIEW-AS DIALOG-BOX  TITLE "Field Triggers".


/*------------------------------Triggers---------------------------------*/

/*----- PUT (Edit Trigger) -----*/
ON PUT OF pname IN FRAME fldtrig, 
      	  override IN FRAME fldtrig,
      	  crc IN FRAME fldtrig
DO:
  pname:SCREEN-VALUE IN FRAME fldtrig = 
      TRIM(pname:SCREEN-VALUE IN FRAME fldtrig).

  RUN "prodict/user/_usrtrig.p"
    (INPUT INPUT FRAME fldtrig pname, 
     INPUT event,
     INPUT p_tblname,  
     INPUT dfields._Field-Name,
     INPUT no,
     INPUT-OUTPUT new_crc_val,
     INPUT-OUTPUT p_Check).
END.


/*---- GO ----*/
ON GO OF FRAME fldtrig
DO:
  pname:SCREEN-VALUE IN FRAME fldtrig = 
      TRIM(pname:SCREEN-VALUE IN FRAME fldtrig).

   p_changed = no.
   {prodict/user/usertrig.i
      &Frame	   = "FRAME fldtrig"
      &pname	   = pname
      &override	   = override
      &crc	   = crc
      &new_crc_val = new_crc_val
      &old_crc_val = old_crc_val
      &changed 	   = p_changed}

   DO ON ERROR UNDO, LEAVE:
      /* replace altered trigger definitions */
      IF p_changed THEN DO:
      	 IF (pname = "" OR pname = ?) AND AVAILABLE ft THEN
      	    DELETE ft.
      	 ELSE DO:
      	    /* Progress doesn't let you modify a trigger record, so delete 
               and recreate. */
      	    IF AVAILABLE ft then DELETE ft.
      	    CREATE ft.
      	    ASSIGN
               ft._File-Recid = drec_File
               ft._Field-Recid = RECID(dfields)
               ft._Event = event
               ft._Proc-Name = pname
               ft._Override  = INPUT FRAME fldtrig override
      	       ft._Trig-CRC = (IF INPUT FRAME fldtrig crc 
      	       	     	       THEN new_crc_val ELSE ?).
      	 END.
      END.
      RETURN.
   END.

   /* There was an error */
   RETURN NO-APPLY.
END.
 

/*--------------------------Mainline code--------------------------------*/
IF dfields._Data-type = "Blob" THEN DO:
    MESSAGE "Triggers can not be created for Blob fields."
        VIEW-AS ALERT-BOX ERROR.
    RETURN.
END.
ELSE IF dfields._Data-type = "Clob" THEN DO:
    MESSAGE "Triggers can not be created for Clob fields."
        VIEW-AS ALERT-BOX ERROR.
    RETURN.
END.

/* There should only be one there. */
FIND FIRST ft where ft._Field-Recid = RECID(dfields) AND ft._Event = event
   NO-ERROR.

ASSIGN
  do-get = "(press [" + KBLABEL("PUT") + "] to edit trigger program)"
  do-get = FILL(" ",45 - LENGTH(do-get)) + do-get 
  go-key = KEYCODE(KBLABEL("GO")).

if NOT AVAILABLE ft THEN
  ASSIGN
    pname = ""
    override = no
    crc = yes
    old_crc_val = ?.
ELSE
  ASSIGN
    pname = ft._Proc-Name
    override = ft._Override
    crc = (if ft._Trig-CRC = ? then no else yes)
    old_crc_val = ft._Trig-CRC.

new_crc_val = old_crc_val.

/* Adjust ok and cancel buttons */
{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME fldtrig"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}

DISPLAY
  pname override crc
  do-get WHEN NOT p_romode
  WITH FRAME fldtrig.

UPDATE
  pname    WHEN NOT p_romode
  override WHEN NOT p_romode
  crc      WHEN NOT p_romode
  btn_OK   WHEN NOT p_romode
  btn_Cancel
  WITH FRAME fldtrig.

HIDE FRAME fldtrig.



/*********************************************************************
* Copyright (C) 2000,2008 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
&SCOPED-DEFINE GATE_OMIT_PARM3 YES

{ prodict/gui/_guigget.p }

/*------------------------------------------------------------------*/
/***********************************************************************
* Copyright (C) 2000,2006-2007 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* useriact - user interface for index activation/deactivation 
 *
 * HISTORY:
 * 11/20/02 D. McMann Fixed display of warning message
 * 07/09/98 by D. McMann Added AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                         to CAN-FIND    
 * 04/09/98 by laurief  Added SIZE 80 BY 20 to FRAME "stuff" (BUG 98-04-09-046)
 * 07/13/94 by gfs      94-06-30-002
 *
 *
 * 11/16/07 fernando   Support for _aud-audit-data* indexes deactivation 
 */

/*
user_env[1] holds the filename which owns the indexes to be activated.

user_env[9] = 'on'   to rebuild (thru proutil idxbuild) not yet supported.
            = 'off'  to deactivate the indexes.
            = 'note' to display the initial help message frame.
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

DEFINE VARIABLE answer    AS LOGICAL               NO-UNDO.
DEFINE VARIABLE canned    AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE c         AS CHARACTER             NO-UNDO.
DEFINE VARIABLE i         AS INTEGER               NO-UNDO.
DEFINE VARIABLE msg-num   AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE rebuild   AS LOGICAL               NO-UNDO.
DEFINE VARIABLE something AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE stufftxt  AS CHARACTER VIEW-AS EDITOR NO-BOX INNER-CHARS 70 INNER-LINES 3 NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 9 NO-UNDO INITIAL [
  /* 1*/ "Select Indexes to Rebuild",
  /* 2*/ "Select Indexes to Deactivate",
  /* 3*/ "You can only rebuild {&PRO_DISPLAY_NAME} database indexes.",
  /* 4*/ "There are no active indexes on this table.",
  /* 5*/ "Are you sure that you want to deactivate ALL indexes?",
  /* 6*/ "Are you sure that you want to deactivate one index?",
  /* 7*/ "Are you sure that you want to deactivate these indexes?",
  /* 8*/ "You do not have permission to use this option.",
  /* 9*/ "The dictionary is in read-only mode - alterations not allowed."
].
FORM
  _File._File-name   FORMAT "x(30)" LABEL "Table-name" 
  _Index._Index-name FORMAT "x(30)" LABEL "Index-name" 
  WITH FRAME offing
  SCREEN-LINES - 8 DOWN CENTERED USE-TEXT VIEW-AS DIALOG-BOX THREE-D
  TITLE " The following indexes are being deactivated ".

FORM
  SKIP({&TFM_WID})
  stufftxt AT 2
  {prodict/user/userbtns.i}
  WITH FRAME stuff
  CENTERED NO-LABELS NO-ATTR-SPACE USE-TEXT 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX THREE-D TITLE "Warning".



/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*==============================Triggers================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame stuff
   or CHOOSE of btn_Help in frame stuff
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Index_Deactivation_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF
/*----- WINDOW-CLOSE ------*/
ON WINDOW-CLOSE of frame stuff
   APPLY "END-ERROR" to frame stuff.

/*============================Mainline Code=============================*/
IF NOT CAN-FIND(FIRST DICTDB._File WHERE DICTDB._File._File-Number > 0
                                  AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
    	    	    	    	    AND  DICTDB._File._Tbl-Type <> "V")
  THEN DO:
  MESSAGE "There are no user tables in this database." VIEW-AS ALERT-BOX ERROR.
  user_path = "".
  RETURN.
END.

IF user_env[9] = "note" THEN DO:
   user_env[9] = "".
  ASSIGN stufftxt:SCREEN-VALUE =
     "When indexes are deactivated, the affected data will be inaccessible " +
     "until the indexes are re-activated using the Index Rebuild Utility.".

  ASSIGN stufftxt:READ-ONLY = TRUE.

  ENABLE stufftxt WITH FRAME stuff.
  /* Adjust the graphical rectangle and the ok and cancel buttons */
    {prodict/user/userctr.i
        &FRAME = "FRAME stuff"
    }
    {adecomm/okrun.i  
        &FRAME  = "FRAME stuff" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
    }
  PAUSE 0.
  DO ON ENDKEY UNDO, LEAVE:
    UPDATE btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME stuff.
    canned = FALSE.
  END.
  HIDE FRAME stuff NO-PAUSE.
  IF canned THEN
    user_path = "".
  RETURN.
END.

DO FOR _File:
  FIND _File "_Index".
  IF      user_dbtype <> "PROGRESS"               THEN msg-num = 3.
  ELSE IF NOT CAN-DO(_Can-write,USERID("DICTDB")) THEN msg-num = 8.
  ELSE IF dict_rog                                THEN msg-num = 9.
END.
IF msg-num > 0 THEN DO:
  MESSAGE new_lang[msg-num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

ASSIGN
  rebuild    = user_env[1] = "on"
  pik_count  = 0
  pik_multi  = TRUE
  pik_wide   = FALSE
  pik_row    = 5
  pik_hide   = TRUE
  pik_column = 20
  pik_title  = new_lang[IF rebuild THEN 1 ELSE 2]. /* select to make/kill */

IF user_env[1] = "ALL" THEN 
_all: DO:
  answer = FALSE.
  MESSAGE new_lang[5] VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
  IF NOT answer THEN
    LEAVE _all. 

  run adecomm/_setcurs.p ("WAIT").
  FOR EACH _File
    WHERE _File._File-num > 0
      AND _File._Db-recid = drec_db
      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
      AND NOT _File._dft-pk:
    FOR EACH _Index OF _File WHERE _Index._Active:
      _Index._Active = FALSE.
      IF RECID(_Index) = _File._Prime-Index THEN PAUSE 0.
      DISPLAY _File-name _Index-name WITH FRAME offing.
      IF FRAME-LINE(offing) = FRAME-DOWN(offing) THEN
        UP FRAME-LINE(offing) - 1 WITH FRAME offing.
      ELSE
        DOWN WITH FRAME offing.
    END.
  END.
  run adecomm/_setcurs.p ("").
  something = TRUE.
END.
ELSE _some: DO:

  HIDE FRAME offing NO-PAUSE.

  FOR EACH _Index WHERE _Index._File-recid = drec_file
    AND _Index._Index-name <> "default"
    BY _Index._Index-name:
    IF rebuild = _Active THEN NEXT.

    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = _Index._Index-name.
  END.

  IF pik_count = 0 THEN DO:
    MESSAGE new_lang[4] VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    user_path = "".
    RETURN.
  END.

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN "prodict/user/_usrpick.p".
  &ELSE
    pik_help = {&Indexes_For_Deactivation_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF
  IF pik_return = 0 THEN LEAVE _some.

  answer = FALSE.
  MESSAGE new_lang[IF pik_return = 1 THEN 6 ELSE 7]
      	  VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer. 
  IF NOT answer THEN LEAVE _some.

  run adecomm/_setcurs.p ("WAIT").
  DO i = 1 TO pik_return:
    FIND _Index WHERE _Index._File-recid = drec_file
      AND _Index._Index-name = pik_list[pik_chosen[i]].
    _Index._Active = FALSE.
    DISPLAY user_filename @ _File._File-name _Index-name WITH FRAME offing.
    IF FRAME-LINE(offing) = FRAME-DOWN(offing) THEN
      UP FRAME-LINE(offing) - 1 WITH FRAME offing.
    ELSE
      DOWN WITH FRAME offing.
  END.
  run adecomm/_setcurs.p ("").
  something = TRUE.
END.

IF something THEN 
   MESSAGE "Index deactivation complete."
      	   VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.

/* This used to give the user opportunity to hit "GET" to repeat the
   process.  It would set user_path = "1=a,_usrtget,_usriact".  This
   is not done anywhere else and I don't see the point in doing it here
   since the user could have selected multiple tables.  If we want to
   restore this add a question to the complete alert box.
*/
HIDE FRAME offing NO-PAUSE.
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* useriadd - user index creation program */

/*
INPUT:
index name in user_env[1].
OUTPUT:
The settings of the index fields are placed in user_env[4...].  This is
in accordance with the what was once ???_idx.p's expectations.

History:  D. McMann 07/29/03  Adjusted frame for data types with long name

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE i        AS INTEGER                NO-UNDO.
DEFINE VARIABLE max-key  AS INTEGER   INITIAL 16   NO-UNDO.
DEFINE VARIABLE p_count  AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_cursor AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_delid  AS INTEGER   INITIAL 2000 NO-UNDO.
DEFINE VARIABLE p_dir    AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_flag   AS INTEGER   EXTENT  2000 NO-UNDO.
DEFINE VARIABLE p_flag#  AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_help   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE p_scrap  AS CHARACTER              NO-UNDO.
DEFINE VARIABLE p_init   AS INTEGER   INITIAL ?    NO-UNDO.
DEFINE VARIABLE p_key    AS CHARACTER EXTENT  3    NO-UNDO.
DEFINE VARIABLE p_line   AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_mark   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE p_name   AS CHARACTER EXTENT  2000 NO-UNDO.
DEFINE VARIABLE p_recid  AS INTEGER   INITIAL 1    NO-UNDO.
DEFINE VARIABLE p_redraw AS LOGICAL   INITIAL TRUE NO-UNDO.
  /* frame line of first non indexed field */
DEFINE VARIABLE p_top    AS INTEGER   INITIAL 2    NO-UNDO.
DEFINE VARIABLE p_typed  AS CHARACTER              NO-UNDO.
/* total number of fields in the table */
DEFINE VARIABLE p_total  AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_current AS INTEGER  INITIAL 0    NO-UNDO.
/*array with the fields chosen by the user*/ 
DEFINE VARIABLE p_chosen AS CHARACTER EXTENT  16   NO-UNDO.
/*max number of lines in the upper part of the list*/
DEFINE VARIABLE p_maxl   AS INTEGER   INITIAL 10   NO-UNDO. 
DEFINE VARIABLE j        AS INTEGER                NO-UNDO.
/*flag keeps track if the last line in the uuper part of 
  the list is the last field chosen*/
DEF VAR flag AS INT INITIAL 0. 

user_env[4] = "".

FOR EACH _Field
  WHERE _Field._File-recid = drec_file
    AND (_Extent = 0 OR user_env[2] matches "*w*")
    AND (_Data-type = "character" OR NOT user_env[2] matches "*w*")
    AND (_Data-type <> "BLOB" AND _Data-type <> "CLOB" AND _Data-type <> "XLOB")
    BY _Field-name:
  ASSIGN
    p_count = p_count + 1
    p_name[p_count] = STRING(_Field-name,"x(26)") + STRING(_Data-type,"x(11)").
END.
IF p_count = 0 THEN RETURN.
ASSIGN p_total = p_count.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 9 NO-UNDO INITIAL [
  /* 1*/ "Use",
  /* 2*/ "to add component",
  /* 3*/ "to remove component",
  /* 4*/ "to save",
  /* 5*/ "to undo",
  /* 6*/ "Type ~"y~" for an ascending component, or ~"n~" for descending",
  /* 7*/ ?, /* see below */
  /* 8*/ "You cannot add any more components to this index.",
  /* 9*/ ""
].
new_lang[7] = "Do you want this to be an ascending index component?  "
            + "Answering ~"no~" will make it a descending index component.".

FORM
  p_mark FORMAT "x(46)"
  HEADER "Num Field Name                       Type Asc?"
  WITH FRAME pick SCROLL 1 OVERLAY NO-LABELS ATTR-SPACE
  SCREEN-LINES - 7 DOWN ROW 3 COLUMN 2
  TITLE " Adding Index ~"" + user_env[1] + "~" ".

FORM
  "Use the cursor-motion keys"               SKIP /*row#4*/
  "to navigate, or type field"               SKIP /*row#5*/
  "name and hilite will move."               SKIP /*row#6*/
  " "                                        SKIP /*row#7*/
  "As you select fields to be"               SKIP /*row#8*/
  "key components, they are"                 SKIP /*row#9*/
  "moved above the dividing"                 SKIP /*row#10*/
  "line.  Use"       p_key[1] FORMAT "x(15)" SKIP /*row#11*/
  "to select fields."                        SKIP /*row#12*/
  "To set asc/desc, use +/-"                 SKIP /*row#13*/
  "keys."                                    SKIP /*row#14*/
  " "                                        SKIP /*row#15*/
  "To unselect fields, move"                 SKIP /*row#16*/
  "hilite above dividing line"               SKIP /*row#17*/
  "and"              p_key[2] FORMAT "x(22)" SKIP /*row#18*/
  "When done, press" p_key[3] FORMAT "x(9)"  SKIP /*row#19*/
  WITH FRAME note OVERLAY NO-LABELS NO-ATTR-SPACE ROW 3 COLUMN 52 USE-TEXT.

FORM
  SPACE(29) /* this must match width of frame 'note' exactly */
  WITH FRAME cover OVERLAY NO-BOX NO-ATTR-SPACE
  (SCREEN-LINES - 21) DOWN ROW 21 COLUMN 52.
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

PAUSE 0.
DISPLAY FILL("-",80) @ p_mark WITH FRAME pick.
DOWN WITH FRAME pick.
DISPLAY
  "[" + KBLABEL("RETURN") + "]"  @ p_key[1]
  "[" + KBLABEL("RETURN") + "]." @ p_key[2]
  "[" + KBLABEL("GO")     + "]." @ p_key[3]
  WITH FRAME note.
IF SCREEN-LINES > 21 THEN VIEW FRAME cover.

DO WHILE TRUE WITH FRAME pick:

  p_recid = MAXIMUM(MINIMUM(p_count,p_recid),1).

  IF p_redraw THEN DO:
    ASSIGN
      p_line   = MAXIMUM(p_top,FRAME-LINE)
      p_cursor = p_recid - (IF p_init = ? THEN p_line ELSE p_init) + p_top.
    UP p_line - p_top.
    IF p_cursor < 1 THEN ASSIGN
      p_cursor = 1
      p_line   = p_top
      p_recid  = 1.
    DO WHILE TRUE:
      IF p_cursor > p_count THEN
        CLEAR NO-PAUSE.
      ELSE
        DISPLAY "   " + p_name[p_cursor] @ p_mark.
      p_cursor = p_cursor + 1.
      IF FRAME-LINE < FRAME-DOWN THEN DOWN. ELSE LEAVE.
    END.
    p_line = (IF p_init = ? THEN p_line ELSE p_init).
    UP FRAME-DOWN - p_line.
    ASSIGN
      p_init   = ?
      p_redraw = FALSE.
  END.

  /*Use [RET] to add components, [GO] when done, [END-ERR] to undo.*/
  /*Use [RET] to remove component, [GO] when done, [END-ERR] to undo.*/
  ASSIGN
    p_mark = p_help
    p_help = new_lang[1]
           + " [" + KBLABEL("RETURN") + "]"
           + " " + new_lang[IF FRAME-LINE >= p_top THEN 2 ELSE 3]
           + ", [" + KBLABEL("GO") + "] "
           + new_lang[4]
           + ", [" + KBLABEL("END-ERROR") + "] "
           + new_lang[5] + ".".
  IF p_mark <> p_help THEN DO:
    user_status = p_help.
    STATUS DEFAULT user_status.
  END.
  IF FRAME-LINE >= p_top THEN DISPLAY "   " + p_name[p_recid] @ p_mark.
  
  COLOR DISPLAY MESSAGES p_mark.
  READKEY.
  COLOR DISPLAY NORMAL   p_mark.
  PAUSE 0.

  IF CAN-DO("+,=,-",CHR(LASTKEY)) AND FRAME-LINE < p_top THEN .
  ELSE
  IF p_count > 0 AND (KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND LASTKEY > 32)
    OR (KEYFUNCTION(LASTKEY) = "BACKSPACE" AND LENGTH(p_typed) > 0) THEN DO:
    IF FRAME-LINE < p_top THEN DOWN p_top - FRAME-LINE.
    p_typed = (IF KEYFUNCTION(LASTKEY) = "BACKSPACE"
              THEN SUBSTRING(p_typed,1,LENGTH(p_typed) - 1)
              ELSE p_typed + CHR(LASTKEY)).
    IF p_typed = "" OR p_name[p_recid] BEGINS p_typed THEN NEXT.
    DO p_line = p_recid TO p_count:
      IF p_name[p_line] BEGINS p_typed THEN LEAVE.
    END.
    IF p_line > p_count THEN DO:
      DO p_line = 1 TO p_recid:
        IF p_name[p_line] BEGINS p_typed THEN LEAVE.
      END.
      IF p_line > p_recid THEN p_line = p_count + 1.
    END.
    IF p_line > p_count THEN DO:
      p_typed = CHR(LASTKEY).
      DO p_line = 1 TO p_count:
        IF p_name[p_line] BEGINS p_typed THEN LEAVE.
      END.
    END.
    IF p_line <= p_count THEN ASSIGN
      p_recid  = p_line
      p_redraw = TRUE.
    NEXT.
  END.
  p_typed = "". /* if keyfunction, reset keys to null string */

  IF CAN-DO("=,+,-",CHR(LASTKEY)) AND p_top > 2 AND FRAME-LINE < p_top THEN DO:
    DISPLAY SUBSTRING(INPUT p_mark,1,41)
      + STRING(CHR(LASTKEY) = "-","no/yes") @ p_mark.
  END.
  ELSE
  IF CAN-DO("RETURN",KEYFUNCTION(LASTKEY)) THEN _return: DO:
    /* only one component allowed in word index */
   IF p_count > 0 AND FRAME-LINE >= p_top AND
      ((p_total - p_count) = max-key  OR (user_env[2] matches "*w*" AND p_top > 2))
      THEN DO:
      MESSAGE new_lang[8]. /* too many parts */
      LEAVE _return.
    END.
    IF p_top > 2 AND FRAME-LINE < p_top THEN DO:    /* <-- delete component */
      ASSIGN
        p_scrap = SUBSTRING(INPUT p_mark,4,37).
       /* check if user has chosen <p_maxl> field or less*/
        IF (p_total - p_count) <= p_maxl THEN DO:
            ASSIGN p_top   = p_top - 1.
            DISPLAY "" @ p_mark.
            SCROLL FROM-CURRENT UP.
            DO WHILE FRAME-LINE < p_top - 1:
                DISPLAY STRING(FRAME-LINE,"Z9") + SUBSTRING(INPUT p_mark,3) @ p_mark.
                DOWN 1.
            END.
            DOWN 1. /* skip over ---- line */
        END.
        /*User has chosen more than <p_maxl> fields*/
        ELSE DO:
            /* Should never happen, but if there was a blank line left,
                  remove it from top part of the list*/ 
            IF p_scrap = "" THEN flag = 1.
            /*if we don't need to scroll down */
            IF flag = 0 THEN DO:
                DO i = 1 TO max-key:
                   IF TRIM(substring(p_chosen[i],1,37)) = TRIM(p_scrap)  THEN LEAVE.
                END.

                DO j = (i + 1) TO max-key:
                   DISPLAY STRING(j - 1,"Z9") + " " + p_chosen [j] @ p_mark.
                   DOWN 1.
                   IF FRAME-LINE = (p_top - 1) THEN LEAVE.
                END.
            END.
            ELSE DO:
                /*we need to scroll down what's above p_top */
                UP FRAME-LINE - 1.
                p_current = INTEGER(SUBSTRING(INPUT p_mark,1,3)).
                IF p_current = 1 THEN p_current = p_current + 1.
                IF (p_total - p_count) = (p_maxl + 1) THEN
                    i = 1.
                ELSE
                    ASSIGN i = (p_current - 1 ).
                DO j = i  TO max-key:
                    IF  TRIM(substring(p_chosen[j],1,37)) <> TRIM(p_scrap) THEN DO:
                       DISPLAY STRING(i ,"Z9") + " " + p_chosen [j] @ p_mark.
                       DOWN 1.
                    END.
                    ELSE i = i - 1.  /* decrease i as we skipped the deleted field */
                    IF FRAME-LINE = (p_top - 1) THEN LEAVE.
                    ASSIGN    i = i + 1.
                 END.
            END.
            /* DOWN 1.*/
            UP 1.
            IF FRAME-LINE = (p_top - 2) THEN DO:
              p_current = INTEGER(SUBSTRING(INPUT p_mark,1,3)).               
              /*keep flaf if user is seeing the last field chosen. */
              IF p_current = (p_total - p_count - 1) THEN flag = 1.
              ELSE flag = 0. 
            END.
            DOWN 2.
        END.
      /*SCROLL FROM-CURRENT DOWN.*/

       /*search through p_chosen to find the line and delete it. then re-arrange the array */
        DO i = 1 TO max-key:
            /*found the line*/
            IF TRIM(substring(p_chosen[i],1,37)) = TRIM(p_scrap) THEN DO:
               /* rearrange the array*/
               DO j = i TO max-key:
                   IF p_chosen[j] = "" THEN LEAVE.
                   IF j = max-key THEN 
                        p_chosen[max-key] = "". /* item maxkey is always blank when deleting */
                   ELSE
                   p_chosen[j] = p_chosen[ j + 1].
               END.
           END.
        END.

   /* to avoid including blank lines in the lower part of the list*/ 
     IF p_scrap <> ""  THEN DO:
     /* now re-insert this field into the lower part of the list */
      DO i = 2000 TO p_delid BY -1:
        IF p_name[i] = p_scrap THEN LEAVE.
      END.
      DO WHILE i > p_delid:
        p_name[i] = p_name[i - 1].
        i = i - 1.
      END.
      DO i = p_count TO 1 BY -1:
        p_name[i + 1] = p_name[i].
        IF p_name[i] < p_scrap THEN LEAVE.
      END.
      ASSIGN
        p_delid       = p_delid + 1
        p_count       = p_count + 1
        p_name[i + 1] = p_scrap
        p_redraw      = TRUE
        p_recid       = 1.
      /*DOWN p_top - FRAME-LINE.*/
     END. /* if p_scrap <> "" */
    END. /* delete component */
    ELSE
    IF p_count > 0 AND FRAME-LINE >= p_top THEN DO:    /* <-- add component */
      /* don't ask about asc/dec on word index */
      IF NOT user_env[2] matches "*w*" THEN
      DO:
        user_status = new_lang[6].
        STATUS DEFAULT user_status. /* use +/- for asc/desc key */
        PUT CURSOR ROW FRAME-LINE + 5 COLUMN 45.
        READKEY PAUSE 0.
        PUT CURSOR OFF.
        p_dir = ?.
        IF CAN-DO("y,a,=,+,RETURN,GO",KEYFUNCTION(LASTKEY)) THEN p_dir = TRUE.
        IF CAN-DO("n,d,-",KEYFUNCTION(LASTKEY)) THEN p_dir = FALSE.
      END.
      ELSE
      p_dir = TRUE.

      IF p_dir = ? AND KEYFUNCTION(LASTKEY) <> "END-ERROR" THEN DO:
        user_status = "".
        STATUS DEFAULT user_status.
        p_dir = TRUE.
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT p_dir,?,?,new_lang[7]).
      END.
      user_status = p_help.
      STATUS DEFAULT user_status.
      IF p_dir = ? OR KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _return.
      flag = 1. /*it is always scrolled down to the last field chosen*/  
      IF (p_total - p_count) < p_maxl THEN DO:
         p_top = p_top + 1.
         UP FRAME-LINE - p_top + 2.
         DISPLAY STRING(p_top - 2,"Z9") + " " + p_name[p_recid] + " "
         + STRING(p_dir,"yes/no") @ p_mark.
         ASSIGN p_chosen [p_total - p_count + 1] = SUBSTRING(INPUT p_mark,4,50).
            
         DOWN.
         DISPLAY FILL("-",80) @ p_mark.
         DOWN.
      END.
      ELSE DO:
         UP FRAME-LINE - p_top + 2.
         /*if last line is the last field*/
              
         p_current = INTEGER(SUBSTRING(INPUT p_mark,1,3)).
         IF p_current = (p_total - p_count) THEN DO:
             j = (p_total - p_count) - p_maxl + 2.
         END.
         ELSE DO :
             p_current = (p_total - p_count).
             j = (p_total - p_count) - p_maxl + 2.
         END.
         UP FRAME-LINE - 1.
         DO i = j TO p_current:
            DISPLAY STRING(i ,"Z9") + " " + p_chosen [i] @ p_mark.
            DOWN 1.
         END.
         DISPLAY STRING(p_current + 1,"Z9") + " " + p_name[p_recid] + " "
          + STRING(p_dir,"yes/no") @ p_mark.
         ASSIGN p_chosen [p_total - p_count + 1] = SUBSTRING(INPUT p_mark,4,50).

         DOWN 2. /* skip to p_top line*/
      END.
      
      /* now remove this field from the lower part of the list */
      ASSIGN
        p_name[p_delid]     = p_name[p_recid]
        p_delid             = p_delid - 1
        p_name[p_count + 1] = ""
        p_count             = p_count - 1.
      DO i = p_recid TO p_count + 1:
        p_name[i] = p_name[i + 1].
      END.
    END.
    ASSIGN
      p_recid  = MINIMUM(p_recid,p_count)
      p_redraw = TRUE.
    DOWN p_top - FRAME-LINE.
  END.
  ELSE
  IF CAN-DO("CURSOR-DOWN,TAB, ",KEYFUNCTION(LASTKEY))
    AND (FRAME-LINE < p_top OR p_recid < p_count) THEN DO:
    IF FRAME-LINE >= p_top AND p_count > 0 THEN p_recid = p_recid + 1.
    IF FRAME-LINE = FRAME-DOWN THEN DO:
      UP FRAME-LINE - p_top.
      SCROLL FROM-CURRENT UP.
      DOWN FRAME-DOWN - FRAME-LINE.
    END.
    ELSE  DO:
       /* when above the top line */
       p_current = INTEGER(SUBSTRING(INPUT p_mark,1,3)).
       
       IF FRAME-LINE = (p_top - 2) THEN DO:
         /*keep flag if user is seeing the last field chosen. */
         IF p_current = (p_total - p_count) THEN flag = 1.
         ELSE flag = 0. 

         IF p_current <> max-key AND p_chosen[p_current + 1] <> "" THEN DO:
           UP FRAME-LINE - 1.
           DO i = ( p_current - p_maxl + 2) TO max-key:
               DISPLAY STRING(i,"Z9") + " " + p_chosen [i] @ p_mark.
               IF FRAME-LINE = (p_top - 1) OR i = p_current + 1 THEN LEAVE.
               DOWN 1.
           END.
         END.
         ELSE   
             IF (FRAME-LINE < p_top OR p_count > 0 )  THEN DOWN. 
       END.
       ELSE
           IF (FRAME-LINE < p_top OR p_count > 0 )  THEN DOWN. 
    END.
    IF FRAME-LINE = p_top - 1 THEN DOWN 1.
  END.
  ELSE
  IF CAN-DO("CURSOR-UP,BACK-TAB",KEYFUNCTION(LASTKEY)) THEN DO:
    IF FRAME-LINE = (p_top - 2 ) THEN DO:
        p_current = INTEGER(SUBSTRING(INPUT p_mark,1,3)).
        IF p_current = (p_total - p_count) THEN flag = 1.
        ELSE flag = 0. 
    END.

    IF p_recid > 1 THEN DO:
      p_recid = p_recid - 1.
      IF FRAME-LINE = p_top THEN
        SCROLL FROM-CURRENT DOWN.
      ELSE
        UP.
    END.
    ELSE IF p_top > 2 THEN DO:
      IF FRAME-LINE > 1 THEN UP 1.
      IF FRAME-LINE = p_top - 1 THEN UP 1.
      /*check if we need to scroll up*/
      IF FRAME-LINE = 1 THEN 
      DO:
          p_current = INTEGER(SUBSTRING(INPUT p_mark,1,3)).
          IF (p_total - p_count) > p_maxl AND ( p_current <> 1) THEN 
          DO:
            DO i = ( p_current - 1) TO max-key:
                DISPLAY STRING(i,"Z9") + " " + p_chosen [i] @ p_mark.
                DOWN 1.
                IF FRAME-LINE = (p_top - 1) OR i = (i + 8) THEN LEAVE.
            END.
            UP FRAME-LINE - 1.
            flag = 0 . /* the p_maxl line is not the last field chosen */
          END.
      END.
    END.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN DO:
    IF FRAME-LINE < p_top THEN DOWN p_top - FRAME-LINE.
    ASSIGN
      p_recid  = p_recid + FRAME-DOWN - p_top
      p_redraw = TRUE.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN DO:
    IF FRAME-LINE < p_top THEN DOWN p_top - FRAME-LINE.
    ASSIGN
      p_recid  = p_recid - FRAME-DOWN - p_top
      p_redraw = TRUE.
  END.
  ELSE
  IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
    IF FRAME-LINE < p_top THEN DOWN p_top - FRAME-LINE.
    ASSIGN
      p_recid  = 1
      p_redraw = TRUE.
    UP FRAME-LINE - p_top.
  END.
  ELSE
  IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
    IF FRAME-LINE < p_top THEN DOWN p_top - FRAME-LINE.
    ASSIGN
      p_recid  = p_count
      p_redraw = TRUE.
    DOWN FRAME-DOWN - FRAME-LINE.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "GO" AND p_top > 2 THEN DO:
 
    DO i = 1 TO max-key:
      ASSIGN 
        p_mark = p_chosen[i]
        user_env[i + 3] 
          = SUBSTRING(p_mark,1,INDEX(p_mark," ") - 1) + ","
          + STRING(SUBSTRING(p_mark,39,1) = "y","+/-").
        
        IF p_mark = "" THEN DO: 
           USER_env[i + 3] = "".
           LEAVE.
        END.
    END.
    LEAVE.
  END.
  ELSE
  IF CAN-DO("GO,END-ERROR",KEYFUNCTION(LASTKEY)) THEN DO:
    user_env[1] = "".
    LEAVE.
  END.

  p_line = 1.
END.

HIDE FRAME note  NO-PAUSE.
HIDE FRAME pick  NO-PAUSE.
HIDE FRAME cover NO-PAUSE.
user_status = ?.
STATUS DEFAULT.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 

History:  D. McMann  Adjust frame for data types with long names

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE qbf_draw AS LOGICAL INITIAL TRUE NO-UNDO.
DEFINE VARIABLE qbf_home AS RECID   INITIAL ?    NO-UNDO.
DEFINE VARIABLE qbf_line AS INTEGER              NO-UNDO.
DEFINE VARIABLE qbf_loop AS INTEGER INITIAL 0    NO-UNDO.
DEFINE VARIABLE qbf_save AS RECID                NO-UNDO.
DEFINE SHARED VARIABLE qbf_rec AS RECID NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 3 NO-UNDO.
ASSIGN
  new_lang[1] =
    "Use the cursor-keys to scroll through the list of index components."
  new_lang[2] = "There are no index key components in this index."
  new_lang[3] = "Press the [" + KBLABEL("END-ERROR")
              + "] key when done browsing.".

FORM
  _Index-field._Index-Seq  FORMAT ">>"       LABEL "Seq"
    ATTR-SPACE SPACE(0)
  _Field._Field-Name       FORMAT "x(25)"    LABEL "Field Name"
    NO-ATTR-SPACE
  _Field._Data-Type        FORMAT "x(11)"     LABEL "Type"
    ATTR-SPACE SPACE(0)
  _Index-field._Ascending  FORMAT "Asc/Desc" LABEL "Asc"
    NO-ATTR-SPACE
  _Index-field._Abbreviate FORMAT "Yes/No"   LABEL "Abbr"
    ATTR-SPACE
  WITH FRAME idx_browse
  OVERLAY ROW 5 COLUMN 27 ATTR-SPACE SCREEN-LINES - 9 DOWN SCROLL 1
  TITLE " Index Browse for ~"" + _Index._Index-name + "~" ".

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

STATUS DEFAULT new_lang[3]. /* press [end-error] when done */

FIND _Index
  WHERE _Index._File-recid = drec_file AND _Index._Index-name = user_env[1].

DO FOR _Index-field:
  FIND FIRST _Index-field OF _Index NO-ERROR.
  IF NOT AVAILABLE _Index-field THEN DO:
    MESSAGE new_lang[2]. /* no key components */
    RETURN.
  END.
  qbf_home = RECID(_Index-field).
END.

DO FOR _Index-field WITH FRAME idx_browse: /* scoping block */

  PAUSE 0.
  VIEW FRAME idx_browse.
  FIND FIRST _Index-field OF _Index NO-ERROR.

  DO WHILE TRUE: /* iterating block */

    IF qbf_draw THEN DO:
      HIDE MESSAGE NO-PAUSE.
      MESSAGE "". /* get to second line */
      MESSAGE COLOR NORMAL new_lang[1]. /* use cursor keys... */
      ASSIGN
        qbf_save = RECID(_Index-field)
        qbf_draw = FALSE
        qbf_line = FRAME-LINE.
      IF qbf_line > 1 THEN DO qbf_loop = 2 TO FRAME-LINE:
        IF AVAILABLE _Index-field THEN
          FIND PREV _Index-field OF _Index NO-ERROR.
        IF NOT AVAILABLE _Index-field THEN qbf_line = qbf_line - 1.
      END.
      UP FRAME-LINE - 1.
      IF NOT AVAILABLE _Index-field THEN
        FIND FIRST _Index-field OF _Index NO-ERROR.
      DO qbf_loop = 1 TO FRAME-DOWN:
        IF AVAILABLE _Index-field THEN DO:
          FIND _Field OF _Index-field.
          DISPLAY _Index-field._Index-Seq _Field._Field-Name _Field._Data-Type
            _Index-field._Ascending _Index-field._Abbreviate.
        END.
        ELSE
          CLEAR NO-PAUSE.
        IF qbf_loop = FRAME-DOWN THEN LEAVE.
        DOWN.
        IF NOT AVAILABLE _Index-field THEN NEXT.
        FIND NEXT _Index-field OF _Index NO-ERROR.
      END.
      FIND _Index-field WHERE RECID(_Index-field) = qbf_save NO-ERROR.
      UP FRAME-DOWN - qbf_line.
    END.

    IF AVAILABLE _Index-field THEN DO:
      FIND _Field OF _Index-field.
      DISPLAY _Index-field._Index-Seq _Field._Field-Name _Field._Data-Type
        _Index-field._Ascending _Index-field._Abbreviate.
      COLOR DISPLAY MESSAGES _Index-field._Index-Seq _Field._Field-Name
        _Field._Data-Type _Index-field._Ascending _Index-field._Abbreviate.
    END.
    READKEY.
    IF AVAILABLE _Index-field THEN COLOR DISPLAY NORMAL
      _Index-field._Index-Seq _Field._Field-Name _Field._Data-Type
      _Index-field._Ascending _Index-field._Abbreviate.

    IF CAN-DO("CURSOR-DOWN,TAB, ",KEYFUNCTION(LASTKEY)) THEN DO:
      FIND NEXT _Index-field OF _Index NO-ERROR.
      IF AVAILABLE _Index-field THEN DO:
        IF FRAME-LINE = FRAME-DOWN THEN
          SCROLL UP.
        ELSE
          DOWN.
      END.
      ELSE
        FIND LAST _Index-field OF _Index NO-ERROR.
      NEXT.
    END.

    IF CAN-DO("CURSOR-UP,BACK-TAB,BACKSPACE",KEYFUNCTION(LASTKEY)) THEN DO:
      FIND PREV _Index-field OF _Index NO-ERROR.
      IF AVAILABLE _Index-field THEN DO:
        IF FRAME-LINE = 1 THEN
          SCROLL DOWN.
        ELSE
          UP.
      END.
      ELSE
        FIND FIRST _Index-field OF _Index NO-ERROR.
      NEXT.
    END.

    IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN DO:
      qbf_draw = TRUE.
      DO qbf_loop = 1 TO FRAME-DOWN:
        FIND NEXT _Index-field OF _Index NO-ERROR.
        IF NOT AVAILABLE _Index-field THEN DO:
          FIND LAST _Index-field OF _Index NO-ERROR.
          DOWN FRAME-DOWN - FRAME-LINE.
          LEAVE.
        END.
      END.
      NEXT.
    END.

    IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN DO:
      qbf_draw = TRUE.
      DO qbf_loop = 1 TO FRAME-DOWN:
        FIND PREV _Index-field OF _Index NO-ERROR.
        IF NOT AVAILABLE _Index-field THEN DO:
          FIND FIRST _Index-field OF _Index NO-ERROR.
          UP FRAME-LINE - 1.
          LEAVE.
        END.
      END.
      NEXT.
    END.

    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY))
      AND AVAILABLE _Index-field AND RECID(_Index-field) <> qbf_home THEN DO:
      qbf_draw = TRUE.
      UP FRAME-LINE - 1.
      FIND FIRST _Index-field OF _Index NO-ERROR.
      NEXT.
    END.

    IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
      qbf_draw = TRUE.
      DOWN FRAME-DOWN - FRAME-LINE.
      FIND LAST _Index-field OF _Index NO-ERROR.
      NEXT.
    END.

    IF CAN-DO("END-ERROR,GET",KEYFUNCTION(LASTKEY)) THEN LEAVE.

  END. /* iterating block */
END. /* scoping block */

HIDE MESSAGE NO-PAUSE.
STATUS DEFAULT.
HIDE FRAME idx_browse NO-PAUSE.
RETURN.
/***********************************************************************
* Copyright (C) 2008,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
************************************************************************/

/*----------------------------------------------------------------------------

File: _usrichg.p

Description:
   TTY module to allow changes to index properties. 

History:
    05/31/96    tomn        Added rowid support for multi-component indexes. 
    02/09/98    mcmann      Added character display of _ianum.
    03/31/98    mcmann      Changed display of _ianum to Area Name
    04/14/98    laurief     fixed bug 98-04-09-004 - removed APPLY LEAVE
                            if not is-area on line 247-248 and moved prompt for
                            indexarea to last field in idx_top frame
    04/15/98    mcmann      Added check for is-area being not true to know
                            if area has been checked.  If field is not entered
                            the leave trigger does not fire.
    04/17/98    mcmann      Added check of field recid > 0 for default index
                            changes.
    04/20/98    mcmann      default _index now as fields so added delete of
                            _index-field records.  Also changed where the area
                            name is gotten from since the SQL meta-schema does
                            not have an ianum.
    04/21/98    mcmann      Further changes handling proper area information
    12/11/98    mcmann      Changed not allowed to change uniqueness message to be displayed as
                            alert-box.
    12/28/98   Mario B      Add s_In_Schema_Area enabling one time notification. 
    05/15/00   D. McMann    Removed message when only Schema Area in DB    
    06/14/00   D. McMann    Added selection list for areas.  
    08/16/00   D. McMann    Added _db-recid to StorageObject find 20000815029   
    07/29/03   D. McMann    Adjusted screen for new data types with long names 
    03/26/05   K. McIntosh  Added warning when attempting to add an active
                            index on-line
    06/08/06  fernando      Support for large key entries
    10/03/07  fernando      Fixed delimiter issue on area name list - OE00135682
    11/16/07  fernando      Support for _aud-audit-data* indexes deactivation
    06/26/08  fernando      Filter out schema tables for encryption

----------------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/pro/arealabel.i}

DEFINE VARIABLE answer         AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE c              AS CHARACTER               NO-UNDO.
DEFINE VARIABLE i              AS INTEGER                 NO-UNDO.
DEFINE VARIABLE in_trans       AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE is_prime       AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE j              AS INTEGER                 NO-UNDO.
DEFINE VARIABLE qbf#           AS INTEGER   INITIAL 1     NO-UNDO.
DEFINE VARIABLE qbf#list       AS CHARACTER               NO-UNDO.
DEFINE VARIABLE qbf_disp       AS RECID     INITIAL ?     NO-UNDO.
DEFINE VARIABLE qbf_home       AS RECID                   NO-UNDO.
DEFINE VARIABLE qbf_idx_deac   AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE qbf_idx_max    AS INTEGER                 NO-UNDO.
DEFINE VARIABLE qbf_idx_nonu   AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE qbf_idx_num    AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE qbf_idx_uniq   AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE qbf_idx_word   AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE qbf_text       AS CHARACTER               NO-UNDO.
DEFINE VARIABLE qbf_was        AS INTEGER   INITIAL 2     NO-UNDO.
DEFINE VARIABLE r              AS RECID                   NO-UNDO.
DEFINE VARIABLE recid_idx      AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE recid_idx1     AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE redraw         AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE rpos           AS RECID                   NO-UNDO.
DEFINE VARIABLE scratch        AS CHARACTER               NO-UNDO.
DEFINE VARIABLE word_index     AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE adding         AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE edbtyp         AS CHARACTER               NO-UNDO. /* db-type external format */
DEFINE VARIABLE warnflg        AS CHAR                    NO-UNDO.
DEFINE VARIABLE l_ifldcnt      AS INT                     NO-UNDO.
DEFINE VARIABLE areaname       AS CHARACTER               NO-UNDO.
DEFINE VARIABLE arealist       AS CHARACTER INITIAL ?     NO-UNDO.
DEFINE VARIABLE indexarea      AS CHARACTER               NO-UNDO.
DEFINE VARIABLE lOk            AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE large_idx      AS LOGICAL                 NO-UNDO INIT ?.
DEFINE VARIABLE ctemp          AS CHARACTER               NO-UNDO.
DEFINE VARIABLE canAudDeact    AS LOGICAL                 NO-UNDO.
define variable cAreaLabel     as character               no-undo.
define variable cAreaMTText    as character               no-undo.

DEFINE BUFFER bfr_Index FOR DICTDB._Index.

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE qbf AS CHARACTER EXTENT 16 NO-UNDO INITIAL [
  "Next",   "Prev",        "First",         "Last",       "Rename",
  "Add",    "Delete",      "ChangePrimary", "Uniqueness", "MakeInactive",
  "Browse", "SwitchTable", "GoField",       "ROWID",      "Undo",
  "Exit"
].

FORM
  qbf[ 1] /*Next*/              FORMAT "x(4)"
    HELP "Look at the next index of this table."
  qbf[ 2] /*Prev*/              FORMAT "x(4)"
    HELP "Look at the previous index of this table."
  qbf[ 3] /*First*/             FORMAT "x(5)"
    HELP "Look at the first index of this table."
  qbf[ 4] /*Last*/              FORMAT "x(4)"
    HELP "Look at the last index of this table."
  qbf[ 5] /*Rename*/            FORMAT "x(6)"
    HELP "Rename an index."
  qbf[ 6] /*Add*/               FORMAT "x(3)"
    HELP "Add a new index."
  qbf[ 7] /*Delete*/            FORMAT "x(6)"
    HELP "Delete the currently displayed index."
  qbf[ 8] /*ChangePrimary*/     FORMAT "x(13)"
    HELP "Change the Primary Index of this table."  
  qbf[ 9] /*Uniqueness*/        FORMAT "x(10)"
    HELP "Change the Uniqueness of this index." SKIP
  qbf[10] /*MakeInactive*/      FORMAT "x(12)"
    HELP "Make an active index inactive." 
  qbf[11] /*Browse*/            FORMAT "x(6)"
    HELP "Browse through entire index component list." 
  qbf[12] /*SwitchTable*/       FORMAT "x(11)"
   HELP "Switch to another table."
  qbf[13] /*GoField*/           FORMAT "x(7)"
    HELP "Go to Fields Editor."
  qbf[14] /*ROWID*/             FORMAT "x(5)"
    HELP "Use this index for ROWID-support." /* only oracle, odbc */
  qbf[15] /*Undo*/              FORMAT "x(4)"
    HELP "Undo this session's changes to the index structures."
  qbf[16] /*Exit*/              FORMAT "x(4)"
    HELP "Exit Index Editor, save changes, and return to menu."
  WITH FRAME qbf ATTR-SPACE OVERLAY NO-LABELS NO-BOX 
  ROW SCREEN-LINES - 3 COLUMN 3 CENTERED WIDTH 76.
/*
|  Next  Prev  First  Last  Rename  Add  Delete  ChangePrimary  Uniqueness
|  MakeInactive  Browse  SwitchTable  GoField  Undo  Exit
*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 38 NO-UNDO INITIAL [
  /* 1*/ "This index is already the Primary Index of this table.",
  /* 2*/ "Are you sure that you want to make this the PRIMARY INDEX?",
  /* 3*/ "You cannot delete the Primary Index of a table.",
  /* 4*/ "Set another index to be the Primary and then try again.",
  /* 5*/ "Are you sure that you want to remove this index?",
  /* 6*/ "Undo all changes since selection of Index Update from menu?",
  /* 7*/ "You cannot rename the ~"default~" index.",
  /* 8*/ "This table has no user-created indexes.",
  /* 9*/ "You have reached the last index in the table.",
  /*10*/ "You have reached the first index in the table.",
  /*11*/ "This operation is not supported on table type", /* type appended */
  /*12*/ "You may now change the index name.",
  /*13*/ "That index name is already used.",
  /*14*/ ?, /* see below */
  /*15*/ "The dictionary is in read-only mode - alterations not allowed.",
  /*16*/ "You do not have permission to use this option.",
  /*17*/ ?, /* see below */
  /*18*/ "You have no [non-array] fields available for index components.",
  /*19*/ "Cannot deactivate indexes for this database type.",
  /*20*/ "This index has already been deactivated.",
  /*21*/ "Are you sure that you want to make the index", /*see #22*/
  /*22*/ "inactive?", /*see #21*/
  /*23*/ "You haven't yet made changes that need to be undone!",
  /*24*/ "For {&PRO_DISPLAY_NAME}/SQL, you must use the CREATE INDEX statement.",
  /*25*/ "For {&PRO_DISPLAY_NAME}/SQL, you must use the DROP INDEX statement.",
  /*26*/ "A Word Index can not be Primary.",
  /*27*/ "This table is frozen - You may not add or modify its indexes.",
  /*28*/ "A Word Index can not be Unique.",
  /*29*/ "Are you sure that you want to make this index &1?",
  /*30*/ "Uniqueness changes are not supported for &1 databases.",
  /*31*/ "The precision or scale of that field allow values incorrect for ROWID-Index.",
  /*32*/ "Index field is not Unique - Your application has to take care of that.",
  /*33*/ "Index field is not Mandatory - Your application has to take care of that.",
  /*34*/ "Are you sure you want to make this the index for ROWID support?",
  /*35*/ "This DataServer does not support/need ROWID-Indexes to be specified.",
  /*36*/ "This index can not be used for ROWID support.",
  /*37*/ "{&PRO_DISPLAY_NAME}/SQL92 Table, cannot modify.",
  /*38*/ "Large key entries support not enabled"
].

ASSIGN
  new_lang[14] = "~"Abbreviate~" is an index option that lets you "
               + "conveniently search for a partial match based on the first "
               + "few characters of a field (like using BEGINS) in the FIND "
               + "... USING statement.  This option is only available on "
               + "indexes that have a character field as their last index "
               + "component.!!Do you want this to be an abbreviated index?"

  new_lang[17] = "IF {&PRO_DISPLAY_NAME} finds duplicate values while creating this new "
               + "unique index, it will UNDO the entire transaction, causing "
               + "you to lose any schema changes just made.  Creating an "
               + "inactive index and then building it with ~"proutil -C "
               + "idxbuild~" will eliminate this problem.  Do you want to "
               + "de-activate this index?".

FORM " " SKIP
  WITH FRAME idx_box OVERLAY
  ROW 1 COLUMN 1 SCREEN-LINES - 4 DOWN NO-LABELS NO-ATTR-SPACE
  WIDTH 80 USE-TEXT.
 
FORM
  _Index._Index-name FORMAT "x(32)" LABEL "Name" 
    HELP "Please enter the Index Name"         
  is_prime           FORMAT "PRIMARY"                 NO-LABEL   SPACE
  _Index._Unique     FORMAT "UNIQUE/Non-Unique"       NO-LABEL 
    HELP "Please enter U or N for UNIQUE of Non-Unique"          SPACE
  _Index._Active     FORMAT "ACTIVE/Inactive"         NO-LABEL 
    HELP "Please enter A or I for ACTIVE or Inactive"            SPACE 
  word_index         FORMAT "Word/"                   NO-LABEL 
    HELP "Please enter W for WORD index or <BLANK> for standard index" SPACE
  recid_idx          FORMAT "ROWID"                   NO-LABEL          SKIP   
    areaname  COLON 5 VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 NO-LABEL 
    HELP "Please select an area where to store the new index."    
    "Area:"  at col 1 row 3 view-as text size 5 by 1
    cAreaMTText at col 44 row 3 no-label format "x(20)"

  WITH FRAME idx_top OVERLAY ROW 2 COLUMN 2 SIDE-LABELS ATTR-SPACE NO-BOX.

FORM
  _Index._Index-name FORMAT "x(27)" SKIP
  WITH FRAME idx_lst USE-TEXT
  OVERLAY ROW 6 COLUMN 1 NO-LABELS ATTR-SPACE SCREEN-LINES - 11 DOWN SCROLL 1.

FORM
  _Index-field._Index-Seq  FORMAT ">>"       LABEL "Seq"
  _Field._Field-Name       FORMAT "x(21)"    LABEL "Field Name"
  _Field._Data-Type        FORMAT "x(11)"     LABEL "Type"
  _Index-field._Ascending  FORMAT "Asc/Desc" LABEL "Asc"
  _Index-field._Abbreviate FORMAT "Yes/No"   LABEL "Abbr"
  WITH FRAME idx_long OVERLAY USE-TEXT
  ROW 6 COLUMN 32  SCREEN-LINES - 13 DOWN SCROLL 1.

/*
123456789012345678901234567890123456789012345678901234567890123456789012345678

Index: Cust-num________________________  Primary Non-Unique Inactive ROWID
 Area: ________________________________
+----------------------------------++-----------------------------------------+
| idx1                             ||Seq Field Name             Type Asc  Abbr|
| index2                           ||--- ---------------------- ---- ---- ----|
| ix3                              ||  1 1234567890123456789012 Char          |
| index-4                          ||  2                        Date          |
| idx_5                            ||  3                        Logi          |
| ix#6                             ||  4                        Inte          |
| index007                         ||  5                        Deci          |
| 12345678901234567890123456789012 ||  6                        Floa          |
|                                  ||  7                        Reci          |
|                                  ||  8                                      |
|                                  ||  9                                      |
|                                  || 10                                      |
+----------------------------------++-----------------------------------------+
*/


/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/*-----------------------------------Triggers------------------------------*/

/*----- LEAVE of INDEX NAME -----*/
ON LEAVE OF _Index._Index-Name IN FRAME idx_top
DO:
  DEFINE VAR rec_id AS RECID NO-UNDO.

  /* See if there's another index with this name. If there is, 
     put up an error.  Otherwise check the new name.
  */
  rec_id = (IF adding THEN ? ELSE RECID(_Index)).
  FIND FIRST bfr_Index OF _File
    WHERE bfr_Index._Index-name = SELF:SCREEN-VALUE
    AND   RECID(bfr_Index) <> rec_id
    NO-ERROR.
  IF AVAILABLE bfr_Index THEN DO:
    MESSAGE new_lang[13] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
  ELSE DO:
    RUN "adecomm/_valname.p" (SELF:SCREEN-VALUE, INPUT no, OUTPUT answer).    
    IF NOT answer THEN RETURN NO-APPLY.
  END.
END.

/*---- VALIDATE area name ----*/
ON LEAVE OF INPUT FRAME idx_top areaname
DO:
 If _File._File-attributes[1] = FALSE  OR _File._File-attributes[2] = TRUE THEN DO:
  DEFINE VARIABLE ans AS LOGICAL INITIAL FALSE NO-UNDO.
   IF user_dbtype = "PROGRESS" AND adding THEN DO:
     IF INPUT FRAME idx_top areaname:SCREEN-VALUE = ? THEN
       ASSIGN indexarea = INPUT FRAME idx_top areaname:ENTRY(1).
     ELSE
       ASSIGN indexarea = INPUT FRAME idx_top areaname:SCREEN-VALUE.
     FIND DICTDB._Area WHERE DICTDB._Area._Area-name = indexarea NO-LOCK.
     IF NOT s_In_Schema_Area THEN DO:
       IF DICTDB._Area._Area-name = "Schema Area" THEN DO:         
         ASSIGN ans = FALSE.
         FIND FIRST DICTDB._Area WHERE DICTDB._Area._Area-number > 6
                                   AND DICTDB._Area._Area-type = 6
                                   no-lock no-error.
         IF AVAILABLE DICTDB._Area THEN DO:
           MESSAGE "Progress Software Corporation does not recommend" SKIP
                   "creating user indices in the Schema Area." SKIP (1)
                   "Should index be created in this area?" SKIP(1)
                   VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE ans.
           IF ans THEN DO:
             s_In_Schema_Area = TRUE.
              APPLY "GO" TO areaname IN FRAME idx_top.
             RETURN.
           END.  
           ELSE DO:
             s_In_Schema_Area = FALSE.
             APPLY "ENTRY" TO areaname IN FRAME idx_top.
             RETURN NO-APPLY.
           END.
         END.
         ELSE DO:          
           ASSIGN s_In_Schema_Area = TRUE.
           APPLY "GO" TO areaname IN FRAME idx_top.
           RETURN.
         END.
       END.
    END. /* IF NOT s_In_Schema_Area */
    ELSE DO:
      s_In_Schema_Area = TRUE.
      RETURN.
    END.
  END.
 END. /* end of if _File._File-attributes[1] = FALSE  OR _File._File-attributes[2] = TRUE  */
END.


/*============================Mainline code===============================*/

{ prodict/dictgate.i &action=query &dbtype=user_dbtype &dbrec=? &output=c }

FIND _File "_Index".
IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
  MESSAGE new_lang[16] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.
/* In qbf#list, negative numbers are the negated subscripts */
/* from new_lang[] to display when that option is disabled. */
qbf#list = "1,2,3,4,"
         + (IF INDEX(ENTRY(3,c),"r") = 0                THEN "-11" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-write ,USERID("DICTDB")) THEN "-16" ELSE "5")
         + "," +
           (IF INDEX(ENTRY(3,c),"a") = 0                THEN "-11" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN "-16" ELSE "6")
         + "," +
           (IF INDEX(ENTRY(3,c),"d") = 0                THEN "-11" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-delete,USERID("DICTDB")) THEN "-16" ELSE "7")
         + "," +
           (IF INDEX(ENTRY(3,c),"s") = 0 THEN "-11" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-write ,USERID("DICTDB")) THEN "-16" ELSE "8")
         + "," +
           (IF INDEX(ENTRY(3,c),"u") = 0                THEN "-30" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-write ,USERID("DICTDB")) THEN "-16" ELSE "9")
         + "," +
           (IF user_dbtype <> "PROGRESS"                THEN "-11" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-write ,USERID("DICTDB")) THEN "-16" ELSE "10")
         + ",11,12,13," +
           (IF INDEX(ENTRY(3,c),"u") = 0                THEN "-35" ELSE
            IF dict_rog                                 THEN "-15" ELSE
            IF NOT CAN-DO(_Can-write ,USERID("DICTDB")) THEN "-16" ELSE "14")
         + ",15,16".

FIND _File WHERE RECID(_File) = drec_file.

ASSIGN
  edbtyp       = {adecomm/ds_type.i
                   &direction = "itoe"
                   &from-type = "user_dbtype"
                   }
  new_lang[11] = new_lang[11] + " " + (IF _File._Db-lang > 0
                 THEN "PROGRESS/SQL" ELSE edbtyp)
  new_lang[30] = substitute(new_lang[30],edbtyp)
  qbf_idx_max  = MINIMUM(INTEGER(ENTRY(6,c)),16) /* max index key comps    */
  qbf_idx_deac = INDEX(ENTRY(3,c),"i") > 0  /* deactivate indexes allowed? */
  qbf_idx_nonu = INDEX(ENTRY(3,c),"n") > 0  /* non-unique indexes allowed? */
  qbf_idx_num  = INDEX(ENTRY(3,c),"#") > 0  /* idx-num to be generated?    */
  qbf_idx_uniq = INDEX(ENTRY(3,c),"u") > 0  /* change uniqueness allowed?  */
  qbf_idx_word = INDEX(ENTRY(3,c),"w") > 0. /* supports word indexing      */

IF _File._For-type = ? THEN DO:

    /* check if this db supports large index keys 
       just care about large_idx really.
    */
    /* dbs running with pre-10.01B servers will have no knowledge of large key entries
       support, so don't need to display message (in which case large_idx = ?)
    */
    /*
       Pass the DICTDB name since that for non-OE schemas, we will know if
       it is turned on of it's on for the schema holder.
    */
    RUN prodict/user/_usrinf3.p 
          (INPUT  LDBNAME("DICTDB"),
           INPUT  "PROGRESS",
           OUTPUT cTemp, 
           OUTPUT cTemp,
           OUTPUT answer,
           OUTPUT large_idx).

END.

/*IF NOT qbf_idx_uniq THEN ASSIGN qbf[9] = "".*/

IF qbf_idx_word THEN
  FIND FIRST _Field OF _File WHERE _Data-type = "character" NO-LOCK NO-ERROR.
qbf_idx_word = (qbf_idx_word AND AVAILABLE _Field).
RELEASE _Field.

/* OE00135682  - use other delimiter in case area name has comma */
areaname:DELIMITER IN FRAME idx_top = CHR(1).

qbf_block:
DO TRANSACTION ON ERROR UNDO,RETRY:

  in_trans = FALSE. /* no changes made yet */
  FIND FIRST _Index WHERE _Index._File-recid = drec_file NO-ERROR.
  PAUSE 0.
  IF NOT RETRY THEN VIEW FRAME idx_box.
  PAUSE 0.
  
  if _file._file-attributes[1] and _file._file-attributes[2] then
  do:
     cAreaMTText:screen-value in frame idx_top  = "(for default tenant)" .
  end.
  else
     cAreaMTText:screen-value in frame idx_top  = "" .
  
/*  setAreaLabel(areaname:handle in frame idx_top,_file._file-attributes[1]).*/
  /*
  areaname:col = length(areaname:label) + 3.
  areaname:side-label-handle:width  = length(areaname:label) + 1.
  /* shrinking seems to work from left label */
  areaname:side-label-handle:col  = 1.
 */
  VIEW FRAME idx_top.

  PAUSE 0.
  VIEW FRAME idx_lst.
  VIEW FRAME idx_long.

  DO WHILE TRUE:
    ASSIGN
/*      qbf[14] = ( IF CAN-DO("a,u",_Index._I-misc2[1])
                    THEN "ROWID"
                    ELSE ""
                ) */
      rpos    = RECID(_Index).
/* This next line causes BUG 97-12-04-020  */

      /*index-area-number = _Index._ianum.*/

    DISPLAY qbf WITH FRAME qbf.

    IF redraw THEN DO:
      ASSIGN areaname:LIST-ITEMS  IN FRAME idx_top = "".
      FIND FIRST _Index OF _File NO-ERROR.
      ASSIGN
        qbf_disp = ?
        qbf_home = RECID(_Index)
        redraw   = FALSE.
      IF rpos <> ? THEN
        FIND _Index WHERE RECID(_Index) = rpos NO-ERROR.
      ASSIGN
        rpos = RECID(_Index)
        j    = (IF FRAME-LINE(idx_lst) = 0 THEN 1 ELSE FRAME-LINE(idx_lst))
        i    = 3.
      UP j - 1 WITH FRAME idx_lst.
      IF j > 1 THEN DO i = 2 TO j WHILE AVAILABLE _Index:
        FIND PREV _Index WHERE _Index._File-recid = drec_file NO-ERROR.
      END.      
      
      IF NOT AVAILABLE _Index THEN DO:
        FIND FIRST _Index OF _File NO-ERROR.
        j = i - 2.
      END.
      
      DO i = 1 TO FRAME-DOWN(idx_lst):
        IF INPUT FRAME idx_lst _Index._Index-name
          = (IF AVAILABLE _Index THEN _Index._Index-name ELSE "") THEN.
        ELSE IF AVAILABLE _Index THEN DO:
          DISPLAY _Index._Index-name WITH FRAME idx_lst.
          IF user_dbtype = "PROGRESS" THEN DO:

           if _File._File-attributes[1] = TRUE  AND _File._File-attributes[2] = FALSE THEN
                ASSIGN arealist = ""
                       areaname = "".  
           ELSE DO:
            IF _Index._Idx-num <> ? AND _Index._Idx-num <> 0 THEN DO:
               /* first - could have one for each collation */ 
               FIND first _StorageObject WHERE _StorageObject._Db-recid = _File._Db-recid
                                         AND _StorageObject._Object-type = 2
                                         AND _Storageobject._Object-number =
                                                          _Index._Idx-num
                                         AND _Storageobject._Partitionid = 0
                                   NO-LOCK NO-ERROR.
               IF AVAILABLE _StorageObject THEN                    
                 FIND _Area WHERE _Area._Area-number = _StorageObject._Area-number NO-ERROR.
               ELSE
                 FIND _Area WHERE _Area._Area-number = 6 NO-LOCK NO-ERROR.  
            END.
            ELSE
              FIND _Area WHERE _Area._Area-number = _Index._ianum NO-LOCK NO-ERROR.
            IF AVAILABLE _Area THEN  
              ASSIGN  arealist = _Area._Area-name.
            ELSE
              ASSIGN arealist = "N/A".  
           END. /* end of  else loop for _File-attributes[1] = TRUE  AND _File-attributes[2] = FALSE */
          END.  
          ELSE
            ASSIGN arealist = "N/A".
          ASSIGN areaname:LIST-ITEMS  IN FRAME idx_top = arealist
                 indexarea = areaname:ENTRY(1) IN FRAME idx_top.          
        END.
        ELSE
          CLEAR FRAME idx_lst NO-PAUSE.

        COLOR DISPLAY VALUE(IF RECID(_Index) = rpos AND RECID(_Index) <> ?
          THEN "MESSAGES" ELSE "NORMAL") _Index._Index-name WITH FRAME idx_lst.
        DOWN WITH FRAME idx_lst.
        FIND NEXT _Index OF _File NO-ERROR.
      END.
      FIND _Index WHERE RECID(_Index) = rpos NO-ERROR.
      UP FRAME-DOWN(idx_lst) - j + 1 WITH FRAME idx_lst.
    END.

    IF qbf_was <> FRAME-LINE(idx_lst) THEN DO WITH FRAME idx_lst:
      i = FRAME-LINE.
      DOWN qbf_was - i.
      COLOR DISPLAY NORMAL _Index._Index-name.
      DOWN i - qbf_was.
      COLOR DISPLAY MESSAGES _Index._Index-name.
      qbf_was = FRAME-LINE.
    END.

    IF AVAILABLE _Index THEN DO:
/* pause 0. */
      assign
        recid_idx  = substring(_Index._I-misc2[1],1,1,"character") = "r"
        recid_idx1 = ( IF _Index._I-misc2[1] <> ?
                        THEN CAN-DO("a,u,ru,ra,u1,ru1,u2,ru2",_Index._I-misc2[1])
                        ELSE FALSE
                     ).
      IF user_dbtype = "PROGRESS" THEN DO:

       if _File._File-attributes[1] = TRUE  AND _File._File-attributes[2] = FALSE THEN
                 ASSIGN arealist = ""
                        areaname = "".  
       ELSE DO:
        IF _Index._Idx-num <> ? AND _Index._Idx-num <> 0 THEN DO:
          /* first - could have one for each collation  */               
          FIND first _StorageObject WHERE _StorageObject._Db-recid = _File._Db-recid
                                    AND _StorageObject._Object-type = 2
                                    AND _StorageObject._Object-number = _Index._Idx-num
                                    AND _Storageobject._Partitionid = 0                   
                                    NO-LOCK.                     
          FIND _Area WHERE _Area._Area-number = _StorageObject._Area-number
                            NO-LOCK NO-ERROR.
        END.
        ELSE
          FIND _Area WHERE _Area._Area-number = _Index._ianum NO-LOCK NO-ERROR.
          
        ASSIGN arealist = (IF AVAILABLE _AREA THEN _Area._Area-name
                               ELSE "N/A").
       END. /* if _File._File-attributes[1] = TRUE  AND _File._File-attributes[2] = FALSE */
      END.  
      ELSE
        ASSIGN arealist = "N/A".
      
      ASSIGN areaname:LIST-ITEMS  IN FRAME idx_top = ""
             areaname:LIST-ITEMS IN FRAME idx_top = arealist
             indexarea = areaname:ENTRY(1) IN FRAME idx_top.   
      DISPLAY
        _File._Prime-index = RECID(_Index) @ is_prime
        _Index._Index-name 
        _Index._Unique 
       _Index._Active
        _Index._Wordidx = 1 @ word_index
        recid_idx
        areaname
        WITH FRAME idx_top.
      
      PAUSE 0.
      DISPLAY _Index._Index-name WITH FRAME idx_lst.
    END.
    ELSE DO:
     
     if _File._File-attributes[1] = TRUE  AND _File._File-attributes[2] = FALSE THEN
              ASSIGN arealist = ""
                     areaname:LIST-ITEMS  IN FRAME idx_top = ""
                     indexarea = areaname:ENTRY(1) IN FRAME idx_top. 
     else do:
      FIND FIRST _Area WHERE _Area._Area-number > 6
                         AND _Area._Area-type = 6 
                         AND NOT CAN-DO ({&INVALID_AREAS}, _Area._Area-name) NO-ERROR.
      ASSIGN arealist = (IF AVAILABLE _AREA THEN _Area._Area-name
                            ELSE "N/A").
      ASSIGN areaname:LIST-ITEMS  IN FRAME idx_top = "" 
             areaname:LIST-ITEMS IN FRAME idx_top = arealist
             indexarea = areaname:ENTRY(1) IN FRAME idx_top.
     END.
    END.                     

    IF qbf_disp <> RECID(_Index) THEN DO i = 1 TO FRAME-DOWN(idx_long):
      DOWN i - FRAME-LINE(idx_long) WITH FRAME idx_long.
      RELEASE _Index-field.
      IF AVAILABLE _Index THEN
        FIND _Index-field OF _Index
          WHERE _Index-seq = i NO-ERROR.
      IF AVAILABLE _Index-field and _Index-field._Field-recid > 0  THEN
        FIND _Field OF _Index-field.
      ELSE
        IF INPUT FRAME idx_long _Field._Field-Name = "" THEN LEAVE.
      IF AVAILABLE _Index-field THEN DISPLAY
        (IF LENGTH(_Field._Field-Name,"character") > 18
          THEN SUBSTRING(_Field._Field-Name,1,18,"character") + "..."
          ELSE _Field._Field-Name) @ _Field._Field-Name
        _Index-field._Index-Seq _Field._Data-Type
        _Index-field._Ascending _Index-field._Abbreviate
        WITH FRAME idx_long.
      ELSE
        CLEAR FRAME idx_long NO-PAUSE.
    END.
    qbf_disp = RECID(_Index).

    IF large_idx = NO THEN DO:
        /* display message about large key entries support */
        HIDE MESSAGE NO-PAUSE.
        MESSAGE new_lang[38].
    END.
       

    ON CURSOR-LEFT BACK-TAB.
    ON CURSOR-RIGHT     TAB.
    _choose:
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF qbf# > 15 THEN qbf# = qbf# - 15.
      IF qbf# >= 1 AND qbf# <= 15 THEN
        NEXT-PROMPT qbf[qbf#] WITH FRAME qbf.
      CHOOSE FIELD qbf PAUSE (IF qbf_disp = RECID(_Index) THEN ? ELSE 0)
        NO-ERROR AUTO-RETURN GO-ON ("CURSOR-UP" "CURSOR-DOWN") WITH FRAME qbf.
      qbf# = FRAME-INDEX.
      IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND CHR(LASTKEY) <> "."
        AND NOT qbf[qbf#] BEGINS CHR(LASTKEY) THEN UNDO,RETRY _choose.
    END.
    ON CURSOR-LEFT  CURSOR-LEFT.
    ON CURSOR-RIGHT CURSOR-RIGHT.
    i = LOOKUP(KEYFUNCTION(LASTKEY),
        "CURSOR-DOWN,CURSOR-UP,HOME,END,,,,,,,GET,PUT,,,,END-ERROR").
    IF i > 0 THEN DO:
      COLOR DISPLAY NORMAL qbf[qbf#] WITH FRAME qbf. 
      qbf# = i.
    END.
    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN
      qbf# = (IF rpos = qbf_home THEN 4 ELSE 3).

    HIDE MESSAGE NO-PAUSE.
    IF large_idx = NO THEN
       MESSAGE new_lang[38].

    IF ENTRY(qbf#,qbf#list) BEGINS "-" THEN DO:   
      MESSAGE new_lang[- INTEGER(ENTRY(qbf#,qbf#list))] view-as alert-box.
    IF _File._Db-lang = 0 THEN .
    ELSE IF qbf# = 6 THEN MESSAGE new_lang[24]. /* use CREATE INDEX */
    ELSE IF qbf# = 7 THEN MESSAGE new_lang[25]. /* use DROP INDEX */
    ELSE IF qbf# >= 5 AND qbf# <= 10 THEN MESSAGE new_lang[37].
    NEXT.
    END.

    IF qbf# > 2 THEN redraw = TRUE.

    IF qbf# = 1 THEN DO: /*------------------------------ start of NEXT */
      FIND NEXT _Index WHERE _Index._File-recid = drec_file NO-ERROR.
      IF NOT AVAILABLE _Index THEN DO:
        FIND LAST _Index WHERE _Index._File-recid = drec_file NO-ERROR.
        MESSAGE new_lang[9].
      END.
      ELSE DO WITH FRAME idx_lst:
        IF FRAME-LINE = FRAME-DOWN THEN qbf_was = qbf_was - 1.
        IF FRAME-LINE = FRAME-DOWN THEN SCROLL UP. ELSE DOWN.
      END.
    END. /*------------------------------------------------ end of NEXT */
    ELSE
    IF qbf# = 2 THEN DO: /*------------------------------ start of PREV */
      FIND PREV _Index WHERE _Index._File-recid = drec_file NO-ERROR.
      IF NOT AVAILABLE _Index THEN DO:
        FIND FIRST _Index WHERE _Index._File-recid = drec_file NO-ERROR.
        MESSAGE new_lang[10].
      END.
      ELSE DO WITH FRAME idx_lst:
        IF FRAME-LINE = 1 THEN qbf_was = qbf_was + 1.
        IF FRAME-LINE = 1 THEN SCROLL DOWN. ELSE UP.
      END.
    END. /*------------------------------------------------ end of PREV */
    ELSE
    IF qbf# = 3 THEN DO: /*----------------------------- start of FIRST */
      FIND FIRST _Index WHERE _Index._File-recid = drec_file NO-ERROR.
      UP FRAME-LINE(idx_lst) - 1 WITH FRAME idx_lst.
      MESSAGE new_lang[10].
    END. /*----------------------------------------------- end of FIRST */
    ELSE
    IF qbf# = 4 THEN DO: /*------------------------------ start of LAST */
      FIND LAST _Index WHERE _Index._File-recid = drec_file NO-ERROR.
      DOWN FRAME-DOWN(idx_lst) - FRAME-LINE(idx_lst) WITH FRAME idx_lst.
      MESSAGE new_lang[9].
    END. /*------------------------------------------------ end of LAST */
    ELSE
    IF qbf# = 5 AND rpos <> ? THEN _qbf5: DO: /*------- start of RENAME */
      IF _File._Frozen THEN 
        MESSAGE new_lang[27].
      ELSE IF _Index._Index-name = "default" THEN DO:
        MESSAGE new_lang[7].
        MESSAGE new_lang[8].
      END.
      ELSE IF _File._Db-lang > 1 THEN DO: 
          MESSAGE new_lang[37].
          PAUSE 3 NO-MESSAGE.
          LEAVE _qbf5.
      END.
      ELSE DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
              adding = false.
        MESSAGE new_lang[12].
        PROMPT-FOR _Index._Index-name WITH FRAME idx_top.
        user_env[1] = INPUT FRAME idx_top _Index._Index-name.
        ASSIGN
          _Index._Index-name = user_env[1]
          in_trans = TRUE.
        DOWN FRAME-DOWN(idx_lst) - FRAME-LINE(idx_lst) WITH FRAME idx_lst.
      END.
    END. /*---------------------------------------------- end of RENAME */
    ELSE
    IF qbf# = 6 THEN _qbf6: DO ON ERROR UNDO,LEAVE: /*---- start of ADD */
      IF _File._Frozen THEN DO:
        MESSAGE new_lang[27]. /* table is frozen */
              LEAVE _qbf6.
      END.
      ELSE IF _File._Db-lang > 1 THEN DO: 
          MESSAGE new_lang[37].
          LEAVE _qbf6.
      END.
      /* are there any fields */
      FIND FIRST _Field OF _File WHERE _Extent = 0 NO-ERROR.
      IF NOT AVAILABLE _Field THEN DO:
        MESSAGE new_lang[18]. /* no non-array fields available */
        LEAVE _qbf6.
      END. 
      ASSIGN areaname:LIST-ITEMS IN FRAME idx_top = ""
             arealist = ?.

     if _File._File-attributes[1] = TRUE  AND _File._File-attributes[2] = FALSE THEN
               ASSIGN arealist = ""
                      indexarea = "".  
     else
      run prodict/pro/_pro_area_list(recid(_File),{&INVALID_AREAS},areaname:DELIMITER in frame idx_top, output arealist).

      ASSIGN areaname:LIST-ITEMS IN FRAME idx_top = arealist.

      DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
              adding = TRUE.
        COLOR DISPLAY NORMAL _Index._Index-name WITH FRAME idx_lst.
        DISPLAY
          ""               @ _Index._Index-name
          ""               @ is_prime
          NOT qbf_idx_nonu @ _Index._Unique
          TRUE             @ _Index._Active
          FALSE            @ word_index
          areaname
          WITH FRAME idx_top.
        PF-BLK:
        DO WHILE TRUE:
        PROMPT-FOR
          _Index._Index-name
          _Index._Unique    WHEN (qbf_idx_uniq AND qbf_idx_nonu)
                            OR   user_dbtype = "PROGRESS"
          _Index._Active    WHEN qbf_idx_deac
          word_index             WHEN qbf_idx_word
          areaname          WHEN user_dbtype = "PROGRESS" and (_File._File-attributes[1] = false or _File._File-attributes[2] = TRUE)
          WITH FRAME idx_top.

        /* IF On-Line and index Active */
        IF SESSION:SCHEMA-CHANGE <> "" AND
           SESSION:SCHEMA-CHANGE <> ?  AND
          INPUT FRAME idx_top _Index._Active THEN DO:
          MESSAGE 
            "The Data Dictionary has detected that you are attempting to" SKIP
            "add an ACTIVE index while ON-LINE.  If some other user is"   SKIP
            "locking the table you are attempting to update, when you"    SKIP
            "commit, your changes may be lost."                        SKIP(1)
            "Do you wish to continue?"
	      VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO-CANCEL 
                                TITLE "ON-LINE Index Add" UPDATE lOk.
          IF (lOk = FALSE) THEN NEXT PF-BLK.
          ELSE IF (lOk = TRUE) THEN LEAVE PF-BLK.
          ELSE RETURN. 
        END.
        ELSE LEAVE PF-BLK.
        END.
         ASSIGN indexarea = areaname:SCREEN-VALUE IN FRAME idx_top.
         IF indexarea = ? THEN
             ASSIGN indexarea =  areaname:ENTRY(1) IN FRAME idx_top.

         IF NOT s_In_Schema_Area THEN
            APPLY "LEAVE" to areaname IN FRAME idx_top.
         
      END.
      IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _qbf6.
      ASSIGN
        user_env[1] = INPUT FRAME idx_top _Index._Index-name
        user_env[2] = (IF INPUT FRAME idx_top _Index._Unique AND
                      NOT INPUT FRAME idx_top word_index     THEN "u" ELSE "")
                    + (IF INPUT FRAME idx_top _Index._Active THEN ""  ELSE "i")
                    + (IF INPUT FRAME idx_top word_index     THEN "w" ELSE "")
        user_env[3] = "".

      if _File._File-attributes[1] = true 
        and _File._File-attributes[2] = FALSE THEN /* if no keep default area then assign ianum to 0 */
           ASSIGN index-area-number = 0
                  indexarea = "".
      else do:
        IF indexarea <> "N/A" THEN DO:
          FIND _Area WHERE _Area._Area-name = indexarea.
          ASSIGN index-area-number = _Area._Area-number.
        END.
        ELSE
          ASSIGN index-area-number = 6.
      END. /* end of if _File._File-attributes[2] = FALSE  */

      RUN "prodict/user/_usriadd.p".  /* get index key components */
      IF user_env[1] = "" THEN LEAVE _qbf6.

      /* maybe ask about abbreviate if not word index */
      IF NOT user_env[2] MATCHES "*w*" THEN DO:
        DO i = 4 TO 18: /* 1 less than 19 */
          IF user_env[i + 1] = "" THEN LEAVE.
        END.
        FIND _Field OF _File
          WHERE _Field._Field-name = ENTRY(1,user_env[i]).
        IF _Data-type = "character" THEN DO:
          answer = FALSE.
          RUN "prodict/user/_usrdbox.p"
            (INPUT-OUTPUT answer,?,?,new_lang[14]). /* abbr index? */
          IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _qbf6.
          IF answer THEN user_env[i] = user_env[i] + "a".
        END.
      END.
      IF qbf_idx_deac AND user_env[2] MATCHES "*u*"
        AND NOT user_env[2] MATCHES "*i*" THEN DO:
        /* make new unique index inactive */
        answer = FALSE.
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[17]).
        IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _qbf6.
        IF answer THEN DO:
          user_env[2] = user_env[2] + "i".
          DISPLAY FALSE @ _Index._Active WITH FRAME idx_top.
        END.
      END.

      /* add index */
      /* input: user_env[1] = index-name to add to file in '_File'
          user_env[2] MATCHES "*p*" for primary-index
          user_env[2] MATCHES "*i*" for deactivated index
          user_env[2] MATCHES "*u*" for unique index
          user_env[2] MATCHES "*w*" for word index
          user_env[4..19] index components 1..16
            these are formatted as follows:
            ENTRY(1,user_env[x]) = field-name
            ENTRY(2,user_env[x]) MATCHES "*+*" for ascending (the default)
            ENTRY(2,user_env[x]) MATCHES "*-*" for descending
            ENTRY(2,user_env[x]) MATCHES "*a*" for abbreviated (pro only)
            ENTRY(2,user_env[x]) MATCHES "*u*" for unsorted (not for pro)
      */
 
      CREATE _Index.
      ASSIGN
        _Index._File-recid = RECID(_File)
        _Index._Idx-num    = ?
        _Index._ianum      = index-area-number
        _Index._Index-name = user_env[1]
        _Index._Unique     = user_env[2] MATCHES "*u*"
        _Index._Wordidx    = (IF user_env[2] MATCHES "*w*" THEN 1 ELSE ?)
        _Index._Active     = NOT user_env[2] MATCHES "*i*".
      DO i = 1 TO 16:
        c = user_env[i + 3].
        IF c = "" THEN LEAVE.
        FIND _Field OF _File WHERE _Field-name = ENTRY(1,c).
        CREATE _Index-field.              
        ASSIGN
          c = ENTRY(2,c)
          _Index-field._Field-recid = RECID(_Field)
          _Index-field._Abbreviate  = c MATCHES "*a*"
          _Index-field._Ascending   = NOT (c MATCHES "*-*")
          _Index-field._Index-recid = RECID(_Index)
          _Index-field._Index-Seq   = i.
      END.

      /* some Dataervers don't initialize the _Index._idx-num - field */
      /* (see <DS>/_<DS>_sys.p), so we call the intialization routine */
      if qbf_idx_num
        then RUN "prodict/gate/_gatxnum.p" 
               (INPUT  RECID(_File),
                OUTPUT _Index._idx-num).

      rpos = RECID(_Index).
      /* delete default index (there is one if _dft-pk is true) 
               and replace with this one unless this is a word index. */
      IF _File._dft-pk AND _Index._Wordidx <> 1 THEN DO:
        ASSIGN
          r                  = _File._Prime-Index
          _File._Prime-Index = RECID(_Index) /* this block will delete the */
          _File._dft-pk      = FALSE.        /* default index if there one */
        FIND _Index WHERE RECID(_Index) = r.
        FOR EACH _Index-field WHERE _Index-field._Index-recid = RECID(_index):
          delete _Index-field.
        END.  
        DELETE _Index.
      END.
      /* If there is no primary index, or this is new primary index,
         make this new one it */
      IF _File._Prime-Index = ? OR user_env[2] MATCHES "*p*" THEN
        _File._Prime-Index = rpos.

      in_trans = TRUE.
      IF RECID(_Index) <> rpos THEN DO:        /* in case we looked up default idx */  
        FIND _Index OF _File
          WHERE _Index._Index-name = user_env[1] NO-ERROR.
        DOWN FRAME-DOWN(idx_lst) - FRAME-LINE(idx_lst) WITH FRAME idx_lst.
      END.
    END. /*------------------------------------------------- end of ADD */
    ELSE
    IF qbf# = 7 AND rpos <> ? THEN DO: /*-------------- start of DELETE */
      IF _File._Frozen THEN 
        MESSAGE new_lang[27]. /* table is frozen */
      ELSE IF _File._Prime-Index = RECID(_Index) THEN DO:
        MESSAGE new_lang[3]. /* cannot delete primary index */
        MESSAGE new_lang[4]. /* try again */
      END.
      ELSE IF _File._Db-lang > 1 THEN  
          MESSAGE new_lang[37].

      ELSE DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        answer = FALSE. /* are you sure... delete? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[5]).
        IF answer THEN DO:
          FOR EACH _Index-field OF _Index:
            DELETE _Index-field.
          END.
          DELETE _Index.
          in_trans = TRUE.
        END.
      END.
    END. /*---------------------------------------------- end of DELETE */
    ELSE
    IF qbf# = 8 AND rpos <> ? THEN DO: /*------ start of CHANGE-PRIMARY */
      IF _File._Frozen THEN 
        MESSAGE new_lang[27]. /* table is frozen */
      ELSE IF _File._Db-lang > 1 THEN  
          MESSAGE new_lang[37].

      ELSE IF _Index._Wordidx = 1 THEN
      do:
        MESSAGE new_lang[26].  /* word index can't be primary */
        pause. /* I added this pause because the message was
                  not being displayed long enough to read.
                  laurief */
      end.
      ELSE
      IF _File._Prime-Index = RECID(_Index) THEN
        MESSAGE new_lang[1]. /* already primary index */
      ELSE DO:
        answer = FALSE.   /* are you sure... set prime? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[2]).
        IF answer THEN
          ASSIGN
            _File._Prime-Index = RECID(_Index)
            in_trans = TRUE.
      END.
    END. /*-------------------------------------- end of CHANGE-PRIMARY */
    ELSE
    IF qbf# = 9 AND rpos <> ? THEN DO: /*---------- start of UNIQUENESS */
      IF _File._Frozen THEN 
        MESSAGE new_lang[27]. /* table is frozen */
      ELSE IF _File._Db-lang > 1 THEN  
          MESSAGE new_lang[37].
          
      ELSE IF _Index._Wordidx = 1 THEN
        MESSAGE new_lang[28].  /* word index can't be unique */
      ELSE IF NOT qbf_idx_uniq THEN
        IF user_dbtype = "PROGRESS" THEN
          MESSAGE "{&PRO_DISPLAY_NAME} does not support uniqueness changes." view-as alert-box.
        ELSE MESSAGE new_lang[30] view-as alert-box.  /* DataServer doesn't support uniquness-changes. */
      ELSE DO:
        ASSIGN
          answer  = FALSE   /* are you sure... set prime? */
          scratch = SUBSTITUTE(new_lang[29],
                            STRING(_Index._Unique,"NON UNIQUE/UNIQUE")).
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,scratch).
        IF answer THEN
          ASSIGN
            in_trans = TRUE
            _Index._Unique = (NOT _Index._Unique).
      END.
    END. /*------------------------------------------ end of UNIQUENESS */
    ELSE
    IF qbf# = 10 AND rpos <> ? THEN DO: /*------ start of MAKE-INACTIVE */
        
      /* we will allow some of the indexes on the _aud-audit-data tables to be
         deactivated. The primary index and the _audit-time index cannot be
         deactivated.
      */
      IF (_File._file-name BEGINS "_aud-audit-data") 
         AND (_Index._Index-Name NE "_audit-time") 
         AND (NOT (_File._Prime-Index = RECID(_Index))) THEN
         ASSIGN canAudDeact = YES.
      ELSE
          ASSIGN canAudDeact = NO.

      IF _File._Frozen AND NOT canAudDeact THEN DO:
        MESSAGE new_lang[27]. /* table is frozen */
        IF _File._file-name BEGINS "_aud-audit-data" THEN
           PAUSE. /* let the user see the message, this is a special case */
      END.
      ELSE IF _File._Db-lang > 1 THEN  
          MESSAGE new_lang[37].
          
      ELSE IF NOT qbf_idx_deac THEN
        MESSAGE new_lang[19]. /* not PROGRESS db */
      ELSE IF NOT _Index._Active THEN
        MESSAGE new_lang[20]. /* already off */
      ELSE DO:
        answer = FALSE. /* are you sure... make inactive? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[21] + ' "'
          + _Index._Index-name + '" ' + new_lang[22]).
        IF answer THEN _Index._Active = FALSE.
        in_trans = in_trans OR answer.
      END.
    END. /*--------------------------------------- end of MAKE-INACTIVE */
    ELSE
    IF qbf# = 11 AND rpos <> ? THEN DO: /*------------- start of BROWSE */
      HIDE FRAME qbf NO-PAUSE.
      COLOR DISPLAY NORMAL _Index._Index-name WITH FRAME idx_lst.
      user_env[1] = _Index._Index-name.
      RUN "prodict/user/_usribro.p".
      COLOR DISPLAY MESSAGES _Index._Index-name WITH FRAME idx_lst.
      VIEW FRAME qbf.
      IF KEYFUNCTION(LASTKEY) = "GET" THEN DO:
        user_path = "1=,_usrtget,_usrichg".
        LEAVE qbf_block.
      END.
    END. /*---------------------------------------------- end of BROWSE */
    ELSE
    IF qbf# = 12 THEN DO: /*---------------------- start of SWITCH-FILE */
      user_path = "1=,_usrtget,_usrichg".
      LEAVE qbf_block.
    END. /*----------------------------------------- end of SWITCH-FILE */
    ELSE
    IF qbf# = 13 THEN DO: /*------------------------ start of GO-FIELDS */
      user_path = "_usrfchg".
      LEAVE qbf_block.
    END. /*------------------------------------------- end of GO-FIELDS */
    ELSE
    IF qbf# = 14 AND rpos <> ? THEN DO: /*-------------- start of ROWID */
      IF _Index._I-misc2[1] BEGINS "r" THEN NEXT.  /* already recid-idx */
      IF _Index._I-misc2[1] = ? THEN 
        MESSAGE new_lang[36]. /* can't be used for ROWID support */
      ELSE IF _File._Frozen THEN 
        MESSAGE new_lang[27]. /* table is frozen */
      ELSE DO:
        FIND FIRST _File of _Index.
/* --- Changed to FOR EACH to support multi-component indexes (tomn 5/96) ---
        FIND _Index-field of _Index.
        FIND _Field of _Index-field.
   --------------------------------------------------------------------------*/
        assign
          l_ifldcnt = 0
          scratch   = ""
          warnflg   = "nnn".
          
        for each _Index-field of _Index, _Field of _Index-field:
          l_ifldcnt = l_ifldcnt + 1.  /* count index fields */
          
          IF    _Index._I-misc2[1]    = "u"
            AND _Index._Unique        = TRUE
            AND _Field._Mandatory     = TRUE
            AND SUBSTR(warnflg, 1, 1) = "n"  /* hasn't already been set by previous index field */
           THEN ASSIGN
                 scratch = scratch + new_lang[31] + chr(10)
                 SUBSTR(warnflg, 1, 1) = "ynn".
        
          IF _Index._Unique = FALSE
            AND SUBSTR(warnflg, 2, 1) = "n"  /* hasn't already been set by previous index field */
           THEN ASSIGN
                 scratch = scratch + new_lang[32] + chr(10)
                 SUBSTR(warnflg, 2, 1) = "y".

          IF _Field._Mandatory = FALSE
            AND SUBSTR(warnflg, 3, 1) = "n"  /* hasn't already been set by previous index field */
           THEN ASSIGN
                 scratch = scratch + new_lang[33] + chr(10)
                 SUBSTR(warnflg, 3, 1) = "y".
        end.  /* for each */        

        assign
          scratch = scratch + new_lang[34].

        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,scratch).
        IF answer
         THEN DO:  /* set this index to be the recid-index */
          FIND FIRST bfr_Index of _File
            WHERE bfr_Index._I-misc2[1] begins "r"
            EXCLUSIVE-LOCK NO-ERROR.
            
          IF user_dbtype = "ORACLE"
           THEN ASSIGN
            in_trans            = TRUE
            _Index._I-misc2[1]  = "r" + _Index._I-misc2[1]
            _File._Fil-misc1[4] = _Field._Fld-stoff.

          ELSE IF l_ifldcnt > 1 OR _Field._For-type <> "INTEGER"
           THEN ASSIGN   /*----- ODBC -----*/
            in_trans            = TRUE
            _Index._I-misc2[1]  = "r" + _Index._I-misc2[1]
            _File._Fil-misc1[2] = _Index._idx-num  /* rowid info */
            _File._Fil-misc1[1] = ?                /* recid      */
            _File._Fil-misc2[3] = ?.               /* info       */
            
           ELSE ASSIGN
            _Index._I-misc2[1]  = "r" + _Index._I-misc2[1]
            _File._Fil-misc1[1] = _Field._Fld-stoff * -1          /* rowid info */
            _File._Fil-misc2[3] = ( IF _Field._Fld-misc2[3] <> ?  /* recid      */
                                      THEN _Field._Fld-misc2[3]   /* info       */
                                      ELSE _Field._For-name
                                  ).
          IF AVAILABLE bfr_Index
           then assign
            bfr_Index._I-misc2[1] = substring(bfr_Index._I-misc2[1]
                                             ,2
                                             ,-1
                                             ,"character"
                                             ).
          
          END.     /* set this index to be the recid-index */
      END.
    END. /*----------------------------------------------- end of ROWID */
    ELSE
    IF qbf# = 15 THEN DO: /*----------------------------- start of UNDO */
      IF in_trans THEN DO:
        answer = FALSE. /* undo session? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[6]).
        IF answer THEN UNDO qbf_block,RETRY qbf_block.
      END.
      ELSE
        MESSAGE new_lang[23]. /* what changes? */
    END. /*------------------------------------------------ end of UNDO */
    ELSE
    IF qbf# = 16 THEN /*--------------------------------- start of EXIT */
      LEAVE qbf_block.
    /*----------------------------------------------------- end of EXIT */

  END. /* iterating block */
END. /* scoping block */

HIDE FRAME qbf      NO-PAUSE.
HIDE FRAME idx_box  NO-PAUSE.
HIDE FRAME idx_long NO-PAUSE.
HIDE FRAME idx_lst  NO-PAUSE.
HIDE FRAME idx_top  NO-PAUSE.
dict_dirty = dict_dirty OR in_trans.
RETURN.





/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrimpo.p - get fields, etc. for import */

/*
This program does the initial for 'sylk', 'dif', 'dbase' and 'ascii'
format loads.

IN:
user_env[1]  = db filename to import
user_env[9]  = 'dif'   for dif format
             = 'sylk'  for sylk format
             = 'dbf'   for dbase format
             = 'ascii' for ascii delimited format
             = 'fixed' for ascii fixed-length field format
 
OUT: 
user_env[1]  = db filename to import
user_env[2]  = *reserved*
user_env[3]  = used for import-specific parameters
user_env[4]  = import '.dif', '.slk' or '.dbf' filename
user_env[5]  = count of field names to import
user_env[6]  = space-delimited list of field names to import
               skip-fields denoted by '^'
user_env[7]  = column ranges for 'fixed' (suitable for osquoter)
user_env[8]  = *reserved*
user_env[9]  = *reserved*
user_env[10] = "y" - disable triggers, "n" - do not disable triggers

history:  Added check to find quoter D. McMann 06/05/00

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

DEFINE NEW SHARED VARIABLE pik_lower  AS INTEGER   EXTENT 2000 NO-UNDO.
DEFINE NEW SHARED VARIABLE pik_upper  AS INTEGER   EXTENT 2000 NO-UNDO.

DEFINE VARIABLE canned    AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE allorsome AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE dis_trigs AS LOGICAL INITIAL NO    NO-UNDO.
DEFINE VARIABLE i         AS INTEGER               NO-UNDO.
DEFINE VARIABLE j         AS INTEGER               NO-UNDO.
DEFINE VARIABLE nuximode  AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE typ       AS CHARACTER             NO-UNDO.
DEFINE VARIABLE upath     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE importlab AS CHARACTER INITIAL "&Import File:"
  FORMAT "X(13)" NO-UNDO.
DEFINE VARIABLE msgEd     AS CHARACTER VIEW-AS EDITOR NO-BOX SIZE 55 BY 7 NO-UNDO.
define variable isSuperTenant as logical no-undo.
define variable isMultiTenant as logical no-undo.
/* used for file dump */
define variable gTenant  as character no-undo.
define variable cTenantlabel as character format "x(30)" no-undo init "Effective Tenant:".
define button btnTenant size 18 by 1 label "Select Tenant...".


  
{prodict/misc/filesbtn.i}
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
  &GLOBAL-DEFINE ARMSG_ROW_OFFSET - 0.25
&ELSE
  &GLOBAL-DEFINE ARMSG_ROW_OFFSET
&ENDIF

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 6 NO-UNDO INITIAL [
  /*1,2*/ "Fields for", "Import",
  /*  3*/ "You do not have permission to create records in this table.",
  /*  4*/ "Cannot find a file of this name.  Try again.",
  /*  5*/ "Quote marks can't be used as separators",
  /*  6*/ "(they are already the delimiters)."
].


/*=============================Functions=================================*/  
function selectTenant return logical (hTenant as handle):
    define variable tenantdlg as prodict.pro._tenant-sel-presenter no-undo.
    tenantdlg = new  prodict.pro._tenant-sel-presenter ().
    do with frame write-dump-dir-mt:
           &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        /* adjust the browse aligned and under field (at least try...) */   
        if  hTenant:frame:row < 0 then  /* this does not really work with large negative */                  
            tenantdlg:Row = (hTenant:row + hTenant:height) + 2.
        else 
            tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row + 0.5.
        tenantdlg:Col = hTenant:col + hTenant:frame:col .
           &ELSE
        
        tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row.
       
           &ENDIF
    end.
    tenantdlg:QueryString = "for each ttTenant where ttTenant.type <> 'super'".
    tenantdlg:Title = "Select Tenant".
  
/*    glInSelect = true. /* stop end-error anywhere trigger */*/ 
    if tenantdlg:Wait() then
    do: 
        hTenant:screen-value = tenantdlg:ColumnValue("ttTenant.name").
        apply "value-changed" to hTenant.
    end.
/*    glInSelect = false.*/
 
end.  

function getTenantName returns char(pctenant as char):
    define variable lok     as logical no-undo.
    define variable hbuffer as handle no-undo. 
    define variable cValue   as character no-undo.
    
    CREATE BUFFER hbuffer FOR TABLE "DICTDB._tenant".
    lok = hbuffer:find-unique ("where _tenant._Tenant-name = " + quoter(pcTenant)) no-error.
    if lok then 
        cValue = hBuffer::_tenant-name.
    
    delete object hbuffer.    
    return cValue.
end function. 

function validateTenantName returns logical(ctenant as char):
    define variable lok as logical no-undo.
    if cTenant = "" then
    do:
        MESSAGE "Please specify which Tenant to dump data for."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false. 
    end.
    if getTenantName(cTenant) = "" then 
    do:
        MESSAGE "There is no Tenant with name " +  ctenant + " in the database."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false.
    end.
    return true.
end function. 


/*------------------- FRAME import-stuff ----------------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
FORM
  SKIP({&TFM_WID})
   cTenantlabel no-label AT 2 VIEW-AS TEXT SKIP({&VM_WID})
   gTenant at 2 no-label format "x(32)"  VIEW-AS fill-in size 37  by 1  
   btntenant skip ({&VM_WID})
 
  importlab AT 2 VIEW-AS TEXT NO-LABEL SKIP({&VM_WID})
  user_env[4] {&STDPH_FILL} NO-LABEL FORMAT "x(80)" AT 2 
        VIEW-AS FILL-IN SIZE 44 BY 1
  btn_File  SKIP ({&VM_WIDG})
  "Fields to Import:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  allorsome VIEW-AS RADIO-SET RADIO-BUTTONS "&Selected", no, "&All (Max 255)", yes
            NO-LABEL AT 2 SKIP({&VM_WIDG})
  "Database Triggers:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  dis_trigs VIEW-AS TOGGLE-BOX LABEL "&Disable During Import"
        AT 2
  {prodict/user/userbtns.i}
  "Note: LOB or array fields cannot " VIEW-AS TEXT 
        AT ROW-OF allorsome {&ARMSG_ROW_OFFSET} COLUMN 25 SKIP
  "be imported, and are excluded      " VIEW-AS TEXT AT 25
  "from the selection list.      " VIEW-AS TEXT AT 25
  WITH FRAME import-stuff
  CENTERED SIDE-LABELS 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
  
  /* Added to support "Import File:" fill-in label mnemonic (tomn 8/1/95) */
  ASSIGN
    user_env[4]:SIDE-LABEL-HANDLE IN FRAME import-stuff = importlab:HANDLE
    user_env[4]:LABEL = importlab 
    gTenant:SIDE-LABEL-HANDLE IN FRAME import-stuff = cTenantlabel:HANDLE
    gTenant:LABEL = cTenantlabel.
&ELSE

FORM
  SKIP({&TFM_WID})
  gTenant colon 18 label "Effective Tenant" format "x(32)"    
  btntenant skip ({&VM_WID})
  user_env[4] {&STDPH_FILL} FORMAT "x(255)" colon 18 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Import File"
  btn_File  SKIP ({&VM_WIDG})
  allorsome FORMAT "All/Some"
    LABEL "Import (A)ll Fields (max 255) Or (S)elected Fields" 
                                                                         AT 2                          SKIP
  "(LOB or Array fields cannot be imported and are excluded from the list)" 
                                                                         AT 4 VIEW-AS TEXT SKIP(1)

  dis_trigs LABEL "Disable Triggers During Import?" AT 2
  {prodict/user/userbtns.i}
  WITH FRAME import-stuff
  CENTERED SIDE-LABELS 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
&ENDIF

/*------------------- FRAME import-dbf ----------------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
FORM
  SKIP({&TFM_WID})
  cTenantlabel no-label AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  gTenant at 2 no-label format "x(32)"  VIEW-AS fill-in size 37  by 1  btntenant skip ({&VM_WID})
 
  importlab AT 2 VIEW-AS TEXT NO-LABEL SKIP({&VM_WID})
  user_env[4] {&STDPH_FILL} NO-LABEL FORMAT "x(80)" AT 2 
        VIEW-AS FILL-IN SIZE 44 BY 1
  btn_File  SKIP ({&VM_WIDG})
  "Fields to Import:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  allorsome VIEW-AS RADIO-SET RADIO-BUTTONS "&Selected", no, "&All (Max 255)", yes
            NO-LABEL AT 2 SKIP({&VM_WIDG})
  "Origin of File:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  nuximode VIEW-AS RADIO-SET RADIO-BUTTONS "IBM/PC or &Compatible", yes,
                                           "&Other", no
        NO-LABEL AT 2 SKIP({&VM_WIDG})
  "Database Triggers:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  dis_trigs VIEW-AS TOGGLE-BOX LABEL "&Disable During Import"
        AT 2
  {prodict/user/userbtns.i}
  "Note: LOB or array fields cannot " VIEW-AS TEXT 
        AT ROW-OF allorsome {&ARMSG_ROW_OFFSET} COLUMN 25 SKIP
  "be imported, and are excluded      " VIEW-AS TEXT AT 25
  "from the selection list.      " VIEW-AS TEXT AT 25
  WITH FRAME import-dbf
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
  
  /* Added to support "Import File:" fill-in label mnemonic (tomn 8/1/95) */
  ASSIGN
    user_env[4]:SIDE-LABEL-HANDLE IN FRAME import-dbf = importlab:HANDLE
    user_env[4]:LABEL = importlab 
    gTenant:SIDE-LABEL-HANDLE IN FRAME import-dbf = cTenantlabel:HANDLE
    gTenant:LABEL IN FRAME import-dbf = cTenantlabel.
&ELSE

FORM
  SKIP({&TFM_WID})
  gTenant colon 18 label "Effective Tenant" format "x(32)"  
  btntenant skip ({&VM_WID})
  user_env[4] {&STDPH_FILL} FORMAT "x(255)" colon 18 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Import File"
  btn_File  SKIP(1)
  nuximode FORMAT "yes/no"
    LABEL "Originated on IBM/PC or Compatibles (Intel 80x8x)" 
                                                                         AT 2              SKIP(1)

  allorsome FORMAT "All/Some"
    LABEL "Import (A)ll Fields (max 255) Or (S)elected Fields" 
                                                                         AT 2              SKIP
  "(LOB or Array fields cannot be imported and are excluded from the list)" 
                                                                         AT 4 VIEW-AS TEXT SKIP(1)

  dis_trigs LABEL "Disable Triggers During Import?" AT 2
  {prodict/user/userbtns.i}
  WITH FRAME import-dbf
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
&ENDIF


/*------------------- FRAME import-ascii ----------------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
FORM
  SKIP({&TFM_WID})
  cTenantlabel no-label AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  gTenant at 2 no-label format "x(32)"  VIEW-AS fill-in size 37  by 1
  btntenant skip ({&VM_WID})
 
  importlab AT 2 VIEW-AS TEXT NO-LABEL SKIP({&VM_WID})
  user_env[4] {&STDPH_FILL} NO-LABEL FORMAT "x(80)" AT 2 
        VIEW-AS FILL-IN SIZE 44 BY 1
  btn_File  SKIP ({&VM_WIDG})
  "Fields to Import:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  allorsome VIEW-AS RADIO-SET RADIO-BUTTONS "&Selected", no, "&All (Max 255)", yes
            NO-LABEL AT 2 SKIP({&VM_WIDG})
  user_env[3] {&STDPH_FILL} FORMAT "X" 
        LABEL "Field Separation &Character" AT 2 SKIP({&VM_WIDG})
  "Database Triggers:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  dis_trigs VIEW-AS TOGGLE-BOX LABEL "&Disable During Import" AT 2
  {prodict/user/userbtns.i}
  "Note: LOB or array fields cannot " VIEW-AS TEXT 
        AT ROW-OF allorsome {&ARMSG_ROW_OFFSET} COLUMN 25 SKIP
  "be imported, and are excluded      " VIEW-AS TEXT AT 25
  "from the selection list.      " VIEW-AS TEXT AT 25
  WITH FRAME import-ascii
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
  
  /* Added to support "Import File:" fill-in label mnemonic (tomn 8/1/95) */
  ASSIGN
    user_env[4]:SIDE-LABEL-HANDLE IN FRAME import-ascii = importlab:HANDLE
    user_env[4]:LABEL = importlab
    gTenant:SIDE-LABEL-HANDLE IN FRAME import-ascii = cTenantlabel:HANDLE
    gTenant:LABEL IN FRAME import-ascii = cTenantlabel.
&ELSE

FORM
  SKIP({&TFM_WID})
  gTenant colon 18 label "Effective Tenant" format "x(32)"  
  btntenant skip ({&VM_WID})
  user_env[4] {&STDPH_FILL} FORMAT "x(255)" colon 18 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Import File"
  btn_File  SKIP ({&VM_WID})
  SKIP(1)
  user_env[3] FORMAT "x" LABEL "Field Separation Character"
                                                                         AT 2              SKIP(1)
  allorsome FORMAT "All/Some"
    LABEL "Import (A)ll Fields (max 255) Or (S)elected Fields" 
                                                                         AT 2                          SKIP
  "(LOB or Array fields cannot be imported and are excluded from the list)" 
                                                                         AT 4 VIEW-AS TEXT SKIP(1)

  dis_trigs LABEL "Disable Triggers During Import?" AT 2
  {prodict/user/userbtns.i}
  WITH FRAME import-ascii
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
&ENDIF

                              
/*------------------- FRAME import-fixed ----------------------------------*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
FORM
  SKIP({&TFM_WID})
  cTenantlabel no-label AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  gTenant at 2 no-label format "x(32)"  VIEW-AS fill-in size 37  by 1  btntenant skip ({&VM_WID})
  
  importlab AT 2 VIEW-AS TEXT NO-LABEL SKIP({&VM_WID})
  user_env[4] {&STDPH_FILL} NO-LABEL FORMAT "x(80)" AT 2 
        VIEW-AS FILL-IN 
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN  
  SIZE 44 BY 1
&ELSE
  SIZE 51 BY 1
&ENDIF
  btn_File  SKIP ({&VM_WIDG})
  "Database Triggers:      " AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  dis_trigs VIEW-AS TOGGLE-BOX LABEL "&Disable During Import"
        AT 2 SKIP({&VM_WIDG})
  msgEd NO-LABEL AT 2 SKIP  
  {prodict/user/userbtns.i}

  WITH FRAME import-fixed
  CENTERED SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel 
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].

/* Setup the message */
ASSIGN
  msgEd:SCREEN-VALUE = "After leaving this form, you will be presented with a scrolling " + 
                   "list of all fields in this table.  For each field there are two "   + 
                   "fill-in areas for entering the starting and ending columns that "   +  
                   "correspond to the position of that field's data in the text "       + 
                   "file.  If you do not want a particular field to be imported "       + 
                   "leave these values blank."                     + CHR(10) + CHR(10) +
                   "Note: LOB or array fields cannot be imported and are excluded from the list."
  msgEd:READ-ONLY    = YES.
  
  /* Added to support "Import File:" fill-in label mnemonic (tomn 8/1/95) */
  ASSIGN
    user_env[4]:SIDE-LABEL-HANDLE IN FRAME import-fixed = importlab:HANDLE
    user_env[4]:LABEL = importlab 
    gTenant:SIDE-LABEL-HANDLE IN FRAME import-fixed = cTenantlabel:HANDLE
    gTenant:LABEL IN FRAME import-fixed = cTenantlabel.
&ELSE
FORM
  SKIP({&TFM_WID})
  gTenant colon 18 label "Effective Tenant" format "x(32)"    
  btntenant skip ({&VM_WID})
  user_env[4] {&STDPH_FILL} FORMAT "x(80)" colon 18
   VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Import File"
  btn_File SKIP(1)
  dis_trigs LABEL "Disable Triggers During Import?"                   AT 2 SKIP(1)
  "After leaving this form, you will be presented with a scrolling"   AT 2 VIEW-AS TEXT SKIP
  "list of all fields in this table.  For each field there are two"   AT 2 VIEW-AS TEXT SKIP
  "fill-in areas for entering the starting and ending columns that"   AT 2 VIEW-AS TEXT SKIP
  "correspond to the position of that field's data in the text"       AT 2 VIEW-AS TEXT SKIP
  "file.  If you do not want a particular field to be imported"       AT 2 VIEW-AS TEXT SKIP
  "leave these values blank."                                         AT 2 VIEW-AS TEXT
  SKIP({&VM_WIDG})
  "Note: LOB or array fields cannot be imported and are excluded from the list."  AT 2 VIEW-AS TEXT
  {prodict/user/userbtns.i}

  WITH FRAME import-fixed
  ROW 2 SIDE-LABELS
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel 
  VIEW-AS DIALOG-BOX TITLE "Import " + user_env[9].
&ENDIF

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/



/*==============================Triggers================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame import-stuff
   or CHOOSE of btn_Help in frame import-stuff
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Import_Stuff_Dlg_Box},
                                               INPUT ?).

on HELP of frame import-dbf
   or CHOOSE of btn_Help in frame import-dbf
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Import_dBase_File_Contents_Dlg_Box},
                                               INPUT ?).

on HELP of frame import-ascii
   or CHOOSE of btn_Help in frame import-ascii
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Import_Delimited_ASCII_Dlg_Box},
                                               INPUT ?).

on HELP of frame import-fixed
   or CHOOSE of btn_Help in frame import-fixed
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Import_Fixed_Length_Dlg_Box},
                                               INPUT ?).
&ENDIF

/*----- ON GO or OK -----*/
ON GO OF FRAME import-stuff
DO:
  run Validate_Frame (user_env[4]:HANDLE IN FRAME import-stuff,
                      dis_trigs:HANDLE IN FRAME import-stuff,
                      gTenant:HANDLE IN FRAME import-stuff).
  if RETURN-VALUE = "error" THEN
     RETURN NO-APPLY.
END.

ON GO OF FRAME import-dbf
DO:
  run Validate_Frame ( user_env[4]:HANDLE IN FRAME import-dbf,
                        dis_trigs:HANDLE IN FRAME import-dbf ,  
                        gTenant:HANDLE IN FRAME import-dbf ).
  if RETURN-VALUE = "error" THEN
     RETURN NO-APPLY.
END.

ON GO OF FRAME import-ascii
DO:
  ASSIGN INPUT FRAME import-ascii user_env[3].
  IF user_env[3] = '"' OR user_env[3] = "'" THEN DO:
    MESSAGE new_lang[5] SKIP new_lang[6] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[3] IN FRAME import-ascii.
    RETURN NO-APPLY.
  END.

  run Validate_Frame (user_env[4]:HANDLE IN FRAME import-ascii,
                      dis_trigs:HANDLE IN FRAME import-ascii,
                      gTenant:HANDLE IN FRAME import-ascii ).
  if RETURN-VALUE = "error" THEN
     RETURN NO-APPLY.
END.

ON GO OF FRAME import-fixed
DO:
  run Validate_Frame (user_env[4]:HANDLE IN FRAME import-fixed,
                      dis_trigs:HANDLE IN FRAME import-fixed,
                      gTenant:HANDLE IN FRAME import-fixed  ).
  if RETURN-VALUE = "error" THEN
     RETURN NO-APPLY.
END.

ON WINDOW-CLOSE OF FRAME import-stuff
   APPLY "END-ERROR" TO FRAME import-stuff.
ON WINDOW-CLOSE OF FRAME import-dbf
   APPLY "END-ERROR" TO FRAME import-dbf.
ON WINDOW-CLOSE OF FRAME import-ascii
   APPLY "END-ERROR" TO FRAME import-ascii.
ON WINDOW-CLOSE OF FRAME import-fixed
   APPLY "END-ERROR" TO FRAME import-fixed.

/*----- HIT of tenant BUTTON -----*/
on choose of btnTenant in frame import-stuff
do:
     selectTenant(gTenant:handle in frame import-stuff).
end. 

on choose of btnTenant in frame import-dbf
do:
     selectTenant(gTenant:handle in frame import-dbf).
end. 

on choose of btnTenant in frame import-fixed
do:
     selectTenant(gTenant:handle in frame import-fixed).
end.   
on choose of btnTenant in frame import-ascii
do:
     selectTenant(gTenant:handle in frame import-ascii).
end.      
   
/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame import-stuff DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[4]:handle in frame import-stuff /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame import-ascii DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[4]:handle in frame import-ascii /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame import-fixed DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[4]:handle in frame import-fixed /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame import-dbf DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[4]:handle in frame import-dbf /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[4] in frame import-stuff
   user_env[4]:screen-value in frame import-stuff = 
        TRIM(user_env[4]:screen-value in frame import-stuff).
ON LEAVE OF user_env[4] in frame import-ascii
   user_env[4]:screen-value in frame import-ascii = 
        TRIM(user_env[4]:screen-value in frame import-ascii).
ON LEAVE OF user_env[4] in frame import-fixed
   user_env[4]:screen-value in frame import-fixed = 
        TRIM(user_env[4]:screen-value in frame import-fixed).
ON LEAVE OF user_env[4] in frame import-dbf
   user_env[4]:screen-value in frame import-dbf = 
        TRIM(user_env[4]:screen-value in frame import-dbf).


/*=================================Mainline code==========================*/

FIND _File WHERE RECID(_File) = drec_file.

IF NOT CAN-DO(_File._Can-create,USERID(user_dbname)) THEN DO:
  MESSAGE new_lang[3] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path =  "".
  RETURN.
END.

IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DO: 
  IF SEARCH("quoter.exe") = ? THEN DO:
    MESSAGE "Unable to find the quoter utility.  Make sure that" SKIP
            "{&PRO_DISPLAY_NAME}' bin directory is in your PATH." SKIP
    VIEW-AS ALERT-BOX ERROR.
    ASSIGN user_path = "".
    RETURN.
  END.
END.
ELSE  IF OPSYS = "UNIX" THEN DO: 
  IF SEARCH("quoter") = ? THEN DO:
    MESSAGE "Unable to find the quoter utility.  Make sure that" SKIP
            "{&PRO_DISPLAY_NAME}' bin directory is in your PATH." SKIP
    VIEW-AS ALERT-BOX ERROR.
    ASSIGN user_path = "".
    RETURN.
  END.
END.

if int(dbversion("dictdb")) > 10 then
do:
   isSuperTenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
   if isSuperTenant and _File._file-attributes[1] then
   do:
      isMultiTenant = true. 
      gTenant = get-effective-tenant-name("dictdb").
   end.
    
end.

/*isMultiTenant = true.*/

ASSIGN

  typ         = user_env[9]
  user_env[2] = ""  /* reserved for child to call _lodsddl.p */
  user_env[3] = ""
  user_env[6] = ""
  user_env[7] = ""
  user_env[8] = "" /* reserved for child to call _lodsddl.p */
  user_env[9] = CAPS(typ).

/* Adjust the graphical rectangle and the ok and cancel buttons */
IF typ = "dbf" THEN DO:
  {adecomm/okrun.i  
      &FRAME  = "FRAME import-dbf" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
  }
    if not isMultiTenant then
    do:
        gTenant:hidden in frame import-dbf = true. 
/*        cTenantlabel:hidden in frame import-dbf = true.*/
        btnTenant:hidden in frame import-dbf = true.  
      
        run adjustframe(FRAME import-dbf:handle).
    end.    
  
  
END.
ELSE IF typ = "ascii" THEN DO:
  {adecomm/okrun.i  
      &FRAME  = "FRAME import-ascii" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
  }
    if not isMultiTenant then
    do:
        gTenant:hidden in frame import-ascii = true. 
/*        cTenantlabel:hidden in frame import-ascii = true.*/
        btnTenant:hidden in frame import-ascii = true.  
      
        run adjustframe(FRAME import-ascii:handle).
    end.    
END.
ELSE IF typ = "fixed" THEN DO:
  {adecomm/okrun.i  
      &FRAME  = "FRAME import-fixed" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
  }
    if not isMultiTenant then
    do:
        gTenant:hidden in frame import-fixed = true. 
/*        cTenantlabel:hidden in frame import-fixed = true.*/
        btnTenant:hidden in frame import-fixed = true.  
      
        run adjustframe(FRAME import-fixed:handle).
    end.    
  
END.
ELSE DO:
  {adecomm/okrun.i  
      &FRAME  = "FRAME import-stuff" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
  }
    if not isMultiTenant then
    do:
        gTenant:hidden in frame import-stuff = true. 
/*        cTenantlabel:hidden in frame import-stuff = true.*/
        btnTenant:hidden in frame import-stuff = true.  
      
        run adjustframe(FRAME import-stuff:handle).
    end.    
  
END.

IF typ = "dif" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  ASSIGN
    user_env[4] = user_env[1] + ".dif"
    pik_title   = new_lang[1] + " DIF " + new_lang[2].
  DO ON ERROR UNDO,RETRY:
   
    UPDATE
      gTenant when isMultiTenant 
      btnTenant when isMultiTenant  
      user_env[4] /*destinf*/ btn_File
      allorsome
      dis_trigs
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME import-stuff.
    IF SEARCH(user_env[4]) = ? THEN DO:
      MESSAGE new_lang[4]. /* file not found */
      UNDO,RETRY.
    END.
    canned = FALSE.
  END.
END.
ELSE
IF typ = "sylk" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  ASSIGN
    user_env[4] = user_env[1] + ".slk"
    pik_title   = new_lang[1] + " SYLK " + new_lang[2].
  DO ON ERROR UNDO,RETRY:
    UPDATE
      gTenant when isMultiTenant 
      btnTenant when isMultiTenant  
      user_env[4] /*destinf*/ btn_File
      allorsome
      dis_trigs
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME import-stuff.
    IF SEARCH(user_env[4]) = ? THEN DO:
      MESSAGE new_lang[4]. /* file not found */
      UNDO,RETRY.
    END.
    canned = FALSE.
  END.
END.
ELSE
IF typ = "dbf" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  ASSIGN
    user_env[4] = user_env[1] + ".dbf"
    user_env[9] = "dBase File Contents"
    pik_title   = new_lang[1] + " " + user_env[9] + " " + new_lang[2].
  DO ON ERROR UNDO,RETRY:
    UPDATE
      gTenant when isMultiTenant 
      btnTenant when isMultiTenant  
      user_env[4] /*destinf*/ btn_File
      nuximode
      allorsome
      dis_trigs
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME import-dbf.
    IF SEARCH(user_env[4]) = ? THEN DO:
      MESSAGE new_lang[4]. /* file not found */
      UNDO,RETRY.
    END.
    canned = FALSE.
  END.
  user_env[3] = STRING(nuximode,"1/0").
END.
ELSE
IF typ = "ascii" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  ASSIGN
    user_env[3] = "," /* delimiter */
    user_env[4] = user_env[1] + ".txt"
    user_env[7] = ?
    user_env[9] = "Delimited Text"
    pik_title   = new_lang[1] + " " + user_env[9] + " " + new_lang[2].
  DO ON ERROR UNDO,RETRY:
    UPDATE
      gTenant when isMultiTenant 
      btnTenant when isMultiTenant  
      user_env[4] /*destinf*/ btn_File
      user_env[3] /*delimiter*/
      allorsome
      dis_trigs
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME import-ascii.
    IF SEARCH(user_env[4]) = ? THEN DO:
      MESSAGE new_lang[4]. /* file not found */
      UNDO,RETRY.
    END.
    canned = FALSE.
  END.
END.
ELSE
IF typ = "fixed" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  ASSIGN
    user_env[3] = ?
    user_env[4] = user_env[1] + ".dat"
    user_env[9] = "Fixed-Length"
    pik_title   = new_lang[1] + " " + user_env[9] + " " + new_lang[2].
  DO ON ERROR UNDO,RETRY:
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
    ENABLE msgEd WITH FRAME import-fixed.
&ENDIF
    UPDATE
      gTenant when isMultiTenant 
      btnTenant when isMultiTenant  
      
      user_env[4] /*destinf*/ btn_File
      dis_trigs 
      btn_OK btn_Cancel {&HLP_BTN_NAME}
      WITH FRAME import-fixed.
    IF SEARCH(user_env[4]) = ? THEN DO:
      MESSAGE new_lang[4]. /* file not found */
      UNDO,RETRY.
    END.
    canned = FALSE.
  END.
END.

IF canned THEN DO:
  user_path = "".
  HIDE FRAME import-stuff NO-PAUSE.
  HIDE FRAME import-dbf   NO-PAUSE.
  HIDE FRAME import-ascii NO-PAUSE.
  HIDE FRAME import-fixed NO-PAUSE.
  HIDE MESSAGE NO-PAUSE.
  RETURN.
END.

user_env[10] = (if dis_trigs then "y" else "n").

IF typ = "fixed" THEN DO:
  FOR EACH _Field OF _File WHERE _Field._Extent = 0 
                             AND _Field._Data-type <> "BLOB"
                             AND _Field._Data-type <> "CLOB" 
                             AND _Field._Data-type <> "XLOB"
                             BY _Field._Order:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = _Field._Field-name.
  END.
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    RUN "prodict/user/_usrfixd.p".
  &ELSE
    RUN "prodict/gui/_guifixd.p".
  &ENDIF
  DO j = 1 TO pik_count:
    IF pik_lower[j] = 0 OR pik_upper[j] = 0 THEN NEXT.
    ASSIGN
      i           = i + 1
      user_env[6] = user_env[6] + (IF i = 1 THEN "" ELSE " ") + pik_list[j]
      user_env[7] = user_env[7]
                  + (IF user_env[7] = "" THEN "" ELSE ",")
                  + STRING(pik_lower[j])
                  + (IF pik_upper[j] = pik_lower[j] THEN ""
                    ELSE "-" + STRING(pik_upper[j])).
    IF i = 255 THEN LEAVE.
  END.
  user_env[5] = STRING(i).
END.
ELSE
IF allorsome THEN DO:
  FOR EACH _Field OF _File WHERE _Field._Extent = 0
                             AND _Field._Data-type <> "BLOB"
                             AND _Field._Data-type <> "CLOB" 
                             AND _Field._Data-type <> "XLOB"
                             BY _Field._Order:
    ASSIGN
      i = i + 1
      user_env[6] = user_env[6]
                  + (IF i = 1 THEN "" ELSE " ")
                  + _Field._Field-name.
    IF i = 255 THEN LEAVE.
  END.
  user_env[5] = STRING(i).
END.
ELSE DO:
  ASSIGN
    pik_column = 25
    pik_row    = 4
    pik_hide   = TRUE
    pik_init   = ""
    pik_wide   = FALSE
    pik_count  = 0
    pik_list   = ""
    pik_multi  = TRUE
    pik_number = TRUE
    pik_skip   = TRUE.
  FOR EACH _Field OF _File WHERE _Field._Extent = 0 
                             AND _Field._Data-type <> "BLOB"
                             AND _Field._Data-type <> "CLOB" 
                             AND _Field._Data-type <> "XLOB"
                             BY _Field._Order:
    ASSIGN
      pik_count = pik_count + 1
      pik_list[pik_count] = _Field._Field-name.
  END.
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN "prodict/user/_usrpick.p".
  &ELSE
    pik_help = {&Fields_For_Import_Dlg_Box}.
    RUN "prodict/gui/_guipick.p".
  &ENDIF
  pik_return = MINIMUM(pik_return,255).
  DO i = 1 TO pik_return:
    user_env[6] = user_env[6]
                + (IF i = 1 THEN "" ELSE " ")
                + (IF pik_chosen[i] = -1 THEN "^"
                  ELSE pik_list[pik_chosen[i]]).
  END.
  user_env[5] = STRING(pik_return).
END.

IF user_env[6] = "" THEN user_path = "".

if isMultiTenant then 
    set-effective-tenant(gTenant,"dictdb").
    
{ prodict/dictnext.i upath }

HIDE FRAME import-stuff NO-PAUSE.
HIDE FRAME import-dbf   NO-PAUSE.
HIDE FRAME import-ascii NO-PAUSE.
HIDE FRAME import-fixed NO-PAUSE.
RETURN.

/*==========================Internal Procedures=========================*/
/* this is really adjust frame after hide  of tenant */ 
procedure adjustFrame:      
    define input  parameter pframe  as handle no-undo.
    define variable hWidget  as handle no-undo.
    define variable deAdjust as decimal no-undo.
    
    deAdjust = if session:window-system = "TTY" then 1 else 1.8. 
    hwidget = pframe:first-child.
    hwidget = hwidget:first-child.
    do while valid-handle(hwidget):
        if hwidget:hidden = false then
           hwidget:row = hwidget:row - deAdjust.
        hwidget= hwidget:next-sibling.
    end.   
    pframe:scrollable = false. 
    pframe:height = pframe:height - deAdjust. 
end.    

/*----------------------------------------------------------
   Do frame validation when user hits OK or GO.

   Input Parameter: 
      p_file    = name of file to import from      
      p_disable = disable trigger widget (yes or no)

   Returns: "error" or "".
----------------------------------------------------------*/
PROCEDURE Validate_Frame:
   DEFINE INPUT PARAMETER p_file    AS WIDGET-HANDLE NO-UNDO.
   DEFINE INPUT PARAMETER p_disable AS WIDGET-HANDLE NO-UNDO.
   DEFINE INPUT PARAMETER p_tenant  AS WIDGET-HANDLE NO-UNDO.
   
   DEFINE VARIABLE ok AS LOGICAL NO-UNDO.
   
   if isMultiTenant then 
   do:
       if not validateTenantName(p_tenant:screen-value) then
       do:
           apply "entry" to p_tenant.
           return "error".
       end.        
   end.    
   
   
   /* See if user has permission to import with triggers
      disabled.  If not, ask if he wants to continue
      anyway.
   */
   IF p_disable:SCREEN-VALUE = "yes" THEN
   DO:
      {prodict/dump/ltrigchk.i &OK = ok}
      IF NOT ok THEN DO:
         MESSAGE "You do not have permission to import" SKIP 
                 "with triggers disabled."
                 VIEW-AS ALERT-BOX ERROR BUTTON OK.
         p_disable:SCREEN-VALUE = "no".
         RETURN "error".
      END.
   END.

  IF SEARCH(p_file:SCREEN-VALUE) = ? THEN DO:
    MESSAGE new_lang[4] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO p_file.
    RETURN "error".
  END.

  RETURN "".
END.

/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/
/*
   _usrincr.p  phase 1 of GUI-mode incremental .df maker.  
   See prodict/dump_inc.p for phase 1 of batch incremental .df maker
   See ./dump/_dmpincr.p for phase 2 

   DICTDB  is the current database
           These are the baseline from which DICTDB2 will be compared 
           Definitions in DICTDB2 that are absent or extraneous to DICTDB
           constitute the incremental delta.df
   DICTDB2 is the database chosen to compare against
           This is the database for whom applying the incremental delta.df 
           would produce a database equivalent to DICTDB.

   The aim is to produce a database like DICTDB.  So this .df file will be
   run against a database like DICTDB2 to create a database like DICTDB.
*/

/*
DICTDB  = new definitions
DICTDB2 = old definitions

for each file:
  match up filename
  match up indexnames
  match up fieldnames
  handle differences
end.

match up:
  find object of same name.
  if found, leave.
  otherwise, make note and continue until all matched.
  if none left over, assume deletes.
  otherwise, ask if renamed.
  return.
end.

History:  07/14/98 DLM Added _Owner to _File Finds
          04/12/00 DLM Added support for long path names

          08/03/2006 fernando   Check permission on DICTDB2 - 20060621-015

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 45 NO-UNDO INITIAL [
  /* 1*/ "The current database must have a DBTYPE of ~"PROGRESS~".",
  /* 2*/ "You do not have permission to use this option",
  /* 3*/ "with database",
  /* 4*/ "There are no other PROGRESS databases to compare.",
  /* 5*/ "BOTH of the databases to be compared must be connected.",
  /* 6*/ "Dump Incremental Definitions",
  /* 7*/ "A file already exists with the name:",
  /* 8*/ "Overwrite it?",
  /* 9*/ "This procedure compares the data",
  /*10*/ "definitions stored in the database you",
  /*11*/ "choose with the schema of the current",
  /*12*/ "database.  This produces a new",
  /*13*/ "definition file with all new, changed",
  /*14*/ "and deleted data definitions.",
  /*15*/ "~n",
  /*16*/ "This new file can be used to upgrade an",
  /*17*/ "existing schema to be identical with",
  /*18*/ "the schema in the current database.",
  /*19*/ "(Run ~"Load Data Definitions~" from",
  /*20*/ "the database you want to upgrade",
  /*21*/ "with input from the new definition",
  /*22*/ "file produced by this procedure).",
  /*23*/ "Create Incremental Definitions File",
  /*24*/ "Set SHDBNAME and MSSDBNAME or ORADBNAME together to allow continuation",
  /*25*/ "Environment variable ",
  /*26*/ " not set properly.  Will be ignored.",
  /*27*/ "Environment variable SHDBNAME is set to """,
  /*28*/ """ as the database schema to compare against current working database """,
  /*29*/ """ does not match your screen selection of """,
  /*30*/ "Do you want to override SHDBNAME value of """,
  /*31*/ """ with your screen selection: """,
  /*32*/ "Incremental Definitions Database Comparison Selection",
  /*33*/ "SHDBNAME value """,
  /*34*/ """ is retained for execution. ",
  /*35*/ """ selection will be ignored.",
  /*36*/ """ is being overridden for execution by replacement value """,
  /*37*/ "Logical database """,
  /*38*/ """ must originate from the db type that corresponds to the set environment variable.",
  /*39*/ """ is not in the schema holder database ",
  /*40*/ "There is already a logical database """, 
  /*41*/ """ opened in another schema holder """, 
  /*42*/ "Aborting: logical database only associated with one schema holder in a session.",
  /*43*/ "Specified schema holder database """, 
  /*44*/ """ had more than one non-PROGRESS logical database.",
  /*45*/ "Your environement variables must select a logical database value when there are more than one in the specified schema holder."
].


FORM
  new_lang[9]  FORMAT "x(39)" SKIP
  new_lang[10] FORMAT "x(39)" SKIP
  new_lang[11] FORMAT "x(39)" SKIP
  new_lang[12] FORMAT "x(39)" SKIP
  new_lang[13] FORMAT "x(39)" SKIP
  new_lang[14] FORMAT "x(39)" SKIP
  new_lang[15] FORMAT "x(39)" SKIP
  new_lang[16] FORMAT "x(39)" SKIP
  new_lang[17] FORMAT "x(39)" SKIP
  new_lang[18] FORMAT "x(39)" SKIP
  new_lang[19] FORMAT "x(39)" SKIP
  new_lang[20] FORMAT "x(39)" SKIP
  new_lang[21] FORMAT "x(39)" SKIP
  new_lang[22] FORMAT "x(39)" SKIP
  WITH FRAME help1 OVERLAY NO-ATTR-SPACE 
  ROW 2 COLUMN 1 USE-TEXT NO-LABELS.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

DEFINE VARIABLE answer 	     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE c      	     AS CHARACTER NO-UNDO.
DEFINE VARIABLE i      	     AS INTEGER   NO-UNDO.
DEFINE VARIABLE canned       AS LOGICAL   NO-UNDO INIT TRUE.
DEFINE VARIABLE hBuffer      AS HANDLE    NO-UNDO.
DEFINE VARIABLE bufList      AS CHARACTER NO-UNDO EXTENT 4
   INIT ["_db","_File","_Field","_Index"].

/* For DataServer use */
DEFINE VARIABLE ds_shname    AS CHARACTER INITIAL ?  NO-UNDO.
DEFINE VARIABLE ds_dbname    AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE user-dbtype2 AS CHARACTER INITIAL ?  NO-UNDO.
DEFINE VARIABLE ds_alias     AS CHARACTER INITIAL ?  NO-UNDO.
DEFINE VARIABLE shdb2-id     AS RECID     INITIAL ?  NO-UNDO.
DEFINE VARIABLE dictdb2-id   AS RECID     INITIAL ?  NO-UNDO.
DEFINE VARIABLE errcode      AS INTEGER   INITIAL ?  NO-UNDO.
/* For DataServer use */

{prodict/misc/filesbtn.i}

FORM                                                SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Output File"
  btn_File                                          SKIP ({&VM_WIDG})
  user_env[5] {&STDPH_FILL} FORMAT "x(80)" COLON 13 VIEW-AS FILL-IN SIZE 40 BY 1
	 LABEL "Code Page"
  {prodict/user/userbtns.i}
  WITH FRAME dump1 
  SIDE-LABELS ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Dump Incremental Definitions ".



/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
/* This is the only frame used in the GUI environment */
on HELP of frame dump1
   or CHOOSE of btn_Help in frame dump1
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Dump_Incremental_Definitions_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


ON GO OF FRAME dump1
DO:
  IF SEARCH(user_env[2]:SCREEN-VALUE IN FRAME dump1) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[7] SKIP user_env[2]:SCREEN-VALUE SKIP(1) new_lang[8]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO user_env[2] IN FRAME dump1.
      RETURN NO-APPLY.
    END.
  END.
END.

ON WINDOW-CLOSE OF FRAME dump1
   APPLY "END-ERROR" TO FRAME dump1.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[2] in frame dump1
   user_env[2]:screen-value in frame dump1 = 
        TRIM(user_env[2]:screen-value in frame dump1).
{prodict/user/usrdump1.i
  &frame    = "dump1"
  &variable = "user_env[5]"
  }  /* checks if user_env[5] contains convertable code-page */
  
/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame dump1 DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame dump1 /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                 /*Must exist*/).
END.


/*============================Mainline code===============================*/


/* PROGRESS provides normal legacy execution by default */
ASSIGN s_DbType1    = "PROGRESS"
       s_DbType2    = "PROGRESS"
       user-dbtype2 = "PROGRESS". 

IF OS-GETENV("SHDBNAME") <> ? THEN DO:
  ds_shname = OS-GETENV("SHDBNAME").
  IF ds_shname = "" THEN DO:
    MESSAGE new_lang[25] "SHDBNAME" new_lang[26] /* Env. vars. not set properly */
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ds_shname = ?.
  END.
END.

IF OS-GETENV("MSSDBNAME") <> ? THEN DO:
  ds_dbname = OS-GETENV("MSSDBNAME").
  IF ds_dbname = "" THEN DO:
    MESSAGE new_lang[25] "MSSDBNAME" new_lang[26] /* Env. vars. not set properly */
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ds_dbname = ?.
  END.
  IF ds_dbname <> ? AND DBTYPE(ds_dbname) <> "MSS" THEN DO:
    MESSAGE new_lang[37] + ds_dbname + new_lang[38] /* logical db must be correct db type */
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    ds_dbname = ?.
  END.
  if ds_dbname <> ? THEN
    user-dbtype2 = "MSS".
END.
ELSE DO:
  IF OS-GETENV("ORADBNAME") <> ? THEN DO:
    ds_dbname = OS-GETENV("ORADBNAME").
    IF ds_dbname = "" THEN DO:
      MESSAGE new_lang[25] "ORADBNAME" new_lang[26] /* Env. vars. not set properly */
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      ds_dbname = ?.
    END. 
    IF ds_dbname <> ? AND DBTYPE(ds_dbname) <> "ORACLE" THEN DO:
        MESSAGE new_lang[37] + ds_dbname + new_lang[38] /* logical db must be correct db type */
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        ds_dbname = ?.
    END.
    if ds_dbname <> ? THEN
      user-dbtype2 = "ORACLE".
  END.
END.

IF ds_dbname = "" THEN
  ds_dbname = ?. /* If dflt untouched, normalize ds_dbname for legacy execution */

DELETE ALIAS "DICTDB2".
ASSIGN
  user_env[2] = "delta.df"
  c           = ?
  pik_row     = 4
  pik_down    = SCREEN-LINES - 13
  pik_column  = 42
  pik_count   = 0
  pik_title   = new_lang[23].
DO i = 1 TO cache_db#:
  IF cache_db_t[i] <> "PROGRESS"
    OR cache_db_l[i] = LDBNAME("DICTDB") THEN NEXT.
  ASSIGN
    pik_count = pik_count + 1
    pik_list[pik_count] = cache_db_l[i].
END.

IF pik_count = 0 THEN DO:
  MESSAGE new_lang[4] SKIP new_lang[5] /* no other dbs to compare to */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  DISPLAY new_lang[9]  new_lang[10] new_lang[11] new_lang[12]
      	  new_lang[13] new_lang[14] new_lang[15] new_lang[16]
      	  new_lang[17] new_lang[18] new_lang[19] new_lang[20]
      	  new_lang[21] new_lang[22] 
      	  WITH FRAME help1.
  RUN "prodict/user/_usrpick.p".
  HIDE FRAME help1.
&ELSE
  pik_text = "".
  DO i = 9 TO 22:
    pik_text = pik_text + new_lang[i].
    IF new_lang[i] <> "~n" AND i <> 22 THEN
       pik_text = pik_text + "~n".
  END.
  pik_help = {&Pick_DB_For_Incr_Dump_Dlg_Box}.
  RUN "prodict/gui/_guipick.p".
&ENDIF

IF pik_first = ? THEN DO:
  user_path = "".
  RETURN.
END.

IF ds_shname <> ? AND pik_first <> ds_shname THEN DO:
  MESSAGE new_lang[27] + ds_shname + new_lang[28] + LDBNAME("DICTDB") + """.  """ +
          ds_shname + new_lang[29] + pik_first + """." SKIP(1)
          new_lang[30] + ds_shname + new_lang[31] + pik_first + """ ?"
    VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL
    TITLE new_lang[32] UPDATE lChoice AS LOGICAL.
  CASE lChoice:
    WHEN TRUE THEN /* Yes */ DO:
      MESSAGE new_lang[33] + ds_shname + new_lang[36] + pik_first + """."
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK-CANCEL UPDATE OK AS LOGICAL.
      IF NOT ok THEN DO:
        user_path = "".
        RETURN.
      END.
      ELSE
        ds_shname = pik_first.
    END.
    WHEN FALSE THEN /* No */ DO:
      MESSAGE new_lang[33] ds_shname new_lang[34] + """" + pik_first + new_lang[35]
        VIEW-AS ALERT-BOX INFORMATION BUTTONS OK-CANCEL UPDATE OK2 AS LOGICAL.
      IF NOT ok2 THEN DO:
        user_path = "".
        RETURN.
      END.
      ELSE
        pik_first = ds_shname.
    END.
    OTHERWISE DO: /* Cancel */ 
      user_path = "".
      RETURN.
    END.
  END CASE.
END.

IF ds_shname <> ? AND ds_dbname = ? THEN DO:
  MESSAGE new_lang[24] /* Env. vars. not set properly */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "". 
  RETURN.
END.

CREATE ALIAS "DICTDB2" FOR DATABASE VALUE(pik_first) NO-ERROR.

IF ds_dbname <> ? THEN DO:
  ASSIGN ds_alias = "DICTDB2".

  RUN "prodict/misc/_valsch.p" (INPUT        ds_alias     /* Dictionary Alias Name */,
                                INPUT        pik_first    /* Schema holder name */,
                                INPUT-OUTPUT ds_dbname    /* Logical database name */,
                                INPUT-OUTPUT user-dbtype2 /* Logical database type */,
                                OUTPUT       shdb2-id     /* RECID of DICTDB */,
                                OUTPUT       dictdb2-id   /* RECID of DICTDB2 */,
                                OUTPUT       errcode      /* Error code */).  

  IF errcode > 0 THEN DO:
    CASE errcode:
      WHEN 1 THEN  
        MESSAGE new_lang[37] + ds_dbname + new_lang[39] + ds_shname + """."
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      WHEN 2 THEN
        MESSAGE new_lang[40] + ds_dbname + new_lang[41] + SDBNAME(ds_shname) + """."  SKIP(1) new_lang[42]
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      WHEN 3 THEN
        MESSAGE new_lang[43] + ds_shname + new_lang[44] SKIP(1) new_lang[45] 
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      WHEN 4 THEN
        MESSAGE new_lang[37] + ds_dbname + new_lang[39] + ds_shname + """."
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    END CASE.
    user_path = "".
    RETURN.
  END.
  
  s_DbRecId = ?. /* Borrow ADE dictionary variable not used by incremental dump */
  IF ds_dbname = ? OR ds_dbname = "" OR dictdb2-id = ? THEN DO:
      user_path = "". 
      RETURN.
  END.
  ELSE DO:
    /* DELETE ALIAS "DICTDBG". */
    /* CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(ds_dbname) NO-ERROR. */
    s_DbRecId = dictdb2-id.
    s_DbType2 = user-dbtype2.
  END.
END.
ELSE DO:
  CREATE BUFFER hBuffer FOR TABLE "DICTDB2._File" NO-ERROR.
  IF VALID-HANDLE(hBuffer) THEN DO:
    /* check all the tables we're interested in */
    REPEAT pik_count = 1 TO 4:
      hBuffer:FIND-FIRST('WHERE DICTDB2._File._File-name = '
                          + QUOTER(bufList[pik_count]) 
                          + ' AND DICTDB2._File._Owner = "PUB"', NO-LOCK) NO-ERROR.
    /* if an error occurred, assume we don't have permissions to read */
    IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
      ASSIGN C = LDBNAME("DICTDB2").
    END.
    ELSE IF hBuffer:AVAILABLE THEN DO:
      IF NOT CAN-DO(hBuffer::_Can-read,USERID("DICTDB2")) THEN c = LDBNAME("DICTDB2").
        hBuffer:BUFFER-RELEASE().
      END.

      IF c NE ? THEN 
        LEAVE.
      END.

      DELETE OBJECT hBuffer NO-ERROR.
  END.
  ELSE /* if we could not create a buffer, assume we can't read the table */
    ASSIGN C = LDBNAME("DICTDB2").
END.

IF c <> ? THEN DO:
  MESSAGE new_lang[2] SKIP new_lang[3] c /* not enough privs on db */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

DO FOR DICTDB._File:
  FIND DICTDB._File "_Db" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN c = LDBNAME("DICTDB").
  
  FIND DICTDB._File "_File" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN c = LDBNAME("DICTDB").
  
  FIND DICTDB._File "_Field" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN c = LDBNAME("DICTDB").
  
  FIND DICTDB._File "_Index" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN c = LDBNAME("DICTDB").
END.

IF c <> ? THEN DO:
  MESSAGE new_lang[2] SKIP new_lang[3] c /* not enough privs on db */
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

assign user_env[2] = "delta.df".

/*--- code-page - stuff: assign default-value   <hutegger> ---*/
if  SESSION:CHARSET = ?
 or SESSION:STREAM  = ?
 then assign 
  user_env[5]           = "<internal defaults apply>"
  user_env[5]:SENSITIVE = false.
 else assign  
  user_env[5]           = SESSION:STREAM
  user_env[5]:SENSITIVE = true.
  

PAUSE 0.
/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
   &FRAME  = "FRAME dump1" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  answer = TRUE.
  UPDATE user_env[2] btn_File user_env[5]
      	 btn_OK btn_Cancel {&HLP_BTN_NAME}
      	 WITH FRAME dump1.

  { prodict/dictnext.i c }
  canned = FALSE.
END.

HIDE FRAME dump1 NO-PAUSE.
IF canned THEN
   user_path = "".
RETURN.

/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*
  Display some interesting session information.
  Increased number of extents for propath so all .pl's will show 20010411-002
  
  D. McMann 02/21/03 Replaced GATEWAYS with DATASERVERS and remved PROGRESS
  fernando  06/06/06 Large sequence and large index support.
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE INPUT PARAMETER p_DbId AS RECID NO-UNDO.  /* not used here */

DEFINE VARIABLE codepage  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE collname  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE conn      AS LOGICAL     	NO-UNDO.
DEFINE VARIABLE drest     AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE dtype     AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE dvers     AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE fcomma	  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE fpoint	  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE i	  AS INTEGER            NO-UNDO.
DEFINE VARIABLE j	  AS INTEGER            NO-UNDO.
DEFINE VARIABLE lname     AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE mdy	  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE num       AS INTEGER            NO-UNDO.
DEFINE VARIABLE pname     AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE prpath	  AS CHARACTER EXTENT 20 NO-UNDO.
DEFINE VARIABLE scharset  AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE sname     AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE sstream   AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER          NO-UNDO.
DEFINE VARIABLE uid       AS CHARACTER   	NO-UNDO.
DEFINE VARIABLE yy        AS INTEGER        NO-UNDO.
DEFINE VARIABLE idx       AS INTEGER        NO-UNDO.
DEFINE VARIABLE Large_Sequence AS CHARACTER NO-UNDO.
DEFINE VARIABLE Large_Keys     AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_seq          AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_keys         AS LOGICAL   NO-UNDO.

DEFINE SHARED STREAM rpt.

FORM
   num      FORMAT ">>9"    LABEL "Connected DBs"       COLON 19 SKIP
   conn     FORMAT "yes/no" LABEL "Connected"           COLON 19 SKIP
   pname    FORMAT "x(50)"  LABEL "Physical name"       COLON 19 SKIP
   lname    FORMAT "x(50)"  LABEL "Logical name"        COLON 19 SKIP
   sname    FORMAT "x(50)"  LABEL "Schema holder"       COLON 19 SKIP
   dtype    FORMAT "x(50)"  LABEL "Database type"       COLON 19 SKIP
   dvers    FORMAT "x(50)"  LABEL "Database version"    COLON 19 SKIP
   drest    FORMAT "x(50)"  LABEL "Restrictions"        COLON 19 SKIP
   uid      FORMAT "x(50)"  LABEL "Database user id"    COLON 19 SKIP
   codepage FORMAT "x(50)"  LABEL "Database code page"  COLON 19 SKIP
   collname FORMAT "x(50)"  LABEL "Database collation"  COLON 19 SKIP
   WITH FRAME dbs SIDE-LABELS ATTR-SPACE CENTERED USE-TEXT STREAM-IO
   TITLE " Currently Selected Database ".

FORM
   num      FORMAT ">>9"    LABEL "Connected DBs"       COLON 19 SKIP
   conn     FORMAT "yes/no" LABEL "Connected"           COLON 19 SKIP
   pname    FORMAT "x(50)"  LABEL "Physical name"       COLON 19 SKIP
   lname    FORMAT "x(50)"  LABEL "Logical name"        COLON 19 SKIP
   sname    FORMAT "x(50)"  LABEL "Schema holder"       COLON 19 SKIP
   dtype    FORMAT "x(50)"  LABEL "Database type"       COLON 19 SKIP
   dvers    FORMAT "x(50)"  LABEL "Database version"    COLON 19 SKIP
   drest    FORMAT "x(50)"  LABEL "Restrictions"        COLON 19 SKIP
   uid      FORMAT "x(50)"  LABEL "Database user id"    COLON 19 SKIP
   codepage FORMAT "x(50)"  LABEL "Database code page"  COLON 19 SKIP
   collname FORMAT "x(50)"  LABEL "Database collation"  COLON 19 SKIP
   Large_Sequence FORMAT "x(20)"  LABEL "64-bit Sequences" COLON 19 SKIP
   Large_Keys     FORMAT "x(20)"  LABEL "Large key entries"  COLON 19 SKIP
   WITH FRAME dbs-2 SIDE-LABELS ATTR-SPACE CENTERED USE-TEXT STREAM-IO
   TITLE " Currently Selected Database ".

ASSIGN
  fpoint   = SUBSTRING(STRING(1,"9."),2,1)
  fcomma   = STRING(fpoint = ".",",/.")
  scharset = SESSION:CHARSET
  prpath   = PROPATH
  sstream  = SESSION:STREAM.

{ prodict/dictsplt.i &src=PROPATH &dst=prpath &num=20 &len=60 &chr="," }

RUN "prodict/_dctyear.p" (OUTPUT mdy,OUTPUT yy).

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
IF user_dbname = ? OR user_dbname = "" THEN DO:
  /* if only db is non-V10, show info on the first one. */

  /* 20060209-012
     Make sure we omit the password, after the '/' character, in case
     this is an ORACLE schema.
  */
  ASSIGN uid = USERID(LDBNAME(1))
         idx = INDEX(uid,"/").

  IF idx > 0 THEN
     uid = SUBSTRING(uid,1,idx - 1).

  DISPLAY STREAM rpt
    NUM-DBS      @ num
    IF NUM-DBS > 0 THEN yes ELSE no @ conn
    PDBNAME(1)   @ pname
    LDBNAME(1)   @ lname
    SDBNAME(1)   @ sname
    DBTYPE(1)	 @ dtype
    DBVERSION(1) @ dvers
    DBREST(1)    @ drest
    uid  
    ?            @ codepage
    ?            @ collname
    WITH FRAME dbs.
  END.
  ELSE DO:
    RUN prodict/user/_usrinf3.p 
      (INPUT  user_dbname,
       INPUT  user_dbtype,
       OUTPUT codepage, 
       OUTPUT collname,
       OUTPUT l_seq,
       OUTPUT l_keys).

    /* 20060209-012
       Make sure we omit the password, after the '/' character, in case
       this is an ORACLE schema.
    */
    ASSIGN uid = USERID(user_dbname)
           idx = INDEX(uid,"/").

    IF idx > 0 THEN
       uid = SUBSTRING(uid,1,idx - 1).

    /* if this is not a Progress db, or it's running with a pre-10.1B release,
       where large sequence and large keys support is not available, don't bother 
       displaying information.
    */
    IF user_dbtype NE "PROGRESS" OR (l_seq = ? AND l_keys = ?) THEN
    DISPLAY STREAM rpt
      NUM-DBS    	     @ num
      yes		     @ conn
      PDBNAME(user_dbname)   @ pname
      LDBNAME(user_dbname)   @ lname
      SDBNAME(user_dbname)   @ sname
      DBTYPE(user_dbname)    @ dtype
      DBVERSION(user_dbname) @ dvers
      DBREST(user_dbname)    @ drest
      uid
      codepage
      collname
      WITH FRAME dbs.
    ELSE
      DISPLAY STREAM rpt
            NUM-DBS    	     @ num
            yes		     @ conn
            PDBNAME(user_dbname)   @ pname
            LDBNAME(user_dbname)   @ lname
            SDBNAME(user_dbname)   @ sname
            DBTYPE(user_dbname)    @ dtype
            DBVERSION(user_dbname) @ dvers
            DBREST(user_dbname)    @ drest
            uid
            codepage
            collname
            (IF l_seq = ? THEN "n/a" ELSE 
                    IF l_seq THEN "enabled" 
                        ELSE "not enabled") @ Large_Sequence
            (IF l_keys = ? THEN "n/a" ELSE 
                    IF l_keys THEN "enabled" 
                        ELSE "not enabled") @ Large_Keys
            WITH FRAME dbs-2.
    END.
        

DISPLAY STREAM rpt
  OPSYS       FORMAT "x(55)" LABEL "Operating System" COLON 18 SKIP
  PROVERSION  FORMAT "x(55)" LABEL "PRO version"      COLON 18 SKIP
  DATASERVERS FORMAT "x(55)" LABEL "DataServers"      COLON 18 SKIP
  WITH FRAME ops SIDE-LABELS ATTR-SPACE CENTERED USE-TEXT STREAM-IO
  TITLE " OpenEdge and Operating System ".

DISPLAY STREAM rpt
  yy       FORMAT ">>>9"  LABEL "-yy century setting"     COLON 22
  fpoint   FORMAT "x"     LABEL "Decimal point character" COLON 56 SKIP
  mdy      FORMAT "x(4)"  LABEL "-d dmy date setting"     COLON 22
  fcomma   FORMAT "x"     LABEL "Thousands separator"     COLON 56 SKIP(1)
  sstream  FORMAT "x(20)" LABEL "Session stream"          COLON 22 SKIP
  scharset FORMAT "x(20)" LABEL "Session charset"         COLON 22 SKIP(1)
  "PROPATH =" NO-ATTR-SPACE                             AT 2  
              prpath[1] FORMAT "x(60)" NO-LABEL         AT 12 SKIP
      	      prpath[2] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[3] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[4] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[5] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[6] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
              prpath[7] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[8] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
              prpath[9] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[10] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
              prpath[11] FORMAT "x(60)" NO-LABEL        AT 12 SKIP
      	      prpath[12] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[13] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[14] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[15] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[16] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
              prpath[17] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[18] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
              prpath[19] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
      	      prpath[20] FORMAT "x(60)" NO-LABEL       	AT 12 SKIP
  WITH FRAME env SIDE-LABELS ATTR-SPACE CENTERED USE-TEXT STREAM-IO
  TITLE " Environment/Startup Parameters ".

DISPLAY STREAM rpt
  SCREEN-LINES  FORMAT ">>9"    LABEL "Screen lines"  COLON 15 SKIP
  MESSAGE-LINES FORMAT ">>9"    LABEL "Message lines" COLON 15 SKIP
  IS-ATTR-SPACE FORMAT "yes/no" LABEL "Space-taking"  COLON 15 SKIP
  TERMINAL      FORMAT "x(30)"  LABEL "Terminal type" COLON 15 SKIP(1)
  WITH FRAME scr SIDE-LABELS ATTR-SPACE CENTERED USE-TEXT STREAM-IO
  TITLE " Screen ".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

RETURN.
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*--------------------------------------------------------------------

File: prodict/user/_usrinf3.p

Description:
    gets collation- and codepage-name of current DB. Also large sequence
    and large key support flags
    
Input-Parameters:
    p_currdb        name of current DB
        
Output-Parameters:
    p_collname      collation-name of current db
    p_codepage      codepage-name of current db
    p_large_seq     yes/no for large sequence support or ? for n/a
    p_large_keys    yes/no for large keys support or ? for n/a
    
    
History:
    hutegger    94/06/13    creation
    McMann      10/17/03  Add NO-LOCK statement to _Db find in support of on-line schema add
    fernando    06/06/06  large sequence and large keys support
    
--------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER p_currdbn  AS character.
DEFINE INPUT  PARAMETER p_currdbt  AS character.
DEFINE OUTPUT PARAMETER p_codepage AS character.
DEFINE OUTPUT PARAMETER p_collname AS character.
DEFINE OUTPUT PARAMETER p_large_seq AS LOGICAL.
DEFINE OUTPUT PARAMETER p_large_keys AS LOGICAL.

/*------------------------------------------------------------------*/

if p_currdbt = "PROGRESS"
  then find first DICTDB._db where DICTDB._db._db-name = ?         NO-LOCK no-error.         
  else find first DICTDB._db where DICTDB._db._db-name = p_currdbn NO-LOCK no-error.         
if available DICTDB._Db
  then do: 
    assign 
    p_codepage = DICTDB._Db._Db-xl-name
    p_collname = DICTDB._Db._Db-coll-name.               

    /* For large key support, we look at the _Database-feature table.
       For large sequence - if 'Large Keys' is not a valid feature, than this
       is a pre-10.1B db in which case large sequences is not
       applicable. Otherwise we look at db-res1[1].
       But only for Progress databases.
    */
    IF p_currdbt = "PROGRESS" THEN
       FIND DICTDB._Database-feature WHERE _DBFeature_Name = "Large Keys" NO-LOCK NO-ERROR.

    IF AVAILABLE DICTDB._Database-feature THEN DO:
        IF DICTDB._Database-feature._DBFeature_Enabled = "1" THEN
           p_large_keys = YES.
        ELSE
           p_large_keys = NO.

           IF DICTDB._Db._db-res1[1] = 1 THEN 
               p_large_seq = YES.
           ELSE
               p_large_seq = NO.
    END.
    ELSE 
        ASSIGN p_large_keys = ?
               p_large_seq = ?.
  END.
  else assign 
    p_codepage = ""
    p_collname = ""
    p_large_seq = ?
    p_large_keys = ?. 


/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*
  Display some interesting session information.
*/

{prodict/user/uservar.i}
{adecomm/commeng.i}  /* Help contexts for common stuff */

DEFINE VARIABLE attrib	AS CHARACTER EXTENT 3 NO-UNDO INITIAL 
[
  "NORMAL", "INPUT", "MESSAGES"
].

FORM 
  SKIP({&TFM_WID})
  attrib[1] FORMAT "x(7)" AT 2
  attrib[2] FORMAT "x(6)" 
  attrib[3] FORMAT "x(10)" 
   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &HELP   = {&HLP_BTN_NAME}
  }
  WITH FRAME clrs 
  NO-LABELS ATTR-SPACE ROW 5 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_OK
  VIEW-AS DIALOG-BOX  TITLE " Video Attribute Settings ".

COLOR DISPLAY NORMAL   attrib[1] WITH FRAME clrs.
COLOR DISPLAY INPUT    attrib[2] WITH FRAME clrs.
COLOR DISPLAY MESSAGES attrib[3] WITH FRAME clrs.


/*==============================Triggers================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame clrs
   or CHOOSE of btn_Help in frame clrs 
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Video_Attribute_Settings_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF

ON WINDOW-CLOSE OF FRAME clrs
   APPLY "END-ERROR" TO FRAME clrs.

/*============================Mainline Code=============================*/

/* _usrinf2.p will do the real display work.  Use report code to see the
  info in an editor widget. 
*/
RUN adecomm/_report.p 
   (INPUT ?,
    INPUT "Session Information",
    INPUT "Session Information",
    INPUT "",
    INPUT "",
    INPUT "prodict/user/_usrinf2.p",
    INPUT "",
    INPUT {&Session_Information_Dlg_Box}).

/* Because we can't show the color stuff via a file, put up an extra
   little dialog to show that. 
*/
/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME clrs" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    &HELP   = {&HLP_BTN_NAME}
}

DISPLAY 
    attrib[1] attrib[2] attrib[3]
    WITH FRAME clrs.
DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
   UPDATE btn_OK {&HLP_BTN_NAME} WITH FRAME clrs.
END.

HIDE FRAME clrs NO-PAUSE.




/**********************************************************************
* Copyright (C) 2000-2010 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/


/* userkchg - Sequence Editor */
/* HISTORY:
   
   Modified on 07/08/94 by gfs      Fixed 94-06-28-033
               08/08/02 D. McMann  Eliminated any sequences whose name begins "$" - Peer Direct
               05/25/06 fernando   Support for 64-bit sequences    
*/
{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/*
+----------------------------------++------------------------------------------+
| 12345678901234567890123456789012 ||                                          |
| 12345678901234567890123456789012 || Name: x(32)___________________________   |
| 12345678901234567890123456789012 ||                                          |
| 12345678901234567890123456789012 || Initial Value: ->,>>>,>>>,>>>,>>>,>>>,>>9|
| 12345678901234567890123456789012 ||  Increment By: ->,>>>,>>>,>>>,>>>,>>>,>>9|
| 12345678901234567890123456789012 ||   Upper Limit: ->,>>>,>>>,>>>,>>>,>>>,>>9|
| 12345678901234567890123456789012 || Current Value: ->,>>>,>>>,>>>,>>>,>>>,>>9|
| 12345678901234567890123456789012 ||                                          |
| 12345678901234567890123456789012 || Cycle at Limit: no                       |
| 12345678901234567890123456789012 ||                                          |
| 12345678901234567890123456789012 ||DataServer Name: ->,>>>,>>>,>>9           |
| 12345678901234567890123456789012 ||          Owner: ->,>>>,>>>,>>9           |
+----------------------------------++-1234567890123456789012345678901234567890-+

   [Next] [Prev] [>NextPage] [<PrevPage] [First] [Last] [Add] [Modify]
   [Delete] [Undo] [Exit]

Modified: 07/14/98 D. McMann Added _Owner to _File finds
          01/11/00 D. McMann Added display of b_seq._seq-name to NEXT & PREV
                             19990820-003
          07/01/02 D. McMann Added assignment of dict_dirty for on-line schema add.
          05/25/06 fernando  Added support for 64-bit sequences
*/
&IF "{&WINDOW-SYSTEM}" = "TTY"
&THEN
DEFINE BUFFER b_Seq FOR _Sequence.

DEFINE VARIABLE answer    AS LOGICAL               NO-UNDO.
DEFINE VARIABLE i         AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE j         AS INTEGER               NO-UNDO.
DEFINE VARIABLE in_trans  AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE qbf#      AS INTEGER INITIAL 1     NO-UNDO.
DEFINE VARIABLE qbf#list  AS CHARACTER             NO-UNDO.
DEFINE VARIABLE redraw    AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE adding    AS LOGICAL               NO-UNDO.
DEFINE VARIABLE limit     AS INT64                 NO-UNDO.
DEFINE VARIABLE large_seq AS LOGICAL               NO-UNDO.
DEFINE VARIABLE curr_value AS CHARACTER            NO-UNDO.
DEFINE VARIABLE c_not_largeseq AS CHARACTER        NO-UNDO.
DEFINE VARIABLE ctemp          AS CHARACTER            NO-UNDO.
define variable multitenantdb as logical no-undo.
/* Recid of sequence whose properties are showing (disp) and recid of
   the selected sequence in the list (rec). */
DEFINE VARIABLE qbf_disp AS RECID   INITIAL ?     NO-UNDO.
DEFINE VARIABLE qbf_rec  AS RECID                 NO-UNDO.

/* qbf_was is where the selection was before the last function was executed.*/
DEFINE VARIABLE qbf_was  AS INTEGER INITIAL 2     NO-UNDO.


DEFINE VARIABLE qbf AS CHARACTER EXTENT 11 NO-UNDO INITIAL [
  "Next", "Prev",   ">NextPage", "<PrevPage", "First", "Last",
  "Add",  "Modify", "Delete",   "Undo",    "Exit"
].

&global-define  NEXT         1
&global-define  PREV         2
&global-define  NEXTPG        3
&global-define  PREVPG        4
&global-define  FIRST        5
&global-define  LAST         6
&global-define  ADD          7
&global-define  MODIFY        8
&global-define  DELETE        9
&global-define  UNDO        10
&global-define  EXIT        11

FORM
  b_Seq._Seq-Name NO-LABEL
  WITH FRAME seq-browse ROW 2 COLUMN 1 12 DOWN ATTR-SPACE
  TITLE " Sequence Names ".

FORM SKIP
  b_Seq._Seq-Name  AT 4     LABEL "Name"            SKIP(1)
  b_Seq._Seq-Attributes[1] COLON 15  LABEL "Multi-tenant" SKIP
  b_Seq._Seq-Init  COLON 15 LABEL "Initial Value" 
                            FORMAT "->,>>>,>>>,>>>,>>>,>>>,>>9" SKIP
  b_Seq._Seq-Incr  COLON 15 LABEL "Increment By"  
                            FORMAT "->,>>>,>>>,>>>,>>>,>>>,>>9" SKIP
  limit            COLON 15 LABEL "Upper Limit"   
                            FORMAT "->,>>>,>>>,>>>,>>>,>>>,>>9" SKIP
  curr_value      COLON 15 LABEL "Current Value" FORMAT "X(26)" SKIP(1)
  b_Seq._Cycle-Ok  COLON 16 LABEL "Cycle at limit"  SKIP(1)
  b_Seq._Seq-misc[1]   COLON 16 LABEL "DataServer Name" SKIP
  b_Seq._Seq-misc[2]   COLON 16 LABEL "Owner"           SKIP
  WITH FRAME seq-detail ROW 2 COLUMN 37 SIDE-LABELS
  TITLE " Sequence Attributes ".

FORM
  qbf[ 1] /*Next*/          FORMAT "x(4)":u
    HELP "Look at the next sequence."
  qbf[ 2] /*Prev*/          FORMAT "x(4)":u
    HELP "Look at the previous sequence."
  qbf[ 3] /*NextPage*/      FORMAT "x(9)":u
    HELP "Look at the next set of sequences."
  qbf[ 4] /*PrevPage*/      FORMAT "x(9)":u
    HELP "Look at the previous set of sequence."
  qbf[ 5] /*First*/         FORMAT "x(5)":u
    HELP "Look at the first sequence."
  qbf[ 6] /*Last*/          FORMAT "x(4)":u 
    HELP "Look at the last sequence." 
  qbf[ 7] /*Add*/        FORMAT "x(03)":u
    HELP "Add a new sequence."
  qbf[ 8] /*Modify*/     FORMAT "x(06)":u
    HELP "Update or Rename a sequence."
  qbf[ 9] /*Delete*/     FORMAT "x(06)":u
    HELP "Remove a sequence."
  qbf[10] /*Undo*/       FORMAT "x(04)":u
    HELP "Undo this session's changes to the sequence structures."
  qbf[11] /*Exit*/       FORMAT "x(04)":u
    HELP "Exit sequence Editor."
  HEADER ""
  WITH FRAME qbf ATTR-SPACE NO-LABELS NO-BOX 
  ROW SCREEN-LINES - 4 CENTERED.

DEFINE VARIABLE capab    AS CHARACTER NO-UNDO.

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  /* 1*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 2*/ "You do not have permission to use this option.",
  /* 3*/ "Are you sure that you want to remove the definition for sequence ",
  /* 4*/ "Undo all changes since entering the sequence editor?",
  /* 5*/ "You have reached the last sequence in the table.",
  /* 6*/ "You have reached the first sequence in the table.",
  /* 7*/ "That sequence name is already used or is not a valid identifier.",
  /* 8*/ "You haven't yet made changes that need to be undone!",
  /* 9*/ "This function is inappropriate when there are no sequences.",
  /*10*/ "A sequence with this name already exists in this database",
  /*11*/ "This function is not supported for this database type",
  /*12*/ "has an invalid value"
].

/*===============================Triggers===================================*/

/*----- LEAVE of NAME FIELD -----*/
on leave of b_Seq._Seq-Name in frame seq-detail
do:
   Define var okay as logical.
   Define var name as char.

   name = TRIM (SELF:screen-value). 

   /* If editing and the name hasn't been changed from what it started as,
      do nothing. */ 
   if NOT adding AND LC(b_Seq._Seq-Name) = LC(name) then
      return.

   RUN "adecomm/_valname.p":u (INPUT name, INPUT no, OUTPUT okay).
   IF NOT okay THEN 
      return NO-APPLY.
   ELSE
      SELF:SCREEN-VALUE = name.  /* Reset the trimmed value */

   /* Make sure there isn't already an object with this name. */
   IF CAN-FIND (_Sequence where _Sequence._Seq-Name = name) THEN DO:
      message new_lang[10].  /* Duplicate name */
      RETURN NO-APPLY.
   END.

   HIDE MESSAGE NO-PAUSE.
   /* message to let the user know that 64-bit sequence support is not on */
   IF c_not_largeseq NE "" THEN
      MESSAGE c_not_largeseq.

end.

/*----- LEAVE of INITIAL VALUE -----*/
on leave of b_Seq._Seq-Init in frame seq-detail
do:
    Define var iValue as int64 NO-UNDO.
    DEFINE VAR IntVal AS INTEGER NO-UNDO.

    /* large_seq can be ? for pre-101b dbs */
    IF large_seq NE YES THEN DO:
        intVal = INT(SELF:SCREEN-VALUE) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1).
            RETURN NO-APPLY.
        END.
    END.
    ELSE DO:
        iValue = int64(SELF:SCREEN-VALUE) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1).
            RETURN NO-APPLY.
        END.
    END.

   HIDE MESSAGE NO-PAUSE.
   /* message to let the user know that 64-bit sequences support is not on */
   IF c_not_largeseq NE "" THEN
      MESSAGE c_not_largeseq.
end.

/*----- LEAVE of LIMIT -----*/
on leave of limit in frame seq-detail
do:
    Define var iValue as int64 NO-UNDO.
    DEFINE VAR IntVal AS INTEGER NO-UNDO.

    /* large_seq can be ? for pre-101b dbs */
    IF large_seq NE YES THEN DO:
        intVal = INT(SELF:SCREEN-VALUE) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1).
            RETURN NO-APPLY.
        END.
    END.
    ELSE DO:
        iValue = int64(SELF:SCREEN-VALUE) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1).
            RETURN NO-APPLY.
        END.
    END.

   HIDE MESSAGE NO-PAUSE.
   /* message to let the user know that 64-bit sequences support is not on */
   IF c_not_largeseq NE "" THEN
      MESSAGE c_not_largeseq.
end.

/*----- LEAVE of INCREMENT -----*/
on leave of b_Seq._Seq-Incr in frame seq-detail
do:
   Define var incr as DECIMAL NO-UNDO.
   Define var iValue as int64 NO-UNDO.
   DEFINE VAR IntVal AS INTEGER NO-UNDO.

   incr = DECIMAL(b_Seq._Seq-Incr:SCREEN-VALUE).

   if incr = 0 then
   do:
      message "Increment can be negative or positive but not 0.".
      return NO-APPLY.
   end.

    /* large_seq can be ? for pre-101b dbs */
    IF large_seq NE YES THEN DO:
        intVal = INT(SELF:SCREEN-VALUE) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1).
            RETURN NO-APPLY.
        END.
    END.
    ELSE DO:
        iValue = int64(SELF:SCREEN-VALUE) NO-ERROR.
        IF ERROR-STATUS:ERROR THEN DO:
            MESSAGE ERROR-STATUS:GET-MESSAGE(1).
            RETURN NO-APPLY.
        END.
    END.

   if incr < 0 then
      limit:LABEL in frame seq-detail = "Lower Limit".
   else 
      limit:LABEL in frame seq-detail = "Upper Limit".
  
   HIDE MESSAGE NO-PAUSE.
   /* message to let the user know that 64-bit sequences support is not on */
   IF c_not_largeseq NE "" THEN
      MESSAGE c_not_largeseq.

end.


/*----- ON GO -----*/
ON GO of FRAME seq-detail 
do:
   Define var incr as int64 NO-UNDO.
   Define var lmt  as int64 NO-UNDO.
   Define var init as int64 NO-UNDO.

   do ON ERROR UNDO, LEAVE:
      assign
         incr = input frame seq-detail b_Seq._Seq-Incr
         init = input frame seq-detail b_Seq._Seq-Init
         lmt  = input frame seq-detail limit.
   
      if incr > 0 then
      do:
         if lmt <= init then
         do:
            message "The upper limit must be greater than the initial value.".
            apply "ENTRY":u to b_Seq._Seq-Init in FRAME seq-detail.
            RETURN NO-APPLY.
         end.
      end.
      else /* _Seq-Incr < 0 */
      do:
         if lmt >= init then
         do:
            message "The lower limit must be less than the initial value.".
            apply "ENTRY":u to b_Seq._Seq-Init in FRAME seq-detail.
            return NO-APPLY.
         end.
      end.
      return.
   end.
   return NO-APPLY.  /* an error occurred on assign */
end.



/*==========================Internal Procedures=============================*/

/*-------------------------------------------------------------------
   Add or modify a sequence and perform all necessary validation.

   Output Parameter: 
      p_Okay - Set to true if transaction was successful.
-------------------------------------------------------------------*/
    
PROCEDURE Add_Modify:

   DEFINE OUTPUT PARAMETER p_Okay AS LOGICAL NO-UNDO.

   DO ON ERROR UNDO,RETRY ON ENDKEY UNDO, LEAVE:
      if adding then
      do:   /*--------- creating new sequence ---------*/
               CREATE b_Seq.
               ASSIGN
                  b_Seq._Db-recid = drec_db
                  limit = b_Seq._Seq-Max
                  limit:LABEL in FRAME seq-detail = "Upper Limit".

               DISPLAY "" @ b_Seq._Seq-Name
                       b_Seq._Seq-Attributes[1]
                       b_Seq._Seq-Init 
                       b_Seq._Seq-Incr
                       limit
                       b_Seq._Cycle-Ok
                       "" @ curr_value
                       WITH FRAME seq-detail.
         SET
            b_Seq._Seq-Name
            b_Seq._Seq-Attributes[1] when multitenantdb
            b_Seq._Seq-Init 
            b_Seq._Seq-Incr
            limit
            b_Seq._Cycle-Ok
            WITH FRAME seq-detail.
         ASSIGN dict_dirty = TRUE.
      end.
      else do:  /*--------- updateing existing sequence ---------*/
               if b_Seq._Seq-Incr > 0 then 
                  ASSIGN
                     limit:LABEL in FRAME seq-detail = "Upper Limit"
                     limit = b_Seq._Seq-Max.
               else
                  ASSIGN
                     limit:LABEL in FRAME seq-detail = "Lower Limit"
                     limit = b_Seq._Seq-Min.

        IF INDEX(capab,"m":u) <> 0 THEN 
        DO:
            IF INDEX(capab,"r":u) <> 0 THEN
            do WITH FRAME seq-detail: 
              prompt-for
                b_Seq._Seq-Name
               /* decided to not support this in v 11.0.0 (keep this commented in case we add it back ) 
                b_Seq._Seq-Attributes[1] when multitenantdb and not b_Seq._Seq-Attributes[1]*/
                b_Seq._Seq-Init 
                b_Seq._Seq-Incr
                limit
                b_Seq._Cycle-Ok
                .
              /* 
               decided to not support this in v 11.0.0 (keep this commented in case we add it back ) 
                 
              if input b_Seq._Seq-Attributes[1] and not b_Seq._Seq-Attributes[1] then
              do:
                  run prodict/pro/_pro_mt_seq.p.
                  if return-value = "error" then
                  do:
                       disp b_Seq._Seq-Attributes[1].
                       undo, retry. 
                  end.       
                  
              end.
                */    
              assign
                b_Seq._Seq-Name
             /* not for v 11.0.0 - perhaps later 
                b_Seq._Seq-Attributes[1] when multitenantdb and not b_Seq._Seq-Attributes[1]*/
                b_Seq._Seq-Init 
                b_Seq._Seq-Incr
                limit
                b_Seq._Cycle-Ok
                 .  
            end.
            ELSE UPDATE
                b_Seq._Seq-Init 
                b_Seq._Seq-Incr
                limit
                b_Seq._Cycle-Ok
                WITH FRAME seq-detail.
        END.
        ELSE DO:     /* modifying anything but name not allowed */
            IF INDEX(capab,"r":u) <> 0 
              THEN UPDATE
                b_Seq._Seq-Name
                WITH FRAME seq-detail.
          /*  ELSE no modification is alowed at all */
        END.
      end.

      if b_Seq._Seq-Incr > 0 then
          ASSIGN
              b_Seq._Seq-Max = limit
              b_Seq._Seq-Min = b_Seq._Seq-Init.
      else 
          ASSIGN
              b_Seq._Seq-Min = limit
              b_Seq._Seq-Max = b_Seq._Seq-Init.
   
      p_Okay = true.
     dict_dirty = TRUE.

      return.
   END.

   p_Okay = false.
END.


/*==============================Mainline Code=============================*/

FIND _File "_Sequence":u WHERE _File._Owner = "PUB" NO-LOCK.
IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
  MESSAGE new_lang[7] VIEW-AS ALERT-BOX ERROR BUTTONS OK.  /* No permission */
  user_path = "".
  RETURN.
END.

/* check if this db supports 64-bit sequences 
   just care about large_seq really.
   
   
   Pass the DICTDB name since that for non-OE schemas, we will know if
   it is turned on of it's on for the schema holder.
*/
RUN prodict/user/_usrinf3.p 
      (INPUT  LDBNAME("DICTDB"),
       INPUT  "PROGRESS",
       OUTPUT cTemp, 
       OUTPUT cTemp,
       OUTPUT large_seq,
       OUTPUT answer).

/* dbs running with pre-10.01B servers will have no knowledge of 64-bit sequences,
   so don't need to display message (in which case large_seq = ?)
*/
IF large_seq NE NO THEN
   ASSIGN c_not_largeseq = "".
ELSE 
   ASSIGN c_not_largeseq = "64-bit sequences support not enabled".

multitenantdb = can-find(first dictdb._tenant).

DO WITH FRAME seq-detail:
    /* alter format if 64-bit sequences support it not turned on */
    /* don't resize fill-in */
    IF large_seq NE YES THEN
        ASSIGN b_Seq._Seq-Init:AUTO-RESIZE = NO
               b_Seq._Seq-Incr:AUTO-RESIZE = NO
               limit:AUTO-RESIZE = NO
               b_Seq._Seq-Init:FORMAT = "->,>>>,>>>,>>9"
               b_Seq._Seq-Incr:FORMAT = "->,>>>,>>>,>>9"
               limit:FORMAT = "->,>>>,>>>,>>9".
END.

{prodict/dictgate.i
    &action = "query"
    &output = "capab"
    &dbrec  = "?"
    &dbtype = "user_dbtype"
    }
assign capab = ENTRY(10,capab).
IF INDEX(capab,"s":u) = 0 
  THEN DO:
    MESSAGE
      "This DataServer does not support sequences"
      view-as alert-box.
    RETURN.
    END.
   
/* There is an entry in qbf#list for each available option.  If there is
   some reason that an option is unavailable, store the message # (new_lang
   index) there which will be displayed when that option is chosen.
*/
qbf#list = "0,0,0,0,0,0,":u
         + ( IF dict_rog THEN "1":u ELSE
            (IF NOT CAN-DO(_Can-create ,USERID("DICTDB":u)) THEN "2":u ELSE
            (IF INDEX(capab,"a":u) = 0 THEN "11":u ELSE "0":u)))
         + ",":u +
           ( IF dict_rog THEN "1":u ELSE
            (IF NOT CAN-DO(_Can-write,USERID("DICTDB":u)) THEN "2":u ELSE 
            (IF (INDEX(capab,"m":u) = 0 AND INDEX(capab,"r":u) = 0 )THEN "11":u ELSE "0":u)))
         + ",":u +
           ( IF dict_rog THEN "1":u ELSE
            (IF NOT CAN-DO(_Can-delete,USERID("DICTDB":u)) THEN "2":u ELSE 
            (IF INDEX(capab,"d":u) = 0 THEN "11":u ELSE "0":u)))
         + ",0,0":u.

PAUSE 0.
VIEW FRAME seq-browse.
VIEW FRAME seq-detail.

/* message to let the user know that 64-bit sequences support is not on */
IF c_not_largeseq NE "" THEN
   MESSAGE c_not_largeseq.

qbf_block:
DO TRANSACTION ON ERROR UNDO,RETRY:

  qbf_inner:
  DO WHILE TRUE WITH FRAME seq-browse:

    qbf_rec = RECID(b_Seq).

    IF redraw THEN DO:
      DISPLAY qbf WITH FRAME qbf.

      ASSIGN
        qbf_disp = ?
        redraw   = FALSE.

      IF qbf_rec <> ? THEN 
        /* This doesn't make any sense - this record should already be
                 in the buffer - but w.o it things don't work right! */
        FIND b_Seq WHERE RECID(b_Seq) = qbf_rec NO-ERROR.
      ELSE DO:
              FIND FIRST b_Seq where b_Seq._Db-recid = drec_db 
                                 AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
              qbf_rec = RECID(b_Seq).
      END.

      /* Display the list of sequences. j will end up being the current
               iteration (FRAME-LINE) and i is a fudge factor for when you
         run off the top of the list.
      */
      ASSIGN
        j = (IF FRAME-LINE = 0 THEN 1 ELSE FRAME-LINE)
        i = 3.
      UP j - 1.
      IF j > 1 THEN DO i = 2 TO j WHILE AVAILABLE b_Seq:
        FIND PREV b_Seq where b_Seq._Db-recid = drec_db
                          AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      END.
      IF NOT AVAILABLE b_Seq THEN DO:
        FIND FIRST b_Seq where b_Seq._Db-recid = drec_db
                           AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
        j = i - 2.
      END.

      DO i = 1 TO FRAME-DOWN(seq-browse):
        /* This avoids displays when the value we want is already there */
        IF INPUT FRAME seq-browse b_Seq._Seq-Name =
                (IF AVAILABLE b_Seq THEN b_Seq._Seq-Name ELSE "")
        THEN .
        ELSE IF AVAILABLE b_Seq THEN
          DISPLAY b_Seq._Seq-Name WITH FRAME seq-browse.
        ELSE
          CLEAR FRAME seq-browse NO-PAUSE.  
        COLOR DISPLAY
          VALUE(IF RECID(b_Seq) = qbf_rec AND RECID(b_Seq) <> ?
          THEN "MESSAGES":u ELSE "NORMAL":u) b_Seq._Seq-Name.
        DOWN.
        IF AVAILABLE b_Seq THEN FIND NEXT b_Seq 
                where b_Seq._Db-recid = drec_db 
                  AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      END.
      IF qbf_rec <> ? THEN
              /* Reset the b_Seq buffer to the one that's highlit. */
        FIND b_Seq WHERE RECID(b_Seq) = qbf_rec 
                     AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      UP FRAME-DOWN - j + 1.
    END.
   
    /* Reset the selection indicator. qbf_was is where the selection was
       before the last function was executed.  This tells us which item
       to clear the color on and then we can reset the selection to 
       FRAME-LINE.
    */       
    IF qbf_was <> FRAME-LINE THEN DO:
      i = FRAME-LINE.
      DOWN qbf_was - i.
      COLOR DISPLAY NORMAL b_Seq._Seq-Name.
      DOWN i - qbf_was.
      IF qbf_rec <> ? THEN COLOR DISPLAY MESSAGES b_Seq._Seq-Name.
      qbf_was = FRAME-LINE.  
    END.
    /* Display info on the first sequence. */
    IF AVAILABLE b_Seq AND qbf_disp <> RECID(b_Seq) THEN DO:
      if b_Seq._Seq-Incr < 0 then
               limit:LABEL in frame seq-detail = "Lower Limit".
      else 
               limit:LABEL in frame seq-detail = "Upper Limit".

      /* get current value of sequence, for Progress db only */
      IF NOT b_Seq._Seq-Attributes[1] and INDEX(capab,"n":u) = 0 THEN DO:
          ASSIGN curr_value = ""
                 /* if sequence was just created, this will fail so need to specify NO-ERROR */
                 curr_value = TRIM(STRING(DYNAMIC-CURRENT-VALUE(b_Seq._Seq-Name, "DICTDB"),"->,>>>,>>>,>>>,>>>,>>>,>>9")) NO-ERROR.
      END.
      
      
      DISPLAY   
        b_Seq._Seq-Name  
        b_Seq._Seq-Attributes[1]  
        b_Seq._Seq-Init  
        b_Seq._Seq-Incr
        (if b_Seq._Seq-Incr > 0 then b_Seq._Seq-Max else b_Seq._Seq-Min)
                  @ limit
        b_Seq._Cycle-Ok
        (IF b_Seq._Seq-Attributes[1] then "<one value per tenant>" 
         else if NOT b_Seq._Seq-Attributes[1] and INDEX(capab,"n":u) = 0 THEN curr_value 
         ELSE "n/a") @ curr_value
        (IF INDEX(capab,"n":u) = 0 THEN "n/a" ELSE b_Seq._Seq-misc[1])
                  @ b_Seq._Seq-misc[1]
        (IF INDEX(capab,"o":u) = 0 THEN "n/a" ELSE b_Seq._Seq-misc[2])
                  @ b_Seq._Seq-misc[2]
        WITH FRAME seq-detail.
    END.
    qbf_disp = RECID(b_Seq).

    /* Allow the user to select from the list of options (from qbf array) */
    ON CURSOR-LEFT BACK-TAB.
    ON CURSOR-RIGHT     TAB.

    _choose:
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF qbf# > {&EXIT} THEN qbf# = qbf# - {&EXIT}. 
      IF qbf# >= 1 AND qbf# <= {&EXIT} THEN
        NEXT-PROMPT qbf[qbf#] WITH FRAME qbf.
      CHOOSE FIELD qbf PAUSE (IF qbf_disp = RECID(b_Seq) THEN ? ELSE 0)
        NO-ERROR AUTO-RETURN
        GO-ON ("CURSOR-UP" "CURSOR-DOWN" "PAGE-DOWN" "PAGE-UP") 
        WITH FRAME qbf.
      qbf# = FRAME-INDEX.

      /* If key is an ascii character but does not match the first letter of
               any function, do nothing and retry.  If the user presses ".",
               FRAME-INDEX will be the current index value (so we will
               execute the highlit function).
      */
      IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY)  AND CHR(LASTKEY) <> ".":u 
        AND NOT qbf[qbf#] BEGINS CHR(LASTKEY) THEN UNDO,RETRY _choose.
   
    END.

    ON CURSOR-LEFT  CURSOR-LEFT.
    ON CURSOR-RIGHT CURSOR-RIGHT.

    /* Map function keys to sequence editor options. */
    i = LOOKUP(KEYFUNCTION(LASTKEY),
        "CURSOR-DOWN,CURSOR-UP,PAGE-DOWN,PAGE-UP,,,,,,,END-ERROR":u).
    IF i > 0 THEN DO:
      COLOR DISPLAY NORMAL qbf[qbf#] WITH FRAME qbf. 
      qbf# = i.
    END.
                  
    HIDE MESSAGE NO-PAUSE.
    /* message to let the user know that 64-bit sequences support is not on */
    IF c_not_largeseq NE "" THEN
       MESSAGE c_not_largeseq.

    /* Only add, undo and exit are appropriate when there are no sequences. */
    IF (NOT AVAILABLE b_Seq AND
        qbf# <> {&ADD} AND qbf# <> {&UNDO} AND qbf# <> {&EXIT}) THEN
    DO:
      MESSAGE new_lang[9]. /* inappropriate function */
      NEXT.
    END.

    IF ENTRY(qbf#,qbf#list) <> "0":u THEN DO:
      MESSAGE new_lang[INTEGER(ENTRY(qbf#,qbf#list))]. /* not allowed */

      NEXT.
    END.

    redraw = qbf# > 2.

    IF qbf# = {&NEXT} THEN DO: /*----------------------------- start of NEXT */
      FIND NEXT b_Seq where b_Seq._Db-recid = drec_db
                        AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      IF NOT AVAILABLE b_Seq THEN DO:
        FIND LAST b_Seq where b_Seq._Db-recid = drec_db 
                          AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
        MESSAGE new_lang[5].  /* last sequence */
      END.
      ELSE DO:
        IF FRAME-LINE = FRAME-DOWN THEN DO:
                /* subtract 1 since when we scroll up the selection indicator goes
                   with it. This will cause the highlight fixup code to be executed
                   to reset the highlight to the last line.
                */
          qbf_was = qbf_was - 1. 
          SCROLL UP.
              END.
        ELSE
          DOWN.
        DISPLAY b_Seq._Seq-Name WITH FRAME seq-browse.
      END.
    END. /*---------------------------------------------------- end of NEXT */
    ELSE
    IF qbf# = {&PREV} THEN DO: /*---------------------------- start of PREV */
      FIND PREV b_Seq where b_Seq._Db-recid = drec_db 
                        AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      IF NOT AVAILABLE b_Seq THEN DO:
        FIND FIRST b_Seq where b_Seq._Db-recid = drec_db 
                           AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
        MESSAGE new_lang[6].  /* first sequence */
      END.
      ELSE DO:
        IF FRAME-LINE = 1 THEN DO:
                /* add 1 since when we scroll down the selection indicator goes
                   with it. This will cause the highlight fixup code to be executed
                   to reset the highlight to the first line.
                */
                qbf_was = qbf_was + 1.
          SCROLL DOWN.
        END.
        ELSE
          UP.
        DISPLAY b_Seq._Seq-Name WITH FRAME seq-browse.
      END.
    END. /*---------------------------------------------------- end of PREV */
    ELSE
    IF qbf# = {&NEXTPG} THEN DO: /*---------------------- start of NEXTPAGE */
      DO i = 1 TO FRAME-DOWN WHILE AVAILABLE b_Seq:
        FIND NEXT b_Seq where b_Seq._Db-recid = drec_db 
                          AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      END.
      IF NOT AVAILABLE b_Seq THEN DO:
        DOWN FRAME-DOWN - FRAME-LINE.
        FIND LAST b_Seq where b_Seq._Db-recid = drec_db 
                          AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      END.
    END. /*------------------------------------------------ end of NEXTPAGE */
    ELSE
    IF qbf# = {&PREVPG} THEN DO: /*---------------------- start of PREVPAGE */
      DO i = 1 TO FRAME-DOWN WHILE AVAILABLE b_Seq:
        FIND PREV b_Seq where b_Seq._Db-recid = drec_db 
                          AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      END.
      IF NOT AVAILABLE b_Seq THEN DO:
        FIND FIRST b_Seq where b_Seq._Db-recid = drec_db
                           AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
        UP FRAME-LINE - 1.
      END.
    END. /*------------------------------------------------ end of PREVPAGE */
    ELSE
    IF qbf# = {&FIRST} THEN DO: /*-------------------------- start of FIRST */
      FIND FIRST b_Seq where b_Seq._Db-recid = drec_db 
                         AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      qbf_rec = RECID(b_Seq).
      UP FRAME-LINE - 1.
    END. /*--------------------------------------------------- end of FIRST */
    ELSE
    IF qbf# = {&LAST} THEN DO: /*---------------------------- start of LAST */
      FIND LAST b_Seq where b_Seq._Db-recid = drec_db 
                        AND NOT b_Seq._Seq-name BEGINS "$" NO-ERROR.
      qbf_rec = RECID(b_Seq).
      DOWN FRAME-DOWN - FRAME-LINE.
    END. /*--------------------------------------------------- end of LAST */
    ELSE
    IF qbf# = {&ADD} THEN DO: /*------------------------------ start of ADD */
      COLOR DISPLAY NORMAL b_Seq._Seq-Name.
      adding = TRUE.
      RUN ADD_MODIFY (OUTPUT answer).
      HIDE MESSAGE NO-PAUSE.
      /* message to let the user know that 64-bit sequences support is not on */
      IF c_not_largeseq NE "" THEN
         MESSAGE c_not_largeseq.

      IF answer THEN DO:
              DOWN FRAME-DOWN - FRAME-LINE.
              in_trans = TRUE.
      END.
    END. /*----------------------------------------------------- end of ADD */
    ELSE
    IF qbf# = {&MODIFY} THEN DO: /*------------------------ start of MODIFY */
      adding = false.
      RUN ADD_MODIFY (OUTPUT answer).
      HIDE MESSAGE NO-PAUSE.
      /* message to let the user know that 64-bit sequences support is not on */
      IF c_not_largeseq NE "" THEN
         MESSAGE c_not_largeseq.

      IF answer THEN DO:
               ASSIGN
            redraw   = b_Seq._Seq-Name ENTERED
            in_trans = TRUE.
      END.
    END. /*-------------------------------------------------- end of MODIFY */
    ELSE
    IF qbf# = {&DELETE} THEN DO ON ERROR UNDO,LEAVE: /*---- start of DELETE */
      answer = FALSE. /* are you sure... delete? */
      RUN "prodict/user/_usrdbox.p":u
        (INPUT-OUTPUT answer,?,?,
          new_lang[3] + b_Seq._Seq-Name + '"?').
      IF answer THEN DELETE b_Seq.
      in_trans = in_trans OR answer.
      dict_dirty = TRUE.
    END. /*-------------------------------------------------- end of DELETE */
    ELSE
    IF qbf# = {&UNDO} THEN DO: /*---------------------------- start of UNDO */
      IF in_trans THEN DO:
        answer = FALSE. /* undo session? */
        RUN "prodict/user/_usrdbox.p":u
          (INPUT-OUTPUT answer,?,?,new_lang[4]).
        in_trans = NOT answer.
        IF answer THEN UNDO qbf_block,RETRY qbf_block.
      END.
      ELSE
        MESSAGE new_lang[8].  /* No changes were made! */
    END. /*---------------------------------------------------- end of UNDO */
    ELSE
    IF qbf# = {&EXIT} THEN /*-------------------------------- start of EXIT */
      LEAVE qbf_inner.
    /*--------------------------------------------------------- end of EXIT */

  END. /* iterating block (qbf_inner) */

END. /* scoping block (qbf_block) */


HIDE FRAME qbf        NO-PAUSE.
HIDE FRAME seq-browse NO-PAUSE.
HIDE FRAME seq-detail NO-PAUSE.
RETURN.

&ENDIF

/*********************************************************************
* Copyright (C) 2005-2009 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*

File:   prodict/user/_usrload 

Describtion:
    user interface and defaults setup for loading

Input:
  user_env[1] = "ALL" or comma-separated list of files
                or it may be in user_longchar, if list was too big.
  user_env[4] = if user_env[9] = "h"
                    then "error", "error_objattrs" or ""  to signal the needed message
                    else insignificant
  user_env[9] = type of load (e.g. .df or .d)
                "d" = load file definitions
                "f" = load data file contents
                "h" = hide message, puts up completed message and returns
                "k" = load sequence values
                "u" = load user file contents
                "v" = load view file contents
                "4" = AS/400 definitions
                "4t" = AS/400 trigger definitions
                "s" = load sequence def's
                "t" = load audit policies as text
                "x" = load audit policies as xml
                "y" = load audit data
                "e" = load application audit events
                "z" = load security authentication records
                "m" = load security permissions
                "i" = load Database Identification Properties
                "o" = load Database Options
                
Output:
  user_env[1] = same as IN
  user_env[2] = physical file or directry name for some input
  user_env[4] = "y" or "n" - stop on first error (if class = "d","4" or "s")
              = error% (if class = "f")
  user_env[5] = comma separated list of table numbers for which triggers
                should be disabled when the load is done.
                (only used for load data file contents, "f").
  user_env[8] = dbname (if class = "d" or "4" or "s")
  user_env[10]= user specified code page
  user_env[15]= user wants to commit even if errors are found.

History:
    D. McMann   08/12/03 Add GET-DIR functionality
    D. McMann   02/04/03 Added support for LOB directories
    D. McMann   04/23/02 Added option for on-line schema changes
    D. McMann   01/03/13 Added option to commit even if error present.
    D. McMann   00/06/08 Added check for non table records on load of data
    D. McMann   00/04/12 Added support for long path names
    D. McMann   98/07/09 Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                         to _File FINDS
    D. McMann   98/06/25 Added check for trailer to begine either cpstream or codepage for
                         backwards compatibility with new .df trailer.
    laurief     98/06/09 Added code to utilize user_env[6] as a flag to turn
                         errors to screen on/off.
    tomn        96/04   Moved instances of okrun.i outside of DO blocks at
                        end of Main section (update statements); Undoing of
                        block would cause frame width to increase each time
                        
    tomn        96/04   Removed extraneous ENDKEY/END-ERROR traps (using
                        LAST-EVENT:FUNCTION statement) after UPDATE statements
                        at end of Main section (already handled by enclosing
                        DO block)

    hutegger    95/05   changed "h" behaviour to message "Load aborted"
                        in case an error occured
    kmcintos 04/04/05   Added frames and additional logic for auditing
                        support
    kmcintos 06/07/05   Added context sensitive help for auditing options
    kmcintos 08/18/05   Added user_commit toggle to audit policy load
                        dialog 20050629-018.
    kmcintos 08/31/05   Added special case for audit policies as text
                        20050629-018.
    kmcintos 01/04/06   Reset user_env[2] when read-only db or some other
                        fatal error having to do with permission checking
                        20051031-030.
    fernando 03/14/06   Handle case with too many tables selected - bug 20050930-006.
    fernando 06/20/07   Support for large files
    fernando 12/13/07   Handle long list of "some" selected tables    
    fernando 07/20/08   support for encryption
    rkamboj  08/16/11   Added new terminology for security items and windows. 
*/
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer        AS LOGICAL    NO-UNDO.
DEFINE VARIABLE canned        AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE base          AS CHARACTER  NO-UNDO.
DEFINE VARIABLE class         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE comma         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE err           AS CHARACTER  NO-UNDO.
DEFINE VARIABLE ivar          AS INT        NO-UNDO.
DEFINE VARIABLE err%          AS INT        NO-UNDO.
DEFINE VARIABLE io-file       AS LOGICAL    NO-UNDO.
DEFINE VARIABLE io-frame      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE io-title      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE is-all        AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-one        AS LOGICAL    NO-UNDO.
DEFINE VARIABLE is-some       AS LOGICAL    NO-UNDO.
DEFINE VARIABLE stop_flg      AS LOGICAL    NO-UNDO.
DEFINE VARIABLE commit_flg    AS LOGICAL    NO-UNDO.
DEFINE VARIABLE no-schema-lock AS LOGICAL   NO-UNDO.
DEFINE VARIABLE msg-num       AS INTEGER    NO-UNDO INITIAL 0.
DEFINE VARIABLE noload        AS CHARACTER  NO-UNDO.
DEFINE VARIABLE prefix        AS CHARACTER  NO-UNDO.
DEFINE VARIABLE trash         AS CHARACTER  NO-UNDO.
DEFINE VARIABLE dis_trig      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE codepage      AS CHARACTER  NO-UNDO FORMAT "X(20)".
DEFINE VARIABLE lvar          AS CHAR EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#         AS INT            NO-UNDO.  
DEFINE VARIABLE cr            AS CHARACTER  NO-UNDO.
DEFINE VARIABLE inclob        AS LOGICAL    NO-UNDO INITIAL TRUE.
DEFINE VARIABLE s_res         AS LOGICAL    NO-UNDO.
DEFINE VARIABLE do-screen     AS LOGICAL   NO-UNDO INIT FALSE.
DEFINE VARIABLE err-to-file   AS LOGICAL   NO-UNDO INIT FALSE.
DEFINE VARIABLE err-to-screen AS LOGICAL   NO-UNDO INIT TRUE.
DEFINE VARIABLE oldsession    AS CHARACTER NO-UNDO.

DEFINE VARIABLE base_lchar AS LONGCHAR NO-UNDO.
DEFINE VARIABLE numCount   AS INTEGER  NO-UNDO.
DEFINE VARIABLE cItem      AS CHARACTER  NO-UNDO.
DEFINE VARIABLE isCpUndefined AS LOGICAL NO-UNDO.
define variable isSuperTenant as logical no-undo.
define variable isAllMultiTenant as logical no-undo. 
define variable isAnyMultiTenant as logical no-undo.
define variable lLobsub as logical no-undo.
define variable gLobFolderName as character no-undo init "lobs".
define variable gFileName      as character no-undo.
define variable gUseDefaultOut   as character no-undo init "<default>".
define variable UseDefaultDirs as logical no-undo  
    label "Use default location" .
    
define variable RootDirectory as character no-undo.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  DEFINE VARIABLE warntxt  AS CHARACTER  NO-UNDO VIEW-AS EDITOR NO-BOX 
   INNER-CHARS 69 INNER-LINES 8.

/* To support fill-in label mnemonic (Nordhougen 07/26/95) */
  DEFINE VARIABLE idir_lbl AS CHARACTER  NO-UNDO FORMAT "X(55)"
    INIT "&Input Directory (blank = current directory):". 
  
  DEFINE VARIABLE tenant_lbl AS CHARACTER  NO-UNDO FORMAT "X(35)"
    INIT "&Effective Tenant:". 
  
  DEFINE VARIABLE idirmt_lbl AS CHARACTER  NO-UNDO FORMAT "X(65)"
    INIT "&Tenant Input Directory (blank = current directory):". 

  DEFINE VARIABLE ldir_lbl AS CHARACTER  NO-UNDO FORMAT "X(55)"
    INIT "Lob Directory (blank = current directory):". 
  
  DEFINE VARIABLE ldirmt_lbl AS CHARACTER  NO-UNDO FORMAT "X(65)"
    INIT "Te&nant Lob Directory (blank = current directory):". 

  DEFINE BUTTON btn_dir
    SIZE 11 by 1.

  DEFINE BUTTON btn_dir2
    SIZE 11 by 1 .

  DEFINE BUTTON btn_dirMT
    SIZE 11 by 1 .

  DEFINE BUTTON btn_dirMTLOB
    SIZE 11 by 1 .
  
  DEFINE BUTTON btn_dirroot
    SIZE 11 by 1 .
 
&ENDIF

DEFINE BUTTON btn_tenant
  SIZE 18 by 1 .
         
{prodict/misc/filesbtn.i}

/* standard form */
FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
              AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
              LABEL "&Input File"
  btn_File SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-input
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

/* standard form */
FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 
              VIEW-AS FILL-IN SIZE 40 BY 1
              LABEL "&Input Directory"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    btn_dir LABEL "Dir..." 
  &ENDIF
  "(If different from current directory)" VIEW-AS TEXT 
      AT &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 19 &ELSE 17 &ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME read-input-dir
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} 
              FORMAT "x({&PATH_WIDG})" AT 2
              VIEW-AS FILL-IN 
                      SIZE 40 BY 1
              LABEL "&Input Directory"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    btn_dir LABEL "Dir..."
  &ENDIF
  "(If different from current directory)" VIEW-AS TEXT
                                          AT 
                                           &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
                                             19 &ELSE 17 &ENDIF
  user_commit VIEW-AS TOGGLE-BOX
              LABEL "&Refresh DB Policy Cache" AT 2
              
  {prodict/user/userbtns.i}
  
  WITH FRAME read-dir-text
             SIDE-LABELS NO-ATTR-SPACE CENTERED
             DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
             VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

/* standard form */
FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 
              VIEW-AS FILL-IN SIZE 40 BY 1
              LABEL "&Input Directory"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    btn_dir LABEL "Dir..." 
  &ENDIF
  "(If different from current directory)" VIEW-AS TEXT 
     AT &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
          19 &ELSE 17 &ENDIF SKIP({&VM_WIDG})
  {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" LABEL "&Acceptable Error Percentage" AT 2                   
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL " Display Errors to &Screen"
  AT 2  SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-dir-nobl
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
  &GLOBAL-DEFINE LINEUP 12
  &GLOBAL-DEFINE FILLCH 67
&ELSEIF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN
  &GLOBAL-DEFINE LINEUP 12
  &GLOBAL-DEFINE FILLCH 69
&ELSE
  &GLOBAL-DEFINE LINEUP 15
&ENDIF

/* form for .df file input */
/* Note that spaces were added to some of the string literals so that
   the strings would not be cut off under Korean Windows 95 */
FORM SKIP({&TFM_WID})
  user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "&Input File" COLON {&LINEUP}
  btn_File  SKIP ({&VM_WIDG}) 
    stop_flg VIEW-AS TOGGLE-BOX LABEL "Stop If Errors Found"
     COLON 3
    commit_flg VIEW-AS TOGGLE-BOX LABEL "Commit Even with Errors" COLON 38
     SKIP({&VM_WID})
    err-to-file VIEW-AS TOGGLE-BOX LABEL "Output Errors to File"
   COLON 3  
    err-to-screen VIEW-AS TOGGLE-BOX LABEL "Output Errors to Screen"
       COLON 38  
  
    SKIP({&VM_WID}) 
    no-schema-lock VIEW-AS TOGGLE-BOX LABEL "Add new objects on-line"
        COLON 3 SKIP({&VM_WIDG})
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  warntxt AT 2 NO-LABEL SKIP ({&VM_WIDG})
  &ELSE
    "WARNING: " AT 2 VIEW-AS TEXT skip
    "  If .df file is an incremental .df it may contain DROP statements which" 
       AT 2 VIEW-AS TEXT SKIP
    "  will cause data to be deleted."  
       AT 2 VIEW-AS TEXT SKIP (1)    
    "  If you select that you are only adding new objects on-line and you try" 
       AT 2 VIEW-AS TEXT SKIP
    "  to modify existing objects all changes could be rolled back. "  
       AT 2 VIEW-AS TEXT SKIP (1)
    "  If you select to commit with errors, your database could be corrupted." 
       AT 2 VIEW-AS TEXT SKIP     
  &ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME read-df KEEP-TAB-ORDER
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

ASSIGN cr = CHR(10).

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ASSIGN warntxt:SCREEN-VALUE =
   "WARNING:" + cr + "  If the input file is an incremental .df it may contain DROP statements" 
   + cr + "  which will cause data to be deleted." + cr + cr +
   "  If you select to add new objects on-line and you try to modify existing" + cr +
   "  objects, all changes could be rolled back." + cr + cr +
   "  If you select to commit with errors, your database could be corrupted." .
 
  ASSIGN warntxt:READ-ONLY = yes.   
&ENDIF

/* form for .d file input */
&GLOBAL-DEFINE DFILE-SPEECH   "Specify an acceptable error percentage.  When this limit is reached,      " AT 2 VIEW-AS TEXT SKIP  "loading will stop.  Enter 0 if any error should stop the load; enter      " AT 2 VIEW-AS TEXT SKIP  "100 if the load should not stop for any error.          "                                       AT 2     VIEW-AS TEXT SKIP ({&VM_WIDG})

FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 3 VIEW-AS FILL-IN SIZE 45 BY 1
         LABEL " &Input File" btn_File  SKIP ({&VM_WIDG})
    "  Include LOB:" VIEW-AS TEXT  inclob LABEL "yes/no" view-as toggle-box SKIP ({&VM_WIDG})
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" LABEL "  LOB Directory"
    VIEW-AS FILL-IN SIZE 45 BY 1 SKIP ({&VM_WIDG})
  &ELSE 
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 6 VIEW-AS FILL-IN SIZE 45 BY 1
         LABEL "&Input File" btn_File  SKIP ({&VM_WIDG})
    "  Include LOB:" VIEW-AS TEXT  inclob LABEL "yes/no" view-as toggle-box SKIP ({&VM_WID})
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE 45 BY 1
         LABEL " &LOB Directory" btn_dir LABEL "Dir..." SKIP ({&VM_WIDG})
   &ENDIF
  {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" LABEL "&Acceptable Error Percentage" AT 2                   
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL " Display Errors to &Screen"
  AT 2  SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-d-file
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    user_env[32]   {&STDPH_FILL} FORMAT "x(32)"     
                   colon 22 VIEW-AS FILL-IN size 33 by 1 /* size to align button..*/        
                   LABEL "Effective Tenant"  
    btn_Tenant     LABEL "Select Tenant..." SKIP ({&VM_WID})
    "Use Default Location:" VIEW-AS TEXT AT 2 
    UseDefaultDirs view-as toggle-box label " (Tenant data in subdirectory named after tenant)"
    RootDirectory {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"
                    colon 22 label "Root Directory"     
                    VIEW-AS FILL-IN SIZE 41 BY 1 
    user_env[2]    {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22 
                    VIEW-AS FILL-IN SIZE 41 BY 1
         LABEL "&Input File" btn_File  SKIP ({&VM_WIDG})
    "Include LOB:" VIEW-AS TEXT AT 11 
    inclob LABEL  ""  colon 22    view-as toggle-box SKIP  
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22 LABEL "LOB Directory"
    VIEW-AS FILL-IN SIZE 41 BY 1 SKIP ({&VM_WIDG})
  &ELSE 
    user_env[32]    {&STDPH_FILL} FORMAT "x(32)" colon 17 VIEW-AS FILL-IN SIZE 39 BY 1
                    LABEL "&Effective Tenant" 
    btn_Tenant      LABEL "Select Tenant..." SKIP ({&VM_WIDG})
    UseDefaultDirs  view-as toggle-box colon 17 label "Use Default Location (Tenant data in subdirectory)"
   
    RootDirectory   {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"
                    colon 17 label "Root Directory"     
                    VIEW-AS FILL-IN SIZE 45 BY 1 
    btn_DirRoot     LABEL "Dir..." SKIP ({&VM_WID})
    
    user_env[2]     {&STDPH_FILL} 
                    FORMAT "x({&PATH_WIDG})" colon 17 VIEW-AS FILL-IN SIZE 45 BY 1
                    LABEL "&Input File" 
    btn_File        SKIP ({&VM_WIDG})
    inclob          colon 17 LABEL "Include LOB" view-as toggle-box SKIP ({&VM_WID})
    user_env[30]    {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 17 VIEW-AS FILL-IN SIZE 45 BY 1
                    LABEL " &LOB Directory" 
    btn_dir         LABEL "Dir..." SKIP ({&VM_WIDG})
   
   &ENDIF
  {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" LABEL "&Acceptable Error Percentage" AT 2                   
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL " Display Errors to &Screen"
  AT 2  SKIP({&VM_WID})
  {prodict/user/userbtns.i}
  WITH FRAME read-d-file-mt
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    user_env[32]   {&STDPH_FILL} FORMAT "x(32)"     
                   colon 22 VIEW-AS FILL-IN size 33 by 1 /* size to align button..*/        
                   LABEL "Effective Tenant"  
    btn_Tenant     LABEL "Select Tenant..." SKIP ({&VM_WIDG})
    "Use Default Location:" VIEW-AS TEXT AT 2 
    UseDefaultDirs view-as toggle-box label " (Tenant data in subdirectory named after tenant)"
    RootDirectory {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"
                    colon 22 label "Root Directory"     
                    VIEW-AS FILL-IN SIZE 41 BY 1 
    user_env[2]    {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22 
                    VIEW-AS FILL-IN SIZE 41 BY 1
                   LABEL "&Input File" btn_File  SKIP ({&VM_WIDG})
   &ELSE 
    user_env[32]    {&STDPH_FILL} FORMAT "x(32)" colon 17 VIEW-AS FILL-IN SIZE 39 BY 1
                    LABEL "&Effective Tenant" 
    btn_Tenant      LABEL "Select Tenant..." SKIP ({&VM_WIDG})
    UseDefaultDirs  view-as toggle-box colon 17 label "Use Default Location (Tenant data in subdirectory)"
   
    RootDirectory   {&STDPH_FILL} FORMAT "x({&PATH_WIDG})"
                    colon 17 label "Root Directory"     
                    VIEW-AS FILL-IN SIZE 45 BY 1 
    btn_DirRoot     LABEL "Dir..." SKIP ({&VM_WID})
    
    user_env[2]     {&STDPH_FILL} 
                    FORMAT "x({&PATH_WIDG})" colon 17 VIEW-AS FILL-IN SIZE 45 BY 1
                    LABEL "&Input File" 
    btn_File        SKIP ({&VM_WIDG})
  
  &ENDIF
  
  {prodict/user/userbtns.i}
  WITH FRAME read-d-seq-mt
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 3 VIEW-AS FILL-IN SIZE 45 BY 1
         LABEL " &Input File" btn_File  SKIP ({&VM_WIDG})
  &ELSE 
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 6 VIEW-AS FILL-IN SIZE 45 BY 1
         LABEL "&Input File" btn_File  SKIP ({&VM_WIDG})
   &ENDIF
  {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" LABEL "&Acceptable Error Percentage" AT 2                   
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL " Display Errors to &Screen"
  AT 2  SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-d-file-nobl
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
    user_env[2] {&STDPH_FILL} 
                FORMAT "x({&PATH_WIDG})" AT 3
                VIEW-AS FILL-IN SIZE 45 BY 1
                LABEL " &Input File" 
    btn_File                                                  SKIP({&VM_WIDG})
    user_overwrite VIEW-AS TOGGLE-BOX 
                   LABEL "&Overwrite Duplicate Policies" AT 6 SKIP({&VM_WIDG})
    user_commit    VIEW-AS TOGGLE-BOX
                   LABEL "&Refresh DB Policy Cache"      AT 6
  &ELSE 
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
                AT 4 VIEW-AS FILL-IN SIZE 45 BY 1
                LABEL "&Input File" 
    btn_File                                                  SKIP({&VM_WIDG})
    user_overwrite VIEW-AS TOGGLE-BOX 
                   LABEL "&Overwrite Duplicate Policies" AT 4
    user_commit    VIEW-AS TOGGLE-BOX
                   LABEL "&Refresh DB Policy Cache"      
  &ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME read-xml-file
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".

FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    idir_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
          SIZE 45 BY 1 NO-LABEL  btn_dir LABEL "Data Dir.." SKIP ({&VM_WIDG})
     "Include LOB" VIEW-AS TEXT AT 2 inclob LABEL "yes/no" view-as toggle-box SKIP ({&VM_WID})
    ldir_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
      SIZE 45 BY 1 NO-LABEL btn_dir2 LABEL "Lob Dir..." SKIP ({&VM_WIDG})
    btn_dir2 LABEL "Lob Dir..." SKIP ({&VM_WIDG})
  &ELSE
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 45 BY 1
                LABEL "Input Directory"  SKIP 
    "(Leave blank for current directory)" VIEW-AS TEXT AT 19  SKIP({&VM_WIDG})   
    "    Include LOB:" VIEW-AS TEXT AT 2 inclob LABEL "yes/no" view-as toggle-box SKIP ({&VM_WID})
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
      SIZE 45 BY 1 LABEL "  LOB Directory"  SKIP 
     "(Leave blank for current directory)" VIEW-AS TEXT AT 19 SKIP({&VM_WIDG})
  &ENDIF  
  {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" AT 2 LABEL "&Acceptable Error Percentage"                     
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL "Output Errors to &Screen"
      AT 2 SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-d-dir
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".  

FORM 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    SKIP({&TFM_WID})
    tenant_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[32] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" at 2 
                    VIEW-AS FILL-IN SIZE 48 BY 1 NO-LABEL
    btn_Tenant LABEL "Select Tenant..." SKIP ({&VM_WIDG})
    UseDefaultDirs  view-as toggle-box  at 2 label "Use Default Location (Tenant and LOB data in subdirectory)"
      
    idir_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
                              SIZE 55 BY 1 NO-LABEL  
    btn_dir LABEL "Data Dir.." SKIP ({&VM_WIDG})
    
    idirmt_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[33] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
                               SIZE 55 BY 1 NO-LABEL 
    btn_dirmt LABEL "Data Dir..." SKIP ({&VM_WIDG})
 
    inclob LABEL "Include LOB" at 2 view-as toggle-box SKIP ({&VM_WID})
    
    ldir_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
                               SIZE 55 BY 1 NO-LABEL 
    
    btn_dir2 LABEL "Lob Dir..." SKIP ({&VM_WIDG})
    ldirmt_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[34] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
                               SIZE 55 BY 1 NO-LABEL 
    btn_dirmtlob LABEL "Lob Dir..." SKIP ({&VM_WIDG})
 
 
  &ELSE
    SKIP({&VM_WIDG})   
    user_env[32] {&STDPH_FILL} FORMAT "x(32)" colon 22 
                 VIEW-AS FILL-IN SIZE 32 BY 1 LABEL "Effective Tenant"
    btn_Tenant LABEL "Select Tenant..." skip({&VM_WID})
    "Use Default Location:"           VIEW-AS TEXT AT 2
    UseDefaultDirs        colon 22 
                          view-as toggle-box label " (Tenant data and lobs in subdirectories)"
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22
                help "Leave blank for current directory"
                VIEW-AS FILL-IN SIZE 51 BY 1 LABEL "Shared Directory"  SKIP 
    user_env[33] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22
                help "Leave blank for current directory"
                VIEW-AS FILL-IN SIZE 51 BY 1 LABEL "Tenant Directory" SKIP ({&VM_WID})
    
    "Include LOB:" VIEW-AS TEXT AT 11 inclob LABEL "" view-as toggle-box SKIP ({&VM_WID})
    
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22 
                 VIEW-AS FILL-IN SIZE 51 BY 1 LABEL "LOB Directory"  skip({&VM_WID})
    user_env[34] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" colon 22 
                 VIEW-AS FILL-IN SIZE 51 BY 1  LABEL "Tenant LOB Directory" SKIP ({&VM_WIDG})
    
  &ENDIF  
   {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" AT 2 LABEL "&Acceptable Error Percentage"
     help "0 = Any error stops the load, 100 = Do not stop for any error."                     
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL "Output Errors to &Screen"
      AT 2 
  
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      SKIP({&VM_WIDG})
  &ENDIF
  
  {prodict/user/userbtns.i}
  WITH FRAME read-d-dir-mt
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".  


FORM SKIP({&TFM_WID})
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    idir_lbl NO-LABEL VIEW-AS TEXT AT 2
    user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
          SIZE 45 BY 1 NO-LABEL  btn_dir LABEL "Dir.." SKIP ({&VM_WIDG})
  &ELSE
     user_env[2] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 45 BY 1
                LABEL "Input Directory"  SKIP 
    "(Leave blank for current directory)" VIEW-AS TEXT AT 19  SKIP({&VM_WIDG})   
    "    Include LOB:" VIEW-AS TEXT AT 2 inclob LABEL "yes/no" view-as toggle-box SKIP ({&VM_WID})
    user_env[30] {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN 
      SIZE 45 BY 1 LABEL "  LOB Directory"  SKIP 
     "(Leave blank for current directory)" VIEW-AS TEXT AT 19 SKIP({&VM_WIDG})
  &ENDIF  
  {&DFILE-SPEECH}
  err% {&STDPH_FILL} FORMAT ">>9" AT 2 LABEL "&Acceptable Error Percentage"                     
     VALIDATE(err% >= 0 AND err% <= 100,
     "Percentage must be between 0 and 100 inclusive.") SKIP({&VM_WIDG})
  do-screen VIEW-AS TOGGLE-BOX LABEL "Output Errors to &Screen"
      AT 2 SKIP({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME read-dir
  SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " " + io-title + " ".  

/* For MSW, associate text widget with fill-in to enable mnemonic (Nordhougen 07/26/95) */
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  /* fixed to use right frame and labels shows &
  ASSIGN user_env[2]:SIDE-LABEL-HANDLE IN FRAME read-d-dir = idir_lbl:HANDLE IN FRAME read-d-dir
         user_env[2]:LABEL IN FRAME read-d-dir = idir_lbl
         user_env[30]:SIDE-LABEL-HANDLE IN FRAME read-d-dir = ldir_lbl:HANDLE IN FRAME read-d-dir
         user_env[30]:LABEL IN FRAME read-d-dir = ldir_lbl.

  ASSIGN user_env[2]:SIDE-LABEL-HANDLE IN FRAME read-d-dir-mt = idir_lbl:HANDLE IN FRAME read-d-dir-mt 
         user_env[2]:LABEL IN FRAME read-d-dir-mt = idir_lbl
         user_env[30]:SIDE-LABEL-HANDLE IN FRAME read-d-dir-mt  = ldir_lbl:HANDLE IN FRAME read-d-dir-mt  
         user_env[30]:LABEL IN FRAME read-d-dir-mt = ldir_lbl 
         user_env[32]:SIDE-LABEL-HANDLE IN FRAME read-d-dir-mt  = tenant_lbl:HANDLE IN FRAME read-d-dir-mt  
         user_env[32]:LABEL IN FRAME read-d-dir-mt = tenant_lbl 
         user_env[33]:SIDE-LABEL-HANDLE IN FRAME read-d-dir-mt  = idirmt_lbl:HANDLE IN FRAME read-d-dir-mt  
         user_env[33]:LABEL IN FRAME read-d-dir-mt = idirmt_lbl 
         user_env[34]:SIDE-LABEL-HANDLE IN FRAME read-d-dir-mt  = ldirmt_lbl:HANDLE IN FRAME read-d-dir-mt  
         user_env[34]:LABEL IN FRAME read-d-dir-mt = ldirmt_lbl.
   */

&ENDIF

FORM
  "Please enter a Code Page to use for this load." AT 2 SKIP
  codepage {&STDPH_FILL} LABEL "&Code Page" AT 2
  {prodict/user/userbtns.i}
  WITH FRAME get-cp SIDE-LABELS NO-ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Code Page ".

/*=============================== Functions =================================*/ 
function getTenantName returns char(pctenant as char):
    define variable lok     as logical no-undo.
    define variable hbuffer as handle no-undo. 
    define variable cValue   as character no-undo.
    
    CREATE BUFFER hbuffer FOR TABLE "DICTDB._tenant".
    lok = hbuffer:find-unique ("where _tenant._Tenant-name = " + quoter(pcTenant)) no-error.
    if lok then 
        cValue = hBuffer::_tenant-name.
    
    delete object hbuffer.    
    return cValue.
end function. 

function setEffectiveTenant returns logical(pctenant as char):
    set-effective-tenant(pcTenant,"DICTDB").
    return true.
    catch e as Progress.Lang.Error :
        message e:GetMessage(1)
        view-as alert-box error.    
        return false.
    end catch.
end function. 

/*
function appendFolderName returns char (ppath as char, pfolder as char):
    define variable iback    as integer no-undo.
    define variable iforward as integer no-undo.
    define variable ilength  as integer no-undo.
    define variable cSlash   as character no-undo init "/".
    define variable cBackSlash   as character no-undo init "~\".
    if pPath = "" then 
        return pfolder.
    iback = r-index(pPath,cBackSlash).
    iforward = r-index(pPath,cSlash).
    if iback = 0 and iforward = 0 then
        return pPath + cSlash + pfolder. 
    ilength = length(pPath).
    if iback = ilength or iforward = ilength then 
        return pPath + pfolder.
    if iForward > 0 then  
        return pPath + cSlash + pfolder.
    if iBack > 0 then    
        return pPath + cBackSlash + pfolder.
    
end.
*/

function addPath return character
                   (pFullPath as char,
                    oldPath as char,
                    newPath as char):
    
    define variable iback        as integer no-undo.
    define variable iforward     as integer no-undo.
    define variable inewback     as integer no-undo.
    define variable inewforward  as integer no-undo.
    define variable iloop        as integer no-undo.
    define variable cSlash       as character no-undo init "/".
    define variable cBackSlash   as character no-undo init "~\".
    define variable cUseSlash    as character no-undo.
    define variable cEntry       as character no-undo.
    define variable cFullPath     as character no-undo. 
    
    
    if length(pfullpath) > 3 and (oldPath = "" or newpath = "") then
    do:
       if substr(pFullPath,1,3) matches ".:" + cSlash + "*" then
           return pFullPath. 
       if substr(pFullPath,1,3) matches ".:" + cBackSlash + "*" then
           return pFullPath. 
    end.
       
    
    cFullPath = pFullPath.   
    /* new slash supersedes old */
    iNewBack = r-index(newPath,cBackSlash).
    iNewForward = r-index(newPath,cSlash).
    iback = r-index(cFullPath,cBackSlash).
    iforward = r-index(cFullPath,cSlash).
    if iNewForward > 0 and iNewForward > iNewBack then
    do:
        if iback > 0 then
            assign
                oldPath = replace(oldPath,cBackSlash,cSlash)
                cFullPath = replace(cFullPath,cBackSlash,cSlash).
        if iNewBack > 0 then
            newPath = replace(newPath,cBackSlash,cSlash).
        cUseSlash = cSlash.
    end.    
    else if iNewBack > 0 then
    do:
        if iForward > 0 then
            assign
                oldPath = replace(oldPath,cSlash,cBackSlash)
                cFullPath = replace(cFullPath,cSlash,cBackSlash).
        if iNewForward > 0 then
            newPath = replace(newPath,cSlash,cBackSlash).
        
        cUseSlash = cBackSlash.
    end.    
    else if iBack > iforward then
    do:
        cUseSlash = cBackSlash.
        if iForward > 0 then 
            assign
                oldPath = replace(oldPath,cSlash,cBackSlash)
                cFullPath = replace(cFullPath,cSlash,cBackSlash).
    end.
    else do:   
        cUseSlash = cSlash.   
        if iback > 0 then
            assign
                oldPath = replace(oldPath,cBackSlash,cSlash)
                cFullPath = replace(cFullPath,cBackSlash,cSlash).
    end.
    
    /* return cfullpath only if replace is done */  
    if oldPath = "" then
    do:
       if newPath = "" then 
           return pFullPath.   
       cFullPath = right-trim(newPath,cUseSlash) 
             + (if cFullPath begins cUseSlash then "" else cUseSlash) 
             + cFullPath.
       return cfullPath.
/*       return left-trim(cFullPath,cUseSlash).*/
    end.
    else if newPath = "" then
    do:
       if cFullPath <> oldpath then
           cFullPath = substr(cFullPath,length(oldpath) + 1).
       else
           cFullPath = "".
       return left-trim(cFullPath,cUseSlash).
    end.
    else do:
       /*** keep max 1 slash  in the returned fullpath */    
       /* trim just in case of many slashes at end of old since 
          they will not have been added */   
       oldPath =  right-trim(oldPath,cUseSlash) + cUseSlash.
       if cFullPath begins oldPath then
       do:
           cFullPath = substr(cFullPath,length(oldpath)).
           if not cFullPath begins cUseSlash then
              cFullPath = cUseSlash + cFullPath.
           newPath = right-trim(newpath,cUseSlash).
           cFullPath = newpath + cFullPath.
           return cfullPath.
 
       end.
    end.    
    
    /* return input if nothing returned above */ 
    return pFullPath.
        
end function. 


function validDirectory returns logical ( cValue as char):
  
    IF cValue <> "" THEN 
    DO:
        if not (cValue begins "/" or cvalue begins "~\" or index(cValue,":") <> 0) then
            cValue = "./" + cValue.  
        
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        return SUBSTRING(FILE-INFO:FILE-TYPE,1,1) = "D".
    END.
        
    return true.
 
end function. /* validateDirectory */


function validateDirectory returns logical ( cValue as char):
   
    IF cValue <> "" THEN 
    DO:
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        IF SUBSTRING(FILE-INFO:FILE-TYPE,1,1) <> "D" THEN DO:
            MESSAGE "Directory " + cValue + " does not exist" SKIP(1)
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    /*
            MESSAGE FILE-INFO:FILE-NAME "is not a directory or can not be found" 
            VIEW-AS ALERT-BOX ERROR.
      */
        return false.
    END.
    return true.
  END.
end function. /* validateDirectory */

/* refresh variables depending in tenant (use_env[32]) and Rootdirectory
   Call whenever one of them has changed  (used by write-dump-dir-file) 
   (Could also be used to refresh if gFileName and gLobFolderName changes)
   */
function refreshDirDefaults return logical():
     define variable cSlash     as character no-undo init "/".     
     define variable cBackSlash as character no-undo init "~\".     
     define variable iBack      as integer no-undo.
     define variable iForward   as integer no-undo.
     define variable cUseSlash  as character no-undo.     
     define variable cDir       as character no-undo.
     if UseDefaultDirs then
     do:
         iback = r-index(user_env[2],cBackSlash).
         iforward = r-index(user_env[2],cSlash).
         if iback > iforward then 
             cUseSlash = cBackSlash.
         else
             cUseSlash  = cSlash.
             
         if user_env[2] <> "" then
         do:
             cdir = user_env[2] + cUseSlash. 
         end.
         assign   
             user_env[33] = cdir + user_env[32]  
             user_env[30] = cdir + gLobFolderName
             user_env[34] = cdir + user_env[32]  + cUseSlash + gLobFolderName.
         return true. 
     end. 
     return false.    
end function.  


/* refresh variables depending in tenant (use_env[32]) and Rootdirectory
   Call whenever one of them has changed  (used by write-dump-dir-file) 
   (Could also be used to refresh if gFileName and gLobFolderName changes)
   */
function refreshFileDefaults return logical():
     define variable cSlash     as character no-undo init "/".     
     define variable cBackSlash as character no-undo init "~\".     
     define variable iBack      as integer no-undo.
     define variable iForward   as integer no-undo.
     define variable cUseSlash  as character no-undo.     
     define variable cDir       as character no-undo.
     if UseDefaultDirs then
     do:
         iback = r-index(RootDirectory,cBackSlash).
         iforward = r-index(RootDirectory,cSlash).
         if iback > iforward then 
             cUseSlash = cBackSlash.
         else
             cUseSlash  = cSlash.
             
         if RootDirectory <> "" then
         do:
             cdir = RootDirectory + cUseSlash. 
         end.
         assign   
             user_env[2] =  cdir + user_env[32] + cUseSlash + gFileName
             user_env[30] = cdir + user_env[32] + cUseSlash + gLobFolderName.
         return true. 
     end. 
     return false.    
end function.  

/* refresh variables depending in tenant (use_env[32]) and Rootdirectory
   Call whenever one of them has changed  (used by read-d-seq-mt) 
   (Could also be used to refresh if gFileName and gLobFolderName changes)
   */
function refreshSeqDefaults return logical():
     define variable cSlash     as character no-undo init "/".     
     define variable cBackSlash as character no-undo init "~\".     
     define variable iBack      as integer no-undo.
     define variable iForward   as integer no-undo.
     define variable cUseSlash  as character no-undo.     
     define variable cDir       as character no-undo.
     if UseDefaultDirs then
     do:
         iback = r-index(RootDirectory,cBackSlash).
         iforward = r-index(RootDirectory,cSlash).
         if iback > iforward then 
             cUseSlash = cBackSlash.
         else
             cUseSlash  = cSlash.
             
         if RootDirectory <> "" then
         do:
             cdir = RootDirectory + cUseSlash. 
         end.
         assign   
             user_env[2] =  cdir + user_env[32] + cUseSlash + gFileName.
         return true. 
     end. 
     return false.    
end function.



function refreshDirMT returns logical ():  
     if refreshDirDefaults() then 
     do: 
         user_env[33]:screen-value in frame read-d-dir-mt = user_env[33].
         if inclob:checked in frame read-d-dir-mt then
            assign
                user_env[30]:screen-value in frame read-d-dir-mt = user_env[30]
                user_env[34]:screen-value in frame read-d-dir-mt = user_env[34].
     
     end.           
end.      

function refreshSeqMT returns logical ():  
     if refreshSeqDefaults() then 
     do: 
         user_env[2]:screen-value in frame read-d-seq-mt = user_env[2].
     end.           
end.   
 
function refreshFileMT returns logical ():  
     if refreshFileDefaults() then 
     do: 
         user_env[2]:screen-value in frame read-d-file-mt = user_env[2].
         if inclob:checked   in frame read-d-file-mt then
             user_env[30]:screen-value in frame read-d-file-mt = user_env[30].
     end.           
end.      


function refreshDirInDirUI returns logical ():      
     if validDirectory(user_env[2]:screen-value in frame read-d-dir-mt) then
     do: 
         user_env[2] = right-trim(user_env[2]:screen-value in frame read-d-dir-mt,"/~\.").        
         refreshDirMT().  
         return true.
     end.
     return false.    
end function.  

function refreshDirInFileUI returns logical ():    
      
     if validDirectory(RootDirectory:screen-value in frame read-d-file-mt) then
     do: 
         RootDirectory = right-trim(RootDirectory:screen-value in frame read-d-file-mt,"/~\.").        
         refreshFileMT().  
         return true.
     end.
     return false.    
end function.  

/* 
function replaceFolderName returns char (ppath as char, pfolder as char,pnewFolder as char):
    define variable iback        as integer no-undo.
    define variable iforward     as integer no-undo.
    define variable iloop        as integer no-undo.
    define variable cSlash       as character no-undo init "/".
    define variable cBackSlash   as character no-undo init "~\".
    define variable cEntry       as character no-undo.
    
    if pPath = "" then 
        return pnewfolder.
    iback = r-index(pPath,cBackSlash).
    iforward = r-index(pPath,cSlash).
    if iBack > iforward then
       cSlash = cBackSlash.
       
    iloop = max(iback,iforward).
    do iloop = num-entries(ppath,cslash) to 1 by -1:
        cEntry = entry(iLoop,ppath,cslash).
        if centry = pfolder then
        do:
           entry(iLoop,ppath,cslash) = pnewfolder.   
           leave. /* only replace one*/
        end.
    end.    
    return ppath. 
end.
*/


function refreshDirMTState returns logical ():    
   
    assign 
        UseDefaultDirs =  UseDefaultDirs:checked in frame read-d-dir-mt
        inclob            =  inclob:checked in frame read-d-dir-mt
        user_env[2]:sensitive in frame read-d-dir-mt = UseDefaultDirs or (isAllMultitenant = false)
  
        user_env[2]:screen-value in frame read-d-dir-mt = if user_env[2]:sensitive in frame read-d-dir-mt
                                                          then user_env[2]
                                                          else ""
        user_env[33]:sensitive  in frame read-d-dir-mt = not UseDefaultDirs
        
        user_env[30]:screen-value in frame read-d-dir-mt = if inclob then user_env[30] else ""
        user_env[30]:sensitive in frame read-d-dir-mt = UseDefaultDirs = false and inclob
        user_env[34]:screen-value in frame read-d-dir-mt = if inclob then user_env[34] else ""
        user_env[34]:sensitive in frame read-d-dir-mt = UseDefaultDirs = false and inclob
       
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
         btn_dir:sensitive  in frame read-d-dir-mt = 
                    user_env[2]:sensitive  in frame read-d-dir-mt
         btn_dirMt:sensitive  in frame read-d-dir-mt = 
                    user_env[33]:sensitive  in frame read-d-dir-mt
         btn_dir2:sensitive  in frame read-d-dir-mt = 
                    user_env[30]:sensitive  in frame read-d-dir-mt
         btn_dirmtLob:sensitive  in frame read-d-dir-mt = 
                    user_env[34]:sensitive  in frame read-d-dir-mt
   
     &ENDIF 
     
       .
end.   

function refreshFileMTState returns logical ():    
     
    assign 
        UseDefaultDirs =  UseDefaultDirs:checked in frame read-d-file-mt
        inclob            =  inclob:checked in frame read-d-file-mt
        RootDirectory:sensitive in frame read-d-file-mt = UseDefaultDirs
        RootDirectory:screen-value in frame read-d-file-mt = if UseDefaultDirs then RootDirectory
                                                                 else ""
        user_env[2]:sensitive  in frame read-d-file-mt = not UseDefaultDirs
        user_env[30]:screen-value in frame read-d-file-mt = if inclob then user_env[30] else ""
        user_env[30]:sensitive in frame read-d-file-mt = UseDefaultDirs = false and inclob
        btn_file:sensitive  in frame read-d-file-mt = 
                    user_env[2]:sensitive  in frame read-d-file-mt
         
       
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
         btn_dirRoot:sensitive  in frame read-d-file-mt = 
                    RootDirectory:sensitive  in frame read-d-file-mt
         btn_dir:sensitive  in frame read-d-file-mt = 
                    user_env[30]:sensitive  in frame read-d-file-mt
   
     &ENDIF      
       .
end.     


function refreshSeqMTState returns logical ():    
    assign 
        UseDefaultDirs =  UseDefaultDirs:checked in frame read-d-seq-mt
        RootDirectory:sensitive in frame read-d-seq-mt = UseDefaultDirs
        RootDirectory:screen-value in frame read-d-seq-mt = if UseDefaultDirs then RootDirectory
                                                            else ""
        user_env[2]:sensitive  in frame read-d-seq-mt = not UseDefaultDirs
        btn_file:sensitive  in frame read-d-seq-mt = 
                    user_env[2]:sensitive  in frame read-d-seq-mt
       
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
         btn_dirRoot:sensitive  in frame read-d-seq-mt = 
                    RootDirectory:sensitive  in frame read-d-seq-mt
     &ENDIF 
       .
end.     

    
function refreshTenantInDirUI returns logical ():    
     define variable newTenantName as character no-undo.
     newTenantName = getTenantName(user_env[32]:screen-value in frame read-d-dir-mt). 
     if newTenantName > "" then
     do: 
         user_env[32] = newTenantName.
         refreshDirMT().  
         return true.
     end.
     return false.    
end function. 

function refreshTenantInFileUI returns logical ():    
     define variable newTenantName as character no-undo.
     newTenantName = getTenantName(user_env[32]:screen-value in frame read-d-file-mt). 
     if newTenantName > "" then
     do: 
         user_env[32] = newTenantName.
         refreshFileMT().  
         return true.
     end.
     return false.    
end function.     

function refreshTenantInSeqUI returns logical ():    
     define variable newTenantName as character no-undo.
     newTenantName = getTenantName(user_env[32]:screen-value in frame read-d-seq-mt). 
     if newTenantName > "" then
     do: 
         user_env[32] = newTenantName.
         refreshSeqMT().  
         return true.
     end.
     return false.    
end function.   

function selectTenant return logical (hTenant as handle):
    define variable tenantdlg as prodict.pro._tenant-sel-presenter no-undo.
    
    tenantdlg = new prodict.pro._tenant-sel-presenter ().
    
    do:
           &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        if  hTenant:frame:row < 0 then  /* this does not really work with large negative */                  
           tenantdlg:Row = (hTenant:row + hTenant:height) + 0.5.
        else 
           tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row + 0.5.
        tenantdlg:Col = hTenant:col + hTenant:frame:col .
  
           &ELSE
        tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row.
      
           &ENDIF
    end.
    tenantdlg:Title = "Select Tenant".
    tenantdlg:QueryString = "for each ttTenant where ttTenant.type <> 'super'".
/*    glInSelect = true. /* stop end-error anywhere trigger */*/
  
   
    if tenantdlg:Wait() then do   :
                 
        hTenant:screen-value = tenantdlg:ColumnValue("ttTenant.name").
        apply "value-changed" TO hTenant.
    end. 
   
/*    glInSelect = false.*/
end.  

function trimScreenValue returns logical (h as handle):
     h:SCREEN-VALUE = TRIM(h:SCREEN-VALUE).
end function.

function validateTenantName returns logical(ctenant as char):
    define variable lok as logical no-undo.
    if cTenant = "" then
    do:
        MESSAGE "Please specify which Tenant to dump data for."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false. 
    end.
    if getTenantName(cTenant) = "" then 
    do:
        MESSAGE "There is no Tenant with name " +  ctenant + " in the database."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false.
    end.
    return true.
end function. 

function refreshLobField returns logical (lEnabled as log,hfield as handle):
    assign 
       hField:sensitive = lEnabled.
       
    if not lEnabled then
       assign
           user_env[30] = hField:screen-value
           hField:screen-value = "". 
    else 
        hField:screen-value = user_env[30].

end.

function refreshTenantLobField returns logical (lEnabled as log,hfield as handle):
    assign 
       hField:sensitive = lEnabled.
    if not lEnabled then
       assign
           user_env[34] = hField:screen-value
           hField:screen-value = "". 
    else 
        hField:screen-value = user_env[34].
end.


/*=============================Triggers===============================*/

DEFINE VAR msg AS CHAR NO-UNDO INITIAL
   "Can not find a file of this name.  Try again.".

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame read-input or CHOOSE of btn_Help in frame read-input
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Load_Stuff_Dlg_Box},
                             INPUT ?).

on HELP of frame read-df or CHOOSE of btn_Help in frame read-df
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Load_Data_Definitions_Dlg_Box},
                             INPUT ?).

ON HELP OF FRAME read-d-file OR 
   CHOOSE OF btn_Help IN FRAME read-d-file
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Load_Data_Contents_Dlg_Box},
                             INPUT ? ).

ON HELP   OF FRAME read-d-file-nobl OR 
   CHOOSE OF btn_Help IN FRAME read-d-file-nobl DO:
  DEFINE VARIABLE iContextId AS INTEGER     NO-UNDO.

  CASE user_env[9]:
    WHEN "o" THEN
      iContextId = {&Load_Database_Options_Dialog_Box}.
    WHEN "i" THEN
      iContextId = {&Load_Database_Identification_Properties_Dialog_Box}.
    WHEN "e" THEN
      iContextId = {&Load_Application_Audit_Events_Dialog_Box}.
  END CASE.
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT iContextId,
                             INPUT ? ).
END.

ON HELP OF FRAME read-xml-file OR 
   CHOOSE OF btn_Help IN FRAME read-xml-file
  RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                             INPUT "CONTEXT",
                             /* Temporary until context help is developed */
                             INPUT {&Load_Data_Contents_Dlg_Box},
                             INPUT ? ).

ON HELP OF FRAME read-input-dir OR 
   CHOOSE OF btn_Help IN FRAME read-input-dir
  RUN "adecomm/_adehelp.p" ( INPUT "admn",
                             INPUT "CONTEXT",
                             INPUT {&Load_Data_Contents_Dlg_Box},
                             INPUT ? ).

ON HELP OF FRAME read-dir-text OR
   CHOOSE OF btn_Help IN FRAME read-dir-text
  RUN "adecomm/_adehelp.p" ( INPUT "admn",
                             INPUT "CONTEXT",
                             INPUT {&Load_Data_Contents_Dlg_Box},
                             INPUT ? ).
                             
ON HELP OF FRAME read-dir-nobl
   OR CHOOSE OF btn_Help IN FRAME read-dir-nobl
  RUN "adecomm/_adehelp.p" ( INPUT "admn",
                             INPUT "CONTEXT",
                             /* Temporary until context help is developed */
                             INPUT {&Load_Data_Contents_Dlg_Box},
                             INPUT ? ).

on HELP of frame read-d-dir
   or CHOOSE of btn_Help in frame read-d-dir
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                             INPUT {&Load_Data_Contents_Some_Dlg_Box},
                             INPUT ?).
                             
on HELP of frame get-cp or CHOOSE of btn_Help in frame get-cp
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT",
                             INPUT {&Code_Page_Dlg_Box},
                              INPUT ?).

&ENDIF

/*----- ON GO or OK -----*/
ON GO OF FRAME read-df
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-df) = ? THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-df.
    RETURN NO-APPLY.
  END.
  IF io-file THEN 
    user_env[2]:SCREEN-VALUE = SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-df).
  ASSIGN user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-df.
  run verify-cp.
END.

ON GO OF FRAME read-d-file
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-d-file) = ? 
  THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-d-file.
    RETURN NO-APPLY.
  END.
  
  ASSIGN user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-d-file
         user_env[30] = user_env[30]:SCREEN-VALUE IN FRAME read-d-file.

  IF inclob:SCREEN-VALUE IN FRAME read-d-file = "no" THEN
      ASSIGN user_env[31] = " NO-LOBS".
  ELSE
      ASSIGN user_env[31] = "".
             
  run verify-cp.
END.

ON GO OF FRAME read-d-file-mt
DO:  
    do with frame  read-d-file-mt:
        trimScreenValue(user_env[30]:handle IN FRAME read-d-file-mt).
        if not validateTenantName(user_env[32]:screen-value IN FRAME read-d-file-mt) then
        do:
            APPLY "ENTRY" TO user_env[32] IN FRAME read-d-file-mt.
            return no-apply.
        end.  
        
        /* Validate this when use defaults. It is not directly used 
           but it is prepended to other directories when valid 
          (invalid values are not prepended, and the user might have 
           thought it was, so we need to tell them that the root is wrong)  */
        if UseDefaultdirs
        and not validateDirectory(RootDirectory:screen-value in frame read-d-file-mt) then 
        do:
            apply "entry" to RootDirectory IN FRAME read-d-file-mt.
            
            return no-apply.
        end.    
    
        IF SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-d-file-mt) = ?  THEN 
        DO:
            MESSAGE "File" user_env[2] "does not exist" VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            if user_env[2]:sensitive in FRAME read-d-file-mt then
                APPLY "ENTRY" TO user_env[2] IN FRAME read-d-file-mt.
            else
                APPLY "ENTRY" TO UseDefaultDirs IN FRAME read-d-file-mt.
            
            RETURN NO-APPLY.
        END.
      
        IF inclob:SCREEN-VALUE IN FRAME read-d-file-mt = "yes" 
        and not validateDirectory(user_env[30]:screen-value IN FRAME read-d-file-mt) then 
        do:
            if user_env[30]:sensitive in FRAME read-d-file-mt then
                apply "entry" to user_env[30] IN FRAME read-d-file-mt.
            else
                APPLY "ENTRY" TO UseDefaultDirs IN FRAME read-d-file-mt.
            return no-apply.
        end.      
        
        ASSIGN user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-d-file-mt
               user_env[30] = user_env[30]:SCREEN-VALUE IN FRAME read-d-file-mt 
               user_env[32] = user_env[32]:SCREEN-VALUE IN FRAME read-d-file-mt.
        
        if not setEffectiveTenant(user_env[32]) then
        do:
            apply "entry" to user_env[32].
            return no-apply.    
        end.
        
        IF inclob:SCREEN-VALUE IN FRAME read-d-file-mt = "no" THEN
            ASSIGN user_env[31] = " NO-LOBS".
        ELSE
            ASSIGN user_env[31] = "".
                 .
        run verify-cp.
    end.
    
END.


ON GO OF FRAME read-d-seq-mt
DO:  
    if not validateTenantName(user_env[32]:screen-value IN FRAME read-d-seq-mt) then
    do:
        APPLY "ENTRY" TO user_env[32] IN FRAME read-d-seq-mt.
        return no-apply.
    end.  
    
    /* Validate this when use defaults. It is not directly used 
       but it is prepended to other directories when valid 
      (invalid values are not prepended, and the user might have 
       thought it was, so we need to tell them that the root is wrong)  */
    if UseDefaultdirs
    and not validateDirectory(RootDirectory:screen-value in frame read-d-seq-mt) then 
    do:
        apply "entry" to RootDirectory IN FRAME read-d-seq-mt.        
        return no-apply.
    end.    

    IF SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-d-seq-mt) = ?  THEN 
    DO:
        MESSAGE "File" user_env[2] "does not exist" VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        if user_env[2]:sensitive in FRAME read-d-seq-mt then
            APPLY "ENTRY" TO user_env[2] IN FRAME read-d-seq-mt.
        else
            APPLY "ENTRY" TO UseDefaultDirs IN FRAME read-d-seq-mt.
        
        RETURN NO-APPLY.
    END.
    assign user_env[32].
    if not setEffectiveTenant(user_env[32]) then
    do:
        apply "entry" to user_env[32].
        return no-apply.    
    end.
    run verify-cp.
 
END.


ON GO OF FRAME read-d-file-nobl
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-d-file-nobl) = ? 
  THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-d-file-nobl.
    RETURN NO-APPLY.
  END.
  user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-d-file-nobl.

  run verify-cp.
END.

ON GO OF FRAME read-xml-file
DO:
  IF SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-xml-file) = ? 
  THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-xml-file.
    RETURN NO-APPLY.
  END.
  user_env[2]  = user_env[2]:SCREEN-VALUE IN FRAME read-xml-file.
END.

ON GO OF FRAME read-input-dir DO:
  DEFINE VARIABLE cDir AS CHARACTER   NO-UNDO.

  cDir = (IF user_env[2]:SCREEN-VALUE IN FRAME read-input-dir = "" THEN
            "./" ELSE user_env[2]:SCREEN-VALUE IN FRAME read-input-dir).
  FILE-INFO:FILE-NAME = cDir.
  IF FILE-INFO:FILE-NAME = ? OR
     INDEX(FILE-INFO:FILE-TYPE,"D") = 0 THEN DO:
    MESSAGE cDir "is not a directory or cannot be found!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
END.

ON GO OF FRAME read-dir-text DO:
  DEFINE VARIABLE cDir AS CHARACTER   NO-UNDO.
  
  cDir = (IF user_env[2]:SCREEN-VALUE IN FRAME read-dir-text = "" THEN
            "./" ELSE user_env[2]:SCREEN-VALUE IN FRAME read-dir-text).
  FILE-INFO:FILE-NAME = cDir.
  IF FILE-INFO:FILE-NAME = ? OR
     INDEX(FILE-INFO:FILE-TYPE,"D") = 0 THEN DO:
    MESSAGE cDir "is not a directory or cannot be found!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
END.

ON GO OF FRAME read-dir-nobl DO:
  DEFINE VARIABLE cDir AS CHARACTER   NO-UNDO.

  cDir = (IF user_env[2]:SCREEN-VALUE IN FRAME read-dir-nobl = "" THEN
            "./" ELSE user_env[2]:SCREEN-VALUE IN FRAME read-dir-nobl).
  FILE-INFO:FILE-NAME = cDir.
  IF FILE-INFO:FILE-NAME = ? OR
     INDEX(FILE-INFO:FILE-TYPE,"D") = 0 THEN DO:
    MESSAGE cDir "is not a directory or cannot be found!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
END.

ON GO OF FRAME read-d-dir
DO:
   
  IF inclob:SCREEN-VALUE IN FRAME read-d-dir = "no" THEN
      ASSIGN user_env[31] = " NO-LOBS".            
  ELSE
      ASSIGN user_env[31] = "".            
END.

ON GO OF FRAME read-d-dir-mt
DO:   
    /* keep standard behavior (not done one value-changed in this frame though) */
    trimScreenValue(user_env[2]:handle in frame read-d-dir-mt).
    trimScreenValue(user_env[30]:handle in frame read-d-dir-mt).
    trimScreenValue(user_env[33]:handle in frame read-d-dir-mt).
    trimScreenValue(user_env[34]:handle in frame read-d-dir-mt).
    
    do with frame read-d-dir-mt:
        if not validateTenantName(user_env[32]:screen-value in frame read-d-dir-mt) then
        do:
            apply "entry" TO user_env[32] IN FRAME read-d-file-mt.
            return no-apply.
        end.  
        
        /* Validate this also if isAllMultiTenant when use defaults. Even if it is not directly in 
           use it is the first part of the other directories  */
        if (not isAllMultiTenant or UseDefaultdirs)
        and not validateDirectory(user_env[2]:screen-value in frame read-d-dir-mt) then 
        do:
            if user_env[2]:sensitive then       
                 apply "entry" to user_env[2] IN FRAME read-d-file-mt.
            else
                 apply "entry" to UseDefaultDirs IN FRAME read-d-file-mt.
                 
            return no-apply.
        end.    
       
        if not validateDirectory(user_env[33]:screen-value in frame read-d-dir-mt) then 
        do:
            apply "entry" to user_env[33] in frame read-d-dir-mt.
            return no-apply.
        end.    
         
        IF inclob:SCREEN-VALUE in frame read-d-dir-mt = "yes" 
        and not isAllMultiTenant 
        and not validateDirectory(user_env[30]:screen-value in frame read-d-dir-mt) then 
        do:
           apply "entry" to user_env[30] in frame read-d-dir-mt.
           return no-apply.
        end.    
        
        IF inclob:SCREEN-VALUE in frame read-d-dir-mt = "yes" 
        and not validateDirectory(user_env[34]:screen-value in frame read-d-dir-mt) then 
        do:
            apply "entry" to user_env[34] in frame read-d-dir-mt. 
            return no-apply.
        end.    
        
        assign user_env[32].
        if not setEffectiveTenant(user_env[32]) then
        do:
            apply "entry" to user_env[32].
            return no-apply.    
        end.
        
        IF inclob:SCREEN-VALUE IN FRAME read-d-dir-mt = "no" THEN
            ASSIGN user_env[31] = " NO-LOBS".            
        ELSE
            ASSIGN user_env[31] = "".
        
    end.                
END.

ON GO OF FRAME read-input
DO:
  IF io-file AND SEARCH(user_env[2]:SCREEN-VALUE IN FRAME read-input) = ? THEN DO:
    MESSAGE msg VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO user_env[2] IN FRAME read-input.
    RETURN NO-APPLY.
  END.
  ASSIGN user_env[2] = user_env[2]:SCREEN-VALUE IN FRAME read-input.
  run verify-cp.
END.

ON CHOOSE OF btn_Cancel IN FRAME read-xml-file
  APPLY "WINDOW-CLOSE" TO FRAME read-xml-file.

IF user_env[9] = "y" THEN DO:
  ON CHOOSE OF btn_Cancel IN FRAME read-input-dir
    APPLY "WINDOW-CLOSE" TO FRAME read-input-dir.
END.


IF user_env[9] = "t" THEN DO:
  ON CHOOSE OF btn_Cancel IN FRAME read-dir-text
    APPLY "WINDOW-CLOSE" TO FRAME read-dir-text.
END.
      
/*----- ON WINDOW-CLOSE -----*/
on WINDOW-CLOSE of frame read-input
   apply "END-ERROR" to frame read-input.
ON WINDOW-CLOSE OF FRAME read-input-dir
   APPLY "END-ERROR" TO FRAME read-input-dir.
ON WINDOW-CLOSE OF FRAME read-d-seq-mt
   APPLY "END-ERROR" TO FRAME read-d-seq-mt.
ON WINDOW-CLOSE OF FRAME read-dir-text
   APPLY "END-ERROR" TO FRAME read-dir-text.
ON END-ERROR OF FRAME read-input-dir
  user_env[2] = ?.
ON END-ERROR OF FRAME read-d-seq-mt
  user_env[2] = ?.
ON END-ERROR OF FRAME read-dir-text
  user_env[2] = ?.
ON WINDOW-CLOSE OF FRAME read-dir-nobl
   APPLY "END-ERROR" TO FRAME read-dir-nobl.
on WINDOW-CLOSE of frame read-df
   apply "END-ERROR" to frame read-df.
on WINDOW-CLOSE of frame read-d-file
   apply "END-ERROR" to frame read-d-file.
on WINDOW-CLOSE of frame read-d-file-mt
   apply "END-ERROR" to frame read-d-file-mt.

on WINDOW-CLOSE of frame read-d-file-nobl
   apply "END-ERROR" to frame read-d-file-nobl.
on WINDOW-CLOSE of frame read-xml-file
   apply "END-ERROR" to frame read-xml-file.
on END-ERROR of frame read-xml-file
  user_env[2] = ?.
on WINDOW-CLOSE of frame read-d-dir
   apply "END-ERROR" to frame read-d-dir.
on WINDOW-CLOSE of frame read-d-dir-mt
   apply "END-ERROR" to frame read-d-dir-mt.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[2] in frame read-input
   user_env[2]:screen-value in frame read-input = 
        TRIM(user_env[2]:screen-value in frame read-input).
ON LEAVE OF user_env[2] IN FRAME read-input-dir
   user_env[2]:SCREEN-VALUE IN FRAME read-input-dir = 
        TRIM(user_env[2]:SCREEN-VALUE IN FRAME read-input-dir).
ON LEAVE OF user_env[2] IN FRAME read-dir-text
   user_env[2]:SCREEN-VALUE IN FRAME read-dir-text =
        TRIM(user_env[2]:SCREEN-VALUE IN FRAME read-dir-text).
ON LEAVE OF user_env[2] IN FRAME read-dir-nobl
   user_env[2]:SCREEN-VALUE IN FRAME read-dir-nobl = 
        TRIM(user_env[2]:SCREEN-VALUE IN FRAME read-dir-nobl).
ON LEAVE OF user_env[2] in frame read-df
   user_env[2]:screen-value in frame read-df = 
        TRIM(user_env[2]:screen-value in frame read-df).
ON LEAVE OF user_env[2] in frame read-d-file
   user_env[2]:screen-value in frame read-d-file = 
        TRIM(user_env[2]:screen-value in frame read-d-file).
ON LEAVE OF user_env[2] in frame read-d-file-nobl
   user_env[2]:screen-value in frame read-d-file-nobl = 
        TRIM(user_env[2]:screen-value in frame read-d-file-nobl).
ON LEAVE OF user_env[2] in frame read-xml-file
   user_env[2]:screen-value in frame read-xml-file = 
        TRIM(user_env[2]:screen-value in frame read-xml-file).

ON LEAVE OF user_env[2] in frame read-d-dir DO:
  user_env[2]:screen-value in frame read-d-dir = 
        TRIM(user_env[2]:screen-value in frame read-d-dir).
  IF user_env[2]:screen-value in frame read-d-dir <> ""  THEN DO:
     ASSIGN FILE-INFO:FILE-NAME = user_env[2]:screen-value in frame read-d-dir .
     IF SUBSTRING(FILE-INFO:FILE-TYPE,1,1) <> "D" THEN DO:
       MESSAGE FILE-INFO:FILE-NAME "is not a directory or can not be found" VIEW-AS ALERT-BOX ERROR.
       RETURN NO-APPLY.
     END.
  END.
END.

ON LEAVE OF user_env[30] in frame read-d-file DO:
   user_env[30]:screen-value in frame read-d-file = 
        TRIM(user_env[30]:screen-value in frame read-d-file).
   IF user_env[30]:screen-value in frame read-d-file <> ""  THEN DO:
     ASSIGN FILE-INFO:FILE-NAME = user_env[30]:screen-value in frame read-d-file .
     IF SUBSTRING(FILE-INFO:FILE-TYPE,1,1) <> "D" THEN DO:
       MESSAGE FILE-INFO:FILE-NAME "is not a directory or can not be found" VIEW-AS ALERT-BOX ERROR.
       RETURN NO-APPLY.
     END.
  END.
END.

ON LEAVE OF user_env[30] in frame read-d-dir DO:
  user_env[30]:screen-value in frame read-d-dir = 
        TRIM(user_env[30]:screen-value in frame read-d-dir).
   IF user_env[30]:screen-value in frame read-d-dir <> ""  THEN DO:
     ASSIGN FILE-INFO:FILE-NAME = user_env[30]:screen-value in frame read-d-dir .
     IF SUBSTRING(FILE-INFO:FILE-TYPE,1,1) <> "D" THEN DO:
       MESSAGE FILE-INFO:FILE-NAME "is not a directory or can not be found" VIEW-AS ALERT-BOX ERROR.
       RETURN NO-APPLY.
     END.
  END.
END.

/*-----On value change of flags --*/
ON VALUE-CHANGED OF stop_flg IN FRAME read-df DO:
  IF SELF:screen-value = "yes" THEN DISABLE commit_flg WITH FRAME read-df.
  ELSE DO: 
      IF no-schema-lock:SCREEN-VALUE IN FRAME read-df = "no" THEN
        ENABLE commit_flg WITH FRAME read-df.   
  END.
  RETURN.
END.
ON VALUE-CHANGED OF commit_flg IN FRAME read-df DO:
  IF SELF:screen-value = "yes" THEN 
      DISABLE stop_flg no-schema-lock WITH FRAME read-df.
  ELSE 
      ENABLE stop_flg no-schema-lock WITH FRAME read-df.
  RETURN.
END.

ON VALUE-CHANGED OF no-schema-lock IN FRAME read-df DO:
  IF SELF:screen-value = "yes" THEN DISABLE commit_flg WITH FRAME read-df.      
  ELSE DO:
    IF stop_flg:SCREEN-VALUE IN FRAME read-df = "no" THEN
      ENABLE commit_flg WITH FRAME read-df.      
  END.
  RETURN.
END.

ON VALUE-CHANGED OF user_env[2] IN FRAME read-d-dir-mt
do:
    refreshDirInDirUI().
end.   

ON VALUE-CHANGED OF user_env[30] in frame read-d-file-mt do: 
    assign frame read-d-file-mt user_env[30].         
end.

ON VALUE-CHANGED OF user_env[30] in frame read-d-dir-mt do: 
    assign frame read-d-dir-mt user_env[30].    
end.

ON VALUE-CHANGED OF user_env[32] in frame read-d-dir-mt do: 
    refreshTenantInDirUI ().
end.

ON VALUE-CHANGED OF user_env[32] in frame read-d-file-mt do: 
    refreshTenantInfileUI ().
end.

ON VALUE-CHANGED OF user_env[32] in frame read-d-seq-mt do: 
    refreshTenantInSeqUI ().
end.

ON VALUE-CHANGED OF user_env[33] in frame read-d-dir-mt do: 
    assign frame read-d-dir-mt user_env[33].        
end.

ON VALUE-CHANGED OF user_env[34] in frame read-d-dir-mt do: 
    assign frame read-d-dir-mt user_env[34].        
end.


ON VALUE-CHANGED OF inclob IN FRAME read-d-file 
DO:
    refreshLobField(SELF:screen-value IN FRAME read-d-file = "yes",user_env[30]:handle IN FRAME read-d-file ).
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
        btn_dir:sensitive in frame read-d-file = SELF:screen-value IN FRAME read-d-file = "yes".
    &ENDIF
END.

ON VALUE-CHANGED OF inclob IN FRAME read-d-file-mt 
DO:
    refreshFileMTState().
END.

ON VALUE-CHANGED OF inclob IN FRAME read-d-dir 
DO:
    refreshLobField(SELF:screen-value = "yes",user_env[30]:handle IN FRAME read-d-dir  ).
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
        btn_dir2:sensitive in frame read-d-dir = SELF:screen-value IN FRAME read-d-dir = "yes".
    &ENDIF
END.

ON VALUE-CHANGED OF inclob IN FRAME read-d-dir-mt
DO:
     refreshDirMTState().
END.

ON VALUE-CHANGED OF UseDefaultDirs IN FRAME read-d-dir-mt
do:
    assign frame read-d-dir-mt UseDefaultDirs.
    if UseDefaultDirs then
        refreshDirMT(). 
    
    refreshDirMtState().
end.


ON VALUE-CHANGED OF UseDefaultDirs IN FRAME read-d-file-mt
do:
    assign FRAME read-d-file-mt UseDefaultDirs.
    if UseDefaultDirs then
        refreshFileMT(). 
    
    refreshFileMtState().
end.

ON VALUE-CHANGED OF UseDefaultDirs IN FRAME read-d-seq-mt
do:
    assign frame read-d-seq-mt UseDefaultDirs.
    if UseDefaultDirs then
        refreshSeqMT(). 
    
    refreshSeqMtState().
end.


ON VALUE-CHANGED OF RootDirectory IN FRAME read-d-file-mt
do:
    refreshDirInFileUI(). 
    
end.


/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame read-input DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-input /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame read-df DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-df /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame read-d-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-d-file /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame read-d-file-mt DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-d-file-mt /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame read-d-seq-mt DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-d-seq-mt /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame read-d-file-nobl DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-d-file-nobl /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File in frame read-xml-file DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[2]:handle in frame read-xml-file /*Fillin*/,
        INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
        
END.
ON CHOOSE OF btn_Tenant IN FRAME read-d-file-mt
DO:
    selectTenant(user_env[32]:handle IN FRAME read-d-file-mt).      
END.
ON CHOOSE OF btn_Tenant IN FRAME read-d-dir-mt
DO:
    selectTenant(user_env[32]:handle IN FRAME read-d-dir-mt).
END.
ON CHOOSE OF btn_Tenant IN FRAME read-d-seq-mt
DO:
    selectTenant(user_env[32]:handle IN FRAME read-d-seq-mt).
END.


&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
  ON CHOOSE OF btn_dir in frame read-d-file DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[30]:handle in frame read-d-file /*Fillin*/,
        INPUT "Find Lob Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
  END.
  ON CHOOSE OF btn_dir in frame read-d-file-mt DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[30]:handle in frame read-d-file-mt /*Fillin*/,
        INPUT "Find Lob Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
    apply "value-changed" to user_env[30] in frame read-d-file-mt.    
  END.
  
  ON CHOOSE OF btn_dir in frame read-input-dir DO:
    RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[2]:handle in frame read-input-dir /*Fillin*/,
        INPUT "Choose Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
  END.
  ON CHOOSE OF btn_dir in frame read-dir-text DO:
    RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[2]:handle in frame read-dir-text /*Fillin*/,
        INPUT "Choose Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
  END.
  ON CHOOSE OF btn_dir in frame read-dir-nobl DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[2]:handle in frame read-dir-nobl /*Fillin*/,
        INPUT "Choose Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
  END.
  ON CHOOSE OF btn_dir in frame read-d-dir DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[2]:handle in frame read-d-dir /*Fillin*/,
        INPUT "Find File Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
  END.
  ON CHOOSE OF btn_dir in frame read-d-dir-mt DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[2]:handle in frame read-d-dir-mt /*Fillin*/,
        INPUT "Find File Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
   apply "value-changed" to user_env[2] in frame read-d-dir-mt.    
  END.
  
  ON CHOOSE OF btn_dir2 in frame read-d-dir DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[30]:handle in frame read-d-dir /*Fillin*/,
        INPUT "Find Lob Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
  END.
  ON CHOOSE OF btn_dir2 in frame read-d-dir-mt DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[30]:handle in frame read-d-dir-mt /*Fillin*/,
        INPUT "Find Lob Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
    apply "value-changed" to user_env[30] in frame read-d-dir-mt.    
  END.
  ON CHOOSE OF btn_dirmt in frame read-d-dir-mt DO:
   RUN "prodict/misc/_dirbtn.p"
       (INPUT user_env[33]:handle in frame read-d-dir-mt /*Fillin*/,
        INPUT "Find File Directory"  /*Title*/,
        INPUT ""                 /*Filter*/).
    apply "value-changed" to user_env[33] in frame read-d-dir-mt.    
   
  END.
  ON CHOOSE OF btn_dirmtlob in frame read-d-dir-mt DO:
    RUN "prodict/misc/_dirbtn.p"
        (INPUT user_env[34]:handle in frame read-d-dir-mt /*Fillin*/,
         INPUT "Find File Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
    apply "value-changed" to user_env[34] in frame read-d-dir-mt.    
    
  END.
  
  ON CHOOSE OF btn_dirRoot in frame read-d-file-mt DO:
    RUN "prodict/misc/_dirbtn.p"
        (INPUT RootDirectory:handle in frame read-d-file-mt /*Fillin*/,
         INPUT "Find File Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
    apply "value-changed" to RootDirectory in frame read-d-file-mt.    
    
  END.
  ON CHOOSE OF btn_dirRoot in frame read-d-seq-mt DO:
    RUN "prodict/misc/_dirbtn.p"
        (INPUT RootDirectory:handle in frame read-d-seq-mt /*Fillin*/,
         INPUT "Find File Directory"  /*Title*/,
         INPUT ""                 /*Filter*/).
    apply "value-changed" to RootDirectory in frame read-d-seq-mt.    
    
  END.

  
&ENDIF
/*=======================Internal Procedures==========================*/

PROCEDURE verify-cp:
  /* Is there a defined codepage? Try to read it in the trailer, if
   * not, ask for it
   */
  ASSIGN codepage = "".
  RUN read-cp. /* read the code page in the file */
  IF codepage = "" OR codepage = ? OR codepage = "(no conversion)" THEN
  DO:
     MESSAGE "There is no Code Page defined in this input file." view-as
        ALERT-BOX ERROR BUTTONS OK.
     RUN get-cp. /* prompt for it */
  END.
  ELSE user_env[10] = codepage.
END PROCEDURE.

PROCEDURE read-cp.
  /* Read trailer of file and find codepage */
  /* (partially stolen from lodtrail.i)     */
  
  DEFINE VARIABLE tempi AS DECIMAL          NO-UNDO.
  DEFINE VARIABLE j     AS INTEGER          NO-UNDO.
  DEFINE VARIABLE iPos  AS INT64            NO-UNDO.

  INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP.
  SEEK INPUT TO END.
  iPos = SEEK(INPUT) - 11.
  SEEK INPUT TO iPos. /* position to possible beginning of last line */

  /* Now we need to deal with a large offset, which is a variable size
     value in the trailer, for large values.
     Now go back one character at a time until we find a new line or we have
     gone back too far.
     For the non-large offset format, the previous char will be a
     newline character, so we will  detect that right away and read the
     value as usual. Unless the file has CRLF (Windows), in which case
     we will go back 1 character to read the value properly - to
     account for the extra byte.
     For larger values, we will read as many digits as needed.
     The loop below could stop after 10 digits, but I am letting it go
     up to 50 to try to catch a bad value.
  */
  DO WHILE LASTKEY <> 13 AND j <= 50:
     ASSIGN j = j + 1
            iPos = iPos - 1.
     SEEK INPUT TO iPos.
     READKEY PAUSE 0.
  END.

  /* now we can start reading it */
  READKEY PAUSE 0.
  ASSIGN
    lvar# = 0
    lvar  = ""
    iPos  = 0.

  DO WHILE LASTKEY <> 13 AND iPos <> ?: /* get byte count (last line) */

      IF LASTKEY > 47 AND LASTKEY < 58 THEN DO:
          /* check if can fit the value into an int64 type. We need
             to manipulate it with a decimal so that we don't get fooled
             by a value that overflows. This is so that we catch a
             bad offset in the file.
           */
          ASSIGN tempi = iPos /* first move it to a decimal */
                 tempi = tempi * 10 + LASTKEY - 48. /* get new value */
          iPos = INT64(tempi) NO-ERROR. /* see if it fits into an int64 */
          
          /* check if the value overflows becoming negative or an error happened. 
             If so, something is wrong (too many digits or invalid values),
             so forget this.
          */
          IF  iPos < 0 OR
              ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 0 THEN DO:
              ASSIGN iPos = 0.
              LEAVE. /* we are done with this */
          END.

      END.
      ELSE 
          ASSIGN iPos = ?. /* bad character */

    READKEY PAUSE 0.
  END.

  IF iPos > 0 then run get_psc (INPUT iPos). /* get it */
  ELSE RUN find_psc. /* look for it */
  INPUT CLOSE.
  DO iPos = 1 TO lvar#:
    IF lvar[iPos] BEGINS "cpstream=" OR lvar[iPos] BEGINS "codepage" THEN
       codepage = TRIM(SUBSTRING(lvar[iPos],10,-1,"character":U)).
  END.
END PROCEDURE.

PROCEDURE get-cp.
   /* Prompt for codepage */
   DO ON ERROR UNDO, RETRY ON ENDKEY UNDO, LEAVE WITH FRAME get-cp:
       ASSIGN codepage = SESSION:STREAM.
       UPDATE codepage btn_OK btn_Cancel {&HLP_BTN_NAME}.
       ASSIGN user_env[10] = codepage.
   END.
END PROCEDURE.

PROCEDURE get_psc:
  DEFINE INPUT PARAMETER piPos AS INT64 NO-UNDO.

  /* using the byte count, we scoot right down there and look for
   * the beginning of the trailer ("PSC"). If we don't find it, we
   * will go and look for it.
   */

  DEFINE VARIABLE rc AS LOGICAL INITIAL no.
  _psc:
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    SEEK INPUT TO piPos. /* skip to beginning of "PSC" in file */
    READKEY PAUSE 0. IF LASTKEY <> ASC("P") THEN LEAVE _psc. /* not there!*/
    READKEY PAUSE 0. IF LASTKEY <> ASC("S") THEN LEAVE _psc.
    READKEY PAUSE 0. IF LASTKEY <> ASC("C") THEN LEAVE _psc.
    ASSIGN rc = yes. /* found it! */
    RUN read_bits (INPUT piPos). /* read trailer bits */
  END.
  IF NOT rc THEN RUN find_psc. /* look for it */
END PROCEDURE.

PROCEDURE find_psc:
  /* If the bytecount at the end of the file is wrong, we will jump
   * back the maximum number of bytes in a trailer and start looking
   * from there. If we still don't find it then tough luck.
   * NOTE: Variable p holds the number of bytes to roll back. AS of
   * 7/21/94, the max size of a trailer (.d) is 204 bytes, if you add
   * anything to this trailer, you must change this number to reflect
   * the number of bytes you added. I'll use 256 to add a little padding. (gfs)
   */
  DEFINE VARIABLE p AS INT64    INITIAL 256. /* really 204, added extra just in case */
  DEFINE VARIABLE l AS INT64.                /* LAST char position */
  
  SEEK INPUT TO END.
  ASSIGN l = SEEK(INPUT). /* EOF */
  SEEK INPUT TO SEEK(INPUT) - MINIMUM(p,l). /* take p, or size of file */
  IF SEEK(INPUT) = ? THEN RETURN.
  _scan:
  REPEAT ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    READKEY PAUSE 0.
    p = SEEK(INPUT). /* save off where we are looking */
    IF LASTKEY = ASC("P") THEN DO:
       READKEY PAUSE 0.
       IF LASTKEY <> ASC("S") THEN NEXT.
       ELSE DO: /* found "PS" */
         READKEY PAUSE 0.
         IF LASTKEY <> ASC("C") THEN NEXT.
         ELSE DO: /* found "PSC"! */
           RUN read_bits (INPUT p - 1).
           LEAVE.
         END. /* IF "C" */
       END. /* IF "S" */    
    END. /* IF "P" */
    ELSE IF p >= l THEN LEAVE _scan. /* at EOF, so give up */
  END. /* repeat */
END.

PROCEDURE read_bits:
  /* reads trailer given a starting position 
   */ 
  DEFINE INPUT PARAMETER pi as INT64  . /* "SEEK TO" location */
    
  SEEK INPUT TO pi.
  REPEAT:
    IMPORT lvar[lvar# + 1].
    lvar# = lvar# + 1.
  END.
END PROCEDURE. 

 
/*==========================Mainline code=============================*/
{adecomm/okrun.i
  &FRAME = "FRAME get-cp"
  &BOX   = "rect_Btns"
  &OK    = "btn_OK"
  {&CAN_BTN}
  {&HLP_BTN}
  }

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

if int(dbversion("dictdb")) > 10 then
do:
   isSuperTenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
end.

ASSIGN
  class    = SUBSTRING(user_env[9],1,-1,"character")
  io-file  = TRUE
  io-frame = ""
    prefix   = "".
             /*(IF OPSYS = "UNIX" THEN "./"
               ELSE IF CAN-DO("MSDOS,OS2",OPSYS) THEN ".~\"
               ELSE "")*/

/* if user_env[1] is "" for class "f", then list is in user_longchar 
   because it was too big to fi into user_env[1].
*/
IF user_env[1] = "" AND class = "f" THEN
   ASSIGN is-some  = (user_longchar MATCHES "*,*").
ELSE
   ASSIGN is-some  = (user_env[1] MATCHES "*,*").

ASSIGN
  is-all   = (user_env[1] = "ALL")
  is-one   = NOT is-all AND NOT is-some.

IF dict_rog THEN msg-num = 3. /* look but don't touch */

/*-------------------------------------------------*/ /* Hide message */
IF class = "h" THEN DO:
  /* Fernando: gives the user time to see the error message that the 
     client issued instead of flashing the messages */
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
     HIDE MESSAGE NO-PAUSE.
  &ENDIF
  
  ASSIGN SESSION:SCHEMA-CHANGE = user_env[35].
 
   /* Fernando: 20020129-017 Also, if there was an error that backed out the changes, 
   do not display the message */
  IF user_env[4] = "error" THEN
     MESSAGE "Load aborted." VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  ELSE IF user_env[4] = "error_objattrs" THEN
      MESSAGE "Load of policies and/or object attributes failed." 
         VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  ELSE
      MESSAGE "Load completed." VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
     
   RETURN.
END.
/*----------------------------------------*/ /* LOAD FILE DEFINITIONS */
IF class = "d" OR class begins "4" or class = "s" THEN DO:

  IF msg-num = 0 THEN DO FOR DICTDB._File iVar = 1 TO 4:
    FIND DICTDB._File
      WHERE DICTDB._File._File-name = ENTRY(iVar,"_Db,_File,_Field,_Index")
        AND DICTDB._File._Owner = "PUB".
    IF   NOT CAN-DO(_Can-read,  USERID("DICTDB"))
      OR NOT CAN-DO(_Can-write, USERID("DICTDB"))
      OR NOT CAN-DO(_Can-delete,USERID("DICTDB"))
      OR NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN msg-num = 4.    
  END.
  ASSIGN
    base        = PDBNAME(user_dbname)
    user_env[2] = (IF class = "s" THEN "_seqdefs.df"
                  ELSE IF class = "4t" THEN "_trgdefs.df"
                  ELSE
                  ((IF base = "" OR base = ? THEN user_dbname ELSE base) 
                                                                 + ".df"))
    io-frame    = "df"
    io-title    = (IF class = "s" THEN "Load Sequence Definitions"
                   ELSE IF class = "4" THEN "Load AS/400 Definitions File"
                   ELSE IF class = "4t" THEN "Load Database Triggers"
                   ELSE "Load Data Definitions")
    user_env[4] = "n"          /* stop on first error - used by _lodsddl.p */
    user_env[8] = user_dbname  /* dbname to load into - used by _lodsddl.p */
    class = "d". /* if class was 's', reassign to run as class 'd' after 
                    input file name default (user_env[2]) */
    
END.

/*--------------------------------------*/ /* LOAD DATA FILE CONTENTS */
ELSE IF class = "f" THEN DO FOR DICTDB._File:

  /* read-only status is relevant only for PROGRESS-db's */
  /* schemaholders can be in read-only mode and still    */
  /* allow data to be loaded!                            */
  IF dict_rog 
    AND msg-num = 3
    AND user_dbtype <> "PROGRESS"
    THEN ASSIGN msg-num = 0. 

  noload = "u".
  { prodict/dictgate.i &action=undumpload
    &dbtype=user_dbtype &dbrec=drec_db &output=noload
  }

  FIND DICTDB._File  WHERE DICTDB._FIle._File-name = "_File"
                       AND DICTDB._File._Owner = "PUB".
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN msg-num = 4.
  RELEASE DICTDB._File.
  IF NOT is-all AND NOT is-some THEN
  DO:
    FIND DICTDB._File WHERE _Db-recid = drec_db AND _File-name = user_env[1]
                        AND (_Owner = "PUB" OR _Owner = "_FOREIGN").
    
  END.
  
  /* using base_lchar to make code below simplier */
  IF NOT isCpUndefined AND (is-one OR is-some) THEN DO:
     /* if user_env[1] is "", then value is in user_longchar */
     IF user_env[1] NE "" THEN
         base_lchar = user_env[1].
     ELSE
         base_lchar = user_longchar.
  END.
  ELSE
     base = (IF is-one OR is-some THEN user_env[1] ELSE "").


  ASSIGN
    user_env[2] = prefix + (IF is-all OR is-some THEN "" ELSE
                  (IF DICTDB._File._Dump-name = ?
                  THEN DICTDB._File._File-name ELSE DICTDB._File._Dump-name)
                + ".d")
    user_env[4] = "0"
    io-file     = NOT is-all AND NOT is-some /* read from file/dir */
    io-frame    = "d"
    io-title    = "Load Data Contents for"
                + " " + (IF is-all THEN "All Tables" /*allfiles*/
                  ELSE  IF is-some THEN "Some Tables" /*somefiles*/
                  ELSE "Table ~"" + user_env[1] + "~"")
    user_env[1] = ""
    user_longchar = (IF isCpUndefined THEN user_longchar ELSE "")
    comma       = ""
    iVar           = 1.

  /* If user had selected ALL, fill base array with list of files.  
     Otherwise, it is already set to file list.
  */
  IF is-all THEN FOR EACH DICTDB._File
    WHERE DICTDB._File._File-number > 0
      AND DICTDB._File._Db-recid = drec_db
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
      AND NOT DICTDB._File._Hidden
      AND DICTDB._File._Tbl-Type <> "V"
      AND CAN-DO(DICTDB._File._Can-create,USERID(user_dbname))
      AND (noload = "" OR NOT CAN-DO(noload,DICTDB._File._For-type))
    BY DICTDB._File._File-name:
    IF DICTDB._File._Owner = "_FOREIGN" AND DICTDB._File._For-Type <> "TABLE" THEN
        NEXT.

    IF isCpUndefined THEN
       base = base + (IF base = "" THEN "" ELSE ",") + DICTDB._File._File-name.
   ELSE
       base_lchar = base_lchar + (IF base_lchar = "" THEN "" ELSE ",") + DICTDB._File._File-name.
  END.

  /* Run through the file list and cull out the ones that the user
     is not allowed to dump for some reason.
  */
  user_env[5] = "".

  ASSIGN numCount = (IF isCpUndefined THEN NUM-ENTRIES(base)
                     ELSE NUM-ENTRIES(base_lchar)).
         isAllMultiTenant = ?.

  DO iVar = 1 TO numCount:
    err = ?.
    dis_trig = "y".
    cItem = ENTRY(iVar,(IF isCpUndefined THEN base ELSE base_lchar)).
    FIND DICTDB._File
      WHERE _Db-recid = drec_db AND _File-name = cItem
        AND (_Owner = "PUB" OR _Owner = "_FOREIGN").   
    IF DICTDB._File._Owner = "_FOREIGN" AND DICTDB._File._For-type <> "TABLE" THEN DO:
      MESSAGE 'The file "' DICTDB._File._File-name  '" does not have a foreign' SKIP
              'type of "TABLE". It is therefore being skipped' SKIP
              VIEW-AS ALERT-BOX WARNING.
      NEXT.
    END.
    IF NOT CAN-DO(DICTDB._File._Can-create,USERID(user_dbname)) THEN
      err = DICTDB._File._File-name
        + " will not be loaded due to insufficient privileges.".
    ELSE
    IF noload <> "" AND CAN-DO(noload,DICTDB._File._For-type) THEN
      err = "".
        /*SUBSTITUTE("&1 is a &2 &3 and cannot be dumped.",
          DICTDB._File._File-name,user_dbtype,DICTDB._File._For-type).*/
    ELSE DO:
      
      
      {prodict/dump/ltrigchk.i &OK = answer}
      IF NOT answer THEN DO:
         MESSAGE "You do not have privileges to load table" DICTDB._File._File-name 
                 SKIP
                 "with triggers disabled.  Do you want to load this table" SKIP
                 "anyway even though the triggers will fire?"
                 VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL UPDATE answer.
         IF answer = no THEN
            err = "".  /* don't do this table but no more messages */
         ELSE IF answer = yes THEN DO:
            err = ?.   /* include this table in load */
            dis_trig = "n".
         END.
         ELSE DO:    /* cancel the load operation */
            user_path = "".
            RETURN.
         END.
      END.
    END.

    IF err = ? THEN DO:
      IF isCpUndefined THEN
         user_env[1] = user_env[1] + comma + DICTDB._File._File-name.
      ELSE
         user_longchar = user_longchar + comma + DICTDB._File._File-name.

      /* now we will only put the table number of tables that we will not
         disable triggers for, which is the exception (to most cases).
      */
      IF dis_trig = "n" THEN DO:
         IF user_env[5] = "" THEN
            user_env[5] = STRING(_File._File-number).
         ELSE
             user_env[5] = user_env[5] + "," + STRING(_File._File-number).
      END.

      ASSIGN  comma       = ",".
    END.
    ELSE IF err <> "" THEN DO:
      MESSAGE err SKIP "Do you want to continue?"
         VIEW-AS ALERT-BOX ERROR BUTTONS YES-NO UPDATE answer.
      IF answer = FALSE THEN DO:
        user_path = "".
        RETURN.
      END.
    END.
    
    if isSuperTenant then 
    do:         
        if isAnyMultiTenant = false then 
            isAnyMultiTenant = _file._file-attributes[1].
       
        if isAllMultiTenant = ? or isAllMultiTenant then
           isAllMultiTenant = _file._file-attributes[1].   
    end.
  END. /* do ivar = 1 to num  */
   
  /* subsequent removal of files changed from many to one, so reset ui stuff */
  IF (is-some OR is-all) AND
      NUM-ENTRIES((IF isCpUndefined THEN user_env[1] ELSE user_longchar)) = 1 THEN DO:

    IF NOT isCpUndefined THEN
       ASSIGN user_env[1] = user_longchar
              user_longchar ="".

    FIND DICTDB._File
      WHERE DICTDB._File._Db-recid = drec_db
        AND DICTDB._File._File-name = user_env[1]
        AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").
    
    ASSIGN
      is-some     = FALSE
      is-all      = FALSE
      is-one      = TRUE
      user_env[2] = prefix + (IF DICTDB._File._Dump-name = ?
                    THEN DICTDB._File._File-name ELSE DICTDB._File._Dump-name)
                  + ".d"
      io-file     = TRUE
      io-title    = "Load Data Contents for Table ~"" + user_env[1] + "~""
      base        = user_env[1].
  END.
  ELSE DO: 
      IF NOT isCpUndefined THEN DO:
          /* see if we can put user_longchar into user_env[1] */
          ASSIGN user_env[1] = user_longchar NO-ERROR.
          IF NOT ERROR-STATUS:ERROR THEN
             ASSIGN user_longchar = "".
          ELSE
             ASSIGN user_env[1] = "".
      END.
  END.

END.

/*-----------------------------------------------*/ /* LOAD SEQ VALS */
ELSE IF class = "k" THEN DO FOR DICTDB._File:
  FIND DICTDB._File "_Sequence".
  IF NOT CAN-DO(_Can-write,USERID("DICTDB")) THEN msg-num = 4.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN
    user_env[2] = prefix + "_seqvals.d"
    io-title    = "Load Sequence Current Values".
END.

/*--------------------------------------*/ /* LOAD USER FILE CONTENTS */
ELSE IF class = "u" THEN DO FOR DICTDB._File:
  FIND DICTDB._File "_User".
  IF NOT CAN-DO(_Can-write, USERID("DICTDB"))
    OR NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN msg-num = 4.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 1.
  ASSIGN
    user_env[2] = prefix + "_user.d"
    io-title    = "Load User Table Contents".
END.

/*--------------------------------------*/ /* LOAD VIEW FILE CONTENTS */
ELSE IF class = "v" THEN DO FOR DICTDB._File:
  FIND DICTDB._File "_View".
  IF NOT CAN-DO(_Can-write, USERID("DICTDB"))
    OR NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN msg-num = 4.
  IF user_dbtype <> "PROGRESS" THEN msg-num = 2.
  ASSIGN
    user_env[2] = prefix + "_view.d"
    io-title    = "Load SQL Views".
END.

IF msg-num > 0 THEN DO:
  MESSAGE (
    IF msg-num = 1 THEN
      "Cannot load User information for non-{&PRO_DISPLAY_NAME} database."
    ELSE IF msg-num = 2 THEN
      "Cannot load View information for non-{&PRO_DISPLAY_NAME} database."
    ELSE IF msg-num = 3 THEN
      "The dictionary is in read-only mode - alterations not allowed."
    ELSE
      "You do not have permission to use this option.")
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  IF CAN-DO("t,x,y",class) THEN
    user_env[2] = ?.
  RETURN.
END.

PAUSE 0.

/* if filename contains the .db, then remove it */
IF INDEX(user_env[2],".db") > 0 THEN
        SUBSTRING(user_env[2],INDEX(user_env[2],".db"),3,"RAW") = "".

IF io-frame = "df" THEN DO:
  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
   &FRAME  = "FRAME read-df" 
   &BOX    = "rect_Btns"
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
  }


  DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-df:
     ENABLE stop_flg commit_flg err-to-file err-to-screen no-schema-lock 
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN warntxt &ENDIF 
         WITH FRAME read-df.

     ASSIGN stop_flg = user_env[4] BEGINS "y".
    
    UPDATE user_env[2] btn_File stop_flg commit_flg err-to-file err-to-screen 
           no-schema-lock btn_OK btn_Cancel {&HLP_BTN_NAME}.

    ASSIGN user_env[15] = STRING(commit_flg)
           user_env[4] = STRING(stop_flg).
    IF no-schema-lock THEN
      ASSIGN user_path = "_lodv5df,*C,_lodsddl,9=h,_usrload"
             oldsession = SESSION:SCHEMA-CHANGE
             SESSION:SCHEMA-CHANGE = "NEW OBJECTS"
              user_env[35] = oldsession.
    ELSE
      ASSIGN user_path = "*T,_lodv5df,*C,_lodsddl,9=h,_usrload"
             user_env[35] = "".
    
    { prodict/dictnext.i trash }
    canned = FALSE.
        user_env[6] = 
         IF (err-to-file AND NOT err-to-screen) THEN "f" 
         ELSE IF (err-to-file AND err-to-screen) THEN "b" 
         ELSE IF (NOT err-to-file AND err-to-screen) THEN "s"
         ELSE "f".
    
  END.
END.

ELSE IF io-frame = "d" THEN DO:
  
  IF NOT io-file THEN 
  DO:
    DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
        if isAnyMultitenant then
        do with frame read-d-dir-mt:
            {adecomm/okrun.i  
              &FRAME  = "FRAME read-d-dir-mt" 
              &BOX    = "rect_Btns"
              &OK     = "btn_OK" 
              {&CAN_BTN}
              {&HLP_BTN}
              }
            
            assign 
                UseDefaultDirs = true
                user_env[32]   = get-effective-tenant-name("dictdb")
                err%           = INTEGER(user_env[4]).
            
            refreshDirDefaults().  
            
            display 
                user_env[32] 
                UseDefaultDirs
                user_env[2] 
                user_env[33] 
                inclob
                user_env[30]
                user_env[34] 
                .
           
            /* 
            if isAllMultiTenant then 
            do:
                user_env[2] = "".
                user_env[30] = "".
                user_env[2]:hidden in frame read-d-dir-mt = true.
                user_env[30]:hidden in frame read-d-dir-mt = true.
            end.      
              */
                              
            &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
            
            if not isAllMultiTenant then
            do:
                entry(1,idir_lbl," ") = "Shared".
                display idir_lbl ldir_lbl.
            end.
             
            display tenant_lbl idirmt_lbl ldirmt_lbl.
            
            enable user_env[32] 
                   btn_Tenant
                   UseDefaultDirs
                   user_env[2]  
                   btn_dir  
                   user_env[33] 
                   btn_dirmt 
                   inclob 
                   user_env[30]  
                   btn_dir2 
                   user_env[34] 
                   btn_dirmtlob 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
            &ELSE
            
            if isAllMultiTenant then 
            do:           
                user_env[34]:row in frame read-d-dir-mt = user_env[30]:row in frame read-d-dir-mt.
                user_env[34]:side-label-handle:row in frame read-d-dir-mt = user_env[34]:row in frame read-d-dir-mt.
            end.
               
            enable 
                   user_env[32]
                   btn_Tenant
                   UseDefaultDirs
                   user_env[2]  
                   user_env[33]
                   inclob 
                   user_env[30]  
                   user_env[34]
                   err%
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
            
            &ENDIF         
                        
            refreshDirMTState().
            wait-for "go" of frame read-d-dir-mt.
          
           /* danger danger: this must be qualified to use the frame of the 
              do block (it is possible that the frame qual only is needed on the first field) */ 
            
            ASSIGN 
                   frame read-d-dir-mt user_env[32]
                   frame read-d-dir-mt UseDefaultDirs
                   frame read-d-dir-mt user_env[2]  
                   frame read-d-dir-mt user_env[33]
                   frame read-d-dir-mt inclob 
                   frame read-d-dir-mt user_env[30]  
                   frame read-d-dir-mt user_env[34]
                   frame read-d-dir-mt err%
                   frame read-d-dir-mt do-screen 
                   user_env[6] = (IF do-screen THEN "s" ELSE "f")
                   user_env[4] = STRING(err%).
            
            RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).
            RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[30]).
            if UseDefaultDirs then
            do:
                 user_env[33] = gUseDefaultOut.
                 user_env[40] = gLobfolderName.
            end.
            else
            do:
                 user_env[40] = "".     
                 RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[33]).
            end.
            RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[34]).
            
            DISPLAY user_env[2] user_env[30] user_env[33] user_env[34].
           { prodict/dictnext.i trash }
            canned = FALSE.
        end. /* if isAnyMultiTenant */
        else do with frame read-d-dir:    
              {adecomm/okrun.i  
                 &FRAME  = "FRAME read-d-dir" 
                 &BOX    = "rect_Btns"
                 &OK     = "btn_OK" 
                 {&CAN_BTN}
                 {&HLP_BTN}
                }
         
            &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
            
            display idir_lbl ldir_lbl.
            ENABLE user_env[2] 
                   btn_dir 
                   inclob 
                   user_env[30] 
                   btn_dir2 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel.
            ASSIGN err% = INTEGER(user_env[4]).
    
            UPDATE user_env[2] 
                   btn_dir 
                   inclob 
                   user_env[30] 
                   btn_dir2 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
            &ELSE
            
            ENABLE user_env[2] inclob user_env[30] err% do-screen btn_OK btn_Cancel.
            ASSIGN err% = INTEGER(user_env[4]).
    
            UPDATE user_env[2] 
                   inclob 
                   user_env[30] 
                   err%
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
            &ENDIF
            
            ASSIGN user_env[6] = (IF do-screen THEN "s" ELSE "f").
    
            RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).
            RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[30]).
            
            DISPLAY user_env[2] user_env[30].
            user_env[4] = STRING(err%).
    
            { prodict/dictnext.i trash }
            canned = FALSE.
     
        end. /* not isAnyMultitenant */
    END. /* do on error */
  END. /* not io-file */
  ELSE DO:
    
    if isAnyMultitenant then
    do WITH FRAME read-d-file-mt:
         {adecomm/okrun.i  
         &FRAME  = "FRAME read-d-file-mt" 
         &BOX    = "rect_Btns"
         &OK     = "btn_OK" 
         {&CAN_BTN}
         {&HLP_BTN}
        }
        
        assign 
            UseDefaultDirs = true
            user_env[32]  = get-effective-tenant-name("dictdb")
            err% = INTEGER(user_env[4])
            gFileName = user_env[2].
              
        refreshFileDefaults(). 
        
        display user_env[32] 
                UseDefaultDirs
                user_env[2] 
                user_env[30] 
                err%
                inclob.
              
        DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
          &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
            ENABLE user_env[32]
                   btn_tenant 
                   UseDefaultDirs 
                   RootDirectory
                   user_env[2] 
                   btn_File 
                   inclob 
                   user_env[30] 
                   btn_dir 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
    
            &ELSE
             
            ENABLE user_env[32]  
                   btn_Tenant
                   UseDefaultDirs 
                   RootDirectory
                   user_env[2]  
                   btn_File 
                   inclob 
                   user_env[30] 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
    
           &ENDIF
           
           refreshFileMTState().
            
           wait-for "go" of frame read-d-file-mt.
           /* danger danger: this must be qualified to use the frame of the 
              do block (it is possible that the frame qual only is needed on the first field) */ 
           ASSIGN  frame read-d-file-mt do-screen 
                   frame read-d-file-mt user_env[32]
                   frame read-d-file-mt user_env[2]                   
                   frame read-d-file-mt user_env[30]
                   frame read-d-file-mt err% 
                   user_env[4] = STRING(err%) 
                   user_env[6] = (IF do-screen THEN "s" ELSE "f").
           if UseDefaultDirs then
           do:
               user_env[33] = gUseDefaultOut.
               user_env[40] = gLobfolderName.
           end.
           else 
              user_env[40] = "".
           { prodict/dictnext.i trash }
          canned = FALSE.
    
       END.
    end. /* if multitenant */
    else do:
        {adecomm/okrun.i  
         &FRAME  = "FRAME read-d-file" 
         &BOX    = "rect_Btns"
         &OK     = "btn_OK" 
         {&CAN_BTN}
         {&HLP_BTN}
        }
    
        DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-d-file:
          &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
            ENABLE user_env[2]  btn_File inclob user_env[30] btn_dir err% do-screen btn_OK btn_Cancel.
            ASSIGN err% = INTEGER(user_env[4]).
    
            UPDATE user_env[2] 
                   btn_File 
                   inclob 
                   user_env[30] 
                   btn_dir 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
    
              &ELSE
           ENABLE user_env[2]  
                  btn_File 
                  inclob 
                  user_env[30] 
                  err% 
                  do-screen 
                  btn_OK 
                  btn_Cancel.
            ASSIGN err% = INTEGER(user_env[4]).
    
            UPDATE user_env[2]  
                   btn_File 
                   inclob 
                   user_env[30] 
                   err% 
                   do-screen 
                   btn_OK 
                   btn_Cancel  
                   {&HLP_BTN_NAME}.
          &ENDIF
          
            DISPLAY user_env[2].
            ASSIGN user_env[4] = STRING(err%)
                   user_env[6] = (IF do-screen THEN "s" ELSE "f").
    
            { prodict/dictnext.i trash }
            canned = FALSE.
       END.
    end. /* if multitenant */
  END. /* else (io-file) */    
END. /* ELSE IF io-frame = "d" */

ELSE DO:
  IF class = "t" THEN DO:
    {adecomm/okrun.i
      &FRAME  = "FRAME read-dir-text"
      &BOX    = "rect_Btns"
      &OK     = "btn_OK"
      {&CAN_BTN}
      {&HLP_BTN}
    }
    DO ON ERROR UNDO, RETRY ON ENDKEY UNDO, LEAVE WITH FRAME read-dir-text:
      io-title = "Load Audit Policies - Text".
                        
      UPDATE user_env[2]
             &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
               btn_dir
             &ENDIF
             user_commit
             btn_OK
             btn_Cancel
             {&HLP_BTN_NAME}.
    
      RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).
      {prodict/dictnext.i trash}
      canned = FALSE.
    END.
  END.
  ELSE IF class = "x" THEN DO:
    {adecomm/okrun.i  
      &FRAME  = "FRAME read-xml-file" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
    }
    DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-xml-file:

      io-title = "Load Audit Policies - XML".

      UPDATE user_env[2] 
             btn_File 
             user_overwrite 
             user_commit
             btn_OK 
             btn_Cancel 
             {&HLP_BTN_NAME}.

      { prodict/dictnext.i trash }
      canned = FALSE.
    END.
  END.
  ELSE IF CAN-DO("i,o,e",class) THEN DO:
    {adecomm/okrun.i  
      &FRAME  = "FRAME read-d-file-nobl" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
    }
    DO ON ERROR UNDO, RETRY ON ENDKEY UNDO, LEAVE WITH FRAME read-d-file-nobl:
      CASE class:
        WHEN "i" THEN
          io-title = "Load Database Identification Properties".
        WHEN "o" THEN
          io-title = "Load Database Options".
        WHEN "e" THEN
          io-title = "Load Application Audit Events".
      END CASE.
      
      UPDATE user_env[2]
             btn_file
             err% 
             do-screen
             btn_OK
             btn_Cancel
             {&HLP_BTN_NAME}.
             
      ASSIGN user_env[4] = STRING(err%).  /* PSC00267783 - load Application Audit Events fails with 100% Acceptable Error Percentage */
      
      /* the ostodir call is not required for these 3 load operations which require file-name as input. */
      /*RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).*/

      {prodict/dictnext.i trash}
      canned = FALSE.
    END.
  END.
  ELSE IF CAN-DO("z,m,y",class) THEN DO:
    {adecomm/okrun.i  
      &FRAME  = "FRAME read-input-dir" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
    }
    DO ON ERROR UNDO, RETRY ON ENDKEY UNDO, LEAVE WITH FRAME read-input-dir:
      CASE class:
        WHEN "z" THEN
          io-title = "Load Security Domains" /* Security Authentication Records" */ .        
        WHEN "m" THEN
          io-title = "Load Security Permissions".
        WHEN "y" THEN
          io-title = "Load Audit Data".
      END CASE.

      UPDATE user_env[2]
             &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
               btn_dir 
             &ENDIF
             btn_OK
             btn_Cancel
             {&HLP_BTN_NAME}.
 
      RUN "prodict/misc/ostodir.p" (INPUT-OUTPUT user_env[2]).
      {prodict/dictnext.i trash}
      canned = FALSE.
    END.
  END.
  else if class = "k" and isSuperTenant then
  DO ON ERROR UNDO, RETRY ON ENDKEY UNDO, LEAVE WITH FRAME read-d-seq-mt:
    
      {adecomm/okrun.i  
        &FRAME  = "FRAME read-d-seq-mt" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
       }
      assign 
          UseDefaultDirs = true
          user_env[32]  = get-effective-tenant-name("dictdb")
          gFileName = user_env[2].
              
      refreshSeqDefaults().  
      display 
          user_env[32]
          UseDefaultDirs
          user_env[2]. 
      
      enable user_env[32]
             btn_Tenant
             UseDefaultDirs
             RootDirectory
           &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
             btn_DirRoot 
           &ENDIF 
             user_env[2] 
             btn_File      
             btn_OK 
             btn_Cancel
             {&HLP_BTN_NAME}.
          
      refreshSeqMTState().
      wait-for "go" of frame read-d-seq-mt.
      /* danger danger: this must be qualified to use the frame of the do block 
        (it is possible that the frame qual only is needed on the first field) */     
      assign 
          frame read-d-seq-mt user_env[32]
          frame read-d-seq-mt user_env[2].        
      
      { prodict/dictnext.i trash }
      canned = FALSE.
     
  end.
  ELSE DO:
    {adecomm/okrun.i  
      &FRAME  = "FRAME read-input" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
    }

    DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME read-input:

      UPDATE user_env[2] btn_File btn_OK btn_Cancel {&HLP_BTN_NAME}.

      { prodict/dictnext.i trash }
      canned = FALSE.
    END.
  END.
END.
 
HIDE FRAME read-input NO-PAUSE.
HIDE FRAME read-df    NO-PAUSE.
HIDE FRAME read-d-file NO-PAUSE.
HIDE FRAME read-d-file-nobl NO-PAUSE.
HIDE FRAME read-xml-file NO-PAUSE.
HIDE FRAME read-d-dir NO-PAUSE.
HIDE FRAME read-input-dir NO-PAUSE.
HIDE FRAME read-dir-text NO-PAUSE.
HIDE FRAME read-dir-nobl NO-PAUSE.
HIDE FRAME get-cp NO-PAUSE.
 
IF canned THEN DO:
  user_path = "".
  IF no-schema-lock THEN
      ASSIGN SESSION:SCHEMA-CHANGE = oldsession.
END.
RETURN.

 

/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrlrec.p - build a new .d from existing .d when .e contains errors 
   History:  D. McMann 04/13/00 Added support for long path names
             D. McMann 06/07/00 Added check for quoter.

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE canned     AS LOGICAL   NO-UNDO INIT TRUE.
DEFINE VARIABLE answer     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE dot_d_file AS CHARACTER NO-UNDO.
DEFINE VARIABLE dot_e_file AS CHARACTER NO-UNDO.
DEFINE VARIABLE scrap      AS CHARACTER NO-UNDO.
DEFINE VARIABLE third_file AS CHARACTER NO-UNDO.
DEFINE VARIABLE msgReco1   AS CHARACTER VIEW-AS EDITOR NO-BOX INNER-CHARS 70 INNER-LINES 4 NO-UNDO.
{prodict/misc/filesbtn.i &NAME = btn_File_d}
{prodict/misc/filesbtn.i &NAME = btn_File_e &NOACC=yes}
{prodict/misc/filesbtn.i &NAME = btn_File_third &NOACC=yes}

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 5 NO-UNDO INITIAL [
  /* 1*/ "A file already exists named:",
  /* 2*/ "Overwrite it?",
  /* 3*/ "error.d", /* it would not be a good idea to change this name here */
  /* 4*/ "Can not find",
  /* 5*/ "file with this name."
].

&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
  &GLOBAL-DEFINE LINEUP 20
  &GLOBAL-DEFINE FILLCH 35
&ELSE
  &GLOBAL-DEFINE LINEUP 20
  &GLOBAL-DEFINE FILLCH 37
&ENDIF

FORM
 
&IF "{&WINDOW-SYSTEM}" <> "TTY" 
&THEN
   SKIP({&TFM_WID})
  msgReco1 NO-LABEL AT 2 SKIP ({&VM_WIDG})
&ELSE
  "When a data load encounters errors, an error file is produced." 
                                         AT 2   VIEW-AS TEXT        SKIP({&VM_WID})
  "This utility takes the error file and the original data file"
                                         AT 2   VIEW-AS TEXT        SKIP({&VM_WID})
  "and produces a new data file with only the bad records.  This"
                                         AT 2   VIEW-AS TEXT        SKIP({&VM_WID})
  "new file can then be edited and reloaded."                   
                                         AT 2    VIEW-AS TEXT  SKIP({&VM_WIDG})
&ENDIF
  dot_d_file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 
        LABEL "Original Data File" COLON {&LINEUP}
  btn_File_d SKIP ({&VM_WIDG})

  dot_e_file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH} BY 1
         LABEL "Error File" COLON {&LINEUP}
 btn_File_e SKIP ({&VM_WIDG})
  third_file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH} BY 1
        LABEL "Output Data File" COLON {&LINEUP}
  btn_File_third SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}

  WITH FRAME recovery 
  CENTERED  SIDE-LABELS 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Reconstruct Bad Load Records".

&IF "{&WINDOW-SYSTEM}" <> "TTY" 
&THEN
ASSIGN msgReco1:SCREEN-VALUE =
  "When a data load encounters errors, an error file is produced. " +
  "This utility takes the error file and the original data file " +
  "and produces a new data file with only the bad records.  This " +
  "new file can then be edited and reloaded.".
msgReco1:READ-ONLY = yes.
&ENDIF
  
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame recovery
   or CHOOSE of btn_Help in frame recovery
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Reconstruct_Bad_Load_Records_Dlg_Box},
                                               INPUT ?).
&ENDIF


ON GO OF FRAME recovery
DO:
  if SEARCH(dot_d_file:SCREEN-VALUE IN FRAME recovery) = ? THEN DO:
    MESSAGE new_lang[4] ".d" new_lang[5]
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO dot_d_file IN FRAME recovery.
    RETURN NO-APPLY.
  END.

  if SEARCH(dot_e_file:SCREEN-VALUE IN FRAME recovery) = ? THEN DO:
    MESSAGE new_lang[4] ".e" new_lang[5]
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO dot_e_file IN FRAME recovery.
    RETURN NO-APPLY.
  END.

  IF SEARCH(third_file:SCREEN-VALUE IN FRAME recovery) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[1] SKIP third_file:SCREEN-VALUE SKIP(1) new_lang[2]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO third_file IN FRAME recovery.
      RETURN NO-APPLY.
    END.
  END.
END.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in ------*/
ON LEAVE OF dot_d_file in frame recovery
   dot_d_file:screen-value in frame recovery = 
        TRIM(dot_d_file:screen-value in frame recovery).
ON LEAVE OF dot_e_file in frame recovery
   dot_e_file:screen-value in frame recovery = 
        TRIM(dot_e_file:screen-value in frame recovery).
ON LEAVE OF third_file in frame recovery
   third_file:screen-value in frame recovery = 
        TRIM(third_file:screen-value in frame recovery).

/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File_d in frame recovery DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT dot_d_file:handle in frame recovery /*Fillin*/,
        INPUT "Find Data File"  /*Title*/,
        INPUT "*.d"             /*Filter*/,
        INPUT yes               /*Must exist*/).
END.
ON CHOOSE of btn_File_e in frame recovery DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT dot_e_file:handle in frame recovery /*Fillin*/,
        INPUT "Find Error File"  /*Title*/,
        INPUT "*.e"             /*Filter*/,
        INPUT yes               /*Must exist*/).
END.
ON CHOOSE of btn_File_third in frame recovery DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT third_file:handle in frame recovery /*Fillin*/,
        INPUT "Specify New Data File"  /*Title*/,
        INPUT "*.d"             /*Filter*/,
        INPUT no                /*Must exist*/).
END.
/*----- WINDOW-CLOSE --------*/
ON WINDOW-CLOSE OF FRAME recovery
   APPLY "END-ERROR" to frame recovery.
      


/*============================Mainline code===============================*/
IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DO: 
  IF SEARCH("quoter.exe") = ? THEN DO:
    MESSAGE "Unable to find the quoter utility.  Make sure that" SKIP
            "{&PRO_DISPLAY_NAME}' bin directory is in your PATH." SKIP
    VIEW-AS ALERT-BOX ERROR.
    ASSIGN user_path = "".
    RETURN.
  END.
END.
ELSE  IF OPSYS = "UNIX" THEN DO: 
  IF SEARCH("quoter") = ? THEN DO:
    MESSAGE "Unable to find the quoter utility.  Make sure that" SKIP
            "{&PRO_DISPLAY_NAME}' bin directory is in your PATH." SKIP
    VIEW-AS ALERT-BOX ERROR.
    ASSIGN user_path = "".
    RETURN.
  END.
END.

ASSIGN
  third_file = new_lang[3]. /* "error.d" */

/* Adjust the graphical rectangle and the ok and cancel buttons */
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN   
    { prodict/user/userctr.i
        &FRAME = "FRAME recovery"
    }
&ENDIF
    {adecomm/okrun.i  
        &FRAME  = "FRAME recovery" 
        &BOX    = "rect_Btns"
        &OK     = "btn_OK" 
        {&CAN_BTN}
        {&HLP_BTN}
    }

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ENABLE msgReco1 WITH FRAME recovery.
&ENDIF
DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  UPDATE dot_d_file btn_File_d dot_e_file btn_File_e third_file btn_File_third
               btn_OK btn_Cancel {&HLP_BTN_NAME}
               WITH FRAME recovery.
  ASSIGN
    user_env[1] = SEARCH(dot_d_file)
    user_env[2] = SEARCH(dot_e_file)
    user_env[3] = third_file.
  { prodict/dictnext.i scrap }

  canned = FALSE.
END.

IF canned THEN
  user_path = "".
HIDE FRAME recovery NO-PAUSE.
HIDE MESSAGE NO-PAUSE.
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrpfed.p - .pf editor */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

{prodict/user/userpfed.i NEW} /* Contains arg_xxx variables and pf_file */

DEFINE STREAM pf.
DEFINE VARIABLE canned	  AS LOGICAL   INITIAL TRUE    NO-UNDO.
DEFINE VARIABLE arg_int	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE arg_log	  AS LOGICAL		       NO-UNDO.
DEFINE VARIABLE c	  AS CHARACTER		       NO-UNDO.
DEFINE VARIABLE go_list	  AS CHARACTER		       NO-UNDO.
DEFINE VARIABLE i	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE k	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE lin	  AS CHARACTER		       NO-UNDO.
DEFINE VARIABLE p_down	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE p_draw	  AS LOGICAL   INITIAL TRUE    NO-UNDO.
DEFINE VARIABLE p_flow	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE p_init	  AS INTEGER   INITIAL ?       NO-UNDO.
DEFINE VARIABLE p_line	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE p_ptr	  AS INTEGER   INITIAL 1       NO-UNDO.
DEFINE VARIABLE p_spot	  AS INTEGER		       NO-UNDO.
DEFINE VARIABLE pf_name	  AS CHARACTER		       NO-UNDO.
DEFINE VARIABLE tru_txt	  AS CHARACTER		       NO-UNDO.
DEFINE VARIABLE comment   AS CHARACTER EXTENT {&COMM#} NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER                 NO-UNDO.
{prodict/misc/filesbtn.i}

&IF "{&OPSYS}" <> "MSDOS" and "{&OPSYS}" <> "WIN32" &THEN
    &SCOPED-DEFINE SLASH /
&ELSE
    &SCOPED-DEFINE SLASH ~~~\
&ENDIF

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 3 NO-UNDO INITIAL [
  /*1,2*/ "Last update: Date", "Time",
  /*  3*/ "Please enter a file name."
].

form
    skip(1)
  pf_name
    at 3
    label "Parameter file"
    format "x(50)" skip
  k
    at 3
    label " Reading line "
    skip(1)
  with frame lreading 
       width 70
       row 5 centered
       overlay
       side-labels USE-TEXT VIEW-AS DIALOG-BOX THREE-D
       TITLE "Reading in pf file".
       

form
    skip(1)
  pf_file
    at 3
    label "Parameter file"
    format "x(50)" skip
  k
    at 3
    label " Writing line "
    skip(1)
  with frame lwriting 
       width 70
       row 5 centered
       overlay
       side-labels USE-TEXT VIEW-AS DIALOG-BOX THREE-D.

FORM SKIP({&TFM_WID})
  pf_file {&STDPH_FILL} LABEL "&Parameter File" FORMAT "x(80)" AT 2 
	VIEW-AS FILL-IN SIZE 40 BY 1
  btn_File
  {prodict/user/userbtns.i}
  WITH FRAME pf_name
  SIDE-LABELS ATTR-SPACE CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Parameter File Name".

FORM
  "Enter comments to be included in the parameter file." SKIP(1)
  arg_comm[ 1] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 2] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 3] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 4] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 5] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 6] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 7] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 8] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[ 9] FORMAT "x({&COMM_LEN})" SKIP
  arg_comm[10] FORMAT "x({&COMM_LEN})" SKIP
  {prodict/user/userbtns.i}
  WITH FRAME comments 
  CENTERED ATTR-SPACE NO-LABELS 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE ' Parameter File "' + pf_file + '" '.

FORM
  arg_nam[p_ptr] FORMAT "x({&PNAME_LEN})" NO-ATTR-SPACE
  arg_val[p_ptr] FORMAT "x({&VAL_CHARS})" HELP "Enter value"
  WITH FRAME pick SCROLL 1 OVERLAY NO-LABELS ATTR-SPACE 
  p_down DOWN ROW 3 COLUMN 1 TITLE " " + pf_file + " ".

FORM
  arg_int FORMAT ">>>,>>>,>>9" HELP "Enter ? to leave blank"
  WITH FRAME pick_int OVERLAY NO-LABELS ATTR-SPACE NO-BOX
  ROW 3 + FRAME-LINE(pick) COLUMN {&VAL_START}.

FORM
  arg_log FORMAT "yes/no" HELP "Enter ~"yes~" to set, else ~"no~""
  WITH FRAME pick_log OVERLAY NO-LABELS ATTR-SPACE NO-BOX
  ROW 3 + FRAME-LINE(pick) COLUMN {&VAL_START}.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
/* This is the only interactive frame that is used in GUI environment */
on HELP of frame pf_name
   or CHOOSE of btn_Help in frame pf_name
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Parameter_File_Name_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


ON GO OF FRAME pf_name
DO:
  IF pf_file:SCREEN-VALUE IN FRAME pf_name = "" THEN DO:
    MESSAGE new_lang[3] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
  ELSE DO:
    DEF VAR d AS CHAR NO-UNDO.
    DEF VAR f AS CHAR NO-UNDO.

    ASSIGN pf_file.
    IF R-INDEX(pf_file,"{&SLASH}") > 0 THEN DO: /* has a slash */
      ASSIGN f = SUBSTRING(pf_file,R-INDEX(pf_file,"{&SLASH}") + 1,-1,"CHARACTER":U) /* filename  */
             d = SUBSTRING(pf_file,1,R-INDEX(pf_file,"{&SLASH}") - 1).               /* directory */
      FILE-INFO:FILE-NAME = d.
      IF FILE-INFO:FULL-PATHNAME EQ ? THEN DO:
        MESSAGE "The directory specified does not exist." VIEW-AS ALERT-BOX ERROR. /* bad directory */
        APPLY "ENTRY" TO pf_file.
        RETURN NO-APPLY.
      END.
      IF INDEX(FILE-INFO:FILE-TYPE,"D") = 0 THEN DO:
        MESSAGE d "is not a valid directory." VIEW-AS ALERT-BOX ERROR. /* bad directory */
        APPLY "ENTRY" TO pf_file.
        RETURN NO-APPLY.
      END.
    END.
    ELSE f = pf_file.
    
    IF CAN-DO("MSDOS,WIN32",OPSYS) THEN DO: /* Check 8.3 requirement */
      IF R-INDEX(f,".") > 0 THEN DO:
        IF (LENGTH(SUBSTRING(f,1,R-INDEX(f,".") - 1)) > 8)                OR
           (LENGTH(SUBSTRING(f,R-INDEX(f,".") + 1,-1,"CHARACTER":U)) > 3) OR
           (LENGTH(f) = 0 )                                                     THEN DO:
          MESSAGE "Invalid filename specified." VIEW-AS ALERT-BOX ERROR.
          APPLY "ENTRY" TO pf_file.
          RETURN NO-APPLY.
        END.
      END.
      ELSE IF LENGTH(f) > 8 THEN DO:
        MESSAGE "A filename cannot exceed 8 characters on MSDOS." VIEW-AS ALERT-BOX ERROR.
        APPLY "ENTRY" TO pf_file.
        RETURN NO-APPLY.
      END.
    END.
    IF LENGTH(f) < 1        OR 
       LENGTH(f) > 59       OR
       LENGTH(pf_file) < 1  OR
       LENGTH(pf_file) > 59 THEN DO:
      MESSAGE "Invalid filename specified." VIEW-AS ALERT-BOX ERROR.
      APPLY "ENTRY" TO pf_file.
      RETURN NO-APPLY.
    END.
  END.     
END.

/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btn_File in frame pf_name DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT pf_file:handle in frame pf_name /*Fillin*/,
        INPUT "Find Parameter File"  /*Title*/,
        INPUT "*.pf"               /*Filter*/,
        INPUT no                 /*Must exist*/).
END.
/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF pf_file in frame pf_name
   pf_file:screen-value in frame pf_name = 
        TRIM(pf_file:screen-value in frame pf_name).

ON WINDOW-CLOSE OF FRAME pf_name
   APPLY "END-ERROR" TO FRAME pf_name.


/*============================Mainline code===============================*/

/* the PROGRESS default truth for logicals */
tru_txt = STRING(TRUE).  /* will automatically match language */

/* Translate the arg_nam array into: 
   arg_lst - all parm names (-B) strung out in a comma delimited list
   arg_nam - array of arg name/description pairs (e.g., -B   Buffers)
   arg_typ - array of argument data types (l, c, n)
   arg_val - array of values - the default value is set here.
*/
DO WHILE arg_nam[args# + 1] <> "":
  ASSIGN
    args#          = args# + 1
    arg_lst        = arg_lst + (IF args# = 1 THEN "" ELSE ",")
                   + ENTRY(1,arg_nam[args#])
    arg_typ[args#] = ENTRY(3,arg_nam[args#])
    arg_nam[args#] = "-" + STRING(ENTRY(1,arg_nam[args#]),"x({&PKEY_LEN})")
                   + ENTRY(2,arg_nam[args#])
    arg_val[args#] = (IF arg_typ[args#] = "l" THEN "no" ELSE "").
END.

SESSION:IMMEDIATE-DISPLAY = yes.

/* Determine the parameter file name */
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
      &FRAME  = "FRAME pf_name" 
      &BOX    = "rect_Btns"
      &OK     = "btn_OK" 
      {&CAN_BTN}
      {&HLP_BTN}
  }
  SET pf_file btn_File btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME pf_name.
  canned = FALSE.
END.
HIDE FRAME pf_name.
iF canned THEN RETURN.
canned = TRUE.  /* reset */

ASSIGN
  pf_name = SEARCH(pf_file)
  go_list = "*-UP,*-DOWN,*TAB,GO,END-ERROR,HOME,MOVE,END".

/* Read an existing file into the arg_comm and arg_xxx arrays. */
IF pf_name <> ? THEN DO:
  PAUSE 0.
  DISPLAY pf_name WITH FRAME lreading.
  run adecomm/_setcurs.p ("WAIT").
  IF OPSYS = "UNIX" THEN
    INPUT STREAM pf THROUGH VALUE(SEARCH("quoter")) "<" VALUE(pf_name) NO-MAP.
  ELSE DO:
    RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
    RUN "prodict/misc/osquoter.p" (pf_name,?,?,tmpfile).
    INPUT STREAM pf FROM VALUE(tmpfile) NO-ECHO NO-MAP.
  END.
  REPEAT:
    k = k + 1.
    DISPLAY k WITH FRAME lreading.
    IMPORT STREAM pf lin.
    /* '##' lines are purged */
    IF lin BEGINS "# " AND NOT lin BEGINS "##" AND arg_comm# < {&COMM#} THEN 
      ASSIGN
        arg_comm# = arg_comm# + 1
        arg_comm[arg_comm#] = SUBSTRING(lin,3).
    IF INDEX(lin,"#") > 0 THEN lin = SUBSTRING(lin,1,INDEX(lin,"#") - 1).
    lin = TRIM(lin).
    DO WHILE SUBSTRING(lin,1,1) = "-":
      ASSIGN
        c   = SUBSTRING(lin,2,INDEX(lin + " "," ") - 2)
        lin = TRIM(SUBSTRING(lin,LENGTH(c) + 2))
        i   = LOOKUP(TRIM(c),arg_lst).
      IF i >= 1 AND i <= args# THEN DO:
        arg_val[i] = tru_txt.
        IF arg_typ[i] <> "l" THEN ASSIGN
          arg_val[i] = SUBSTRING(lin,1,INDEX(lin + " "," ") - 1)
          lin        = TRIM(SUBSTRING(lin,LENGTH(arg_val[i]) + 1)).
      END.
    END.
  END.
  INPUT STREAM pf CLOSE.
  IF OPSYS <> "UNIX" THEN OS-DELETE VALUE(tmpfile).
  run adecomm/_setcurs.p ("").
  HIDE FRAME lreading NO-PAUSE.
END.

ASSIGN
  pf_file = (IF pf_name = ? THEN pf_file ELSE pf_name)
  p_ptr   = 1
  p_down  = MINIMUM(args#,SCREEN-LINES - 8).

/* This is the UI section - allowing users to modify values */
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  DO WHILE TRUE WITH FRAME pick:
  
    p_ptr = MINIMUM(args#,MAXIMUM(p_ptr,1)).
  
    IF p_draw THEN DO:
      ASSIGN
	p_line = MAXIMUM(1,FRAME-LINE)
	p_spot = p_ptr - (IF p_init = ? THEN p_line ELSE p_init) + 1.
      UP p_line - 1.
      IF p_spot < 1 THEN ASSIGN
	p_spot = 1
	p_line = 1
	p_ptr  = 1.
      DO p_flow = p_spot TO p_spot + p_down - 1:
	IF p_flow > args# THEN DO:
	  CLEAR NO-PAUSE.
	END.
	ELSE DO:
	  DISPLAY
	    arg_nam[p_flow] @ arg_nam[p_ptr]
	    arg_val[p_flow] @ arg_val[p_ptr].
	END.
	IF p_flow < p_spot + p_down - 1 THEN DOWN 1.
      END.
      p_line = (IF p_init = ? THEN p_line ELSE p_init).
      UP p_down - p_line.
      ASSIGN
	p_init = ?
	p_draw = FALSE.
    END.
  
    DISPLAY arg_nam[p_ptr].
    IF arg_typ[p_ptr] = "c" THEN UPDATE arg_val[p_ptr]
      EDITING:
	READKEY.
	APPLY (IF CAN-DO(go_list,KEYFUNCTION(LASTKEY))
	  THEN KEYCODE(KBLABEL("GO")) ELSE LASTKEY).
      END.
    IF arg_typ[p_ptr] = "n" THEN DO WITH FRAME pick_int:
      arg_int = (IF arg_val[p_ptr] = "" THEN ? ELSE INTEGER(arg_val[p_ptr])).
      PAUSE 0.
      UPDATE arg_int EDITING:
	READKEY.
	APPLY (IF CAN-DO(go_list,KEYFUNCTION(LASTKEY))
	  THEN KEYCODE(KBLABEL("GO")) ELSE LASTKEY).
	END.
      HIDE NO-PAUSE.
      arg_val[p_ptr] = (IF arg_int = ? THEN "" ELSE STRING(arg_int)).
    END.
    IF arg_typ[p_ptr] = "l" THEN DO WITH FRAME pick_log:
      arg_log = arg_val[p_ptr] = tru_txt.
      PAUSE 0.
      UPDATE arg_log EDITING:
	READKEY.
	APPLY (IF CAN-DO(go_list,KEYFUNCTION(LASTKEY))
	  THEN KEYCODE(KBLABEL("GO")) ELSE LASTKEY).
	END.
      HIDE NO-PAUSE.
      arg_val[p_ptr] = STRING(arg_log).
    END.
    DISPLAY arg_val[p_ptr] WITH FRAME pick.
  
    IF CAN-DO("RETURN,CURSOR-DOWN,TAB",KEYFUNCTION(LASTKEY))
      AND p_ptr < args# THEN DO:
      p_ptr = p_ptr + 1.
      IF FRAME-LINE = FRAME-DOWN THEN
	SCROLL UP.
      ELSE
	DOWN.
    END.
    ELSE
    IF CAN-DO("CURSOR-UP,BACK-TAB",KEYFUNCTION(LASTKEY)) AND p_ptr > 1 THEN DO:
      p_ptr = p_ptr - 1.
      IF FRAME-LINE = 1 THEN
	SCROLL DOWN.
      ELSE
	UP.
    END.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN ASSIGN
      p_ptr  = p_ptr + p_down
      p_draw = TRUE.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN ASSIGN
      p_ptr  = p_ptr - p_down
      p_draw = TRUE.
    ELSE
    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND p_ptr > 1 THEN DO:
      ASSIGN
	p_ptr  = 1
	p_draw = TRUE.
      UP FRAME-LINE - 1.
    END.
    ELSE
    IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
      ASSIGN
	p_ptr  = args#
	p_draw = TRUE.
      DOWN p_down - FRAME-LINE.
    END.
    ELSE
    IF CAN-DO("GO,END-ERROR",KEYFUNCTION(LASTKEY)) THEN LEAVE.
  
    p_line = 1.
  END.
  
  HIDE FRAME pick NO-PAUSE.
  IF KEYFUNCTION(LASTKEY) <> "END-ERROR" THEN DO:
  
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
         {adecomm/okrun.i  
            &FRAME  = "FRAME comments" 
            &BOX    = "rect_Btns"
            &OK     = "btn_OK" 
            {&CAN_BTN}
            {&HLP_BTN}
         }
         UPDATE TEXT(arg_comm[1 FOR {&COMM#}]) 
      	        btn_OK btn_Cancel {&HLP_BTN_NAME}
      	       	WITH FRAME comments. 
         canned = FALSE.
    END.
    HIDE FRAME comments NO-PAUSE.
    arg_comm# = 0.
    DO i = 1 TO {&COMM#}:
      IF arg_comm[i] <> "" THEN arg_comm# = arg_comm# + 1.
    END.
  END.
&ELSE
   RUN "prodict/gui/_guipfed.p" (OUTPUT canned).
&ENDIF

IF NOT canned THEN DO:
  /* Write new values out to parameter file */
  k = 0.
  PAUSE 0.
  DISPLAY pf_file WITH FRAME lwriting.
  run adecomm/_setcurs.p ("WAIT").
  OUTPUT STREAM pf TO VALUE(pf_file) NO-ECHO NO-MAP.

  IF arg_comm# > 0 THEN DO:
    PUT STREAM pf UNFORMATTED
      "##" FILL("-",{&COMM_LEN} + 4) SKIP
      "## " new_lang[1] /* date */ " " STRING(TODAY)
        " " new_lang[2] /* time */ " " STRING(TIME,"HH:MM:SS") SKIP.
    DO i = 1 TO {&COMM#}:
      IF arg_comm[i] <> "" THEN PUT STREAM pf UNFORMATTED "# " arg_comm[i] SKIP.
    END.
    PUT STREAM pf UNFORMATTED "##" FILL("-",{&COMM_LEN} + 4) SKIP.
  END.
  DO i = 1 TO args#:
    IF (arg_typ[i] = "l" AND arg_val[i] = "no") OR arg_val[i] = "" THEN NEXT.
    IF arg_typ[i] = "l" THEN arg_val[i] = "".
    k = k + 1.
    DISPLAY k WITH FRAME lwriting.
    PUT STREAM pf UNFORMATTED 
      "-" STRING(ENTRY(i,arg_lst),"x({&PKEY_LEN})") arg_val[i].
    IF LENGTH(arg_val[i]) > 50 THEN DO:
      PUT STREAM pf UNFORMATTED SKIP SPACE(55).
      k = k + 1.
    END.
    ELSE
      PUT STREAM pf UNFORMATTED 
      	 FILL(" ", 80 - {&PNAME_LEN} - LENGTH(arg_val[i]) - 3).
    PUT STREAM pf UNFORMATTED 
      "#" SUBSTRING(LC(arg_nam[i]),{&PKEY_LEN} + 1,{&PDESC_LEN} + 1) SKIP.
  END.
  OUTPUT STREAM pf CLOSE.
  run adecomm/_setcurs.p ("").
  HIDE FRAME lwriting NO-PAUSE.
END.

SESSION:IMMEDIATE-DISPLAY = no.
RETURN.




/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *                         *
**********************************************************************/

/* _usrpick.p - flexible 'pick' program */
/*
pik_chosen - list of chosen element ids (was pik_choice)
pik_column - column position of frame   (0 for default)
pik_count  - number of elements in      (was pik_chextent)
pik_down   - iterations of down frame   (usually 0 for default)
pik_first  - first element out or ?     (same as pik_list[pik_chosen[1]])
pik_hide   - hide frame when done?
pik_init   - initial value to position cursor
pik_list   - list of elements in        (was pik_chlist)
pik_multi  - can pick multiple?         (was pik_multiple)
pik_number - number the elements?       (only with pik_multi)
pik_return - number of elements chosen  (was pik_chcnt)
pik_row    - row position of frame      (0 for default)
pik_skip   - use 'skip number' option   (only with pik_number)
pik_title  - title of frame             (spaces prepended and appended)
pik_wide   - use wide frame?
*/

{ prodict/user/userhue.i }
{ prodict/user/userpik.i }

/*
DEFINE VARIABLE p_mark   AS CHARACTER           INITIAL ""   NO-UNDO.
DEFINE VARIABLE p_recid  AS INTEGER             INITIAL 1    NO-UNDO.
*/
DEFINE VARIABLE p_flag   AS INTEGER EXTENT 2000 INITIAL 0    NO-UNDO.
DEFINE VARIABLE p_flag#  AS INTEGER             INITIAL 0    NO-UNDO.
DEFINE VARIABLE p_init   AS INTEGER             INITIAL ?    NO-UNDO.
DEFINE VARIABLE p_line   AS INTEGER                          NO-UNDO.
DEFINE VARIABLE p_loop   AS INTEGER                          NO-UNDO.
DEFINE VARIABLE p_redraw AS LOGICAL             INITIAL TRUE NO-UNDO.
DEFINE VARIABLE p_spot   AS INTEGER                          NO-UNDO.
DEFINE VARIABLE p_typed  AS CHARACTER           INITIAL ""   NO-UNDO.

DEFINE VARIABLE highnum  AS INTEGER NO-UNDO. /* highest number used */
DEFINE VARIABLE read_tt  AS LOGICAL NO-UNDO.
DEFINE VARIABLE c_currName AS CHARACTER NO-UNDO.
DEFINE VARIABLE i_currFlag AS INTEGER NO-UNDO.

/*
FORM
  p_mark            FORMAT "x(3)" NO-ATTR-SPACE SPACE(0)
  pik_list[p_recid] FORMAT "x(32)"   ATTR-SPACE SPACE(0)
  WITH FRAME pick1 SCROLL 1 OVERLAY NO-LABELS NO-ATTR-SPACE
  pik_down DOWN ROW pik_row COLUMN pik_column
  TITLE COLOR VALUE(pick-fg) pik_title.
FORM
  p_mark            FORMAT "x(3)" NO-ATTR-SPACE SPACE(0)
  pik_list[p_recid] FORMAT "x(70)"   ATTR-SPACE SPACE(0)
  WITH FRAME pick2 SCROLL 1 OVERLAY NO-LABELS NO-ATTR-SPACE
  pik_down DOWN ROW pik_row COLUMN pik_column
  TITLE COLOR VALUE(pick-fg) pik_title.
*/

/*
FORM
  p_typed FORMAT "x(35)"
  WITH FRAME type1
  OVERLAY NO-LABELS ROW pik_row + pik_down + 2 COLUMN pik_column.
FORM
  p_typed FORMAT "x(72)"
  WITH FRAME type2
  OVERLAY NO-LABELS ROW pik_row + pik_down + 2 COLUMN pik_column.
*/

IF pik_count <= 0 THEN RETURN.

/* check if we have to read the temp-table */
ASSIGN read_tt = (CAN-FIND (FIRST ttpik)).

ASSIGN
  pik_number = pik_number AND pik_multi
  pik_skip   = pik_skip   AND pik_number.

IF pik_skip AND pik_list[1] <> "*SKIP UP" THEN DO:
  IF read_tt THEN DO:
      FOR EACH ttpik BY ttpik.i_number DESC:
          ttpik.i_number = ttpik.i_number + 2.
      END.
      CREATE ttpik.
      ASSIGN ttpik.i_number = 1
             ttpik.c_name = "*SKIP UP*".
      CREATE ttpik.
      ASSIGN ttpik.i_number = 2
             ttpik.c_name = "*SKIP DOWN*".
  END.
  ELSE DO p_recid = pik_count TO 1 BY -1:
    pik_list[p_recid + 2] = pik_list[p_recid].
  END.

  ASSIGN
    pik_list[1] = "*SKIP UP*"
    pik_list[2] = "*SKIP DOWN*"
    pik_count   = pik_count + 2
    nextnum     = 1.
  .
END.

IF pik_skip THEN DO:
  ASSIGN FRAME fskip:HIDDEN = no.
  IF pik_wide THEN 
    ASSIGN FRAME fskip:ROW = FRAME pick2:ROW
           FRAME fskip:COLUMN = FRAME pick2:COLUMN - FRAME fskip:WIDTH - 2.
  ELSE
    ASSIGN FRAME fskip:ROW = FRAME pick1:ROW
           FRAME fskip:COLUMN = FRAME pick1:COLUMN - FRAME fskip:WIDTH - 2.
END.
ELSE FRAME fskip:HIDDEN = yes.

ASSIGN
  pik_chosen = -1
  pik_return = 0
  pik_first  = ?
  pik_row    = (IF pik_row = 0    THEN 5 ELSE pik_row)
  pik_column = (IF pik_column = 0 THEN
               (IF pik_wide THEN 2 ELSE 42) ELSE pik_column)
  p_recid    = 1
  p_mark     = ""
  pik_down   = MINIMUM(pik_count,
               IF pik_wide THEN 12 ELSE SCREEN-LINES - 3 - pik_row).

IF pik_init <> "" THEN DO:
  IF read_tt THEN DO:
     FIND FIRST ttpik WHERE ttpik.c_name = pik_init NO-ERROR.
     IF AVAILABLE ttpik THEN 
        p_spot = ttpik.i_number.
     ELSE
        p_spot = pik_count + 1.
  END.
  ELSE DO p_spot = 1 TO pik_count:
    IF pik_init = pik_list[p_spot] THEN LEAVE.
  END.

  IF p_spot <= pik_count THEN ASSIGN
    p_init  = MINIMUM(pik_down,p_spot)
    p_recid = p_spot.
END.

_pick:
DO WHILE TRUE:

  p_recid = MINIMUM(pik_count,MAXIMUM(p_recid,1)).
  /*IF LENGTH(p_typed) > 0 THEN DO:
    PAUSE 0.
    IF pik_wide THEN
      DISPLAY p_typed WITH FRAME type2.
    ELSE
      DISPLAY p_typed WITH FRAME type1.
  END.
  ELSE DO:
    HIDE FRAME type1 NO-PAUSE.
    HIDE FRAME type2 NO-PAUSE.
  END.*/

  IF p_redraw THEN DO:
    IF pik_wide THEN
      VIEW FRAME pick2.
    ELSE
      VIEW FRAME pick1.
    ASSIGN
      p_line = MAXIMUM(1,
               IF pik_wide THEN FRAME-LINE(pick2) ELSE FRAME-LINE(pick1))
      p_spot = p_recid - (IF p_init = ? THEN p_line ELSE p_init) + 1.
    IF pik_wide THEN
      UP p_line - 1 WITH FRAME pick2.
    ELSE
      UP p_line - 1 WITH FRAME pick1.
    IF p_spot < 1 THEN ASSIGN
      p_spot  = 1
      p_line  = 1
      p_recid = 1.
    DO pik_return = p_spot TO p_spot + pik_down - 1:
      IF pik_return > pik_count THEN DO:
        IF pik_wide THEN
          CLEAR FRAME pick2 NO-PAUSE.
        ELSE
          CLEAR FRAME pick1 NO-PAUSE.
      END.
      ELSE DO:
       IF read_tt THEN DO:
           FIND FIRST ttpik WHERE ttpik.i_number = pik_return NO-LOCK.
           
           ASSIGN p_mark = (IF pik_number THEN STRING(ttpik.i_flag,">>>")
                            ELSE STRING(ttpik.i_flag > 0,"*/ "))
                  c_CurrName = ttpik.c_name.
       END.
       ELSE
        ASSIGN p_mark = (IF pik_number THEN STRING(p_flag[pik_return],">>>")
                         ELSE STRING(p_flag[pik_return] > 0,"*/ "))
               c_CurrName = pik_list[pik_return].

        IF highnum < INT(p_mark) THEN highnum = INT(p_mark).
        IF pik_wide THEN
           DISPLAY p_mark c_CurrName @ pik_list[p_recid] WITH FRAME pick2.
        ELSE
           DISPLAY p_mark c_CurrName @ pik_list[p_recid] WITH FRAME pick1.
      END.
      IF pik_return < p_spot + pik_down - 1 THEN
        IF pik_wide THEN
          DOWN 1 WITH FRAME pick2.
        ELSE
          DOWN 1 WITH FRAME pick1.
    END.
    p_line = (IF p_init = ? THEN p_line ELSE p_init).
    IF pik_wide THEN
      UP pik_down - p_line WITH FRAME pick2.
    ELSE
      UP pik_down - p_line WITH FRAME pick1.
    ASSIGN
      p_init     = ?
      pik_return = 0
      p_redraw   = FALSE.
  END.

  IF read_tt THEN DO:
      FIND FIRST ttpik WHERE ttpik.i_number = p_recid NO-LOCK.

      ASSIGN p_mark = (IF pik_number THEN STRING(ttpik.i_flag,">>>")
                       ELSE STRING(ttpik.i_flag > 0,"*/ "))
             c_CurrName = ttpik.c_name.
  END.
  ELSE
      ASSIGN p_mark = (IF pik_number THEN STRING(p_flag[p_recid],">>>")
                       ELSE STRING(p_flag[p_recid] > 0,"*/ "))
             c_CurrName = pik_list[p_recid].

  IF highnum < INT(p_mark) THEN highnum = INT(p_mark).

  IF pik_wide THEN
     DISPLAY p_mark c_CurrName @ pik_list[p_recid] WITH FRAME pick2.
  ELSE
     DISPLAY p_mark c_CurrName @ pik_list[p_recid] WITH FRAME pick1.

  IF pik_wide THEN
     COLOR DISPLAY VALUE(pick-bg) pik_list[p_recid] WITH FRAME pick2.
  ELSE
     COLOR DISPLAY VALUE(pick-bg) pik_list[p_recid] WITH FRAME pick1.

  READKEY.

  IF pik_wide THEN
     COLOR DISPLAY VALUE(pick-fg) pik_list[p_recid] WITH FRAME pick2.
  ELSE
     COLOR DISPLAY VALUE(pick-fg) pik_list[p_recid] WITH FRAME pick1.

  PAUSE 0.

  IF (KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND LASTKEY > 32)
    OR (KEYFUNCTION(LASTKEY) = "BACKSPACE" AND LENGTH(p_typed) > 0) THEN DO:
    p_typed = (IF KEYFUNCTION(LASTKEY) = "BACKSPACE"
              THEN SUBSTRING(p_typed,1,LENGTH(p_typed) - 1)
              ELSE p_typed + CHR(LASTKEY)).
    IF p_typed = "" OR c_CurrName BEGINS p_typed THEN NEXT.

    IF read_tt THEN DO:
        FIND FIRST ttpik WHERE ttpik.i_number >= p_recid AND 
            ttpik.c_name BEGINS p_typed NO-LOCK NO-ERROR.
        IF AVAILABLE ttpik THEN
            p_line = ttpik.i_number.
        ELSE
            p_line = pik_count + 1.
    END.
    ELSE DO:
        DO p_line = p_recid TO pik_count:
          IF pik_list[p_line] BEGINS p_typed THEN LEAVE.
        END.
    END.

    IF p_line > pik_count THEN DO:
      IF read_tt THEN DO:
         FIND FIRST ttpik WHERE ttpik.i_number < p_recid AND 
             ttpik.c_name BEGINS p_typed NO-LOCK NO-ERROR.
         IF AVAILABLE ttpik THEN
             p_line = ttpik.i_number.
         ELSE
             p_line = p_recid + 1.
      END.
      ELSE DO p_line = 1 TO p_recid:
        IF pik_list[p_line] BEGINS p_typed THEN LEAVE.
      END.

      IF p_line > p_recid THEN p_line = pik_count + 1.
    END.

    IF p_line > pik_count THEN DO:
      p_typed = CHR(LASTKEY).
      IF read_tt THEN DO:
         FIND FIRST ttpik WHERE ttpik.c_name BEGINS p_typed NO-LOCK NO-ERROR.
         IF AVAILABLE ttpik THEN
             p_line = ttpik.i_number.
         ELSE
             p_line = pik_count + 1.
      END.
      ELSE DO p_line = 1 TO pik_count:
        IF pik_list[p_line] BEGINS p_typed THEN LEAVE.
      END.
    END.
    p_spot = p_line - p_recid
           + (IF pik_wide THEN FRAME-LINE(pick2) ELSE FRAME-LINE(pick1)).
    IF p_line <= pik_count THEN p_recid = p_line.
    IF p_spot < 1 OR p_spot > pik_down THEN p_redraw = TRUE.
    ELSE
    IF pik_wide THEN
      UP FRAME-LINE(pick2) - p_spot WITH FRAME pick2.
    ELSE
      UP FRAME-LINE(pick1) - p_spot WITH FRAME pick1.
    NEXT.
  END.

  IF read_tt THEN DO:
      FIND FIRST ttpik WHERE ttpik.i_number = p_recid.
      ASSIGN c_currName = ttpik.c_name
             i_currFlag = ttpik.i_flag.
  END.
  ELSE
      ASSIGN c_currName = pik_list[p_recid]
             i_currFlag = p_flag[p_recid].

  p_typed = "".
  IF CAN-DO("RETURN,PICK",KEYFUNCTION(LASTKEY)) AND pik_multi THEN DO:
    IF pik_skip AND c_currName = "*SKIP UP*" THEN DO: /* skip up by 1 */
      p_flag# = p_flag# + 1.
      DISPLAY p_flag# + 1 @ nextnum WITH FRAME fskip.
    END.
    ELSE IF pik_skip AND c_currName = "*SKIP DOWN*" THEN DO:
      /* skip down by 1, but stop one above the highest number used */
      highnum = 0.
      IF read_tt THEN DO:
          FOR EACH ttpik NO-LOCK:
              IF highnum < ttpik.i_flag THEN highnum = ttpik.i_flag.
          END.
      END.
      ELSE DO p_line = 1 TO pik_count: /* look for highest used */
        IF highnum < p_flag[p_line] THEN highnum = p_flag[p_line].
      END.    
      IF p_flag#  > highnum THEN DO:  
        p_flag# = p_flag# - 1. /* decrement */
        DISPLAY p_flag# + 1 @ nextnum WITH FRAME fskip.
      END.
    END.
    ELSE /* flagging an item */
    IF NOT pik_number OR i_currFlag = 0 THEN DO:
      ASSIGN
        p_flag#         = p_flag# + (IF i_currFlag = 0 THEN 1 ELSE 0)
        i_currFlag = (IF i_currFlag = 0 THEN p_flag# ELSE 0).
        p_mark = (IF pik_number THEN STRING(i_currFlag,">>>")
                  ELSE STRING(i_currFlag > 0,"*/ ")).

      /* update the value */
      IF read_tt THEN DO:
         FIND FIRST ttpik WHERE ttpik.i_number = p_recid.
         ASSIGN ttpik.i_flag = i_currFlag.
      END.
      ELSE
         p_flag[p_recid] = i_currFlag.

      IF pik_skip THEN DISPLAY p_flag# + 1 @ nextnum WITH FRAME fskip.
      IF pik_wide THEN
        DISPLAY p_mark WITH FRAME pick2.
      ELSE
        DISPLAY p_mark WITH FRAME pick1.
    END.
    ELSE DO: /* if turning off and pik_number, then must renumber others */
      IF read_tt THEN DO:
          FOR EACH ttpik WHERE ttpik.i_flag > i_currFlag:
              ttpik.i_flag = ttpik.i_flag - 1.
          END.
      END.
      ELSE DO p_line = 1 TO pik_count:
        IF p_flag[p_line] > p_flag[p_recid] THEN
          p_flag[p_line] = p_flag[p_line] - 1.
      END.

      IF read_tt THEN DO:
          FIND FIRST ttpik WHERE ttpik.i_number = p_recid.
          ASSIGN ttpik.i_flag = 0.
      END.
      ELSE
        ASSIGN p_flag[p_recid] = 0.

       ASSIGN
        p_flag#         = p_flag# - 1
        p_spot = (IF pik_wide THEN FRAME-LINE(pick2) ELSE FRAME-LINE(pick1)).
      IF pik_skip THEN DISPLAY p_flag# + 1 @ nextnum WITH FRAME fskip.
      IF pik_wide THEN
        UP p_spot - 1 WITH FRAME pick2.
      ELSE
        UP p_spot - 1 WITH FRAME pick1.
      DO p_line = 1 TO pik_down:
        ASSIGN
          p_init = p_recid - p_spot + p_line.

        IF read_tt THEN DO:
            FIND FIRST ttpik WHERE ttpik.i_number = p_init.
            ASSIGN 
                p_mark = (IF pik_number THEN STRING(ttpik.i_flag,">>>")
                         ELSE STRING(ttpik.i_flag > 0,"*/ ")).
        END.
        ELSE
              p_mark = (IF pik_number THEN STRING(p_flag[p_init],">>>")
                   ELSE STRING(p_flag[p_init] > 0,"*/ ")).

        IF pik_wide THEN DISPLAY
          p_mark WHEN p_mark <> INPUT FRAME pick2 p_mark WITH FRAME pick2.
        ELSE DISPLAY
          p_mark WHEN p_mark <> INPUT FRAME pick1 p_mark WITH FRAME pick1.
        IF pik_wide THEN
          DOWN WITH FRAME pick2.
        ELSE
          DOWN WITH FRAME pick1.
      END.
      p_init = ?.
      IF pik_wide THEN
        UP FRAME-LINE(pick2) - p_spot WITH FRAME pick2.
      ELSE
        UP FRAME-LINE(pick1) - p_spot WITH FRAME pick1.
    END.
    PAUSE 0.
    IF pik_skip AND (c_currName = "*SKIP UP*" OR 
                     c_currName = "*SKIP DOWN*") THEN .
    ELSE
    IF p_recid < pik_count THEN DO:
      p_recid = p_recid + 1.
      IF pik_wide THEN
        IF FRAME-LINE(pick2) = FRAME-DOWN(pick2) THEN
          SCROLL UP WITH FRAME pick2.
        ELSE
          DOWN WITH FRAME pick2.
      ELSE
        IF FRAME-LINE(pick1) = FRAME-DOWN(pick1) THEN
          SCROLL UP WITH FRAME pick1.
        ELSE
          DOWN WITH FRAME pick1.
    END.
  END.
  ELSE
  IF CAN-DO("CURSOR-DOWN,TAB, ",KEYFUNCTION(LASTKEY))
    AND p_recid < pik_count THEN DO:
    p_recid = p_recid + 1.
    IF pik_wide THEN
      IF FRAME-LINE(pick2) = FRAME-DOWN(pick2) THEN
        SCROLL UP WITH FRAME pick2.
      ELSE
        DOWN WITH FRAME pick2.
    ELSE
      IF FRAME-LINE(pick1) = FRAME-DOWN(pick1) THEN
        SCROLL UP WITH FRAME pick1.
      ELSE
        DOWN WITH FRAME pick1.
  END.
  ELSE
  IF CAN-DO("CURSOR-UP,BACK-TAB",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
    p_recid = p_recid - 1.
    IF pik_wide THEN
      IF FRAME-LINE(pick2) = 1 THEN
        SCROLL DOWN WITH FRAME pick2.
      ELSE
        UP WITH FRAME pick2.
    ELSE
      IF FRAME-LINE(pick1) = 1 THEN
        SCROLL DOWN WITH FRAME pick1.
      ELSE
        UP WITH FRAME pick1.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN ASSIGN
    p_recid  = p_recid + pik_down
    p_redraw = TRUE.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN ASSIGN
    p_recid  = p_recid - pik_down
    p_redraw = TRUE.
  ELSE
  IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
    ASSIGN
      p_recid  = 1
      p_redraw = TRUE.
    IF pik_wide THEN
      UP FRAME-LINE(pick2) - 1 WITH FRAME pick2.
    ELSE
      UP FRAME-LINE(pick1) - 1 WITH FRAME pick1.
  END.
  ELSE
  IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
    ASSIGN
      p_recid  = pik_count
      p_redraw = TRUE.
    IF pik_wide THEN
      DOWN pik_down - FRAME-LINE(pick2) WITH FRAME pick2.
    ELSE
      DOWN pik_down - FRAME-LINE(pick1) WITH FRAME pick1.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "GO"
    AND pik_skip AND c_currName = "*SKIP*" THEN DO:
    ASSIGN
      p_flag   = 0
      p_flag#  = 0
      p_recid  = 1
      p_redraw = TRUE.
    IF pik_wide THEN
      UP FRAME-LINE(pick2) - 1 WITH FRAME pick2.
    ELSE
      UP FRAME-LINE(pick1) - 1 WITH FRAME pick1.
  END.
  ELSE
  IF CAN-DO("GO,RETURN",KEYFUNCTION(LASTKEY)) THEN DO:
    ASSIGN
      pik_return = (IF pik_multi THEN 0 ELSE 1)
      pik_chosen = (IF pik_multi THEN -1 ELSE p_recid).

    IF read_tt THEN DO:
      ASSIGN pik_first = ?.

       FOR EACH ttpik:
           IF ttpik.i_number = p_recid THEN
               pik_first = ttpik.c_name.

           IF ttpik.i_flag > 0 THEN DO:
               /* for the temp-table, we will just count how many
                  where chosen.
               */
               ASSIGN pik_return = pik_return + 1.
               IF ttpik.i_flag = 1 THEN
                   pik_first = ttpik.c_name.
           END.
       END.
    END.
    ELSE DO:
        DO p_recid = 1 TO pik_count:
          IF p_flag[p_recid] > 0 THEN ASSIGN
            pik_return = pik_return + 1
            pik_chosen[IF pik_number THEN p_flag[p_recid] ELSE pik_return]
              = p_recid.
        END.

        pik_first = (IF pik_return > 0 AND pik_chosen[1] > 0
                 THEN pik_list[pik_chosen[1]] ELSE ?).
    END.

    IF pik_skip THEN pik_return = p_flag#.
    LEAVE _pick.
  END.
  ELSE
  IF CAN-DO("GET,END-ERROR",KEYFUNCTION(LASTKEY)) THEN LEAVE _pick.

  p_line = 1.
END.

ASSIGN
  pik_row    = 0
  pik_column = 0
  pik_title  = ""
  pik_init   = "".
IF pik_wide THEN
  UP FRAME-LINE(pick2) - 1 WITH FRAME pick2.
ELSE
  UP FRAME-LINE(pick1) - 1 WITH FRAME pick1.
IF pik_hide THEN DO:
  /* CLEAR FRAME pick1 ALL NO-PAUSE.
  CLEAR FRAME pick2 ALL NO-PAUSE. */
  HIDE FRAME pick1 NO-PAUSE.
  HIDE FRAME pick2 NO-PAUSE.
  HIDE FRAME fskip NO-PAUSE.
END.
/*HIDE FRAME type1 NO-PAUSE.
HIDE FRAME type2 NO-PAUSE.*/
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* create a new database */

{ prodict/user/uservar.i }

DEFINE VARIABLE newdb AS CHARACTER NO-UNDO.

RUN adecomm/_dbcreat.p (INPUT "", INPUT-OUTPUT newdb).
user_env[2] = newdb.

IF newdb = ? THEN user_path = "".

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrpwd2.p - user password verification procedure */

{prodict/user/uservar.i}

/* New password entered - in encoded form */
DEFINE INPUT  PARAMETER p_newpwd AS CHAR    NO-UNDO. 

/* Set to yes if user types password correctly, no if password doesn't match
   or ? if user cancels out of box. */
DEFINE OUTPUT PARAMETER p_ok     AS LOGICAL NO-UNDO. 

FORM
  SKIP({&TFM_WID})
  "For verification purposes, please type     " AT 2 VIEW-AS TEXT SKIP
  "the same password in again. Remember"       AT 2 VIEW-AS TEXT SKIP
  "that passwords are case-sensitive.        " AT 2 VIEW-AS TEXT SKIP({&VM_WIDG})
  DICTDB._User._Password {&STDPH_FILL} PASSWORD-FIELD AT 2 LABEL "Password"
  {prodict/user/userbtns.i}
  WITH FRAME usr_passwd 
    CENTERED SIDE-LABELS ATTR-SPACE 
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    VIEW-AS DIALOG-BOX TITLE "Password Verification".


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame usr_passwd
   or CHOOSE of btn_Help in frame usr_passwd
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Password_Verification_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF

ON WINDOW-CLOSE OF FRAME usr_passwd
   APPLY "END-ERROR" TO FRAME usr_passwd.


/*==========================Mainline Code================================*/

{adecomm/okrun.i  
    &FRAME  = "FRAME usr_passwd" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}

DO ON ERROR UNDO, LEAVE  ON ENDKEY UNDO, LEAVE:
  PROMPT-FOR _User._Password btn_OK btn_Cancel {&HLP_BTN_NAME}
         WITH FRAME usr_passwd.
  p_ok = p_newpwd = ENCODE(INPUT FRAME usr_passwd _Password).
  RETURN.
END.

p_ok = ?.
RETURN.
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* _usrquot.p - support for quoter w/o import into PROGRESS */

/*
user_env[1] = "1" -> Convert each line of input file to one field of input.
            = "d" -> Convert fields in each line of input file by a delimiter.
            = "c" -> Convert fields in each line of input file by columns.
            = "m" -> Like "c", but just create include file to do conversion.


Modified by Gerry Seidl on 6/13/94 - Bug 94-06-01-011. Removed SEARCH for unix
                                     which was supplying the full path.
                                     
Modified by Gerry Seidl on 7/7/94 - Bug 94-06-27-069 & 
                                        94-06-27-049 &
                                        94-06-27-041 &
                                        94-06-27-079 &
                                        94-06-27-080
                                        
Modified by Gerry Seidl on 11/11/94 - Rewrote GO for c and m frames. Changed
                                      SET to ENABLE and used W-F.
                                      
Tom Nordhougen     07/19/95     Added support for mnemonics for the "Files..."
                                button and the "Output File" fill-in label for
                                the m frame.                                      
                                        
hutegger    03/97   widened quoter-c frame and adjusted quoter-make frame
                    to new font on Win32 stuff     
D. McMann   04/13/00 Added support for long path names    
D. McMann   06/05/00  Added check for return error from osquoter.p       
D. McMann   06/09/03 Changed assignment statement to include each individual 
                     array element for frames quoter-c and quoter-m 

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

&GLOBAL-DEFINE NUMFLDS 24
DEFINE VARIABLE delim-char  AS CHARACTER INITIAL ?             NO-UNDO.
DEFINE VARIABLE c           AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE msg         AS CHARACTER EXTENT 9              NO-UNDO.
DEFINE VARIABLE column-list AS CHARACTER INITIAL ?             NO-UNDO.
DEFINE VARIABLE i           AS INTEGER                         NO-UNDO.
DEFINE VARIABLE l           AS INTEGER EXTENT {&NUMFLDS} {&STDPH_FILL}
			       FORMAT ">>>9" NO-UNDO.
DEFINE VARIABLE quoter-file AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE source-file AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE target-file AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE u           AS INTEGER EXTENT {&NUMFLDS} {&STDPH_FILL} 
			       FORMAT ">>>9" NO-UNDO.
DEFINE VARIABLE q-mode      AS CHARACTER                       NO-UNDO.
DEFINE VARIABLE canned      AS LOGICAL   INITIAL TRUE          NO-UNDO.
DEFINE VARIABLE sf-lbl      AS CHAR FORMAT "X(12)" INIT "&Input File:".
DEFINE VARIABLE tf-lbl      AS CHAR FORMAT "X(16)" INIT "For&matted File:".
DEFINE VARIABLE msgQuot1    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 72 INNER-LINES 2 NO-UNDO.
DEFINE VARIABLE msgQuot2    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 72 INNER-LINES 2 NO-UNDO.
DEFINE VARIABLE msgQuot3    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 72 INNER-LINES 2 NO-UNDO.
DEFINE VARIABLE msgQuot4    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 72 INNER-LINES 2 NO-UNDO.
DEFINE VARIABLE msgQuot5    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 56 INNER-LINES 1 NO-UNDO.
DEFINE VARIABLE msgQuot6    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 60 INNER-LINES 1 NO-UNDO.
DEFINE VARIABLE msgQuot7    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 56 INNER-LINES 2 NO-UNDO.
DEFINE VARIABLE msgQuot8    AS CHAR VIEW-AS EDITOR NO-BOX INNER-CHARS 74 INNER-LINES 2 NO-UNDO.

{prodict/misc/filesbtn.i &NAME = btn_File_Source}
{prodict/misc/filesbtn.i &NAME = btn_File_Target}
{prodict/misc/filesbtn.i &NAME = btn_File_Quoter}

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

msg[9] = (IF user_env[1] = "1"
         THEN "IMPORT field."
         ELSE "IMPORT field1 field2 field3 ....").


&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  &GLOBAL-DEFINE LINEUP-1 15
  &GLOBAL-DEFINE FILLCH-1 35
&ELSE
  &GLOBAL-DEFINE LINEUP-1 16
  &GLOBAL-DEFINE FILLCH-1 40
&ENDIF

FORM
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
   msgQuot1 NO-LABEL AT 2 SKIP({&VM_WIDG})
&ELSE
  "Your input file will be copied to a new file, formatted with" AT 2 VIEW-AS TEXT SKIP
  "quotes around each line." 	AT 2 VIEW-AS TEXT SKIP({&VM_WIDG})
&ENDIF
  source-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH-1} BY 1
         LABEL "&Input File" COLON {&LINEUP-1}
  btn_File_Source SKIP({&VM_WIDG})
  target-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH-1} BY 1
         LABEL "For&matted File" COLON {&LINEUP-1}
  btn_File_Target
  {prodict/user/userbtns.i}
  WITH FRAME quoter-1 
  SIDE-LABELS CENTERED THREE-D
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Quote Entire Lines".

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
ASSIGN msgQuot1:SCREEN-VALUE =
  "Your input file will be copied to a new file, formatted with " +
  "quotes around each line.".
msgQuot1:READ-ONLY = yes.
&ENDIF

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  &GLOBAL-DEFINE LINEUP-q 20
  &GLOBAL-DEFINE FILLCH-q 35
&ELSE
  &GLOBAL-DEFINE LINEUP-q 22
  &GLOBAL-DEFINE FILLCH-q 41
&ENDIF

FORM
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  msgQuot2 NO-LABEL AT 2 SKIP({&VM_WIDG})
&ELSE
  "Your input file will be copied to a new file, formatted with" AT 2 VIEW-AS TEXT SKIP
  "quotes around each delimited field." 	AT 2 VIEW-AS TEXT SKIP({&VM_WIDG})
&ENDIF
  source-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH-q} BY 1
         LABEL "&Input File" COLON {&LINEUP-q}
  btn_File_Source SKIP({&VM_WIDG})
  target-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH-q} BY 1
         LABEL "For&matted File" COLON {&LINEUP-q}
  btn_File_Target SKIP({&VM_WIDG})
  delim-char  FORMAT "x" LABEL "&Delimiting character" 
	{&STDPH_FILL} COLON {&LINEUP-q}
	VALIDATE(delim-char <> '"' AND delim-char <> " ",
	        "Blanks and quotes are not allowed as delimiters.")
  {prodict/user/userbtns.i}
  WITH FRAME quoter-d 
  SIDE-LABELS CENTERED ATTR-SPACE THREE-D
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Quote By Delimiter".

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
ASSIGN msgQuot2:SCREEN-VALUE =
  "Your input file will be copied to a new file, formatted with " +
  "quotes around each delimited field.".
msgQuot2:READ-ONLY = yes.
&ENDIF

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  &GLOBAL-DEFINE FILLCH-c 38
  &GLOBAL-DEFINE LINEUP-c 17
  &GLOBAL-DEFINE WIDTH-C 86
&ELSE
  &GLOBAL-DEFINE FILLCH-c 40
  &GLOBAL-DEFINE LINEUP-c 18
  &GLOBAL-DEFINE WIDTH-C 80
&ENDIF

FORM
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  msgQuot3 NO-LABEL AT 2 SKIP ({&VM_WIDG})
&ELSE
  "Your input file will be copied to a new file, formatted with" AT 2 VIEW-AS TEXT SKIP
  "quotes around each column-defined field."   AT 2 VIEW-AS TEXT SKIP({&VM_WIDG})
&ENDIF
  source-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH-c} BY 1
         LABEL "&Input File" COLON {&LINEUP-c}
  btn_File_Source SKIP({&VM_WIDG})
  target-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN SIZE {&FILLCH-c} BY 1
         LABEL "For&matted File" COLON {&LINEUP-c}
  btn_File_Target SKIP({&VM_WIDG})
   &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    msgQuot6 NO-LABELS AT 2 SKIP({&VM_WID})
   &ELSE
    "Enter the starting and ending columns for each field in the input:" AT 2
      SKIP(1)
   &ENDIF
  {prodict/user/userquot.i}
  {prodict/user/userbtns.i}
  WITH FRAME quoter-c 
  WIDTH {&WIDTH-C}
  SIDE-LABELS NO-LABELS /* This is intentional; it causes default to be 
                           NO-LABEL, but allows explicit labels to appear as
                           side labels.  */  
  CENTERED THREE-D
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE "Quote By Column Ranges".

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
ASSIGN msgQuot3:SCREEN-VALUE =
  "Your input file will be copied to a new file, formatted with " +
  "quotes around each column-defined field.". 
ASSIGN msgQuot6:SCREEN-VALUE =
    "Enter the starting and ending columns for each field in the input:". 
msgQuot3:READ-ONLY = yes.
msgQuot6:READ-ONLY = yes.
&ENDIF

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  &GLOBAL-DEFINE FILLCH-m 39
  &GLOBAL-DEFINE LINEUP-m  2
&ELSE
  &GLOBAL-DEFINE FILLCH-m 40
  &GLOBAL-DEFINE LINEUP-m  2
&ENDIF

FORM
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  msgQuot4 NO-LABEL AT 2 SKIP ({&VM_WIDG})
&ELSE  
  "A quoter command will be created from the columns you list below."
      	       	     	      	       	     	AT 2 VIEW-AS TEXT
  "The command will be stored into a new file that can be used as an"
      	       	     	      	       	     	AT 2 VIEW-AS TEXT
  "include file." AT 2 VIEW-AS TEXT SKIP({&VM_WIDG})
&ENDIF
  quoter-file {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" VIEW-AS FILL-IN 
    SIZE {&FILLCH-m} BY 1 AT {&LINEUP-m} 
    LABEL "&Output File"
  btn_File_Quoter SKIP({&VM_WIDG})
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    msgQuot5 NO-LABEL AT 2 SKIP({&VM_WID})
  &ELSE
  "Enter the starting and ending columns for each field:" AT 2 SKIP(1)
  &ENDIF
  {prodict/user/userquot.i}
  {prodict/user/userbtns.i}
  WITH FRAME quoter-m
  SIDE-LABELS NO-LABELS /* This is intentional; it causes default to be 
                           NO-LABEL, but allows explicit labels to appear as
                           side labels.  */
  CENTERED THREE-D
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  SCROLLABLE
  VIEW-AS DIALOG-BOX TITLE "Quoter Include File".
  
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
ASSIGN msgQuot4:SCREEN-VALUE =
  "A quoter command will be created from the columns you list below. " +
  "The command will be stored into a new file that can be used as an " +
  "include file.".
ASSIGN msgQuot5:SCREEN-VALUE =
  "Enter the starting and ending columns for each field:".
msgQuot4:READ-ONLY = yes.
msgQuot5:READ-ONLY = yes.
&ENDIF

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  &GLOBAL-DEFINE FILLCH-done 35
&ELSE
  &GLOBAL-DEFINE FILLCH-done 41
&ENDIF

FORM
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  msgQuot7 NO-LABELS AT 2 SKIP({&VM_WIDG})
&ELSE
  "If there were no errors, your new formatted file may be" AT 2  SKIP 
  "used for {&PRO_DISPLAY_NAME} input."	AT 2  SKIP({&VM_WIDG})
&ENDIF

  "For example:"     	      	   AT 2  SKIP({&VM_WID})
    "INPUT FROM"                   AT 6 
      c FORMAT "x({&FILLCH-done})"                   SKIP
    "REPEAT:"			   AT 6	 SKIP
      "CREATE filename."	   AT 8	 SKIP
      msg[9] FORMAT "x(32)"        AT 8  SKIP
    "END."	      	           AT 6	 SKIP
    "INPUT CLOSE."	           AT 6
   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &HELP   = {&HLP_BTN_NAME}} /*No cancel button*/
  WITH FRAME quoter-done THREE-D
  NO-LABELS CENTERED NO-ATTR-SPACE 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Ok
  USE-TEXT VIEW-AS DIALOG-BOX TITLE "Quoter Formatting Completed.".

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
ASSIGN msgQuot7:SCREEN-VALUE =
  "If there were no errors, your new formatted file may be " +
  "used for {&PRO_DISPLAY_NAME} input.".
msgQuot7:READ-ONLY = yes.
&ENDIF

FORM
  SKIP({&TFM_WID})
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
  msgQuot8 NO-LABELS AT 2 SKIP ({&VM_WIDG})
&ELSE
  "Your new include file may be used in several types of {&PRO_DISPLAY_NAME} statements." 
		 AT 2 SKIP({&VM_WIDG})
&ENDIF
  "UNIX only:"                                        TO 14 
    "INPUT THROUGH"                                   AT 16 
      msg[1] FORMAT "x({&FILLCH-done})"                     SKIP
    "REPEAT:"                                	      AT 16 SKIP
      msg[9] FORMAT "x(32)"     	      	             AT 18 SKIP(1)

  "UNIX:"                                             TO 14
    "UNIX SILENT"       	                           AT 16 
      msg[2] FORMAT "x(50)"                           AT 30 SKIP
  "DOS:"                                              TO 14
    "DOS SILENT"                                      AT 16 
      msg[3] FORMAT "x(50)"                           AT 30 SKIP
   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &HELP   = {&HLP_BTN_NAME}} /*No cancel button*/
  WITH FRAME quoter-make THREE-D
  NO-LABELS CENTERED SCROLLABLE
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Ok
  USE-TEXT VIEW-AS DIALOG-BOX TITLE "Include File Created".

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
ASSIGN msgQuot8:SCREEN-VALUE =
  "Your new include file may be used in several types of {&PRO_DISPLAY_NAME} statements.".
msgQuot8:READ-ONLY = yes.
&ENDIF

/*========================Internal Procedures=============================*/

/*---------------------------------------------
   See if the output file already exists and
   ask the user if he wants to overwrite it.
   Return "error" if user made a mistake.
----------------------------------------------*/
PROCEDURE Check_Output_File:
  DEFINE INPUT PARAMETER p_File AS WIDGET-HANDLE.
  DEFINE VAR answer AS LOGICAL NO-UNDO. 

  IF (p_File:SCREEN-VALUE) = "" THEN DO:
    MESSAGE "Output file not specified."
      VIEW-AS ALERT-BOX MESSAGE BUTTONS OK.
      APPLY "ENTRY" TO p_File.
      RETURN "error".
    END.

  IF SEARCH(p_File:SCREEN-VALUE) <> ? THEN DO:
    answer = FALSE.
    MESSAGE "A file already exists with the name:" SKIP 
	     "~"" + p_File:SCREEN-VALUE + "~"." SKIP(1) "Overwrite?"
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO p_File.
      RETURN "error".
    END.
  END.
  RETURN "".
END.

/*---------------------------------------------
   Make sure the input file already exists
   and that it doesn't equal the output file.
   Return "error" if user made a mistake.
----------------------------------------------*/
PROCEDURE Check_Input_File:
  DEFINE INPUT PARAMETER p_File  AS WIDGET-HANDLE.
  DEFINE INPUT PARAMETER p_OFile AS WIDGET-HANDLE.
  DEFINE VAR answer AS LOGICAL NO-UNDO. 

  IF (p_File:SCREEN-VALUE) = "" THEN DO:
    MESSAGE "Input file not specified."
      VIEW-AS ALERT-BOX MESSAGE BUTTONS OK.
    APPLY "ENTRY" TO p_File.
    RETURN "error".
  END.

  IF SEARCH(p_File:SCREEN-VALUE) = ? THEN DO:
    answer = FALSE.
    MESSAGE "Input file not found with the name:" SKIP 
	     "~"" + p_File:SCREEN-VALUE + "~"."
    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO p_File.
    RETURN "error".
  END.

  IF p_OFile:SCREEN-VALUE <> "" AND
     SEARCH(p_File:SCREEN-VALUE) = SEARCH(p_OFile:SCREEN-VALUE) THEN DO:
    MESSAGE "The input file cannot be the same as the output file."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO p_File.
    RETURN "error".
  END.
   
  RETURN "".
END.

PROCEDURE chk-arrays:
   DEF VAR ctr        AS INT.
   DEF VAR err-none   AS INT INITIAL 0. /* 0=none, >0=some */
   DEF VAR err-inv    AS INT INITIAL 0. /* 0=ok, 1=bad */
  
   REPEAT ctr = 1 to {&NUMFLDS}:
        IF l[ctr] > u[ctr] THEN err-inv = 1.
        IF l[ctr] NE 0 AND u[ctr] <> 0 then err-none = 1.
   END.
   IF err-none = 0 THEN DO:
        MESSAGE "You haven't entered any ranges."
            VIEW-AS ALERT-BOX ERROR BUTTONS ok.
        RETURN "error".
   END.
   IF err-inv = 1 THEN DO:
        MESSAGE "You have entered one or more invalid ranges."
            VIEW-AS ALERT-BOX ERROR BUTTONS ok.
        RETURN "error".
   END.
END.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN 
/*----- HELP -----*/
on HELP of frame quoter-1
   or CHOOSE of btn_Help in frame quoter-1
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Quote_Entire_Lines_Dlg_Box},
      	       	     	     INPUT ?).

on HELP of frame quoter-d
   or CHOOSE of btn_Help in frame quoter-d
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Quote_By_Delimiter_Dlg_Box},
      	       	     	     INPUT ?).

on HELP of frame quoter-c
   or CHOOSE of btn_Help in frame quoter-c
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Quote_By_Column_Ranges_Dlg_Box},
      	       	     	     INPUT ?).

on HELP of frame quoter-m
   or CHOOSE of btn_Help in frame quoter-m
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Quoter_Include_File_Dlg_Box},
      	       	     	     INPUT ?).

on HELP of frame quoter-done
   or CHOOSE of btn_Help in frame quoter-done
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Quoter_Conversion_Completed_Dlg_Box},
      	       	     	     INPUT ?).

on HELP of frame quoter-make
   or CHOOSE of btn_Help in frame quoter-make
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Include_File_Created_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


/*---- on GO or OK -----*/
ON GO OF FRAME quoter-1
DO:
   RUN Check_Input_File (INPUT source-file:HANDLE IN FRAME quoter-1,
      	       	     	 INPUT target-file:HANDLE IN FRAME quoter-1).
   IF RETURN-VALUE = "error" THEN
      RETURN NO-APPLY.
   RUN Check_Output_File (INPUT target-file:HANDLE IN FRAME quoter-1).
   IF RETURN-VALUE = "error" THEN
      RETURN NO-APPLY.
END.

ON GO OF FRAME quoter-d
DO:
   RUN Check_Input_File (INPUT source-file:HANDLE IN FRAME quoter-d,
      	       	     	 INPUT target-file:HANDLE IN FRAME quoter-d).
   IF RETURN-VALUE = "error" THEN
      RETURN NO-APPLY.
   RUN Check_Output_File (INPUT target-file:HANDLE IN FRAME quoter-d).
   IF RETURN-VALUE = "error" THEN
      RETURN NO-APPLY.
END.

ON GO of FRAME quoter-c DO:
   assign source-file target-file
     l[ 1] u[ 1]   l[ 2] u[ 2]   l[ 3] u[ 3]   l[ 4] u[ 4]   l[ 5] u[ 5]
     l[ 6] u[ 6]   l[ 7] u[ 7]   l[ 8] u[ 8]   l[ 9] u[ 9]   l[10] u[10]
     l[11] u[11]   l[12] u[12]   l[13] u[13]   l[14] u[14]   l[15] u[15]
     l[16] u[16]   l[17] u[17]   l[18] u[18]   l[19] u[19]   l[20] u[20]
     l[21] u[21]   l[22] u[22]   l[23] u[23]   l[24] u[24].
    
   /* ASSIGN source-file target-file l u.*/
   RUN Check_Input_File (INPUT source-file:HANDLE IN FRAME quoter-c,
      	       	     	 INPUT target-file:HANDLE IN FRAME quoter-c).
   IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.      	       	     	 
   RUN Check_Output_File (INPUT target-file:HANDLE IN FRAME quoter-c).
   IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
   RUN chk-arrays. /* check l & u for bad or missing ranges */
   IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
END.

ON GO of FRAME quoter-m DO:
   ASSIGN quoter-file 
     l[ 1] u[ 1]   l[ 2] u[ 2]   l[ 3] u[ 3]   l[ 4] u[ 4]   l[ 5] u[ 5]
     l[ 6] u[ 6]   l[ 7] u[ 7]   l[ 8] u[ 8]   l[ 9] u[ 9]   l[10] u[10]
     l[11] u[11]   l[12] u[12]   l[13] u[13]   l[14] u[14]   l[15] u[15]
     l[16] u[16]   l[17] u[17]   l[18] u[18]   l[19] u[19]   l[20] u[20]
     l[21] u[21]   l[22] u[22]   l[23] u[23]   l[24] u[24].

   RUN Check_Output_File (INPUT quoter-file:HANDLE IN FRAME quoter-m).
   IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
   RUN chk-arrays. /* check l & u for bad or missing ranges */
   IF RETURN-VALUE = "error" THEN RETURN NO-APPLY.
END.

/*----- WINDOW CLOSE -----*/
ON WINDOW-CLOSE OF FRAME quoter-1
   APPLY "END-ERROR" TO FRAME quoter-1.
ON WINDOW-CLOSE OF FRAME quoter-d
   APPLY "END-ERROR" TO FRAME quoter-d.
ON WINDOW-CLOSE OF FRAME quoter-c
   APPLY "END-ERROR" TO FRAME quoter-c.
ON WINDOW-CLOSE OF FRAME quoter-m
   APPLY "END-ERROR" TO FRAME quoter-m.
ON WINDOW-CLOSE OF FRAME quoter-done
   APPLY "END-ERROR" TO FRAME quoter-done.
ON WINDOW-CLOSE OF FRAME quoter-make
   APPLY "END-ERROR" TO FRAME quoter-make.

/*----- HIT of FILE BUTTONS -----*/
ON CHOOSE OF btn_File_Source in frame quoter-1 DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT source-file:handle in frame quoter-1 /*Fillin*/,
	INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File_Target in frame quoter-1 DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT target-file:handle in frame quoter-1 /*Fillin*/,
	INPUT "Find Formatted File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON CHOOSE OF btn_File_Source in frame quoter-d DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT source-file:handle in frame quoter-d /*Fillin*/,
	INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File_Target in frame quoter-d DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT target-file:handle in frame quoter-d /*Fillin*/,
	INPUT "Find Formatted File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON CHOOSE OF btn_File_Source in frame quoter-c DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT source-file:handle in frame quoter-c /*Fillin*/,
	INPUT "Find Input File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File_Target in frame quoter-c DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT target-file:handle in frame quoter-c /*Fillin*/,
	INPUT "Find Formatted File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON CHOOSE OF btn_File_Quoter in frame quoter-m DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT quoter-file:handle in frame quoter-m /*Fillin*/,
	INPUT "Find Output File"  /*Title*/,
        INPUT "*.i"               /*Filter*/,
        INPUT no                /*Must exist*/).
END.

/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF source-file in frame quoter-1
   source-file:screen-value in frame quoter-1 = 
        TRIM(source-file:screen-value in frame quoter-1).
ON LEAVE OF target-file in frame quoter-1
   target-file:screen-value in frame quoter-1 = 
        TRIM(target-file:screen-value in frame quoter-1).
ON LEAVE OF source-file in frame quoter-d
   source-file:screen-value in frame quoter-d = 
        TRIM(source-file:screen-value in frame quoter-d).
ON LEAVE OF target-file in frame quoter-d
   target-file:screen-value in frame quoter-d = 
        TRIM(target-file:screen-value in frame quoter-d).
ON LEAVE OF source-file in frame quoter-c
   source-file:screen-value in frame quoter-c = 
        TRIM(source-file:screen-value in frame quoter-c).
ON LEAVE OF target-file in frame quoter-c
   target-file:screen-value in frame quoter-c = 
        TRIM(target-file:screen-value in frame quoter-c).
ON LEAVE OF quoter-file in frame quoter-m
   quoter-file:screen-value in frame quoter-m = 
        TRIM(quoter-file:screen-value in frame quoter-m).

/*============================Mainline code===============================*/

q-mode = user_env[1].

IF q-mode = "1" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
     ENABLE msgQuot1 WITH FRAME quoter-1.
  &ENDIF
  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
    &FRAME  = "FRAME quoter-1" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }
  UPDATE source-file btn_File_Source target-file btn_File_Target
      	 btn_OK btn_Cancel {&HLP_BTN_NAME}
      	 WITH FRAME quoter-1.
  canned = FALSE.
END.
ELSE
IF q-mode = "d" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    ENABLE msgQuot2 WITH FRAME quoter-d.
  &ENDIF
  delim-char = " ".
  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
    &FRAME  = "FRAME quoter-d" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }
  UPDATE source-file btn_File_Source target-file btn_File_Target delim-char 
      	 btn_OK btn_Cancel {&HLP_BTN_NAME}
      	 WITH FRAME quoter-d.
  canned = FALSE.
END.
ELSE
IF q-mode = "c" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    ENABLE msgQuot3 msgQuot6 WITH FRAME quoter-c.
  &ENDIF
  {adecomm/okrun.i  
    &FRAME  = "FRAME quoter-c" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }
  ENABLE source-file btn_File_Source target-file btn_File_Target
    l[ 1] u[ 1]   l[ 2] u[ 2]   l[ 3] u[ 3]   l[ 4] u[ 4]   l[ 5] u[ 5]
    l[ 6] u[ 6]   l[ 7] u[ 7]   l[ 8] u[ 8]   l[ 9] u[ 9]   l[10] u[10]
    l[11] u[11]   l[12] u[12]   l[13] u[13]   l[14] u[14]   l[15] u[15]
    l[16] u[16]   l[17] u[17]   l[18] u[18]   l[19] u[19]   l[20] u[20]
    l[21] u[21]   l[22] u[22]   l[23] u[23]   l[24] u[24]
    btn_OK btn_Cancel {&HLP_BTN_NAME}
    WITH FRAME quoter-c.    
    WAIT-FOR GO OF FRAME quoter-c.
   canned = FALSE.
END.
ELSE
IF q-mode = "m" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    ENABLE msgQuot4 msgQuot5 msgQuot8 WITH FRAME quoter-m.
  &ENDIF
  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
    &FRAME  = "FRAME quoter-m" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }

  ENABLE quoter-file btn_File_Quoter
    l[ 1] u[ 1]   l[ 2] u[ 2]   l[ 3] u[ 3]   l[ 4] u[ 4]   l[ 5] u[ 5]
    l[ 6] u[ 6]   l[ 7] u[ 7]   l[ 8] u[ 8]   l[ 9] u[ 9]   l[10] u[10]
    l[11] u[11]   l[12] u[12]   l[13] u[13]   l[14] u[14]   l[15] u[15]
    l[16] u[16]   l[17] u[17]   l[18] u[18]   l[19] u[19]   l[20] u[20]
    l[21] u[21]   l[22] u[22]   l[23] u[23]   l[24] u[24]
    btn_OK btn_Cancel {&HLP_BTN_NAME}
    WITH FRAME quoter-m.  	 
    WAIT-FOR GO OF FRAME quoter-m.
    canned = FALSE.
END.

IF canned THEN ASSIGN
  q-mode    = ""
  user_path = "".

IF q-mode = "c" OR q-mode = "m" THEN DO:
  column-list = "".
  DO i = 1 TO {&NUMFLDS}:
    IF l[i] = 0 OR u[i] = 0 THEN NEXT.
    column-list = column-list
                + (IF column-list = "" THEN "" ELSE ",")
                + STRING(l[i])
                + (IF l[i] = u[i] THEN "" ELSE "-" + STRING(u[i])).
  END.
END.

IF q-mode = "1" OR q-mode = "d" OR q-mode = "c" THEN DO:
  RUN "prodict/misc/osquoter.p"
    (source-file,delim-char,column-list,target-file).
  IF RETURN-VALUE = "error" THEN
    RETURN.
END.

IF q-mode = "m" THEN DO:
  IF CAN-DO("MSDOS,WIN32",OPSYS) THEN c = "quoter -c ".
  ELSE IF OPSYS = "UNIX"  THEN c = "quoter -c ".
  OUTPUT TO VALUE(quoter-file) NO-ECHO NO-MAP.
  PUT UNFORMATTED c '"' column-list '"' SKIP.
  OUTPUT CLOSE.
END.

HIDE FRAME quoter-1 NO-PAUSE.
HIDE FRAME quoter-d NO-PAUSE.
HIDE FRAME quoter-c NO-PAUSE.
HIDE FRAME quoter-m NO-PAUSE.

IF q-mode = "1" OR q-mode = "d" OR q-mode = "c" THEN DO:
  &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
    ENABLE msgQuot7 WITH FRAME quoter-done.
  &ENDIF
  {adecomm/okrun.i  
    &FRAME  = "FRAME quoter-done" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&HLP_BTN}
  }
  DISPLAY '"' + target-file + '".' @ c msg[9]
    WITH FRAME quoter-done.
  DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
    UPDATE btn_OK {&HLP_BTN_NAME} WITH FRAME quoter-done.
  END.
END.

IF q-mode = "m" THEN DO:
  /* Adjust the graphical rectangle and the ok and cancel buttons */
  {adecomm/okrun.i  
    &FRAME  = "FRAME quoter-make" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&HLP_BTN}
  }
  DISPLAY
    msg[9]
    '"' + quoter-file + '".'                                    @ msg[1]
    "~{ " + quoter-file + " ~} input-file >output-file."        @ msg[2]
    "~{ " + quoter-file + " ~} input-file >output-file."        @ msg[3]
    "~{ " + quoter-file + " ~} input-file >output-file."        @ msg[4]
    "~{ " + quoter-file + " ~} input-file >output-file."        @ msg[5]
    "~{ " + quoter-file + " ~} /OUTPUT=output-file input-file." @ msg[6]
    WITH FRAME quoter-make.
  DO ON ERROR UNDO, LEAVE ON ENDKEY UNDO, LEAVE:
    &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
      ENABLE msgQuot8 WITH FRAME quoter-make.
    &ENDIF
    UPDATE btn_OK {&HLP_BTN_NAME} WITH FRAME quoter-make.
  END.
END.

HIDE FRAME quoter-done NO-PAUSE.
HIDE FRAME quoter-make NO-PAUSE.
HIDE MESSAGE NO-PAUSE.
RETURN.
/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _usrschg.p

    change DICTDB._Db record information


Input-Parameters:
    none
    
Output-Parameters:
    none
    
Used/Modified Shared Objects:
    in:  user_env[1] = "add" or "upd"
         user_env[3] = dbtype to add or "" for any
                       MS Sql Srver 7, ORACLE  OR
                       ODBC (Sybase, SQLServer, DB2, Informix, MS SQL 6.5)
    out: user_env[2] = new DICTDB._Db._Db-name
         no other environment variables changed

History:
    D. McMann 11/26/02  Removed V7 Oracle Support
    D. McMann 06/25/02  Added support for V9 of Oracle
    D. McMann 06/16/01  Added collation name for all DataServers and case sensitive for MSS
    D. McMann 06/07/00  Changed tty frame layout
    D. McMann 04/01/99  Added check for Oracle to assign _DB-misc1[3].
    D. McMann 03/26/99  Added support for MS SQL Server 7
    D. McMann 03/10/99  Removed connect parameters check
    D. McMann 03/04/99  Added RETURN:INSERT to f_comm.
    DMcMann 07/14/98    Added _Owner to _File finds
    DMcMann 01/13/98    Removed data source name for odbc since the code
                        assigns the underlying data source when the pull
                        is done.
    DMcMann 12/18/97    Added data source name field for ODBC and display
                        Oracle. Added validation for connect parms and if ODBC
                        data source name.  Removed physical database name field
                        if Oracle db-type.
    tomn    05/22/96    Changed method by which SYB10/MSSQLSRV default
                        codepage is set; Before, the "leave" trigger was
                        fired, which would also display error when codepage
                        conversion failed; Copied just the logic to set
                        default value from trigger routine (gat_cpvl.i).
    tomn    08/31/95    Changed read-only mode so that user is able to view
                        details after alert-box is dismissed
  kmcintos  09/08/05    Added support for Oracle 10 20050318-015                      
  fernando  09/14/07    Allow ORACLE version 11
  sbehera   02/03/14    Support ORACLE version 12 and changed default version to 11
----------------------------------------------------------------------------*/
/*h-*/

/*==========================  DEFINITIONS ===========================*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE amode    AS LOGICAL            NO-UNDO. /*true=add,false=modify*/
DEFINE VARIABLE c        AS CHARACTER          NO-UNDO.
DEFINE VARIABLE codepage AS CHARACTER          NO-UNDO format "x(40)".
DEFINE VARIABLE collname AS CHARACTER          NO-UNDO FORMAT "x(40)".
DEFINE VARIABLE dblst    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE f_addr   AS CHARACTER          NO-UNDO.
DEFINE VARIABLE f_comm   AS CHARACTER          NO-UNDO.
DEFINE VARIABLE fmode    AS LOGICAL            NO-UNDO. /* part of gateway */
DEFINE VARIABLE i        AS INTEGER  INITIAL 0 NO-UNDO.
DEFINE VARIABLE j        AS INTEGER            NO-UNDO.
DEFINE VARIABLE okay     AS LOGICAL            NO-UNDO.
DEFINE VARIABLE ronly    AS LOGICAL            NO-UNDO. /* read only */
DEFINE VARIABLE x-l      AS LOGICAL            NO-UNDO. /* allow set ldb name */
DEFINE VARIABLE x-p      AS LOGICAL            NO-UNDO. /* allow set pdb name */
DEFINE VARIABLE canned   AS LOGICAL  INIT TRUE NO-UNDO.
DEFINE VARIABLE dname    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE dsource  AS CHARACTER          NO-UNDO.
DEFINE VARIABLE dstitle  AS CHARACTER FORMAT "x(24)"    NO-UNDO.
DEFINE VARIABLE ovtitle  AS CHARACTER FORMAT "x(15)"    NO-UNDO.
DEFINE VARIABLE oraver   AS INTEGER FORMAT ">9" NO-UNDO.
DEFINE VARIABLE olddb    AS CHARACTER          NO-UNDO.
DEFINE VARIABLE olddbtyp AS CHARACTER          NO-UNDO.

/* LANGUAGE DEP  END.ENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 14 NO-UNDO INITIAL [
  /* 1*/ "You have to select a non-{&PRO_DISPLAY_NAME} database to use this option.",
  /* 2*/ "None of the above information may be changed for this database.",
  /* 3*/ "(Cannot change Logical Name while database is Connected.)",
  /* 4*/ "Supported ODBC Data Sources:  ",
  /* 5*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 6*/ "You do not have permission to create foreign database definitions.",
  /* 7*/ "You do not have permission to view foreign database definitions.",
  /* 8*/ "You do not have permission to alter foreign database definitions.",
  /* 9*/ "There is currently a database using this name as a dbname or alias",
  /*10*/ "Internal Dictionary Error: inconsistent dbtype encountered.",
  /*11*/ "Logical Database Name may not be left blank or unknown.",
  /*12*/ "Connect parameters are required.",
  /*13*/ "ODBC Data Source Name is required.",
  /*14*/ "Oracle version must be either 10, 11 or 12."
].

FORM
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN    
  SKIP ({&TFM_WID}) 
&ENDIF
  DICTDB._Db._Db-name  FORMAT "x(18)" COLON 23 LABEL "Logical Database Name" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
  DICTDB._Db._Db-type  FORMAT "x(10)" COLON 23 LABEL "Server Type" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
    
  codepage                     COLON 23 LABEL "Code Page" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
  collname                     COLON 23 LABEL "Collation" 
      {&STDPH_FILL}  SKIP ({&VM_WID})
  new_lang[3]   FORMAT "x(63)" AT 2 NO-LABEL VIEW-AS TEXT 
  SKIP ({&VM_WID})
  ovtitle NO-LABEL VIEW-AS TEXT AT 9 oraver NO-LABEL SKIP ({&VM_WIDG})
  "Connection Parameters:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  f_comm                   AT 2 NO-LABEL {&STDPH_EDITOR}
      VIEW-AS EDITOR 
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
               SIZE 65 BY 4
      &ELSE 
               SIZE 65 BY 3 SCROLLBAR-VERTICAL
      &ENDIF
  SKIP({&VM_WIDG})

  dstitle NO-LABEL VIEW-AS TEXT AT 2 SKIP ({&VM_WID})
  f_addr AT 2 FORMAT "x(256)" NO-LABEL VIEW-AS FILL-IN SIZE 65 BY 1
      {&STDPH_FILL} 

  {prodict/user/userbtns.i}
  WITH FRAME userschg ROW 1 CENTERED SIDE-LABELS
      DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
      VIEW-AS DIALOG-BOX 
      TITLE "Create/Modify Database Record for DataServer Schema".

/* LANGUAGE DEP  END.ENCIES   END. */ /*------------------------------------------*/

/*================================Triggers=================================*/

/*----- LEAVE of LOGICAL NAME -----*/
ON LEAVE OF DICTDB._Db._Db-name IN FRAME userschg DO:

    Define variable btn_ok   as logical initial true.
  
    /* If logical name was edited and name is in use: */
    dname = TRIM(INPUT FRAME userschg DICTDB._Db._Db-name).
    IF DICTDB._Db._Db-name ENTERED 
      THEN DO:  /* DICTDB._Db._Db-name ENTERED */
        IF LDBNAME(dname) <> ?
          THEN DO:
            MESSAGE new_lang[9] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RETURN NO-APPLY.
            END.
        ELSE IF user_env[1] = "chg"
          THEN DO:
            message "Changing the logical database name causes"  skip
                    "the Data Administration tool to close."     skip
                    "You can then continue working with the "    skip
                    "tool by restarting it."                     skip(1)
                    "Do you want to make the change?"
                    view-as alert-box QUESTION buttons yes-no 
                    update btn_ok.
            if btn_ok 
              THEN ASSIGN user_path = "*E".
              ELSE DO:
                DISPLAY dname @ DICTDB._Db._Db-name WITH FRAME userschg.
                RETURN NO-APPLY.
                END.
            END.
        END.    /* DICTDB._Db._Db-name ENTERED */
    END.

/*----- LEAVE of code-page -----*/
{prodict/gate/gat_cpvl.i
  &frame    = "userschg"
  &variable = "codepage"
  &adbtype  = "user_env[3]" 
  }  /* checks if codepage contains convertable code-page */
 

/* -----LEAVE of Oracle Version on add oraver ------------- */
ON LEAVE OF oraver IN FRAME userschg DO:
     IF INPUT oraver <> 8 AND
        INPUT oraver <> 9 AND
        INPUT oraver <> 10 AND
        INPUT oraver <> 11 AND
        INPUT oraver <> 12 THEN DO:
    MESSAGE new_lang[14] 
       VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO oraver IN FRAME userschg.
    RETURN NO-APPLY.
  END.
END.

/*----- GO or OK -----*/
ON GO OF FRAME userschg DO:
  dname = TRIM(INPUT FRAME userschg DICTDB._Db._Db-name).
  IF dname = "" OR dname = ? THEN DO:
     MESSAGE new_lang[11] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     APPLY "ENTRY" TO DICTDB._Db._Db-name IN FRAME userschg.
     RETURN NO-APPLY.
  END.
  IF x-p AND (INPUT FRAME userschg f_addr = "" or 
              INPUT FRAME userschg f_addr = ?) THEN DO:
       MESSAGE new_lang[13] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       APPLY "ENTRY" TO f_addr IN FRAME userschg.
       RETURN NO-APPLY.      
  END.      
END.

/*-----WINDOW-CLOSE-----*/
ON WINDOW-CLOSE OF FRAME userschg
    APPLY "END-ERROR" TO FRAME userschg.


/*----- HELP -----*/
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
ON HELP OF FRAME userschg OR CHOOSE of btn_Help IN FRAME userschg DO:
    RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                              INPUT {&Create_DataServer_Schema_Dlg_Box},
      	       	     	      INPUT ?).
    END.
&ENDIF

/* ----- Cancel ------ */
ON 'choose':U OF btn_cancel IN FRAME userschg DO:
    ASSIGN canned = TRUE
           user_dbname = olddb
           user_dbtype =  olddbtyp.
    RETURN.
END.
/*============================Mainline Code===============================*/

ASSIGN
  amode    = (user_env[1] = "add")
  fmode    = (user_env[3] <> "")
  olddb    = user_dbname
  olddbtyp = user_dbtype
  dblst    = (IF fmode THEN user_env[3] ELSE SUBSTRING(GATEWAYS,10)). /* 10 = LENGTH("PROGRESS") + 2 */

IF user_env[3] <> "ORACLE" THEN
  ASSIGN dstitle = "ODBC Data Source Name:".
ELSE  
  ASSIGN dstitle = "".
IF user_env[3] = "ORACLE" THEN
  ASSIGN ovtitle = "Oracle Version:".
ELSE
  ASSIGN ovtitle = "".    
    
{ prodict/dictgate.i &action=query &dbtype=dblst &dbrec=? &output=c }

x-p = INDEX(ENTRY(5,c),"p") > 0.

IF NOT amode
  THEN DO:
    FIND DICTDB._Db WHERE RECID(DICTDB._Db) = drec_db NO-ERROR.
    IF NOT DICTDB._Db._Db-slave THEN i = 1. /* no DICTDB._Db rec */
    IF fmode AND dblst <> user_dbtype THEN i = 10. /* inconsistent dbtype */
    END.

if user_env[1] = "add"
  then do:
    { prodict/dictgate.i &action=query &dbtype=dblst &dbrec=? &output=codepage }
    assign codepage = ENTRY(11,codepage)
           collname = SESSION:CPCOLL.
    END.
  else  assign codepage = DICTDB._Db._Db-xl-name
               collname = (IF DICTDB._DB._Db-coll-name <> ? THEN DICTDB._DB._Db-coll-name
                             ELSE SESSION:CPCOLL).
    

IF i > 0 THEN DO:
  MESSAGE new_lang[i] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
  END.

ASSIGN
  f_addr = (IF AVAILABLE DICTDB._Db THEN DICTDB._Db._Db-addr ELSE "")
  f_comm = (IF AVAILABLE DICTDB._Db THEN DICTDB._Db._Db-comm ELSE "")
  oraver = (IF AVAILABLE DICTDB._Db AND DICTDB._Db._Db-Type = "ORACLE"
                THEN DICTDB._Db._Db-misc1[3] ELSE 11).

DO FOR DICTDB._File:
  FIND DICTDB._File "_Db" WHERE _File._Owner = "PUB" NO-LOCK.
  IF amode AND NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[6] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
    END.
  IF NOT amode AND NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[7] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
    END.
  ASSIGN
    x-l   = amode OR NOT CONNECTED(DICTDB._Db._Db-name) /* can set ldb name? */
    ronly = NOT CAN-DO(_Can-write,USERID("DICTDB")).
  END.

{adecomm/okrun.i  
  &FRAME  = "FRAME userschg" 
  &BOX    = "rect_Btns"
  &OK     = "btn_OK" 
  {&CAN_BTN}
  {&HLP_BTN}
}

ASSIGN f_comm:RETURN-INSERT in frame userschg = yes.

DISPLAY
  DICTDB._Db._Db-name WHEN AVAILABLE DICTDB._Db
  DICTDB._Db._Db-type WHEN AVAILABLE DICTDB._Db
  oraver WHEN user_env[3] = "ORACLE"
  new_lang[3]  WHEN NOT x-l
  f_addr       WHEN x-p
  codepage
  collname
  dstitle
  ovtitle
  f_comm
  WITH FRAME userschg.
  
 
IF INDEX(dblst,",") = 0 THEN DISPLAY dblst @ DICTDB._Db._Db-type WITH FRAME userschg.

IF dict_rog OR ronly THEN DO:
  MESSAGE (IF dict_rog THEN new_lang[5] ELSE new_lang[8])
      VIEW-AS ALERT-BOX WARNING BUTTONS OK.
  ASSIGN  user_path = "".
  HIDE FRAME userschg NO-PAUSE.
  RETURN.    
END.  /* dict_rog OR ronly (we're in read-only mode - view only) */
      
ELSE _trx: DO TRANSACTION WITH FRAME userschg:

  DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
      PROMPT-FOR
        DICTDB._Db._Db-name WHEN x-l   AND               NOT (dict_rog OR ronly)
        DICTDB._Db._Db-type WHEN amode AND NOT fmode AND NOT (dict_rog OR ronly)
        codepage            WHEN amode AND               NOT (dict_rog OR ronly)
        collname            WHEN amode AND               NOT (dict_rog OR ronly)
        oraver              WHEN amode AND user_env[3] = "ORACLE"
        f_comm              WHEN                         NOT (dict_rog OR ronly)
        f_addr              WHEN x-p   AND               NOT (dict_rog OR ronly)
        btn_OK
        btn_Cancel
        {&HLP_BTN_NAME}.
      canned = false.
   END.

   IF canned THEN UNDO _trx, LEAVE _trx.

   IF amode
      THEN DO: /* create a new DICTDB._Db for a schema for a Non-PROGRESS db */
          
        CREATE DICTDB._Db.
        ASSIGN
          DICTDB._Db._Db-name    = INPUT DICTDB._Db._Db-name
          DICTDB._Db._Db-slave = TRUE
          DICTDB._Db._Db-type  = CAPS(INPUT DICTDB._Db._Db-type)
          DICTDB._Db._Db-addr  = ""
          DICTDB._Db._Db-comm  = ""
          DICTDB._Db._Db-misc1[3] = (IF user_env[3] = "ORACLE" THEN INPUT oraver
                                     ELSE ?)
          user_dbtype   = DICTDB._Db._Db-type.
        IF NOT fmode THEN 
          &IF "{&WINDOW-SYSTEM}" = "TTY"
            &THEN
                   user_path = "1=sys,_usrsget".
            &ELSE
                   user_path = "1=sys,_guisget".
            &ENDIF
        { prodict/dictgate.i &action=query &dbtype=DICTDB._Db._Db-type &dbrec=? &output=c }
        IF INDEX(ENTRY(1,c),"a") > 0
          THEN DO:
            { prodict/dictgate.i &action=add
              &dbtype=DICTDB._Db._Db-type &dbrec=RECID(DICTDB._Db) &output=c }
            END.
        END.   /* create a new DICTDB._Db for a schema for a Non-PROGRESS db */

    ASSIGN
      DICTDB._Db._Db-name    = INPUT DICTDB._Db._Db-name
      user_env[2]            = DICTDB._Db._Db-name
      DICTDB._Db._Db-addr    = (IF DICTDB._Db._Db-addr = ? THEN "" ELSE DICTDB._Db._Db-addr)
      DICTDB._Db._Db-comm    = TRIM(INPUT f_comm)
      /* Remove any line feeds (which we get on WINDOWS) */
      DICTDB._Db._Db-comm    = REPLACE(DICTDB._Db._Db-comm, CHR(13), "")
      user_dbname     = DICTDB._Db._Db-name
      .

   /* these are changed only when amode */
   IF amode THEN  DO:
       DICTDB._Db._Db-xl-name = if codepage = "<internal defaults apply>" 
                             then ? 
                             else codepage.
       DICTDB._Db._Db-coll-name = INPUT collname.
   END.

    IF x-p THEN DICTDB._Db._Db-addr = INPUT f_addr.

   { prodict/user/usercon.i }

END.   /* _trx: do transaction */

RELEASE DICTDB._Db.   /* I'm not sure why we need this? (los) */

IF canned THEN user_path = "".
HIDE FRAME userschg NO-PAUSE.
RETURN.

/*====================================================================*/





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrscon - connect databases */
/*
user_env[1] = "usr" to assume connecting database named in user_dbname
user_env[1] = "env" to assume connecting database named in user_env[2]
user_env[1] = "" otherwise
*/

/* history:
95-04-17    j. palazzo  Added arg_network, arg_host, arg_service.
              We don't actually use them since they are not prompted for
              directly in the character Connect Database dialog. They are
              just output parameter placeholders.
              
94-05-02    hutegger    deleted bi and ai - fill-ins from dialog-box
              changed tty-DlgBox to ask for multi-user
              
D. McMann 02/21/03 Replaced GATEWAYS with DATASERVERS              
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE trash       AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_1       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE arg_db      AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_ld      AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_dt      AS CHARACTER NO-UNDO INITIAL "PROGRESS":u.
DEFINE VARIABLE arg_p       AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_pf      AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_u       AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_tl      AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_network AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_host    AS CHARACTER NO-UNDO.
DEFINE VARIABLE arg_service AS CHARACTER NO-UNDO.
DEFINE VARIABLE ix          AS INTEGER   NO-UNDO.
DEFINE VARIABLE stri        AS CHARACTER NO-UNDO.
DEFINE VARIABLE args        AS CHARACTER NO-UNDO EXTENT 4.
DEFINE VARIABLE canned      AS LOGICAL   NO-UNDO INITIAL TRUE.

DEFINE NEW GLOBAL SHARED VARIABLE fast_track AS LOGICAL. /* FT active? */
/*
{prodict/misc/filesbtn.i &NAME = btn_Filen}
{prodict/misc/filesbtn.i &NAME = btn_Filet}
{prodict/misc/filesbtn.i &NAME = btn_Filep}
*/

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 3 NO-UNDO INITIAL [
  /* 1*/ "You must supply a physical name or parameter file",
  /* 2*/ "You have to leave Fast Track before connecting a new database",
  /* 3*/ "The connection parameters contain a wrong -dt entry"
  ].
/*
 *FORM
 *  arg_db LABEL "Physical Name"  FORMAT "x(70)" COLON 17       /* -db */
 *      	       	     	        VIEW-AS FILL-IN SIZE 38 BY 1
 *  btn_Filen                                                   SKIP
 *
 *  arg_ld LABEL "Logical Name"   FORMAT "x(32)" COLON 17       SKIP    /* -ld */
 *  arg_dt LABEL "Database Type" 	FORMAT "x(12)" COLON 17       SKIP    /* -dt */
 *  arg_u  LABEL "Userid"       	FORMAT "x(50)" COLON 17       SKIP    /* -U */
 *  arg_p  LABEL "Password"      	FORMAT "x(50)" COLON 17 BLANK SKIP    /* -P */
 *  arg_1  LABEL "Multiple Users"                COLON 17       SKIP    /* -1 */
 *  arg_tl LABEL "Trigger Location" FORMAT "x(70)" COLON 17             /*-trig*/
 *      	       	     	      	VIEW-AS FILL-IN SIZE 38 BY 1
 *  btn_Filet                                                   SKIP
 *  arg_pf LABEL "Parameter File" FORMAT "x(70)" COLON 17		      /* -PF */
 *      	       	     	        VIEW-AS FILL-IN SIZE 38 BY 1
 *  btn_Filep                                                   SKIP(1)
 *
 *  "Other CONNECT-Statement parameters:"       	     	AT 2  SKIP
 *  args[2] NO-LABEL   	      	 FORMAT "x(64)" AT 4  	      SKIP
 *  args[3] NO-LABEL   	      	 FORMAT "x(64)" AT 4  	      SKIP
 *  args[4] NO-LABEL   	      	 FORMAT "x(64)" AT 4
 *
 *  {prodict/user/userbtns.i}
 *
 *  WITH FRAME con-man
 *  ROW 2 CENTERED SIDE-LABELS ATTR-SPACE
 *  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
 *  VIEW-AS DIALOG-BOX TITLE " Connect Database ".
 */
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*===============================Triggers=================================*/

/*
&IF "{&WINDOW-SYSTEM}":u <> "TTY":u &THEN
ON HELP OF FRAME con-man
  RUN adecomm/_adehelp.p ("admn":u,"CONTEXT":u,{&Connect_Database_Dlg_Box},?).
&ENDIF

/*----- GO or HIT of OK BUTTON -----*/
ON GO OF FRAME con-man DO:	/* or OK Button because of auto-go */
  DEFINE VARIABLE num AS INTEGER NO-UNDO.

  ASSIGN
    INPUT FRAME con-man arg_db
    arg_ld arg_u arg_p arg_1 arg_pf arg_tl
    args[2] args[3] args[4].

  IF (arg_db = "" OR arg_db = ?) AND (arg_pf = "" OR arg_pf = ?) THEN DO:
    MESSAGE new_lang[1] /* must supply dbname or -pf file */
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.

  args[1] = arg_db.
  IF arg_ld <> "" THEN args[1] = args[1] + ' -ld ':u + arg_ld.
  IF arg_dt <> "" THEN args[1] = args[1] + ' -dt ':u + arg_dt.
  IF arg_tl <> "" THEN args[1] = args[1] + ' -trig ':u + arg_tl.
  IF arg_pf <> "" THEN args[1] = args[1] + ' -pf ':u + arg_pf.
  IF NOT arg_1    THEN args[1] = args[1] + ' -1':u.
  IF arg_u  <> "" THEN args[1] = args[1] + ' -U ':u  + arg_u.
  IF arg_p  <> "" THEN args[1] = args[1] + ' -P ':u  + arg_p.

  /* The only way to really see if connect succeeded is to compare
    num-dbs before and after.  Certain conditions - like database
    already connected, do not raise error.
  */
  num = NUM-DBS.
  MESSAGE "Connecting".
  DO ON ERROR UNDO, LEAVE:
    CONNECT VALUE(args[1]) VALUE(args[2]) VALUE(args[3]) VALUE(args[4]).
  END.
  HIDE MESSAGE NO-PAUSE.

  IF NUM-DBS = num THEN DO:
    APPLY "ENTRY":u TO arg_db.
    RETURN NO-APPLY.  /* an error occurred */
  END.
END.

/*----- LEAVE of LOGICAL NAME -----*/
ON LEAVE OF arg_ld IN FRAME con-man DO:
  IF CAN-DO("DICTDB,DICTDB2,DICTDBG":u, INPUT FRAME con-man arg_ld) THEN DO:
    MESSAGE
      "You cannot connect a database with a logical name of " +
      INPUT FRAME con-man arg_ld + ".":u
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
END.

/*----- LEAVE of DATABASE TYPE -----* /
 * not updateable anymore <hutegger>
 *ON LEAVE OF arg_dt IN FRAME con-man
 *DO:
 *  IF NOT CAN-DO(GATEWAYS, INPUT FRAME con-man arg_dt) THEN DO:
 *    MESSAGE "This copy of PROGRESS does not support that database type."
 *      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 *    RETURN NO-APPLY.
 *  END.
 *END.
 */

/*----- HIT OF FILE BUTTONS -----*/
ON CHOOSE OF btn_Filen IN FRAME con-man
  RUN prodict/misc/_filebtn.p (arg_db:HANDLE IN FRAME con-man /*Fillin*/,
                               "Find Database File"           /*Title*/,
                               "*.db":u                       /*Filter*/,
                               yes                            /*Must exist*/).

ON CHOOSE OF btn_Filet IN FRAME con-man
  RUN prodict/misc/_filebtn.p (arg_tl:HANDLE IN FRAME con-man /*Fillin*/,
                               "Find Procedure Library File"  /*Title*/,
                               "*.pl":u                       /*Filter*/,
                               no                             /*Must exist*/).

ON CHOOSE OF btn_Filep IN FRAME con-man
  RUN prodict/misc/_filebtn.p (arg_pf:handle in frame con-man /*Fillin*/,
                               "Find Parameter File"          /*Title*/,
                               "*.pf":u                       /*Filter*/,
                               yes                            /*Must exist*/).

/*----- LEAVE OF FILE NAME FIELDS -----*/
ON LEAVE OF arg_db IN FRAME con-man
  arg_db:SCREEN-VALUE IN FRAME con-man =
     TRIM(arg_db:SCREEN-VALUE IN FRAME con-man).

ON LEAVE OF arg_tl IN FRAME con-man
  arg_tl:SCREEN-VALUE IN FRAME con-man =
    TRIM(arg_tl:SCREEN-VALUE IN FRAME con-man).

ON LEAVE OF arg_pf IN FRAME con-man
  arg_pf:SCREEN-VALUE IN FRAME con-man =
    TRIM(arg_pf:SCREEN-VALUE IN FRAME con-man).
*/

/*============================Mainline code===============================*/

/* If dictionary was started from Fast Track, return here.                  */
/* (Connecting within Fast Track doesn't make sense because file=-caching   */
/*  is done at startup-time when ft.p is run                                */
IF fast_track THEN DO:
  MESSAGE new_lang[2] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

/* if current db not connected, set default params */
IF user_env[1] = "usr":u
  AND NOT CONNECTED(user_dbname)
  AND user_dbname <> ""
  AND user_dbtype <> "PROGRESS":u
  AND CAN-DO(DATASERVERS,user_dbtype) THEN DO: /* current db not connected */
  ASSIGN
    arg_db = user_dbname
    arg_ld = user_dbname
    arg_dt = user_dbtype.
  IF NUM-DBS > 0 THEN
    RUN adecomm/_getconp.p (INPUT        user_dbname,
                            INPUT-OUTPUT arg_db,
                            INPUT-OUTPUT arg_ld,
                            INPUT-OUTPUT arg_dt,
                            OUTPUT       arg_tl,
                            OUTPUT       arg_pf,
                            OUTPUT       arg_1,
                            OUTPUT       arg_network,
                            OUTPUT       arg_host,
                            OUTPUT       arg_service,
                            OUTPUT       arg_u,
                            OUTPUT       arg_p,
                            OUTPUT       args[2],
                            OUTPUT       args[3],
                            OUTPUT       args[4]).

  IF arg_dt <> user_dbtype THEN DO:
    MESSAGE new_lang[3] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
END.        /* current db not connected */

IF user_env[1] = "env":u THEN DO:
  ASSIGN
    arg_db  = user_env[2]
    arg_dt  = "PROGRESS":u
    arg_ld  = ""
    arg_tl  = ""
    arg_pf  = ""
    arg_1   = FALSE
    arg_u   = ""
    arg_p   = ""
    args[2] = ""
    args[3] = ""
    args[4] = "".

  RUN prodict/misc/osprefix.p
    (INPUT user_env[2],OUTPUT trash,OUTPUT arg_ld).

  ix = LENGTH(arg_ld, "CHARACTER":u) - 2.
  IF ix > 1 AND SUBSTRING(arg_ld, ix, 3, "CHARACTER":u) = ".db":u THEN
    arg_ld = SUBSTRING(arg_ld, 1, ix - 1, "CHARACTER":u).
END.

/* Removed spaces from line break which were causing problems */
ASSIGN args[2] = TRIM(args[2] + args[3] + args[4]).

RUN adecomm/_dbconnx.p (INPUT        YES,
                        INPUT-OUTPUT arg_db,
                        INPUT-OUTPUT arg_ld,
                        INPUT-OUTPUT arg_dt,
                        INPUT-OUTPUT arg_1,
                        INPUT-OUTPUT arg_network,
                        INPUT-OUTPUT arg_host,
                        INPUT-OUTPUT arg_service,
                        INPUT-OUTPUT arg_u,
                        INPUT-OUTPUT arg_p,
                        INPUT-OUTPUT arg_tl,
                        INPUT-OUTPUT arg_pf,
                        INPUT-OUTPUT args[2],
                        OUTPUT       stri).

canned = (IF arg_ld = ? THEN YES ELSE NO).

/* Even if there's an error do this.  We may have gotten an error on
 * one database, but another may have been connected successfully.
 */
RUN prodict/_dctsget.p.

{ prodict/user/usercon.i }

IF canned THEN
  user_path = "".

HIDE FRAME con-man NO-PAUSE.

RETURN.

/* _usrscon.p - end of file */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* usersdbf - translate dbase .dbf and .ndx into .df file

   History:  07/14/98 DLM Added _Owner to _File finds
   
 */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE i       AS INTEGER              NO-UNDO.
DEFINE VARIABLE msg-num AS INTEGER INITIAL 0    NO-UNDO.
DEFINE VARIABLE nuxi    AS LOGICAL INITIAL TRUE NO-UNDO.
DEFINE VARIABLE scrap   AS CHARACTER            NO-UNDO.
DEFINE VARIABLE canned  AS LOGICAL INITIAL TRUE NO-UNDO.
/* used for super-tenant multi-tenant load */
define variable isSuperTenant as logical no-undo.
define variable isMultiTenant as logical no-undo.
define variable gTenant  as character no-undo.
define button btnTenant size 18 by 1 label "Select Tenant...".

{prodict/misc/filesbtn.i &NAME = btn_File1}
{prodict/misc/filesbtn.i &NAME = btn_File4}
{prodict/misc/filesbtn.i &NAME = btn_File5}
{prodict/misc/filesbtn.i &NAME = btn_File6}
{prodict/misc/filesbtn.i &NAME = btn_File7}
{prodict/misc/filesbtn.i &NAME = btn_File8}
{prodict/misc/filesbtn.i &NAME = btn_File9}
{prodict/misc/filesbtn.i &NAME = btn_File10}
{prodict/misc/filesbtn.i &NAME = btn_File11}
{prodict/misc/filesbtn.i &NAME = btn_File12}
{prodict/misc/filesbtn.i &NAME = btn_File13}

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 3 NO-UNDO INITIAL [
  /* 1*/ "Cannot find file",
  /* 2*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 3*/ "You do not have permission to use this option."
].
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
&GLOBAL-DEFINE LINEUP 18
&GLOBAL-DEFINE FILLWIDTH 49
&GLOBAL-DEFINE TENANTWIDTH 42
&GLOBAL-DEFINE TEXTLINEUP 11
&GLOBAL-DEFINE LOCAL_WIDG {&VM_WIDG}
&ELSE
&GLOBAL-DEFINE LINEUP 18
&GLOBAL-DEFINE TENANTWIDTH 37
&GLOBAL-DEFINE FILLWIDTH 45
&GLOBAL-DEFINE TEXTLINEUP 2
&GLOBAL-DEFINE LOCAL_WIDG {&VM_WID}
&ENDIF
FORM
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   SKIP({&TFM_WID})
  &ENDIF
  
  gTenant COLON {&LINEUP} label "Effective Tenant" format "x(32)"    
         view-as fill-in size {&TENANTWIDTH} by 1
  btntenant skip ({&VM_WID})
  user_env[1] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP} LABEL "&dBASE File"
  btn_File1 SKIP({&LOCAL_WIDG})
  user_env[4] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP} LABEL "Index File #&1"
  btn_File4 SKIP ({&VM_WID})
  user_env[5] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP} LABEL "Index File #&2"
  btn_File5 SKIP ({&VM_WID})
  user_env[6] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP} LABEL "Index File #&3"
  btn_File6 SKIP ({&VM_WID})
  user_env[7] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP}  LABEL "Index File #&4"
  btn_File7 SKIP ({&VM_WID})
  user_env[8] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP} LABEL "Index File #&5"
  btn_File8 SKIP ({&VM_WID})
  user_env[9] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN SIZE {&FILLWIDTH} BY 1 
        COLON {&LINEUP} LABEL "Index File #&6"
  btn_File9 SKIP ({&VM_WID})
  user_env[10] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN 
        SIZE {&FILLWIDTH} BY 1 LABEL "Index File #&7" COLON {&LINEUP}
  btn_File10 SKIP ({&VM_WID})
  user_env[11] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN 
        SIZE {&FILLWIDTH} BY 1 LABEL "Index File #&8" COLON {&LINEUP}
  btn_File11 SKIP ({&VM_WID})
  user_env[12] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN 
        SIZE {&FILLWIDTH} BY 1 LABEL "Index File #&9" COLON {&LINEUP}
  btn_File12 SKIP ({&VM_WID})
  user_env[13] {&STDPH_FILL} FORMAT "x(80)" VIEW-AS FILL-IN 
        SIZE {&FILLWIDTH} BY 1 LABEL "Index File #1&0" COLON {&LINEUP}
  btn_File13 SKIP({&VM_WIDG})
  "If there are more than 10 index files, this dialog can be used again to"
                                                                    AT {&TEXTLINEUP} VIEW-AS TEXT 
  "import the additional indexes (this will not harm the existing definition)."
                                                                     AT {&TEXTLINEUP} VIEW-AS TEXT 
  {prodict/user/userbtns.i}
  WITH FRAME dbdefs 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  width 83
  &ELSE
  size 78 by 19 row 1 
  &ENDIF
  CENTERED SIDE-LABELS 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX 
  TITLE " Import dBASE II, III, III+ and IV Definitions ".

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/*===============================Functions=================================*/
function selectTenant return logical (hTenant as handle):
    define variable tenantdlg as prodict.pro._tenant-sel-presenter no-undo.
    tenantdlg = new  prodict.pro._tenant-sel-presenter ().
    do with frame write-dump-dir-mt:
           &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        /* adjust the browse aligned and under field (at least try...) */   
        if  hTenant:frame:row < 0 then  /* this does not really work with large negative */                  
            tenantdlg:Row = (hTenant:row + hTenant:height) + 2.
        else 
            tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row + 0.5.
        tenantdlg:Col = hTenant:col + hTenant:frame:col .
           &ELSE
        
        tenantdlg:Row = hTenant:row + hTenant:height +  hTenant:frame:row.
       
           &ENDIF
    end.
    tenantdlg:QueryString = "for each ttTenant where ttTenant.type <> 'super'".
    tenantdlg:Title = "Select Tenant".
  
/*    glInSelect = true. /* stop end-error anywhere trigger */*/ 
    if tenantdlg:Wait() then
    do: 
        hTenant:screen-value = tenantdlg:ColumnValue("ttTenant.name").
        apply "value-changed" to hTenant.
    end.
/*    glInSelect = false.*/
 
end.  
/* the use of name is somewhat weird here (copied from elsewhere where it doesn't 
make much sense either... (but in anticipaton of lower case when used in file names) */
function getTenantName returns char(pctenant as char):
    define variable lok     as logical no-undo.
    define variable hbuffer as handle no-undo. 
    define variable cValue   as character no-undo.
    
    CREATE BUFFER hbuffer FOR TABLE "DICTDB._tenant".
    lok = hbuffer:find-unique ("where _tenant._Tenant-name = " + quoter(pcTenant)) no-error.
    if lok then 
        cValue = hBuffer::_tenant-name.
    
    delete object hbuffer.    
    return cValue.
end function. 

function validateTenantName returns logical(ctenant as char):
    define variable lok as logical no-undo.
    if cTenant = "" then
    do:
        MESSAGE "Please specify which Tenant to dump data for."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false. 
    end.
    if getTenantName(cTenant) = "" then 
    do:
        MESSAGE "There is no Tenant with name " +  ctenant + " in the database."
                    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return false.
    end.
    return true.
end function. 

/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame dbdefs
   or CHOOSE of btn_Help in frame dbdefs
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Import_dBase_Definitions_Dlg_Box},
                                               INPUT ?).
&ENDIF

on choose of btnTenant in frame dbdefs
do:
     selectTenant(gTenant:handle in frame dbdefs).
end. 


ON GO OF FRAME dbdefs
DO:
  DEFINE VAR in_fil AS CHAR NO-UNDO.
  DEFINE VAR fil    AS CHAR NO-UNDO.

  if isMultiTenant then 
  do:
       if not validateTenantName(gtenant:screen-value) then
       do:
           apply "entry" to gtenant.
           return no-apply.
       end.        
  end.    
   

  fil_loop:
  DO i = 1 TO 13:
    IF i = 2 THEN i = 4. /* skip to iteration 4, i will increment from there */
    in_fil = INPUT FRAME dbdefs user_env[i].
   
    /* If blank or a file that's found, it's good - except for the first
       one which can't be blank.
    */
    IF (in_fil = "" AND i > 1) OR SEARCH(in_fil) <> ? THEN NEXT fil_loop.

    IF in_fil <> "" THEN DO:
      /* Otherwise tack on the proper extension and look again */
      fil = in_fil + (IF i = 1 THEN ".dbf" ELSE ".ndx").
      IF SEARCH(fil) <> ? THEN DO:
        DISPLAY fil @ user_env[i] WITH FRAME dbdefs.
        NEXT fil_loop.
      END.
  
      /* Still not found - try upper case extension */
      fil = in_fil + (IF i = 1 THEN ".DBF" ELSE ".NDX").
      IF SEARCH(fil) <> ? THEN DO:
        DISPLAY fil @ user_env[i] WITH FRAME dbdefs.
        NEXT fil_loop.
      END.
    END.

    MESSAGE new_lang[1] (in_fil) /* can't find fil ... */
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
   
    /* I should be able to do this: APPLY "ENTRY" TO user_env[i] IN FRAME..
       but it doesn't let me! - it wants a constant subscript so:
    */
    CASE i:
      WHEN 1  THEN APPLY "ENTRY" TO user_env[1]  IN FRAME dbdefs.
      WHEN 4  THEN APPLY "ENTRY" TO user_env[4]  IN FRAME dbdefs.
      WHEN 5  THEN APPLY "ENTRY" TO user_env[5]  IN FRAME dbdefs.
      WHEN 6  THEN APPLY "ENTRY" TO user_env[6]  IN FRAME dbdefs.
      WHEN 7  THEN APPLY "ENTRY" TO user_env[7]  IN FRAME dbdefs.
      WHEN 8  THEN APPLY "ENTRY" TO user_env[8]  IN FRAME dbdefs.
      WHEN 9  THEN APPLY "ENTRY" TO user_env[9]  IN FRAME dbdefs.
      WHEN 10 THEN APPLY "ENTRY" TO user_env[10] IN FRAME dbdefs.
      WHEN 11 THEN APPLY "ENTRY" TO user_env[11] IN FRAME dbdefs.
      WHEN 12 THEN APPLY "ENTRY" TO user_env[12] IN FRAME dbdefs.
      WHEN 13 THEN APPLY "ENTRY" TO user_env[13] IN FRAME dbdefs.
    END.      
    RETURN NO-APPLY.
  END.
END.

ON WINDOW-CLOSE OF FRAME dbdefs
   APPLY "END-ERROR" TO FRAME dbdefs.

/*----- HIT of FILE BUTTONS -----*/
ON CHOOSE OF btn_File1 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[1]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find dBASE File"  /*Title*/,
        INPUT "*.DBF"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File4 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[4]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File5 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[5]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File6 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[6]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File7 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[7]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File8 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[8]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File9 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[9]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File10 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[10]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File11 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[11]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File12 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[12]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
ON CHOOSE OF btn_File13 in frame dbdefs DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT user_env[13]:handle in frame dbdefs /*Fillin*/,
        INPUT "Find Index File"  /*Title*/,
        INPUT "*.NDX"             /*Filter*/,
        INPUT yes                /*Must exist*/).
END.
/*----- LEAVE of fill-ins: trim blanks the user may have typed in filenames---*/
ON LEAVE OF user_env[1] in frame dbdefs
   user_env[1]:screen-value in frame dbdefs = 
        TRIM(user_env[1]:screen-value in frame dbdefs).
ON LEAVE OF user_env[4] in frame dbdefs
   user_env[4]:screen-value in frame dbdefs = 
        TRIM(user_env[4]:screen-value in frame dbdefs).
ON LEAVE OF user_env[5] in frame dbdefs
   user_env[5]:screen-value in frame dbdefs = 
        TRIM(user_env[5]:screen-value in frame dbdefs).
ON LEAVE OF user_env[6] in frame dbdefs
   user_env[6]:screen-value in frame dbdefs = 
        TRIM(user_env[6]:screen-value in frame dbdefs).
ON LEAVE OF user_env[7] in frame dbdefs
   user_env[7]:screen-value in frame dbdefs = 
        TRIM(user_env[7]:screen-value in frame dbdefs).
ON LEAVE OF user_env[8] in frame dbdefs
   user_env[8]:screen-value in frame dbdefs = 
        TRIM(user_env[8]:screen-value in frame dbdefs).
ON LEAVE OF user_env[9] in frame dbdefs
   user_env[9]:screen-value in frame dbdefs = 
        TRIM(user_env[9]:screen-value in frame dbdefs).
ON LEAVE OF user_env[10] in frame dbdefs
   user_env[10]:screen-value in frame dbdefs = 
        TRIM(user_env[10]:screen-value in frame dbdefs).
ON LEAVE OF user_env[11] in frame dbdefs
   user_env[11]:screen-value in frame dbdefs = 
        TRIM(user_env[11]:screen-value in frame dbdefs).
ON LEAVE OF user_env[12] in frame dbdefs
   user_env[12]:screen-value in frame dbdefs = 
        TRIM(user_env[12]:screen-value in frame dbdefs).
ON LEAVE OF user_env[13] in frame dbdefs
   user_env[13]:screen-value in frame dbdefs = 
        TRIM(user_env[13]:screen-value in frame dbdefs).


/*============================Mainline code===============================*/

IF dict_rog THEN msg-num = 2. /* look but don't touch */
ELSE DO FOR DICTDB._File i = 1 TO 3:
  FIND DICTDB._File
    WHERE DICTDB._File._File-name = ENTRY(i,"_File,_Field,_Index")
      AND DICTDB._File._Owner = "PUB".
  IF   NOT CAN-DO(_Can-read,  USERID("DICTDB"))
    OR NOT CAN-DO(_Can-write, USERID("DICTDB"))
    OR NOT CAN-DO(_Can-delete,USERID("DICTDB"))
    OR NOT CAN-DO(_Can-create,USERID("DICTDB")) THEN msg-num = 3.
END.

IF msg-num > 0 THEN DO:
  MESSAGE new_lang[msg-num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

if int(dbversion("dictdb")) > 10 then
do:
   isSuperTenant = can-find(first dictdb._tenant) and  tenant-id("dictdb") < 0.
   if isSuperTenant then
   do:
      isMultiTenant = true. 
      gTenant = get-effective-tenant-name("dictdb").
   end.    
end.

user_env = "".

PAUSE 0.
/* just messes with stuff and sets row to high on tty and seems to serve 
  no purpose in gui (okrun ?). 
/* Adjust the graphical rectangle and the ok and cancel buttons */
{prodict/user/userctr.i
    &FRAME = "FRAME dbdefs"
}
*/
 
{adecomm/okrun.i  
    &FRAME  = "FRAME dbdefs" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}
 
if not isMultiTenant then
do:
    gTenant:hidden in frame dbdefs = true. 
    btnTenant:hidden in frame dbdefs = true.    
    if session:window-system = "tty" then
    do:
          user_env[1]:row = 1 . 
          user_env[1]:side-label-handle:row = 1.
          btn_File1:row = 1.
       
    end.    
    else
       run adjustframe(FRAME dbdefs:handle).
    
end.    
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  UPDATE gTenant when isMultiTenant 
         btnTenant when isMultiTenant  
         user_env[1] /*nuxi*/ btn_File1
         user_env[4] btn_File4
         user_env[5] btn_File5
         user_env[6] btn_File6
         user_env[7] btn_File7
         user_env[8] btn_File8
         user_env[9] btn_File9
         user_env[10] btn_File10
         user_env[11] btn_File11
         user_env[12] btn_File12
         user_env[13] btn_File13
               btn_OK btn_Cancel {&HLP_BTN_NAME}
               WITH FRAME dbdefs.
  canned = FALSE.
END.

user_env[2] = STRING(nuxi,"y/n").

if canned THEN 
  user_path = "".
else if isMultiTenant then 
    set-effective-tenant(gTenant,"dictdb").

HIDE FRAME dbdefs NO-PAUSE.
RETURN.
/*==========================Internal Procedures=========================*/
/* this is really adjust frame after hide  of tenant */ 
procedure adjustFrame:      
    define input  parameter pframe  as handle no-undo.
    define variable hWidget  as handle no-undo.
    define variable deAdjust as decimal no-undo.
    
    deAdjust =  1 . 
    hwidget = pframe:first-child.
    hwidget = hwidget:first-child.
    do while valid-handle(hwidget):
        if hwidget:hidden = false then
           hwidget:row = hwidget:row - deAdjust.
        hwidget= hwidget:next-sibling.
    end.   
    pframe:scrollable = false. 
    pframe:height = pframe:height - deAdjust. 
end.    
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* _usrsdel.p - delete database 

      Modified 11/5/97 DLM Removed the check to see if any schema present
                           and will just ask if user is sure.
               07/14/98 DLM Added _Owner to _File finds
               04/24/00 DLM Added deleting of _db without user interaction so
                            the Create MSS Dataserver option can get rid of an
                            old version not supported by the dataserver.
                           
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer  AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE edbtyp  AS CHARACTER             NO-UNDO.
DEFINE VARIABLE msg-num AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE scrap   AS CHARACTER             NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  /*  1*/ "You cannot delete a {&PRO_DISPLAY_NAME} database through this program.",
  /*  2*/ "This is only for removing non-{&PRO_DISPLAY_NAME} data definitions from the schema holder.",
  /*  3*/ "You cannot remove non-{&PRO_DISPLAY_NAME} data definitions from a schema holder that still",
  /*  4*/ "contains table definitions.  Remove the table definitions first.",
  /*  5*/ "You do not have permission to delete data definitions from the schema holder definitions.",
  /*6,7*/ "Data definitions for database", "removed.",
  /*8,9*/ "Data definitions for database", "NOT removed.",
  /* 10*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 11*/ "Are you sure you want to remove the data definitions for the", 
  /* 12*/           "database called"
].
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

assign
  edbtyp = { adecomm/ds_type.i
             &direction = "itoe"
             &from-type = "user_dbtype"
             }.

DO FOR DICTDB._File:
  FIND _File "_Db" WHERE _File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-delete,USERID("DICTDB")) THEN msg-num = 5.
  ELSE IF dict_rog THEN msg-num = 10. /* look but don't touch */
  IF msg-num > 0 THEN DO:
    MESSAGE new_lang[msg-num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
    RETURN.
  END.
END.

IF user_dbtype = "PROGRESS" AND user_env[35] <> "wrg-ver" THEN DO:
  MESSAGE new_lang[1]  /* can't delete progress db */
      	  new_lang[2]
      	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

DO:
  IF user_env[35] <> "wrg-ver" THEN DO:
    answer = FALSE.
    MESSAGE new_lang[11] SKIP /* r-u-sure */
        	  edbtyp + " " + new_lang[12] + ' "' + user_dbname + '"?' 
        	  VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
  END.
  ELSE ASSIGN answer = TRUE.
  IF answer THEN DO:
    RUN "adecomm/_setcurs.p" ("WAIT").
    IF CONNECTED(user_dbname) THEN DISCONNECT VALUE(user_dbname).
    DO TRANSACTION:
      FIND _Db WHERE RECID(_Db) = drec_db.
      FOR EACH _File OF _Db:
        { prodict/dump/loadkill.i }
      END.
      FOR EACH _SEQUENCE OF _Db:
        DELETE _Sequence.
      END.
      DELETE _Db.
    END.
    RUN "adecomm/_setcurs.p" ("").
   IF user_env[35] <> "wrg-ver" THEN
        MESSAGE new_lang[6] '"' + user_dbname + '"' new_lang[7]
      VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
   ASSIGN
      drec_db     = ?
      user_dbname = ""
      cache_dirty = TRUE.
  END.
  ELSE DO:
     user_path = "".  /* If not deleted, don't ask user to select a db */
     MESSAGE
        new_lang[8] '"' + user_dbname + '"' new_lang[9]
      	VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  END.
END.

RETURN.

/***********************************************************************
* Copyright (C) 2000,2006,2009 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* usersecu - file/field level can-do security program

   History: D. McMann 07/09/98 Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                               to FIND _File.

 */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }
{ prodict/user/userpik.i NEW }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE qbf AS CHARACTER EXTENT 11 NO-UNDO INITIAL [
  "NextField",     "PrevField", "ForwardTable",
  "BackwardTable", "Modify",    "SwitchTable",
  "JumpField",     "CallAdmin", "UserEditor",
  "Report",        "Exit"
 ].

FORM
  qbf[ 1] /*NextField*/     FORMAT "x(9)"  HELP "Next Field."
  qbf[ 2] /*PrevField*/     FORMAT "x(9)"  HELP "Previous Field."
  qbf[ 3] /*ForwardTable*/  FORMAT "x(12)" HELP "Next Table."
  qbf[ 4] /*BackwardTable*/ FORMAT "x(13)" HELP "Previous Table."
  qbf[ 5] /*Modify*/        FORMAT "x(6)"  HELP "Modify above permissions."
  qbf[ 6] /*SwitchTable*/   FORMAT "x(11)" HELP "Switch to a different table."
    SKIP 
  qbf[ 7] /*JumpField*/     FORMAT "x(9)"  HELP "Jump to a specific field."
  qbf[ 8] /*CallAdmin*/     FORMAT "x(9)"
    HELP "Call to the Security Administrator program."
  qbf[ 9] /*UserEditor*/    FORMAT "x(10)" HELP "Go to ~"Edit User List~"."
  qbf[10] /*Report*/        FORMAT "x(6)"  HELP "List the current users."
  qbf[11] /*Exit*/          FORMAT "x(4)"  HELP "Exit ~"Change Data Security~"."
  WITH FRAME qbf NO-BOX NO-LABELS ATTR-SPACE
  ROW SCREEN-LINES - 3 COLUMN 1.

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 10 NO-UNDO INITIAL [
  /* 1*/ "You must be a Security Administrator to execute this function.",
  /* 2*/ "",   /* goes with 1 */

  /* 3*/ "You need Database Security Administrator privileges in the master",
  /* 4*/ "{&PRO_DISPLAY_NAME} DB which contains the schema of this database to continue.",

  /* 5*/ "You may not use this function with a blank userid.  This applies to",
  /* 6*/ "both the {&PRO_DISPLAY_NAME} DB and the specific foreign DB, if appropriate.",

  /* 7*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 8*/ "You can only alter security on SQL tables with GRANT and REVOKE.",
  /* 9*/ "There are no fields in this table to jump to!",

  /*10*/ "You cannot change permissions to exclude yourself."
].

FORM
  _File._Can-read   COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP
  _File._Can-write  COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP
  _File._Can-create COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP
  _File._Can-delete COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP
  _File._Can-dump   COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP
  _File._Can-load   COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP(1)
  {prodict/user/usersecu.i}
  WITH FRAME fil ROW 2 COLUMN 1 ATTR-SPACE SIDE-LABELS
  TITLE COLOR NORMAL ' Table Name: "' + _File._File-name + '" '.

FORM
  _Field._Field-name COLON 12 FORMAT "x(32)" SKIP(1)
  _Field._Can-read   COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP
  _Field._Can-write  COLON 12 VIEW-AS EDITOR INNER-LINES 1 INNER-CHARS 63 SKIP(3)
  {prodict/user/usersecu.i}
  WITH FRAME fld ROW 2 COLUMN 1 ATTR-SPACE SIDE-LABELS
  TITLE COLOR NORMAL ' Table Name: "' + _File._File-name + '" '.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

DEFINE VARIABLE i       AS INTEGER               NO-UNDO.
DEFINE VARIABLE l       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE msg-num AS INTEGER INITIAL     0 NO-UNDO.
DEFINE VARIABLE qbf#    AS INTEGER               NO-UNDO.
DEFINE VARIABLE r-o     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE re-use  AS LOGICAL INITIAL FALSE NO-UNDO.

DEFINE VARIABLE istrans AS LOGICAL INITIAL TRUE. /*UNDO (not no-undo!) */
DO ON ERROR UNDO:
  istrans = FALSE.
  UNDO,LEAVE.
END.

FIND _File WHERE RECID(_File) = drec_file.

r-o = user_env[9] = "ro".
IF ((istrans
  OR PROGRESS = "Run-Time"
  OR CAN-DO("READ-ONLY",DBRESTRICTIONS(user_dbname))) AND NOT r-o)
  OR _File._Db-lang <> 0 THEN DO:
  MESSAGE new_lang[IF _File._Db-lang <> 0 THEN 8 ELSE 7]
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  HIDE MESSAGE NO-PAUSE.
  IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN DO:
    user_path = "".
    RETURN.
  END.
  IF KEYFUNCTION(LASTKEY) = "GET" THEN DO:
    user_path = "1=,_usrtget,9=" + user_env[9] + ",_usrsecu".
    RETURN.
  END.
END.
IF dict_rog THEN r-o = TRUE.

RUN "prodict/_dctadmn.p" (INPUT USERID("DICTDB"),OUTPUT l).
IF NOT l                 THEN msg-num = 1. /* secu admin? */
IF NOT l AND user_dbtype <> "PROGRESS"
                         THEN msg-num = 3. /* secu admn in pro db */
IF USERID("DICTDB") = "" THEN msg-num = 5. /* userid set? */

IF msg-num <> 0 THEN DO:
  MESSAGE new_lang[msg-num] SKIP
      	  new_lang[msg-num + 1] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

/*
----------------- Table Name: ________________________________ ---------------
|   Can-Read: *                                                              |
|  Can-Write: *                                                              |
| Can-Create: *                                                              |
| Can-Delete: *                                                              |
| Can-Dump:   *                                                              |
| Can-Load:   *                                                              |
------------------------------------------------------------------------------

----------------- Table Name: ________________________________ ---------------3
| Field Name: ________________________________                               |4
|                                                                            |5
|   Can-Read: *                                                              |6
|  Can-Write: *                                                              |7
------------------------------------------------------------------------------8
*/

/* use these statements to man-handle scoping */
RELEASE _Field.

PAUSE 0.
DISPLAY qbf WITH FRAME qbf.

_outer: DO WHILE TRUE:

  IF AVAILABLE _Field THEN DO:
    HIDE FRAME fil NO-PAUSE.
    DISPLAY _Field._Field-name
      _Field._Can-read _Field._Can-write WITH FRAME fld.
  END.
  ELSE DO:
    HIDE FRAME fld NO-PAUSE.
    DISPLAY _File._Can-read   _File._Can-write
            _File._Can-create _File._Can-delete 
            _File._Can-dump   _File._Can-load
      	 WITH FRAME fil.
  END.

  IF NOT re-use THEN DO:
    ON CURSOR-LEFT BACK-TAB.
    ON CURSOR-RIGHT     TAB.
    _choose: DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF qbf# >= 1 AND qbf# <= 11 THEN NEXT-PROMPT qbf[qbf#] WITH FRAME qbf.
      CHOOSE FIELD qbf NO-ERROR AUTO-RETURN GO-ON ("CURSOR-UP" "CURSOR-DOWN")
        WITH FRAME qbf.
      qbf# = FRAME-INDEX.
      IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND CHR(LASTKEY) <> "."
        AND NOT qbf[qbf#] BEGINS CHR(LASTKEY) THEN UNDO,RETRY _choose.
    END.
    ON CURSOR-LEFT  CURSOR-LEFT.
    ON CURSOR-RIGHT CURSOR-RIGHT.
    i = LOOKUP(KEYFUNCTION(LASTKEY),
        "CURSOR-DOWN,CURSOR-UP,PAGE-DOWN,PAGE-UP,,GET,PUT,,,,END-ERROR").
    IF i > 0 THEN qbf# = i.
    IF KEYFUNCTION(LASTKEY) = "PICK" THEN qbf# = 7.
    IF CHR(LASTKEY) = "." THEN qbf# = 11.
  END.

  IF (qbf# = 5 OR qbf# = 8) AND r-o THEN DO:
    MESSAGE new_lang[7]. /* sorry, r-o mode */
    NEXT _outer.
  END.

  IF qbf# = 1 THEN DO: /*------------------------------------ start of NEXT */
    IF NOT AVAILABLE _Field THEN
      FIND FIRST _Field OF _File NO-ERROR.
    ELSE
      FIND NEXT _Field OF _File NO-ERROR.
  END. /*------------------------------------------------------ end of NEXT */
  ELSE
  IF qbf# = 2 THEN DO: /*------------------------------------ start of PREV */
    IF NOT AVAILABLE _Field THEN
      FIND LAST _Field OF _File NO-ERROR.
    ELSE
      FIND PREV _Field OF _File NO-ERROR.
  END. /*------------------------------------------------------ end of PREV */
  ELSE
  IF qbf# = 3 OR qbf# = 4 THEN DO: /*------------ start of FORWARD/BACKWARD */
    IF qbf# = 4 THEN DO:
      FIND PREV _File
        WHERE _File._Db-recid = drec_db
          AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
          AND NOT _File._Hidden NO-ERROR.
      IF NOT AVAILABLE _File THEN
        FIND LAST _File
          WHERE _File._Db-recid = drec_db
            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
            AND NOT _File._Hidden NO-ERROR.
    END.
    ELSE DO:
      FIND NEXT _File
        WHERE _File._Db-recid = drec_db
          AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
          AND NOT _File._Hidden NO-ERROR.
      IF NOT AVAILABLE _File THEN
        FIND FIRST _File
          WHERE _File._Db-recid = drec_db
            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
            AND NOT _File._Hidden NO-ERROR.
    END.
    IF NOT AVAILABLE _File THEN LEAVE _outer.
    RELEASE _Field.
    ASSIGN
      drec_file     = RECID(_File)
      pik_count     = 0
      user_filename = _File._File-name.
    DISPLAY user_filename WITH FRAME user_ftr.
    HIDE FRAME fld NO-PAUSE.
    HIDE FRAME fil NO-PAUSE.
  END. /*------------------------------------------ end of FORWARD/BACKWARD */
  ELSE
  IF qbf# = 5 THEN DO TRANSACTION: /*---------------------- start of MODIFY */
    i = 0.
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF AVAILABLE _Field THEN DO:
        IF i = 1 THEN NEXT-PROMPT _Field._Can-read  WITH FRAME fld.
        IF i = 2 THEN NEXT-PROMPT _Field._Can-write WITH FRAME fld.
        SET
          _Field._Can-read _Field._Can-write
          WITH FRAME fld EDITING:
            READKEY.
            APPLY (IF CAN-DO("PAGE-UP,PAGE-DOWN,GET,PUT",KEYFUNCTION(LASTKEY))
              THEN KEYCODE(KBLABEL("GO")) ELSE LASTKEY).
          END.

        /* trim blanks */
        ASSIGN _Field._Can-read = TRIM(_Field._Can-read)
               _Field._Can-write = TRIM (_Field._Can-write).
        i = 0.
        IF NOT CAN-DO(_Field._Can-read ,USERID("DICTDB")) THEN i = 1.
        IF NOT CAN-DO(_Field._Can-write,USERID("DICTDB")) THEN i = 2.
      END.
      ELSE DO:
        IF i = 1 THEN NEXT-PROMPT _File._Can-read   WITH FRAME fil.
        IF i = 2 THEN NEXT-PROMPT _File._Can-write  WITH FRAME fil.
        IF i = 3 THEN NEXT-PROMPT _File._Can-create WITH FRAME fil.
        IF i = 4 THEN NEXT-PROMPT _File._Can-delete WITH FRAME fil.
        IF i = 5 THEN NEXT-PROMPT _File._Can-dump   WITH FRAME fil.
        IF i = 6 THEN NEXT-PROMPT _File._Can-load   WITH FRAME fil.
        SET
          _File._Can-read   _File._Can-write
          _File._Can-create _File._Can-delete
          _File._Can-dump   _File._Can-load
          WITH FRAME fil EDITING:
            READKEY.
            APPLY (IF CAN-DO("PAGE-UP,PAGE-DOWN,GET,PUT",KEYFUNCTION(LASTKEY))
              THEN KEYCODE(KBLABEL("GO")) ELSE LASTKEY).
          END.
       /* trim blanks */
        ASSIGN _File._Can-read  = TRIM(_File._Can-read)
               _File._Can-write = TRIM(_File._Can-write)
               _File._Can-create = TRIM(_File._Can-create)
               _File._Can-delete = TRIM(_File._Can-delete)
               _File._Can-dump = TRIM(_File._Can-dump)  
               _File._Can-load = TRIM (_File._Can-load).
        i = 0.
        IF NOT CAN-DO(_File._Can-read  ,USERID("DICTDB")) THEN i = 1.
        IF NOT CAN-DO(_File._Can-write ,USERID("DICTDB")) THEN i = 2.
        IF NOT CAN-DO(_File._Can-create,USERID("DICTDB")) THEN i = 3.
        IF NOT CAN-DO(_File._Can-delete,USERID("DICTDB")) THEN i = 4.
        IF NOT CAN-DO(_File._Can-dump  ,USERID("DICTDB")) THEN i = 5.
        IF NOT CAN-DO(_File._Can-load  ,USERID("DICTDB")) THEN i = 6.
      END.
      IF i > 0 THEN DO:
        MESSAGE new_lang[10]. /* cannot exclude self */
        UNDO,RETRY.
      END.
    END.
    ASSIGN
      i      = LOOKUP(KEYFUNCTION(LASTKEY),"PAGE-DOWN,PAGE-UP,,,,GET,PUT,")
      re-use = i > 0
      qbf#   = (IF re-use THEN i ELSE qbf#).
    IF re-use THEN NEXT _outer.
  END. /*---------------------------------------------------- end of MODIFY */
  ELSE
  IF qbf# = 6 THEN DO: /*---------------------------- start of SWITCH-TABLE */
    user_path = "1=,_usrtget,9=" + user_env[9] + ",_usrsecu".
    LEAVE _outer.
  END. /*---------------------------------------------- end of SWITCH-TABLE */
  ELSE
  IF qbf# = 7 THEN _qbf7: DO: /*----------------------- start of JUMP-FIELD */
    IF pik_count = 0 THEN DO:
      ASSIGN
        pik_first   = ?
        pik_count   = 1
        pik_list[1] = "<<table security>>".
      FOR EACH _Field OF _File:
        ASSIGN
          pik_count           = pik_count + 1
          pik_list[pik_count] = _Field._Field-name.
      END.
    END.
    IF pik_count > 1 THEN
      RUN "prodict/user/_usrpick.p".
    ELSE
      MESSAGE new_lang[9]. /* there ain't no fields */
    IF pik_first <> ? THEN FIND FIRST _Field OF _File
      WHERE _Field._Field-name = pik_first NO-ERROR.
  END. /*------------------------------------------------ end of JUMP-FIELD */
  ELSE
  IF qbf# = 8 THEN DO: /*------------------------------ start of CALL-ADMIN */
    user_path = "!PROGRESS,_usradmn,_usrsecu".
    LEAVE _outer.
  END. /*------------------------------------------------ end of CALL-ADMIN */
  ELSE
  IF qbf# = 9 THEN DO: /*----------------------------- start of USER-EDITOR */
    user_path = "!PROGRESS,_usruchg".
    LEAVE _outer.
  END. /*----------------------------------------------- end of USER-EDITOR */
  ELSE
  IF qbf# = 10 THEN DO: /*--------------------------------- start of REPORT */
    user_path = "_rptuqik,_usrsecu".
    LEAVE _outer.
  END. /*---------------------------------------------------- end of REPORT */
  ELSE
  IF qbf# = 11 THEN DO: /*----------------------------------- start of EXIT */
    user_path = "".
    LEAVE _outer.
  END. /*------------------------------------------------------ end of EXIT */

  IF re-use AND qbf# <> 5 THEN qbf# = 5. ELSE re-use = FALSE.
END.

HIDE FRAME fil      NO-PAUSE.
HIDE FRAME fld      NO-PAUSE.
HIDE FRAME qbf      NO-PAUSE.
HIDE MESSAGE NO-PAUSE.
RETURN.

/*********************************************************************
* Copyright (C) 2006,2010 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* _usrsget.p - select working schema */

/*
user_env[1] = "dis" - this program disconnects a database
user_env[1] = "new" - this may be the first database connected
user_env[1] = "get" - user wants to select a database to work with
user_env[1] = "sys" - dictionary forcing user to pick a database
*/
/*

History:
    mcmann      98/01/14    Changed connect message to 10 instead of 9
    laurief     97/12/18    Made V8 to "generic version" changes
    laurief     97/05/12    Changed some messages to alert boxes (95-09-27-025)
    gfs         94/06/23    Fixed F4 prob on disconnect 94-06-02-005
    hutegger    94/05/05    "automatically get select-dialogbox after
                            connecting to an n. db (n > 1)" was switched
                            off; I switched it on again.      
    hutegger    94/05/05    I inserted an extention of user_path, in case
                            there are more then 1 db left after disconnect
                            1. commit transaction; 
                            2. call this routine again
    fernando    02/17/06    Handle V9 db's - don't let user select them - 20050510-008
    fernando    10/04/10    Support for OE 11

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE answer AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE choice AS INTEGER   INITIAL ?     NO-UNDO.
DEFINE VARIABLE d_char AS CHARACTER EXTENT  4     NO-UNDO.
DEFINE VARIABLE d_log  AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE dbpick AS CHARACTER               NO-UNDO.
DEFINE VARIABLE i      AS INTEGER                 NO-UNDO.
DEFINE VARIABLE is_dis AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE j      AS INTEGER   INITIAL 0     NO-UNDO.
DEFINE VARIABLE l      AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE look   AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE old_db AS INTEGER   INITIAL ?     NO-UNDO.
DEFINE VARIABLE oldbs  AS INTEGER   INITIAL 0     NO-UNDO.
DEFINE VARIABLE olname AS CHARACTER               NO-UNDO.
DEFINE VARIABLE p_down AS INTEGER                 NO-UNDO.
DEFINE VARIABLE p_init AS INTEGER   INITIAL ?     NO-UNDO.
DEFINE VARIABLE p_line AS INTEGER                 NO-UNDO.
DEFINE VARIABLE redraw AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE rpos   AS INTEGER                 NO-UNDO.
DEFINE VARIABLE typed  AS CHARACTER INITIAL ""    NO-UNDO.
DEFINE NEW GLOBAL SHARED VARIABLE fast_track AS LOGICAL. /* FT active? */
DEFINE VARIABLE old_dbver AS CHARACTER            NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 22 NO-UNDO INITIAL [
  /*  1*/ "Are you sure that you want to disconnect database",
  /*  2*/ "Nothing was disconnected.",
  /*  3*/ "Cannot disconnect a database if it is not connected.",
  /*  4*/ "has been disconnected.",
  /*  5*/ "There are only" , 
  /*  6*/ "databases connected.  Please use the ",
  /*  7*/ "dictionary from ", 
  /*  8*/ "{&PRO_DISPLAY_NAME} to view/edit these databases.",
  /*  9*/ "ERROR! Database type inconsistency in _usrsget.p",
/*10,11*/ "Database", "is not connected.  Would you like to connect it?",
  /* 12*/ "",  /* reserved */
  /* 13*/ "is the only database connected - it is already selected.",
  /* 14*/ "You have been automatically switched to database",
/*15,16*/ "The", "Dictionary can not be used with a {&PRO_DISPLAY_NAME}",
  /* 17*/ "database.",
  /* 18*/ "There are no databases connected to select!",
  /* 19*/ "This copy of {&PRO_DISPLAY_NAME} does not support database type",
  /* 20*/ "There are no databases connected for you to disconnect.",
  /* 21*/ "You have to leave Fast Track before disconnecting a database",
  /* 22*/ "is the only selectable database connected - it is already selected."
].

FORM
  d_char[1] FORMAT "x(18)"  LABEL "Logical DBName"  ATTR-SPACE SPACE(0)
  d_char[2] FORMAT "x(20)"  LABEL "Physical DBName"
  d_char[3] FORMAT "x(12)"  LABEL "DB Type"         ATTR-SPACE SPACE(0)
  d_char[4] FORMAT "x(18)"  LABEL "Schema Holder"
  d_log     FORMAT "yes/no" LABEL "Con"             ATTR-SPACE
  WITH FRAME schema_stuff NO-ATTR-SPACE USE-TEXT
  ROW 4 COLUMN 1 SCROLL 1 p_down DOWN TITLE COLOR NORMAL
  " Select " + TRIM(STRING(is_dis,"Database to Disconnect/Working Database"))
	     + " ".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

FUNCTION isOlderDBVersion RETURNS LOGICAL (INPUT pos AS INTEGER) FORWARD.


is_dis = user_env[1] = "dis".

IF is_dis AND NUM-DBS = 0 THEN DO:
  MESSAGE new_lang[20] VIEW-AS ALERT-BOX. /* nothing to disconnect */
  user_path = "".
  RETURN.
END.

RUN "prodict/_dctsget.p".

IF is_dis THEN DO: /* removed unconnected items from list */
  DO i = 1 TO cache_db#:
    IF CONNECTED(cache_db_l[i]) THEN ASSIGN
      j             = j + 1
      cache_db_e[j] = cache_db_e[i]
      cache_db_l[j] = cache_db_l[i]
      cache_db_p[j] = cache_db_p[i]
      cache_db_s[j] = cache_db_s[i]
      cache_db_t[j] = cache_db_t[i].
  END.
  cache_db# = j.
END.

DO i = 1 TO cache_db#:
  IF cache_db_l[i] = user_dbname AND old_db = ? THEN old_db = i.
  IF  isOlderDBVersion(i) THEN oldbs = oldbs + 1.
  old_dbver = "R" + DBVERSION(cache_db#).
END.

ASSIGN
  cache_dirty = TRUE
  p_down      = MINIMUM(cache_db#,SCREEN-LINES - 8)
  p_init      = MINIMUM(p_down,old_db)
  rpos        = (IF old_db = ? THEN 1 ELSE old_db).

IF cache_db# = oldbs AND oldbs > 0 THEN DO:
  IF not is_dis THEN
    MESSAGE new_lang[5] old_dbver new_lang[6] SKIP /* only non-V8 dbs connected */
      	    new_lang[7] old_dbver new_lang[8] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  look = TRUE.
END.
IF cache_db# = 0 OR cache_db# = oldbs THEN DO:
  ASSIGN
    user_path     = ""
    user_dbname   = ""
    user_dbtype   = ""
    user_filename = "".
  DISPLAY user_dbname user_filename WITH FRAME user_ftr.
  IF CAN-DO("get,new",user_env[1]) AND oldbs = 0 THEN
    MESSAGE new_lang[18] VIEW-AS ALERT-BOX. /* no dbs connected */
  IF NOT (look AND is_dis) THEN RETURN.
END.

/* <hutegger> 94/05/05 user should be automatically prompted to select */
/* the current working db, if there are more then 1 db's connected     */
/*
IF old_db <> ? AND user_env[1] = "new" THEN
  choice = old_db.
ELSE
*/
IF cache_db# = 1 AND NOT look THEN DO:
  choice = 1.
  IF user_env[1] = "get" THEN 
    MESSAGE cache_db_l[1] new_lang[13] VIEW-AS ALERT-BOX. /* only 1 db to choose */
  IF cache_db_l[1] <> olname AND
    (user_env[1] = "new"
    OR (user_env[1] = "sys" AND user_dbname <> cache_db_l[1])) THEN
    MESSAGE new_lang[14] '"' + cache_db_l[1] + '"'. /* auto-switch to db... */
END.
ELSE IF ((cache_db# - oldbs) = 1) AND NOT look THEN DO:

  /* check if we only have one db that can be selected, for instance, if you have
     a db from an older version and a db from the current release, then you can only
     select the current version db. We do that only if the user is trying to select
     a different database, or it's a db that just got connected.
  */
  IF (user_env[1] = "get" AND user_dbname <> "") OR user_env[1] = "new" THEN DO:
     /* there is only 1 db that can be selected - find out which one */      
     choice = 1.

     DO WHILE isOlderDBVersion(choice) AND choice <= cache_db#:
           choice = choice + 1.
     END.
    
     /* message is only needed if the user is trying to select a db */
     IF user_env[1] = "get" THEN
         MESSAGE cache_db_l[choice] new_lang[22] /* only 1 selectable db */
                VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  END.
  
END.

DO WHILE choice = ?:

  rpos = MINIMUM(cache_db#,MAXIMUM(rpos,1)).

  IF redraw THEN DO:
    ASSIGN
      p_line = MAXIMUM(1,FRAME-LINE(schema_stuff))
      j      = rpos - (IF p_init = ? THEN p_line ELSE p_init) + 1.
    UP p_line - 1 WITH FRAME schema_stuff.
    IF j < 1 THEN ASSIGN
      j      = 1
      p_line = 1
      rpos   = 1.
    DO i = j TO j + p_down - 1:
      IF i > cache_db# THEN
        CLEAR FRAME schema_stuff NO-PAUSE.
      ELSE
        DISPLAY
          cache_db_l[i] @ d_char[1]
          SUBSTRING(cache_db_p[i]
                   ,MAXIMUM(1,LENGTH(cache_db_p[i],"character") - 20)
                   ,21
                   ,"character"
                   )
            @ d_char[2]
          cache_db_e[i] @ d_char[3]
          cache_db_s[i] @ d_char[4]
          CONNECTED(cache_db_l[i]) @ d_log
          WITH FRAME schema_stuff.
      IF i < j + p_down - 1 THEN
        DOWN WITH FRAME schema_stuff.
    END.
    p_line = (IF p_init = ? THEN p_line /*1*/ ELSE p_init).
    UP p_down - p_line WITH FRAME schema_stuff.
    ASSIGN
      p_init = ?
      redraw = FALSE.
  END.

  DISPLAY
    cache_db_l[rpos] @ d_char[1]
    SUBSTRING(cache_db_p[rpos]
             ,MAXIMUM(1,LENGTH(cache_db_p[rpos],"character") - 20)
             ,21
             ,"character"
             )
      @ d_char[2]
    cache_db_e[rpos] @ d_char[3]
    cache_db_s[rpos] @ d_char[4]
    CONNECTED(cache_db_l[rpos]) @ d_log
    WITH FRAME schema_stuff.
  COLOR DISPLAY MESSAGES d_char[1 FOR 4] d_log WITH FRAME schema_stuff.
  READKEY.
  COLOR DISPLAY NORMAL d_char[1 FOR 4] d_log WITH FRAME schema_stuff.
  PAUSE 0.

  IF ( KEYFUNCTION(LASTKEY) = CHR(LASTKEY) 
   AND LASTKEY >= 32
     )
   OR ( KEYFUNCTION(LASTKEY) = "BACKSPACE"
   AND  LENGTH(typed,"character") > 0
      )
   THEN DO:
    typed = (IF KEYFUNCTION(LASTKEY) = "BACKSPACE"
        THEN SUBSTRING(typed,1,LENGTH(typed,"character") - 1,"character")
        ELSE typed + CHR(LASTKEY)).
    IF typed = "" OR cache_db_l[rpos] BEGINS typed THEN NEXT.
    DO p_line = rpos TO cache_db#:
      IF cache_db_l[p_line] BEGINS typed THEN LEAVE.
    END.
    IF p_line > cache_db# THEN DO:
      DO p_line = 1 TO rpos:
        IF cache_db_l[p_line] BEGINS typed THEN LEAVE.
      END.
      IF p_line > rpos THEN p_line = cache_db# + 1.
    END.
    IF p_line > cache_db# THEN DO:
      typed = CHR(LASTKEY).
      DO p_line = 1 TO cache_db#:
        IF cache_db_l[p_line] BEGINS typed THEN LEAVE.
      END.
    END.
    IF p_line <= cache_db# THEN ASSIGN
      rpos   = p_line
      redraw = TRUE.
    NEXT.
  END.

  typed = "".
  IF KEYFUNCTION(LASTKEY) = "CURSOR-DOWN" AND rpos < cache_db# THEN DO:
    rpos = rpos + 1.
    IF FRAME-LINE(schema_stuff) = FRAME-DOWN(schema_stuff) THEN
      SCROLL UP WITH FRAME schema_stuff.
    ELSE
      DOWN WITH FRAME schema_stuff.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "CURSOR-UP" AND rpos > 1 THEN DO:
    rpos = rpos - 1.
    IF FRAME-LINE(schema_stuff) = 1 THEN
      SCROLL DOWN WITH FRAME schema_stuff.
    ELSE
      UP WITH FRAME schema_stuff.
  END.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN ASSIGN
    rpos   = rpos + p_down
    redraw = TRUE.
  ELSE
  IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN ASSIGN
    rpos   = rpos - p_down
    redraw = TRUE.
  ELSE
  IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND rpos > 1 THEN DO:
    ASSIGN
      rpos   = 1
      redraw = TRUE.
    UP FRAME-LINE(schema_stuff) - 1 WITH FRAME schema_stuff.
  END.
  ELSE
  IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
    ASSIGN
      rpos   = cache_db#
      redraw = TRUE.
    DOWN p_down - FRAME-LINE(schema_stuff) WITH FRAME schema_stuff.
  END.
  ELSE
  IF CAN-DO("GO,RETURN,END-ERROR",KEYFUNCTION(LASTKEY)) THEN DO:
    l = KEYFUNCTION(LASTKEY) = "END-ERROR".
    IF NOT l AND NOT is_dis
      AND isOlderDBVersion(rpos)   THEN DO:
      /*old_dbver = "R" + DBVERSION(cache_db#).*/
	  old_dbver = "R" + DBVERSION(cache_db_l[rpos]).
      MESSAGE new_lang[15] PROVERSION new_lang[16] old_dbver new_lang[17] VIEW-AS ALERT-BOX. /* cannot use V5/V6/V7/V8 db and V9 dict together */
      NEXT.
    END.
    ELSE
    /*-----
    IF NOT l AND NOT CAN-DO(GATEWAYS,cache_db_t[rpos]) THEN DO:
      MESSAGE new_lang[19] cache_db_e[rpos] VIEW-AS ALERT-BOX. /* unsupported dbtype */
      NEXT.
    END.
    ------*/ 
    ASSIGN
      choice = (IF l THEN old_db ELSE rpos)
      choice = (IF choice = ? THEN 1 ELSE choice).
  END.

  p_line = 1.
END.

dbpick = cache_db_l[choice].
IF KEYFUNCTION(LASTKEY)  = "END-ERROR" THEN user_path = "".

IF is_dis THEN _discon: DO: /*-----------------------------*/ /* disconnect */
  IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _discon.
  answer = FALSE.
  RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT answer,?,?,
    new_lang[1] + ' "' + dbpick + '"?'). /* discon? */
  IF NOT answer OR answer = ? THEN DO:
    MESSAGE new_lang[2] VIEW-AS ALERT-BOX. /* nothing disconnected */
    user_path = "".
    LEAVE _discon.
  END.
  /* If dictionary was started from Fast Track, return here.     */
  /* (Disconnecting within Fast Track doesn't make sense because */
  /* file-caching is done at startup-time when ft.p is run.      */
  IF fast_track THEN DO:
    BELL.
    MESSAGE new_lang[21].
    PAUSE 0.
    RETURN.
  END.
  DISCONNECT VALUE(dbpick).
  RUN "prodict/_dctsget.p". /* recache list */
  MESSAGE dbpick new_lang[4] VIEW-AS ALERT-BOX. /* disconnected */
  IF  (        user_dbname  = dbpick
    OR SDBNAME(user_dbname) = dbpick )
    THEN DO:
    ASSIGN
      user_dbname   = ""
      user_dbtype   = ""
      user_filename = "".
    /* recount the residing db's:                                   */
    /* if disconnecting a shemaholder, then don't count NEITHER the */
    /* schemaholder NOR its schemas; else don't count only the      */
    /* disconnected db                                              */
    ASSIGN j = 0.
    DO i = 1 TO cache_db#:
      IF  ( cache_db_l[i] <> dbpick
        OR  cache_db_t[i] <> "PROGRESS" )
        AND cache_db_s[i] <> dbpick AND
        NOT isOlderDBVersion(i)           
        THEN j = j + 1.
    END.

    if j > 1 then assign user_path = "*C,1=get,_usrsget" + user_path.
    DISPLAY user_dbname user_filename WITH FRAME user_ftr.
  END.
END. /*---------------------------------------------------------------------*/
ELSE _select: DO: /*-------------------------------------------*/ /* select */
  IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _select.
  ASSIGN
    user_dbname   = dbpick
    user_dbtype   = cache_db_t[choice]
    cache_dirty   = TRUE
    user_filename = ""
    drec_db       = ?
    drec_file     = ?.
  { prodict/user/usercon.i user_filename }

  CREATE ALIAS "DICTDB" FOR DATABASE VALUE(cache_db_s[choice]) NO-ERROR.
  IF LDBNAME("DICTDBG") <> ? THEN DELETE ALIAS "DICTDBG".
  IF user_dbtype = "PROGRESS" THEN
    dbpick = ?.
  ELSE IF CONNECTED(dbpick) THEN
    CREATE ALIAS "DICTDBG" FOR DATABASE VALUE(dbpick) NO-ERROR.
  RUN "prodict/_dctsset.p" (dbpick).

  IF NOT CONNECTED(user_dbname) AND CAN-DO(DATASERVERS,user_dbtype) THEN DO:
    answer = TRUE.
    RUN "prodict/user/_usrdbox.p" (INPUT-OUTPUT answer,?,?,
      new_lang[10] + ' "' + user_dbname + '" ' + new_lang[11]).
    IF answer THEN user_path = "*C,1=usr,_usrscon".
  END.
END. /*---------------------------------------------------------------------*/

HIDE FRAME schema_stuff NO-PAUSE.
RETURN.


FUNCTION isOlderDBVersion RETURNS LOGICAL (INPUT pos AS INTEGER):

  IF index(cache_db_t[pos],"/R10") <> 0  THEN  
     RETURN YES.
   ELSE 
     RETURN NO.
   
END FUNCTION.
/**********************************************************************
* Copyright (C) 2000-2011 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/* _usrtchg.p 

   History:  D. McMann 01/14/98 Added check for ORACLE and AS400 to stop user
                                from trying to create a table
             D. McMann 02/09/98 Added character variable for original area
                                so N/A can be displayed for DataServers.
             D. McMann 03/18/98 98-03-16-022 Changed assignment to file-area-number
                                instead of workfile. 
             D. McMann 04/20/98 98-04-20-030 changed how area name is found. 
             D. McMann 07/09/98 Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                                to FIND _File.
             Mario B   12/28/98 Add s_In_Schema_Area enabling one time notification 
             D. McMann 05/15/00 Removed warning if only Schema Area in DB.
             D. McMann 08/16/00 Added _db-recid to StorageObject find 20000815029
             D. McMann 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
             fernando  06/15/06 Expanding Dump-name to 32 characters
             fernando  09/27/06 Use a different delimiter for areaname - 20051228-008
             fernando  10/03/07 Fixed delimiter issue on area name list - OE00135682
             fernando  06/26/08 Filter out schema tables for encryption
             hdaniels  06/27/10 Multi-tenant support
             rkamboj   10/11/11 Fixed tab issue for area field during update for non-MT database.
             
*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN

/*---------------------------------------------------------------------
   Input: 
      user_env[1] = The name of the file to modify.  If "" then we're
                                 adding.
---------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }
{ prodict/dump/loaddefs.i NEW }
/*defines setAreaState */
{ prodict/pro/arealabel.i }
DEFINE VARIABLE adding             AS LOGICAL                      NO-UNDO.
DEFINE VARIABLE c             AS CHARACTER              NO-UNDO.
DEFINE VARIABLE capabs       AS LOGICAL   EXTENT    5 NO-UNDO.
    /* 1 add                 */
    /* 2 chg_foreign_name    */
    /* 3 rename              */
    /* 4 chg_foreign_size    */
    /* 5 chg_foreign_type    */
 

DEFINE VARIABLE dbkey           AS RECID                 NO-UNDO.
DEFINE VARIABLE do-get          AS CHARACTER             NO-UNDO.
DEFINE VARIABLE ftyp            AS CHARACTER             NO-UNDO.
DEFINE VARIABLE get-hit         AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE go_field        AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE go-key          AS INTEGER               NO-UNDO.
DEFINE VARIABLE hiding          AS LOGICAL               NO-UNDO.
DEFINE VARIABLE i               AS INTEGER               NO-UNDO.
DEFINE VARIABLE isbad           AS LOGICAL               NO-UNDO.
DEFINE VARIABLE j               AS INTEGER               NO-UNDO.
DEFINE VARIABLE newnam          AS LOGICAL               NO-UNDO.
DEFINE VARIABLE override        AS LOGICAL   EXTENT    7 NO-UNDO.
DEFINE VARIABLE pname           AS CHARACTER EXTENT    7 NO-UNDO.
DEFINE VARIABLE crc             AS LOGICAL   EXTENT    7 NO-UNDO.
DEFINE VARIABLE romode          AS INTEGER               NO-UNDO.
DEFINE VARIABLE stdmsg          AS CHARACTER INITIAL  "" NO-UNDO.
DEFINE VARIABLE touched         AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE old_crc_val     AS INTEGER   EXTENT    7 NO-UNDO.
DEFINE VARIABLE new_crc_val     AS INTEGER   EXTENT    7 NO-UNDO.
DEFINE VARIABLE check_syntax    AS LOGICAL   INITIAL yes NO-UNDO.
DEFINE VARIABLE fldeditor       AS LOGICAL               NO-UNDO.
DEFINE VARIABLE odbtyp          AS CHARACTER             NO-UNDO.
DEFINE VARIABLE filearea        AS CHARACTER             NO-UNDO.
DEFINE VARIABLE filearealog     AS CHARACTER             NO-UNDO.

DEFINE VARIABLE arealist        AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE VARIABLE areaname        AS CHARACTER             NO-UNDO.
define variable multitenantdb   as logical               no-undo.
DEFINE VARIABLE events   AS CHARACTER EXTENT    7 NO-UNDO 
   init ["Create","Delete","Find","Write",
         "Replication-Create","Replication-Delete","Replication-Write"].

DEFINE BUTTON button-f LABEL "&Triggers...".
DEFINE BUTTON button-v LABEL "&Validation...".
DEFINE BUTTON button-s LABEL "&String Attributes...".
DEFINE BUTTON button-d LABEL "&DS...".
DEFINE BUTTON btn_flds LABEL "Field Editor" AUTO-GO. 

IF FALSE THEN FIND FIRST _Db NO-LOCK.

{ prodict/user/user-d.i }  /* description frame, triggers and procedures */
{ prodict/user/user-v.i }  /* validation frame, triggers and procedures */
{ prodict/user/user-f.i }  /* trigger frame, triggers and procedures */
{ prodict/user/user-s.i }  /* string attribute frame and procedures */

FORM
  c FORMAT "x(78)" 
  WITH FRAME box-shadow
  /* need scrollable to compile cleanly on gui - though it's not run there */
  NO-ATTR-SPACE NO-LABELS OVERLAY SCROLLABLE 
  ROW 1 COLUMN 1 16 DOWN.

ASSIGN
  do-get = "(press [" + KBLABEL("PUT") + "] to edit trigger program)"
  do-get = FILL(" ",45 - LENGTH(do-get)) + do-get
  go-key= KEYCODE(KBLABEL("GO")).

/* get all the capabilities for the current data-server-type */
{ prodict/dictgate.i &action=query &dbtype=user_dbtype &dbrec=? &output=c }
assign
  capabs[1] = INDEX(ENTRY(2,c),"a") > 0
  capabs[2] = INDEX(ENTRY(2,c),"f") > 0
  capabs[3] = INDEX(ENTRY(2,c),"r") > 0
  capabs[4] = INDEX(ENTRY(2,c),"s") > 0
  capabs[5] = INDEX(ENTRY(2,c),"t") > 0.
  

/*--------------------------------------------------------------------------*/
/* Initialization.  Strategy is to copy working set into workfiles, */
/* modify the workfiles, and then copy the information back using   */
/* the same programs as load data definitions.                      */

/* This sets things up properly for when creating a file (user_env[1] = "") */
user_filename = user_env[1].
DISPLAY user_filename WITH FRAME user_ftr.

PAUSE 0 BEFORE-HIDE.

ASSIGN  odbtyp = {adecomm/ds_type.i
                  &direction = "ODBC"
                  &from-type = "odbtyp"}.

/* point to proper _Db record */
FIND DICTDB._Db WHERE
  DICTDB._Db._Db-name = (IF user_dbtype = "PROGRESS" THEN ? ELSE user_dbname) NO-LOCK.
  
IF (DICTDB._Db._DB-type = "ORACLE" OR DICTDB._DB._Db-type = "AS400" OR
    DICTDB._Db._Db-type = "ODBC") and user_filename = "" THEN DO:
  MESSAGE "You may not add a table definition for this database type."
      view-as ALERT-BOX ERROR buttons OK.
  ASSIGN user_path = "".
  RETURN.
END.  
  
FIND DICTDB._File OF DICTDB._Db WHERE
  DICTDB._File._File-name = user_filename 
  AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")NO-ERROR.
IF AVAILABLE DICTDB._File THEN drec_file = RECID(DICTDB._File).

/* ODBC and ORACLE DataServers need some more Table-specific info
 * currently: ROWID index-info
 */
do with frame frame-d:
  if can-do(odbtyp + ",ORACLE",user_dbtype)
  and available DICTDB._File
   then assign
     button-v:column = 2
     button-f:column = 21
     button-s:column = 37
     button-d:column = 63
     button-d:label  = "DataServer...".
   else assign
     button-d:hidden = TRUE.
  end.

CREATE wfil.

ASSIGN
  adding = NOT AVAILABLE DICTDB._File
  hiding = (AVAILABLE DICTDB._File AND DICTDB._File._Hidden)
  dbkey  = RECID(DICTDB._File).
/* IF adding THEN DO:              moved     */
/*   { prodict/dictgate.i            to      * /
/ *        &action=query               top   * /
/ *        &dbtype=user_dbtype       <hut>   * /
/ *        &dbrec=?                          * /
/ *        &output=c }                       */ 
/*   capabs[1] = INDEX(ENTRY(2,c),"a") > 0.  */
/* END.                                      */

/* 20051228-008 - use other delimiter in case area name has comma */
areaname:DELIMITER IN FRAME frame-d = CHR(1).

IF NOT adding THEN DO:
  IF DICTDB._File._For-type <> ? THEN
    ASSIGN arealist = "N/A"
           areaname:LIST-ITEMS IN FRAME frame-d = arealist.          
  ELSE DO:
    if DICTDB._File._file-attributes[1] = false or DICTDB._File._file-attributes[2] = true then
    do:
        FIND _StorageObject WHERE _StorageObject._Db-recid = DICTDB._File._Db-recid
                              AND _StorageObject._Object-type = 1
                              AND _StorageObject._Object-number = DICTDB._File._File-number
                              and _StorageObject._Partitionid = 0
                              NO-LOCK NO-ERROR.
        IF AVAILABLE _StorageObject THEN                                               
          FIND DICTDB._Area WHERE DICTDB._Area._Area-number = 
                                          _StorageObject._Area-number NO-LOCK.
        ELSE
          FIND DICTDB._Area WHERE DICTDB._Area._Area-number =  6 NO-LOCK.
          
        ASSIGN arealist = DICTDB._Area._Area-name
               areaname:LIST-ITEMS IN FRAME frame-d = arealist.
    end.       
  END.  
  { prodict/dump/copy_fil.i &from=DICTDB._File &to=wfil &all=true}
  FOR EACH DICTDB._File-Trig OF DICTDB._File:
    CREATE wfit.
    { prodict/dump/copy_fit.i &from=DICTDB._File-trig &to=wfit }
  END.
END.
ELSE DO:

  FOR EACH DICTDB._Area WHERE DICTDB._Area._Area-num > 6
                          AND DICTDB._Area._Area-type = 6
                          AND NOT CAN-DO ({&INVALID_AREAS}, DICTDB._Area._Area-name)
                          NO-LOCK. 

    IF arealist = ? THEN
      ASSIGN arealist = DICTDB._Area._Area-name
             filearea = DICTDB._Area._Area-name.
    ELSE
      /* 20051228-008 - use other delimiter in case area name has comma */
      ASSIGN arealist = arealist + CHR(1) + DICTDB._Area._Area-name.

  END.
  
  FIND DICTDB._Area WHERE DICTDB._Area._Area-num = 6 NO-LOCK.
  IF arealist = ? THEN 
    ASSIGN arealist = DICTDB._Area._Area-name
           filearea = DICTDB._Area._Area-name
           s_In_Schema_Area = TRUE.
  ELSE
    ASSIGN arealist = arealist + CHR(1) + DICTDB._Area._Area-name.

  ASSIGN areaname:LIST-ITEMS IN FRAME frame-d = arealist.
         
  
END.
          
/*--------------------------------------------------------------------------*/
/* Check Security.
romode =  0 - can read/write
       = +1 - file frozen
       = +2 - dict in r/o mode
       = +3 - no permission to change
       = -1 - new file and no create permission
       = -2 - old file and no write permission
       = -3 - can't add for this dbtype
*/

FIND DICTDB._File "_File".
romode = (IF wfil._Frozen THEN 1 ELSE IF dict_rog THEN 2 ELSE IF wfil._Db-lang > 1 THEN 4 ELSE 0).
IF adding AND NOT CAN-DO(DICTDB._File._Can-write,USERID("DICTDB"))
  THEN romode = 3.
IF adding AND NOT CAN-DO(DICTDB._File._Can-create,USERID("DICTDB"))
  THEN romode = -1.
IF NOT adding AND NOT CAN-DO(DICTDB._File._Can-read,USERID("DICTDB"))
  THEN romode = -2.
IF adding AND NOT capabs[1] THEN romode = -3.

/* 0: Use the [GET] key to switch files quickly.                          */
/*+1: This file definition has been FROZEN and cannot be altered here.    */
/*+2: The dictionary is in read-only mode, so alterations are not allowed.*/
/*+3: You do not have permission to modify files.                         */
/*+4: SQL92 Table can not modify                                          */
/*-1: You do not have permission to create files.                         */
/*-2: You do not have permission to see file definitions.                 */
/*-3: You may not add a file definition here for this database type.      */

HIDE MESSAGE NO-PAUSE.
IF romode < 0 THEN DO:
  MESSAGE (IF romode = -1
    THEN "You do not have permission to create tables."
    ELSE IF romode = -2
    THEN "You do not have permission to see table definitions."
    ELSE "You may not add a table definition here for this database type.").
  user_path = "".
  RETURN.
END.

stdmsg =  
  (IF romode = 0
  THEN IF adding THEN "" 
       ELSE "Use the [" + KBLABEL("GET") + "] key to switch tables quickly."
  ELSE IF romode = 1
  THEN "This table definition has been FROZEN and cannot be altered here."
  ELSE IF romode = 2
  THEN "The dictionary is in read-only mode, so alterations are not allowed."
  ELSE IF romode = 4 THEN
    "{&PRO_DISPLAY_NAME}/SQL92 table cannot be modify."
  ELSE "You do not have permission to modify tables.").


/*--------------------------------------------------------------------------*/

/* See if the field editor is in user_path.  If not, don't show field editor
   button.  It won't be for certain gateway operations.
*/

fldeditor = (IF INDEX(user_path,"_usrfchg") = 0 THEN no ELSE yes).

VIEW FRAME box-shadow.
/*UNDERLINE c WITH FRAME box-shadow. */ /* FIX THIS */
/* above line produces a remaining "_" on the table-modify screen */

IF adding OR NOT fldeditor THEN DO:
  /* Use this to center the ok and cancel buttons */
  {adecomm/okrun.i  
     &FRAME  = "FRAME frame-d" 
     &OK     = "btn_OK" 
     &CANCEL = "btn_Cancel"
  }
  FRAME frame-d:WIDTH = FRAME frame-d:WIDTH - 1.  /* undo widening of frame */
  btn_flds:VISIBLE IN FRAME frame-d = no.
END.

VIEW FRAME frame-d.
    
/*
This code sets the file type.
File-types:
  PROGRESS Schema   _File-num = -1..-6, -30..-32
  FAST TRACK Schema _File-num = -7..-29
  PROGRESS/SQL      _Db-lang = 1 for SQL89 and 2 for SQL92
  non-PROGRESS      _Db-type <> "PROGRESS"
  PROGRESS          (whatever's left)
*/

ftyp = (IF wfil._File-number >= -29
       AND wfil._File-number <= -7 THEN "FAST TRACK Schema"
       ELSE IF wfil._File-number < 0 THEN "{&PRO_DISPLAY_NAME} Schema"
       ELSE IF wfil._File-number > 32767  THEN "SQL92 View"
       ELSE IF wfil._Db-lang > 0  THEN "{&PRO_DISPLAY_NAME}/SQL"
       ELSE                             user_dbtype)
      + (IF wfil._For-Type = ? THEN "" ELSE " (" + wfil._For-Type + ")").
i = INDEX(ftyp,") (").
IF i > 0 THEN SUBSTRING(ftyp,i,3) = ", ".

MESSAGE COLOR NORMAL stdmsg.
IF adding THEN
   ASSIGN
      wfil._File-name = "" /* instead of ? */
      wfil._Dump-name = "".
      
multitenantdb = can-find(first dictdb._tenant) .
if not multitenantdb then
    wfil._File-attribute[2]:hidden in frame frame-d = true.
DISPLAY
  wfil._File-name
  wfil._File-attribute[1] 
  wfil._File-attribute[2] when multitenantdb
  areaname
  wfil._Dump-name
  ftyp @ wfil._For-Type
  wfil._Hidden
  wfil._File-label
  wfil._Frozen
  (IF wfil._Db-lang > 0 THEN ENTRY(1,wfil._Owner) ELSE wfil._For-Owner)
    @ wfil._For-Owner
  (IF wfil._For-Size = ? THEN "n/a" ELSE STRING(wfil._For-Size))
    @ wfil._For-Size
  (IF wfil._For-Name = ? THEN "n/a" ELSE wfil._For-Name)
    @ wfil._For-Name
  (IF user_dbtype <> "ORACLE" then "n/a" ELSE IF 
   wfil._Fil-misc2[8] = ? THEN "<Local-Db>" ELSE
   wfil._Fil-misc2[8]) @ wfil._Fil-misc2[8]
  wfil._Fil-misc2[6]
  wfil._Desc
  WITH FRAME frame-d.

setAreaState(wfil._File-attribute[1],
             wfil._File-attribute[2],
             no,
             adding,
             wfil._File-attribute[1]:handle in frame frame-d,
             areaname:handle in frame frame-d,
             ?,
             /* onl one entry in list when editing */
             if not adding then areaname:list-items else "").

newnam = (romode = 0)
         AND (wfil._Db-lang = 0)
         AND (NOT CAN-FIND(FIRST DICTDB._View-ref
         WHERE DICTDB._View-ref._Ref-Table = wfil._File-name)).

desc_frame:
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE WITH FRAME frame-d:
    
  /* use enable and wait-for in order to control wfil._File-attributes[2] tab order
     even if it is not enabled and the area is not sensitive (the SetAreaState
     is fired from value changed on the File-attributes and set [2] tab order 
     before the Area */   
  ENABLE 
    wfil._File-name  WHEN newnam
    wfil._File-attributes[1] when multitenantdb /* disabled below if necessary */
    wfil._File-attributes[2] when multitenantdb  /* disabled below   */
    areaname when ierror EQ 0 /* disabled below if necessary  */
    wfil._Dump-name  WHEN romode = 0
	     VALIDATE(INDEX(INPUT wfil._Dump-name, " ") = 0, "Invalid character in Dump Name")
    wfil._For-Type   WHEN romode = 0 AND capabs[5]
    wfil._Hidden     WHEN romode = 0
    wfil._File-label WHEN romode = 0
    wfil._Fil-misc2[6] WHEN romode < 4   /* replication procedure name */
    wfil._For-Size   WHEN romode = 0 AND capabs[4]
    wfil._For-name   WHEN romode = 0 AND capabs[2]
    wfil._Desc       WHEN romode = 0
    button-v button-f button-s
    button-d         WHEN can-do(odbtyp + ",ORACLE", user_dbtype)
                            and not adding
    btn_OK           WHEN romode = 0
    btn_Cancel 
    btn_flds         WHEN NOT adding AND fldeditor
    WITH FRAME frame-d.
     
  if ierror EQ 0 THEN
  do:
    if multitenantdb then
      assign
        wfil._File-attributes[1]:sensitive = (romode = 0 and multitenantdb and not wfil._File-attributes[1])
        wfil._File-attributes[2]:sensitive = romode = 0 and FALSE. /* enabled in triggers only*/
        areaname:sensitive = romode = 0 AND adding.
  end.
  wait-for go of frame frame-d.
  
  ASSIGN 
     wfil._File-name           when wfil._File-name:sensitive 
     wfil._File-attributes[1]  when wfil._File-attributes[1]:sensitive
                               /* NOT a typo - [2] need to be saved also when disabled
                                  when [1] is enabled  */ 
     wfil._File-attributes[2]  when wfil._File-attributes[1]:sensitive 
     wfil._Dump-name           when wfil._Dump-name:sensitive      
     wfil._For-Type            when wfil._For-Type:sensitive 
     wfil._Hidden              when wfil._Hidden:sensitive  
     wfil._File-label          when wfil._File-label:sensitive 
     wfil._Fil-misc2[6]        when wfil._Fil-misc2[6]:sensitive 
     wfil._For-Size            when wfil._For-Size:sensitive  
     wfil._For-name            when wfil._For-name:sensitive   
     wfil._Desc                when wfil._Desc:sensitive 
     touched = touched
           OR FRAME frame-d wfil._File-name ENTERED
           OR FRAME frame-d wfil._File-attribute[1] ENTERED
           OR FRAME frame-d wfil._File-attribute[2] ENTERED
           OR FRAME frame-d wfil._For-Type ENTERED
           OR FRAME frame-d wfil._Hidden ENTERED
           OR FRAME frame-d areaname ENTERED
           OR FRAME frame-d wfil._File-label ENTERED
           OR FRAME frame-d wfil._Dump-name ENTERED
           OR FRAME frame-d wfil._For-Size ENTERED
           OR FRAME frame-d wfil._Desc ENTERED
           OR FRAME frame-d wfil._Fil-misc2[6] ENTERED
    wfil._Dump-name = INPUT FRAME frame-d wfil._Dump-name.

  IF adding THEN DO:
    if wfil._File-attributes[1] = true and wfil._File-attributes[2] = false then
    do:
        ASSIGN file-area-number = 0.
    end.      
    else do:
        FIND DICTDB._Area WHERE DICTDB._Area._Area-name = filearea NO-LOCK.
        ASSIGN file-area-number = DICTDB._Area._Area-number.
    end.
  END.
  
  /* Any user-added tables for an ODBC db will be of type BUFFER */
  IF CAN-DO(odbtyp, user_dbtype)
     AND wfil._For-Name = ? AND wfil._For-Owner = ? THEN
    ASSIGN 
      wfil._For-Type = "BUFFER"
      wfil._For-Name = "NONAME".
        
  IF romode = 0 THEN DO:
    ierror = 0.
    IF NOT adding AND wfil._File-name <> user_filename THEN DO:
      ASSIGN
        irename         = wfil._File-name
        wfil._File-name = user_filename
        imod            = "r".
      RUN "prodict/dump/_lod_fil.p".
      wfil._File-name = irename.
    END.
      
    IF ierror > 0 THEN UNDO, RETRY.

    ASSIGN
      cache_dirty = cache_dirty OR adding
                          OR (NOT adding AND
                              (wfil._File-name <> user_filename OR 
                                      wfil._Hidden <> hiding))
      dict_dirty    = dict_dirty OR cache_dirty OR touched OR RETURN-VALUE = "MOD"
      user_filename = wfil._File-name      /* RETURN-VALUE set by _gat_row.p (tty) */
      imod          = (IF adding THEN "a" ELSE "m").
    if not adding then 
    do:
      /*-----------------------------------------------------------------------
        We need to point back to the _File being modified to copy any changes
        made in _gat_row.p (above we find the "_File" file to check permissions
        ----------------------------------------------------------------------*/
      find DICTDB._File where recid(DICTDB._File) = drec_file.

      /*---------------------------------------------------------------------
        Needed to prevent _lod_fil.p from blowing away changes made to schema
        holder "rowid" fields in _gat_row.p, which does not use wfil. (tsn)
        --------------------------------------------------------------------*/
      assign
        wfil._Fil-misc1[1] = DICTDB._File._Fil-misc1[1]
        wfil._Fil-misc1[2] = DICTDB._File._Fil-misc1[2]
        wfil._Fil-misc1[4] = DICTDB._File._Fil-misc1[4]
        wfil._Fil-misc2[3] = DICTDB._File._Fil-misc2[3].
      /*--------------------------------------------------------------------*/
    end.
      
    RUN "prodict/dump/_lod_fil.p".
    
    IF ierror > 0 THEN UNDO, RETRY.
    DISPLAY user_filename WITH FRAME user_ftr.
  END.

  IF KEYFUNCTION(LASTKEY) = "GO" OR get-hit then LEAVE desc_frame.
END.  /* if romode = o then do; */
 
IF get-hit THEN
  user_path = "1=,_usrtget,_usrtchg,_usrfchg".
ELSE IF KEYFUNCTION(LASTKEY) = "END-ERROR" OR 
        (NOT adding AND fldeditor AND NOT go_field) THEN DO:
  user_path = "".
  HIDE MESSAGE NO-PAUSE.
END.

HIDE FRAME box-shadow NO-PAUSE.
HIDE FRAME frame-d NO-PAUSE.

PAUSE 0 BEFORE-HIDE.

RETURN.

&ENDIF  /* only compile for tty */


/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* _usrtdel.p - delete files */

/**************************************************************
History
    laurief   04/09/98    Changed user_env[1] from "as" to "s" as part
                          of fix for BUG 97-07-22-029.
    D. McMann 07/09/98    Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                          to FIND _File.
    D. McMann 08/24/98    Added check for user_env = "ALL". 98-08-21-014
    D. McMann 06/10/02    Added check for new SESSION attribute schema change.
    fernando  03/13/06    Storing table names in temp-table - bug 20050930-006.
**************************************************************/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE answer  AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE i       AS INTEGER                 NO-UNDO.
DEFINE VARIABLE msg-txt AS CHARACTER INITIAL     ? NO-UNDO.
DEFINE VARIABLE skipped AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE iNum    AS INTEGER   NO-UNDO INIT 0.

/* This program has a rather odd flow of control.  It is actually
executed four times.  The first time is to set up the execution string
and begin the transaction.  The second is to build the list of
deleteable files.  After allowing the user to select from a scrolling
list, the third time actual performs the deletion.  After that, the
transaction is allowed to end, and then it is called a fourth time to
display the "finished" message. */

/*--------------------------------------------------------------------------*/
/* INITIALIZATION phase */
IF user_env[9] = "" THEN DO:
  user_path = "*T,9=pre,_usrtdel,1=s,_usrtget,"
            + "9=mid,_usrtdel,*C,9=end,_usrtdel".
  RETURN.
END.

/*--------------------------------------------------------------------------*/
/* PRE phase */

IF user_env[9] = "pre" THEN _pre: DO:
  IF dict_rog THEN
    msg-txt = "The dictionary is in read-only mode - alterations not allowed.".
  ELSE
  DO FOR _File:
    FIND _File WHERE _File._File-name = "_File"
                 AND _File._Owner = "PUB".
    IF NOT CAN-DO(_Can-delete,USERID("DICTDB")) THEN msg-txt =
      "You do not have permission to delete table definitions.".
  END.
  IF SESSION:SCHEMA-CHANGE = "New Objects" THEN
      ASSIGN msg-txt = 'You can not delete existing object when SESSION:SCHEMA-CHANGE = "New Objects".'.
  
  IF msg-txt <> ? THEN LEAVE _pre.

  ASSIGN
    cache_dirty   = FALSE
    cache_file#   = 1
    l_cache_tt    = FALSE /* 20050930-006 */
    cache_file    = ""
    cache_file[1] = "ALL".

  /* 20050930-006 - get rid of the caching information */
  EMPTY TEMP-TABLE tt_cache_file NO-ERROR.

  FOR EACH _File WHERE _Db-recid = drec_db 
                   AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                   AND NOT _Hidden
                    BY _File._File-name:
    answer = FALSE.
    IF _Frozen
      OR CAN-FIND(FIRST _View-ref WHERE _View-ref._Ref-Table = _File._File-name)
      OR _Db-lang <> 0 THEN answer = TRUE.
    ELSE
    IF user_dbtype = "PROGRESS" THEN DO:
      FIND _Index WHERE RECID(_Index) = _File._Prime-Index NO-ERROR.
      IF AVAILABLE _Index AND NOT _Index._Active THEN skipped = TRUE.
    END.
    IF answer THEN DO:
      skipped = TRUE.
      NEXT.
    END.

    ASSIGN cache_file# = cache_file# + 1.

    /* 20050930-006 */
    IF NOT l_cache_tt THEN DO:

       ASSIGN cache_file[cache_file#] = _File._File-name NO-ERROR.

       IF ERROR-STATUS:ERROR THEN DO:
           /* if an error occurred, it could be because there are too many
              tables, or we hit the limit on the character variable size
              (cache_file), so we will use a temp-table to hold the table
              names 
           */

           /* copy them to the temp-table */
           REPEAT iNum = 1 TO (cache_file# - 1):
               CREATE tt_cache_file.
               ASSIGN tt_cache_file.nPos = iNum
                       tt_cache_file.cName = cache_file[iNum].
           END.

           /* now create an entry for the current table name */
           CREATE tt_cache_file.
           ASSIGN tt_cache_file.nPos = cache_file#
                  tt_cache_file.cName = _File._File-name.

           /* clear out cache_file */
           ASSIGN cache_file = ""
                  l_cache_tt = YES.
       END.
    END.
    ELSE DO:
        CREATE tt_cache_file.
        ASSIGN tt_cache_file.nPos = cache_file#
               tt_cache_file.cName = _File._File-name.
    END.

  END.
  IF cache_file# = 1 THEN cache_file# = 0.
  IF skipped THEN DO:
    MESSAGE "Note: SQL tables, Frozen tables, and tables with".
    MESSAGE "      no active indexes cannot be deleted here.".
  END.
  RETURN.
END.

/*--------------------------------------------------------------------------*/
/* MID phase */

IF user_env[9] = "mid" THEN _mid: DO:
  IF user_env[1] <> "ALL" THEN 
  DO FOR _File i = 1 TO NUM-ENTRIES(user_env[1]) WHILE msg-txt = ?:
      FIND _File WHERE _File._Db-recid = drec_db
        AND _File._File-name = ENTRY(i,user_env[1])
        AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").
  END.
  IF msg-txt <> ? THEN LEAVE _mid.

  answer = FALSE.
  RUN prodict/user/_usrdbox.p (INPUT-OUTPUT answer,?,?,
       'Are you sure that you want to remove the selected tables? ').
    IF NOT answer OR answer = ? THEN DO:
    MESSAGE "Nothing was deleted."VIEW-AS ALERT-BOX.
    user_path = "".
    LEAVE _mid.
  END.

  _killer:
  DO FOR _File TRANSACTION:
    IF user_env[1] = "ALL" THEN DO:
      FOR EACH _File WHERE _File._Db-recid = drec_db
                       AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                       AND NOT _File._Frozen
                       AND NOT _File._Hidden
                       AND _File._Db-lang = 0:
         HIDE MESSAGE NO-PAUSE.
         MESSAGE "Removing the definition for " + _File._File-name.
         DO ON ERROR UNDO,LEAVE:
           { prodict/dump/loadkill.i }
         END.
         IF AVAILABLE _File THEN DO:
           MESSAGE 'The table "' + _File._File-name + '" was not deleted.'
             VIEW-AS ALERT-BOX ERROR BUTTONS OK.
           UNDO _killer,LEAVE _killer.
         END.
                      
      END.
    END.                   
    ELSE DO i = 1 TO NUM-ENTRIES(user_env[1]): /* beginning delete... */
      FIND _File WHERE _File._Db-recid = drec_db
        AND _File._File-name = ENTRY(i,user_env[1])
        AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").
      HIDE MESSAGE NO-PAUSE.
      MESSAGE 'Removing the definition for "' + _File._File-name + '"...'.
      DO ON ERROR UNDO,LEAVE:
        { prodict/dump/loadkill.i }
      END.
      IF AVAILABLE _File THEN DO:
        MESSAGE 'The table "' + _File._File-name + '" was not deleted.'
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        msg-txt= "UNDO performed - Delete operation ABORTED.".
        UNDO _killer,LEAVE _killer.
      END.
    END.
  END.

  IF msg-txt = ? THEN DO:
    HIDE MESSAGE NO-PAUSE.
    /* now reclaiming database space */
    MESSAGE (IF user_dbtype = "PROGRESS"
      THEN "Making database table space available for re-use"
      ELSE "Saving changes") + "...".
  END.
  ASSIGN
    cache_dirty = TRUE
    drec_file   = ?.

END.
/*--------------------------------------------------------------------------*/
/* END phase */

IF user_env[9] = "end" THEN _end: DO:
  MESSAGE "All tables marked for deletion have been removed.".
  ASSIGN
    user_filename = ""
    user_env[9]   = "".
  DISPLAY "" @ user_filename WITH FRAME user_ftr.
  RETURN.
END.

/*--------------------------------------------------------------------------*/

IF msg-txt <> ? THEN DO:
  MESSAGE msg-txt VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

RETURN.



/*********************************************************************
* Copyright (C) 2006-2007,2009,2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrtgen.p */

/* This program generates CREATE TABLE statements from _File records
stored in the database.  These CREATE TABLE statements can then be
run on another database to define those tables. */

/*
  user_env[2] = output file
  user_env[3] = '' or separate output file for 'create index'
  user_env[4] = allow PROGRESS format statements, also xlat "-" -> "_"
  user_env[5] = statement terminator
  user_env[6] = unique index names
  user_env[7] = support DEFAULT <init value>
  user_env[8] = xlat "-" -> "_"
  user_env[9] = userid
  user_env[11..18] = strings of how to convert PROGRESS datatypes to SQL:
                character -> char, character, vchar, varchar, long char
                date      -> date, datetime
                logical   -> logical
                integer   -> integer, smallint, number
                decimal   -> decimal, number, real, float, double precision
                decimal*  -> decimal, integer, number
                recid     -> recid, rowid
                char**    -> long, character, long varchar
              (decimal* is decimal with _Decimals=0)
              (char** is character longer than 240)
 user_env[19] = character to use for unique name creation
 user_env[21] = Add shadow column for case-insensitive key fields
 user_env[22] = dbtype ("ORACLE"...)
 user_env[23] = Min width for character fields.
 user_env[24] = Min width for numeric fields.
 user_env[25] = create sequences (oracle only).
 user_env[33] = to use _Width of field or calculate.
 
History:
    nagaraju    11/12/09    Remove numbers for radio-set options in MSSDS
    nagaraju    10/06/09    Support for computed column to PROGRESS_RECID in MSSDS
    fernando    04/03/09    Support for MSS's sequence generator and 2008 data types
    fernando    08/10/07    Removed UI restriction for Unicode support 
    fernando    07/19/06    Unicode support - restrict UI
    fernando    04/18/06    Unicode support for DataServers
    D. McMann   03/06/03    Removed shadow columns for Oracle.
    D. McMann   11/15/02    Split compatible objects into seperate selections
    D. McMann   09/18/02    Change SQL Width to Width
    D. McMann   08/18/00    Incresed size of max length for identifiers 200008007028
    D. McMann   08/18/00    Added support for MS SQL Server 20000727013
    D. McMann   04/13/00    Added support for long path names
    D, McMann   00/02/01    Added sqlwidth toggle box.
    Mario B.    98/12/04    Gray l_cmptbl when Progress is SQL flavor
    D. McMann   98/07/14    Added _Owner to _File finds
    hutegger    95/05/03    turned ue8 on for PROGRESS ("-" -> "_")
    hutegger    95/02/07    changed UI and created list of switches for
                            different SQL-flavors and extented the
                            switches set for wrktgen dpending on the
                            SQL-flavor
    hutegger    94/05/06    added parameters user_env[20 ... 25] for
                            _wrktgen.p (based on info from Marceau)
                            
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE allusers  AS LOGICAL   INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE answer    AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE canned    AS LOGICAL   INITIAL TRUE  NO-UNDO.

DEFINE VARIABLE fn        AS CHARACTER               NO-UNDO.
DEFINE VARIABLE fot       AS CHARACTER               NO-UNDO.
DEFINE VARIABLE foi       AS CHARACTER               NO-UNDO.
DEFINE VARIABLE ft        AS CHARACTER INITIAL "pro" NO-UNDO.
DEFINE VARIABLE l_cmptbl  AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE shadowcol AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE crtdef    AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE l_dbtyp   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_i       AS INTEGER                 NO-UNDO.
DEFINE VARIABLE l_ue-4    AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-5    AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-6    AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-7    AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-8    AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-11   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-12   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-13   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-14   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-15   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-16   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-17   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-18   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-19   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-20   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-21   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-22   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-23   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-24   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-25   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-28   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE l_ue-29   AS CHARACTER               NO-UNDO.
DEFINE VARIABLE usrnm     AS CHARACTER               NO-UNDO.
DEFINE VARIABLE uidtag    AS CHARACTER   	     NO-UNDO.
DEFINE VARIABLE alltables AS LOGICAL                 NO-UNDO.
DEFINE VARIABLE optlab    AS CHARACTER INITIAL "Output Option:"
			             FORMAT "X(15)"  NO-UNDO.
DEFINE VARIABLE cFormat   AS CHARACTER INITIAL "For field widths use:"
                                           FORMAT "x(21)"  NO-UNDO.

DEFINE VARIABLE usrlab    AS CHARACTER INITIAL "Which Users:"
			             FORMAT "X(15)"  NO-UNDO.
DEFINE VARIABLE iFmtOption AS INTEGER  INITIAL 2     NO-UNDO.
DEFINE VARIABLE lFormat    AS LOGICAL  INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE unicodeTypes AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE tmp_str      AS CHARACTER               NO-UNDO.
DEFINE VARIABLE lUniExpand   AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE mapMSSDatetime AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE newseq       AS LOGICAL   INITIAL FALSE NO-UNDO.
DEFINE VARIABLE cRecid        AS CHARACTER INITIAL "For Create RECID use:"
                                           FORMAT "x(22)" NO-UNDO.
DEFINE VARIABLE iRecidOption AS INTEGER  INITIAL 1     NO-UNDO.

{prodict/misc/filesbtn.i &NAME="btn_File_t"}
{prodict/misc/filesbtn.i &NAME="btn_File_i" &NOACC=yes}

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /* 1*/ "Could not find a user in the connected database with this userid.",
  /* 2*/ "A file named",
  /* 3*/ "already exists.",
  /* 4*/ "Overwrite it?",
  /* 5*/ "All Tables",
  /* 6*/ "You do not have permission to use this option.",
  /* 7*/ "(Enter a Userid or ~"ALL~")"
].


&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
&IF "{&WINDOW-SYSTEM}" = "OSF/Motif" &THEN  
   &GLOBAL-DEFINE LINEUP 45
   &GLOBAL-DEFINE FILLCH 48
&ELSE
   &GLOBAL-DEFINE LINEUP 48
   &GLOBAL-DEFINE FILLCH 50
&ENDIF

FORM 
  SKIP({&TFM_WID})
  "Output File for CREATE TABLE:"  VIEW-AS TEXT AT 2
  SKIP({&VM_WID})
  fot {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 AT 2
  btn_File_t 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID}) 
  &ELSE SKIP({&VM_WIDG}) &ENDIF

  "Output File for CREATE INDEX:" VIEW-AS TEXT AT 2
  SKIP({&VM_WID})

  foi {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 AT 2
  btn_File_i 
  SKIP({&VM_WIDG})
    
  "SQL-Flavor:" VIEW-AS TEXT AT 2
  ft VIEW-AS RADIO-SET horizontal
             RADIO-BUTTONS "{&PRO_DISPLAY_NAME}",      "pro",
                           "ORACLE",        "ora",
                           "MS SQL Server", "mss"
  SKIP({&VM_WIDG})
      
  l_cmptbl AT 2 label  "Create RECID Field "
          VIEW-AS toggle-box
          HELP "Create PROGRESS_RECID Column/Index...?"
  shadowcol AT 34 VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" 
          HELP "Create shadow columns for case insensitivity...?"
  SKIP({&VM_WID})
  crtdef AT 2 LABEL "Include Defaults" VIEW-AS toggle-box
              HELP "Include initial value as field default."
   unicodeTypes AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Unicode Types" 
            HELP "Create character columns as Unicode data types?"
    SKIP({&VM_WID})
    lUniExpand AT 2 VIEW-AS TOGGLE-BOX LABEL "Expand width (utf-8)"
           HELP "Double field length (for utf-8 compatibility)"
    newSeq AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Revised Sequence Generator" 
             HELP "Create sequences using new generation logic?"
    SKIP({&VM_WID})
    mapMSSDatetime AT 2 VIEW-AS TOGGLE-BOX LABEL "Map to MSS 'Datetime' Type"
           HELP "Default mapping for OpenEdge date and datetime to the MSS datetime type?"
    SKIP({&VM_WID})
    cFormat VIEW-AS TEXT NO-LABEL AT 2
    iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                               "ABL Format", 2
                                 HORIZONTAL NO-LABEL
               HELP "Make choice to determine field width in output."
    lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30"
            HELP "Choose to output field width of 30 for x(8) fields."
            AT 51
    SKIP({&VM_WID}) 
    cRecid VIEW-AS TEXT NO-LABEL AT 2
    iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS "Trigger", 1,
                                               "Computed column", 2
                                 HORIZONTAL NO-LABEL
               HELP "Make choice to determine Create RECID option."
  {prodict/user/userbtns.i}
  WITH FRAME createtable
  NO-LABELS CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Dump CREATE TABLE for ~"" + fn + "~" ".

FORM 
  SKIP({&TFM_WID})
  "Output File for CREATE TABLE:" VIEW-AS TEXT AT 2 
  SKIP({&VM_WID})

  fot {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 AT 2
  btn_File_t 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF
    
  "Output File for CREATE INDEX:" VIEW-AS TEXT AT 2 
  SKIP({&VM_WID})

  foi {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 AT 2
  btn_File_i 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF
       
  usrlab VIEW-AS TEXT AT 2
  SKIP({&VM_WIDG})

  allusers AT 2 VIEW-AS RADIO-SET HORIZONTAL 
	RADIO-BUTTONS "All Users",yes,"Single User",no SPACE(0)
  usrnm {&STDPH_FILL} 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF 
  
  "SQL-Flavor:" VIEW-AS TEXT AT 2 
  ft VIEW-AS RADIO-SET HORIZONTAL
             RADIO-BUTTONS "{&PRO_DISPLAY_NAME}",      "pro",
                           "ORACLE",        "ora",
                           "MS SQL Server", "mss"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF
  l_cmptbl AT 2 label "Create RECID Field "
          VIEW-AS toggle-box
          HELP "Create PROGRESS_RECID Column/Index?"
  shadowcol AT 34 VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" 
          HELP "Create shadow columns for case insensitivity...?"
  SKIP({&VM_WID})
    crtdef AT 2 LABEL "Include Defaults" VIEW-AS toggle-box
            HELP "Include initial value as field default."
    unicodeTypes AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Unicode Types" 
                  HELP "Create character columns as Unicode data types?"
    SKIP({&VM_WID})
    lUniExpand AT 2 VIEW-AS TOGGLE-BOX LABEL "Expand width (utf-8)"
           HELP "Double field length (for utf-8 compatibility)"
    newSeq AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Revised Sequence Generator" 
             HELP "Create sequences using new generation logic?"
    SKIP({&VM_WID})    
    mapMSSDatetime AT 2 VIEW-AS TOGGLE-BOX LABEL "Map to MSS 'Datetime' Type"
           HELP "Default mapping for OpenEdge date and datetime to the MSS datetime type?"
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF    
    cFormat VIEW-AS TEXT NO-LABEL AT 2
    iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                               "ABL Format", 2
                                 HORIZONTAL NO-LABEL
               HELP "Make choice to determine field width in output."
    lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30"
            HELP "Choose to output field width of 30 for x(8) fields."
            AT 51
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF
    cRecid VIEW-AS TEXT NO-LABEL AT 2
    iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS "Trigger", 1,
                                               "Computed column", 2
                                 HORIZONTAL NO-LABEL
               HELP "Make choice to determine Create RECID option."
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF
  {prodict/user/userbtns.i}

  WITH FRAME createalltables
  NO-LABELS CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Dump CREATE TABLE for All Tables".

&ELSE
   &GLOBAL-DEFINE LINEUP 30
   &GLOBAL-DEFINE LINEUP2 37
   &GLOBAL-DEFINE FILLCH 34

FORM 
  SKIP({&TFM_WID})
  fot {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 
        LABEL "Output File for CREATE TABLE" COLON {&LINEUP}
  btn_File_t
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF
    
  foi {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 
        LABEL "Output File for CREATE INDEX" COLON {&LINEUP}
  btn_File_i
  SKIP({&VM_WIDG})

  "SQL-Flavor:" VIEW-AS TEXT AT 2 
  ft NO-LABEL VIEW-AS RADIO-SET HORIZONTAL 
                      RADIO-BUTTONS "{&PRO_DISPLAY_NAME}",      "pro",
                                    "ORACLE",        "ora",
                                   "MS SQL Server", "mss"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
  &ELSE SKIP({&VM_WID}) &ENDIF
  l_cmptbl AT 2 label "Create RECID Field "
          VIEW-AS toggle-box
          HELP "Create PROGRESS_RECID Column/Index?"
  shadowcol AT 34 VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" 
          HELP "Create shadow columns for case insensitivity...?"
  SKIP({&VM_WID})
    crtdef AT 2 LABEL "Include Defaults" VIEW-AS toggle-box
            HELP "Include initial value as field default."
    unicodeTypes AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Unicode Types" 
                 HELP "Create character columns as Unicode data types?"
    SKIP({&VM_WID})
    lUniExpand AT 2 VIEW-AS TOGGLE-BOX LABEL "Expand width (utf-8)"
           HELP "Double field length (for utf-8 compatibility)"
    newSeq AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Revised Sequence Generator" 
             HELP "Create sequences using new generation logic?"
    SKIP({&VM_WID})  
    mapMSSDatetime AT 2 VIEW-AS TOGGLE-BOX LABEL "Map to MSS 'Datetime' Type"
           HELP "Default mapping for OpenEdge date and datetime to the MSS datetime type?"
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF        
    cFormat VIEW-AS TEXT NO-LABEL AT 2
    iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                               "ABL Format", 2
                                 HORIZONTAL NO-LABEL 
               HELP "Make choice to determine field width in output."
    lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30"
            HELP "Choose to output field width of 30 for x(8) fields."
            AT 51
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF
    cRecid VIEW-AS TEXT NO-LABEL AT 2
    iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS "Trigger", 1,
                                               "Computed column", 2
                                 HORIZONTAL NO-LABEL
               HELP "Make choice to determine Create RECID option."

    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
    &ELSE SKIP({&VM_WID}) &ENDIF
  "This program generates a SQL DDL program containing CREATE TABLE statements" 
               VIEW-AS TEXT   AT    2     SKIP
  "equivalent to those originally used to define the table.  It does NOT" 
               VIEW-AS TEXT   AT    2     SKIP
  "generate any GRANT or REVOKE statements to set permissions on the tables." 
               VIEW-AS TEXT   AT    2     SKIP
  "It also generates CREATE INDEX statements in a separate file (these will"
               VIEW-AS TEXT   AT    2    SKIP
  "be omitted if no file is specified for them above)."
               VIEW-AS TEXT   AT 2
  {prodict/user/userbtns.i}

  WITH FRAME createtable
  SIDE-LABELS ATTR-SPACE ROW 1 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Dump CREATE TABLE for ~"" + fn + "~" ".

FORM 
  SKIP({&TFM_WID})
  fot {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 
        LABEL "Output File for CREATE TABLE" COLON {&LINEUP}
  btn_File_t 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF
    
  foi {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" 
      VIEW-AS FILL-IN SIZE {&FILLCH} BY 1 
        LABEL "Output File for CREATE INDEX" COLON {&LINEUP}
  btn_File_i 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP({&VM_WID})
  &ELSE SKIP({&VM_WIDG}) &ENDIF

  usrnm  LABEL "Which Users"                COLON {&LINEUP}
  uidtag FORMAT "x(25)" NO-LABEL              AT 53    
  SKIP({&VM_WIDG})
  
  "SQL-Flavor:" VIEW-AS TEXT AT 2 
  ft NO-LABEL VIEW-AS RADIO-SET HORIZONTAL 
                      RADIO-BUTTONS "{&PRO_DISPLAY_NAME}",      "pro",
                                    "ORACLE",        "ora",
                                    "MS SQL Server", "mss"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
  &ELSE SKIP({&VM_WID}) &ENDIF
  l_cmptbl AT 2 label "Create RECID Field "
          VIEW-AS toggle-box
          HELP "Create PROGRESS_RECID Column/Index?"
  shadowcol AT 34 VIEW-AS TOGGLE-BOX LABEL "Create Shadow Columns" 
          HELP "Create shadow columns for case insensitivity...?"
  SKIP({&VM_WID})
  crtdef AT 2 LABEL "Include Defaults" VIEW-AS toggle-box
            HELP "Include initial value as field default."
  unicodeTypes AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Unicode Types" 
               HELP "Create character columns as Unicode data types?"
    SKIP({&VM_WID})
    lUniExpand AT 2 VIEW-AS TOGGLE-BOX LABEL "Expand width (utf-8)"
           HELP "Double field length (for utf-8 compatibility)"
    newSeq AT 34 VIEW-AS TOGGLE-BOX LABEL "Use Revised Sequence Generator" 
             HELP "Create sequences using new generation logic?"
  SKIP({&VM_WID})
  mapMSSDatetime AT 2 VIEW-AS TOGGLE-BOX LABEL "Map to MSS 'Datetime' Type"
         HELP "Default mapping for OpenEdge date and datetime to the MSS datetime type?"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
  &ELSE SKIP({&VM_WID}) &ENDIF      
  cFormat VIEW-AS TEXT NO-LABEL AT 2
  iFmtOption VIEW-AS RADIO-SET RADIO-BUTTONS "Width", 1,
                                             "ABL Format", 2
                               HORIZONTAL NO-LABEL 
             HELP "Make choice to determine field width in output."
  lFormat VIEW-AS TOGGLE-BOX LABEL "Expand x(8) to 30"
          HELP "Choose to output field width of 30 for x(8) fields."
          AT 51
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
  &ELSE SKIP({&VM_WID}) &ENDIF
    cRecid VIEW-AS TEXT NO-LABEL AT 2
    iRecidOption VIEW-AS RADIO-SET RADIO-BUTTONS "Trigger", 1,
                                               "Computed column", 2
                                 HORIZONTAL NO-LABEL
               HELP "Make choice to determine Create RECID option."

  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN SKIP({&VM_WIDG})
  &ELSE SKIP({&VM_WID}) &ENDIF
  "This program generates a SQL DDL program containing CREATE TABLE statements" 
             VIEW-AS TEXT   AT    2     SKIP
  "equivalent to those originally used to define the table.  It does NOT" 
             VIEW-AS TEXT   AT    2     SKIP
  "generate any GRANT or REVOKE statements to set permissions on the tables." 
             VIEW-AS TEXT   AT    2     SKIP
  "It also generates CREATE INDEX statements in a separate file (these will"
             VIEW-AS TEXT   AT    2    SKIP
  "be omitted if no file is specified for them above)."
             VIEW-AS TEXT   AT 2
  {prodict/user/userbtns.i}

  WITH FRAME createalltables
  SIDE-LABELS ATTR-SPACE ROW 1 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX TITLE " Dump CREATE TABLE for All Tables".
&ENDIF

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame createtable
   or CHOOSE OF btn_Help in frame createtable
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Dump_Create_Table_Dlg_Box},
      	       	     	     INPUT ?).
on HELP of frame createalltables
   or CHOOSE OF btn_Help in frame createalltables
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Dump_Create_Table_All_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


ON GO OF FRAME createtable
DO:
  DEFINE VAR f1  AS CHAR NO-UNDO.
  DEFINE VAR f2  AS CHAR NO-UNDO.
  DEFINE VAR uid AS CHAR NO-UNDO.

  f1 = fot:SCREEN-VALUE IN FRAME createtable.
  f2 = foi:SCREEN-VALUE IN FRAME createtable.

  IF SEARCH(f1) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] f1 new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fot IN FRAME createtable.
      RETURN NO-APPLY.
    END.
  END.
  IF SEARCH(f2) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] f2 new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO foi IN FRAME createtable.
      RETURN NO-APPLY.
    END.
  END.
END.
ON GO OF FRAME createalltables
DO:
  DEFINE VAR f1  AS CHAR NO-UNDO.
  DEFINE VAR f2  AS CHAR NO-UNDO.
  DEFINE VAR uid AS CHAR NO-UNDO.

  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
    IF allusers:SCREEN-VALUE = "yes" THEN
	  uid = "ALL".
    ELSE DO:
	  uid = usrnm:SCREEN-VALUE.
	  usrnm = uid.
    END.
  &ELSE
    uid  = usrnm:SCREEN-VALUE.
  &ENDIF

  IF uid <> "ALL" AND NOT CAN-FIND(_User WHERE _User._Userid = uid) THEN DO:
    MESSAGE new_lang[1] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO usrnm IN FRAME createalltables.
    RETURN NO-APPLY.
  END.


  f1 = fot:SCREEN-VALUE IN FRAME createalltables.
  f2 = foi:SCREEN-VALUE IN FRAME createalltables.

  IF SEARCH(f1) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] f1 new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fot IN FRAME createalltables.
      RETURN NO-APPLY.
    END.
  END.
  IF SEARCH(f2) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] f2 new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO foi IN FRAME createalltables.
      RETURN NO-APPLY.
    END.
  END.
END.
ON CHOOSE OF btn_File_t in frame createtable DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fot:handle in frame createtable /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.

ON LEAVE OF fot in frame createtable
   fot:screen-value in frame createtable = 
        TRIM(fot:screen-value in frame createtable).

ON CHOOSE OF btn_File_i in frame createtable DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT foi:handle in frame createtable /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.

ON LEAVE OF foi in frame createtable
   foi:screen-value in frame createtable = 
        TRIM(foi:screen-value in frame createtable).

ON VALUE-CHANGED OF iFmtOption IN FRAME createalltables DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lFormat:CHECKED IN FRAME createalltables   = FALSE
           lFormat:SENSITIVE IN FRAME createalltables = FALSE.
  ELSE
    ASSIGN lFormat:CHECKED  IN FRAME createalltables  = TRUE
           lFormat:SENSITIVE IN FRAME createalltables = TRUE.
END.

ON VALUE-CHANGED OF iFmtOption IN FRAME createtable DO:
  IF SELF:SCREEN-VALUE = "1" THEN
    ASSIGN lFormat:CHECKED IN FRAME createtable   = FALSE
           lFormat:SENSITIVE IN FRAME createtable = FALSE.
  ELSE
    ASSIGN lFormat:CHECKED IN FRAME createtable   = TRUE
           lFormat:SENSITIVE IN FRAME createtable = TRUE.
END.

ON VALUE-CHANGED OF ft IN FRAME createtable DO:
   CASE SELF:SCREEN-VALUE:
     WHEN "pro" THEN DO:
       ASSIGN iFmtOption:SCREEN-VALUE IN FRAME createtable = "2" 
              iRecidOption:SCREEN-VALUE IN FRAME createtable = "1" 
              l_cmptbl:SENSITIVE = FALSE
              l_cmptbl:SCREEN-VALUE = "no"
              shadowcol:SENSITIVE = FALSE
              shadowcol:SCREEN-VALUE = "no"
              crtdef:SENSITIVE = FALSE
              crtdef:SCREEN-VALUE = "no".
       
          ASSIGN unicodeTypes:SENSITIVE IN FRAME createtable = NO
                 unicodeTypes:SCREEN-VALUE = "no"
                 lUniExpand:SENSITIVE = NO
                 lUniExpand:SCREEN-VALUE = "no"
                 newSeq:SCREEN-VALUE = "no"
                 newSeq:SENSITIVE = NO
                 mapMSSDatetime:SCREEN-VALUE = "no"
                 mapMSSDatetime:SENSITIVE = NO
                 iRecidOption:SENSITIVE = NO.

       iFmtOption:DISABLE("Width") IN FRAME createtable.
       APPLY "VALUE-CHANGED" TO iFmtOption IN FRAME createtable.
     END.  
     WHEN "ora" THEN DO:       
       ASSIGN l_cmptbl:SENSITIVE = TRUE
              l_cmptbl:SCREEN-VALUE = "no"
              shadowcol:SENSITIVE = TRUE
              crtdef:SENSITIVE = TRUE.
       
           ASSIGN
              unicodeTypes:SENSITIVE IN FRAME createtable = YES
              unicodeTypes:SCREEN-VALUE = "no"
              lUniExpand:SENSITIVE = NO
              lUniExpand:SCREEN-VALUE = "no"
              newSeq:SCREEN-VALUE = "no"
              newSeq:SENSITIVE = NO
              mapMSSDatetime:SCREEN-VALUE = "no"
              mapMSSDatetime:SENSITIVE = NO
             iRecidOption:SENSITIVE = NO.

       iFmtOption:ENABLE("Width") IN FRAME createtable.
       APPLY "VALUE-CHANGED" TO iFmtOption IN FRAME createtable.
     END.
     OTHERWISE DO:
       ASSIGN l_cmptbl:SENSITIVE = TRUE
              l_cmptbl:SCREEN-VALUE = "no"
              shadowcol:SENSITIVE = TRUE
              crtdef:SENSITIVE = TRUE.
       
           ASSIGN
              unicodeTypes:SENSITIVE IN FRAME createtable = YES
              unicodeTypes:SCREEN-VALUE = "no"
              lUniExpand:SENSITIVE = NO
              lUniExpand:SCREEN-VALUE = "no"
              newSeq:SCREEN-VALUE = "no"
              newSeq:SENSITIVE = YES
              mapMSSDatetime:SCREEN-VALUE = "yes"
              mapMSSDatetime:SENSITIVE = YES
              iRecidOption:SENSITIVE = YES.

       iFmtOption:ENABLE("Width") IN FRAME createtable.
       APPLY "VALUE-CHANGED" TO iFmtOption IN FRAME createtable.
     END.
   END CASE.
END.

ON ENTRY OF FRAME createtable DO:
   /* Just assigning l_cmptbl:SENSITIVE = FALSE doesn't work because the *
    * widget is not realized until the UPDATE statements are executed.   *
    * Once that happens, this is the only way to force the assignment.   */
   APPLY "VALUE-CHANGED" TO ft IN FRAME createtable.
END.

ON WINDOW-CLOSE OF FRAME createtable
   APPLY "END-ERROR" TO FRAME createtable.

ON CHOOSE OF btn_File_t in frame createalltables DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fot:handle in frame createalltables /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.

ON VALUE-CHANGED OF unicodeTypes IN FRAME createalltables DO:
    DEF VAR dummyl AS LOGICAL NO-UNDO.

    IF ft:SCREEN-VALUE EQ "ora" THEN
        RETURN.

    IF SELF:SCREEN-VALUE = "NO" THEN
       ASSIGN lUniExpand:SENSITIVE IN FRAME createalltables = NO
              lUniExpand:SCREEN-VALUE = "no".
    ELSE
    ASSIGN lUniExpand:SENSITIVE IN FRAME createalltables = YES
           lUniExpand:SCREEN-VALUE = "no"
           dummyl = lUniExpand:MOVE-AFTER-TAB-ITEM(unicodeTypes:HANDLE).
END.

ON VALUE-CHANGED OF unicodeTypes IN FRAME createtable DO:
    DEF VAR dummyl AS LOGICAL NO-UNDO.

    IF ft:SCREEN-VALUE EQ "ora" THEN
        RETURN.
            
    IF SELF:SCREEN-VALUE = "NO" THEN
       ASSIGN lUniExpand:SENSITIVE IN FRAME createtable = NO
              lUniExpand:SCREEN-VALUE = "no".
    ELSE
    ASSIGN lUniExpand:SENSITIVE IN FRAME createtable = YES
           lUniExpand:SCREEN-VALUE = "no"
           dummyl = lUniExpand:MOVE-AFTER-TAB-ITEM(unicodeTypes:HANDLE).
END.



ON VALUE-CHANGED OF l_cmptbl IN FRAME createalltables DO:

    IF ft:SCREEN-VALUE EQ "ora" THEN
        RETURN.

    IF SELF:SCREEN-VALUE = "NO" THEN
       ASSIGN iRecidOption:SENSITIVE IN FRAME createalltables = NO
           iRecidOption:SCREEN-VALUE IN FRAME createalltables = "1".
    ELSE
    ASSIGN iRecidOption:SENSITIVE IN FRAME createalltables = YES
           iRecidOption:SCREEN-VALUE IN FRAME createalltables = "1" .
END.

ON VALUE-CHANGED OF l_cmptbl IN FRAME createtable DO:

    IF ft:SCREEN-VALUE EQ "ora" THEN
        RETURN.
            
    IF SELF:SCREEN-VALUE = "NO" THEN
       ASSIGN iRecidOption:SENSITIVE IN FRAME createtable = NO
           iRecidOption:SCREEN-VALUE IN FRAME createalltables = "1".
    ELSE
    ASSIGN iRecidOption:SENSITIVE IN FRAME createtable = YES
           iRecidOption:SCREEN-VALUE IN FRAME createalltables = "1".
END.


ON LEAVE OF fot in frame createalltables
   fot:screen-value in frame createalltables = 
        TRIM(fot:screen-value in frame createalltables).

ON CHOOSE OF btn_File_i in frame createalltables DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT foi:handle in frame createalltables /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.

ON LEAVE OF foi in frame createalltables
   foi:screen-value in frame createalltables = 
        TRIM(foi:screen-value in frame createalltables).

ON VALUE-CHANGED OF ft IN FRAME createalltables DO:
   CASE SELF:SCREEN-VALUE:
     WHEN "pro" THEN DO:
       ASSIGN iFmtOption:SCREEN-VALUE IN FRAME createalltables = "2" 
              iRecidOption:SCREEN-VALUE IN FRAME createalltables = "1" 
              l_cmptbl:SENSITIVE = FALSE
              l_cmptbl:SCREEN-VALUE = "no"
              shadowcol:SENSITIVE = FALSE
              shadowcol:SCREEN-VALUE = "no"
              crtdef:SENSITIVE = FALSE
              crtdef:SCREEN-VALUE = "no".
       
       ASSIGN
              unicodeTypes:SENSITIVE IN FRAME createalltables= NO
              unicodeTypes:SCREEN-VALUE = "no"
              lUniExpand:SENSITIVE = NO
              lUniExpand:SCREEN-VALUE = "no"
              newSeq:SCREEN-VALUE = "no"
              newSeq:SENSITIVE = NO
              mapMSSDatetime:SCREEN-VALUE = "no"
              mapMSSDatetime:SENSITIVE = NO
              iRecidOption:SENSITIVE = NO.

       iFmtOption:DISABLE("Width") IN FRAME createalltables.
       APPLY "VALUE-CHANGED" TO iFmtOption IN FRAME createalltables.
     END.
     WHEN "ora" THEN DO:
       ASSIGN l_cmptbl:SENSITIVE = TRUE
              l_cmptbl:SCREEN-VALUE = "no"
              crtdef:SENSITIVE = TRUE
              shadowcol:SENSITIVE = TRUE.
       
       ASSIGN
              unicodeTypes:SENSITIVE IN FRAME createalltables = YES
              unicodeTypes:SCREEN-VALUE = "no"
              lUniExpand:SENSITIVE = NO
              lUniExpand:SCREEN-VALUE = "no"
              newSeq:SCREEN-VALUE = "no"
              newSeq:SENSITIVE = NO
              mapMSSDatetime:SCREEN-VALUE = "no"
              mapMSSDatetime:SENSITIVE = NO
              iRecidOption:SENSITIVE = NO.

       iFmtOption:ENABLE("Width") IN FRAME createalltables.
       APPLY "VALUE-CHANGED" TO iFmtOption IN FRAME createalltables.
     END.
     OTHERWISE DO:
       ASSIGN shadowcol:SENSITIVE = TRUE
              l_cmptbl:SENSITIVE = TRUE
              l_cmptbl:SCREEN-VALUE = "no"
              crtdef:SENSITIVE = TRUE.
       
       ASSIGN
              unicodeTypes:SENSITIVE IN FRAME createalltables = YES
              unicodeTypes:SCREEN-VALUE = "no"
              lUniExpand:SENSITIVE = NO
              lUniExpand:SCREEN-VALUE = "no"
              newSeq:SCREEN-VALUE = "no"
              newSeq:SENSITIVE = YES
              mapMSSDatetime:SCREEN-VALUE = "yes"
              mapMSSDatetime:SENSITIVE = YES
              iRecidOption:SENSITIVE = NO.

       iFmtOption:ENABLE("Width") IN FRAME createalltables.
       APPLY "VALUE-CHANGED" TO iFmtOption IN FRAME createalltables.
     END.
   END CASE.
END.

ON ENTRY OF FRAME createalltables DO:
   /* Just assigning l_cmptbl:SENSITIVE = FALSE doesn't work because the *
    * widget is not realized until the UPDATE statements are executed.   *
    * Once that happens, this is the only way to force the assignment.   */
   APPLY "VALUE-CHANGED" TO ft IN FRAME createalltables.
END.

ON WINDOW-CLOSE OF FRAME createalltables
   APPLY "END-ERROR" TO FRAME createalltables.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
ON VALUE-CHANGED OF allusers IN FRAME createalltables DO:
   DEFINE VARIABLE dummyl AS LOGICAL NO-UNDO.

   IF allusers:SCREEN-VALUE = "yes" THEN DO:
	usrnm:SENSITIVE = FALSE.
	usrnm:SCREEN-VALUE = "".
   END.
   ELSE DO:
        usrnm = "".
	usrnm:SENSITIVE = TRUE.
	dummyl = usrnm:MOVE-AFTER-TAB-ITEM(allusers:HANDLE).
	APPLY "ENTRY" TO usrnm.
   END.
END.
&ENDIF

/*========================= Initializations ============================*/

FIND DICTDB._File "_File" WHERE _File._Owner = "PUB" NO-LOCK.
answer = CAN-DO(_Can-read,USERID("DICTDB")).
FIND DICTDB._File "_Field" WHERE _File._Owner = "PUB" NO-LOCK.
answer = answer AND CAN-DO(_Can-read,USERID("DICTDB")).
FIND DICTDB._File "_Index" WHERE _File._Owner = "PUB" NO-LOCK.
answer = answer AND CAN-DO(_Can-read,USERID("DICTDB")).
IF NOT answer THEN DO:
  MESSAGE new_lang[6] VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  user_path = "".
  RETURN.
END.

RELEASE DICTDB._File.
assign alltables = (IF user_env[1] = "ALL" THEN yes ELSE no).

IF NOT alltables THEN
  FIND DICTDB._File 
    WHERE DICTDB._File._Db-recid = drec_db 
    AND DICTDB._File._File-name = user_env[1]
    AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN").


ASSIGN
  answer = TRUE
  fot = (IF alltables THEN user_dbname ELSE DICTDB._File._File-name)
      + ".p"
  foi = (IF alltables THEN user_dbname ELSE DICTDB._File._File-name)
      + ".i"
  fn  = (IF alltables THEN new_lang[5] ELSE DICTDB._File._File-name)
  usrnm  = (IF alltables THEN "ALL" ELSE ENTRY(1,_File._Can-read))
  ft  = ( if lookup(user_env[22],"pro,ora,mss") = 0
            then "pro"
            else user_env[22]
        )
  .

/* Adjust the graphical rectangle and the ok and cancel buttons */
IF alltables THEN DO:
  {adecomm/okrun.i  
    &FRAME  = "FRAME createalltables" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }
END.
ELSE DO:
  {adecomm/okrun.i  
    &FRAME  = "FRAME createtable" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
  }
END.
PAUSE 0.

/* here is the matrix of parameters per db-type */
assign
  l_dbtyp = "pro,ora,mss"
  l_ue-4  = "y,n,n"                        /* allow PROGRESS format statements */
  l_ue-5  = ".,;,go"                       /* statement terminator */
  l_ue-6  = "n,y,y"                        /* Unique index names? */
  l_ue-7  = "y,n,n"                        /* default <init value> */
  l_ue-8  = "y,y,y"                        /* xlat "-" -> "_" */
  l_ue-11 = "character,varchar2,varchar"   /* character */
  l_ue-12 = "date,date,datetime"           /*           */
  l_ue-13 = "logical,number,tinyint"       /* logical   */
  l_ue-14 = "integer,number,integer"       /* integer   */
  l_ue-15 = "decimal,number,decimal(18,5)" /* decimal   */
  l_ue-16 = "decimal,number,decimal"       /* decimal(_decimal=0) */
  l_ue-17 = "recid,number,integer"         /* recid     */
  l_ue-18 = "character,long,text"          /* char > x(240) */
  l_ue-19 = "logical,number,tinyint"       /* logical(idx-comp) */
  l_ue-20 = ",#,#"                         /* char for arrays; e.g. mnth-sales##12 */
  l_ue-21 = "n,y,n"                        /* shadowing for case-sensitivity */
  l_ue-22 = "PROGRESS,ORACLE,MSS"                         
  l_ue-23 = "8,30,30"                     /* minimum width for character-fields */
  l_ue-24 = "7,15,15"                     /* minimum width for numeric-fields */
  l_ue-25 = "n,y,y"                       /* sequences supported */
  l_ue-28 = "32,30,128"                    /* max-length(idx-name) */
  l_ue-29 = "32,26,128"                    /* max-length(id-name) */
  .
/*========================== Mainline code =============================*/

IF alltables THEN 
 DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:

  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN  
    uidtag = new_lang[7].

    DISPLAY uidtag cFormat lFormat cRecid WITH FRAME createalltables.
    usrnm = "ALL".
  
    UPDATE
      fot btn_File_t
      foi btn_File_i
      usrnm
      ft
      l_cmptbl
      shadowcol
      crtdef
      unicodeTypes
      lUniExpand WHEN unicodeTypes
      newSeq
      mapMSSDatetime
      iFmtOption
      lFormat WHEN iFmtOption = 2 
      iRecidOption
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
      WITH FRAME createalltables.
  &ELSE
    DISPLAY usrlab cFormat lFormat cRecid WITH FRAME createalltables.
    UPDATE
      fot btn_File_t
      foi btn_File_i
      allusers
      ft
      l_cmptbl
      shadowcol      
      crtdef
      unicodeTypes
      lUniExpand WHEN unicodeTypes
      newSeq
      mapMSSDatetime
      iFmtOption
      lFormat WHEN iFmtOption = 2
      iRecidOption
      btn_OK 
      btn_Cancel
      {&HLP_BTN_NAME}
      WITH FRAME createalltables.
    IF allusers THEN usrnm = "ALL".
  &ENDIF

  /* if cr tab and cr idx both going to same file, wipe out idx fil name */
  IF foi = fot AND (OPSYS <> "UNIX" OR ENCODE(foi) = ENCODE(fot)) THEN foi = "".

  ASSIGN
    l_i          = lookup(ft,l_dbtyp)
    user_env[ 2] = fot  /* output file */
    user_env[ 3] = foi  /* '' or separate output file for 'create index' */
    user_env[ 4] = entry(l_i,l_ue-4)
    user_env[ 5] = entry(l_i,l_ue-5)
    user_env[ 6] = entry(l_i,l_ue-6)
    user_env[ 8] = entry(l_i,l_ue-8)
    user_env[ 9] = usrnm             /* userid */
    user_env[11] = entry(l_i,l_ue-11)
    user_env[12] = entry(l_i,l_ue-12)
    user_env[13] = entry(l_i,l_ue-13)
    user_env[14] = entry(l_i,l_ue-14)
    user_env[15] = entry(l_i,l_ue-15)
    user_env[16] = entry(l_i,l_ue-16)
    user_env[17] = entry(l_i,l_ue-17)
    user_env[18] = entry(l_i,l_ue-18)
    user_env[19] = entry(l_i,l_ue-19)
    user_env[20] = entry(l_i,l_ue-20)   
    user_env[22] = entry(l_i,l_ue-22)
    user_env[23] = entry(l_i,l_ue-23)
    user_env[24] = entry(l_i,l_ue-24)
    user_env[25] = entry(l_i,l_ue-25)
    user_env[27] = string(l_cmptbl,"y/n")
    user_env[28] = entry(l_i,l_ue-28)
    user_env[29] = entry(l_i,l_ue-29)
    user_env[31] = "-- **"           /*comment-character*/
    user_env[38] = "1"            /* OE00209275 */
    user_env[39] = "1"            /* OE00209275 */
    user_env[36] = "n,n,n,n,n"    /* OE00211502 */
    .

  IF user_env[22] = "ORACLE" OR user_env[22] = "MSS" THEN
     unicodeTypes = LOGICAL(unicodeTypes:SCREEN-VALUE IN FRAME createalltables).
  ELSE
     unicodeTypes = NO.

  IF user_env[22] = "MSS" THEN DO:
        ASSIGN user_env[7]  = (IF crtdef THEN "y" ELSE "n")
             user_env[10] = (IF unicodeTypes THEN "4000" ELSE "8000")
             user_env[12] = (IF mapMSSDatetime THEN "datetime" ELSE "date")
             user_env[32] = "MSSQLSRV7"
             user_env[21] = (IF shadowcol THEN "y" ELSE "n")
             user_env[27] = (IF l_cmptbl THEN "y" + "," + STRING(iRecidOption) ELSE "n")
             user_env[35] = "n".

       /* first y is for sequence support.
          second entry is for new sequence generator 
          third entry is for use 2008 types 
       */
       ASSIGN user_env[25] = "y" + (IF newseq THEN ",y" ELSE ",n") + 
                             (IF mapMSSDatetime THEN ',n' ELSE ',y').

      IF unicodeTypes THEN
         ASSIGN user_env[11] = "nvarchar"
                user_env[18] = "nvarchar(max)"
                lUniExpand = LOGICAL(lUniExpand:SCREEN-VALUE IN FRAME createalltables)
                user_env[35] = (IF lUniexpand THEN "y" ELSE "n").
                
  END.
  ELSE IF user_env[22] = "ORACLE" THEN
      ASSIGN user_env[7]  = (IF crtdef THEN "y" ELSE "n")
             user_env[18] = (IF unicodeTypes THEN "NVARCHAR2" ELSE "VARCHAR2")
             user_env[21] = (IF shadowcol THEN "y" ELSE "n")
             /* no support for character semantics and clob expansion */
             user_env[10] = (IF unicodeTypes THEN "2000" ELSE "4000") + ",no,no"
             user_env[11] = (IF unicodeTypes THEN "nvarchar2" ELSE "varchar2").
  ELSE
      ASSIGN user_env[7]  = "y" 
             user_env[21] = "n".
   
  IF iFmtOption = 1 THEN
    ASSIGN user_env[33] = "y".
  ELSE IF (lFormat = TRUE) THEN
    ASSIGN user_env[33] = "n".
  ELSE ASSIGN user_env[33] = "?".

  RUN "prodict/misc/_wrktgen.p".
  canned = FALSE.
END.

ELSE /*Single table*/
 DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:

   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN  
   DISPLAY cFormat lFormat cRecid WITH FRAME createtable.
   UPDATE
    fot btn_File_t
    foi btn_File_i
    ft
    l_cmptbl
    shadowcol
    crtdef
    unicodeTypes
    lUniExpand WHEN unicodeTypes
    newSeq
    mapMSSDatetime
    iFmtOption
    lFormat WHEN iFmtOption = 2
    iRecidOption
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    WITH FRAME createtable.
  &ELSE
   DISPLAY cFormat lFormat cRecid WITH FRAME createtable.
   UPDATE
    fot btn_File_t
    foi btn_File_i
    ft
    l_cmptbl
    shadowcol
    crtdef
    unicodeTypes
    lUniExpand WHEN unicodeTypes
    newSeq
    mapMSSDatetime
    iFmtOption
    lFormat WHEN iFmtOption = 2
    iRecidOption
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    WITH FRAME createtable.
  &ENDIF

  /* if cr tab and cr idx both going to same file, wipe out idx fil name */
  IF foi = fot AND (OPSYS <> "UNIX" OR ENCODE(foi) = ENCODE(fot)) THEN foi = "".

  ASSIGN
    l_i          = lookup(ft,l_dbtyp)
    user_env[ 2] = fot  /* output file */
    user_env[ 3] = foi  /* '' or separate output file for 'create index' */
    user_env[ 4] = entry(l_i,l_ue-4)
    user_env[ 5] = entry(l_i,l_ue-5)
    user_env[ 6] = entry(l_i,l_ue-6)
    user_env[ 8] = entry(l_i,l_ue-8)
    user_env[ 9] = "ALL"      	     /* userid */
    user_env[11] = entry(l_i,l_ue-11)
    user_env[12] = entry(l_i,l_ue-12)
    user_env[13] = entry(l_i,l_ue-13)
    user_env[14] = entry(l_i,l_ue-14)
    user_env[15] = entry(l_i,l_ue-15)
    user_env[16] = entry(l_i,l_ue-16)
    user_env[17] = entry(l_i,l_ue-17)
    user_env[18] = entry(l_i,l_ue-18)
    user_env[19] = entry(l_i,l_ue-19)
    user_env[20] = entry(l_i,l_ue-20)
    user_env[22] = entry(l_i,l_ue-22)
    user_env[23] = entry(l_i,l_ue-23)
    user_env[24] = entry(l_i,l_ue-24)
    user_env[25] = entry(l_i,l_ue-25)
    user_env[27] = string(l_cmptbl,"y/n")
    user_env[28] = entry(l_i,l_ue-28)
    user_env[29] = entry(l_i,l_ue-29)
    user_env[31] = "-- **"           /*comment-character*/
    user_env[38] = "1"            /* OE00209275 */
    user_env[39] = "1"            /* OE00209275 */
    user_env[36] = "n,n,n,n,n"    /* OE00211502 */
    .

  IF user_env[22] = "ORACLE" OR user_env[22] = "MSS" THEN
     unicodeTypes = LOGICAL(unicodeTypes:SCREEN-VALUE IN FRAME createtable).
  ELSE
      unicodeTypes = NO.

  IF user_env[22] = "MSS" THEN DO:
  
      ASSIGN user_env[ 7] = (IF crtdef THEN "y" ELSE "n")
             user_env[10] = (IF unicodeTypes THEN "4000" ELSE "8000")
             user_env[12] = (IF mapMSSDatetime THEN "datetime" ELSE "date")
             user_env[32] = "MSSQLSRV7"
             user_env[21] = (IF shadowcol THEN "y" ELSE "n")
             user_env[27] = (IF l_cmptbl THEN "y" + "," + STRING(iRecidOption) ELSE "n")
             user_env[35] = "n".

      /* first y is for sequence support.
         second entry is for new sequence generator 
         third entry is for use 2008 types 
      */
      ASSIGN user_env[25] = "y" + (IF newseq THEN ",y" ELSE ",n") + 
                            (IF mapMSSDatetime THEN ',n' ELSE ',y').

      IF unicodeTypes THEN
         ASSIGN user_env[11] = "nvarchar"
                user_env[18] = "nvarchar(max)"
                lUniExpand = LOGICAL(lUniExpand:SCREEN-VALUE IN FRAME createtable)
                user_env[35] = (IF lUniexpand THEN "y" ELSE "n").
  END.
  ELSE IF user_env[22] = "ORACLE" THEN
      ASSIGN user_env[ 7] = (IF crtdef THEN "y" ELSE "n")
             user_env[18] = (IF unicodeTypes THEN "NVARCHAR2" ELSE "VARCHAR2")
             user_env[21] = (IF shadowcol THEN "y" ELSE "n")
             /* no support for character semantics and clob expansion */
             user_env[10] = (IF unicodeTypes THEN "2000" ELSE "4000") + ",no,no"
             user_env[11] = (IF unicodeTypes THEN "nvarchar2" ELSE "varchar2").
  ELSE
      ASSIGN user_env[ 7] = "y"
             user_env[21] = "n".

  IF iFmtOption = 1 THEN
    ASSIGN user_env[33] = "y".
  ELSE IF (lFormat = TRUE) THEN
    ASSIGN user_env[33] = "n".   
  ELSE ASSIGN user_env[33] = "?".

  RUN "prodict/misc/_wrktgen.p".
  canned = FALSE.
END.

HIDE FRAME createtable NO-PAUSE.
IF canned THEN
  user_path = "".

RETURN.

/*********************************************************************
* Copyright (C) 2008 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/*************************************************************
   _usrtget.p - select a table 

History:
    laurief  04/09/98  Added p_allw and count to allow us to compare
                       the number of tables selected to the total
                       number of tables available.  This needs to be
                       done in the case where a user is not typing "ALL",
                       instead the user types an "*" in the 
                       select/deselect dialog.  This allows us to 
                       compare count with cache_file# and if they are
                       equal, the .df will contain all database schema
                       info correctly.  BUG 97-07-22-029
   mcmann  04/20/98    Added exclusion of views from table list.
   mcmann  07/09/98    Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                       to Find _File
   Mario B 12/11/98   The ALL option was appearing in places where
                      it should not.  Changed display with frame t-type so
                      that p_all and p_allw are ANDed instead of ORed.  That
                      fixed it.  BUG 98-05-06-056  
   Mario B 11/11/98   More fixes to the "ALL" option.  All not needed when
                      pattern matching is presented.  BUG# 19991025-003
   D. McMann 05/10/00 Added ability for user to display hidden files
   D. McMann 07/11/02 redo cache if session:schema-change is set to new objects.
                      20020701-029
   fernando  03/13/06 Storing table names in temp-table - 20050930-006.
   fernando  12/13/07 Handle long list of "some" selected tables 
   fernando  06/26/08 Filter out schema tables for encryption   

*************************************************************/


{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

/*
INPUT:
user_env[1] MATCHES "*o*":
  If this program sees an "o" (for "optional") in user_env[1], then it
  returns immediately if a filename is currently set (other than
  "ALL").

user_env[1] MATCHES "*a*":
  If this program sees an "a" (for "all"), then "ALL" is a valid
  choice.

user_env[1] MATCHES "*s*":
  If this program sees an "s" (for "some"), then [Return] marks (or
  unmarks) names, and the comma-delimited list of names is returned in
  user_env[1].


OUTPUT:
drec_file
  Contains the recid of the _File record selected, or no record if
  'ALL' or some entered.

user_filename
user_env[1]
  Contains the filename selected, or 'ALL', or a comma-separated list
  of filenames.  If a comma-sep list is returned in user_env[1], 'SOME'
  is returned in user_filename.
*/

DEFINE VARIABLE c          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE g          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE h          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE h2         AS CHARACTER              NO-UNDO.
DEFINE VARIABLE hb         AS INTEGER                NO-UNDO.
DEFINE VARIABLE i          AS INTEGER                NO-UNDO.
DEFINE VARIABLE sh         AS CHARACTER              NO-UNDO.
DEFINE VARIABLE inc-hid    AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE j          AS INTEGER                NO-UNDO.
DEFINE VARIABLE l          AS LOGICAL                NO-UNDO.
DEFINE VARIABLE lb         AS INTEGER                NO-UNDO.
DEFINE VARIABLE noselect   AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE offset     AS INTEGER   INITIAL 20   NO-UNDO.
DEFINE VARIABLE p_all      AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_allw     AS LOGICAL                NO-UNDO.
DEFINE VARIABLE count      AS INTEGER   INITIAL 0    NO-UNDO.
DEFINE VARIABLE p_init     AS INTEGER   INITIAL ?    NO-UNDO.
DEFINE VARIABLE p_option   AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_original AS CHARACTER              NO-UNDO.
DEFINE VARIABLE p_recid    AS INTEGER   INITIAL 1    NO-UNDO.
DEFINE VARIABLE p_some     AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_spot     AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_touch    AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE p_typed    AS CHARACTER INITIAL ""   NO-UNDO.
DEFINE VARIABLE pattern    AS CHARACTER INITIAL "*"  NO-UNDO.
DEFINE VARIABLE point_flag AS LOGICAL   EXTENT  2048 NO-UNDO.
DEFINE VARIABLE redraw     AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE small      AS INTEGER                NO-UNDO.
DEFINE VARIABLE isCpUndefined AS LOGICAL             NO-UNDO.
DEFINE VARIABLE use_lchar  AS LOGICAL                NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 13 NO-UNDO INITIAL [
  /*  1*/ "(or ~"ALL~" for all tables)", /* length must be <= 26 */
  /*  2*/ "The entered name does not match any table name in this database.",
  /*  3*/ "Use direction keys navigate, or begin typing table name.",
  /*  4*/ "You do not have permission to select tables.",
  /*5,6*/ "Press the", "key to end.",
  /*  7*/ "key.",
  /*  8*/ "when done.",
  /*  9*/ "Press",
  /* 10*/ "to select/deselect",
  /* 11*/ "by pattern.",
  /* 12*/ "There are no tables in this database to select.",
  /* 13*/ "key to show/hide hidden files."
].

FORM
  point_flag[p_recid] FORMAT "*/ "
  cache_file[p_recid] FORMAT "x(34)"
  WITH FRAME t-pick SCROLL 1 NO-LABELS ATTR-SPACE
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg)
  SCREEN-LINES - 10 DOWN ROW 7 COLUMN offset. /* see below if changing DOWN */

FORM
  c          LABEL "Table Name" FORMAT "x(26)" NO-ATTR-SPACE SKIP
  p_typed NO-LABEL              FORMAT "x(37)"
  WITH FRAME t-type SIDE-LABELS ATTR-SPACE ROW 3 COLUMN offset
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg).
COLOR DISPLAY VALUE(IF pick-bg = "MESSAGES" THEN "INPUT" ELSE pick-bg) p_typed
  WITH FRAME t-type.

FORM
  "Select tables with the [" SPACE(0) c FORMAT "x(14)" SKIP
  "Press [" SPACE(0) g FORMAT "x(32)" SKIP
  h FORMAT "x(34)" h2 FORMAT "x(12)"  SKIP
  sh FORMAT "x(45)"
  WITH FRAME t-help NO-LABELS NO-ATTR-SPACE ROW 1 COLUMN offset
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg).

FORM SKIP(1)
  "Enter name of table to" AT 2
  l FORMAT "select./deselect." NO-LABEL SKIP

  "Use * and . for wildcard patterns." AT 2 SKIP(1)

  pattern AT 2 LABEL "Table Name" FORMAT "x(30)" SKIP(1)
  WITH FRAME t-patt OVERLAY ROW 7 CENTERED SIDE-LABELS ATTR-SPACE
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg).

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/
/* In case the last change was rolled back, we want to refresh the table list */
IF SESSION:SCHEMA-CHANGE = "New objects" THEN
    ASSIGN cache_dirty = true.

IF cache_dirty THEN RUN "prodict/_dctcach.p" (inc-hid).

i = 0.
FIND _File WHERE _File._File-name = "_File"
             AND _File._Owner = "PUB".
IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN i = 4. /* no perm to peek */
IF cache_file# = 0 THEN DO:
  FIND FIRST _File WHERE _Db-recid = drec_db 
                     AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                     AND _Hidden NO-ERROR.
  IF NOT AVAILABLE _File THEN i = 12. /* no files */
END.
IF i > 0 THEN DO:
  MESSAGE new_lang[i] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  ASSIGN
    drec_file     = ?
    user_path     = ""
    user_filename = ""
    user_env[1]   = "".
  RETURN.
END.

/* 20050930-006
   If the cache information is in the temp-table, run the version that
   reads the temp-table 
*/
IF l_cache_tt THEN DO:
    RUN prodict/user/_usrtget-tt.p.
    RETURN.
END.

IF user_filename <> "" THEN DO:
  { prodict/dictsrch.i
    &vector=cache_file
    &extent=cache_file#
    &tofind=user_filename
    &result=i
  }
  IF i > 0 THEN ASSIGN
    p_init  = MINIMUM(SCREEN-LINES - 10,i)
    p_recid = i.
END.

ASSIGN
  p_option      = user_env[1] MATCHES "*o*" AND drec_file <> ?
  p_all         = user_env[1] MATCHES "*a*"
  p_allw        = user_env[1] MATCHES "***"
  p_some        = user_env[1] MATCHES "*s*"
  p_typed       = (IF user_filename = "SOME" THEN "" ELSE user_filename)
  cache_dirty   = p_some AND p_all OR (p_some AND p_allw) /* this is important! */
  user_filename = "".

IF SESSION:CPINTERNAL EQ "undefined":U THEN
   isCpUndefined = YES.

IF p_all AND p_allw AND cache_file[1] <> "ALL" AND cache_file# >= 1 THEN DO:
  DO i = cache_file# + 1 TO 2 BY -1:
    cache_file[i] = cache_file[i - 1].
  END.
  ASSIGN
    cache_file[1] = "ALL"
    cache_file#   = cache_file# + 1.  
END.
ELSE IF NOT p_all AND p_allw AND cache_file[1] = "ALL" THEN
DO:
  /* This means "ALL" should not be offered BUG# 19991025-003
   * This is certainly strange, but "ALL" may have been put into
   * cache_file[1] before we got here.  It was easier to do this
   * than to modify every program that calls this.
   */
  IF cache_file# > 1 THEN
  DO i = 1 TO cache_file#:
     cache_file[i] = cache_file[i + 1].
     IF i = cache_file# THEN cache_file# = cache_file# - 1.
  END.
  ELSE if cache_file# = 1 THEN
  ASSIGN
     cache_file[1] = ""
     cache_file# = 0.
END.

IF (p_typed = "ALL" AND NOT p_all)
  OR (p_typed = "" AND cache_file# > 0) THEN p_typed = cache_file[1].
p_original =  p_typed.

IF p_option THEN user_filename = p_typed.
ELSE IF p_some THEN 
  DISPLAY
  KBLABEL("RETURN") + "] " + new_lang[7] @ c
  KBLABEL("GO")     + "] " + new_lang[8] @ g
  new_lang[9] + " [" + KBLABEL("GET") + "]/[" + KBLABEL("PUT")
                    + "] " + new_lang[10] @ h 
  new_lang[11] @ h2 
  new_lang[5] + " [" + KBLABEL("RECALL") + "] " + new_lang[13] @ sh
  WITH FRAME t-help.
ELSE DISPLAY (IF p_all AND p_allw THEN new_lang[1] ELSE "") @ c WITH FRAME t-type.
                         /* ^-- (or "ALL" for all files) */
IF NOT p_option THEN DO:
  DISPLAY "" @ cache_file[p_recid] WITH FRAME t-pick.

  user_status = new_lang[5] + " [" + KBLABEL("END-ERROR") + "] " + new_lang[6].
  STATUS DEFAULT user_status.

  IF NOT p_option THEN _pick: DO WHILE TRUE: 

    p_recid = MAXIMUM(1,MINIMUM(cache_file#,p_recid)).

    IF redraw THEN DO WITH FRAME t-pick:
      IF p_init <> ? THEN DOWN p_init - 1.
      ASSIGN
        j      = MAXIMUM(1,FRAME-LINE)
        p_spot = p_recid - j + 1
        p_init = ?.
      UP j - 1.
      IF p_spot < 1 THEN ASSIGN
        p_spot  = 1
        j       = 1
        p_recid = 1.
      i = p_recid.
      DO p_recid = p_spot TO p_spot + FRAME-DOWN - 1:
        IF p_recid > cache_file# THEN
          CLEAR NO-PAUSE.
        ELSE
          DISPLAY point_flag[p_recid] cache_file[p_recid].
        IF p_recid < p_spot + FRAME-DOWN - 1 THEN DOWN.
      END.
      ASSIGN
        p_init  = ?
        redraw  = FALSE
        p_recid = i
        j       = (IF p_init = ? THEN j ELSE p_init).
      UP FRAME-DOWN - j.
    END.

    IF cache_file# > 0 THEN
      DISPLAY point_flag[p_recid] cache_file[p_recid] WITH FRAME t-pick.

    IF cache_file# > 0 AND cache_file[p_recid] BEGINS p_typed AND
      (p_some OR p_recid = cache_file# OR cache_file[p_recid] = p_typed
      OR NOT cache_file[p_recid + 1] BEGINS p_typed) THEN
      COLOR DISPLAY VALUE(pick-bg) cache_file[p_recid] WITH FRAME t-pick.
    IF NOT p_some THEN DO WITH FRAME t-type:
      IF INPUT p_typed <> p_typed THEN DISPLAY p_typed.
      PUT CURSOR ROW 6 COLUMN offset + 2 + LENGTH(p_typed).
    END.
    READKEY.
    IF NOT p_some THEN PUT CURSOR OFF.
    IF cache_file# > 0 THEN
      COLOR DISPLAY VALUE(pick-fg) cache_file[p_recid] WITH FRAME t-pick.
    PAUSE 0.

    IF KEYFUNCTION(LASTKEY) = "BACKSPACE" THEN DO:
      IF LENGTH(p_typed) = 0 THEN NEXT _pick.
      ASSIGN
        p_touch = FALSE
        p_typed = SUBSTRING(p_typed,1,LENGTH(p_typed) - 1)
        i       = (IF p_typed = "" THEN 1 ELSE p_recid).
      DO WHILE i > 1 AND cache_file[i - 1] BEGINS p_typed:
        i = i - 1.
      END.
      IF FRAME-LINE(t-pick) >= p_recid - i THEN
        UP p_recid - i WITH FRAME t-pick.
      ELSE
        redraw = TRUE.
      p_recid = i.
      NEXT _pick.
    END.

    IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND LASTKEY > 32 THEN DO:
      ASSIGN
        p_typed = (IF p_touch THEN "" ELSE p_typed) + CHR(LASTKEY)
        p_touch = FALSE.
      IF   (cache_file# = 0)
        OR (cache_file[p_recid] BEGINS p_typed)
        OR (p_typed < SUBSTRING(cache_file[1],1,LENGTH(p_typed)))
        OR (p_typed > cache_file[cache_file#])
        OR (LENGTH(p_typed) > 1 AND NOT cache_file[p_recid] BEGINS
            SUBSTRING(p_typed,1,LENGTH(p_typed) - 1)) THEN NEXT _pick.
      { prodict/dictsrch.i
        &vector=cache_file
        &extent=cache_file#
        &tofind=p_typed
        &result=j
      }
      IF j < 0 THEN j = p_recid.
      p_spot = j - p_recid + FRAME-LINE(t-pick).
      IF j > 0 THEN p_recid = j.
      IF p_spot < 1 OR p_spot > FRAME-DOWN(t-pick) THEN
        redraw = TRUE.
      ELSE
        UP FRAME-LINE(t-pick) - p_spot WITH FRAME t-pick.
      NEXT _pick.
    END.

    IF p_some AND cache_file# > 0 AND (
        (noselect AND KEYFUNCTION(LASTKEY) = "GO") /*if SOME & none yet marked*/
      OR
        CAN-DO("RETURN,PICK",KEYFUNCTION(LASTKEY) )
      ) THEN DO:
      ASSIGN
        noselect            = FALSE
        point_flag[p_recid] = NOT point_flag[p_recid].
      DISPLAY point_flag[p_recid] WITH FRAME t-pick.
    END.
    /*ELSE*/ /* no else here */
    IF CAN-DO("CURSOR-DOWN,TAB, " + (IF p_some THEN ",RETURN" ELSE ""),
      KEYFUNCTION(LASTKEY)) AND p_recid < cache_file# THEN DO:
      p_recid = p_recid + 1.
      IF FRAME-LINE(t-pick) = FRAME-DOWN(t-pick) THEN
        SCROLL UP WITH FRAME t-pick.
      ELSE
        DOWN WITH FRAME t-pick.
    END.
    ELSE
    IF CAN-DO("CURSOR-UP,BACK-TAB",KEYFUNCTION(LASTKEY))
      AND p_recid > 1 THEN DO:
      p_recid = p_recid - 1.
      IF FRAME-LINE(t-pick) = 1 THEN
        SCROLL DOWN WITH FRAME t-pick.
      ELSE
        UP WITH FRAME t-pick.
    END.
    ELSE IF KEYFUNCTION(LASTKEY) = "RECALL" THEN DO:
      IF inc-hid THEN
        ASSIGN inc-hid = FALSE
                 redraw = TRUE.
      ELSE
        ASSIGN inc-hid = TRUE
               redraw = TRUE.
      RUN prodict/_dctcach.p (inc-hid).
    END.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN ASSIGN
      p_recid = p_recid + FRAME-DOWN(t-pick)
      redraw  = TRUE.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN ASSIGN
      p_recid = p_recid - FRAME-DOWN(t-pick)
      redraw  = TRUE.
    ELSE
    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
      ASSIGN
        p_recid = 1
        redraw  = TRUE.
      UP FRAME-LINE(t-pick) - 1 WITH FRAME t-pick.
    END.
    ELSE
    IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
      ASSIGN
        p_recid = cache_file#
        redraw  = TRUE.
      DOWN FRAME-DOWN(t-pick) - FRAME-LINE(t-pick) WITH FRAME t-pick.
    END.
    ELSE
    IF CAN-DO("GO" + (IF p_some THEN "" ELSE ",RETURN"),KEYFUNCTION(LASTKEY))
      THEN DO:
       IF p_some THEN DO:
         user_filename = "".

         IF NOT isCpUndefined THEN
             user_longchar = "".
         
        /* The commented out sections within this block are because we
         * no longer allow ALL to be in the list when we present the flavor
         * that allows wildcards and the select/deselect of one or more files. 
         * Bug# 19991025-003.
         */

         /* let's do a quick check to see if user selected all */
         DO p_recid = 1 TO cache_file#:
            IF point_flag[p_recid] THEN
               count = count + 1.
         END.

         IF count = cache_file# THEN
            user_filename = "ALL".
         ASSIGN count = 0.

         IF user_filename = "" THEN DO p_recid = 1 TO cache_file#:
           IF point_flag[p_recid] /* OR (p_all AND point_flag[1]) OR (p_allw
              AND point_flag[1]) */ THEN DO:             
             count = count + 1.
             IF COUNT = 1 THEN
                user_filename = cache_file[p_recid].
             ELSE DO:
                IF use_lchar THEN
                   user_longchar = user_longchar + "," + cache_file[p_recid] NO-ERROR.
                ELSE
                   user_filename = user_filename + "," + cache_file[p_recid] NO-ERROR.
                
                IF ERROR-STATUS:ERROR THEN DO:
                    /* if undefined codepage, nothing we can do but error out */
                    IF isCpUndefined THEN
                        user_filename = user_filename + "," + cache_file[p_recid].
                    
                    ASSIGN user_longchar =  user_filename + "," + cache_file[p_recid]. 
                           use_lchar = YES.
                END.
             END.

           END.
           ELSE IF point_flag[p_recid] AND NOT p_all AND NOT p_allw
           THEN count = cache_file# - 1.
        END.

        /* can't happen anymore
           IF user_filename BEGINS "," THEN
          user_filename = SUBSTRING(user_filename,2).
         */
      END. /* if p_some */
      ELSE
      IF p_all AND p_typed = "ALL" THEN user_filename = "ALL".
      ELSE
      IF cache_file[p_recid] BEGINS p_typed AND
        (p_recid = cache_file# OR cache_file[p_recid] = p_typed
        OR NOT cache_file[p_recid + 1] BEGINS p_typed)
        THEN user_filename = cache_file[p_recid].
      ELSE
      IF p_typed <> cache_file[p_recid] THEN DO:
        FIND _File
          WHERE _File._Db-recid = drec_db
            AND _File._File-name BEGINS p_typed 
            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
        IF NOT AVAILABLE _File OR CAN-DO({&INVALID_SCHEMA_TABLES},_File._File-name) THEN DO:
          MESSAGE new_lang[2]. /* bad filename guess */
          BELL.
          NEXT _pick.
        END.
        user_filename = _File._File-name.
      END.
      LEAVE _pick.
    END.
    ELSE
    IF CAN-DO("GET,PUT",KEYFUNCTION(LASTKEY)) AND p_some THEN DO:
      ASSIGN
        noselect = FALSE
        lb = 0
        l = KEYFUNCTION(LASTKEY) = "GET".
      PAUSE 0.
      DISPLAY l WITH FRAME t-patt.
      DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        UPDATE pattern WITH FRAME t-patt.
      END.
      redraw = KEYFUNCTION(LASTKEY) <> "END-ERROR".
      IF redraw THEN DO i = 1 TO cache_file#:
        IF CAN-DO(pattern,cache_file[i]) THEN
          ASSIGN point_flag[i] = l lb = lb + 1.
      END.
      HIDE FRAME t-patt NO-PAUSE.
      IF redraw AND lb = 0 AND l THEN DO:
        lb = cache_file#.
        FOR EACH _File
          WHERE _File._Db-recid = drec_db 
            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
            AND _File._Hidden
            AND CAN-DO(pattern,_File._File-name)
            AND _File._tbl-type <> "V" :
          ASSIGN lb = lb + 1 cache_file[lb] = _File._File-name.
        END.
        IF lb <> cache_file# THEN DO i = 1 TO lb: /* this is exchange sort */
          hb = i.
          DO j = i + 1 TO lb:
            IF cache_file[j] < cache_file[hb] THEN hb = j.
          END.
          IF hb > i THEN ASSIGN
            c              = cache_file[i]
            cache_file[i]  = cache_file[hb]
            cache_file[hb] = c.
        END. /*--------------------------------------- end of exchange sort */
        ASSIGN
          cache_dirty = lb <> cache_file#
          cache_file# = lb.          
      END.
    END.
    ELSE
    IF CAN-DO("CLEAR,RECALL",KEYFUNCTION(LASTKEY)) THEN DO:
      p_typed = (IF KEYFUNCTION(LASTKEY) = "CLEAR" THEN "" ELSE p_original).
      NEXT _pick.
    END.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN DO:
      ASSIGN
        user_filename = ""
        user_path     = "".
      LEAVE _pick.
    END.
    ASSIGN
      p_typed = cache_file[MAXIMUM(1,MINIMUM(cache_file#,p_recid))]
      p_touch = TRUE.
   
  END. /* _pick */
END. /* if optional */

FIND FIRST _File WHERE _File._Db-recid = drec_db
  AND _File._File-name = SUBSTRING(user_filename,1,33)
  AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") 
  AND _File._Tbl-type <> "V" NO-ERROR.
  /* Take a piece of user_filename since it can get pretty long.
  PROGRESS will gronk with "SYSTEM ERROR: fmsrt - maxdlen. (59)" if you
  try to compare a key with a string > 127 chars.  I learned this from
  experience. (Good judgement comes from experience.  Experience comes
  from bad judgement.) */  
ASSIGN
  user_filename = (IF AVAILABLE _File THEN _File._File-name
                  ELSE user_filename)
  user_env[1]   = (IF NOT use_lchar THEN user_filename ELSE "")
  drec_file     = RECID(_File).

IF use_lchar THEN
   user_filename = "SOME".
ELSE
IF user_filename MATCHES "*,*" THEN DO:
   IF p_all OR p_allw AND NOT p_some OR (count = cache_file#)
     THEN user_filename = "ALL".
   ELSE
     user_filename = "SOME".
END.
ELSE
IF user_filename <> "" THEN DO:
  /* I'm guessing this has never and will never execute.  Mario - 12/7/99 */
  IF count >= 1 AND (p_all OR p_allw) AND (count = cache_file#)
    THEN DO:
      user_env[1] = "ALL".
      user_filename = "ALL".
    END.
END.

DISPLAY user_filename WITH FRAME user_ftr.
IF user_filename = "" THEN user_path = "".

HIDE FRAME t-help NO-PAUSE.
HIDE FRAME t-patt NO-PAUSE.
HIDE FRAME t-pick NO-PAUSE.
HIDE FRAME t-type NO-PAUSE.
user_status = ?.
STATUS DEFAULT.
RETURN.


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE VARIABLE answer AS LOGICAL            NO-UNDO.
DEFINE VARIABLE c      AS CHARACTER          NO-UNDO.
DEFINE VARIABLE i      AS INTEGER            NO-UNDO.
DEFINE VARIABLE j      AS INTEGER            NO-UNDO.

DEFINE VARIABLE msg    AS CHARACTER EXTENT 9 NO-UNDO.

DEFINE VARIABLE thread AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /* 1*/ "1=,_usrtget,_usrtchg,_usrfchg",
  /* 2*/ "1=,_usrtget,_usrfchg",
  /* 3*/ "1=,_usrtget,_usrichg",
  /* 4*/ "_usrkchg",  
  /* 5*/ "1=,_usrtget,_guisqlw",
  /* 6*/ "", /* this MUST be "" */
  /* 7*/ "*R"
].

/* if nothing worthwhile posted in this transaction, then just return. */
IF NOT dict_dirty THEN DO:
  user_trans = "".
  RETURN.
END.

DISPLAY
  " M. Modify Existing Table " @ msg[1] HELP "Update Existing Table" SKIP
  " F. Field Editor "          @ msg[2] HELP "Field Editor" SKIP
  " I. Index Editor "          @ msg[3] HELP "Index Editor" SKIP
  " S. Sequence Editor "       @ msg[4] HELP "Sequence Editor" SKIP  
  " Q. Adjust Field Width "    @ msg[5] HELP "Field Width Browser" SKIP
  "---------------------------" NO-ATTR-SPACE SKIP
  " A. Apply Changes "         @ msg[6] HELP "Apply Changes to Database" SKIP
  " U. Undo Changes "          @ msg[7] HELP "Undo Recent Changes" SKIP
  WITH COLOR DISPLAY VALUE(menu-fg) NO-LABELS
  ATTR-SPACE ROW 3 CENTERED WITH FRAME mod-scheme.

FORM
  c FORMAT "x(63)" SKIP
  WITH FRAME instr j DOWN ROW 14 CENTERED NO-LABELS NO-ATTR-SPACE.

c = 'Once you leave this menu, all schema changes to database "'
  + user_dbname
  + '" will be applied.  This may take some time.  If you wish, you can '
  + 'select another change from this menu and include it in the '
  + 'transaction.  Selecting "Apply Changes" will apply the changes to '
  + 'your database.'.

{ prodict/dictsplt.i &src=c &dst=msg &num=9 &len=63 &chr=" " }

j = 0.
DO i = 9 TO 1 BY -1 WHILE j = 0:
  IF msg[i] <> "" THEN j = i.
END.
DO i = 1 TO j:
  DISPLAY msg[i] @ c WITH FRAME instr.
  DOWN WITH FRAME instr.
END.

ON CURSOR-UP BACK-TAB.
ON CURSOR-DOWN    TAB.
NEXT-PROMPT msg[6] WITH FRAME mod-scheme.

answer = FALSE.
DO WHILE NOT answer:
  DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
    CHOOSE FIELD msg[1 FOR 7] COLOR VALUE(menu-bg)
      AUTO-RETURN GO-ON(".") WITH FRAME mod-scheme.
  END.
  ASSIGN
    j         = (IF CHR(LASTKEY) = "." OR KEYFUNCTION(LASTKEY) = "END-ERROR"
                THEN 7 ELSE FRAME-INDEX)
    c         = SUBSTRING(INPUT FRAME mod-scheme msg[j],7)
    user_path = thread[j].
  IF user_path = "*R" THEN
    MESSAGE "Are you sure that you want to undo your work?" 
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
  ELSE
    answer = TRUE.
  IF answer = ? THEN answer = FALSE.
END.

ON CURSOR-UP   CURSOR-UP.
ON CURSOR-DOWN CURSOR-DOWN.

PAUSE 0.
HIDE FRAME mod-scheme.
HIDE FRAME instr.

user_trans = (IF user_path = ""   THEN "*"
         ELSE IF user_path = "*R" THEN ""
         ELSE                     "_usrtrax").

IF user_trans = "*" THEN DO:
  { prodict/user/userhdr.i c }
END.
ELSE DO:
  { prodict/user/userhdr.i user_hdr }
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------------
   Put up a frame for editing trigger code.

   Input Parameters:
      p_pgm	  - The name of the file to edit which contains trigger code
      p_event	  - The event of the trigger (e.g., "Create")
      p_tname	  - The name of the table that this trigger belongs to or
		    if a field trigger the name of the table the field belongs 
		    to.
      p_fname	  - The name of the field that this trigger belongs to.  
		    This should be "" for a table trigger.    
      p_synfixed  - yes if syntax toggle should be non-changeable - fixed at
      	       	    the input value below or no if user can decide. 
      	       	    (if yes, don't disable the toggle but give an error if 
      	       	     user tries to change it so he knows why)

   Input/Output Parameters:
      p_crc	  - On input, the current crc_value.  On ouput, set to new 
		    crc value if code was compiled successfully.
      p_Check	  - whether to default check syntax to yes or no.  Any new
		    setting is returned.

   History:
   
      tomn      04/96   Removed statement that assigned the screen-value
                        of the editor "tcode" to the underlying variable;
                        When the trigger procedure was large (gt 32K), it
                        would generate error 444.  "tcode" is a local var
                        that is not used in any comparison (as stated). 

---------------------------------------------------------------------------*/

{prodict/user/uservar.i}

DEFINE INPUT	    PARAMETER p_pgm    	  AS CHARACTER NO-UNDO.
DEFINE INPUT	    PARAMETER p_event  	  AS CHARACTER NO-UNDO.
DEFINE INPUT	    PARAMETER p_tname  	  AS CHARACTER NO-UNDO.
DEFINE INPUT	    PARAMETER p_fname  	  AS CHARACTER NO-UNDO.
DEFINE INPUT   	    PARAMETER p_synfixed  AS LOGICAL   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_crc    	  AS INTEGER   NO-UNDO.
DEFINE INPUT-OUTPUT PARAMETER p_Check  	  AS LOGICAL   NO-UNDO.

DEFINE VARIABLE tcode  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE saved  AS LOGICAL     NO-UNDO.
DEFINE VARIABLE fname  AS CHARACTER   NO-UNDO.

FORM
   tcode view-as EDITOR INNER-CHARS 72 INNER-LINES 13 SCROLLBAR-V  SKIP
   p_check LABEL "Auto Check Syntax" AT 28 VIEW-AS TOGGLE-BOX
   {prodict/user/userbtns.i}
   WITH FRAME trigcode 
   DEFAULT-BUTTON btn_OK
   VIEW-AS DIALOG-BOX TITLE "Trigger Code" NO-LABELS.


/*=============================Triggers=================================*/

ON GO OF FRAME trigcode
DO:
   DEFINE VAR tmpfile AS CHAR NO-UNDO.

   /* Return if user doesn't want to check syntax. */
   ASSIGN p_check.
   IF NOT p_check THEN
      RETURN.

   RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".dct", OUTPUT tmpfile).
   saved = tcode:SAVE-FILE(tmpfile) IN FRAME trigcode.

   /* Try to compile it. */
   COMPILE VALUE(tmpfile) NO-ERROR.
   OS-DELETE VALUE(tmpfile).

   IF COMPILER:ERROR THEN
   DO:
      MESSAGE ERROR-STATUS:GET-MESSAGE(1)
      	 VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      tcode:CURSOR-OFFSET IN FRAME trigcode =
        INTEGER(COMPILER:FILE-OFFSET).
      APPLY "ENTRY" TO tcode IN FRAME trigcode.
      RETURN NO-APPLY.
   END.
   ELSE DO:
      RCODE-INFO:FILENAME = tmpfile.
      p_crc = RCODE-INFO:CRC-VALUE.
      MESSAGE "Compiled successfully.".
   END.

   /* Save the file */
   saved = tcode:SAVE-FILE(fname) IN FRAME trigcode.
   IF NOT saved THEN
   DO:
      message "Unable to save trigger code in file."
	       view-as alert-box error buttons ok.
      RETURN NO-APPLY.
   END.
END.

/*----- VALUE-CHANGED of CHECK SYNTAX TOGGLE -----*/
ON VALUE-CHANGED OF p_check IN FRAME trigcode
DO:
   IF p_synfixed THEN
      IF SELF:SCREEN-VALUE = "yes" THEN  /* it was "no" before this trigger */
      DO:
      	 /* explain why compiling is a no-no and reset toggle to no */
      	 { prodict/user/usertrgw.i &widg = SELF }
      END.
      ELSE DO:
      	 MESSAGE "Since you chose to do CRC checking," SKIP
      	       	 "this requires that the trigger code" SKIP
               	 "be compiled before it is saved."
                 view-as ALERT-BOX INFORMATION buttons OK.

      	 SELF:SCREEN-VALUE = "yes".  /* reset to yes */
      END.
END.  


/*=========================Mainline code=================================*/

IF p_pgm = "" OR p_pgm = ? THEN DO:
  HIDE MESSAGE NO-PAUSE.
  MESSAGE "Please enter the filename of a trigger procedure to edit." SKIP
      	  "It will be created if it doesn't exist yet."
      	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

/* Adjust position of ok and cancel buttons */
{adecomm/okrun.i
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME trigcode"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}

/* Look for this procedure and load it if it's out there. If it's a 
   new file, preset the edit widget for this type of trigger. It will
   be saved in the current directory.
*/
fname = SEARCH(p_pgm).
IF fname = ? THEN fname = p_pgm.
IF tcode:read-file(fname) IN FRAME trigcode = no THEN 
  tcode:screen-value IN FRAME trigcode = 
      "TRIGGER PROCEDURE FOR " + p_Event + " OF " + p_tname + 
    	 (if p_fname <> "" then "." + p_fname else "") + ".".

/* Save in underlying variable for later comparison. */
ASSIGN
/*  tcode = tcode:screen-value IN FRAME trigcode */ /* I don't see where this     */
   tcode:PFCOLOR IN FRAME trigcode = 0.             /* is either used or needed;  */
                                                    /* Removing because it causes */
                                                    /* erc 444 with large files.  */
                                                    /* (tsn 4/96)                 */
DISPLAY p_check WITH FRAME trigcode.

do ON ERROR UNDO,LEAVE  ON ENDKEY UNDO,LEAVE:
  PROMPT-FOR tcode p_check btn_OK btn_Cancel WITH FRAME trigcode.
end.

HIDE FRAME trigcode.




/***********************************************************************
* Copyright (C) 2000-2011 by Progress Software Corporation.            *
* All rights reserved.  Prior versions of this work may contain        *
* portions contributed by participants of Possenet.                    *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 

History: 07/09/98 D. McMann Added AND _File._Owner = "PUB" to FIND _File
         10/23/02 D. McMann Changed BLANK to PASSWORD-FIELD
         09/22/09 fernando  Reset other can-fields when unsetting sec admin
         04/18/11 Rajinder  OE00208533  fixed error if domain name is empty.

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/

DEFINE VARIABLE qbf AS CHARACTER EXTENT 12 NO-UNDO INITIAL [
  "Next",   "Prev",      "First",    "Last",   "Add",  "Modify",
  "Delete", "CallAdmin", "Security", "Report", "Undo", "Exit"
].
FORM
  qbf[ 1] /*Next*/      FORMAT "x(4)" HELP "Look at the next user."
  qbf[ 2] /*Prev*/      FORMAT "x(4)" HELP "Look at the previous user."
  qbf[ 3] /*First*/     FORMAT "x(5)" HELP "Look at the first user."
  qbf[ 4] /*Last*/      FORMAT "x(4)" HELP "Look at the last user."
  qbf[ 5] /*Add*/       FORMAT "x(3)" HELP "Add a new user."
  qbf[ 6] /*Modify*/    FORMAT "x(6)"
    HELP "Change this user's name and/or password."
  qbf[ 7] /*Delete*/    FORMAT "x(6)" HELP "Delete the displayed user."
  qbf[ 8] /*CallAdmin*/ FORMAT "x(9)"
    HELP "Call to the Security Administrator program."
  qbf[ 9] /*Security*/  FORMAT "x(8)"
    HELP "Go to the Change Data Security program."
  qbf[10] /*Report*/    FORMAT "x(6)"
    HELP "List the current users."
  SKIP 
  qbf[11] /*Undo*/      FORMAT "x(4)"
    HELP "Undo this session's changes to the user list."
  qbf[12] /*Exit*/      FORMAT "x(4)"
    HELP "Exit User Editor, save changes, and return to menu."
  WITH FRAME qbf ATTR-SPACE NO-BOX NO-LABELS OVERLAY
  ROW SCREEN-LINES - 5 COLUMN 3 CENTERED.
/*       "Revoke:Revoke access privileges to tables.", */
/*       "Grant:Grant access privileges to tables.", */

 

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 21 NO-UNDO INITIAL [
  /*  1*/ "This function only works on {&PRO_DISPLAY_NAME} databases.",
  /*  2*/ "You may not use this function with a blank userid.",
  /*  3*/ "You must be a Security Administrator to execute this function.",
  /*  4*/ "You may delete the current User only if it is the only User left.",
  /*  5*/ "Are you sure that you want to remove this user?",
  /*  6*/ "Undo all changes since selection of User Editor from menu?",
  /*7,8*/ "The user named", "has no password assigned.",
  /*  9*/ "You have reached the last user in the table.",
  /* 10*/ "You have reached the first user in the table.",
  /* 11*/ "You did not type the same password each time.",
  /* 12*/ "No User record was created.",
  /* 13*/ ?, /* see below */
  /* 14*/ "The dictionary is in read-only mode - alterations not allowed.",
  /* 15*/ "There are no users in the _User table.",
  /* 16*/ "You haven't yet made changes that need to be undone!",
      	  /* 17 - 20 used together */
  /* 17*/ "You have removed all security administrators, leaving none of",
  /* 18*/ "the remaining users with security administrator privileges.",
  /* 19*/ "There must be at least one user with security administrator",
  /* 20*/ "privileges.",
  /* 21 */ " Invalid domain name entered."
].
new_lang[13] = "You are about to end the transaction in which you have "
             + "deleted the last User record.!When you do this, you force "
             + "all users to have security administrator privileges. ! "
             + "Do you want to do this?!"
             + "(If not, undo changes or add back a security administrator)".
 
define variable fi-domain-name as character 
                view-as fill-in 
                size 40 by 1  /* fit with button */
                format "x(255)" /*"x(64)" in db */  
                no-undo 
                label "Domain Name".
                
define button btnDomain label "Select Domain...".
define variable  hasPassword as logical no-undo.
 

/*
FORM " " SKIP
  WITH FRAME usr_box OVERLAY
  ROW 2 COLUMN 2 SCREEN-LINES - 6 DOWN NO-LABELS NO-ATTR-SPACE WIDTH 78
  USE-TEXT.
*/
FORM
  _User._Userid      LABEL "User ID"
  _User._Domain-name LABEL "Domain Name"  VIEW-AS FILL-IN SIZE 25 BY 1
  _User._User-Name   VIEW-AS FILL-IN SIZE 15 BY 1   LABEL "User Name"
  _User._sql-only      LABEL "SQL Only" 
  hasPassword label "Password"
  WITH FRAME usr_lst   
  OVERLAY ROW 3 COLUMN 2 NO-LABELS ATTR-SPACE SCREEN-LINES - 12 DOWN SCROLL 1 /*WIDTH 76*/ .

/* avoid warning in gui compile */
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    &scoped-define col 13
&ELSE
    &scoped-define col 20
&ENDIF
 
FORM
  _User._Userid  colon {&col}   label "User ID"
/*
    VALIDATE(NOT CAN-FIND(_User USING _User._Userid),
    "User IDs must be unique within each database.")
*/
 
  fi-domain-name colon {&col} label "Domain Name"  
  btndomain
  _User._User-Name   colon {&col} label "User Name"
             view-as fill-in size 40 by 1 
  _User._Password    colon {&col} label "Password" password-field
  _User._sql-only    colon {&col} label "SQL Only" 
  WITH FRAME usr_edit  view-as dialog-box
  OVERLAY ROW 4 centered side-LABELS ATTR-SPACE.

/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

DEFINE VARIABLE answer     AS LOGICAL               NO-UNDO.
DEFINE VARIABLE i          AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE in_trans   AS LOGICAL INITIAL FALSE NO-UNDO.
DEFINE VARIABLE j          AS INTEGER               NO-UNDO.
DEFINE VARIABLE passwd     AS CHARACTER             NO-UNDO.
DEFINE VARIABLE qbf#       AS INTEGER INITIAL 1     NO-UNDO.
DEFINE VARIABLE qbf_disp   AS RECID   INITIAL ?     NO-UNDO.
DEFINE VARIABLE qbf_home   AS RECID                 NO-UNDO.
DEFINE VARIABLE qbf_rec    AS RECID                 NO-UNDO.
DEFINE VARIABLE qbf_was    AS INTEGER INITIAL 2     NO-UNDO.
DEFINE VARIABLE redraw     AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE user-cnt-i AS INTEGER INITIAL 0     NO-UNDO.
DEFINE VARIABLE user-cnt-o AS INTEGER               NO-UNDO.
DEFINE VARIABLE istrans AS LOGICAL INITIAL TRUE. /*UNDO (not no-undo!) */

/** Functions ***********************************/
function FullUserId returns char(id as char, name as char):
    if name = "" then 
        return id.
    else 
        return id + "@" + name.           
end.   
   
function GetDomainList returns char (pType as char,pdelimiter as char):
    define variable domainList as character no-undo. 
    run prodict/pro/_pro_domain_list.p(pType,pdelimiter,output domainList). 
    return domainlist.
end.   

/*** triggers  ***********************************/

/*----- HIT OF tenant BUTTON -----*/
ON CHOOSE OF btnDomain IN FRAME usr_edit 
do: 
     
    run selectDomain(fi-domain-name:handle in frame usr_edit).
    
end.

/*** main  ***********************************/

DO ON ERROR UNDO:
  istrans = FALSE.
  UNDO,LEAVE.
END.
 

RUN "prodict/_dctadmn.p" (INPUT USERID(user_dbname),OUTPUT answer).
IF istrans OR PROGRESS = "Run-Time"
  OR CAN-DO("READ-ONLY",DBRESTRICTIONS(user_dbname)) THEN i = 14. /* r/o mode */
IF NOT answer                THEN i = 3. /* secu admin? */
 
IF USERID(user_dbname) = "" THEN
DO:
    if integer(dbversion("DICTDB":U)) > 10 then
    do: 
        if CAN-FIND(FIRST _User where _user._sql-only-user = false) THEN 
            i = 2. /* userid set? */
    end.
    else do: 
        if CAN-FIND(FIRST _User) then
            i = 2. /* userid set? */
    end.
END.

IF user_dbtype <> "PROGRESS" THEN i = 1. /* dbtype okay */
 
/* user-cnt-i: 0=none, 1=one, 2=many - that's all we need to know */     
if integer(dbversion("DICTDB":U)) > 10 then 
do:
    FOR EACH _User where _User._sql-only-user = false WHILE user-cnt-i < 2:
      user-cnt-i = user-cnt-i + 1.
    END.
               
end.
else do:
    FOR EACH _User WHILE user-cnt-i < 2:
      user-cnt-i = user-cnt-i + 1.
    END.
end.    

IF i <> 0 THEN DO:
  MESSAGE new_lang[i] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

PAUSE 0.
/*VIEW FRAME usr_box.*/

qbf_block:
DO FOR _User TRANSACTION ON ERROR UNDO,RETRY:

  FIND FIRST _User NO-ERROR.
   
  
  PAUSE 0.
  VIEW FRAME usr_lst.
   
  qbf_inner:
  DO WHILE TRUE WITH FRAME usr_lst:
    qbf_rec = RECID(_User).

    IF redraw THEN DO:
      DISPLAY qbf WITH FRAME qbf.
      FIND FIRST _User NO-ERROR.
      ASSIGN
        qbf_disp = ?
        qbf_home = RECID(_User)
        redraw   = FALSE.
      IF qbf_rec <> ? THEN
        FIND _User WHERE RECID(_User) = qbf_rec NO-ERROR.
      ASSIGN
        qbf_rec = RECID(_User)
        j       = (IF FRAME-LINE = 0 THEN 1 ELSE FRAME-LINE)
        i       = 3.
      UP j - 1.
      IF j > 1 THEN DO i = 2 TO j WHILE AVAILABLE _User:
        FIND PREV _User NO-ERROR.
      END.
      IF NOT AVAILABLE _User THEN DO:
        FIND FIRST _User NO-ERROR.
        j = i - 2.
      END.
      DO i = 1 TO FRAME-DOWN:
          /*
        IF INPUT _User-name = (IF AVAILABLE _User THEN _User-name ELSE "")
          AND INPUT _Userid = (IF AVAILABLE _User THEN _Userid ELSE "") THEN .
        ELSE*/
         IF AVAILABLE _User THEN
          DISPLAY _Userid _Domain-name _User-name _sql-only 
          
/*          _User._Password <> ENCODE("") @ hasPassword*/
          
          .
        ELSE
          CLEAR NO-PAUSE.
        COLOR DISPLAY VALUE(IF RECID(_User) = qbf_rec AND RECID(_User) <> ?
          THEN "MESSAGES" ELSE "NORMAL") _Userid _Domain-name _User-name _sql-only hasPassword.
        DOWN.
        FIND NEXT _User NO-ERROR.
      END.
      IF qbf_rec <> ? THEN
        FIND _User WHERE RECID(_User) = qbf_rec NO-ERROR.
      UP FRAME-DOWN - j + 1.
    END.

    IF qbf_was <> FRAME-LINE THEN DO:
      i = FRAME-LINE.
      DOWN qbf_was - i.
      COLOR DISPLAY NORMAL _Userid _Domain-name _User-name _sql-only hasPassword.
      DOWN i - qbf_was.
      IF qbf_rec <> ? THEN COLOR DISPLAY MESSAGES _Userid _Domain-name _User-name _sql-only hasPassword.
      qbf_was = FRAME-LINE.
    END.

    IF AVAILABLE _User AND qbf_disp <> RECID(_User) THEN
      DISPLAY _Userid _Domain-name _User-name _sql-only
/*       _User._Password <> ENCODE("") @ hasPassword*/
        .
    qbf_disp = RECID(_User).

    ON CURSOR-LEFT BACK-TAB.
    ON CURSOR-RIGHT     TAB.
    _choose: DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF qbf# > 12 THEN qbf# = qbf# - 12.
      IF qbf# >= 1 AND qbf# <= 12 THEN NEXT-PROMPT qbf[qbf#] WITH FRAME qbf.
      CHOOSE FIELD qbf NO-ERROR AUTO-RETURN GO-ON ("CURSOR-UP" "CURSOR-DOWN")
        WITH FRAME qbf.
      qbf# = FRAME-INDEX.
      IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND CHR(LASTKEY) <> "."
        AND NOT qbf[qbf#] BEGINS CHR(LASTKEY) THEN UNDO,RETRY _choose.
    END.
    ON CURSOR-LEFT  CURSOR-LEFT.
    ON CURSOR-RIGHT CURSOR-RIGHT.
    i = LOOKUP(KEYFUNCTION(LASTKEY),
        "CURSOR-DOWN,CURSOR-UP,,END,,,,,,,,END-ERROR,PAGE-DOWN,PAGE-UP").
    IF i > 0 THEN qbf# = i.
    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN
      qbf# = (IF qbf_rec = qbf_home THEN 4 ELSE 3).

    HIDE MESSAGE NO-PAUSE.
    redraw = qbf# > 2.

    IF qbf# = 1 THEN DO: /*---------------------------------- start of NEXT */
      FIND NEXT _User NO-ERROR.
      IF NOT AVAILABLE _User THEN DO:
        FIND LAST _User NO-ERROR.
        MESSAGE new_lang[IF AVAILABLE _User THEN 9 ELSE 15].
      END.
      ELSE DO:
        IF FRAME-LINE = FRAME-DOWN THEN qbf_was = qbf_was - 1.
        IF FRAME-LINE = FRAME-DOWN THEN
          SCROLL UP.
        ELSE
          DOWN.
      END.
    END. /*---------------------------------------------------- end of NEXT */
    ELSE
    IF qbf# = 2 THEN DO: /*---------------------------------- start of PREV */
      FIND PREV _User NO-ERROR.
      IF NOT AVAILABLE _User THEN DO:
        FIND FIRST _User NO-ERROR.
        MESSAGE new_lang[IF AVAILABLE _User THEN 10 ELSE 15].
      END.
      ELSE DO:
        IF FRAME-LINE = 1 THEN qbf_was = qbf_was + 1.
        IF FRAME-LINE = 1 THEN
          SCROLL DOWN.
        ELSE
          UP.
      END.
    END. /*---------------------------------------------------- end of PREV */
    ELSE
    IF qbf# = 3 THEN DO: /*--------------------------------- start of FIRST */
      FIND FIRST _User NO-ERROR.
      UP FRAME-LINE - 1.
      MESSAGE new_lang[IF AVAILABLE _User THEN 10 ELSE 15].
    END. /*--------------------------------------------------- end of FIRST */
    ELSE
    IF qbf# = 4 THEN DO: /*---------------------------------- start of LAST */
      FIND LAST _User NO-ERROR.
      DOWN FRAME-DOWN - FRAME-LINE.
      MESSAGE new_lang[IF AVAILABLE _User THEN 9 ELSE 15].
    END. /*---------------------------------------------------- end of LAST */
    ELSE
    IF qbf# = 5 THEN 
    _qbf5: 
    DO ON ERROR UNDO,LEAVE: /*-------- start of ADD */
      FRAME usr_edit:title = "Add User".
      /* Workaround bug inner-lines is included in size.
         View the frame with inner-lines 1 before call to initModFrame, 
         which increases the inner-lines again.  */      
      do with frame usr_edit:
          
          VIEW FRAME usr_edit.
          
          DISPLAY "" @ _Userid "" @ fi-domain-name "" @ _User-name "" @ _Password NO @ _sql-only.
          DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE :
            PROMPT-FOR 
                _Userid 
                fi-domain-name 
                btndomain 
                _User-name 
                _Password 
                _sql-only.
          END.
          passwd = ENCODE(INPUT _Password).
          IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN LEAVE _qbf5.
          IF fi-domain-name:screen-value <> "" then
          DO:
              IF NOT can-find(FIRST DICTDB._sec-authentication-domain 
                               WHERE DICTDB._sec-authentication-domain._Domain-name = fi-domain-name:screen-value) then
              DO:
                  MESSAGE new_lang[21]
                  VIEW-AS ALERT-BOX.
                  RETURN NO-APPLY.
              END.                     
          END.
          IF INPUT _Password <> "" THEN DO:
            RUN "prodict/user/_usrpwd2.p" (INPUT passwd, OUTPUT answer).
            IF answer = NO THEN DO:
              MESSAGE new_lang[11] SKIP /* didn't type same passwd each time */
                   	  new_lang[12] 	    /* no user record created */
          	       	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            END.
            IF answer <> YES THEN LEAVE _qbf5.
          END.
          CREATE _User.
          ASSIGN
            _Userid    = INPUT FRAME usr_edit _Userid
            _User-name = INPUT FRAME usr_edit _User-name
            _Password  = passwd
            _Domain-name = FRAME usr_edit fi-domain-name
            _sql-only = INPUT FRAME usr_edit _sql-only.
          IF INPUT _Password = "" THEN /* note: user xxx has no passwd */
            MESSAGE new_lang[7] + " ~"" + _Userid + "~" " + new_lang[8].
      end. /* do with frame usr_edit */
      qbf_was = (IF FRAME-LINE = 1 THEN FRAME-DOWN ELSE FRAME-LINE - 1).
      DOWN FRAME-DOWN - FRAME-LINE .
      in_trans = TRUE.
   
    END. /*----------------------------------------------------- end of ADD */
    ELSE
    IF qbf# = 6 AND qbf_rec <> ? THEN /*------------------- start of MODIFY */
    DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE WITH FRAME usr_edit:
      FRAME usr_edit:title = "Modify User".
      
      btnDomain:hidden = yes.
      DISPLAY _Userid 
              _Domain-name @ fi-domain-name
              _User-name
              _sql-only.
      PROMPT-FOR  
                 fi-domain-name
                 btndomain 
                 _User-name 
/*                _Password*/
                _sql-only.
      ASSIGN
        in_trans   = in_trans OR _User-name ENTERED
        _User-name = INPUT FRAME usr_edit _User-name 
        _Domain-name = INPUT FRAME usr_edit fi-domain-name
        _sql-only = INPUT FRAME usr_edit _sql-only.
         
    END. /*-------------------------------------------------- end of MODIFY */
    ELSE
    IF qbf# = 7 AND qbf_rec <> ? THEN DO: /*--------------- start of DELETE */
      IF FullUserId(_Userid,_Domain-name) = USERID(user_dbname) THEN DO:
        FIND FIRST _User WHERE _Userid <> USERID(user_dbname) NO-ERROR.
        IF AVAILABLE _User THEN DO:
          MESSAGE new_lang[4]. /* can only delete self if last user */
      	 
      	  FIND _User WHERE _User._UserId = USERID(user_dbname). /* refind */
      	  
          NEXT.
        END.
        FIND _User WHERE RECID(_User) = qbf_rec.
      END.
      DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        answer = FALSE. /* are you sure... delete? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[5]).
        IF answer THEN DO:
          DELETE _User.
          in_trans = in_trans OR answer.
        END.
      END.
    END. /*-------------------------------------------------- end of DELETE */
    ELSE
    IF qbf# = 8 THEN DO: /*---------------------------- start of CALL-ADMIN */
      user_path = "_usradmn,_usruchg".
      LEAVE qbf_inner.
    END. /*---------------------------------------------- end of CALL-ADMIN */
    ELSE
    IF qbf# = 9 THEN DO: /*------------------------------ start of SECURITY */
      user_path = "1=o,_usrtget,9=rw,_usrsecu".
      LEAVE qbf_inner.
    END. /*------------------------------------------------ end of SECURITY */
    ELSE
    IF qbf# = 10 THEN DO: /*------------------------------- start of REPORT */
      user_path = "_rptuqik,_usruchg".
      LEAVE qbf_inner.
    END. /*-------------------------------------------------- end of REPORT */
    ELSE
    IF qbf# = 11 THEN DO: /*--------------------------------- start of UNDO */
      IF in_trans THEN DO:
        answer = FALSE. /* undo session? */
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[6]).
        IF answer THEN DO:
          in_trans = FALSE.
          UNDO qbf_block,RETRY qbf_block.
        END.
      END.
      ELSE
        MESSAGE new_lang[16]. /* what changes? */
    END. /*---------------------------------------------------- end of UNDO */
    ELSE
    IF qbf# = 12 THEN _qbf12: DO: /*------------------------- start of EXIT */
      /* user-cnt-o: 0=none, 1=one, 2=many - that's all we need to know */
      user-cnt-o  = 0.
      
      if integer(dbversion("DICTDB":U)) > 10 then 
      do:      
          FOR EACH _User where _User._sql-only-user = false WHILE user-cnt-o < 2:
            user-cnt-o = user-cnt-o + 1.
          END.
      end.
      else do:
          FOR EACH _User WHILE user-cnt-o < 2:
            user-cnt-o = user-cnt-o + 1.
          END.
      end.
      
      IF user-cnt-i = 0 AND user-cnt-o = 0 THEN .   /* don't care */
      ELSE
      IF user-cnt-o > 0 THEN DO: /* chgd or added _User: kill last sec adm? */
        answer = FALSE.
        
        if integer(dbversion("DICTDB":U)) > 10 then 
        do:
            FOR EACH _User where _User._sql-only-user = false WHILE NOT answer:
              RUN "prodict/_dctadmn.p"  /* determines if user is sec administrator */
                  (FullUserId(_User._Userid,_User._Domain-Name), OUTPUT answer).  
            END.
        end.
        else do:
            FOR EACH _User WHILE NOT answer:
              RUN "prodict/_dctadmn.p"  /* determines if user is sec administrator */
                  (FullUserId(_User._Userid,_User._Domain-Name), OUTPUT answer).  
            END.  
        end.
        
        IF NOT answer THEN DO:
      	  MESSAGE new_lang[17] SKIP
      	       	  new_lang[18] SKIP
      	       	  new_lang[19] SKIP
      	       	  new_lang[20]
      	       	  VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          LEAVE _qbf12.
        END.
      END.
      ELSE /* last non sql _User deleted */
      IF user-cnt-i > 0 AND user-cnt-o = 0 THEN DO: 
        answer = FALSE.
        RUN "prodict/user/_usrdbox.p"
          (INPUT-OUTPUT answer,?,?,new_lang[13]).
        IF NOT answer THEN LEAVE _qbf12.

        /* set the security administrator fields back to "*" */
        FIND _File "_File" WHERE _File._Db-recid = drec_db
                             AND _File._Owner = "PUB".
        FIND _Field "_Can-read"   OF _File.
        _Field._Can-write = "*".
        FIND _Field "_Can-write"  OF _File.
        _Field._Can-write = "*".
        FIND _Field "_Can-create" OF _File.
        _Field._Can-write = "*".
        FIND _Field "_Can-delete" OF _File.
        _Field._Can-write = "*".

        FIND _File "_Field" WHERE _File._Db-recid = drec_db
                              AND _File._Owner = "PUB" .
        FIND _Field "_Can-read"   OF _File.
        _Field._Can-write = "*".
        FIND _Field "_Can-write"  OF _File.
        _Field._Can-write = "*".

        FIND _File "_User" WHERE _File._Db-recid = drec_db
                             AND _File._Owner = "PUB".
        ASSIGN
          _File._Can-create = "*"
          _File._Can-delete = "*".

        FIND _File "_Db-Option" NO-ERROR.
        IF AVAILABLE _File THEN
            ASSIGN _File._Can-create = "*" 
                   _File._Can-write = "*"
                   _File._Can-delete = "*".

        FIND _File "_Db-Detail" NO-ERROR.
        IF AVAILABLE _File THEN
            ASSIGN _File._Can-create = "*" 
                   _File._Can-write = "*"
                   _File._Can-delete = "*".

        FIND _File "_Db".
        FIND _Field "_Db-guid" OF _File NO-ERROR.
        IF AVAILABLE _Field THEN
            ASSIGN _Field._Can-write = "*".

      END.

      LEAVE qbf_inner.
    END. /*---------------------------------------------------- end of EXIT */
    ELSE
    IF qbf_rec <> ? AND qbf# = 13 THEN DO: /*----------- start of NEXT-PAGE */
      DO i = 1 TO FRAME-DOWN WHILE AVAILABLE _User:
        FIND NEXT _User NO-ERROR.
      END.
      IF NOT AVAILABLE _User THEN DO:
        DOWN FRAME-DOWN - FRAME-LINE.
        FIND LAST _User NO-ERROR.
      END.
    END. /*----------------------------------------------- end of NEXT-PAGE */
    ELSE
    IF qbf_rec <> ? AND qbf# = 14 THEN DO: /*----------- start of PREV-PAGE */
      DO i = 1 TO FRAME-DOWN WHILE AVAILABLE _User:
        FIND PREV _User NO-ERROR.
      END.
      IF NOT AVAILABLE _User THEN DO:
        FIND FIRST _User NO-ERROR.
        UP FRAME-LINE - 1.
      END.
    END. /*----------------------------------------------- end of PREV-PAGE */

  END. /* iterating block */

END. /* scoping block */


HIDE FRAME qbf     NO-PAUSE.
/*HIDE FRAME usr_box NO-PAUSE.*/
HIDE FRAME usr_lst NO-PAUSE.
RETURN.

/**** prcedures  ******************************************************/
/*
Procedure initModFrame: 
    /* "fillin" "combo" or "browse" */
    define input  parameter pMode as character no-undo.
    define variable hlabel as handle no-undo.
 
    do with frame usr_edit:
       display cdomainlabel. 
       fi-domain-name:hidden = pmode = "combo" .
              
       /* tty */
/*       fi-domain-name:side-label-handle:hidden = pmode = "combo" .*/
       
       btnDomain:hidden = pmode <> "browse".
       			  
       cmb-domain-name:hidden = pmode <> "combo".
/*       cmb-domain-name:side-label-handle:hidden = pmode <> "combo".*/
       
     /*  if pmode = "combo" then 
       do: 
           if cmb-domain-name:list-items = ? then
               cmb-domain-name:list-items = getDomainList("_oeusertable",cmb-domain-name:delimiter).     
           cmb-domain-name:inner-lines = min(9,num-entries(cmb-domain-name:list-items)).
       end.  */ 
   end.  
   catch e as Progress.Lang.Error :
   		message e:GetMessage(1).
   end catch.
end procedure.   
*/
Procedure selectDomain :
    define input  parameter hField as handle no-undo.
    define variable domaindlg as prodict.pro._domain-sel-presenter no-undo.
    domaindlg = new  prodict.pro._domain-sel-presenter ().
    do with frame usr_edit:
      
       domaindlg:Row = hField:row + hField:height +  hField:frame:row  .
        
       domaindlg:QueryString = "for each ttdomain where ttdomain.DomainTypeName = " + quoter("_oeusertable") .
   
       domaindlg:Title = "Select Authentication System Domain".
/*    glInSelect = true. /* stop end-error anywhere trigger */*/
       if domaindlg:Wait() then 
           hField:screen-value = domaindlg:ColumnValue("ttdomain.Name").
/*    glInSelect = false.*/
   end.
end.   
/***********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11
   History:  D. McMann 10/23/02 Changed BLANK to PASSWORD-FIELD
 
 */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }


/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 10 NO-UNDO INITIAL [
  /*  1*/ "This function only works on {&PRO_DISPLAY_NAME} databases.",
  /*  2*/ "You may not use this function with a blank userid.",
  /*  3*/ "You must be a Security Administrator to execute this function.",
  /*  4*/ "Your userid does not exist in the User table.",
  /*  5*/ "You did not type the same password each time.",
  /*  6*/ "Your password has not been changed.",
  /*7,8*/ "The user named", "now has no password assigned.",
  /*  9*/ "Your new password has been set.",
  /* 10*/ "The dictionary is in read-only mode - alterations not allowed."
].
/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

DEFINE VARIABLE answer      AS LOGICAL     NO-UNDO.
DEFINE VARIABLE canned      AS LOGICAL     NO-UNDO INITIAL TRUE.
DEFINE VARIABLE msg-num     AS INTEGER     NO-UNDO INITIAL 0.
DEFINE VARIABLE new-pwd_enc AS CHARACTER   NO-UNDO.
DEFINE VARIABLE new-pwd     AS CHARACTER   NO-UNDO.

FORM
  SKIP({&TFM_WID})
  DICTDB._User._Password {&STDPH_FILL} PASSWORD-FIELD      AT 2 LABEL "New Password"
  "(case-sensitive)"
  {prodict/user/userbtns.i}
  WITH FRAME usr_please 
    CENTERED SIDE-LABELS ATTR-SPACE 
    DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
    VIEW-AS DIALOG-BOX TITLE "Change Password".


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame usr_please
   or CHOOSE of btn_Help in frame usr_please
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Change_Your_Password_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF

ON WINDOW-CLOSE OF FRAME usr_please
   APPLY "END-ERROR" TO FRAME usr_please.


/*==========================Mainline Code================================*/

/*RUN prodict/_dctadmn.p (INPUT USERID(user_dbname),OUTPUT answer).*/
IF dict_rog                  THEN msg-num = 10. /* r/o mode   */
IF NOT CAN-FIND(DICTDB._User WHERE DICTDB._User._Userid = USERID(user_dbname))
                             THEN msg-num = 4. /* not in user */
/*IF NOT answer              THEN msg-num = 3. /* secu admin? */*/
IF USERID(user_dbname) = ""  THEN msg-num = 2. /* userid set? */
IF user_dbtype <> "PROGRESS" THEN msg-num = 1. /* dbtype okay */

IF msg-num <> 0 THEN DO:
  MESSAGE new_lang[msg-num] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME usr_please" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}
PAUSE 0.
VIEW FRAME usr_please.
DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  PROMPT-FOR _Password btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME usr_please.

  new-pwd = INPUT FRAME usr_please _Password.
  new-pwd_enc = ENCODE(new-pwd).
  canned = FALSE.
END.
HIDE FRAME usr_please NO-PAUSE.

IF canned THEN RETURN.

/* Verify the password by having user retype it */
IF new-pwd_enc <> ENCODE("") THEN DO:
  RUN "prodict/user/_usrpwd2.p" (INPUT new-pwd_enc, OUTPUT answer).
  if answer = NO THEN DO:
    MESSAGE new_lang[5] SKIP /* didn't type same passwd each time */
	    new_lang[6]      /* password not changed */
	    VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
  END.
  ELSE IF answer = ? THEN RETURN.  /* user cancelled out */
END.

FIND DICTDB._User WHERE DICTDB._User._Userid = USERID(user_dbname).
DO ON ERROR UNDO, LEAVE:
  DICTDB._User._Password = new-pwd_enc.
  
  IF new-pwd = "" THEN /* note: user xxx has no passwd */
    MESSAGE new_lang[7] + " ~"" + _Userid + "~" " + new_lang[8]
	    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
  ELSE
    MESSAGE new_lang[9]	/* password was set */
	    VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
END.
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrvgen.p */

/* This program generates CREATE VIEW statements from _View records
stored in the database.  These CREATE VIEW statements can then be
run on another database to define those views. 

History:  Added _Owner to _file Finds 07/14/98 D. McMann
          Added support for long path names 04/13/00 D. McMann

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer        AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE canned  AS LOGICAL INITIAL TRUE  NO-UNDO.
DEFINE VARIABLE fo   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE fn   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE ft   AS CHARACTER INITIAL "."  NO-UNDO.
DEFINE VARIABLE allusers AS LOGICAL  INITIAL true NO-UNDO.
DEFINE VARIABLE usrnm   AS CHARACTER              NO-UNDO.
DEFINE VARIABLE uidtag  AS CHARACTER                  NO-UNDO.
DEFINE VARIABLE allviews AS LOGICAL            NO-UNDO.
{prodict/misc/filesbtn.i}

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 7 NO-UNDO INITIAL [
  /* 1*/ "Could not find a user in the connected database with this userid.",
  /* 2*/ "A file named",
  /* 3*/ "already exists.",
  /* 4*/ "Overwrite it?",
  /* 5*/ "All Views",
  /* 6*/ "You do not have permission to use this option.",
  /* 7*/ "(Enter a Userid or ~"ALL~")"
].
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
&GLOBAL-DEFINE FILLCH 40
&GLOBAL-DEFINE LINEUP 23
FORM 
  SKIP({&TFM_WID})
  "Output File:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2
         VIEW-AS FILL-IN SIZE {&FILLCH} BY 1
  btn_File SKIP ({&VM_WIDG})
  "Statement Termination Character:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  ft AT 2 VIEW-AS RADIO-SET HORIZONTAL
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN  
        RADIO-BUTTONS "~" . ~"", ".", "~" ; ~"", ";"
&ELSE
        RADIO-BUTTONS "~".~"", ".", "~";~"", ";"
&ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME createview
  NO-LABELS ATTR-SPACE ROW 3 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX
  TITLE " Dump CREATE VIEW of ~"" + fn + "~" ".

FORM
  SKIP({&TFM_WID})
  "Output File:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2
         VIEW-AS FILL-IN SIZE {&FILLCH} BY 1
  btn_File SKIP ({&VM_WIDG})
  "Which Users:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  allusers AT 2 VIEW-AS RADIO-SET HORIZONTAL 
        RADIO-BUTTONS "All Users",yes,"Single User",no
  usrnm {&STDPH_FILL} SKIP ({&VM_WIDG})
  "Statement Termination Character:" AT 2 VIEW-AS TEXT SKIP({&VM_WID})
  ft AT 2 VIEW-AS RADIO-SET HORIZONTAL
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN  
        RADIO-BUTTONS "~" . ~"", ".", "~" ; ~"", ";"
&ELSE
        RADIO-BUTTONS "~".~"", ".", "~";~"", ";"
&ENDIF
  {prodict/user/userbtns.i}
  WITH FRAME createallviews
  NO-LABELS ATTR-SPACE ROW 3 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX
  TITLE " Dump CREATE VIEW of All Views".
&ELSE
FORM
  SKIP({&TFM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" LABEL "Output File"
        COLON 23 VIEW-AS FILL-IN SIZE 40 BY 1
  btn_File SKIP ({&VM_WIDG})
  ft LABEL " Statement Termination"  FORMAT "x"  COLON 23 SPACE(1)
    "(~".~" or ~"~;~")"                                   SKIP({&VM_WIDG})
  " This program generates a SQL DDL program containing CREATE VIEW statements" 
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " equivalent to those originally used to define the view.  The generated"
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " program makes the assumption that all necessary permissions are available"
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " It does NOT generate any GRANT or REVOKE statements to set permissions"
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " on the views."                           VIEW-AS TEXT     
  {prodict/user/userbtns.i}
  WITH FRAME createview
  SIDE-LABELS ATTR-SPACE ROW 3 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX
  TITLE " Dump CREATE VIEW of ~"" + fn + "~" ".
FORM
  SKIP({&TFM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" LABEL "Output File"
        COLON 23 VIEW-AS FILL-IN SIZE 40 BY 1
  btn_File SKIP ({&VM_WIDG})
  ft LABEL "Statement Termination"  FORMAT "x"  COLON 23 SPACE(1)
    "(~".~" or ~"~;~")"                                   SKIP({&VM_WIDG})
  usrnm LABEL "Which User"                            COLON 23 SPACE(1)
  uidtag FORMAT "x(25)" NO-LABEL                                    SKIP({&VM_WIDG})
  " This program generates a SQL DDL program containing CREATE VIEW statements" 
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " equivalent to those originally used to define the view.  The generated"
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " program makes the assumption that all necessary permissions are available"
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " It does NOT generate any GRANT or REVOKE statements to set permissions"
                                                                                     VIEW-AS TEXT      SKIP(0.1)
  " on the views."                           VIEW-AS TEXT     
  {prodict/user/userbtns.i}

  WITH FRAME createallviews
  SIDE-LABELS ATTR-SPACE ROW 3 CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX
  TITLE " Dump CREATE VIEW of All Views".
&ENDIF
/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/


/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame createview
   or CHOOSE of btn_Help in frame createview
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Dump_Create_View_Dlg_Box},
                                               INPUT ?).
on HELP of frame createallviews
   or CHOOSE of btn_Help in frame createallviews
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
                                               INPUT {&Dump_Create_View_All_Dlg_Box},
                                               INPUT ?).
&ENDIF


ON GO OF FRAME createview
DO:
  DEFINE VAR fil AS CHAR NO-UNDO.

  fil = fo:SCREEN-VALUE IN FRAME createview.

  IF SEARCH(fil) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] fil new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fo IN FRAME createview.
      RETURN NO-APPLY.
    END.
  END.
END.

ON GO OF FRAME createallviews
DO:
  DEFINE VAR fil AS CHAR NO-UNDO.
  DEFINE VAR uid AS CHAR NO-UNDO.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
  IF allusers:SCREEN-VALUE = "yes" THEN
        uid = "ALL".
  ELSE DO:
        uid = usrnm:SCREEN-VALUE.
        usrnm = uid.
  END.
&ELSE
  uid  = usrnm:SCREEN-VALUE.
&ENDIF
  IF uid <> "ALL" AND NOT CAN-FIND(_User WHERE _User._Userid = uid) THEN DO:
    MESSAGE new_lang[1] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO usrnm IN FRAME createallviews.
    RETURN NO-APPLY.
  END.

  fil = fo:SCREEN-VALUE IN FRAME createview.

  IF SEARCH(fil) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] fil new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fo IN FRAME createview.
      RETURN NO-APPLY.
    END.
  END.
END.

ON WINDOW-CLOSE OF FRAME createview
   APPLY "END-ERROR" TO FRAME createview.

ON CHOOSE OF btn_File in frame createview DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fo:handle in frame createview /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.

ON LEAVE OF fo in frame createview
   fo:screen-value in frame createview = 
        TRIM(fo:screen-value in frame createview).
ON WINDOW-CLOSE OF FRAME createallviews
   APPLY "END-ERROR" TO FRAME createallviews.

ON CHOOSE OF btn_File in frame createallviews DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fo:handle in frame createallviews /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON LEAVE OF fo in frame createallviews
   fo:screen-value in frame createallviews = 
        TRIM(fo:screen-value in frame createallviews).

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
ON VALUE-CHANGED OF allusers IN FRAME createallviews DO:
   DEFINE VARIABLE dummyl AS LOGICAL NO-UNDO.

   IF allusers:SCREEN-VALUE = "yes" THEN DO:
        usrnm:SENSITIVE = FALSE.
        usrnm:SCREEN-VALUE = "".
   END.
   ELSE DO:
        usrnm = "".
        usrnm:SENSITIVE = TRUE.
        dummyl = usrnm:MOVE-AFTER-TAB-ITEM(allusers:HANDLE).
        APPLY "ENTRY" TO usrnm.
   END.
END.
&ENDIF

/*============================Mainline code===============================*/

DO FOR DICTDB._File:
  FIND _File "_View" WHERE _File._Owner = "PUB" NO-LOCK.
  IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN DO:
    MESSAGE new_lang[6] VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
    user_path = "".
    RETURN.
  END.
END.

FIND DICTDB._View WHERE DICTDB._View._View-name = user_env[1] NO-ERROR.
ASSIGN
  fo = (IF user_env[1] = "ALL" THEN DBNAME ELSE user_env[1]) + ".p"
  fn = (IF user_env[1] = "ALL" THEN new_lang[5] ELSE user_env[1])

allviews = IF user_env[1] = "ALL" THEN yes ELSE NO.

/* Adjust the graphical rectangle and the ok and cancel buttons */
IF allviews THEN DO:
  {adecomm/okrun.i  
     &FRAME  = "FRAME createallviews" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
  }
END.
ELSE DO:
  {adecomm/okrun.i  
     &FRAME  = "FRAME createview" 
     &BOX    = "rect_Btns"
     &OK     = "btn_OK" 
     {&CAN_BTN}
     {&HLP_BTN}
  }
END.
PAUSE 0.

IF allviews THEN
  DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN  
  UPDATE
    fo btn_File
    ft
    allusers
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    WITH FRAME createallviews.
  IF allusers THEN usrnm = "ALL".
&ELSE
uidtag = new_lang[7].
usrnm = "ALL".
DISPLAY uidtag WITH FRAME createallviews.
  UPDATE
    fo btn_File
    ft
    usrnm 
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    WITH FRAME createallviews.
&ENDIF

  ASSIGN
    user_env[2] = fo  /* output file */
    user_env[3] = usrnm  /* userid */
    user_env[4] = ft. /* statement terminator */
  
  RUN "prodict/misc/_wrkvgen.p".
  canned = FALSE.

END.
ELSE DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:

  UPDATE
    fo btn_File
    ft
    btn_OK 
    btn_Cancel
    {&HLP_BTN_NAME}
    WITH FRAME createview.

  ASSIGN
    user_env[2] = fo  /* output file */
    user_env[3] = ""  /* userid */
    user_env[4] = ft. /* statement terminator */
  
  RUN "prodict/misc/_wrkvgen.p".
  canned = FALSE.
END.

HIDE FRAME createview NO-PAUSE.
HIDE FRAME createallviews NO-PAUSE.
IF canned THEN
   user_path = "".
RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrvget.p - select views */

/*
INPUT:
user_env[1] MATCHES "*o*":
If this program sees an "o" (for "optional") in user_env[1], then it returns
immediately if a filename is currently set (other than "ALL").

user_env[1] MATCHES "*a*":
If this program sees an "a" (for "all"), then "ALL" is a valid choice.

user_env[1] MATCHES "*s*":
If this program sees an "s" (for "some"), then [Return] marks (or unmarks)
names, and the list of _View-names is returned in user_env[1] (Not for
Views!)  Otherwise, one file must be chosen.  "ALL" is also a valid
choice.

OUTPUT:
user_env[1] contains the filename selected, or 'ALL'.

History: Added _Owner to _File finds 07/14/98 D. McMann

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userpik.i NEW }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 4 NO-UNDO INITIAL [
  /*  1*/ "There are no views defined in this database.",
  /*  2*/ "You do not have permission to select views.",
  /*3,4*/ "Press the", "key to end."
].

FORM
  "  Please select a view from the following list.  " SKIP
  WITH ROW 3 CENTERED FRAME v-one.

FORM
  "  Please select a view from the  "  SKIP
  "  list or ~"ALL~" for all views.  " SKIP
  WITH ROW 3 CENTERED FRAME v-all.

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

DEFINE VARIABLE i AS INTEGER NO-UNDO.
DEFINE VARIABLE l AS LOGICAL NO-UNDO.

IF NOT CAN-FIND(FIRST DICTDB._View) THEN i = 1. /* I can't see any views */

DO FOR DICTDB._File:
  FIND _File "_View" WHERE _File._Owner = "PUB" NO-LOCK.
  l = CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_View-ref" WHERE _File._Owner = "PUB" NO-LOCK.
  l = l AND CAN-DO(_Can-read,USERID("DICTDB")).
  FIND _File "_View-col" WHERE _File._Owner = "PUB" NO-LOCK.
  l = l AND CAN-DO(_Can-read,USERID("DICTDB")).
  IF NOT l THEN i = 2. /* You're not supposed to see any views */
END.

IF i > 0 THEN DO:
  MESSAGE new_lang[i] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  ASSIGN
    user_path   = ""
    user_env[1] = "".
  RETURN.
END.

IF user_env[1] MATCHES "*a*" THEN
  VIEW FRAME v-all.
ELSE
  VIEW FRAME v-one.
ASSIGN
  l          = TRUE
  pik_column = 20
  pik_row    = (IF user_env[1] MATCHES "*a*" THEN 7 ELSE 6)
  pik_multi  = user_env[1] MATCHES "*s*"
  pik_count  = 0.
IF user_env[1] MATCHES "*a*" THEN ASSIGN
  pik_count = pik_count + 1
  pik_list[pik_count] = "ALL".
FOR EACH DICTDB._View:
  ASSIGN
    l = FALSE
    pik_count = pik_count + 1
    pik_list[pik_count] = DICTDB._View._View-name.
END.

user_status = new_lang[3] + " [" + KBLABEL("END-ERROR") + "] " + new_lang[4].
STATUS DEFAULT user_status.
RUN "prodict/user/_usrpick.p".
user_status = ?.
STATUS DEFAULT.

user_env[1] = (IF pik_first = ? THEN "" ELSE pik_first).
IF pik_return > 1 AND user_env[1] MATCHES "*s*" THEN
  DO i = 2 TO pik_return:
    user_env[1] = user_env[1] + "," + pik_list[pik_chosen[i]].
  END.

IF user_env[1] = "" THEN user_path = "".
HIDE FRAME v-all NO-PAUSE.
HIDE FRAME v-one NO-PAUSE.
RETURN.

/*********************************************************************
* Copyright (C) 2005,2007 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: _usrwdth.p

History:  
   09/18/02   D. McMann    Created
   09/16/05   K. McIntosh  Prevented deletion of valid report data, also found
                           & fixed problem with usage of BUFFER-VALUE in LENGTH
                           function for INTEGER elements of arrays 20031121-042.
   10/26/07   fernando     Make sure recommended length is not > 31995 - OE00098662

----------------------------------------------------------------------------*/

{ prodict/fhidden.i }

DEFINE INPUT PARAMETER p_DbId  AS RECID      NO-UNDO.
DEFINE INPUT PARAMETER p_Tbl   AS CHARACTER  NO-UNDO.
DEFINE INPUT PARAMETER p_how   AS CHARACTER  NO-UNDO.

DEFINE SHARED STREAM rpt.

DEFINE VARIABLE line         AS CHARACTER              NO-UNDO.
DEFINE VARIABLE scr-count    AS INTEGER                NO-UNDO.
DEFINE VARIABLE lReturnValue AS LOGICAL                NO-UNDO.
DEFINE VARIABLE lDefName    AS CHARACTER FORMAT "x(6)" NO-UNDO.  

DEFINE TEMP-TABLE sc-rpt
    FIELD rpt-id   AS INTEGER
    FIELD rpt-line AS CHARACTER FORMAT "x(60)"
    INDEX rpt rpt-id.

DEFINE TEMP-TABLE ttField
    FIELD tField-Name   LIKE DICTDB._Field._Field-Name 
    FIELD tWidth        LIKE DICTDB._Field._Width
    FIELD tDecimals     LIKE DICTDB._Field._Decimals
    INDEX IdxField-Name IS PRIMARY tField-Name.

DEFINE TEMP-TABLE ttExceed
    FIELD tFile-Name    LIKE DICTDB._File._File-Name 
    FIELD tField-Name   LIKE DICTDB._Field._Field-Name 
    FIELD tFormat       LIKE DICTDB._Field._Format
    FIELD tdtype        LIKE DICTDB._Field._Data-Type
    FIELD tExtent       LIKE DICTDB._Field._Extent
    FIELD tDecimals     LIKE DICTDB._Field._Decimals
    FIELD tDecData      LIKE DICTDB._Field._Decimals  /* Maximum decimals found */ 
    FIELD tWidth        LIKE DICTDB._Field._Width
    FIELD tFmtLen       AS INTEGER                  /* The length of the format */ 
    FIELD tKey          AS LOGICAL
    FIELD tNumberErr    AS INTEGER                   /* Number of format/width errors found for field */ 
    FIELD tNumberDec    AS INTEGER                   /* Number records with a field that exeeded the maximum number of decimal places */ 
    FIELD tLength       AS INTEGER
    FIELD tSize         AS INTEGER
    FIELD tMaxValue     AS CHARACTER                 /* Maximum falue for field exceeding format/width */
    FIELD tMaxDec       AS CHARACTER                 /* Value showing most significant decimal places. */ 
    FIELD tLargeValue   AS CHARACTER                 /* Largest decimal value, for comparision with longest */
    FIELD tDecOnly      AS LOGICAL 
    INDEX IdxFField-Name IS PRIMARY tFile-Name tField-Name.

DEFINE QUERY qFileSchema FOR DICTDB._File CACHE 50. 

FORM
  SKIP(1) 
  SPACE(3) DICTDB._File._File-name LABEL "Working on" FORMAT "x(32)" SPACE
  SKIP(1)
  WITH FRAME working_on SIDE-LABELS VIEW-AS DIALOG-BOX  
  TITLE "Generating Report".

FORM
    rpt-line
    WITH FRAME shorpt STREAM-IO DOWN USE-TEXT NO-LABELS.

FUNCTION LengthDecimal RETURNS INTEGER
  ( INPUT pDec AS DECIMAL )  FORWARD.

/*===========================Mainline code=================================*/

IF p_Tbl = "ALL" THEN
   SESSION:IMMEDIATE-DISPLAY = yes.
   
FIND _Db NO-LOCK WHERE RECID(_Db) = p_DbId.

lReturnValue = SESSION:SET-WAIT-STATE("general"). 

RUN Process-Tables NO-ERROR. 

HIDE FRAME working_on NO-PAUSE.
RUN Display-Report.
HIDE FRAME shorpt NO-PAUSE.
RETURN.

PROCEDURE Display-Report:
/* The purpose of this rountin is to display the information generated when checking
   the data.
*/

  FIND FIRST sc-rpt NO-ERROR.
  IF NOT AVAILABLE sc-rpt THEN DO:
    CREATE sc-rpt.
    ASSIGN rpt-line = "No data was found that exceeds the report's criteria. ".
  END.

  PAGE STREAM rpt.

  FOR EACH sc-rpt:
    DISPLAY STREAM rpt rpt-line WITH FRAME shorpt.
    DOWN STREAM rpt WITH FRAME shorpt.
  END.

END PROCEDURE.

PROCEDURE Process-Tables :
/*------------------------------------------------------------------------------
  Purpose: The purpose of this routine is to create records in a temporary table
            that identify the character and decimal fields that have data that 
            exceed either the format or the width.  The determination of format
            or width is set by a global variable.  
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE VARIABLE lBufHndl     AS HANDLE NO-UNDO.
DEFINE VARIABLE lQryHndl     AS HANDLE NO-UNDO.
DEFINE VARIABLE iIdx         AS INTEGER NO-UNDO.
DEFINE VARIABLE lFieldHndl   AS HANDLE NO-UNDO. 
DEFINE VARIABLE lLength      AS INTEGER NO-UNDO. 
DEFINE VARIABLE lPrint       AS LOGICAL INITIAL TRUE NO-UNDO. 
DEFINE VARIABLE lDecOnly     AS LOGICAL NO-UNDO. 
DEFINE VARIABLE lSize        AS INTEGER NO-UNDO. 
DEFINE VARIABLE lErrorFld    AS LOGICAL NO-UNDO. 
DEFINE VARIABLE lWidth       AS INTEGER NO-UNDO. 
DEFINE VARIABLE lNumDecimals AS INTEGER NO-UNDO. 
DEFINE VARIABLE TmpDec       AS DECIMAL NO-UNDO. 

/* Clear the temporary table */ 
FOR EACH ttExceed: 
    DELETE ttExceed. 
END.  

ASSIGN scr-count = 1.

IF p_Tbl = "ALL" THEN 
  OPEN QUERY qFileSchema FOR EACH DICTDB._File WHERE DICTDB._File._Tbl-Type = "T" 
                                               AND   DICTDB._File._Owner = "PUB" NO-LOCK.
ELSE
  OPEN QUERY qFileSchema FOR EACH DICTDB._File WHERE DICTDB._File._Tbl-Type = "T" 
                                               AND   DICTDB._File._Owner = "PUB" 
                                               AND   DICTDB._File._File-name = p_Tbl NO-LOCK.

  File-loop: 
  REPEAT:
    GET NEXT qFileSchema.
    IF NOT AVAILABLE DICTDB._File THEN 
        LEAVE File-loop.

    DISPLAY DICTDB._File._File-name WITH FRAME working_on.

    RUN LocateFields.

    CREATE BUFFER lBufHndl FOR TABLE DICTDB._File._File-Name.
    CREATE QUERY  lQryHndl.
    lQryHndl:SET-BUFFERS(lBufHndl).
    lQryHndl:QUERY-PREPARE("FOR EACH " + DICTDB._File._File-Name).
    lQryHndl:QUERY-OPEN.

    Data-Loop: 
    REPEAT:   
      /* Process all of the data records for the selected table. */ 

      lQryHndl:GET-NEXT.      /* get the next data record from current DICTDB._File._File-Name */ 
      IF lQryHndl:QUERY-OFF-END THEN DO:
        /* All data records have been processed */
        /* Print information if fields were found that exceeded format/width */ 
        RUN DisplayFieldInfo (INPUT DICTDB._File._File-Name).
        LEAVE Data-Loop.
      END.
    
      ttField-loop: 
      FOR EACH ttField:
        /* For each field in the temporary table that is character or decimal */ 
        ASSIGN  lFieldHndl  = lBufHndl:buffer-field(ttField.tField-Name) 
                iIdx        = 1         /* Set extent index. */  
                lErrorFld    = FALSE.   /* Initialize value that no errors have been found. */ 

        Extent-loop: 
        REPEAT:
          IF lFieldHndl:EXTENT > 0 THEN DO:
            IF CAN-DO("XLOB,CLOB,BLOB,CHARACTER,RAW",lFieldHndl:DATA-TYPE) THEN
              lLength = LENGTH(lFieldHndl:BUFFER-VALUE(iIdx), 
                               "CHARACTER") NO-ERROR. 
            ELSE IF lFieldHndl:DATA-TYPE = "decimal" THEN /* Type is decimal */
              lLength = LengthDecimal(DECIMAL(lFieldHndl:BUFFER-VALUE(iIdx))).
            ELSE 
              lLength = LENGTH(STRING(lFieldHndl:BUFFER-VALUE(iIdx)),
                               "CHARACTER") NO-ERROR.
          END.
          ELSE DO:
            IF CAN-DO("XLOB,CLOB,BLOB,CHARACTER,RAW",lFieldHndl:DATA-TYPE) THEN
              lLength = LENGTH(lFieldHndl:BUFFER-VALUE, 
                               "CHARACTER") NO-ERROR. 
            ELSE IF lFieldHndl:DATA-TYPE = "decimal" THEN /* Type is decimal */
              lLength = LengthDecimal(DECIMAL(lFieldHndl:BUFFER-VALUE)).
            ELSE lLength = LENGTH(STRING(lFieldHndl:BUFFER-VALUE),
                                  "CHARACTER") NO-ERROR.
          END.
          /* If the data exceeds the size of the format then process the data ... */
          /*    The buffer-field object handle value WIDTH-CHARS is derived from the field format */ 
          
          ASSIGN  lPrint   = FALSE
                  lDecOnly = FALSE. 

          IF p_how = "W" AND lLength > ttField.tWidth THEN DO: 
            IF lFieldHndl:EXTENT > 0 THEN  
              ASSIGN lWidth = ((ttField.tWidth / 2) / lFieldHndl:EXTENT) - 1.                 
            ELSE 
              ASSIGN lWidth = INTEGER(ttField.tWidth).   
                       
              /* Width was selected so only put message in the report if the width is exceeded. */ 
            IF lLength > lWidth THEN      
              ASSIGN  lPrint      = TRUE
                      lSize       = lWidth. 
            ELSE 
               /* Width is not exceeded, only format */ 
              NEXT ttField-loop. 
          END.
          ELSE IF lLength > (lFieldHndl:WIDTH-CHARS) THEN            
            ASSIGN  lPrint      = TRUE
                    lSize       = lFieldHndl:WIDTH-CHARS. 

                    
          IF lFieldHndl:DATA-TYPE = "decimal" THEN DO: 
            /* Get the number of significant decimal places for this decimal value. */ 
            IF lFieldHndl:EXTENT > 0 THEN  
              lNumDecimals = 
                LENGTH(STRING(DECIMAL(lFieldHndl:BUFFER-VALUE(iIdx)) - 
                              TRUNCATE(DECIMAL(lFieldHndl:BUFFER-VALUE(iIdx)),
                                       0))) NO-ERROR.
            ELSE
              lNumDecimals = 
                LENGTH(STRING(DECIMAL(lFieldHndl:BUFFER-VALUE) - 
                              TRUNCATE(DECIMAL(lFieldHndl:BUFFER-VALUE),
                                       0))) NO-ERROR.

            /* Subtract 1 to remove the counting of the decimal place. */ 
            lNumDecimals = lNumDecimals - 1. 

              /* If the number of decimal places is greater than the schema definition ...  */ 
            IF lNumDecimals > ttField.tDecimals THEN  
              ASSIGN  lDecOnly    = NOT lPrint  
                      lPrint      = TRUE. 
                                     
          END.

          IF lPrint THEN DO: 
              /* Keep track of the informaiton to be printed and possibly updated. */ 
            FIND ttExceed WHERE ttExceed.tFile  = lFieldHndl:TABLE
                            AND   ttExceed.tField = lFieldHndl:NAME NO-ERROR.
            IF NOT AVAILABLE ttExceed THEN DO: 
              CREATE ttExceed. 
              ASSIGN  ttExceed.tFile          = lFieldHndl:TABLE
                      ttExceed.tField         = lFieldHndl:NAME
                      ttExceed.tWidth         = ttField.tWidth
                      ttExceed.tFormat        = lFieldHndl:FORMAT 
                      ttExceed.tFmtLen        = lFieldHndl:WIDTH-CHARS 
                      ttExceed.tSize          = lSize
                      ttExceed.tKey           = lFieldHndl:KEY
                      ttExceed.tdtype         = lFieldHndl:DATA-TYPE
                      ttExceed.tDecimals      = ttField.tDecimals                               
                      ttExceed.tDecData       = 0                                
                      ttExceed.tExtent        = lFieldHndl:EXTENT     
                      ttExceed.tNumberErr     = 0
                      ttExceed.tNumberDec     = 0 
                      ttExceed.tDecOnly       = lDecOnly.
            END. 

              /* the tDecOnly field is used to control the reporting and printing.
                 If tDecOnly is true then the format/width has not been exceeded.  */                                                                                                
            IF NOT lDecOnly THEN  
              ASSIGN  ttExceed.tNumberErr = ttExceed.tNumberErr + 1
                        ttExceed.tDecOnly   = NO.

            IF lNumDecimals > ttField.tDecimals THEN DO:
              ASSIGN ttExceed.tNumberDec = ttExceed.tNumberDec + 1. 
              IF lNumDecimals > ttExceed.tDecData THEN  
                  ASSIGN ttExceed.tDecData   = lNumDecimals.                  
            END. 

              /* Keep track of the longest field over the definition size */ 
            IF lLength > ttExceed.tLength THEN 
              ASSIGN ttExceed.tLength   = lLength. 
               
          END. /* IF lPrint */ 

          IF lFieldHndl:EXTENT > 0 THEN DO:
            ASSIGN iIdx = iIdx + 1. 
            IF iIdx > lFieldHndl:EXTENT THEN 
              LEAVE Extent-loop. 
          END.
          ELSE   /* Process only once for non-extent field */ 
            LEAVE Extent-loop.        
        END.  /* Extent-loop */ 
      END. /* ttField-loop */ 
    END. /* Data-Loop */
    
    DELETE OBJECT lQryHndl.
    DELETE OBJECT lBufHndl.
  END. /* File-loop */ 

RETURN. 
END PROCEDURE.

PROCEDURE LocateFields :
/*------------------------------------------------------------------------------
  Purpose: Create temporary table records with meta schema information on the 
            width and the decimal values.  Only these fields are needed since the
            buffer-field object handle provides access to all of the other meta
            schema information that is needed.     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/

    /* Clear the temporary table */ 
    FOR EACH ttField: 
        DELETE ttField. 
    END.  

    field-loop: 
    FOR EACH DICTDB._Field WHERE DICTDB._Field._File-recid = RECID(DICTDB._File)
                    AND   (DICTDB._Field._Data-Type  = "character"
                           OR DICTDB._Field._Data-Type  = "decimal"
                           OR DICTDB._Field._Data-type = "raw"
                           OR DICTDB._Field._Extent > 0) NO-LOCK:     

        CREATE ttField.
        CASE DICTDB._Field._Data-Type:
            WHEN "character" OR WHEN "raw" THEN DO: 
                ASSIGN  tField-Name   =    DICTDB._Field._Field-Name
                        tWidth        =    DICTDB._Field._Width.
            END.
            WHEN "decimal" THEN DO: 
                ASSIGN  tField-Name   =    DICTDB._Field._Field-Name
                        tWidth        =    DICTDB._Field._Width
                        tDecimals     =    DICTDB._Field._Decimals.
            END.
            OTHERWISE 
                ASSIGN tField-name    =    DICTDB._Field._Field-name
                       tWidth         =    DICTDB._Field._Width.
        END CASE.        
    END. 
    RETURN. 
END PROCEDURE.

PROCEDURE DisplayFieldInfo :
/*------------------------------------------------------------------------------
  Purpose:     
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
DEFINE INPUT PARAMETER pFile AS CHARACTER NO-UNDO.

DEFINE VARIABLE numrec AS INTEGER NO-UNDO.
DEFINE VARIABLE size   AS INTEGER NO-UNDO.

FIND FIRST ttExceed WHERE ttExceed.tFile = pFile NO-ERROR.

IF AVAILABLE ttExceed THEN DO:
    /* At least one field exists that should be modified in the selected table. */ 
    FIND FIRST sc-rpt NO-ERROR.
    IF AVAILABLE sc-rpt THEN DO:
      CREATE sc-rpt.
      ASSIGN rpt-id = scr-count
             rpt-line = "  "
             scr-count = scr-count + 1.
    END.

    CREATE sc-rpt.
    ASSIGN rpt-id = scr-count
           rpt-line = ttExceed.tFile-Name  + " Table"
           scr-count = scr-count + 1.

    numrec = scr-count.
END.

_crt-rpt:
FOR EACH ttExceed WHERE ttExceed.tFile = pFile: 
    IF ttExceed.tExtent > 0 AND (((ttExceed.tLength + 1) * ttExceed.tExtent) < ttExceed.tWidth) THEN
       NEXT _crt-rpt.
    
    /* Do not add to report for format/width if this is a decimal only issue. */ 
    IF ttExceed.tDecOnly = NO THEN DO:             
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line = "  " + ttExceed.tField-Name
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line =  "      Number of records exceeding format: " + (IF ttExceed.tExtent > 0 THEN STRING(INTEGER(tNumberErr / ttExceed.tExtent))
                                                                           ELSE STRING(tNumberErr))
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line =  "      Data type: " + ttExceed.tdtype +  "   Used in an index: " + STRING(ttExceed.tKey)
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line =  "      Format Length: " + STRING(ttExceed.tFmtLen) + "       Format: " + ttExceed.tFormat
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line =  "      Width: " + STRING(ttExceed.tWidth )
               scr-count = scr-count + 1.
        IF ttExceed.tExtent = 0 THEN DO:
          CREATE sc-rpt.
          ASSIGN rpt-id = scr-count
                 rpt-line =  "      Longest Data Length: " + STRING(ttExceed.tLength)
                 scr-count = scr-count + 1.
        END.
        ELSE DO:
          CREATE sc-rpt.
          ASSIGN rpt-id = scr-count
                 rpt-line =  "      Longest Individual Element: " + STRING(ttExceed.tLength)
                 scr-count = scr-count + 1.
        END.
       
      
       /* SQL client cannot access fields having widths greater than 31995 */
       ASSIGN size = ((ttExceed.tLength + 1) * ttExceed.tExtent).
       IF size > 31995 THEN
          ASSIGN size = 31995.
       
        CASE ttExceed.tdtype:
            WHEN "character" OR WHEN "raw" THEN DO:
                IF ttExceed.tExtent > 0 THEN DO:
                    CREATE sc-rpt.
                    ASSIGN rpt-id = scr-count
                           rpt-line = "      Extent: " + STRING(ttExceed.tExtent)
                           scr-count = scr-count + 1.
                    CREATE sc-rpt.
                    ASSIGN rpt-id = scr-count
                           rpt-line = "      Recommended Field Width: " + STRING(size)
                           scr-count = scr-count + 1.                    
                END.                                         
            END.
            WHEN "decimal" THEN DO: 
                IF ttExceed.tExtent > 0 THEN DO:
                    CREATE sc-rpt.
                    ASSIGN rpt-id = scr-count
                           rpt-line = "      Extent: " + STRING(ttExceed.tExtent)
                           scr-count = scr-count + 1.
                    CREATE sc-rpt.
                    ASSIGN rpt-id = scr-count
                           rpt-line = "      Recommended Field Width: " + STRING(size)
                           scr-count = scr-count + 1.                    
                END.                
            END.
            OTHERWISE DO:
              IF ttExceed.tExtent > 0 THEN DO:
                CREATE sc-rpt.
                ASSIGN rpt-id = scr-count
                       rpt-line = "      Extent: " + STRING(ttExceed.tExtent)
                       scr-count = scr-count + 1.
                CREATE sc-rpt.
                ASSIGN rpt-id = scr-count
                       rpt-line = "      Recommended Field Width: " + STRING(size)
                       scr-count = scr-count + 1.                    
              END.  
            END.

        END CASE.  
    END. /* IF ttExceed.tDecOnly = NO */ 

    /* Does the number of decimals need to be modified? */
    IF ttExceed.tDecimals < ttExceed.tDecData THEN DO: 
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line = "    " + ttExceed.tField-Name + " field does not have enough decimal places for the data."
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line = "        Number of records exceeding format: " + STRING(tNumberDec)
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line = "        Decimals: " + STRING(ttExceed.tDecimals) + "   Part of index: " + STRING(ttExceed.tKey)
               scr-count = scr-count + 1.
        CREATE sc-rpt.
        ASSIGN rpt-id = scr-count
               rpt-line = "        Maximum Decimals: " + STRING(ttExceed.tDecData)  + "   Data type: " + ttExceed.tdtype
               scr-count = scr-count + 1.

        IF ttExceed.tExtent > 0 THEN DO:
            CREATE sc-rpt.
            ASSIGN rpt-id = scr-count
                   rpt-line = "      Extent: " + STRING(ttExceed.tExtent)
                   scr-count = scr-count + 1.
        END.
    END.

END.  /* FOR EACH ttExceed */ 
IF numrec = scr-count THEN DO:
  FIND sc-rpt WHERE rpt-id = numrec - 1 NO-ERROR.
  IF AVAILABLE sc-rpt THEN
    DELETE sc-rpt.
END.

RETURN. 
END PROCEDURE.

FUNCTION LengthDecimal RETURNS INTEGER
  ( INPUT pDec AS DECIMAL ) :
/*------------------------------------------------------------------------------
  Purpose: This function calculates the size needed to accommodate a decimal value.
            The calculated size includes the number of digits (scale), the number of decimal 
            places (precision), the decimal point, the sign, and the comma separator. 
             
    Notes: The decimal calculations include the sign, decimal point, and commas in the size
           calculations.  This errors on the side of allocating a little bit of extra space. 
           This size calculation is the similar to the way the width field was initially 
           calculated.    
           
           The default width when the scale is < 15 is 15 + decimal places.
------------------------------------------------------------------------------*/
    DEFINE VARIABLE lTruncate   AS DECIMAL NO-UNDO.
    DEFINE VARIABLE lComma      AS DECIMAL NO-UNDO.
    DEFINE VARIABLE lRemainder  AS DECIMAL NO-UNDO.
    DEFINE VARIABLE lLenDec     AS DECIMAL NO-UNDO.
    DEFINE VARIABLE lSign       AS DECIMAL NO-UNDO.
    
    /* Determine number of commas */ 
    ASSIGN  lTruncate     = TRUNCATE(pDec,0) /* Set the scale */
            lRemainder  = lTruncate 
            lSign       = IF lTruncate < 0 THEN 1 ELSE 0 
            lComma      = 0. 

    DO WHILE (lRemainder > 0) AND (lRemainder > 1000):
        ASSIGN  lComma = lComma + 1  
                lRemainder = lRemainder / 1000. 
    END.

    /* length of scale + precision, includes count of decimal place + commas + sign */  
    RETURN INTEGER((LENGTH(STRING(lTruncate)) + LENGTH(STRING(pDec - lTruncate)) + lComma) + lSign).   /* Function return value. */

END FUNCTION.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _usrwgen.p */

/* This program generates explicit WORKFILE definitions from file
definitions in the database.  These workfile definitions can then
be customized.

This is useful if you need a workfile to temporarily hold some,
but not all, of the fields in a database file. 

History: 07/09/98 D. McMann Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                            to Find of _File
         04/13/00 D. McMann Added support for long path names
         03/05/03 D. McMann Added note about LOB's not in file.
                            
*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE VARIABLE answer AS LOGICAL   NO-UNDO.
DEFINE VARIABLE canned AS LOGICAL   NO-UNDO INIT TRUE.
DEFINE VARIABLE fo     AS CHARACTER NO-UNDO.
{prodict/misc/filesbtn.i}

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 4 NO-UNDO INITIAL [
  /* 1*/ "You do not have permission to use this option.",
  /* 2*/ "A file named",
  /* 3*/ "already exists.",
  /* 4*/ "Overwrite it?"
].
FORM 
  SKIP({&TFM_WID})
  fo {&STDPH_FILL} FORMAT "x({&PATH_WIDG})" AT 2 VIEW-AS FILL-IN SIZE 40 BY 1
         LABEL "Output File"
  btn_File SKIP ({&VM_WIDG})
   "NOTE:  Only Non-LOB fields will be included in the output file" AT 2
    VIEW-AS TEXT SKIP ({&VM_WIDG})
  {prodict/user/userbtns.i}
  WITH FRAME genworkf
  SIDE-LABELS CENTERED 
  DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel
  VIEW-AS DIALOG-BOX 
  TITLE " Generate DEFINE WORK-TABLE for ~"" + _File._File-name + "~" ".

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

/*===============================Triggers=================================*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
/*----- HELP -----*/
on HELP of frame genworkf
   or CHOOSE of btn_Help IN FRAME genworkf
   RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	     INPUT {&Generate_Workfile_Dlg_Box},
      	       	     	     INPUT ?).
&ENDIF


ON GO OF FRAME genworkf
DO:
  DEFINE VAR fil AS CHAR NO-UNDO.

  fil = fo:SCREEN-VALUE IN FRAME genworkf.

  IF SEARCH(fil) <> ? THEN DO:
    answer = FALSE.
    MESSAGE new_lang[2] fil new_lang[3] SKIP new_lang[4]
      VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    IF NOT answer THEN 
    DO:
      APPLY "ENTRY" TO fo IN FRAME genworkf.
      RETURN NO-APPLY.
    END.
  END.
END.

ON CHOOSE OF btn_File in frame genworkf DO:
   RUN "prodict/misc/_filebtn.p"
       (INPUT fo:handle in frame genworkf /*Fillin*/,
        INPUT "Find Output File"  /*Title*/,
        INPUT ""                 /*Filter*/,
        INPUT no                /*Must exist*/).
END.
ON LEAVE OF fo in frame genworkf
   fo:screen-value in frame genworkf = 
        TRIM(fo:screen-value in frame genworkf).

ON WINDOW-CLOSE OF FRAME genworkf
   APPLY "END-ERROR" TO FRAME genworkf.

/*============================Mainline code===============================*/

FIND _File WHERE _File._File-name = "_File"
             AND _File._Owner = "PUB".
answer = CAN-DO(_Can-read,USERID("DICTDB")).
FIND _File WHERE _File._File-name = "_Field"
             AND _File._Owner = "PUB".
answer = answer AND CAN-DO(_Can-read,USERID("DICTDB")).
IF NOT answer THEN DO:
  MESSAGE new_lang[1] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_path = "".
  RETURN.
END.

FIND _File WHERE _Db-recid = drec_db AND _File-name = user_env[1]
             AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN").

ASSIGN
  fo = LC(_File._File-name) + ".i".

/* Adjust the graphical rectangle and the ok and cancel buttons */
{adecomm/okrun.i  
    &FRAME  = "FRAME genworkf" 
    &BOX    = "rect_Btns"
    &OK     = "btn_OK" 
    {&CAN_BTN}
    {&HLP_BTN}
}
PAUSE 0.

work_loop:
DO ON ERROR UNDO,RETRY ON ENDKEY UNDO,LEAVE:
  UPDATE fo btn_File btn_OK btn_Cancel {&HLP_BTN_NAME} WITH FRAME genworkf.

  /* Do the work */
  user_env[1] = fo.
  RUN "prodict/misc/_wrkwgen.p".
  canned = FALSE.
END.

IF canned THEN
  user_path = "".

HIDE FRAME genworkf NO-PAUSE.
RETURN.

/********************************************************************* *
* Copyright (C) 2000-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*
-------------------------------------------------------------------------------
DESCRIPTION:
------------
  Table Name: ______________________________     Table Type: _________ 
Multi-tenant: ___  Keep Area for Default Tenant: __ 
        Area: _____________________________________         
   Dump File: _____________________________________         Hidden: ___
       Label: _____________________________________         Frozen: ___
       Owner: _____________________________________    Record Size: _____
 Replication: _____________________________________
  DataServer Name: ______________________________________________
         DB Link : ______________________________________________

 Description: _______________________________________________________________
              _______________________________________________________________
              _______________________________________________________________
              _______________________________________________________________

          [^Validation] [^Triggers] [String Attributes] [^DataServer]
-------------------------------------------------------------------------------
*/
/*
   HISTORY:  D. McMann change Area variable to character so N/A could be
                       displayed for DataServer files 02/9/98
                       
             D. McMann Removed _file-number 03/18/98   
             D. McMann Added Area name support 
             D. McMann Added _Owner to _File finds 07/14/98
             Mario B Add s_In_Schema_Area enabling one time notification 12/28/98.
             D. McMann changes for 99-02-26-025
             D. McMann Added selection-list for areas.
             fernando  06/15/06 Expanding Dump-name to 32 characters
*/

FORM
  wfil._File-name FORMAT "x(32)"  colon 13 LABEL "Table Name"
  /* progress is longest db type name */  
  wfil._For-Type  FORMAT "x(10)"  colon 64 LABEL "Table Type"
  skip
  wfil._File-attributes[1]  colon 13 label "Multi-tenant" 
  wfil._File-attributes[2]  label "Keep Area for Default Tenant"
  SKIP
  areaname  colon 13 VIEW-AS SELECTION-LIST INNER-CHARS 32 INNER-LINES 1 
                                     LABEL "Area" SKIP
 
  wfil._Dump-name    FORMAT "x(32)"  colon 13 LABEL "Dump File" 
  wfil._Hidden       FORMAT "yes/no" colon 64 LABEL "Hidden" SKIP
  wfil._File-label   FORMAT "x(32)"  colon 13 LABEL "Label"      
  wfil._Frozen       FORMAT "yes/no" colon 64 LABEL "Frozen" SKIP
  wfil._For-Owner    FORMAT "x(32)"  colon 13 LABEL "Owner"
  wfil._For-Size     FORMAT ">>>>9"  colon 64 LABEL "Record Size" SKIP

  wfil._Fil-misc2[6] FORMAT "X(32)"  colon 13 LABEL "Replication"
 
  wfil._For-Name     FORMAT "x(45)" colon 19   LABEL  "DataServer Name"
    HELP "The name of the table in the DataServer's schema"  SKIP
  wfil._Fil-misc2[8] FORMAT "x(45)"  colon 19  LABEL "DB Link"   SKIP
 
  wfil._Desc      colon 13 VIEW-AS EDITOR
                           INNER-CHARS 63 INNER-LINES 3
                           BUFFER-LINES 4     LABEL "Description"    SKIP

  button-v AT 12 SPACE(2) button-f SPACE(2) 
        button-s SPACE(2) button-d                           SKIP
  btn_OK   AT 22 SPACE(4) btn_Cancel SPACE(4) btn_flds
  WITH FRAME frame-d
    /* need scrollable to compile cleanly on gui - though it's not run there */
    NO-BOX  SIDE-LABELS OVERLAY ROW 2 COLUMN 2 SCROLLABLE.


/*----- GO or OK -----*/
ON GO OF FRAME frame-d DO:
  RUN check_file_name (OUTPUT isbad).
  IF isbad THEN DO:
    ASSIGN
      go_field = no
      get-hit = no.
    RETURN NO-APPLY.
  END.

  RUN check_dump_name (OUTPUT isbad).
  IF isbad THEN DO:
    ASSIGN
      get-hit = no
      go_field = no.
    RETURN NO-APPLY.
  END.

  IF adding THEN DO:   
    ASSIGN filearea = areaname:SCREEN-VALUE IN FRAME FRAME-d.    
    RUN check_area_name (INPUT-OUTPUT s_In_Schema_Area).
    IF NOT s_In_Schema_Area THEN 
    DO:
      ASSIGN get-hit = no
             go_field = no.
      RETURN NO-APPLY.
    END.
  END.
  ELSE DO:
    if input wfil._File-attributes[1] and not wfil._File-attributes[1] then
    do:    
        /*  input input...   */
        RUN check_multi_tenant (input input wfil._File-attributes[2],OUTPUT isBad).
        IF isBad THEN DO:
          ASSIGN
            go_field = no
            get-hit = no.
          RETURN NO-APPLY.
        END.
    end.
  END.
  
END.

ON VALUE-CHANGED OF areaname IN FRAME frame-d DO :
  ASSIGN filearea = areaname:SCREEN-VALUE.
  /* keep track of last non-bank area for resetting when 
     changing Keep default area - wfil._File-attribute[2] */
  if filearea <> "" then 
     filearealog = filearea.
  RETURN.
END.

ON any-printable OF wfil._File-attribute[1] IN FRAME frame-d,
                    wfil._File-attribute[2] IN FRAME frame-d
DO :
   if last-event:label = "?" then
    do: 
        bell. 
        return no-apply.  
    end.  
end.

ON VALUE-CHANGED OF wfil._File-attribute[1] IN FRAME frame-d,
                    wfil._File-attribute[2] IN FRAME frame-d
DO :
             
   /* { defined in prodict/pro/arealabel.i } */
   setAreaState(input frame frame-d wfil._File-attribute[1],
                input frame frame-d wfil._File-attribute[2],   
                yes,
                adding,
                wfil._File-attribute[2]:handle in frame frame-d, 
                areaname:handle in frame frame-d,
                ?, /* no area button */
                filearealog).
                 
END.


/*----- CHOOSE OF FIELD EDITOR BUTTON-----*/
ON CHOOSE OF btn_flds IN FRAME frame-d 
   go_field = yes.
   /* GO trigger will fire after this */


/*----- CHOOSE of SUB-DIALOG BUTTONS -----*/
ON CHOOSE OF button-v IN FRAME frame-d DO:
  RUN Tbl_Validation.
  MESSAGE COLOR NORMAL stdmsg.
END.

ON CHOOSE OF button-f IN FRAME frame-d DO:
  RUN Tbl_Triggers.
  MESSAGE COLOR NORMAL stdmsg.
END.

ON CHOOSE OF button-s IN FRAME frame-d DO:
  /* used for GUI too! */
  RUN Tbl_String_Attrs.
  MESSAGE COLOR NORMAL stdmsg.
END.

ON CHOOSE OF button-d IN FRAME frame-d DO:
  RUN prodict/gate/_gat_row.p 
    ( INPUT user_dbtype,
      INPUT dbkey
    ).
  MESSAGE COLOR NORMAL stdmsg.
END.



/*---- DEFAULT DUMP NAME -----*/
ON ENTRY OF wfil._Dump-name IN FRAME frame-d DO:
  IF SELF:SCREEN-VALUE = "?" OR SELF:SCREEN-VALUE = "" THEN
    DISPLAY LC(INPUT FRAME frame-d wfil._File-name)
      @ wfil._Dump-name WITH FRAME frame-d.
END.


/*----- HANDLE GET TO SWITCH TABLES -----*/
ON   GET OF wfil._File-name  IN FRAME frame-d
  OR GET OF wfil._File-attribute[1]  IN FRAME frame-d
  OR GET OF wfil._File-attribute[2]  IN FRAME frame-d
  OR GET OF areaname         IN FRAME frame-d
  OR GET OF wfil._For-Type   IN FRAME frame-d
  OR GET OF wfil._Hidden     IN FRAME frame-d
  OR GET OF wfil._Dump-name  IN FRAME frame-d
  OR GET OF wfil._File-label IN FRAME frame-d
  OR GET OF wfil._For-Size   IN FRAME frame-d
  OR GET OF wfil._Desc       IN FRAME frame-d 
  OR GET OF button-v         IN FRAME frame-d
  OR GET OF button-f         IN FRAME frame-d 
  OR GET OF button-s         IN FRAME frame-d 
  OR GET OF btn_OK           IN FRAME frame-d 
  OR GET OF btn_Cancel       IN FRAME frame-d 
  OR GET OF btn_flds         IN FRAME frame-d 
DO:
  IF NOT adding THEN DO:
    get-hit = TRUE.
    APPLY "GO" TO FRAME frame-d.
  END.
  RETURN NO-APPLY.
END.


/*------------------------Internal Procedures--------------------*/
PROCEDURE check_dump_name:
  DEFINE OUTPUT PARAMETER isbad AS LOGICAL INITIAL FALSE NO-UNDO.

  IF INPUT FRAME frame-d wfil._Dump-name = ?
    OR INPUT FRAME frame-d wfil._Dump-name = "" THEN
    DISPLAY LC(INPUT FRAME frame-d wfil._File-name)
      @ wfil._Dump-name WITH FRAME frame-d.
  FIND FIRST _File
    WHERE _File._Dump-name = INPUT FRAME frame-d wfil._Dump-name
      AND (adding OR RECID(_File) <> dbkey) 
      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
  IF AVAILABLE _File THEN DO:
    MESSAGE "That dump name is not unique within this database."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    isbad = TRUE.
    APPLY "ENTRY" TO wfil._Dump-name IN FRAME frame-d.
  END.
END PROCEDURE.


PROCEDURE check_file_name:
  DEFINE OUTPUT PARAMETER isbad AS LOGICAL INITIAL FALSE NO-UNDO.

  IF newnam THEN DO: 
    RUN "adecomm/_valname.p"
      (INPUT (INPUT FRAME frame-d wfil._File-name),INPUT no,OUTPUT isbad).
    isbad = NOT isbad. /* _valname.p returns opposite of what we want here*/
    IF isbad THEN DO:
       APPLY "ENTRY" TO wfil._File-name IN FRAME frame-d.
       RETURN.
    END.
  END.

  FIND FIRST _File OF _Db
    WHERE _File._File-name = INPUT FRAME frame-d wfil._File-name
      AND (adding OR RECID(_File) <> dbkey) 
      AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
  isbad = (AVAILABLE _File).
  IF isbad THEN DO:
    MESSAGE "This table name is already used within this database."
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    APPLY "ENTRY" TO wfil._File-name IN FRAME frame-d.
  END.
END PROCEDURE.

PROCEDURE check_area_name:
  DEFINE INPUT-OUTPUT PARAMETER p_In_Schema_Area AS LOGICAL NO-UNDO.
  
  DEFINE VARIABLE ans             AS LOGICAL INITIAL FALSE NO-UNDO. 

  IF filearea = "" OR filearea = ? THEN
      ASSIGN filearea = areaname:ENTRY(1) IN FRAME frame-d.

  IF filearea = "Schema Area"  THEN DO:
    IF p_In_schema_area THEN DO:
      APPLY LASTKEY.
      RETURN.
    END.
    FIND FIRST DICTDB._Area WHERE DICTDB._Area._Area-number > 6
                              AND DICTDB._Area._Area-type = 6
                              no-lock no-error.
    IF AVAILABLE DICTDB._Area THEN DO:
      MESSAGE "Progress Software Corporation does not recommend" SKIP
              "creating user tables in the Schema Area." SKIP (1)
              "Should tables be created in this area?" SKIP(1)
               VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE ans.
      IF ans THEN
        p_In_Schema_Area = TRUE.
      ELSE DO:
        p_In_Schema_Area = FALSE.
        APPLY "ENTRY" TO areaname IN FRAME frame-d.
        RETURN.
      END.
    END.
    ELSE DO:
      MESSAGE "Progress Software Corporation does not recommend" SKIP
              "creating user tables in the Schema Area. " SKIP(1)
              "See the System Administration Guide on how to" SKIP
              "create data areas. " SKIP(1)
              VIEW-AS ALERT-BOX WARNING.
      ASSIGN p_In_Schema_Area = TRUE.
    END.
  END.
  ELSE  
    APPLY LASTKEY.
   
END PROCEDURE.

PROCEDURE check_multi_tenant :    
 
    DEFINE INPUT PARAMETER keepdefault AS LOGICAL NO-UNDO.
    DEFINE OUTPUT PARAMETER isbad AS LOGICAL INITIAL FALSE NO-UNDO.
    run prodict/pro/_pro_mt_tbl.p (keepdefault,output isbad). 
END.  
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
-------------------------------------------------------------------------------
TABLE-TRIGGERS:
---------------

                                                               Override- Check
                        Trigger Programs                       able	 CRC?
    
             for CREATE: ____________________________________   ___	  __ 
             for DELETE: ____________________________________   ___	  __ 
               for FIND: ____________________________________   ___	  __ 
              for WRITE: ____________________________________   ___	  __ 
 for REPLICATION-CREATE: ____________________________________   ___	  __ 
 for REPLICATION-DELETE: ____________________________________   ___	  __ 
  for REPLICATION-WRITE: ____________________________________   ___	  __ 

[^Description] [^Validation]         (press [PUT] to edit trigger source)
-------------------------------------------------------------------------------
*/

FORM
  "Override-"	      at 62 view-as TEXT 
  "Check"	      at 73 view-as TEXT  SKIP
  "Trigger Programs"  at 26 view-as TEXT 
  "able?"	      at 62 view-as TEXT 
  "CRC?"	      at 73 view-as TEXT  SKIP(1)

  pname[1]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL "            For CREATE" 
              view-as fill-in size 33 by 1
  override[1] at 62 ATTR-SPACE NO-LABEL 
  crc[1]      at 73 ATTR-SPACE NO-LABEL  SKIP

  pname[2]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL "            For DELETE"
              view-as fill-in size 33 by 1 
  override[2] at 62 ATTR-SPACE NO-LABEL
  crc[2]      at 73 ATTR-SPACE NO-LABEL  SKIP

  pname[3]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL "              For FIND" 
              view-as fill-in size 33 by 1
  override[3] at 62 ATTR-SPACE NO-LABEL 
  crc[3]      at 73 ATTR-SPACE NO-LABEL  SKIP

  pname[4]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL "             For WRITE"
              view-as fill-in size 33 by 1 
  override[4] at 62 ATTR-SPACE NO-LABEL 
  crc[4]      at 73 ATTR-SPACE NO-LABEL  SKIP

  pname[5]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL "For REPLICATION-CREATE"
              view-as fill-in size 33 by 1 
  override[5] at 62 ATTR-SPACE NO-LABEL 
  crc[5]      at 73 ATTR-SPACE NO-LABEL  SKIP

  pname[6]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL "For REPLICATION-DELETE"
              view-as fill-in size 33 by 1 
  override[6] at 62 ATTR-SPACE NO-LABEL 
  crc[6]      at 73 ATTR-SPACE NO-LABEL  SKIP

  pname[7]    at 2 FORMAT "x(100)" ATTR-SPACE LABEL " For REPLICATION-WRITE"
              view-as fill-in size 33 by 1 
  override[7] at 62 ATTR-SPACE NO-LABEL 
  crc[7]      at 73 ATTR-SPACE NO-LABEL  SKIP

  SPACE(12) "(removing the trigger file name deletes the trigger)" SKIP
  SPACE(12) do-get FORMAT "x(45)" NO-LABEL 

  {prodict/user/userbtns.i}
  WITH FRAME frame-f
    NO-ATTR-SPACE SIDE-LABELS SCROLLABLE
    VIEW-AS DIALOG-BOX TITLE "Table Triggers"
    ROW 2 COLUMN 1.

{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME frame-f"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}


DEFINE VAR committed AS LOGICAL NO-UNDO.

/*=========================Internal Procedures=============================*/

PROCEDURE Tbl_Triggers:
   /* See if the table we are adding/editing is committed to the
      database yet.  If we're adding, we know it's not committed.  
      On edit, we have a problem if the user is renaming the table. 
   */
   committed = (IF adding THEN no else 
      	        IF wfil._File-name <> INPUT FRAME frame-d wfil._File-name 
      	       	  then no else yes).

  VIEW FRAME frame-f.

  ASSIGN
    pname = ""
    override = no
    crc = committed  /* if trig won't compile no else yes */
    old_crc_val = ?.

  DO i = 1 TO 7:
    FIND FIRST wfit WHERE wfit._Event = events[i] NO-ERROR.
    IF AVAILABLE wfit THEN 
      ASSIGN
    	pname[i]	= wfit._Proc-name
    	override[i]	= wfit._Override
    	crc[i]	     	= (if wfit._Trig-CRC = ? then no else yes)
    	old_crc_val[i] 	= wfit._Trig-CRC.

    new_crc_val[i] = old_crc_val[i].
  END.
     
  IF romode = 0 THEN
    HIDE MESSAGE NO-PAUSE.

  DISPLAY
    pname[1] override[1] crc[1]
    pname[2] override[2] crc[2]
    pname[3] override[3] crc[3]
    pname[4] override[4] crc[4]
    pname[5] override[5] crc[5]
    pname[6] override[6] crc[6]
    pname[7] override[7] crc[7]
    do-get WHEN romode = 0
    WITH FRAME frame-f.

  UPDATE
    pname[1] WHEN romode =0 override[1] WHEN romode =0 crc[1] WHEN romode=0
    pname[2] WHEN romode =0 override[2] WHEN romode =0 crc[2] WHEN romode=0
    pname[3] WHEN romode =0 override[3] WHEN romode =0 crc[3] WHEN romode=0
    pname[4] WHEN romode =0 override[4] WHEN romode =0 crc[4] WHEN romode=0
    pname[5] WHEN romode =0 override[5] WHEN romode =0 crc[5] WHEN romode=0
    pname[6] WHEN romode =0 override[6] WHEN romode =0 crc[6] WHEN romode=0
    pname[7] WHEN romode =0 override[7] WHEN romode =0 crc[7] WHEN romode=0
    btn_OK btn_Cancel
    WITH FRAME frame-f.
END.

/*----------------------------------------------------------------
   Dispatch to editing trigger code sub-dialog.

   Note: I should be able to just pass in the event index for
   all the pieces (pname, events, crc and new_crc_val) but 
   using indexes on widget arrays doesn't work real well in 
   Progress!
----------------------------------------------------------------*/
PROCEDURE Edit_Trig_Code:
   DEFINE INPUT PARAMETER ev_ix  AS INTEGER   	  NO-UNDO.  /* event index */   
   DEFINE INPUT PARAMETER w_crc  AS WIDGET-HANDLE NO-UNDO.
   DEFINE INPUT PARAMETER p_name AS CHAR          NO-UNDO. 

   DEFINE VAR crc_val AS LOGICAL NO-UNDO.

   crc_val = (IF w_crc:SCREEN-VALUE = "yes" THEN yes ELSE no).

   /* In case they hit "PUT" before leaving the crc field */
   if crc_val AND NOT committed THEN 
   DO:
      /* It won't compile so put up error and reset crc to no */
     { prodict/user/usertrgw.i &widg = w_crc } 
   END.

   /* check syntax can be determined by user except: if not committed
      so trigger won't compile then no, and if user requests
      crc checking than they must compile.  This determines 5th 
      input parameter.
   */
   check_syntax = (IF NOT committed THEN no ELSE check_syntax OR crc_val).
   RUN "prodict/user/_usrtrig.p"
      (INPUT p_name,
       INPUT events[ev_ix],
       INPUT wfil._File-Name:SCREEN-VALUE IN FRAME frame-d, 
       INPUT "",
       INPUT (NOT committed) OR crc_val,
       INPUT-OUTPUT new_crc_val[ev_ix],
       INPUT-OUTPUT check_syntax).
END.

/*===============================Triggers=================================*/

/*----- PUT FROM ANY TRIGGER FRAME FIELD-----*/
ON PUT OF pname[1] IN FRAME frame-f,
          override[1] IN FRAME frame-f,
      	  crc[1] IN FRAME frame-f
DO:
   pname[1]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[1]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 1, 
      	       	       INPUT crc[1]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[1]). 
END.

ON PUT OF pname[2] IN FRAME frame-f,
          override[2] IN FRAME frame-f,
      	  crc[2] IN FRAME frame-f
DO:
   pname[2]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[2]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 2, 
      	       	       INPUT crc[2]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[2]). 
END.

ON PUT OF pname[3] IN FRAME frame-f,
          override[3] IN FRAME frame-f,
      	  crc[3] IN FRAME frame-f
DO:
   pname[3]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[3]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 3, 
      	       	       INPUT crc[3]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[3]). 
END.

ON PUT OF pname[4] IN FRAME frame-f,
          override[4] IN FRAME frame-f,
      	  crc[4] IN FRAME frame-f
DO:
   pname[4]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[4]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 4, 
      	       	       INPUT crc[4]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[4]). 
END.

ON PUT OF pname[5] IN FRAME frame-f,
          override[5] IN FRAME frame-f,
      	  crc[5] IN FRAME frame-f
DO:
   pname[5]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[5]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 5, 
      	       	       INPUT crc[5]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[5]). 
END.

ON PUT OF pname[6] IN FRAME frame-f,
          override[6] IN FRAME frame-f,
      	  crc[6] IN FRAME frame-f
DO:
   pname[6]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[6]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 6, 
      	       	       INPUT crc[6]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[6]). 
END.

ON PUT OF pname[7] IN FRAME frame-f,
          override[7] IN FRAME frame-f,
      	  crc[7] IN FRAME frame-f
DO:
   pname[7]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[7]:SCREEN-VALUE IN FRAME frame-f).

   RUN Edit_Trig_Code (INPUT 7, 
      	       	       INPUT crc[7]:HANDLE IN FRAME frame-f,
      	       	       INPUT FRAME frame-f pname[7]). 
END.

/*----- GO or OK of TRIGGER FRAME -----*/
ON GO OF FRAME frame-f
DO:
   pname[1]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[1]:SCREEN-VALUE IN FRAME frame-f).
   pname[2]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[2]:SCREEN-VALUE IN FRAME frame-f).
   pname[3]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[3]:SCREEN-VALUE IN FRAME frame-f).
   pname[4]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[4]:SCREEN-VALUE IN FRAME frame-f).
   pname[5]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[5]:SCREEN-VALUE IN FRAME frame-f).
   pname[6]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[6]:SCREEN-VALUE IN FRAME frame-f).
   pname[7]:SCREEN-VALUE IN FRAME frame-f = 
      TRIM(pname[7]:SCREEN-VALUE IN FRAME frame-f).

   DO i = 1 TO 7:
      {prodict/user/usertrig.i
         &Frame	      = "FRAME frame-f"
         &pname	      = "pname[i]"
         &override    = "override[i]"
         &crc	      = "crc[i]"
         &new_crc_val = "new_crc_val[i]"
         &old_crc_val = "old_crc_val[i]"
         &changed     = touched}
   END.

   /* replace altered trigger definitions */
   DO ON ERROR UNDO, LEAVE:
     DO i = 1 TO 7:
        pname[i] = INPUT FRAME frame-f pname[i].
        FIND FIRST wfit WHERE wfit._Event = events[i] NO-ERROR.
        IF (pname[i] = "" OR pname[i] = ?) AND AVAILABLE wfit THEN
          DELETE wfit.
        IF pname[i] <> "" AND pname[i] <> ? AND NOT AVAILABLE wfit THEN
          CREATE wfit.
        IF AVAILABLE wfit THEN 
        DO:
          ASSIGN
            wfit._Event = events[i]
            wfit._Proc-Name = pname[i]
            wfit._Override  = INPUT FRAME frame-f override[i]
            wfit._Trig-CRC = (IF INPUT FRAME frame-f crc[i] 
      			THEN new_crc_val[i] ELSE ?).
        END.
     END.
     RETURN.
   END.

   /* There was an error */
   RETURN NO-APPLY.
END.

/*----- VALUE-CHANGED of CHECK CRC TOGGLE -----*/
on leave of crc[1],crc[2],crc[3],crc[4],crc[5],crc[6],crc[7] in frame frame-f
do:
   /* If user wants to check crc and it was not on before
      he must compile before saving.  Make sure compile can succeed.
   */
   if SELF:screen-value = "yes" AND NOT committed then
   do:
      /* It won't compile so put up error and reset crc to no */
      { prodict/user/usertrgw.i &widg = SELF }
   end.
end.





/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: user-s.i  (table string attributes dialog box)

Description:   
   Display and handle the dialog box for specifying string attributes
   for a table.

Author: Laura Stern

Date Created: 04/05/93 

----------------------------------------------------------------------------*/

FORM
   SKIP(1)
   "String attribute options are:"      at 2 view-as TEXT   SKIP
   "T, R, L, C, U and # of characters." at 2 view-as TEXT   SKIP({&VM_WIDG})

   wfil._File-Label-SA	colon 20 label "Label"    	    SKIP(0.1)
   wfil._Valmsg-SA	colon 20 label "Validation Message" SPACE(1)
   {prodict/user/userbtns.i}
   with frame tbl_string_attrs
   SIDE-LABELS DEFAULT-BUTTON btn_OK
   view-as DIALOG-BOX TITLE "Table String Attributes".

/* Adjust the position of the ok and cancel buttons */
{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME tbl_string_attrs"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}
   

Procedure Tbl_String_Attrs:
   do ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
      IF wfil._File-Label-SA = ? THEN wfil._File-Label-SA = "".
      IF wfil._Valmsg-SA = ? THEN wfil._Valmsg-SA = "".

      update wfil._File-Label-SA when romode = 0
	     wfil._Valmsg-SA	 when romode = 0
	     btn_OK  	      	 when romode = 0
	     btn_Cancel
	     with frame tbl_string_attrs.
   end.
   
   hide frame tbl_string_attrs.
end.



/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
-------------------------------------------------------------------------------
VALIDATION:
-----------

Enter the message to be displayed for disallowed deletions.
     Valmsg: _______________________________________________________________

Enter an expression that must be TRUE to allow record deletions.
     Valexp: _______________________________________________________________
             _______________________________________________________________
             _______________________________________________________________
             _______________________________________________________________


[^Table-Triggers] [^Description]
-------------------------------------------------------------------------------
*/

FORM
  SKIP(1)
  "Enter the message to be displayed for disallowed deletions." SKIP
  wfil._Valmsg    VIEW-AS EDITOR
                  INNER-CHARS 63 INNER-LINES 2
                  BUFFER-LINES 4 COLON 10 SKIP (1)

  "Enter an expression which must be TRUE to allow record deletions." SKIP
  wfil._Valexp    VIEW-AS EDITOR
      	       	  INNER-CHARS 63 INNER-LINES 2 
      	       	  BUFFER-LINES 4  COLON 10  

  {prodict/user/userbtns.i}
  WITH FRAME frame-v
    ATTR-SPACE SIDE-LABELS VIEW-AS DIALOG-BOX TITLE "Table Validation"
    ROW 5 COLUMN 2 WIDTH 78.

{adecomm/okrun.i  
   &BOX    = "rect_Btns"
   &FRAME  = "FRAME frame-v"
   &OK     = "btn_OK"
   &CANCEL = "btn_Cancel"}


PROCEDURE Tbl_Validation:
  VIEW FRAME frame-v.

  IF romode = 0 THEN
    HIDE MESSAGE NO-PAUSE.

  DISPLAY
    wfil._Valmsg
    wfil._Valexp
    WITH FRAME frame-v.

  UPDATE
    wfil._Valmsg        WHEN romode = 0
    wfil._Valexp   	WHEN romode = 0
    btn_OK btn_Cancel
    WITH FRAME frame-v.

  touched = touched
         OR FRAME frame-v wfil._Valmsg ENTERED
         OR FRAME frame-v wfil._Valexp ENTERED.

  IF romode = 0 THEN 
    IF wfil._Valexp = "" THEN wfil._Valexp = ?.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: userbtns.i

Description:   
   Adds an OK and Cancel button and the rectangle that underlies them,
   to a frame.  

Text-Parameters:
    &OTHER      other buttons for both TTY AND GUI frames
    &OTHERGUI   other buttons for GUI frames ONLY
    &OTHERTTY   other buttons for TTY frames ONLY
    
Author: Laura Stern

Date Created: 11/17/92 

Modified:
    hutegger    94-09-12    added text-parameters which can get omitted
    
----------------------------------------------------------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   {adecomm/okform.i
      &BOX    = rect_btns
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      &OTHER  = " {&OTHER}{&OTHERGUI}"
      &HELP   = btn_Help}
&ELSE
   {adecomm/okform.i
      &STATUS = no
      &OK     = btn_OK
      &CANCEL = btn_Cancel
      &OTHER  = " {&OTHER}{&OTHERTTY}"}
&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* usercon.i - displays current dbname and dbtype */

DISPLAY
  user_dbname + (IF user_dbname = "" THEN "" ELSE " ("
    + ( IF CONNECTED(user_dbname) 
         THEN CAPS({adecomm/ds_type.i
                     &direction = "itoe"
                     &from-type = "user_dbtype"
                     }) 
         ELSE LC  ({adecomm/ds_type.i
                     &direction = "itoe"
                     &from-type = "user_dbtype"
                     })
      )
    + ")") @ user_dbname
  {*}
  WITH FRAME user_ftr.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* userctr.i - dictionary user interface code to center frame--use this
   only when the frame is pretty large--TTY centering algorithm can put
   the frame just a hair below the menubar, which looks non-optimal.
   This code will move it down, so that the frame partially obscures
   the message line and status line--this looks better than being
   cheek-to-jowl with the menubar.  For shorter frames, the normal
   TTY centering algorithm works better. */

/**
** PARAMETERS:
** &FRAME    widget name of the frame to be centered
**/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    {&FRAME}:ROW = 2 + (CURRENT-WINDOW:HEIGHT - {&FRAME}:HEIGHT) / 2.
&ENDIF

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* userfchg.i - performs routine for the different db mgrs */

{4} = FALSE.

RUN VALUE("prodict/" +  
  IF   _File._Db-lang > 0            THEN "pro/_pro_sql.p"
  ELSE IF user_dbtype = "ORACLE"     THEN "ora/_ora_fld.p"
  ELSE IF CAN-DO(odbtyp,user_dbtype) THEN "odb/_odb_fld.p"
  ELSE IF user_dbtype = "AS400"      THEN "as4/_as4_fld.p"
  ELSE                                    "pro/_pro_fld.p")
  ("{2}",{3},OUTPUT {4}).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* userhdr.f - user interface shared frame definitions */

DEFINE {1} SHARED FRAME user_hdr.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  
  FORM
    user_hdr FORMAT "x(60)" 
    "Data Dictionary "
    WITH FRAME user_hdr 
    ROW SCREEN-LINES - 1 COLUMN 1 
    NO-BOX ATTR-SPACE NO-LABELS USE-TEXT
    COLOR DISPLAY VALUE(head-bg) PROMPT VALUE(head-bg).
&ENDIF

DEFINE {1} SHARED FRAME user_ftr.
FORM
  user_dbname   FORMAT "x(28)" LABEL "Database"
  user_filename FORMAT "x(34)" LABEL "Table"
  WITH FRAME user_ftr 
  ROW SCREEN-LINES COLUMN 1 &if "{&window-system}" = "ms-windows" &then width 95 &endif
  NO-BOX NO-ATTR-SPACE SIDE-LABELS USE-TEXT.

COLOR DISPLAY VALUE(head-fg) user_dbname user_filename WITH FRAME user_ftr.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  ASSIGN
    user_hdr = {1}.
  DISPLAY user_hdr WITH FRAME user_hdr.
&ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* userhue.i - color settings */

DEFINE {1} SHARED VARIABLE menu-fg AS CHARACTER INITIAL "NORMAL"   NO-UNDO.
DEFINE {1} SHARED VARIABLE menu-bg AS CHARACTER INITIAL "MESSAGES" NO-UNDO.
DEFINE {1} SHARED VARIABLE dbox-fg AS CHARACTER INITIAL "NORMAL"   NO-UNDO.
DEFINE {1} SHARED VARIABLE dbox-bg AS CHARACTER INITIAL "MESSAGES" NO-UNDO.
DEFINE {1} SHARED VARIABLE head-fg AS CHARACTER INITIAL "NORMAL"   NO-UNDO.
DEFINE {1} SHARED VARIABLE head-bg AS CHARACTER INITIAL "MESSAGES" NO-UNDO.
DEFINE {1} SHARED VARIABLE pick-fg AS CHARACTER INITIAL "NORMAL"   NO-UNDO.
DEFINE {1} SHARED VARIABLE pick-bg AS CHARACTER INITIAL "MESSAGES" NO-UNDO.
/*********************************************************************
* Copyright (C) 2006-2013 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------
File: usermenu.i

Description:
   This include file contains the definition of the Admin menu and the
   Dictionary menu for the TTY version.
 
Arguments:
   {1} - this is either "NEW" or nothing.

Author: Laura Stern

HISTORY
mcmann   03/06/03   Remove the DB2/400 DataServer Utilities
mcmann   04/23/02   Change where schema lock is taken for on-line schema adds
mcmann   03/26/99   Added support for MS SQL Server 7 Utilities
McMann   02/01/00   Added Oracle Bulk Insert Menu Option
Mario B. 05/19/99   Adjust Width Field browser integration.
mcmann   08/24/98   Added incremental df migration for Oracle
mcmann   06/29/98   Added ProToOdbc in ODBC DataServer menu
mcmann   06/05/98   DICTDB was being assigned to a foreign database which
                    caused an error message to be display when trying to
                    access DataServer utilities. 98-04-28-005 96-10-17-026
laurief  04/09/98   Changed user_env[1] from "a" to "s" for the following
                    utilities to allow users to select/deselect multiple
                    tables (BUG 97-07-22-029).  Utilities include Dump
                    Definitions
mcmann   02/11/98   Changed user_env[1] for dump dfs to s from a 97-07-22-029
mcmann   01/07/98   Added Storage Area Report
hutegger 96/09      removed DB2 and DB2-DRDA again
tomn     07/96      Changed "menu graying" logic (Menu_Walk) so that a menu item
                    will be disabled if all of its children are disabled.  This
                    is an MS-Windows standard, which has a side-effect on TTY
                    since there is no visual cue that a menu item is disabled.
tomn     07/96      Added "Schema Migration Tools" pop-up menu to MS-SQL, ORACLE,
                    and SYBASE sub-menus.  This menu is essentially 3 of the 4
                    individual steps of the "PROTOXXX" utility: Generate DDL,
                    Send SQL, and Adjust Schema (Beautify).  The fourth
                    step is Create Schema Image, which is already on the previous
                    menu.  Also on this menu is the combined "PROTOXXX" utility.
tomn     07/96      Reordered DataServer main menu in alphabetic order.
DLM      06/96      Removed DB2/400 V6 Utilities and Allbase reference
sjp      06/96      Added db type DB2-DRDA. Re-used DB2 for DB2 with ODBC.
                    DB2-DRDA is older, native DB2 dataserver.
DLM      05/96      Changed system check to be begins ms-win instead of =
tomn     03/96      Removed dataserver name from submenu label to shorten length
tomn     03/96      Removed Sybase4 from menu; Changed Sybase10 menu labels to
                    "Sybase" (Sybase4 was "Sybase" and Sybase10 was "Sybase-10")
hutegger 95/11      added MSSQL-menu plus /*###*/ to indicate where
                    changes are needed when adding a new DataServer
                    (Don't forget adecomm/ds_type.i & prodict/dictgate.i!)
hutegger 95/09      removed netisam and ctos-isam, also V5-dump 
trb      05/05/95   Updated AS400 V7 Utilities.
nhorn    11/14/94   Added AS400 V7 Utilities. Took out Allbase Utilities.
gfs      11/01/94   Fixed wording on menu.
gfs      07/22/94   Changed mneumonic on "Change" from "g" to "h" for
                    better readability.
mcmann  02/15/01    Added schema migration menu for DB2/400    
mcmann  03/05/02    Added new user_path for loading objects without getting
                    a schema lock.  The *T option is moved to _usrload.p      
mcmann  12/03/02    Added Delta SQL Utility to MSS     
McMann  02/21/03    Replaced GATEWAYS with DATASERVERS      
McMann  02/24/03    Removed depreciated DataServers                   
kmcintos 04/04/05   Added menus, menu-items and logic support for auditing
kmcintos 04/20/05   Removed directory check and refined logic for performance
                    when menu-item requires _db-detail, _aud or _sec
kmcintos 04/28/05   Changed dump and security options to set user_env[9]
                    before call to _usrtget & _guitget. 20050427-022
kmcintos 04/30/05   Added code to rerun menu initialization proc after changing
                    DICTDB.
kmcintos 04/30/05   Added code to db disconnect, db connect and db create to 
                    rerun menu initialization process.
kmcintos 05/24/05   Changed Dump/Load DB Id Records to Dump/Load Db Id 
                    Properties. 20050505-019                    
kmcintos 07/19/05   Re-Fixed bug 20050301-003.
kmcintos 08/18/05   Added Audit Policy Refresh after load 20050629-018.
kmcintos 09/01/05   Moved setting of user_env[9] to before call to table list
                    20050831-019.
kmcintos 10/28/05   Changed audit event inserter perm requirement to audit admin
                    bug # 20051026-058.
fernando 01/04/06   Changes for 20051230-006.
fernando 06/09/06   Support for large key entries
fernando 06/23/08   Support for encryption
fernando 04/07/09   Added Alternate Buffer Pool utilities
kmayur   06/21/11   Added options for constraint creation (Server Attributes in Dataserver) OE00195067
rkamboj  08/16/11   Added new terminology for security items and windows. 

Date Created: 01/04/93 
----------------------------------------------------------------------------*/

{prodict/misc/misc-funcs.i}
{prodict/sec/sec-func.i}

/*===========================Variables==================================*/

/*---------------------------------------------------------------------
   This will be filled with the menu handles for each menu-item.  After
   the initial graying phase, elements for menu-items that will NEVER
   be activated for this version of progress will be set to ?.
---------------------------------------------------------------------*/
Define var Menu_Hdl as widget-handle extent /*170*/ 200 NO-UNDO.  /* tsn 7/96 */

/* Indexes into the Menu_Hdl array and the ?_Gray arrays. */
Define var All_Items_ix as integer NO-UNDO init 0. /* idx into Menu_Hdl */
Define var Submenu_ix         as integer NO-UNDO init 0. /* idx into ?_Gray array */

/* This is used after running another ADE tool */
Define var num_connected as integer NO-UNDO.

/*------------------------------------------------------------------------
   This array is used to determine what should be grayed when we are
   running a particular version of Progress.  There is an array element 
   for each sub-menu.  The value of the array element is a comma 
   delimited list, with a value for each menu item.  (A rule is considered
   a menu item!)  Each of these values is a combination of the letters FCXQRN.
   Each letter represents a configuration of Progress as shown below.  If the 
   letter is present, it means that this menu item should be enabled for 
   this Progress.  Otherwise, it is replaced with a "-".  So FCX--- means 
   that we enable this menu item only for Full, Compile and Compile-Encrypted 
   Progress.

   The code letters are as follows:
      F = FULL PROGRESS
      C = COMPILE-ONLY PROGRESS

      X = COMPILE-ENCRYPT PROGRESS
      Q = QUERY/REPORT PROGRESS
      R = RUN-TIME PROGRESS
      N = PROGRESS w/no database connected 
      A = Requires Audit tables be present in the database
      Z = Requires _db-detail table be in the database
      B = Requires _db-option table be in the database
      Y = Requires Security tables be present in the database
      E = Requires db that has Encryption capabilities
      M = Requires sys admin user (only for PROGRESS db type)
      
   *****************************IMPORTANT***************************
   The order of submenus was generated by the same tree walk 
   that will be used to process the list for graying.
   If any menus/menu items are added, removed or re-ordered, this 
   table must be updated. Also need to fix MSSQL_IX, etc below to
   match new position of DataServer menus.
   ******************************************************************
---------------------------------------------------------------------------*/
Define var Gray_Table as char extent 32 NO-UNDO init /*###*/
[
   /*Database  */ "FCXQR-,FCXQRN,FCXQRN,FCXQR-,FCXQRN",       
   /*Reports   */ "FCXQR-,FCXQR-,FCXQR-,FCXQR-,FCXQR-,FCXQR-,FCXQR-,FCXQ--,FCXQR-,FCXQR-,FCXQR-,FCXQRM-,------,------",
   /*Auditing Reports */ "FCXQR-A,FCXQR-A,FCXQR-A,FCXQR-A,------,FCXQR-A,FCXQR-A,FCXQR-A,FCXQR-A,------,FCXQR-A,FCXQR-A,FCXQR-A,------,FCXQR-A,FCXQR-A,FCXQR-A,------,FCXQR-A",
   /*Encryption Policy Reports */ "FCXQR-E,FCXQR-E",
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   /*&Schema   */ "FCXQR-,FCX---,FCX---,FCXQR-,FCX---,FCX---,FCXQR-,FCXQR-,FCXQR",         
  &ENDIF
   /*Admin     */ "FCX---,FCX---B,FCX----",
   /*Dump      */ "FCX---,F-----,FCX---,------,FCX---,FCXQR-Y,FCXQR-Y,------,FCX---,FCX---,FCX---,F-----,FCXQR-Z,FCXQR-B,------,FCXQR-A,------,FCX---",
   /*Audit Policies*/ "FCXQR-A,FCXQR-A,-------,FCXQR-A",
   /*Load      */ "FCX---,F-----,FCX---,------,FCX---,FCXQR-Y,FCXQR-Y,------,F-----,FCX---,FCXQR-Z,FCXQR-B,------,FCXQR-A",   
   /*Audit Policies*/ "FCXQR-A,FCXQR-A,-------,FCXQR-A",
   /*DB Identification*/ "FCX---Z,FCX---Z",
   /*Security  */ "FCXQ--,FCXQ--,FCXQ--,FCXQ--A,FCXQ--,FCXQ--,FCXQ--,------,------",
   /*Auth Systems */ "FCXQ--Y,FCXQ--Y",
   /*Encryption Policies */ "FCX--E,FCX--E,FCX--E",
   /*Export    */ "F-----,F-----,F-----,F-----",          
   /*Import    */ "F-----,F-----,F-----,F-----,F-----,F-----",    
   /*AltBufPool*/ "FCX--M",
   /*DataServer*/ "",
   /*MSSQL Util*/ "FCX---,FCX---,FCX---,FCX---,FCX---,FCX---,FCX---,------,FCX---",
   /*OE00195067 MSSQL Server Attributes */ "FCX---,FCX---,FCX---,FCX---",  
   /*MSSQL Tool*/ "FCX---,FCX---,FCX---",    
   /*Odb Util  */ "FCX---,FCX---,FCX---,FCX---,FCX---,FCX---,------,FCX---",
   /*Odb Tools */ "FCX---,FCX---",
   /*ORA Util  */ "FCX---,FCX---,FCX---,FCX---,FCX---,FCX---,FCX---,------,FCX---",
   /*OE00195067 ORACLE Server Attributes */ "FCX---,FCX---,FCX---",
   /*ORA Tools */ "FCX---,FCX---,FCX---,FCX---",
   /*Utilities */ "FCXQ-N,------,FCX---,FCX---,FCX---,------,FCXQ-N",
   /*Quoter    */ "FCXQ-N,FCXQ-N,FCXQ-N,FCXQ-N", 
   /*Incl File */ "FCXQ--,FCXQ--,FCXQ--", 
   /*PRO/SQL   */ "FCXQR-,FCXQ--,FCXQ--"
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   ,
   /*&Help     */ "FCXQRN,FCXQRN,FCXQRN,FCXQRN,FCXQRN,FCXQRN,FCXQRN"  
  &ENDIF
   ].

/* These are array indices for the DataServer sub-menus in Gray_Table.
*/
&IF "{&WINDOW-SYSTEM}" = "TTY" /*###*/
 &THEN
 &global-define MSSQL_IX       18 /* tools 19 */ 
 &global-define ODBC_IX        20 /* tools 21 */
 &global-define ORACLE_IX      22 /* tools 23 */
 &ELSE                         /*###*/                       
  &global-define MSSQL_IX       17 /* tools 18 */
  &global-define ODBC_IX        19 /* tools 20 */
  &global-define ORACLE_IX      21 /* tools 22 */
&ENDIF

/*=============================Menu Definitions==========================*/

/* standard tools menu */
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   {adecomm/toolmenu.i 
      &EXCLUDE_ADMIN = yes
      &EXCLUDE_DICT  = yes
   }
&ELSE 
   {adecomm/toolmenu.i 
      &EXCLUDE_ADMIN = yes
   }
&ENDIF

DEFINE SUB-MENU mnu_Aud_Rep
   MENU-ITEM mi_Rpt_AudPol    LABEL "Track Audit &Policy Changes"
   MENU-ITEM mi_Rpt_DbSchma   LABEL "Track Database &Schema Changes"
   MENU-ITEM mi_Rpt_AudAdmn   LABEL "Track &Audit Data Administration (Dump/Load)"
   MENU-ITEM mi_Rpt_TblAdmn   LABEL "Track Application &Data Administration (Dump/Load)"
   RULE
   MENU-ITEM mi_Rpt_UsrAct    LABEL "Track &User Account Changes"
   MENU-ITEM mi_Rpt_SecPerm   LABEL "Track Security Per&missions Changes"
   MENU-ITEM mi_Rpt_Dba       LABEL "&Track SQL Permissions Changes"
   MENU-ITEM mi_Rpt_AuthSys   LABEL "Track Authe&ntication System Changes"
   RULE
   MENU-ITEM mi_Rpt_CltSess   LABEL "&Client Session Authentication Report"
   MENU-ITEM mi_Rpt_DbAdmin   LABEL "Database Administ&ration Report (Utilities)"
   MENU-ITEM mi_Rpt_AppLogin  LABEL "Database Access Report (Lo&gin/Logout/etc...)"
   RULE
   MENU-ITEM mi_Rpt_EncPol    LABEL "Track &Encryption Policy Changes"
   MENU-ITEM mi_Rpt_KeyStore  LABEL "Track &Key Store Changes"
   MENU-ITEM mi_Rpt_EncAdmin  LABEL "Database Encr&yption Administration (Utilities)"
   RULE
   MENU-ITEM mi_Rpt_Cust      LABEL "Custom Audit Data &Filter Report".

DEFINE SUB-MENU mnu_Enc_Rep
    MENU-ITEM mi_Rpt_QkEncPol   LABEL "&Quick Encryption Policies"
    MENU-ITEM mi_Rpt_DtEncPol   LABEL "&Detailed Encryption Policies".

/*--------------------Database and its Sub-menus-------------------------*/
Define sub-menu mnu_Reports        
   menu-item mi_Rpt_DetTbl    label "&Detailed Table"
   menu-item mi_Rpt_Table     label "Quick &Table"
   menu-item mi_Rpt_Field     label "Quick &Field"
   menu-item mi_Rpt_Index     label "Quick &Index"
   menu-item mi_Rpt_View      label "PRO/SQL &View"
   menu-item mi_Rpt_Sequence  label "&Sequence"
   menu-item mi_Rpt_Trigger   label "Tri&gger"
   menu-item mi_Rpt_User      label "&User"
   menu-item mi_Rpt_TblRel    label "Table &Relations"
   menu-item mi_Rpt_Area      label "Storage &Areas"
   MENU-ITEM mi_Rpt_Width     LABEL "Verify Data &Width"
   MENU-ITEM mi_Rpt_AltBufPool LABEL "Alternate &Buffer Pool"
   RULE
   SUB-MENU  mnu_Aud_Rep      LABEL "Auditing R&eports"
   SUB-MENU  mnu_Enc_Rep      LABEL "Encryption &Policy Reports".

Define sub-menu mnu_Database
   menu-item mi_DB_Select     label "&Select Working Database..."
   menu-item mi_DB_Create     label "&Create..."
   menu-item mi_DB_Connect    label "Co&nnect..." 
   menu-item mi_DB_Disconnect label "&Disconnect..."
   sub-menu  mnu_Reports      label "&Reports"   
   menu-item mi_Exit          label "E&xit"
   .

/*---------------------------Schema Menu----------------------------------*/
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
Define sub-menu mnu_Schema
   menu-item mi_Sch_ModTbl    label "&Modify Table..."
   menu-item mi_Sch_AddTbl    label "&Add New Table..."
   menu-item mi_Sch_DelTbl    label "&Delete Table(s)..."
   menu-item mi_Sch_FldEdit   label "&Field Editor..."     
   menu-item mi_Sch_ReordFld  label "&Reorder Fields..."
   menu-item mi_Sch_RenamFld  label "&Global Field Name Change..."
   menu-item mi_Sch_IdxEdit   label "&Index Editor..."
   menu-item mi_Sch_SeqEdit   label "&Sequence Editor..."
   menu-item mi_Sch_SQL       label "Adjust Field &Width..."
   .
&ENDIF
    
/*-----------------Admin Menu and its Sub-menus---------------------------*/

DEFINE SUB-MENU mnu_Dump_Aud_Pol
   MENU-ITEM mi_Dump_as_XML   LABEL "Dump as &XML (.xml file)..."
   MENU-ITEM mi_Dump_as_Txt   LABEL "Dump as &Text (.ad file)..."
   RULE
   MENU-ITEM mi_Dump_Evt      LABEL "Application Audit &Events...".
   
Define sub-menu mnu_Dump
   menu-item mi_Dump_Defs     label "&Data Definitions (.df file)..."
   menu-item mi_Dump_Contents label "&Table Contents (.d file)..."
   menu-item mi_Dump_Views    label "SQL &Views..."
   RULE
   menu-item mi_Dump_User     label "&User Table Contents..."
   MENU-ITEM mi_Dump_Sec_Auth LABEL "Securit&y Domains..." /* Security Aut&hentication Records..." */
   MENU-ITEM mi_Dump_Sec_Perm LABEL "Security Per&missions..."
   RULE
   menu-item mi_Dump_AutoConn label "Auto-Conn&ect Records only..."
   menu-item mi_Dump_CollTran label "&Collation Tables..."
   menu-item mi_Dump_SeqDefs  label "&Sequences Definitions..."
   menu-item mi_Dump_SeqVals  label "Se&quences Current Values..."
   MENU-ITEM mi_Dump_DB_Ids   LABEL "Database Identi&fication Properties..."
   MENU-ITEM mi_Dump_DB_Opt   LABEL "Database &Options..."
   RULE
   SUB-MENU mnu_Dump_Aud_Pol  LABEL "Audit &Policies"
   MENU-ITEM mi_Dump_Aud_Data LABEL "&Audit Data..."
   RULE
   menu-item mi_Dump_IncrDF   label "Create &Incremental .df File..."
   .

DEFINE SUB-MENU mnu_Load_Aud_Pol
   MENU-ITEM mi_Load_XML      LABEL "Load &XML (.xml file)..."
   MENU-ITEM mi_Load_Txt      LABEL "Load &Text (.ad file)..."
   RULE
   MENU-ITEM mi_Load_Evt      LABEL "Application Audit &Events...".
      
Define sub-menu mnu_Load
   menu-item mi_Load_Defs     label "&Data Definitions (.df file)..."
   menu-item mi_Load_Contents label "&Table Contents (.d file)..."
   menu-item mi_Load_Views    label "SQL &Views..."
   RULE
   menu-item mi_Load_User     label "&User Table Contents..."
   MENU-ITEM mi_Load_Sec_Auth LABEL "Securit&y Domains..." /* "Security Aut&hentication Records..." */
   MENU-ITEM mi_Load_Sec_Perm LABEL "Security Per&missions..."
   RULE
   menu-item mi_Load_SeqVals  label "&Sequences Current Values..."
   menu-item mi_Load_BadRecs  label "&Reconstruct Bad Load Records..."
   MENU-ITEM mi_Load_DB_Ids   LABEL "Database Identi&fication Properties..."
   MENU-ITEM mi_Load_DB_Opt   LABEL "Database &Options..."
   RULE
   SUB-MENU  mnu_Load_Aud_Pol LABEL "Audit &Policies"
   MENU-ITEM mi_Load_Aud_Data LABEL "Aud&it Data..."
   .

DEFINE SUB-MENU mnu_dbid
   MENU-ITEM mi_db_id_maint LABEL "Database Identification &Maintenance..."
   MENU-ITEM mi_db_id_hist  LABEL "Database Identification &History..."
   .

DEFINE SUB-MENU mnu_auth_maint
    MENU-ITEM mi_auth_sys       LABEL "&Authentication Systems..." /* "Security Authentication &Systems..." */
    MENU-ITEM mi_auth_dom       LABEL "&Domains..." /* Authentication System &Domains..." */ .

DEFINE SUB-MENU mnu_Enc_Policies
    MENU-ITEM mi_encpol_edit     LABEL "&Edit Encryption Policy..."
    MENU-ITEM mi_encpol_regen    LABEL "&Generate Encryption Keys..."
    MENU-ITEM mi_encpol_history  LABEL "&Encryption Policy History...".

Define sub-menu mnu_Security
   menu-item mi_Sec_EditUser  label "&Edit User List..."
   menu-item mi_Sec_Password  label "Change Your &Password..."
   menu-item mi_Sec_DataSec   label "Edit Data &Security..."
   MENU-ITEM mi_Sec_Aud_Perm  LABEL "Edit Au&dit Permissions..."
   menu-item mi_Sec_Adminors  label "Security &Administrators..."
   menu-item mi_Sec_BlankId   label "Disallow &Blank Userid Access..."
   menu-item mi_Sec_UserRpt   label "&User Report..."
   RULE
   SUB-MENU  mnu_auth_maint   LABEL "Domain &Maintenance" /* "Authentication System &Maintenance" */
   SUB-MENU  mnu_Enc_Policies LABEL "En&cryption Policies"
   .
        
Define sub-menu mnu_Export
   menu-item mi_Exp_DIF              label "&DIF..."
   menu-item mi_Exp_SYLK      label "&SYLK..."
   menu-item mi_Exp_ASCII     label "&Text..."
   menu-item mi_Exp_MSWord    label "&Microsoft Word Merge Data..."
   .

Define sub-menu mnu_Import
   menu-item mi_Imp_DIF              label "&DIF..."
   menu-item mi_Imp_SYLK      label "&SYLK..."
   menu-item mi_Imp_ASCII     label "Delimited &Text..."
   menu-item mi_Imp_FixedLen  label "&Fixed-Length..."
   menu-item mi_Imp_dBASEDefs label "d&BASE Definitions..."
   menu-item mi_Imp_dBASECont label "dBASE File &Contents..."
   .

Define sub-menu mnu_AltBuf
    menu-item mi_AltBuf_Maint label "Alternate Buffer Pool Maintenance"
    .

Define sub-menu mnu_Admin
   sub-menu  mnu_Dump         label "&Dump Data and Definitions"
   sub-menu  mnu_Load         label "&Load Data and Definitions"
   SUB-MENU  mnu_dbid         LABEL "Database Identi&fication"
   sub-menu  mnu_Security     label "&Security"
   sub-menu  mnu_Export       label "&Export Data"
   sub-menu  mnu_Import       label "&Import Data"
   menu-item mi_BulkLoad      label "Create &Bulk Loader Description File..."
   MENU-ITEM mi_DbOptions     LABEL "Database &Options..."
   MENU-ITEM mi_LargeKeys     LABEL "Enable Large &Key Entries"
   sub-menu  mnu_AltBuf       label "&Alternate Buffer Pool"
   .

/*== Pop-up menus for "protoxxx" tools -  MS-SQL ==*/
/* OE00195067 */
Define sub-menu mnu_mss_srv_attr  
   menu-item mi_mss_viw_mnt_cnst         label "View/Maintain Foreign Constraint Definitions..."
   menu-item mi_mss_active_all_cnst      label "Activate/Deactivate Constraint Definitions..."
   menu-item mi_mss_delete_all_cns       label "Delete Constraint Definitions..."
   menu-item mi_mss_gen_cnst_frm_rowid   label "Generate Constraints from ROWID..."
   .
/* OE00195067 */

Define sub-menu mnu_mss_tools 
   menu-item mi_mss_Migrate   label "&OpenEdge DB to MS SQL Server..."
   menu-item mi_mss_Incre     label "&Generate Delta.sql OpenEdge to MSS..." 
   menu-item mi_mss_AdjstSI   label "&Adjust Schema..."
   .
/*== Pop-up menus for "protoxxx" tools -  ODBC ==*/

Define sub-menu mnu_odb_tools
   menu-item mi_odb_DBtoodb    label "&OpenEdge DB to ODBC..."
   MENU-ITEM mi_odb_AdjstSI    LABEL "&Adjust Schema..."
   .

/*== Pop-up menus for "protoxxx" tools -  Oracle ==*/

/* OE00195067 */
Define sub-menu mnu_ora_srv_attr  
   menu-item mi_ora_viw_mnt_cnst         label "View/Maintain Foreign Constraint Definitions..."
   menu-item mi_ora_active_all_cnst      label "Activate/Deactivate Constraint Definitions..."
   menu-item mi_ora_delete_all_cns       label "Delete Constraint Definitions..."
   .

Define sub-menu mnu_ora_tools
   menu-item mi_ora_DBtoORA   label "&OpenEdge DB to ORACLE..."
   menu-item mi_ora_Incre     label "&Generate Delta.sql OpenEdge to ORACLE..." 
   menu-item mi_ora_AdjstSI   label "&Adjust Schema..."
   MENU-ITEM mi_ora_BInsert   LABEL "&Bulk Inserts..."
   .

Define sub-menu mnu_MSSQL
   menu-item mi_MSSQL_Create    label "&Create DataServer Schema..."
   menu-item mi_MSSQL_UpdFile   label "&Update/Add Table Definitions..."
   menu-item mi_MSSQL_VerFile   label "&Verify Table Definition..."
   menu-item mi_MSSQL_ConnInfo  label "&Edit Connection Information..."
   menu-item mi_MSSQL_ChgCP     label "C&hange DataServer Schema Code Page..."
   sub-menu mnu_mss_srv_attr    label "Server Attributes"  /* OE00195067 */
   menu-item mi_MSSQL_Delete    label "&Delete DataServer Schema..."
   RULE
   sub-menu mnu_mss_tools       label "Schema &Migration Tools"
   .

Define sub-menu mnu_Odbc
   menu-item mi_Odb_Create    label "&Create DataServer Schema..."
   menu-item mi_Odb_UpdFile   label "&Update/Add Table Definitions..."
   menu-item mi_Odb_VerFile   label "&Verify Table Definition..."
   menu-item mi_Odb_ConnInfo  label "&Edit Connection Information..."
   menu-item mi_odb_ChgCP     label "C&hange DataServer Schema Code Page..."
   menu-item mi_Odb_Delete    label "&Delete DataServer Schema..."
   RULE
   sub-menu mnu_odb_tools     label "Schema &Migration Tools"
   .

Define sub-menu mnu_ORACLE
   menu-item mi_ORA_Create    label "&Create DataServer Schema..."
   menu-item mi_ORA_UpdFile   label "&Update/Add Table Definitions..."
   menu-item mi_ORA_VerFile   label "&Verify Table Definition..."
   menu-item mi_ORA_ConnInfo  label "&Edit Connection Information..."
   menu-item mi_ORA_ChgCP     label "C&hange DataServer Schema Code Page..."
   menu-item mi_ORA_Delete    label "&Delete DataServer Schema..."
   sub-menu  mnu_ora_srv_attr label "Server Attributes"    /* OE00195067 */
   menu-item mi_ORA_SQLPlus   label "&Run ORACLE SQL*Plus..."
   RULE
   sub-menu mnu_ora_tools     label "Schema &Migration Tools"
   .


/*== DataServers Main Menu ==*/     /*###*/ /*###*/
Define sub-menu mnu_Gateway
   sub-menu mnu_MSSQL         label "MS S&QL Server Utilities"  
   sub-menu mnu_Odbc          label "O&DBC Utilities"
   sub-menu mnu_ORACLE        label "&ORACLE Utilities"
   .


/*---------------Utilities Menus and its sub-menus--------------------------*/

Define sub-menu mnu_Quoter
   menu-item mi_Quo_EntLines  label "&Entire Lines..."
   menu-item mi_Quo_Delimiter label "By &Delimiter..."
   menu-item mi_Quo_ColRanges label "By &Column Ranges..."
   menu-item mi_Quo_InclFile  label "Quoter &Include File..."
   .

Define sub-menu mnu_GenIncl
   menu-item mi_Incl_Assign   label "&ASSIGN Statement..."
   menu-item mi_Incl_FORM     label "&FORM Statement..."
   menu-item mi_Incl_WorkFile label "&DEFINE WORK-TABLE Statement..."
   .

Define sub-menu mnu_Utilities
   menu-item mi_Util_ParmFile label "Editor for &Parameter Files..."
   sub-menu  mnu_Quoter              label "&Quoter Functions"
   sub-menu  mnu_GenIncl      label "&Generate Include Files"
   RULE
   menu-item mi_Util_AutoConn label "Edit OpenEdge &Auto-Connect List..."
   menu-item mi_Util_Freeze   label "&Freeze/Unfreeze..."
   menu-item mi_Util_IdxDeact label "Index &Deactivation..."
   RULE
   menu-item mi_Util_Info     label "&Information..."
   .


/*---------------------------Other menus----------------------------------*/

Define sub-menu mnu_SQL
   menu-item mi_SQL_ViewRpt   label "PRO/SQL View &Report..."
   menu-item mi_SQL_DumpView  label "Dump as CREATE &VIEW Statement..."
   menu-item mi_SQL_DumpTable label "Dump as CREATE &TABLE Statement..."
   .

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
Define sub-menu mnu_Help SUB-MENU-HELP
   MENU-ITEM mi_Hlp_Master       LABEL "OpenEdge &Master Help"
   menu-item mi_Hlp_Topics       label "Data Administration &Help Topics"
   RULE 
   menu-item mi_Hlp_Messages     label "M&essages..."
   menu-item mi_Hlp_Recent       label "&Recent Messages..."
   RULE
   menu-item mi_Hlp_About        label "&About Database Administration".
&ENDIF


/*----------------------------Menu bar-----------------------------------*/
Define {1} shared menu mnu_Admin_Tool
   MENUBAR
   sub-menu mnu_Database    label "&Database"

   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   sub-menu mnu_Schema            label "&Schema"
   &ENDIF

   sub-menu mnu_Admin            label "&Admin"
   sub-menu mnu_Gateway     label "DataSer&ver"
   sub-menu mnu_Utilities   label "&Utilities"
   sub-menu mnu_SQL            label "&PRO/SQL"
   sub-menu mnu_Tools       label "&Tools"

   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
   sub-menu mnu_Help            label "&Help"
   &ENDIF
   .


/*==========================Internal Procedures==========================*/

/*----------------------------------------------------------------------
   Do_Menu_Item_Initial

   This is the function called for each menu item on the initial walk
   through the menus.

   Input Parameter:
      p_hdl    - Handle to a menu item
      p_sub_ix  - Index of the sub-menu being processed (in Gray_Table)
      p_item_ix - Index of the menu item within this sub-menu.
----------------------------------------------------------------------*/
Procedure Do_Menu_Item_Initial:
   Define INPUT parameter p_hdl      as widget-handle NO-UNDO.
   Define INPUT parameter p_sub_ix   as integer       NO-UNDO.
   Define INPUT parameter p_item_ix  as integer       NO-UNDO.

   Define var gray as integer NO-UNDO.  /*  0 = gray, 1 = don't gray */
   Define var code as char    NO-UNDO.  /* FCXQRN entry from gray table */
   
   DEFINE VARIABLE hBuffer  AS HANDLE NO-UNDO.
   DEFINE VARIABLE hBuffer2 AS HANDLE NO-UNDO.

   IF (NUM-ENTRIES(Gray_Table[p_sub_ix])>=p_item_ix) THEN
     code = ENTRY(p_item_ix, Gray_Table[p_sub_ix]).
   ELSE ASSIGN code = ?.

   case PROGRESS:
      when "Full" then
               gray = INDEX(code, "F").
      when "COMPILE" then 
               gray = INDEX(code, "C").
      when "COMPILE-ENCRYPT" then 
               gray = INDEX(code, "X").
      when "Query" then 
               gray = INDEX(code, "Q").
      when "Run-Time" then 
               gray = INDEX(code, "R").
     end.

   IF NUM-DBS > 0 AND
      (INDEX(code,"Y") > 0 OR
       INDEX(code,"Z") > 0 OR
       INDEX(code,"B") > 0 OR
       INDEX(code,"A") > 0 OR 
       INDEX(code,"M") > 0 OR
       INDEX(code,"E") > 0) THEN DO:
     CREATE BUFFER hBuffer FOR TABLE "DICTDB._file".
     
     IF INDEX(code,"Z") > 0 THEN DO:
       /* Check to see whether this menu item requires the _db-detail 
          table in the database */
       hBuffer:FIND-FIRST("WHERE _file._File-Name = ~'_db-detail~'",
                          NO-LOCK) NO-ERROR.
       IF NOT hBuffer:AVAILABLE THEN gray = 0.

     END. /* INDEX(code,"Z") > 0 */

     IF INDEX(code,"B") > 0 THEN DO:
       /* Check to see whether this menu item requires the _db-option 
          table in the database */
       hBuffer:FIND-FIRST("WHERE _file._File-Name = ~'_db-option~'",
                          NO-LOCK) NO-ERROR.
       IF NOT hBuffer:AVAILABLE THEN gray = 0.

     END. /* INDEX(code,"B") > 0 */

     IF INDEX(code,"A") > 0 THEN DO:
       /* Check to see whether this menu item requires any of the audit 
          tables to be in the database */
       hBuffer:FIND-FIRST("WHERE _file._file-name BEGINS ~'_aud~'",
                          NO-LOCK) NO-ERROR.
    
       IF NOT hBuffer:AVAILABLE THEN gray = 0.
     END. /* INDEX(code,"A") > 0 */

     IF INDEX(code,"E") > 0 THEN DO:
       /* Check to see whether this menu item requires encryption to be enabled */
       CREATE BUFFER hBuffer2 FOR TABLE "DICTDB._database-feature" NO-ERROR.
       IF VALID-HANDLE(hBuffer2) THEN DO:
          hBuffer2:FIND-FIRST("WHERE _database-feature._dbfeature_name = ~'encryption~'",
                             NO-LOCK) NO-ERROR.

          IF NOT hBuffer2:AVAILABLE OR hBuffer2::_dbfeature_enabled <> "1" THEN 
             ASSIGN gray = 0.
          ELSE DO:
              hBuffer2:BUFFER-RELEASE().

              /* can't maintain encryption if not local 
                 or not progress db or not sys admin */
              IF DBTYPE("DICTDB") NE "PROGRESS" OR 
                 user_dbtype NE "PROGRESS" OR
                 NOT dbAdmin(USERID("DICTDB")) THEN 
                 ASSIGN gray = 0.
          END.
          DELETE OBJECT hBuffer2 NO-ERROR.
       END.
       ELSE
           ASSIGN gray = 0.
     END. /* INDEX(code,"E") > 0 */

     IF INDEX(code,"M") > 0 THEN DO:
         IF DBTYPE("DICTDB") NE "PROGRESS" OR 
            user_dbtype NE "PROGRESS" OR
            NOT dbAdmin(USERID("DICTDB")) THEN 
            ASSIGN gray = 0.
     END.

     IF INDEX(code,"Y") > 0 THEN DO:
       /* Check to see whether this menu item requires any of the security
          tables to be in the database */
       hBuffer:FIND-FIRST("WHERE _file._file-name BEGINS ~'_sec-granted~'",
                          NO-LOCK) NO-ERROR.
     
       IF NOT hBuffer:AVAILABLE THEN gray = 0.
     END. /* INDEX(code,"Y") > 0 */

     DELETE OBJECT hBuffer.
   END. /* NUM-DBS > 0 and code = A, Z or Y */

   if gray = 0 then
      /* If this menu item not appropriate for this PROGRESS
         then disable it and set handle to ? so it will never
         get enabled.
      */
      assign
         p_hdl:sensitive = no
         Menu_Hdl[All_Items_ix] = ?. 
   else do:
      Menu_Hdl[All_Items_ix] = p_hdl.  /* store the menu handle */
      /* If we're not connected to a database and this isn't 
         appropriate when no database is connected then disable it 
      */
      if user_dbname = "" AND (INDEX(code, "N") = 0) then
         p_hdl:sensitive = no.
      ELSE p_hdl:SENSITIVE = (gray <> 0).
     end.
   
  end.


/*----------------------------------------------------------------------
   Do_Menu_Item_Db_Change

   This is the function called for each menu item on the subsequent
   walks through the menus when the database connection status has
   changed.

   Input Parameter:
      p_hdl    - Handle to a menu item
      p_sub_ix  - Index of the sub-menu being processed (in Gray_Table)
      p_item_ix - Index of the menu item within this sub-menu.      
----------------------------------------------------------------------*/
Procedure Do_Menu_Item_Db_Change:
   Define INPUT parameter p_hdl      as widget-handle NO-UNDO.
   Define INPUT parameter p_sub_ix   as integer       NO-UNDO.
   Define INPUT parameter p_item_ix  as integer       NO-UNDO.

   Define var code as char    NO-UNDO.  /* FCXQRN entry from gray table */

   /* If handle is ?, it's been grayed already and forever 
      because of the PROGRESS version or lack of gateway support.
      So do nothing */
   if NOT Menu_Hdl[All_Items_ix] = ? then
   do:
      /* If the menu item is marked as not appropriate when no database
               is connected (a "-" in the "N" slot) gray it or ungray it
               depending on if database is connected.  If it IS marked as
               appropriate even when there's no db connected (a "N" in the "N"
               slot) leave it alone - it will never be grayed.
      */
      IF NUM-ENTRIES(Gray_Table[p_sub_ix]) >= p_item_ix THEN
         code = ENTRY(p_item_ix, Gray_Table[p_sub_ix]).

      if INDEX(code, "N") = 0 then
         p_hdl:sensitive = (if user_dbname = "" then no else yes).
     end.
  end.


/*--------------------------------------------------------------------------
   Menu_Walk

   Walk through the menu tree and do menu graying.  This will be
   called once for initial menu graying and again for each time
   we switch between having a connected database and not having one.
   p_Func will do different things for each case.

   Input Parameter:
      p_hdl      - Handle to either the top level menu or a submenu.
      p_Func     - Function to call to process each menu item. 
      p_sm-alive - Flag to indicate if sub-menu should be disabled.  If any
                   of it's children are enabled, then it is "alive". 
----------------------------------------------------------------------------*/
Procedure Menu_Walk:
   Define INPUT  parameter p_hdl      as widget-handle NO-UNDO.  
   Define INPUT  parameter p_Func     as char          NO-UNDO.
   Define OUTPUT parameter p_sm-alive as logical       NO-UNDO init no.

   /* Submenu index that this recursive level is processing */
   Define var loc_sub_ix as integer NO-UNDO.  
   Define var item_ix    as integer NO-UNDO init 0.  /* index within submenu */
   Define var l_sm-alive as logical NO-UNDO.  /* store return value from   *
                                               * recursive calls to myself */

   loc_sub_ix = Submenu_ix.
   do while p_hdl <> ?:
      if p_hdl:type = "menu-item" then 
      do:
         assign
                 All_Items_ix = All_Items_ix + 1
                 item_ix      = item_ix + 1.
                 
               run VALUE(p_Func) (p_hdl, loc_sub_ix, item_ix).
               if p_hdl:sensitive then assign p_sm-alive = yes.  /* sub-menu alive; at *
                                                                  * least one enabled  *
                                                                  * menu-item          */
        end.
      else do:
               /* Don't handle the tools menu - common code deals with this */
               if NOT(p_hdl:type = "sub-menu" AND p_hdl:label = "&Tools") then
               do:
                  /* type will either be sub-menu or menu */
            if p_hdl:type = "sub-menu" then
               Submenu_ix = Submenu_ix + 1.
            run Menu_Walk (p_hdl:first-child, p_Func, OUTPUT l_sm-alive).
            if not l_sm-alive then
              p_hdl:sensitive = no.  /* disable sub-menu - no enabled children */
            else assign
              p_sm-alive = yes        /* at least one enabled sub-menu */
              p_hdl:sensitive = yes.  /* so enable parent              */
                 end.
        end.
      if p_hdl:type <> "menu" then  /* if not top-level menu bar */
               p_hdl = p_hdl:next-sibling.
      else
               p_hdl = ?.
     end.
  end.


/*----------------------------------------------------------------------
   Initial_Menu_Gray

   Gray menu items based on what the current version of PROGRESS 
   supports.  This includes the type of Progress as shown below as well
   as the gateways supported by this Progress.

   This graying only happens once since the executable doesn't change
   within one session.  Also, at this time check to see if there is a
   database connected.  If not, gray based on the "N" array as well.  
   We want to do it in one pass since menu graying can be very slow.
----------------------------------------------------------------------*/
Procedure Initial_Menu_Gray:
   Define var gate       as char NO-UNDO.
   Define var supp_gates as char NO-UNDO.  /* supported gateways */
   Define var all_gates  as char NO-UNDO.

   Define var g_all_ix  as integer NO-UNDO. /* index into all gateways list */
   Define var gate_ix   as integer NO-UNDO. /* index into Gray_Table array */
   Define var gate_list as char    NO-UNDO. /* list of "------"s for gateway */
   Define var junk      as logical no-undo. /* for output parm we don't care about */

   /* Change the Gray_Table based on whether this copy of PROGRESS
      supports certain gateways.  If a gateway is not supported, reset
      the comma delimited list for that gateway menu to all "------"'s so
      that all the menu items will be grayed out.
   */
   ASSIGN
     all_gates  = {adecomm/ds_type.i 
       &direction = "itype"
       &from-type = supp_gates
       }
     supp_gates = DATASERVERS.
   do g_all_ix = 1 to NUM-ENTRIES(all_gates):
      gate = ENTRY(g_all_ix, all_gates).
      if NOT CAN-DO(supp_gates, gate) then
            case gate:              
            when "MSS" then do:
               Gray_Table[{&MSSQL_IX}] =      /* MS-SQL Menu */
               "------,------,------,------,------,------,------,------".
               Gray_Table[{&MSSQL_IX} + 1] =  /* Migrate Menu */
               "------,------,------".
            end.
            when "ODBC" then DO:
               Gray_Table[{&ODBC_IX}] =
               "------,------,------,------,------,------,------,------".
               Gray_Table[{&ODBC_IX} + 1] = 
                 "------,------". 
            end.     
            when "ORACLE" then do:
                Gray_Table[{&ORACLE_IX}] =      /* ORACLE Menu */
                "------,------,------,------,------,------,------,------,------".
                Gray_Table[{&ORACLE_IX} + 1] =  /* Migrate Menu */
                "------,------,------,------".
            end.
            end case.          /*###*/
     end.
   
   /* Walk through the menu and do menu graying. */
   assign
      All_Items_ix = 0
      submenu_ix = 0.
   run Menu_Walk (MENU mnu_Admin_Tool:HANDLE, "Do_Menu_Item_Initial", OUTPUT junk).
  end.


/*------------------------------------------------------------------------ 
   Fix up the aliases.
------------------------------------------------------------------------*/
Procedure Reset_Aliases:
   IF LDBNAME("DICTDBG") <> ? THEN DELETE ALIAS "DICTDBG".
   IF user_dbname = "" THEN
      DELETE ALIAS "DICTDB".
   ELSE IF SDBNAME(user_dbname) = ? THEN DO:
      /* this case should never be executed except when running a copy
         of progress with a missing gateway (whatever that means!). */
      DO i = 1 TO cache_db#:
               IF cache_db_t[i] = user_dbtype AND cache_db_l[i] = user_dbname THEN 
                  LEAVE.
        end.
      CREATE ALIAS "DICTDB" FOR DATABASE VALUE(cache_db_s[i]) NO-ERROR.
     end.
   ELSE DO:
      IF    DBTYPE("DICTDB") = "PROGRESS"
       AND  user_dbtype     <> "PROGRESS" 
       THEN RUN prodict/_dctalia.p
              ( INPUT user_dbname
              ). /* switch DICTDB only if needed */
      IF  DBTYPE("DICTDB") <> "PROGRESS"
       THEN CREATE ALIAS DICTDB FOR DATABASE VALUE(SDBNAME(user_dbname)).
      IF LDBNAME(user_dbname) <> SDBNAME(user_dbname) 
       AND CONNECTED(user_dbname)
       THEN CREATE ALIAS "DICTDBG"
            FOR DATABASE VALUE(LDBNAME(user_dbname)) 
            NO-ERROR.
     end.
  end.


/*------------------------------------------------------------------------
   Reset the current database - the last one may have been disconnected
   or what have you.
   
   Input Parameter:
      p_Prev - name of previously connected database or "" if there
                     was no connected database.
------------------------------------------------------------------------*/
Procedure Reset_Db:

   Define INPUT PARAMETER p_Prev as char NO-UNDO.
   Define var junk as logical no-undo.  /* for output parm we don't care about */

   run Reset_Aliases.

   IF user_dbname = "" AND NUM-DBS > 0 THEN DO:
      RUN "prodict/_dctsget.p".
      RUN "prodict/_dctgues.p".
     end.
   /* If we've gone from having a database connected to not having one
      or vice-versa, we need to change menu gray state.
   */
   if (p_Prev = ""  AND user_dbname <> "") OR
      (p_Prev <> "" AND user_dbname = "") then
   do:
      assign
         All_Items_ix = 0
         submenu_ix = 0.
      run Menu_Walk (MENU mnu_Admin_Tool:HANDLE, "Do_Menu_Item_Db_Change", OUTPUT junk).
     end.
  end.


/*----------------------------------------------------------------------
   Perform_Func:

   Perform the function the user chose from the
   menu.  The input control string specifies what to do.
   Here is how the string is interpreted:

   If the statement looks like "number=value", where <number> is an
   integer from 1 to 19, then dictionary environment variable
   user_env[<number>] is set to <value>.  This is an assignment.

   If the statement begins with a star "*", it is an action statement.
   The different types of action strings are:
     *C - commit transaction
     *E - exit dictionary
     *N - nop (no operation, or do nothing)
     *O - OS-COMMAND (values in user_env[1-6] are the names of the
          programs to call (btos,msdos,os2,unix,vms,win32); user_env[7]
          is a default-value, used when any of user_env[1-6] = " "
     *Q - quit
     *R - rollback transaction.  this must be the last item in a
          control string, otherwise it is ignored (i.e., user_path
          must equal "*R" for this to execute properly).
     *T - start transaction, followed optionally by a colon ":" and
          the name of the procedure to execute when the user_path is
          empty.

   If the statement begins with a question mark "?", it is a DBTYPE
   string.  The name following the ? (e.g. "?ORA") is checked against
   the GATEWAYS function, and if the result is FALSE, a message is
   displayed and the control string is set to "".  In other words, 
   you can only perform this function if the current database is the
   given type.

   A "!" is similar to a "?", except that not only must the gateway be
   available in the current copy of PROGRESS, but the currently selected
   database must also be of that type.

   A "@" is similar to !, except that not only must the current database
   be of that type, but it must also be connected.

   If the statement is anything else, it is assumed to be a procedure.
   A "prodict/" is tacked on to the beginning, a ".p" is tacked on to
   the end, and it is RUN.
-----------------------------------------------------------------------*/
Procedure Perform_Func:
   Define INPUT parameter p_CtrlStr as char NO-UNDO.
   
   Define var prev_dbname as char    NO-UNDO.
   Define var ampersand   as integer NO-UNDO.
   Define var lbl         as char    NO-UNDO.
   DEFINE VAR lError      AS LOGICAL NO-UNDO.
   DEFINE VAR inTrans1    AS LOGICAL NO-UNDO /*UNDO*/.

   hide message NO-PAUSE.

   /* Display menu pick text in header line, removing ampersand first */
   lbl = SELF:label.  /* based on trigger that called this function */
   ampersand = INDEX(lbl, "&").
   lbl = (if ampersand > 1 then SUBSTR(lbl,1,ampersand - 1,"character")
                           else "")
                + SUBSTR(lbl,ampersand + 1,-1,"character").
   lbl = TRIM (lbl, ".").  /* remove any elipsis */
   { prodict/user/userhdr.i lbl}

   assign
      user_path = p_CtrlStr   
      prev_dbname = user_dbname.

   run Reset_Aliases.

   /* Hide welcome frame */
   if frame guten-tag:visible then
      hide frame guten-tag.

   /* To parent dialogs properly. */
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      CURRENT-WINDOW = win.
   &ENDIF

   /* this is the main execute loop */
mainl:
   DO WHILE user_path <> "" AND user_path <> "*E" AND user_path <> "*R"
             ON ERROR UNDO, LEAVE mainl
             ON STOP  UNDO, LEAVE mainl:
      IF user_dbname = ""
       THEN RUN "prodict/_dctexen.p".
       ELSE do:
        IF dict_trans
         THEN 
          _dict: DO TRANSACTION:
            ASSIGN inTrans1 = YES.
            RUN "prodict/_dctexec.p".
            IF user_path = "*R" THEN UNDO _dict,LEAVE _dict.

            FINALLY:
                /* OE00111504 - if not inTrans1, transaction was rolled back */
                IF NOT inTrans1 THEN
                   lerror = YES.
            END.
         END.
         ELSE RUN "prodict/_dctexec.p".
       end.
     end.

   IF user_path = "*E" 
     THEN APPLY "CHOOSE" TO MENU-ITEM mi_Exit IN MENU mnu_Database.

   /* Make sure userpath is set properly, in the event main loop exited
    * because of an error.
    * We also need to clear the window and reset the cursor.
    *                                                   (hutegger 95/09)
    */
   user_path =  "".

   /* OE00111504 - give the user a chance to see the error message that
      caused the rollback.
   */
   IF lError THEN
       PAUSE.

   hide all no-pause.
   RUN adecomm/_setcurs.p ("").
   { prodict/user/usercon.i }
  
   /* Make sure current database is set properly. */
   IF user_path <> "*E" 
     THEN run Reset_Db (INPUT prev_dbname).

   ASSIGN dict_trans   = FALSE
          dict_dirty   = FALSE
          user_trans   = ""
          user_excepts = "".

   IF user_env[35] NE "persistent" THEN user_env = "".

   /* Reset context line */
   lbl = "Main Menu".
   { prodict/user/userhdr.i lbl}

  end.

/*------------------------------------------------------------------------ 
   Disable myself because user has run another tool.  This simply
   means disable the menu bar.
------------------------------------------------------------------------*/
Procedure disable_widgets:

   /* Unset global active ade tool variable. */
   ASSIGN h_ade_tool = ?.

   num_connected = NUM-DBS.   /* remember this for later */

   /* This only does top level menu items, so we don't have to worry 
      about messing up grayed/non-grayed items.
   */
   menu mnu_Admin_Tool:sensitive = no.

   if frame guten-tag:visible then
      hide frame guten-tag.
   hide frame user_hdr.
   hide frame user_ftr.
   hide message NO-PAUSE.
   SESSION:SUPPRESS-WARNINGS = sw_sav.  /* sw_sav is defined in _dictc.p */
  end.


/*------------------------------------------------------------------------ 
   Reactivate myself now that invoked tool has returned. 
------------------------------------------------------------------------*/
Procedure enable_widgets:
   
   Define var ix        as integer NO-UNDO.
   Define var all_conn  as logical NO-UNDO init yes.
   Define var curr_conn as logical NO-UNDO.
   Define var prev_db   as char    NO-UNDO.

   /* Set global active ade tool procedure handle to Procedure Editor. */
   ASSIGN h_ade_tool = THIS-PROCEDURE.

   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      /* Reattach the menubar and redisplay hdr and ftr frames */
      default-window:menubar = menu mnu_Admin_Tool:handle.
      {prodict/user/userhdr.i user_hdr}
      { prodict/user/usercon.i user_filename} /* displays footer */

      /* Reset session attributes in case tool clobbered them. */
      ASSIGN
               session:APPL-ALERT-BOXES = NO
               session:SYSTEM-ALERT-BOXES = NO
               SESSION:SUPPRESS-WARNINGS = YES.
   &ELSE
      /* Reset session attributes in case tool clobbered them. */
      ASSIGN
         session:APPL-ALERT-BOXES = NO
         session:SYSTEM-ALERT-BOXES = YES
         SESSION:SUPPRESS-WARNINGS = YES.
   &ENDIF

   menu mnu_Admin_Tool:sensitive = yes.

   /* If any of the databases that were connected before are no longer
      connected or there are new ones connected, then reset the
      database cache.
   */
   curr_conn = connected (user_dbname).
   if num_connected = NUM-DBS then  /* this check is for efficiency */
      do ix = 1 to cache_db# while all_conn:
         all_conn = all_conn AND CONNECTED(cache_db_l[ix]).
        end.

   if num_connected <> NUM-DBS OR NOT all_conn then
   do:
      prev_db = user_dbname.
      if user_dbname <> "" AND NOT curr_conn then
      do:
               /* previous db no longer connected */
               user_dbname = "".
               user_dbtype = "".
               user_filename = "".
               { prodict/user/usercon.i user_filename} /* displays footer */
        end.
      if user_dbname = "" then
               run Reset_Db (INPUT prev_db). /* refresh cache and pick a new db */
      else 
               run "prodict/_dctsget.p".  /* refresh the cache */
     end.

  if curr_conn then 
   do:
     IF user_dbtype <> "PROGRESS" THEN
      /* Make sure alias is still set properly. */
        CREATE ALIAS "DICTDB" FOR DATABASE VALUE(SDBNAME(user_dbname)) NO-ERROR.
     ELSE
        CREATE ALIAS "DICTDB" FOR DATABASE VALUE(user_dbname) NO-ERROR.

      /* Since someone may have changed the schema in other tool */
      assign
               user_filename = ""
               cache_dirty = yes.
     end.
   {prodict/user/usercon.i user_filename} /* redisplay footer */
  end.

/* Execute the different utilities for encryption policies */
PROCEDURE encpol_tool.
    DEFINE INPUT PARAMETER mode AS CHAR NO-UNDO.

    IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
      MESSAGE "You must be a Security Administrator to access this utility!"
         VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN.
   END.
   IF DBTYPE(user_dbname) NE "PROGRESS" THEN DO:
       MESSAGE "You tried to perform some PROGRESS operation on a"
               DBTYPE(user_dbname) "database."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       RETURN.
   END.

   RUN prodict/sec/_sec-pol-driver.p (INPUT mode).
END.

/*=============================Triggers==================================*/

/*---------------------------Database menu-------------------------------*/

/*----- SELECT DATABASE -----*/
ON CHOOSE OF MENU-ITEM mi_DB_Select         IN MENU mnu_Database DO:
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   RUN Perform_Func ("1=get,_usrsget").
   &ELSE
   RUN Perform_Func ("1=get,_guisget").
   &ENDIF
   
   RUN  Initial_Menu_Gray.
END.

/*----- CONNECT DATABASE -----*/
ON CHOOSE OF MENU-ITEM mi_DB_Connect        IN MENU mnu_Database DO:
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=usr,_usrscon,1=new,_usrsget,*N").
   &ELSE
   run Perform_Func ("1=usr,_usrscon,1=new,_guisget,*N").
   &ENDIF

   RUN  Initial_Menu_Gray.
END.

/*----- DISCONNECT DATABASE -----*/
ON CHOOSE OF MENU-ITEM mi_DB_Disconnect     IN MENU mnu_Database DO:
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=dis,_usrsget").
   &ELSE
   run Perform_Func ("1=dis,_guisget").
   &ENDIF
   
   RUN  Initial_Menu_Gray.
END.

/*----- CREATE DATABASE -----*/
ON CHOOSE OF MENU-ITEM mi_DB_Create         IN MENU mnu_Database DO:
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrprdb,1=env,_usrscon,1=new,_usrsget,*N").
   &ELSE
   run Perform_Func ("_usrprdb,1=env,_usrscon,1=new,_guisget,*N").
   &ENDIF
   
   RUN  Initial_Menu_Gray.
END.

/*---------------------------Schema menu-------------------------------*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
/*----- MODIFY TABLE -----*/
on choose of menu-item mi_Sch_ModTbl   in menu mnu_Schema
   run Perform_Func ("*T:_usrtrax,_usrtget,_usrtchg,19=alpha,_usrfchg").

/*----- CREATE TABLE -----*/
on choose of menu-item mi_Sch_AddTbl   in menu mnu_Schema
   run Perform_Func ("*T:_usrtrax,_usrtchg,19=alpha,_usrfchg").

/*----- DELETE TABLE -----*/
on choose of menu-item mi_Sch_DelTbl   in menu mnu_Schema  
   run Perform_Func ("_usrtdel").

/*----- FIELD EDITOR -----*/
on choose of menu-item mi_Sch_FldEdit  in menu mnu_Schema  
   run Perform_Func ("*T:_usrtrax,_usrtget,19=alpha,_usrfchg").

/*----- REORDER FIELDS -----*/
on choose of menu-item mi_Sch_ReordFld in menu mnu_Schema  
   run Perform_Func ("_usrtget,_usrfnum").

/*----- RENAME FIELDS -----*/
on choose of menu-item mi_Sch_RenamFld in menu mnu_Schema
   run Perform_Func ("_usrfglo").

/*----- INDEX EDITOR -----*/
on choose of menu-item mi_Sch_IdxEdit  in menu mnu_Schema
   run Perform_Func ("*T:_usrtrax,_usrtget,_usrichg").

/*----- SEQUENCE EDITOR -----*/
on choose of menu-item mi_Sch_SeqEdit  in menu mnu_Schema 
   run Perform_Func ("*T:_usrtrax,_usrkchg").

/*----- SQL PROPERTIES -----*/
on choose of menu-item mi_Sch_SQL      in menu mnu_Schema  
   run Perform_Func ("!PROGRESS,*T:_usrtrax,_usrtget,19=alpha,_guisqlw").
&ENDIF


/*----------------------------Admin/Dump menu---------------------------*/

/*----- DUMP DEFS -----*/
on choose of menu-item mi_Dump_Defs     in menu mnu_Dump   
   run Perform_Func ("9=d,1=s,_guitget,_usrdump,_dmpsddl").
  

/*----- DUMP CONTENTS -----*/
on choose of menu-item mi_Dump_Contents in menu mnu_Dump 
  run Perform_Func ("9=f,1=s,_guitget,_usrdump,*N,_dmpdata").
   
/*----- DUMP VIEWS -----*/
on choose of menu-item mi_Dump_Views    in menu mnu_Dump 
   run Perform_Func ("!PROGRESS,2=ALL,9=v,_usrdump,_dmpview").

/*----- DUMP USERS -----*/
on choose of menu-item mi_Dump_User     in menu mnu_Dump 
   run Perform_Func ("!PROGRESS,9=u,_usrdump,_dmpuser").

/*----- DUMP SECURITY AUTHENTICATION RECORDS -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_Sec_Auth IN MENU mnu_Dump DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.

  user_env[1] = "_sec-authentication-system,_sec-authentication-domain".
  RUN Perform_Func ("9=h,_usrdump,_dmpdata").
END.

/*----- DUMP SECURITY PERMISSIONS -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_Sec_Perm IN MENU mnu_Dump DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.

  ASSIGN user_env[1]  = 
                "_sec-role,_sec-granted-role,_sec-granted-role-condition"
         user_excepts = "_sys.audit.admin,_sys.audit.archive," + 
                        "_sys.audit.read,_sys.audit.appevent.insert".
  RUN Perform_Func ("9=m,_usrdump,_dmpdata").
END.

/*----- DUMP AUTO-CONNECT -----*/
on choose of menu-item mi_Dump_AutoConn in menu mnu_Dump 
   run Perform_Func ("!PROGRESS,9=a,_usrdump,_dmpsddl").

/*----- DUMP COLLATE/TRANSLATE Stuff -----*/
on choose of menu-item mi_Dump_CollTran in menu mnu_Dump 
   run Perform_Func ("!PROGRESS,9=c,_usrdump,_dmpsddl").

/*----- DUMP SEQUENCES -----*/
on choose of menu-item mi_Dump_SeqDefs  in menu mnu_Dump 
   run Perform_Func ("!PROGRESS,9=s,_usrdump,_dmpsddl").

/*----- DUMP SEQUENCE VALUES -----*/
on choose of menu-item mi_Dump_SeqVals  in menu mnu_Dump 
   run Perform_Func ("!PROGRESS,9=k,_usrdump,_dmpseqs").

/*----- DUMP AUDIT POLICIES -- AS XML -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_as_XML IN MENU mnu_Dump_Aud_Pol DO:
  /* Ensure that the user has the appropriate permission assigned
     to dump audit data/policies. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN DO:
    MESSAGE "You must have Audit Administrator permissions to " +
            "access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                           
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */
                                           
  RUN Perform_Func 
      ("_aud-pol,9=x,2=_audit-policies.xml,35=persistent,_usrdump").

  IF user_env[1] = ? OR
     user_env[1] = "" THEN DO:
    user_env = "".
    RETURN NO-APPLY.
  END.

  IF user_env[1] = "All" THEN user_env[1] = "*".
  
  IF user_env[1] NE ? THEN
    RUN prodict/dump/_dmpaudp.p ( INPUT "x",
                                  INPUT user_env[1],
                                  INPUT user_env[2] ).

  user_env = "".
END.

/*----- DUMP AUDIT POLICIES -- AS TEXT -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_as_Txt IN MENU mnu_Dump_Aud_Pol DO:
  DEFINE VARIABLE lRetry  AS LOGICAL     NO-UNDO INITIAL TRUE.
  DEFINE VARIABLE cFilter AS CHARACTER   NO-UNDO.

  /* Ensure that the user has the appropriate permission assigned
     to dump audit data/policies. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN DO:
    MESSAGE "You must have Audit Administrator permissions to " +
            "access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                                 
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */
                                           
  RUN Perform_Func ("9=t,_aud-pol,35=persistent").

  IF user_env[1] = ? OR
     user_env[1] = "" THEN DO:
    user_env = "".
    RETURN NO-APPLY.
  END.

  cFilter     = user_env[1].
  user_env[1] = "_aud-audit-policy,_aud-event-policy," +
                "_aud-field-policy,_aud-file-policy".
  
  DO WHILE lRetry:
    RUN Perform_Func ("5=UTF-8,9=t,35=persistent,_usrdump").

    IF user_env[1] EQ ? THEN LEAVE.

    RUN prodict/dump/_dmpsec.p ( INPUT "",
                                 INPUT cFilter,
                                 INPUT user_env[2],
                                 INPUT user_env[30],
                                 INPUT "ap" ).

    lRetry = (RETURN-VALUE = "Retry").
  END.
  
  user_env = "".
END.
                   
/*----- DUMP AUDIT EVENTS -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_Evt IN MENU mnu_Dump_Aud_Pol DO:
  /* Ensure that the user has the appropriate permission assigned
     to dump audit events. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN 
    PERM-CHK: DO:
      
    MESSAGE "You must have Audit Administrator permissions to " +
            "access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                                 
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */
                                           
  
  ASSIGN user_env[2] = "_aud-event.ad"
         user_env[1] = "_aud-event".

  RUN Perform_Func ("9=e,_usrdump,_dmpdata").

END.

/*----- DUMP AUDIT Data -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_Aud_Data  IN MENU mnu_Dump DO:
  DEFINE VARIABLE lRetry  AS LOGICAL     NO-UNDO INITIAL TRUE.
  DEFINE VARIABLE cFilter AS CHARACTER   NO-UNDO.

  /* Ensure that the user has the appropriate permission assigned
     to dump audit data/policies. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.archive",FALSE) THEN DO:
    MESSAGE "You must have Audit Archiver permissions to " +
            "access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                    
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */
                                         
  RUN adecomm/_auddfilt.p ( INPUT "y",
                            OUTPUT user_env[1] ).

  IF user_env[1] = ? THEN DO:
    user_env  = "".
    user_path = "".
    RETURN NO-APPLY.
  END.
  
  cFilter     = user_env[1].
  user_env[1] = "_aud-audit-data,_aud-audit-data-value".
  user_env[5] = "UTF-8".

  DO WHILE lRetry:
    RUN Perform_Func ( "9=y,35=persistent,_usrdump" ).

    IF user_env[1] = ? THEN LEAVE.
        
    RUN prodict/dump/_dmpsec.p ( INPUT "",
                                 INPUT cFilter,
                                 INPUT user_env[2],
                                 INPUT user_env[30],
                                 INPUT "ad" ).

    lRetry = (RETURN-VALUE = "Retry").
  END.
            
  user_env = "".
END.

/*----- DUMP DATABASE IDENTIFICATION -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_Db_ids  IN MENU mnu_Dump DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        
    user_env = "".
    RETURN NO-APPLY.
  END.
 
   RUN Perform_Func ("9=i,1=_db-detail,2=_db-detail.d,_usrdump,_dmpdata").
END.

/*----- DUMP DATABASE IDENTIFICATION -----*/
ON CHOOSE OF MENU-ITEM mi_Dump_Db_Opt  IN MENU mnu_Dump DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this dump option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
 
    user_env = "".
    RETURN NO-APPLY.
  END.
   
  RUN Perform_Func ("9=o,1=_db-option,2=_db-option.d,_usrdump,_dmpdata").
END.

/*----- INCREMENTAL DF FILE -----*/
on choose of menu-item mi_Dump_IncrDF   in menu mnu_Dump
   run Perform_Func ("_usrincr,*N,_dmpincr").

/*----------------------------Admin/Load menu---------------------------*/

/*----- LOAD DEFS -----*/
on choose of menu-item mi_Load_Defs     in menu mnu_Load 
   run Perform_Func ("9=d,_usrload").

/*----- LOAD CONTENTS -----*/
on choose of menu-item mi_Load_Contents in menu mnu_Load
   run Perform_Func ("9=f,1=s,_guitget,_usrload,*N,_loddata").

/*----- LOAD VIEWS -----*/
on choose of menu-item mi_Load_Views    in menu mnu_Load 
   run Perform_Func ("2=ALL,9=v,_usrload,_lodview").

/*----- LOAD USERS -----*/
on choose of menu-item mi_Load_User     in menu mnu_Load 
   run Perform_Func ("9=u,_usrload,_loduser").

/*----- LOAD SECURITY AUTHENTICATION RECORDS -----*/
ON CHOOSE OF MENU-ITEM mi_Load_Sec_Auth IN MENU mnu_Load DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_env = "".
    RETURN NO-APPLY.
  END.

  user_env[1]  = "_sec-authentication-system,_sec-authentication-domain".
  RUN Perform_Func ("9=z,_usrload,_loddata").
END.

/*----- LOAD SECURITY AUTHENTICATION RECORDS -----*/
ON CHOOSE OF MENU-ITEM mi_Load_Sec_Perm IN MENU mnu_Load DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_env = "".
    RETURN NO-APPLY.
  END.

  user_env[1]  = "_sec-role,_sec-granted-role," + 
                 "_sec-granted-role-condition".

  RUN Perform_Func ("9=m,_usrload,_loddata").
END.

/*----- LOAD SEQUENCE VALUES -----*/
on choose of menu-item mi_Load_SeqVals  in menu mnu_Load 
   run Perform_Func ("!PROGRESS,9=k,_usrload,_lodseqs").

/*----- LOAD AUDIT DATA -----*/
ON CHOOSE OF MENU-ITEM mi_Load_Aud_Data  IN MENU mnu_Load DO:
  DEFINE VARIABLE lRetry AS LOGICAL     NO-UNDO INITIAL TRUE.
  
  /* Ensure that the user has the appropriate permission assigned
     to load audit data/policies. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.archive",FALSE) THEN DO:
    MESSAGE "You must have Audit Archiver permissions to " +
            "access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */

  DO WHILE lRetry:
    RUN Perform_Func ( "35=persistent,9=y,_usrload" ).
    
    IF user_env[2] = ? THEN LEAVE.
      
    RUN prodict/dump/_lodsec.p ( INPUT user_env[2],
                                 INPUT "ad",
                                 INPUT LDBNAME("DICTDB"),
                                 INPUT user_env[30] ).
    
    lRetry = (RETURN-VALUE EQ "Retry").
  END.
                                       
  user_env = "".
                                         
END.

/*----- LOAD DATABASE IDENTIFICATION -----*/
ON CHOOSE OF MENU-ITEM mi_Load_DB_ids  IN MENU mnu_Load DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_env = "".
    RETURN NO-APPLY.
  END.

  RUN Perform_Func ("9=i,1=_db-detail,2=_db-detail.d,_usrload,5=n,_loddata").
END.

/*----- LOAD DATABASE IDENTIFICATION -----*/
ON CHOOSE OF MENU-ITEM mi_Load_DB_Opt  IN MENU mnu_Load DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_env = "".
    RETURN NO-APPLY.
  END.

  RUN Perform_Func ("9=o,1=_db-option,2=_db-option.d,_usrload,_loddata").
END.

/*----- LOAD AUDIT POLICIES -- AS XML -----*/
ON CHOOSE OF MENU-ITEM mi_Load_XML   IN MENU mnu_Load_Aud_Pol DO:
  /* Ensure that the user has the appropriate permission assigned
     to load audit data/policies. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN DO:
    MESSAGE "You must have Audit Administrator permissions to " +
            "access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
     
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */
  
  RUN Perform_Func ( "9=x,2=_audit-policies.xml,35=persistent,_usrload" ).

  IF user_env[2] NE ? THEN
    RUN prodict/dump/_lodaudp.p ( INPUT user_env[9],
                                  INPUT user_env[2],
                                  INPUT user_overwrite ).

  IF user_commit  EQ TRUE AND
     RETURN-VALUE EQ "" THEN
    AUDIT-POLICY:REFRESH-AUDIT-POLICY("DICTDB").

  user_env = "".
END.

/*----- LOAD AUDIT POLICIES -- AS TEXT -----*/
ON CHOOSE OF MENU-ITEM mi_Load_Txt   IN MENU mnu_Load_Aud_Pol DO:
  DEFINE VARIABLE lRetry AS LOGICAL     NO-UNDO INITIAL TRUE.

  /* Ensure that the user has the appropriate permission assigned
     to load audit data/policies. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN DO:
    MESSAGE "You must have Audit Administrator permissions to " +
            "access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                              
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */

  DO WHILE lRetry:
    RUN Perform_Func ( "35=persistent,9=t,_usrload" ).

    IF user_env[2] = ? THEN LEAVE.
    
    RUN prodict/dump/_lodsec.p ( INPUT user_env[2],
                                 INPUT "ap",
                                 INPUT LDBNAME("DICTDB"),
                                 INPUT user_env[30] ).

    lRetry = (RETURN-VALUE EQ "Retry").
  END.
  
  IF (user_commit = TRUE) AND 
     RETURN-VALUE = "" THEN
    AUDIT-POLICY:REFRESH-AUDIT-POLICY("DICTDB").

  user_env = "".
END.

/*----- LOAD AUDIT EVENTS -----*/
ON CHOOSE OF MENU-ITEM mi_Load_Evt   IN MENU mnu_Load_Aud_Pol DO:
  /* Ensure that the user has the appropriate permission assigned
     to load audit events. */
  IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN
    PERM-CHK: DO:
      
    MESSAGE "You must have Audit Administrator permissions to " +
            "access this load option!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                                 
    user_env = "".
    RETURN NO-APPLY.
  END. /* Permission Check */
  
  RUN Perform_Func ( "9=e,1=_aud-event,2=_aud-event.ad,_usrload,_loddata" ).
END.

/*----- RECONSTRUCT BAD LOAD RECORDS -----*/
on choose of menu-item mi_Load_BadRecs  in menu mnu_Load 
   run Perform_Func ("_usrlrec,_dctlrec").

/*----------------------------Admin/DB Identification menu---------------------*/
ON CHOOSE OF MENU-ITEM mi_db_id_maint IN MENU mnu_dbid DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this utility!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  
    user_env = "".
    RETURN NO-APPLY.
  END.

  RUN Perform_Func ("_db-id-mnt").

END.

ON CHOOSE OF MENU-ITEM mi_db_id_hist IN MENU mnu_dbid DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this utility!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.

    user_env = "".
    RETURN NO-APPLY.
  END.
  RUN Perform_Func ("_db-id-hst").

END.

/*-------------------------Admin/Security menu---------------------------*/

/*----- EDIT USER LIST -----*/
on choose of menu-item mi_Sec_EditUser  in menu mnu_Security 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!PROGRESS,_usruchg").
   &ELSE
   run Perform_Func ("!PROGRESS,_guiuchg").
   &ENDIF

/*----- CHANGE PASSWORD -----*/
on choose of menu-item mi_Sec_Password  in menu mnu_Security 
   run Perform_Func ("!PROGRESS,_usrupwd").

/*----- EDIT DATA SECURITY -----*/
on choose of menu-item mi_Sec_DataSec   in menu mnu_Security 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("9=rw,_usrtget,_usrsecu").
   &ELSE
   run Perform_Func ("9=rw,_guisecu").
   &ENDIF

ON CHOOSE OF MENU-ITEM mi_Sec_Aud_Perm            IN MENU mnu_Security
  RUN Perform_Func ("9=a,_sec-perm").

/*----- SECURITY ADMINISTRATORS -----*/
on choose of menu-item mi_Sec_Adminors  in menu mnu_Security 
   run Perform_Func ("!PROGRESS,_usradmn").

/*----- DISALLOW BLANK USERID ACCESS -----*/
on choose of menu-item mi_Sec_BlankId   in menu mnu_Security 
   run Perform_Func ("!PROGRESS,_usrblnk").

/*----- USER REPORT -----*/
on choose of menu-item mi_Sec_UserRpt   in menu mnu_Security 
   run Perform_Func ("_rptuqik").

/*----- AUTHENTICATION SYSTEM MAINTENANCE -----*/
ON CHOOSE OF MENU-ITEM mi_auth_sys    IN MENU mnu_auth_maint DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this utility!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
  RUN Perform_Func ("_sec-sys").
END.

ON CHOOSE OF MENU-ITEM mi_auth_dom    IN MENU mnu_auth_maint DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this utility!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
  END.
  RUN Perform_Func ("_sec-dom").
END.

/*----- SECURITY POLICIES-----*/
ON CHOOSE OF MENU-ITEM mi_encpol_edit    IN MENU mnu_Enc_Policies DO:
   RUN encpol_tool("edit").
END.

ON CHOOSE OF MENU-ITEM mi_encpol_regen   IN MENU mnu_Enc_Policies DO:
   RUN encpol_tool("generate").
END.

ON CHOOSE OF MENU-ITEM mi_encpol_history    IN MENU mnu_Enc_Policies DO:
   RUN encpol_tool("history").
END.

/*---------------------------Admin/Export menu---------------------------*/
        
/*----- EXPORT DIF -----*/
on choose of menu-item mi_Exp_DIF           in menu mnu_Export 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=dif,_usrexpo,_dmpdiff").
   &ELSE
   run Perform_Func ("_guitget,9=dif,_usrexpo,_dmpdiff").
   &ENDIF

/*----- EXPORT SYLK -----*/
on choose of menu-item mi_Exp_SYLK      in menu mnu_Export 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=sylk,_usrexpo,_dmpsylk").
   &ELSE
   run Perform_Func ("_guitget,9=sylk,_usrexpo,_dmpsylk").
   &ENDIF

/*----- EXPORT ASCII -----*/
on choose of menu-item mi_Exp_ASCII     in menu mnu_Export 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=ascii,_usrexpo,_dmpasci").
   &ELSE
   run Perform_Func ("_guitget,9=ascii,_usrexpo,_dmpasci").
   &ENDIF

/*----- EXPORT MS WORD -----*/
on choose of menu-item mi_Exp_MSWord    in menu mnu_Export 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=word,_usrexpo,_dmpasci").
   &ELSE
   run Perform_Func ("_guitget,9=word,_usrexpo,_dmpasci").
   &ENDIF


/*---------------------------Admin/Import menu---------------------------*/

/*----- IMPORT DIF -----*/
on choose of menu-item mi_Imp_DIF           in menu mnu_Import 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=dif,_usrimpo,_loddiff").
   &ELSE
   run Perform_Func ("_guitget,9=dif,_usrimpo,_loddiff").
   &ENDIF

/*----- IMPORT SYLK -----*/
on choose of menu-item mi_Imp_SYLK      in menu mnu_Import 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=sylk,_usrimpo,_lodsylk").
   &ELSE
   run Perform_Func ("_guitget,9=sylk,_usrimpo,_lodsylk").
   &ENDIF

/*----- IMPORT ASCII -----*/
on choose of menu-item mi_Imp_ASCII     in menu mnu_Import 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=ascii,_usrimpo,_lodasci").
   &ELSE
   run Perform_Func ("_guitget,9=ascii,_usrimpo,_lodasci").
   &ENDIF

/*----- IMPORT FIXED LENGTH -----*/
on choose of menu-item mi_Imp_FixedLen  in menu mnu_Import 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,9=fixed,_usrimpo,_lodasci").
   &ELSE
   run Perform_Func ("_guitget,9=fixed,_usrimpo,_lodasci").
   &ENDIF


   /*----- IMPORT dBASE DEFS -----*/
   on choose of menu-item mi_Imp_dBASEDefs in menu mnu_Import 
      run Perform_Func ("_usrsdbf,_lodsdbf,9=h,_usrload").

   /*----- IMPORT dBASE FILE CONTENTS -----*/
   on choose of menu-item mi_Imp_dBASECont in menu mnu_Import 
      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      run Perform_Func ("_usrtget,9=dbf,_usrimpo,_loddbff").
      &ELSE
      run Perform_Func ("_guitget,9=dbf,_usrimpo,_loddbff").
      &ENDIF


/*---------------------------Admin/other menu items---------------------*/

/*----- CREATE BULK LOADER DESCRIPTION FILE -----*/
on choose of menu-item mi_BulkLoad      in menu mnu_Admin
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=s,_usrtget,9=b,_usrdump,_dmpbulk").
   &ELSE
   run Perform_Func ("1=s,_guitget,9=b,_usrdump,_dmpbulk").
   &ENDIF

/*----- DATABASE OPTIONS -----*/
ON CHOOSE OF MENU-ITEM mi_DbOptions     IN MENU mnu_Admin DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Security Administrator to access this utility!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        
    user_env = "".
    RETURN NO-APPLY.
  END.
  
  RUN Perform_Func ("_db-optn").
END.

/*----- ENABLE LARGE KEY ENTRIES -----*/
ON CHOOSE OF MENU-ITEM mi_LargeKeys     IN MENU mnu_Admin DO:
  IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
    MESSAGE "You must be a Database Administrator to access this utility!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        
    user_env = "".
    RETURN NO-APPLY.
  END.
  
  RUN Perform_Func ("_db-lkey").
END.

/*----- ALTERNATE BUFFER POOL MAINTENANCE -----*/
ON CHOOSE OF MENU-ITEM mi_AltBuf_Maint     IN MENU mnu_AltBuf DO:
   IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
     MESSAGE "You must be a Database Administrator to access this utility!"
         VIEW-AS ALERT-BOX ERROR BUTTONS OK.

     user_env = "".
     RETURN NO-APPLY.
   END.

   IF DBTYPE(user_dbname) NE "PROGRESS" THEN DO:
       MESSAGE "You tried to perform some PROGRESS operation on a"
               DBTYPE(user_dbname) "database."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       RETURN.
   END.

   RUN prodict/pro/_alt-buf-driver.p (INPUT "edit").
END.

/*-------------------------------DataServer/MSSQL--------------------------*/

     /*----- Create Schema -----*/
     on choose of menu-item mi_MSSQL_Create    in menu mnu_MSSQL
        run Perform_Func
           ("?MSS,1=add,3=MSS,_mssschg,_gat_ini,*C,_gat_drv,*C,_gat_con,_mss_get,mss/procbfrpul,_mss_pul,_gat_cro").

     /*----- Update File Def -----*/
     on choose of menu-item mi_MSSQL_UpdFile   in menu mnu_MSSQL
        run Perform_Func
           ("!MSS,1=upd,_gat_ini,*C,_gat_con,_mss_get,mss/procbfrpul,_mss_pul,_gat_cro").

     /*----- Verify File Def -----*/
     on choose of menu-item mi_MSSQL_VerFile   in menu mnu_MSSQL
        run Perform_Func
          ("!MSS,1=,_gat_ini,*C,_gat_con,25=compare,_mss_get,mss/procbfrpul,_mss_pul,_gat_cmp,_gat_cro").

     /*----- Edit Connect Info -----*/
     on choose of menu-item mi_MSSQL_ConnInfo  in menu mnu_MSSQL
        run Perform_Func ("!MSS,1=chg,3=MSS,_mssschg").

     /*----- Change Code Page -----*/
     on choose of menu-item mi_MSSQL_ChgCP     in menu mnu_MSSQL   
        run Perform_Func ("!MSS,_gat_cp,_gat_cp1").

     /* OE00195067 */ 
     /*----- "Server Attributes" pop-up menu: Migrate DB to MS-SQL -----*/
     on choose of menu-item mi_mss_viw_mnt_cnst in menu  mnu_mss_srv_attr
        run Perform_Func("_msc_viw"). 
     on choose of menu-item  mi_mss_active_all_cnst in menu  mnu_mss_srv_attr
        run Perform_Func("_msc_act"). 
     on choose of menu-item  mi_mss_delete_all_cns in menu  mnu_mss_srv_attr
        run Perform_Func("_msc_del"). 
     on choose of menu-item  mi_mss_gen_cnst_frm_rowid in menu  mnu_mss_srv_attr  
        run Perform_Func("_mss_gid").

     /* OE00195067 */
     
     /*----- Delete Schema -----*/
     on choose of menu-item mi_MSSQL_Delete    in menu mnu_MSSQL
        &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
        run Perform_Func ("!MSS,_usrsdel,*N,1=sys,_usrsget").
        &ELSE
        run Perform_Func ("!MSS,_usrsdel,*N,1=sys,_guisget").
        &ENDIF

     /*----- "Schema Migration Tools" pop-up menu: Migrate DB to MS-SQL -----*/
     on choose of menu-item mi_mss_Migrate in menu mnu_mss_tools
        run Perform_Func ("?MSS,mss/protomss").
     /*----- "Schema Migration Tools" pop-up menu: Incremental Dump -----*/
     on choose of menu-item mi_mss_Incre in menu mnu_mss_tools
       run Perform_Func ("!MSS,mss/_mss_inc").
     on choose of menu-item mi_mss_AdjstSI in menu mnu_mss_tools
        run Perform_Func ("!MSS,22=mss,mss/_beauty").



/*----------------------------DataServer/Odbc-----------------------------*/
 
/*----- Create Schema -----*/
on choose of menu-item mi_Odb_Create    in menu mnu_Odbc
   run Perform_Func
      ("?ODBC,1=add,3=ODBC,_usrschg,_gat_ini,*C,_gat_drv,*C,_gat_con,_odb_get,25=add,_odb_pul,_gat_cro").
 
/*----- Update File Def -----*/
on choose of menu-item mi_Odb_UpdFile   in menu mnu_Odbc
   run Perform_Func 
     ("!ODBC,1=upd,_gat_ini,*C,_gat_con,_odb_get,25=upd,_odb_pul,_gat_cro").
 
/*----- Verify File Def -----*/
on choose of menu-item mi_Odb_VerFile   in menu mnu_Odbc
   run Perform_Func
     ("!ODBC,1=,_gat_ini,*C,_gat_con,25=compare,_odb_get,_odb_pul,_gat_cmp,_gat_cro").
 
/*----- Edit Connect Info -----*/
on choose of menu-item mi_Odb_ConnInfo  in menu mnu_Odbc
   run Perform_Func ("!ODBC,1=chg,3=ODBC,_usrschg").
 
/*----- Change Code Page -----*/
on choose of menu-item mi_Odb_ChgCP     in menu mnu_Odbc
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!ODBC,_gat_cp,_gat_cp1").
   &ELSE
   run Perform_Func ("!ODBC,_gat_cp,_gat_cp1").
   &ENDIF

/*----- Delete Schema -----*/
on choose of menu-item mi_Odb_Delete    in menu mnu_Odbc
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!ODBC,_usrsdel,*N,1=sys,_usrsget").
   &ELSE
   run Perform_Func ("!ODBC,_usrsdel,*N,1=sys,_guisget").
   &ENDIF   

/*----- "Schema Migration Tools" pop-up menu: ProtoODBC -----*/
on choose of menu-item mi_odb_DBtoODB in menu mnu_odb_tools
   run Perform_Func ("?ODBC,odb/protoodb").
 
/*----- "Schema Migration Tools" pop-up menu: Adjust Schema -----*/
on choose of menu-item mi_odb_AdjstSI in menu mnu_odb_tools
   run Perform_Func ("!ODBC,22=odbc,odb/_beauty").
 
   
/*----------------------------DataServer/ORACLE---------------------------*/

/*----- Create Schema -----*/
on choose of menu-item mi_ORA_Create    in menu mnu_ORACLE 
   run Perform_Func 
     ("?ORACLE,1=add,3=ORACLE,_usrschg,_gat_ini,*C,_gat_con,_ora_lk0,*C,_ora_lkc,_ora_lkl").

/*----- Update File Def -----*/
on choose of menu-item mi_ORA_UpdFile   in menu mnu_ORACLE 
   run Perform_Func 
     ("!ORACLE,1=upd,_gat_ini,*C,_gat_con,_ora_lk0,*C,_ora_lkc,_ora_lkl").

/*----- Verify File Def -----*/
on choose of menu-item mi_ORA_VerFile   in menu mnu_ORACLE 
   run Perform_Func 
     ("!ORACLE,1=,_gat_ini,*C,_gat_con,_ora_lk0,*C,_ora_lkc,25=compare,_ora_lkl").

/*----- Edit Connect Info -----*/
on choose of menu-item mi_ORA_ConnInfo  in menu mnu_ORACLE 
   run Perform_Func ("!ORACLE,1=chg,3=ORACLE,_usrschg").

/*----- Change Code Page -----*/
on choose of menu-item mi_ORA_ChgCP     in menu mnu_ORACLE
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!ORACLE,_gat_cp,_gat_cp1").
   &ELSE
   run Perform_Func ("!ORACLE,_gat_cp,_gat_cp1").
   &ENDIF

/* OE00195067 */ 
/*----- "Server Attributes" pop-up menu: Migrate DB to ORACLE -----*/
on choose of menu-item mi_ora_viw_mnt_cnst in menu  mnu_ora_srv_attr
    run Perform_Func("_orc_viw"). 
on choose of menu-item  mi_ora_active_all_cnst in menu  mnu_ora_srv_attr
    run Perform_Func("_orc_act"). 
on choose of menu-item  mi_ora_delete_all_cns in menu  mnu_ora_srv_attr
    run Perform_Func("_orc_del"). 

/* OE00195067 */

/*----- Delete Schema -----*/
on choose of menu-item mi_ORA_Delete    in menu mnu_ORACLE
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!ORACLE,_usrsdel,*N,1=sys,_usrsget").
   &ELSE
   run Perform_Func ("!ORACLE,_usrsdel,*N,1=sys,_guisget").
   &ENDIF

/*----- SQL Plus -----*/
on choose of menu-item mi_ORA_SQLPlus   in menu mnu_ORACLE
   run Perform_Func ("?ORACLE,1= ,2=plus31,3= ,4= ,5= ,6=sqlplus,7=sqlplus,*O").

/*----- "Schema Migration Tools" pop-up menu: ProtoOra -----*/
on choose of menu-item mi_ora_DBtoORA in menu mnu_ora_tools
   run Perform_Func ("?ORACLE,ora/protoora").
   
/*----- "Schema Migration Tools" pop-up menu: Incremental Dump -----*/
on choose of menu-item mi_ora_Incre in menu mnu_ora_tools
   run Perform_Func ("!ORACLE,ora/_ora_inc").

/*----- "Schema Migration Tools" pop-up menu: Adjust Schema -----*/
on choose of menu-item mi_ora_AdjstSI in menu mnu_ora_tools
   run Perform_Func ("!ORACLE,22=ora,ora/_beauty").

/*----- "Schema Migration Tools" pop-up menu: Bulk Inserts -----*/
on choose of MENU-ITEM mi_ora_BInsert in menu mnu_ora_tools
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!ORACLE,1=s,_usrtget,9=f,ora/_oraload,*N,35=ora,_loddata").
   &ELSE
   run Perform_Func ("!ORACLE,1=s,_guitget,9=f,ora/_oraload,*N,35=ora,_loddata").
   &ENDIF

/*-----------------------Utilities/Quoter menu--------------------------*/

/*----- ENTIRE LINES -----*/
on choose of menu-item mi_Quo_EntLines  in menu mnu_Quoter 
   run Perform_Func ("1=1,_usrquot").

/*----- By DELIMITER -----*/
on choose of menu-item mi_Quo_Delimiter in menu mnu_Quoter 
   run Perform_Func ("1=d,_usrquot").

/*----- BY COLUMN RANGES -----*/
on choose of menu-item mi_Quo_ColRanges in menu mnu_Quoter 
   run Perform_Func ("1=c,_usrquot").

/*----- INCLUDE FILE -----*/
on choose of menu-item mi_Quo_InclFile  in menu mnu_Quoter 
   run Perform_Func ("1=m,_usrquot").


/*------------------Utilities/General Include File menu------------------*/

/*----- ASSIGN -----*/
on choose of menu-item mi_Incl_Assign   in menu mnu_GenIncl 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,_usrcgen").
   &ELSE
   run Perform_Func ("_guitget,_usrcgen").
   &ENDIF

/*----- FORM -----*/
on choose of menu-item mi_Incl_FORM     in menu mnu_GenIncl 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,_usrfgen").
   &ELSE
   run Perform_Func ("_guitget,_usrfgen").
   &ENDIF

/*----- DEFINE WORKFILE -----*/
on choose of menu-item mi_Incl_WorkFile in menu mnu_GenIncl 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,_usrwgen").
   &ELSE
   run Perform_Func ("_guitget,_usrwgen").
   &ENDIF


/*-----------------------Utilities/other menu items---------------------*/

/*----- PARAMETER FILE EDITOR -----*/
on choose of menu-item mi_Util_ParmFile in menu mnu_Utilities 
   run Perform_Func ("_usrpfed").

/*----- AUTO-CONNECT EDITOR -----*/
on choose of menu-item mi_Util_AutoConn  in menu mnu_Utilities
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrauto").
   &ELSE
   run Perform_Func ("_guiauto").
   &ENDIF

/*----- FREEZE/UNFREEZE -----*/
on choose of menu-item mi_Util_Freeze   in menu mnu_Utilities 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("_usrtget,_usrcold").
   &ELSE
   run Perform_Func ("_guitget,_usrcold").
   &ENDIF

/*----- INDEX DEACTIVATE -----*/
on choose of menu-item mi_Util_IdxDeact in menu mnu_Utilities
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("9=note,_usriact,1=a,_usrtget,9=off,_usriact").
   &ELSE
   run Perform_Func ("9=note,_usriact,1=a,_guitget,9=off,_usriact").
   &ENDIF

/*----- INFORMATION -----*/
on choose of menu-item mi_Util_Info     in menu mnu_Utilities 
   run Perform_Func ("_usrinfo").


/*---------------------------PRO/SQL menu-------------------------------*/

/*----- VIEW REPORT -----*/
on choose of menu-item mi_SQL_ViewRpt   in menu mnu_SQL 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrvget,_rptvqik").
   &ELSE
   run Perform_Func ("1=a,_guivget,_rptvqik").
   &ENDIF

/*----- DUMP AS CREATE VIEW -----*/
on choose of menu-item mi_SQL_DumpView  in menu mnu_SQL 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrvget,_usrvgen").
   &ELSE
   run Perform_Func ("1=a,_guivget,_usrvgen").
   &ENDIF

/*----- DUMP AS CREATE TABLE -----*/
on choose of menu-item mi_SQL_DumpTable in menu mnu_SQL 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrtget,_usrtgen").
   &ELSE
   run Perform_Func ("1=a,_guitget,_usrtgen").
   &ENDIF


/*--------------------------Reports menu----------------------------------*/

/*----- DETAILED TABLE REPORT -----*/
on choose of menu-item mi_Rpt_DetTbl    in menu mnu_Reports 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrtget,9=,_rptflds").
   &ELSE
   run Perform_Func ("1=a,_guitget,9=,_rptflds").
   &ENDIF

/*----- TABLE REPORT -----*/
on choose of menu-item mi_Rpt_Table     in menu mnu_Reports 
   run Perform_Func ("_rpttqik").

/*----- FIELD REPORT -----*/
on choose of menu-item mi_Rpt_Field     in menu mnu_Reports 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrtget,19=o,_rptfqik").
   &ELSE
   run Perform_Func ("1=a,_guitget,19=o,_rptfqik").
   &ENDIF

/*----- INDEX REPORT -----*/
on choose of menu-item mi_Rpt_Index     in menu mnu_Reports 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrtget,_rptiqik").
   &ELSE
   run Perform_Func ("1=a,_guitget,_rptiqik").
   &ENDIF

/*----- VIEW REPORT -----*/
on choose of menu-item mi_Rpt_View      in menu mnu_Reports 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrvget,_rptvqik").
   &ELSE
   run Perform_Func ("1=a,_guivget,_rptvqik").
   &ENDIF

/*----- SEQUENCE REPORT -----*/
on choose of menu-item mi_Rpt_Sequence  in menu mnu_Reports 
   run Perform_Func ("_rptsqik").

/*----- TRIGGER REPORT -----*/
on choose of menu-item mi_Rpt_Trigger   in menu mnu_Reports 
   run Perform_Func ("_rpttrig").

/*----- USER REPORT -----*/
on choose of menu-item mi_Rpt_User      in menu mnu_Reports 
   run Perform_Func ("_rptuqik").

/*----- TABLE RELATIONS REPORT -----*/
on choose of menu-item mi_Rpt_TblRel    in menu mnu_Reports 
   &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("1=a,_usrtget,_rptrels").
   &ELSE
   run Perform_Func ("1=a,_guitget,_rptrels").
   &ENDIF

/*----- AREA REPORT -----*/
on choose of menu-item mi_Rpt_Area      in menu mnu_Reports 
   run Perform_Func ("_rptaqik").

/*------WIDTH REPORT ----*/
ON CHOOSE OF MENU-ITEM mi_Rpt_Width IN MENU mnu_reports
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   run Perform_Func ("!PROGRESS,1=a,_usrtget,_rptwdth").
   &ELSE
   run Perform_Func ("!PROGRESS,1=a,_guitget,_rptwdth").
   &ENDIF

/*------ ALTERNATE BUFFER POOL WIDTH REPORT ----*/
ON CHOOSE OF MENU-ITEM mi_Rpt_AltBufPool IN MENU mnu_reports
   RUN Perform_Func ("_rptaltbuf").

/*------    Track Audit Policy Changes Report            -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_AudPol   IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=1,_rptaud"). /* AUD_POL_MNT */

/*------    Track Database Schema Changes Report         -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_DbSchma  IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=2,_rptaud"). /* SCH_CHGS */

/*------    Track Audit Data Administration Report       -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_AudAdmn  IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=3,_rptaud"). /* AUD_ARCHV */

/*------    Track Application Data Administration Report-------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_TblAdmn  IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=4,_rptaud"). /* DATA_ADMIN */

/*------    Track User Account Changes Report            -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_UsrAct   IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=5,_rptaud"). /* USER_MAINT */

/*------    Track Security Permissions Changes Report       -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_SecPerm  IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=6,_rptaud"). /* SEC_PERM_MNT */

/*------    Track Database Administrator Changes Report -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_Dba      IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=7,_rptaud"). /* DBA_MAINT */

/*------    Track Authentication System Changes Report   -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_AuthSys  IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=8,_rptaud"). /* AUTH_SYS */

/*------    Client Session Authentication Report         -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_CltSess IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=9,_rptaud"). /* CLT_SESS */

/*------    Database Administration Report               -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_DbAdmin IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=10,_rptaud"). /* DB_ADMIN */

/*------    Database Access Report                       -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_AppLogin IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=11,_rptaud"). /* DB_ACCESS */

/*------    Custom Audit Data Filter Report              -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_Cust IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=12,_rptaud"). /* CUST_RPT */

/*------    Track Encryption Policy Changes              -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_EncPol IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=13,_rptaud"). /* ENC_POL */

/*------    Track Key Store Changes                      -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_KeyStore IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=14,_rptaud"). /* ENC_KEYSTORE */

/*------   Database Encryption Administration (Utilities) -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_EncAdmin IN MENU mnu_Aud_Rep
  RUN Perform_Func ("9=15,_rptaud"). /* ENC_ADMIN */

/*------    Security Report - Quick                      -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_QkEncPol IN MENU mnu_enc_Rep
  RUN Perform_Func ("9=1,_rptencp").

/*------    Security Report - Detailed                   -------*/
ON CHOOSE OF MENU-ITEM mi_Rpt_DtEncPol IN MENU mnu_Enc_Rep DO:

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Database Administrator to access this report!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.

  user_env = "".
  RETURN NO-APPLY.
END.


IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot use this option with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  user_env = "".
  RETURN NO-APPLY.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
    RUN Perform_Func ("1=a,_usrtget,9=2,_rptencp").
&ELSE
    RUN Perform_Func ("1=a,_guitget,9=2,_rptencp").
&ENDIF

END.

/*------------------------------Tools menu-------------------------------*/

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
   {adecomm/toolrun.i &MENUBAR       = "mnu_Admin_Tool"
                      &EXCLUDE_ADMIN = yes 
                                   &EXCLUDE_DICT  = yes
   }
&ELSE
   {adecomm/toolrun.i &MENUBAR       = "mnu_Admin_Tool"
                      &EXCLUDE_ADMIN = yes 
   }
&ENDIF
if tool_bomb then return.  /* admin is already running so quit. */


/*-----------------------------Help menu----------------------------------*/

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
/*----- HELP CONTENTS -----*/
on choose of menu-item mi_Hlp_Topics in menu mnu_Help
   RUN "adecomm/_adehelp.p" ("admn", "TOPICS", ?, ?).

ON CHOOSE OF MENU-ITEM mi_Hlp_Master IN MENU mnu_Help
    RUN "adecomm/_adehelp.p" ("mast", "TOPICS", ?, ?).

/*----- MESSAGES HELP -----*/
on choose of menu-item mi_Hlp_Messages in menu mnu_Help
   run prohelp/_msgs.p.

/*----- RECENT MESSAGES HELP -----*/
on choose of menu-item mi_Hlp_Recent   in menu mnu_Help
   run prohelp/_rcntmsg.p.

/*----- HELP ABOUT ADMIN -----*/
on choose of menu-item mi_Hlp_About in MENU mnu_Help
   run adecomm/_about.p ("Database Administration", "adeicon/admin%").

&ENDIF
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* userpaus.i - pause that is not confused by end-error */
/*              this also does not do an input-clear like PAUSE would. */

IF TERMINAL <> "" THEN DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  READKEY PAUSE 0.
  IF LASTKEY = -1 THEN PAUSE.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*----------------------------------------------------------------
   Shared variables used for parameter file editor.

   Author: Tony Lavinio, Laura Stern
     Data: 02/03/93

     Tex updated 1/4/95 with 7.3b I18N parameters (cp**)
     DLM 10/01/99 Updated 9.1A valid Parameters
     DLM 01/31/00 Updated 9.1B valid Parameters
     DLM 02/19/03 Removed AS400 options
-----------------------------------------------------------------*/

/* arg_nam   - Starts as array of all the parm data: name description and type.
               Translated into array of arg name/description pairs 
               (e.g., -B   Buffers)
   arg_lst   - All parm names (-B) strung out in a comma delimited list
   arg_typ   - Array of argument data types ((l)ogical, (c)haracter, (n)umber)
   arg_val   - Array of values
   args#     - Number of arguments 
   arg_comm  - Array of comment lines 
   arg_comm# - # of non-blank comment lines
   pf_file   - The parameter file to edit.
*/

DEFINE {1} SHARED VARIABLE arg_lst   AS CHARACTER CASE-SENSITIVE NO-UNDO.
DEFINE {1} SHARED VARIABLE arg_typ   AS CHARACTER EXTENT 200     NO-UNDO.
DEFINE {1} SHARED VARIABLE arg_val   AS CHARACTER EXTENT 200     NO-UNDO.
DEFINE {1} SHARED VARIABLE args#     AS INTEGER   INITIAL 0      NO-UNDO.
DEFINE {1} SHARED VARIABLE arg_comm  AS CHARACTER EXTENT 10      NO-UNDO.
DEFINE {1} SHARED VARIABLE arg_comm# AS INTEGER   INITIAL 0      NO-UNDO.
DEFINE {1} SHARED VARIABLE pf_file   AS CHARACTER                NO-UNDO.

/* PKEY  is the actual parameter: "-B"
   PDESC is the description: "Buffers"
   PNAME is the key plus the description: "-B  Buffers" 
   COMM# is the number of comment lines supported
*/
&GLOBAL-DEFINE PKEY_LEN    16
&GLOBAL-DEFINE PDESC_LEN   20
&GLOBAL-DEFINE PNAME_LEN   37
&GLOBAL-DEFINE VAL_START   39
&GLOBAL-DEFINE VAL_CHARS   39   /*How many chars to allow input*/
&GLOBAL-DEFINE COMM_LEN           73
&IF "{&WINDOW-SYSTEM}" begins "MS-Win" &THEN
&GLOBAL-DEFINE COMM#       8
&ELSE
/* Change comm# to 6 if we use _guipfed.p under TTY */
&GLOBAL-DEFINE COMM#       10
&ENDIF

/*---------------------------------------------------------------------
   These labels match the VMS arguments wherever possible. 
   They should not be translated to non-English languages. 

   The following parameters are not valid in .pf files:
     -lm  (leave memory)
     -ovl (overlay buffer size)
     -rft (return fault table)
   
   The following parameters were deliberately left out to avoid problems:
     -K c   (keycapture mode)
     -noshm (no shared memory on server)
   
   There are a bunch of other parameters that are used only in utilities
   (like proshut).
   
----------------------------------------------------------------------*/

DEFINE {1} SHARED VARIABLE arg_nam AS CHARACTER EXTENT 158 NO-UNDO INITIAL [
  "1,SINGLE-USER,l",
  "adminport,ADMINSERVER-PORT,n",
  "aibufs,AFTER-IMAGE-BUFFERS,n",
  "aistall,AFTER-IMAGE-STALL,l",
  "asyncqueuesize,ASYNC-QUEUE-SIZE,n",
  "b,BATCH,l",
  "B,BUFFERS,n",
  "baseADE,ADE-CODE-LOC,c",
  "baseindex,BASE-INDEX,n",
  "basekey,REGISTRY-BASE-KEY,c",
  "basetable,BASE-TABLE,n",
  "bibufs,BI-BUFFERS,n",
  "bistall,THRESHOLD-STALL,l",
  "bithold,REC-LOG-THRESHOLD,n",
  "Bp,PRIVATE-RO-BUFFERS,n",
  "Bpmax,MAX-PRI-BUFFERS,n",
  "brl,BLEEDING-RECORD-LOCK,l",
  "Bt,TEMP-TABLE-BUFFERS,n",
  "c,INDEX-CURSORS,n",
  "cache,SCHEMA-CACHE-FILE,c",
  "checkdbe,CHECK-DBE,l",
  "classpath,JAVA-CLASSPATH,l",
  "clientlog,CLIENT-LOG,c",
  "convmap,CONVERSION-MAP,c",
  "cp,COMM-PARMFILE,c",
  "cpcase,CASE-CHAR-SET,c",
  "cpcoll,COLLATION-CHAR-SET,c",
  "cpinternal,INTERNAL-CHAR-SET,c",
  "cplog,LOG-FILE-CODE-PAGE,c",
  "cpprint,PRINTER-CHAR-SET,c",
  "cprcodein,READ-RCODE-CHAR-SET,c",
  "cprcodeout,WRITE-RCODE-CHAR-SET,c",
  "cpstream,STREAM-CHAR-SET,c",
  "cpterm,TERMINAL-CHAR-SET,c",
  "cs,CURSOR-SIZE,n",
  "d,DATE-FORMAT,c",
  "D,DIRECTORY-SIZE,n",
  "DataService,DATASERVICE,c",
  "db,DATABASE,c",
  "debug,DEBUG,l",
  "debugalert,DEBUG-ALERT-BOX,l",
  "dictexps,DICT-EXPRESSIONS,l",
  "directio,DIRECT-I/O,l",
  "Dsrv,DATASERVER,c",
  "dt,DB-TYPE,c",
  "E,EUROPEAN-NUMBERS,l",
  "esqllog,ESQL-LOG,l",
  "esqlnopad,ESQL-NO-PADDING,l",
  "evtlevel,EVENT-LEVEL,c",
  "expandbrow,EXPANDABLE-BROWSE,l",
  "fc,SCHEMA-FLD-CACHE-SZ,n",
  "filteroxcevents,FILTER-ASYNC-COM,l",
  "fldisable,FIELD-LIST-DISABLE,l",
  "G,BI-CLUSTER-AGE,n",
  "groupdelay,GROUP-DELAY,n",
  "h,MAX-DATABASES,n",
  "H,HOST-NAME,c",
  "hardlimit,HARDLIMIT,l",
  "hash,HASH,n",
  "i,NO-INTEGRITY,l",
  "icfparm,ICF-PARAMETERS,c",
  "indexrangesize,INDEX-RANGE-SIZE,n",
  "ininame,INITIALIZATION-FILE,c",
  "inp,MAX-STATEMENT-LEN,n",
  "isnoconv,INI-VAL-SEQ-NO-CVT,l",
  "k,KEYWORD-FORGET,c",
  "l,LOCAL-BUFFER-SIZE,n",
  "L,NUMBER-LOCKS,n",
  "ld,LOGICAL-DBNAME,c",
  "lkwtmo,LOCK-TIMEOUT,n",
  "lng,LANGUAGE-NAME,c",
  "m1,AUTO-SERVER,l",
  "m2,MANUAL-SERVER,l",
  "m3,LOGIN-BROKER,l",
  "Ma,MAXIMUM-CLIENTS,n",
  "maxport,MAX-DYNAMIC-SERVER,n",
  "Mf,DELAYED-BI-WRITE,n",
  "Mi,MINIMUM-CLIENTS,n",
  "minport,MIN-DYNAMIC-SERVER,n",
  "Mm,MESSAGE-BUFFER-SIZE,n",
  "mmax,MAX-R-CODE-MEMORY,n",
  "Mn,MAX-SERVERS,n",
  "Mp,SERVERS/PROTOCOL,n",
  "Mpb,MAX-SERVERS/BROKER,n",
  "Mpte,VLM-PG-TBL-ENT-OPT,l",
  "Mr,RECORD-BUFFER-SIZE,n",
  "Mxs,EXCESS-SHARED-MEM,n",
  "n,NUMBER-OF-USERS,n",
  "N,NETWORK-TYPE,c",
  "nb,NESTED-BLOCK-LIMIT,n",
  "NL,NO-LOCK-DEFAULT,l",
  "nochkttnames,NO-CHK-TEMP-TBL,l",
  "noindexhint,INDEX-HINT,l",
  "nojoinbysqldb,SERVER-JOIN,l",
  "noSQLbyserver,PASS-THRU-DISABLE,l",
  "numdec,FRACTIONAL-SEPARATOR,n",
  "numsep,THOUSANDS-SEPARATOR,n",
  "o,PRINTER,c",
  "ojmode,OUTER-JOIN-MODE,n",
  "p,STARTUP-PROCEDURE,c",
  "P,PASSWORD,c",
  "param,PARAMETER,c",
  "pf,PARAMETER-FILE,c",
  "pinshm,PIN-SHARED-MEM,l",
  "plm,PROLIB-MEMORY,l",
  "pls,PROLIB-SWAP,l",
  "populate,FAST-SCHEMA-CHANGE,l",
  "pp,ESQL-PROPATH,c",
  "properties,CONFIG-PROPS-FILE,c",
  "proxyhost,PROXY-HOST,c",
  "proxyPassword,PROXY-PASSWORD,c",
  "proxyport,PROXY-PORT,n",
  "ProxyUserid,PROXY-USERID,c",
  "q,QUICK-REQUEST,l",
  "Q,ANSI-SQL,l",
  "Q2,ANSI-SQL-CLIENT,l",
  "r,NON-RELIABLE-I/O,l",
  "rand,RANDOM-NUM-MODE,n",
  "rereadnolock,REREAD-NL,l",
  "rg,RUN-4GL-CLIENT,l",
  "RO,READ-ONLY-DATABASE,l",
  "rptint,LIC-USAGE-RPT-INTVAL,n",
  "rq,RUN-QUERY-CLIENT,l",
  "rr,RUN-RUNTIME-CLIENT,l",
  "rx,ENCRYPTED-COMPILER,l",
  "s,STACK-SIZE,n",
  "S,SERVICE-NAME,c",
  "semsets,SEMAPHORE-SETS,n",
  "servergroup,SERVER-GROUP,c",
  "ServerType,TYPE-OF-SERVER,c",
  "spin,SPIN-LOCK-TRIES,n",
  "SQLStackSize,SQL92-STACK-SZ,n",
  "SQLStmtCacheSize,SQL92-STMT-SZ,n",
  "stsh,STASH-AREA-SIZE,n",
  "SV,OI-DRIVER-CONNECTION,c",
  "t,SAVE-TEMP-FILES,l",
  "T,TEMP-FILE-DIRECTORY,c",
  "tablerangesize,TABLE-RANGE-SIZE,n",
  "TB,SORT-BLOCK-SIZE,n",
  "TM,MERGE-BUFFER-COUNT,n",
  "tok,MAX-TOKENS,n",
  "trig,TRIGGER-LOCATION,c",
  "U,USERID,c",
  "usrcount,USER-COUNT,n",
  "v6colon,VERSION-6-COLON,l",
  "v6q,V6-QUERY,l",
  "wss,WIN-SINGLE-SESSION,l",
  "wy,WINDOWS-EXIT,c",
  "y,STATISTICS,l",
  "yc,STATISTICS-CTRLC,l",
  "yd,SEGMENT-STATISTICS,l",
  "yr4def,4-DIGIT-YEAR-DEFAULT,l",
  "yx,STATISTICS-XREF,l",
  "yy,YEAR-OFFSET,n",
  ""
].


/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *                         *
**********************************************************************/

/* userpik.i - definitions for flexible 'pick' program _usrpick.p */
/*
pik_chosen - list of chosen element ids (was pik_choice)
pik_column - column position of frame   (0 for default)
pik_count  - number of elements in      (was pik_chextent)
pik_down   - iterations of down frame   (usually 0 for default)
pik_first  - first element out or ?     (same as pik_list[pik_chosen[1]])
pik_hide   - hide frame when done?
pik_init   - initial value to position cursor
pik_list   - list of elements in        (was pik_chlist)
pik_multi  - can pick multiple?         (was pik_multiple)
pik_number - number the elements?       (only with pik_multi)
pik_return - number of elements chosen  (was pik_chcnt)
pik_row    - row position of frame      (0 for default)
pik_skip   - use 'skip number' option   (only with pik_number)
pik_start  - set true/false from values in pik_chosen
pik_title  - title of frame             (spaces prepended and appended)
pik_wide   - use wide frame?
pik_text   - instructional text 
pik_help   - a help context Id to explain this use of the picker.
*/

/*input:*/
DEFINE {1} SHARED VARIABLE pik_column AS INTEGER                NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_count  AS INTEGER                NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_down   AS INTEGER                NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_hide   AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_init   AS CHARACTER INITIAL  ""	NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_list   AS CHARACTER EXTENT 2000	NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_multi  AS LOGICAL   INIT FALSE   NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_number AS LOGICAL		NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_row    AS INTEGER		NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_skip   AS LOGICAL   INIT FALSE   NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_title  AS CHARACTER		NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_wide   AS LOGICAL		NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_text   AS CHARACTER INITIAL ?	NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_help   AS INTEGER 	        NO-UNDO.

/* 20060717-022
   Handle too many items to be picked 
*/
DEFINE {1} SHARED TEMP-TABLE ttpik
    FIELD i_number AS INTEGER
    FIELD c_name   AS CHARACTER
    FIELD i_flag   AS INTEGER
    INDEX i_number i_number.

/*output:*/
DEFINE {1} SHARED VARIABLE pik_chosen AS INTEGER   EXTENT 2000  NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_first  AS CHARACTER              NO-UNDO.
DEFINE {1} SHARED VARIABLE pik_return AS INTEGER   INITIAL 0    NO-UNDO.

/*local:*/
DEFINE VARIABLE p_mark  AS CHARACTER NO-UNDO.
DEFINE VARIABLE p_recid AS INTEGER   NO-UNDO.
DEFINE VARIABLE nextnum AS INTEGER   NO-UNDO.

/*frames:*/
DEFINE {1} SHARED FRAME pick1.
DEFINE {1} SHARED FRAME pick2.

/*forms:*/
FORM
  p_mark            FORMAT "x(3)" NO-ATTR-SPACE SPACE(0)
  pik_list[p_recid] FORMAT "x(32)"   ATTR-SPACE SPACE(0)
  WITH FRAME pick1 SCROLL 1 OVERLAY NO-LABELS NO-ATTR-SPACE
  pik_down DOWN ROW pik_row COLUMN pik_column
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg)
  TITLE COLOR VALUE(pick-fg) pik_title
  USE-TEXT.
FORM
  p_mark            FORMAT "x(3)" NO-ATTR-SPACE SPACE(0)
  pik_list[p_recid] FORMAT "x(40)"   ATTR-SPACE SPACE(0)
  WITH FRAME pick2 SCROLL 1 OVERLAY NO-LABELS NO-ATTR-SPACE
  pik_down DOWN ROW pik_row COLUMN pik_column
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg)
  TITLE COLOR VALUE(pick-fg) pik_title
  USE-TEXT. 
  
/* This frame is used to display the next number in the
 * flagging sequence when 'skip' is turned on. Otherwise,
 * it is hidden.
 */
FORM
  nextnum FORMAT ">,>>9" NO-ATTR-SPACE SPACE(0)
  WITH FRAME fskip NO-LABELS TITLE "Next Num" USE-TEXT.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* userquot.i - a portion of a form used by _usrquot.p in two places */

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
&SCOPED-DEFINE SPACER SPACE(.2)
&SCOPED-DEFINE LINEUP 2
&ELSE
&SCOPED-DEFINE SPACER 
&SCOPED-DEFINE LINEUP 4
&ENDIF

l[ 1] AT {&LINEUP} {&SPACER} "to" {&SPACER} u[ 1] SPACE(4)
l[ 2]              {&SPACER} "to" {&SPACER} u[ 2] SPACE(4)
l[ 3]              {&SPACER} "to" {&SPACER} u[ 3] SPACE(4)
l[ 4]              {&SPACER} "to" {&SPACER} u[ 4]
		SKIP({&VM_WID})  
l[ 5] AT {&LINEUP} {&SPACER} "to" {&SPACER} u[ 5] SPACE(4)
l[ 6]              {&SPACER} "to" {&SPACER} u[ 6] SPACE(4)
l[ 7]              {&SPACER} "to" {&SPACER} u[ 7] SPACE(4)
l[ 8]              {&SPACER} "to" {&SPACER} u[ 8]
		SKIP({&VM_WID})  
l[ 9] AT {&LINEUP} {&SPACER} "to" {&SPACER} u[ 9] SPACE(4)
l[10]              {&SPACER} "to" {&SPACER} u[10] SPACE(4)
l[11]              {&SPACER} "to" {&SPACER} u[11] SPACE(4)
l[12]              {&SPACER} "to" {&SPACER} u[12]
		SKIP({&VM_WID})  
l[13] AT {&LINEUP} {&SPACER} "to" {&SPACER} u[13] SPACE(4)
l[14]              {&SPACER} "to" {&SPACER} u[14] SPACE(4)
l[15]              {&SPACER} "to" {&SPACER} u[15] SPACE(4)
l[16]              {&SPACER} "to" {&SPACER} u[16]
		SKIP({&VM_WID}) 
l[17] AT {&LINEUP} {&SPACER} "to" {&SPACER} u[17] SPACE(4)
l[18]              {&SPACER} "to" {&SPACER} u[18] SPACE(4)
l[19]              {&SPACER} "to" {&SPACER} u[19] SPACE(4)
l[20]              {&SPACER} "to" {&SPACER} u[20]
		SKIP({&VM_WID}) 
l[21] AT {&LINEUP} {&SPACER} "to" {&SPACER} u[21] SPACE(4)
l[22]              {&SPACER} "to" {&SPACER} u[22] SPACE(4)
l[23]              {&SPACER} "to" {&SPACER} u[23] SPACE(4)
l[24]              {&SPACER} "to" {&SPACER} u[24]
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/* usersecu.i - security instructions portion of frame */

"Examples:"                                         AT 2  VIEW-AS TEXT
"*" 	       	     	      	       	     	    AT 4  VIEW-AS TEXT
  "- All users (login Ids) are allowed access."     AT 23 VIEW-AS TEXT SKIP
"<user>,<user>,etc."                                AT 4  VIEW-AS TEXT
  "- Only these users have access."                 AT 23 VIEW-AS TEXT SKIP
"!<user>,!<user>,*"                                 AT 4  VIEW-AS TEXT
  "- All except these users have access."           AT 23 VIEW-AS TEXT SKIP
"acct*":t18     	     	      	       	    AT 4  VIEW-AS TEXT
  "- Only users that begin with ~"acct~" allowed."  AT 23 VIEW-AS TEXT 
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
     SKIP({&VM_WIDG})  /*Don't need and can't afford blank line in TTY*/
&ENDIF
"Do not use spaces in the string (they will be taken literally)." 
      	       	     	      	       	     	    AT 2  VIEW-AS TEXT


/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*-------------------------------------------------------------
   usertrgw.i - trigger warning
      User wants to check syntax explicitly or implicitly 
      because he wants crc checking but we know it won't compile
      because table isn't committed yet.

   &widg = widget to reset to no (either the crc check toggle 
      	   or the check syntax toggle)
----------------------------------------------------------------*/

MESSAGE "Trigger code that references uncommitted schema tables"     SKIP
        "(such as this new or renamed table) will not compile"       SKIP
        "successfully."       	       	     	      	             SKIP(1)
        "You can save your trigger code now but if you want"         SKIP
        "to make sure there are no syntax errors, you must"          SKIP
        "commit table changes first. (As soon as you leave the"      SKIP
        "Table Editor the table changes are committed to the"        SKIP
      	"database.)" 	      	       	     	      	             SKIP(1)
        "NOTE: Choosing ~"Check CRC~" will require that the"         SKIP
        "trigger code be compiled before it is saved."
         view-as ALERT-BOX INFORMATION buttons OK.

{&widg}:SCREEN-VALUE = "no".
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* Progress Lex Converter 7.1A->7.1B Version 1.11 */

/*
   Do some OK processing for one trigger for either a table trigger or
   field trigger.
   
   Arguments:
      Frame	    - Indicates what frame to use in the form of "FRAME x".
      pname	    - The variable for the proc name 
      override      - The variable for the override flag
      crc	    - The variable for the crc flag
      new_crc_val   - The variable for the new crc value
      old_crc_val   - The variable for the new crc value
      changed       - Variable indicating if values were modified.
*/


DEFINE VAR fname AS CHAR NO-UNDO.

{&pname} = INPUT {&Frame} {&pname}.
   	    
/* If user wants to store crc and they haven't explicitly gone into
   the trigger code and recompiled, do it now in case they changed
   the source outside of the dictionary.  This is true even for new
   triggers - user may refer to an existing .p. 
*/
IF {&pname} <> "" AND {&pname} <> ? AND 
   INPUT {&Frame} {&crc} AND {&new_crc_val} = {&old_crc_val} then
DO:
   fname = SEARCH({&pname}).
   if fname = ? then fname = {&pname}.
   COMPILE VALUE(fname) NO-ERROR.
   IF NOT COMPILER:ERROR THEN
   DO:
      RCODE-INFO:FILENAME = fname.
      {&new_crc_val} = RCODE-INFO:CRC-VALUE.
   END.
   ELSE DO:
      MESSAGE "In order to store the CRC value, the trigger" SKIP
              "code must be compiled.  The following error" SKIP
              "occurred when trying to compile " fname SKIP(1) 
              ERROR-STATUS:GET-MESSAGE(1) SKIP(1)
              "Either fix this problem or turn off CRC checking."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN NO-APPLY.
   END.
END. 
 
/* indicates if dirty */
{&changed} = {&changed} OR
	     {&Frame} {&pname}    ENTERED OR 
	     {&Frame} {&override} ENTERED OR
	     {&Frame} {&crc}      ENTERED OR
	     {&new_crc_val} <> {&old_crc_val}.

 




/***********************************************************************
* Copyright (C) 2006-2011 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
************************************************************************/

/* History:                                                         *
 * kmcintos     04/13/04    Added support for ODBC type DB2/400     *
 * kmcintos     04/04/05    Added variables for Auditing Support    *
 * kmcintos     07/27/05    Removed unused longchar variable        *
 * kmcintos     08/18/05    Added logical for audit policy commit   *
 *                          20050629-018                            *
 * fernando     03/14/06    Handle case with too many tables selected*
 *                          20050930-006                            */
   
/* uservar.i - dictionary user interface variable definitions */

{adecomm/adestds.i}

DEFINE {1} SHARED VARIABLE user_dbname   AS CHARACTER           NO-UNDO.
DEFINE {1} SHARED VARIABLE user_dbtype   AS CHARACTER           NO-UNDO.
DEFINE {1} SHARED VARIABLE user_env      AS CHARACTER EXTENT 42 NO-UNDO.
/* NOTE: this variable-definition has to be in sync with adedict/dictvar.i */
DEFINE {1} SHARED VARIABLE user_filename AS CHARACTER           NO-UNDO.
DEFINE {1} SHARED VARIABLE user_hdr      AS CHARACTER           NO-UNDO.
DEFINE {1} SHARED VARIABLE user_menupos  AS INTEGER   INITIAL ? NO-UNDO.
DEFINE {1} SHARED VARIABLE user_path     AS CHARACTER           NO-UNDO.
DEFINE {1} SHARED VARIABLE user_trans    AS CHARACTER           NO-UNDO.
DEFINE {1} SHARED VARIABLE user_status   AS CHARACTER INITIAL ? NO-UNDO.
DEFINE {1} SHARED VARIABLE user_library  AS CHARACTER           NO-UNDO.

DEFINE {1} SHARED VARIABLE index-area-number AS INTEGER INITIAL 6 NO-UNDO.

DEFINE BUTTON btn_Ok     LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

DEFINE {1} SHARED STREAM logfile.
DEFINE {1} SHARED VARIABLE logfile_open AS LOGICAL NO-UNDO INITIAL false.

/* kmcintos "Auditing support" */
DEFINE {1} SHARED VARIABLE user_overwrite AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE user_commit    AS LOGICAL   NO-UNDO.
DEFINE {1} SHARED VARIABLE user_excepts   AS CHARACTER NO-UNDO.

/* for bug fix 20050930-006 */
DEFINE {1} SHARED VARIABLE user_longchar  AS LONGCHAR NO-UNDO.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN  &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN  /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
&ENDIF


&IF "{&WINDOW-SYSTEM}" <> "TTY"
 AND "{&DICTG}" <> "dictg"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF

/* used to define the display name of the product. It used to be PROGRESS,
and now we are changigng it to OpenEdge. Creating define so that the next time
we change it, we don't have to go through changing all necessary source
files again 
*/
&GLOBAL-DEFINE PRO_DISPLAY_NAME OpenEdge
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* usrdump1.i   

function:
     on leave - trigger for field user_env[5] (code-page)
   
text-parameters:
    &frame          frame containing the field
    &variable       name of the field
    
included in:
  prodict/user/_usrdump.p    
  prodict/user/_usrincr.p    
    
history:
    hutegger    94/03/02    creation
    
*/
/*------------------ begin Trailer-INFO ------------------*/

ON LEAVE OF {&variable} in frame {&frame} do:    

  if {&variable}:screen-value in frame {&frame} = "?" 
   then assign {&variable}:screen-value in frame {&frame} = "<internal defaults apply>".

   else do:
    assign
      {&variable} = TRIM({&variable}:screen-value in frame {&frame})
      {&variable}:screen-value in frame {&frame} = {&variable}.
    if codepage-convert("a",{&variable},SESSION:CHARSET) = ? 
     then RETURN NO-APPLY. /* conversion not possible */
    end.      /* {&variable} <> ? */

   end.         /* leave of {&variable} in frame {&frame} */

/*--------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2008 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *                         *
*********************************************************************/

/*************************************************************
   _usrtget-tt.p - select a table (cache information is in the temp-table.
                   This is a copy of prodict/user/_usrtget.p which handles
                   the cached information in the temp-table, which is only
                   used when we can't hold the table names in the cache_file
                   array. Fixing bug 20050930-006.

History:
    laurief  04/09/98  Added p_allw and count to allow us to compare
                       the number of tables selected to the total
                       number of tables available.  This needs to be
                       done in the case where a user is not typing "ALL",
                       instead the user types an "*" in the 
                       select/deselect dialog.  This allows us to 
                       compare count with cache_file# and if they are
                       equal, the .df will contain all database schema
                       info correctly.  BUG 97-07-22-029
   mcmann  04/20/98    Added exclusion of views from table list.
   mcmann  07/09/98    Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                       to Find _File
   Mario B 12/11/98   The ALL option was appearing in places where
                      it should not.  Changed display with frame t-type so
		      that p_all and p_allw are ANDed instead of ORed.  That
		      fixed it.  BUG 98-05-06-056  
   Mario B 11/11/98   More fixes to the "ALL" option.  All not needed when
                      pattern matching is presented.  BUG# 19991025-003
   D. McMann 05/10/00 Added ability for user to display hidden files
   fernando  02/02/02 storing table names in temp-table - 20050930-006.
   fernando  12/13/07 Handle long list of "some" selected tables    
   fernando  06/26/08 Filter out schema tables for encryption
*************************************************************/


{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

/*
INPUT:
user_env[1] MATCHES "*o*":
  If this program sees an "o" (for "optional") in user_env[1], then it
  returns immediately if a filename is currently set (other than
  "ALL").

user_env[1] MATCHES "*a*":
  If this program sees an "a" (for "all"), then "ALL" is a valid
  choice.

user_env[1] MATCHES "*s*":
  If this program sees an "s" (for "some"), then [Return] marks (or
  unmarks) names, and the comma-delimited list of names is returned in
  user_env[1].


OUTPUT:
drec_file
  Contains the recid of the _File record selected, or no record if
  'ALL' or some entered.

user_filename
user_env[1]
  Contains the filename selected, or 'ALL', or a comma-separated list
  of filenames.  If a comma-sep list is returned in user_env[1], 'SOME'
  is returned in user_filename.
*/

DEFINE VARIABLE c          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE g          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE h          AS CHARACTER              NO-UNDO.
DEFINE VARIABLE h2         AS CHARACTER              NO-UNDO.
DEFINE VARIABLE hb         AS INTEGER                NO-UNDO.
DEFINE VARIABLE i          AS INTEGER                NO-UNDO.
DEFINE VARIABLE sh         AS CHARACTER              NO-UNDO.
DEFINE VARIABLE inc-hid    AS LOGICAL INITIAL FALSE  NO-UNDO.
DEFINE VARIABLE j          AS INTEGER                NO-UNDO.
DEFINE VARIABLE l          AS LOGICAL                NO-UNDO.
DEFINE VARIABLE lb         AS INTEGER                NO-UNDO.
DEFINE VARIABLE noselect   AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE offset     AS INTEGER   INITIAL 20   NO-UNDO.
DEFINE VARIABLE p_all      AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_allw     AS LOGICAL                NO-UNDO.
DEFINE VARIABLE count      AS INTEGER   INITIAL 0    NO-UNDO.
DEFINE VARIABLE p_init     AS INTEGER   INITIAL ?    NO-UNDO.
DEFINE VARIABLE p_option   AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_original AS CHARACTER              NO-UNDO.
DEFINE VARIABLE p_recid    AS INTEGER   INITIAL 1    NO-UNDO.
DEFINE VARIABLE p_some     AS LOGICAL                NO-UNDO.
DEFINE VARIABLE p_spot     AS INTEGER                NO-UNDO.
DEFINE VARIABLE p_touch    AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE p_typed    AS CHARACTER INITIAL ""   NO-UNDO.
DEFINE VARIABLE pattern    AS CHARACTER INITIAL "*"  NO-UNDO.
DEFINE VARIABLE point_flag AS LOGICAL   EXTENT  2048 NO-UNDO.
DEFINE VARIABLE redraw     AS LOGICAL   INITIAL TRUE NO-UNDO.
DEFINE VARIABLE small      AS INTEGER                NO-UNDO.
DEFINE VARIABLE cFirst     AS CHARACTER              NO-UNDO.
DEFINE VARIABLE cNext      AS CHARACTER              NO-UNDO.
DEFINE VARIABLE cLast      AS CHARACTER              NO-UNDO.
DEFINE VARIABLE cTemp      AS CHARACTER              NO-UNDO.
DEFINE VARIABLE cFile_name AS CHARACTER              NO-UNDO.
DEFINE VARIABLE p_curflag  AS LOGICAL                NO-UNDO.
DEFINE VARIABLE isCpUndefined AS LOGICAL             NO-UNDO.
DEFINE VARIABLE use_lchar  AS LOGICAL                NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/

DEFINE VARIABLE new_lang AS CHARACTER EXTENT 13 NO-UNDO INITIAL [
  /*  1*/ "(or ~"ALL~" for all tables)", /* length must be <= 26 */
  /*  2*/ "The entered name does not match any table name in this database.",
  /*  3*/ "Use direction keys navigate, or begin typing table name.",
  /*  4*/ "You do not have permission to select tables.",
  /*5,6*/ "Press the", "key to end.",
  /*  7*/ "key.",
  /*  8*/ "when done.",
  /*  9*/ "Press",
  /* 10*/ "to select/deselect",
  /* 11*/ "by pattern.",
  /* 12*/ "There are no tables in this database to select.",
  /* 13*/ "key to show/hide hidden files."
].

FORM
  p_curflag FORMAT "*/ "
  cFile_name FORMAT "x(34)"
  WITH FRAME t-pick SCROLL 1 NO-LABELS ATTR-SPACE
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg)
  SCREEN-LINES - 10 DOWN ROW 7 COLUMN offset. /* see below if changing DOWN */

FORM
  c          LABEL "Table Name" FORMAT "x(26)" NO-ATTR-SPACE SKIP
  p_typed NO-LABEL              FORMAT "x(37)"
  WITH FRAME t-type SIDE-LABELS ATTR-SPACE ROW 3 COLUMN offset
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg).
COLOR DISPLAY VALUE(IF pick-bg = "MESSAGES" THEN "INPUT" ELSE pick-bg) p_typed
  WITH FRAME t-type.

FORM
  "Select tables with the [" SPACE(0) c FORMAT "x(14)" SKIP
  "Press [" SPACE(0) g FORMAT "x(32)" SKIP
  h FORMAT "x(34)" h2 FORMAT "x(12)"  SKIP
  sh FORMAT "x(45)"
  WITH FRAME t-help NO-LABELS NO-ATTR-SPACE ROW 1 COLUMN offset
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg).

FORM SKIP(1)
  "Enter name of table to" AT 2
  l FORMAT "select./deselect." NO-LABEL SKIP

  "Use * and . for wildcard patterns." AT 2 SKIP(1)

  pattern AT 2 LABEL "Table Name" FORMAT "x(30)" SKIP(1)
  WITH FRAME t-patt OVERLAY ROW 7 CENTERED SIDE-LABELS ATTR-SPACE
  COLOR DISPLAY VALUE(pick-fg) PROMPT VALUE(pick-bg).

/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/


/*************************************************************************  
    THIS CODE IS ALREADY IN prodict/user/_usrtget.p, which is the procedure
    that call this. Commenting it out - leaving it here just for reference.
 *************************************************************************
 
IF cache_dirty THEN RUN "prodict/_dctcach.p" (inc-hid).

i = 0.
FIND _File WHERE _File._File-name = "_File"
             AND _File._Owner = "PUB".
IF NOT CAN-DO(_Can-read,USERID("DICTDB")) THEN i = 4. /* no perm to peek */
IF cache_file# = 0 THEN DO:
  FIND FIRST _File WHERE _Db-recid = drec_db 
                     AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                     AND _Hidden NO-ERROR.
  IF NOT AVAILABLE _File THEN i = 12. /* no files */
END.
IF i > 0 THEN DO:
  MESSAGE new_lang[i] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  ASSIGN
    drec_file     = ?
    user_path     = ""
    user_filename = ""
    user_env[1]   = "".
  RETURN.
END.

**************************************************************************/

IF user_filename <> "" THEN DO:

  ASSIGN i = 0
         j = 0.

  FOR EACH tt_cache_file NO-LOCK:
      ASSIGN j  = 1 + 1.
      IF tt_cache_file.cName BEGINS user_filename THEN DO:
          ASSIGN i = j.
          LEAVE.
      END.
  END.

  IF i > 0 THEN ASSIGN
    p_init  = MINIMUM(SCREEN-LINES - 10,i)
    p_recid = i.
END.

ASSIGN
  p_option      = user_env[1] MATCHES "*o*" AND drec_file <> ?
  p_all         = user_env[1] MATCHES "*a*"
  p_allw        = user_env[1] MATCHES "***"
  p_some        = user_env[1] MATCHES "*s*"
  p_typed       = (IF user_filename = "SOME" THEN "" ELSE user_filename)
  cache_dirty   = p_some AND p_all OR (p_some AND p_allw) /* this is important! */
  user_filename = "".

IF SESSION:CPINTERNAL EQ "undefined":U THEN
   isCpUndefined = YES.

/* get the first table name */
FIND FIRST tt_cache_file NO-LOCK NO-ERROR.
IF AVAILABLE tt_cache_file THEN
    ASSIGN cFile_name = tt_cache_file.cName.
ELSE
    ASSIGN cFile_name = "".

IF p_all AND p_allw AND cFile_name <> "ALL" AND cache_file# >= 1 THEN DO:
    /* adding "ALL" to the list - go backwards so we don't violate the 
       unique index on nPos
    */
    FOR EACH tt_cache_file BY nPos DESC:
      ASSIGN tt_cache_file.nPos = tt_cache_file.nPos + 1.
    END.
    
    /* now add "ALL" as the first entry */
    CREATE tt_cache_file.
    ASSIGN tt_cache_file.nPos = 1
         tt_cache_file.cName = "ALL".

    ASSIGN
    cFile_name = "ALL"
    cache_file#   = cache_file# + 1.  
END.
ELSE IF NOT p_all AND p_allw AND cFile_name = "ALL" THEN
DO:
  /* This means "ALL" should not be offered BUG# 19991025-003
   * This is certainly strange, but "ALL" may have been put into
   * cache_file[1] before we got here.  It was easier to do this
   * than to modify every program that calls this.
   */
  IF cache_file# > 1 THEN DO:
      FIND FIRST tt_cache_file.
      DELETE tt_cache_file.
      cFile_name = "".

      /* get the first table name */
      FIND FIRST tt_cache_file NO-ERROR.
      IF AVAILABLE tt_cache_file THEN
          cFile_name =  tt_cache_file.cName.
    
      /* fix nPos value */
      FOR EACH tt_cache_file:
          ASSIGN tt_cache_file.nPos = tt_cache_file.nPos - 1.
      END.

      cache_file# = cache_file# - 1.
  END.
  ELSE if cache_file# = 1 THEN DO:
      ASSIGN
         cFile_name = ""
         cache_file# = 0.

      /* make sure temp-table is clean */
      EMPTY TEMP-TABLE tt_cache_file NO-ERROR.
  END.
END.

IF (p_typed = "ALL" AND NOT p_all)
  OR (p_typed = "" AND cache_file# > 0) THEN p_typed = cFile_name.
p_original =  p_typed.

IF p_option THEN user_filename = p_typed.
ELSE IF p_some THEN 
  DISPLAY
  KBLABEL("RETURN") + "] " + new_lang[7] @ c
  KBLABEL("GO")     + "] " + new_lang[8] @ g
  new_lang[9] + " [" + KBLABEL("GET") + "]/[" + KBLABEL("PUT")
                    + "] " + new_lang[10] @ h 
  new_lang[11] @ h2 
  new_lang[5] + " [" + KBLABEL("RECALL") + "] " + new_lang[13] @ sh
  WITH FRAME t-help.
ELSE DISPLAY (IF p_all AND p_allw THEN new_lang[1] ELSE "") @ c WITH FRAME t-type.
                         /* ^-- (or "ALL" for all files) */
IF NOT p_option THEN DO:
  DISPLAY "" @ cFile_name WITH FRAME t-pick.

  user_status = new_lang[5] + " [" + KBLABEL("END-ERROR") + "] " + new_lang[6].
  STATUS DEFAULT user_status.

  IF NOT p_option THEN _pick: DO WHILE TRUE: 

    p_recid = MAXIMUM(1,MINIMUM(cache_file#,p_recid)).

    IF redraw THEN DO WITH FRAME t-pick:
      IF p_init <> ? THEN DOWN p_init - 1.
      ASSIGN
        j      = MAXIMUM(1,FRAME-LINE)
        p_spot = p_recid - j + 1
        p_init = ?.
      UP j - 1.
      IF p_spot < 1 THEN ASSIGN
        p_spot  = 1
        j       = 1
        p_recid = 1.
      i = p_recid.
      DO p_recid = p_spot TO p_spot + FRAME-DOWN - 1:
        IF p_recid > cache_file# THEN
          CLEAR NO-PAUSE.
        ELSE DO:
          RUN get-file-info(INPUT p_recid).
          DISPLAY p_curflag cFile_name.
        END.
        IF p_recid < p_spot + FRAME-DOWN - 1 THEN DOWN.
      END.
      ASSIGN
        p_init  = ?
        redraw  = FALSE
        p_recid = i
        j       = (IF p_init = ? THEN j ELSE p_init).
      UP FRAME-DOWN - j.
    END.

    ASSIGN cNext = "".

    IF cache_file# > 0 THEN DO:
      /* find the next table-name*/
      FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = p_recid + 1 NO-ERROR.
      IF AVAILABLE tt_cache_file THEN
          cNext = tt_cache_file.cName.

      RUN get-file-info(INPUT p_recid).
      DISPLAY p_curflag cFile_name WITH FRAME t-pick.
    END.

    IF cache_file# > 0 AND cFile_name BEGINS p_typed AND
      (p_some OR p_recid = cache_file# OR cFile_name = p_typed
      OR NOT cNext BEGINS p_typed) THEN
      COLOR DISPLAY VALUE(pick-bg) cFile_name WITH FRAME t-pick.
    
    IF NOT p_some THEN DO WITH FRAME t-type:
      IF INPUT p_typed <> p_typed THEN DISPLAY p_typed.
      PUT CURSOR ROW 6 COLUMN offset + 2 + LENGTH(p_typed).
    END.
    READKEY.
    IF NOT p_some THEN PUT CURSOR OFF.
    IF cache_file# > 0 THEN
      COLOR DISPLAY VALUE(pick-fg) cFile_name WITH FRAME t-pick.
    PAUSE 0.

    IF KEYFUNCTION(LASTKEY) = "BACKSPACE" THEN DO:
      IF LENGTH(p_typed) = 0 THEN NEXT _pick.
      ASSIGN
        p_touch = FALSE
        p_typed = SUBSTRING(p_typed,1,LENGTH(p_typed) - 1)
        i       = (IF p_typed = "" THEN 1 ELSE p_recid).

      FOR EACH tt_cache_file WHERE tt_cache_file.nPos < i NO-LOCK:
          IF tt_cache_file.cName BEGINS p_typed THEN
              ASSIGN i = i - 1.
          ELSE
              LEAVE.
      END.

      IF FRAME-LINE(t-pick) >= p_recid - i THEN
        UP p_recid - i WITH FRAME t-pick.
      ELSE
        redraw = TRUE.
      p_recid = i.
      NEXT _pick.
    END.

    IF KEYFUNCTION(LASTKEY) = CHR(LASTKEY) AND LASTKEY > 32 THEN DO:
      ASSIGN
        p_typed = (IF p_touch THEN "" ELSE p_typed) + CHR(LASTKEY)
        p_touch = FALSE.

      IF cache_file# > 0 THEN DO:
         FIND FIRST tt_cache_file.
         ASSIGN cFirst = tt_cache_file.cName.
         FIND LAST tt_cache_file.
         ASSIGN cLast = tt_cache_file.cName.
         RUN get-file-info(INPUT p_recid).
      END.

      IF   (cache_file# = 0)
        OR (cFile_name BEGINS p_typed)
        OR (p_typed < SUBSTRING(cFirst,1,LENGTH(p_typed)))
        OR (p_typed > cLast)
        OR (LENGTH(p_typed) > 1 AND NOT cFile_name BEGINS
            SUBSTRING(p_typed,1,LENGTH(p_typed) - 1)) THEN NEXT _pick.

      ASSIGN i = 0
             j = 0.

      FOR EACH tt_cache_file NO-LOCK:
          ASSIGN i = i + 1.
          IF tt_cache_file.cName BEGINS p_typed THEN DO:
              ASSIGN j = i.
              LEAVE.
          END.
      END.

      IF j < 0 THEN j = p_recid.
      p_spot = j - p_recid + FRAME-LINE(t-pick).
      IF j > 0 THEN p_recid = j.
      IF p_spot < 1 OR p_spot > FRAME-DOWN(t-pick) THEN
        redraw = TRUE.
      ELSE
        UP FRAME-LINE(t-pick) - p_spot WITH FRAME t-pick.
      NEXT _pick.
    END.

    IF p_some AND cache_file# > 0 AND (
        (noselect AND KEYFUNCTION(LASTKEY) = "GO") /*if SOME & none yet marked*/
      OR
        CAN-DO("RETURN,PICK",KEYFUNCTION(LASTKEY) )
      ) THEN DO:

      RUN get-file-info(INPUT p_recid).

      ASSIGN
        noselect            = FALSE
        p_curflag = NOT p_curflag.

      IF AVAILABLE tt_cache_file THEN
         ASSIGN tt_cache_file.p_flag = p_curflag.

      DISPLAY p_curflag WITH FRAME t-pick.
    END.
    /*ELSE*/ /* no else here */
    IF CAN-DO("CURSOR-DOWN,TAB, " + (IF p_some THEN ",RETURN" ELSE ""),
      KEYFUNCTION(LASTKEY)) AND p_recid < cache_file# THEN DO:
      p_recid = p_recid + 1.
      IF FRAME-LINE(t-pick) = FRAME-DOWN(t-pick) THEN
        SCROLL UP WITH FRAME t-pick.
      ELSE
        DOWN WITH FRAME t-pick.
    END.
    ELSE
    IF CAN-DO("CURSOR-UP,BACK-TAB",KEYFUNCTION(LASTKEY))
      AND p_recid > 1 THEN DO:
      p_recid = p_recid - 1.
      IF FRAME-LINE(t-pick) = 1 THEN
        SCROLL DOWN WITH FRAME t-pick.
      ELSE
        UP WITH FRAME t-pick.
    END.
    ELSE IF KEYFUNCTION(LASTKEY) = "RECALL" THEN DO:
      IF inc-hid THEN
        ASSIGN inc-hid = FALSE
                 redraw = TRUE.
      ELSE
        ASSIGN inc-hid = TRUE
               redraw = TRUE.
      RUN prodict/_dctcach.p (inc-hid).
    END.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "PAGE-DOWN" THEN ASSIGN
      p_recid = p_recid + FRAME-DOWN(t-pick)
      redraw  = TRUE.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "PAGE-UP" THEN ASSIGN
      p_recid = p_recid - FRAME-DOWN(t-pick)
      redraw  = TRUE.
    ELSE
    IF CAN-DO("HOME,MOVE",KEYFUNCTION(LASTKEY)) AND p_recid > 1 THEN DO:
      ASSIGN
        p_recid = 1
        redraw  = TRUE.
      UP FRAME-LINE(t-pick) - 1 WITH FRAME t-pick.
    END.
    ELSE
    IF CAN-DO("END,HOME,MOVE",KEYFUNCTION(LASTKEY)) THEN DO:
      ASSIGN
        p_recid = cache_file#
        redraw  = TRUE.
      DOWN FRAME-DOWN(t-pick) - FRAME-LINE(t-pick) WITH FRAME t-pick.
    END.
    ELSE
    IF CAN-DO("GO" + (IF p_some THEN "" ELSE ",RETURN"),KEYFUNCTION(LASTKEY))
      THEN DO:

      FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = p_recid  + 1 NO-LOCK NO-ERROR.
      IF AVAILABLE tt_cache_file THEN
          ASSIGN cNext = tt_cache_file.cName.
      ELSE 
          cNext = "".

      RUN get-file-info (INPUT p_recid).

      IF p_some THEN DO:
        user_filename = "".

      IF NOT isCpUndefined THEN
         user_longchar = "".

	/* The commented out sections within this block are because we
	 * no longer allow ALL to be in the list when we present the flavor
	 * that allows wildcards and the select/deselect of one or more files. 
	 * Bug# 19991025-003.
	 */
       IF user_filename = "" THEN DO:

          /* check if the user selected all tables */
          FOR EACH tt_cache_file  WHERE tt_cache_file.p_flag NO-LOCK:
              count = count + 1.
          END.

          /* user selected all tables */
          IF count = cache_file# THEN
             user_filename = "ALL".
          ELSE DO:
              ASSIGN count = 0.

              FOR EACH tt_cache_file NO-LOCK:
                  IF tt_cache_file.p_flag /* OR (p_all AND point_flag[1]) OR (p_allw
                     AND point_flag[1]) */ THEN DO:	     
                    count = count + 1.

                    IF COUNT = 1 THEN
                       user_filename = tt_cache_file.cName.
                    ELSE DO:
                       IF use_lchar THEN
                          user_longchar = user_longchar + "," + tt_cache_file.cName NO-ERROR.
                       ELSE
                          user_filename = user_filename + "," + tt_cache_file.cName NO-ERROR.

                       IF ERROR-STATUS:ERROR THEN DO:
                           /* if undefined codepage, nothing we can do but error out */
                           IF isCpUndefined THEN
                               user_filename = user_filename + "," + tt_cache_file.cName.

                           ASSIGN user_longchar =  user_filename + "," + tt_cache_file.cName. 
                                  use_lchar = YES.
                       END.
                    END.

                  END.
              /*ELSE IF tt_cache_file.p_flag AND NOT p_all AND NOT p_allw
                   THEN count = cache_file# - 1.*/
              END. /* FOR EACH */
          END.

        /*  can't happen anymore 
        
        IF user_filename BEGINS "," THEN
          user_filename = SUBSTRING(user_filename,2).
        */
       END. /* IF user_filename = "" */
      END.
      ELSE
      IF p_all AND p_typed = "ALL" THEN user_filename = "ALL".
      ELSE
      IF cFile_name BEGINS p_typed AND
        (p_recid = cache_file# OR cFile_name = p_typed
        OR NOT cNext BEGINS p_typed)
        THEN user_filename = cFile_name.
      ELSE
      IF p_typed <> cFile_name THEN DO:
        FIND _File
          WHERE _File._Db-recid = drec_db
            AND _File._File-name BEGINS p_typed 
            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") NO-ERROR.
        IF NOT AVAILABLE _File OR CAN-DO({&INVALID_SCHEMA_TABLES},_File._File-name) THEN DO:
          MESSAGE new_lang[2]. /* bad filename guess */
          BELL.
          NEXT _pick.
        END.
        user_filename = _File._File-name.
      END.
      LEAVE _pick.
    END.
    ELSE
    IF CAN-DO("GET,PUT",KEYFUNCTION(LASTKEY)) AND p_some THEN DO:
      ASSIGN
        noselect = FALSE
        lb = 0
        l = KEYFUNCTION(LASTKEY) = "GET".
      PAUSE 0.
      DISPLAY l WITH FRAME t-patt.
      DO ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        UPDATE pattern WITH FRAME t-patt.
      END.
      redraw = KEYFUNCTION(LASTKEY) <> "END-ERROR".

      IF redraw THEN DO:
         FOR EACH tt_cache_file NO-LOCK.
             IF CAN-DO(pattern, tt_cache_file.cName) THEN
                ASSIGN tt_cache_file.p_flag = l
                       lb = lb + 1.
         END.
      END.

      HIDE FRAME t-patt NO-PAUSE.
      IF redraw AND lb = 0 AND l THEN DO:
        lb = cache_file#.
        FOR EACH _File
          WHERE _File._Db-recid = drec_db 
            AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
            AND _File._Hidden
            AND CAN-DO(pattern,_File._File-name)
            AND _File._tbl-type <> "V" :
          ASSIGN lb = lb + 1.
          FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = lb NO-ERROR.
          IF AVAILABLE tt_cache_file THEN
             ASSIGN tt_cache_file.cName = _File._File-name.
          ELSE DO:
              CREATE tt_cache_file.
              ASSIGN tt_cache_file.nPos = lb
                     tt_cache_file.cName = _File._File-name.
          END.

        END.
        IF lb <> cache_file# THEN DO i = 1 TO lb: /* this is exchange sort */
          hb = i.
          FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = hb NO-LOCK NO-ERROR.
          IF AVAILABLE tt_cache_file THEN
              cTemp = tt_cache_file.cName.
          ELSE
              cTemp = "".

          j = i + 1.
          FOR EACH tt_cache_file WHERE tt_cache_file.nPos >= j AND
              tt_cache_file.nPos <= lb.
              IF tt_cache_file.cName <  cTemp THEN
                 ASSIGN hb = j.
          END.

          IF hb > i THEN DO:
              FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = i.
              ASSIGN c = tt_cache_file.cName.

              FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = hb.
              ASSIGN cTemp = tt_cache_file.cName.
                     tt_cache_file.cName = c.

              FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = i.
              ASSIGN tt_cache_file.cName = cTemp.
          END.
        END. /*--------------------------------------- end of exchange sort */
        ASSIGN
          cache_dirty = lb <> cache_file#
          cache_file# = lb.	  
      END.
    END.
    ELSE
    IF CAN-DO("CLEAR,RECALL",KEYFUNCTION(LASTKEY)) THEN DO:
      p_typed = (IF KEYFUNCTION(LASTKEY) = "CLEAR" THEN "" ELSE p_original).
      NEXT _pick.
    END.
    ELSE
    IF KEYFUNCTION(LASTKEY) = "END-ERROR" THEN DO:
      ASSIGN
        user_filename = ""
        user_path     = "".
      LEAVE _pick.
    END.

    j = MAXIMUM(1,MINIMUM(cache_file#,p_recid)).

    RUN get-file-info(INPUT j).

    ASSIGN
      p_typed = cFile_name
      p_touch = TRUE.
   
  END. /* _pick */
END. /* if optional */

FIND FIRST _File WHERE _File._Db-recid = drec_db
  AND _File._File-name = SUBSTRING(user_filename,1,33)
  AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN") 
  AND _File._Tbl-type <> "V" NO-ERROR.
  /* Take a piece of user_filename since it can get pretty long.
  PROGRESS will gronk with "SYSTEM ERROR: fmsrt - maxdlen. (59)" if you
  try to compare a key with a string > 127 chars.  I learned this from
  experience. (Good judgement comes from experience.  Experience comes
  from bad judgement.) */  
ASSIGN
  user_filename = (IF AVAILABLE _File THEN _File._File-name
                  ELSE user_filename)
  user_env[1]   = (IF NOT use_lchar THEN user_filename ELSE "")
  drec_file     = RECID(_File).

IF use_lchar THEN
   user_filename = "SOME".
ELSE 
IF user_filename MATCHES "*,*" THEN DO:
   IF p_all OR p_allw AND NOT p_some OR (count = cache_file#)
     THEN user_filename = "ALL".
   ELSE
     user_filename = "SOME".
END.
ELSE
IF user_filename <> "" THEN DO:
  /* I'm guessing this has never and will never execute.  Mario - 12/7/99 */
  IF count >= 1 AND (p_all OR p_allw) AND (count = cache_file#)
    THEN DO:
      user_env[1] = "ALL".
      user_filename = "ALL".
    END.
END.

DISPLAY user_filename WITH FRAME user_ftr.
IF user_filename = "" THEN user_path = "".

HIDE FRAME t-help NO-PAUSE.
HIDE FRAME t-patt NO-PAUSE.
HIDE FRAME t-pick NO-PAUSE.
HIDE FRAME t-type NO-PAUSE.
user_status = ?.
STATUS DEFAULT.
RETURN.

/* Added to get the information about the table name at position n_recid */
PROCEDURE get-file-info:
    DEFINE INPUT PARAMETER n_recid AS INTEGER NO-UNDO.

    FIND FIRST tt_cache_file WHERE tt_cache_file.nPos = n_recid NO-ERROR.

    IF AVAILABLE tt_cache_file THEN
        ASSIGN p_curflag = tt_cache_file.p_flag
               cFile_name = tt_cache_file.cName.
    ELSE
        ASSIGN p_curflag = NO
               cFile_name = "".
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/*
To be a Security Administrator, you must have:

Write  permission on _File._Can-read
Write  permission on _File._Can-write
Write  permission on _File._Can-create
Write  permission on _File._Can-delete
Write  permission on _Field._Can-read
Write  permission on _Field._Can-write
Create permission on _User
Delete permission on _User

History:  07/14/98 DLM Added _Owner to _File finds

*/

DEFINE INPUT  PARAMETER usrn AS CHARACTER            NO-UNDO.
DEFINE OUTPUT PARAMETER okay AS LOGICAL INITIAL TRUE NO-UNDO.

/*check runtime privileges*/
FIND DICTDB._File "_File" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
FIND DICTDB._Field "_Can-read" OF _File.
IF NOT CAN-DO(_Field._Can-write,usrn) THEN okay = FALSE.
FIND DICTDB._Field "_Can-write" OF _File.
IF NOT CAN-DO(_Field._Can-write,usrn) THEN okay = FALSE.
FIND DICTDB._Field "_Can-create" OF _File.
IF NOT CAN-DO(_Field._Can-write,usrn) THEN okay = FALSE.
FIND DICTDB._Field "_Can-delete" OF _File.
IF NOT CAN-DO(_Field._Can-write,usrn) THEN okay = FALSE.

FIND DICTDB._File "_Field" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
FIND DICTDB._Field "_Can-read" OF _File.
IF NOT CAN-DO(_Field._Can-write,usrn) THEN okay = FALSE.
FIND DICTDB._Field "_Can-write" OF _File.
IF NOT CAN-DO(_Field._Can-write,usrn) THEN okay = FALSE.

FIND DICTDB._File "_User" WHERE DICTDB._File._Owner = "PUB" NO-LOCK.
IF NOT CAN-DO(_File._Can-create,usrn)
  OR NOT CAN-DO(_File._Can-delete,usrn) THEN okay = FALSE.

RETURN.

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/_dctalia.p

Description:
    
    Sets DICTDB alias to Database number p_db-num
            
Input-Parameters:
    p_db-num    number of db to set alias to

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    none
    
Author: Tom Hutegger

History:
    hutegger    94/04/12    creation
    mcmann      10/17/03    Add NO-LOCK statement to _Db find in support of on-line schema add

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

define input parameter p_db-name    as character.

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

      find first DICTDB._Db
        where DICTDB._Db._Db-name = p_db-name
        NO-LOCK no-error.

      if not available DICTDB._Db
       then create alias "DICTDB"
            for database VALUE(SDBNAME(p_db-name))
            no-error.

/*------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2006,2008-2009,2011 by Progress Software Corporation.*
* All rights reserved.  Prior versions of this work may contain      *
* portions contributed by participants of Possenet.                  *
*                                                                    *
*********************************************************************/
/*

  History: D. McMann 07/09/98 Added AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                              to FOR EACH _File.
           K. McIntosh 04/25/05 Added code to avoid adding _aud tables to 
                                list, when p_hidden.
           K. McIntosh 04/28/05 Refined logic to allow tables to show when
                                called from options other than "Dump Contents" 
                                and "Edit Security". 20050427-022
           fernando  03/13/06 Using temp-table to hold table names - bug 20050930-006
           fernando  06/26/08 Filter encryption schema table out from cache
           fernando  08/04/09 Put a limit on the size of the table array before
                              switching to the temp-table approach.

*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

/* LANGUAGE DEPENDENCIES START */ /*---------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 1 NO-UNDO INITIAL [
  /* 1*/ "Reading Schema..."
].
/* LANGUAGE DEPENDENCIES END */ /*-----------------------------------------*/

/* Include hidden tables in list? */                                  
DEFINE INPUT PARAMETER p_hidden AS LOGICAL NO-UNDO.

DEFINE VARIABLE c      AS CHARACTER NO-UNDO.
DEFINE VARIABLE useVar AS LOGICAL   NO-UNDO INIT YES.
DEFINE VARIABLE totLen AS INT       NO-UNDO.

/* 20050930-006 - get rid of the caching information */
EMPTY TEMP-TABLE tt_cache_file NO-ERROR.

ASSIGN cache_dirty = FALSE
       cache_file# = 0
       cache_file  = ""
       l_cache_tt = FALSE /* 20050930-006 - clear it out */
       c           = user_hdr.  /* save it */

PAUSE 0 BEFORE-HIDE.  /* Added BEFORE-HIDE to prevent prior messages from 
                         being cleared (e.g., from _usrsget.p) in tty mode
                         (Nordhougen 07/25/95) */

{prodict/user/userhdr.i new_lang[1]}

/* For gui only, schema tables may be included in the cache for
   the table get program.
   In tty, the user must type in a schema table name.
*/
IF p_hidden
 THEN FOR EACH DICTDB._File
    WHERE DICTDB._File._Db-recid = drec_db
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
      AND NOT CAN-DO({&INVALID_SCHEMA_TABLES},DICTDB._File._File-name)
    BY DICTDB._File._File-name:
  
    /* If this is an Audit table, show only if this was called by a 
       "Schema" menu-item. */
    IF DICTDB._File._File-Name BEGINS "_aud" AND
       (user_env[9] = "f"  OR
        user_env[9] = "rw") THEN NEXT.
       
    /* Set the cache to dirty to force it to rebuild the list next time.
       This prevents an unauthorized tool from seeing these tables. */
    cache_dirty = TRUE.
    
    RUN addEntry(INPUT DICTDB._File._File-name).

    END.
 ELSE FOR EACH DICTDB._File
    WHERE DICTDB._File._Db-recid = drec_db
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
      AND NOT DICTDB._File._Hidden
      BY DICTDB._File._File-name:

         RUN addEntry(INPUT DICTDB._File._File-name).

  END.

{prodict/user/userhdr.i c}  /* restore header line */

/* to refresh the db/file status line */
DISPLAY (IF user_filename = "ALL"  THEN "ALL"
    ELSE IF user_filename = "SOME" THEN "SOME"
    ELSE IF drec_file     = ?      THEN ""
    ELSE                                user_filename) 
                           @ user_filename WITH FRAME user_ftr.

RETURN.

/* Added to fix 20050930-006 - we will store the table names in a temp-table
   if we can't fit them into a character field
*/
PROCEDURE addEntry:
    DEFINE INPUT PARAMETER cTableName AS CHARACTER NO-UNDO.

    DEFINE VARIABLE iNum   AS INTEGER   NO-UNDO INIT 0.

    ASSIGN cache_file# = cache_file# + 1.

    IF NOT l_cache_tt THEN DO:

       ASSIGN cache_file[cache_file#] = cTableName NO-ERROR.

       ASSIGN totLen = totLen + LENGTH(cTableName).

       /* OE00163260
          Check the size of the array to leave some room for other things
          as the var is compiled as undo.
       */
       IF totlen > 25000 OR ERROR-STATUS:ERROR THEN DO:
           /* if an error occurred, it could be because there are too many
              tables, or we hit the limit on the character variable size
              (cache_file), so we will use a temp-table to hold the table
              names 
           */

           /* copy them to the temp-table */
           REPEAT iNum = 1 TO (cache_file# - 1):
               CREATE tt_cache_file.
               ASSIGN tt_cache_file.nPos = iNum
                      tt_cache_file.cName = cache_file[iNum].
           END.

           /* now create an entry for the current table name */
           CREATE tt_cache_file.
           ASSIGN tt_cache_file.nPos = cache_file#
                  tt_cache_file.cName = DICTDB._File._File-name
                  tt_cache_file.multitenant = DICTDB._File._File-attributes[1].

           /* clear out cache_file */
           ASSIGN cache_file = ""
                  l_cache_tt = YES.
       END.
    END.
    ELSE DO:
        CREATE tt_cache_file.
        ASSIGN tt_cache_file.nPos = cache_file#
               tt_cache_file.cName = DICTDB._File._File-name
               tt_cache_file.multitenant = DICTDB._File._File-attributes[1].
    END.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
File:
    prodict/_dctexec.p
    
descr:
    runs all routines from user_path, locks MetaSchema (search for *T),
    We return from this routine to its caller (usermenu.i: procedure
    perform_Func) either
    a) if the user_path   = ""      (no more programs to run)
    b) entry(1,user_path) = "*E"    (leave _dictc.p)
    c) entry(1,user_path) = "*T"    (start transaction)
    d) entry(1,user_path) = "*C"    (commit transaction)

history:
    hutegger    08/96   changed *O behavior. executable can have different
                        names per OPSYS. So I use user_env[1-6] to hold
                        the names of the programs per opsys. user_env[7]
                        holds the default value, which gets used when
                        one of user_env[1-6] = ""
    tomn        07/96   Changed the "proc name massage" logic to correctly
                        produce the correct relative path name for the
                        "protoxxx" utilities.  Since they do not follow the
                        original naming convention, the logic had to be changed
                        so as to not attempt to insert a subdirectory spec.
    hutegger    95/06   fixed commit-flag
    gfs         94/11   Make sure that "external" dbtype is used in
                        message. (Mainly for AS400 vs. AS/400).
    gfs         94/07   Report error message when running a *T function
                        on a Read-only database.
    mcmann     03/20/00 Added support for MS SQL Server 7
    D. McMann 02/21/03  Replaced GATEWAYS with DATASERVERS
    kmcintos   04/03/05 Added "Security" (_sec) and "Auditing" (_aud)
                        file-types
    kmayur     08/05/11 Added "Constraints for mss and oracle
                        (/mss/key) and (/ora/key)                        
    sdash      05/07/13 Added Logical DB validation in a Schema Holder
                        while using delta SQL utility.
*/
/*h-*/
/*---------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

DEFINE NEW SHARED VARIABLE select_dbname   AS CHARACTER           NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*-----------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 9 NO-UNDO INITIAL [
  /*  1,2*/ "Operations on", "are not supported in this copy of {&PRO_DISPLAY_NAME}.",
  /*    3*/ "The dictionary is in read-only mode - alterations not allowed.",
  /*4,5,6*/ "You tried to perform some", "operation on a", "database.",
  /*    7*/ "You can only perform this operation when the", 
  /*    8*/ "database is connected.",
  /*    9*/ "Schema holder database has no logical database of type."
].
/* LANGUAGE DEPENDENCIES END */ /*-------------------------------------*/

DEFINE VARIABLE i  AS INTEGER   NO-UNDO.
DEFINE VARIABLE l  AS LOGICAL   NO-UNDO.
DEFINE VARIABLE op AS CHARACTER NO-UNDO.
DEFINE VARIABLE p  AS CHARACTER NO-UNDO.
DEFINE VARIABLE z  AS CHARACTER NO-UNDO.
DEFINE VARIABLE extdbtype1 AS CHARACTER NO-UNDO. /*cvt op dbtype to exttype*/
DEFINE VARIABLE extdbtype2 AS CHARACTER NO-UNDO. /*cvt dbtype to exttype */

/*---------------------------------------------------------------------*/

DO WHILE user_path <> "":

  assign z = ( if drec_file = ?
                 then ""
                 else user_filename
             ).
  if z <> INPUT FRAME user_ftr user_filename then
    DISPLAY z @ user_filename WITH FRAME user_ftr.
  ASSIGN
    z         = ENTRY(1,user_path)
    i         = INDEX(z,"=")
    op        = ( if i > 0
                   then "*A"
                   else z
                )
    user_path = TRIM(SUBSTRING(user_path
                              ,LENGTH(z,"character") + 2
                              ,-1
                              ,"character"
                              )).
  if  op BEGINS "?"
   or op BEGINS "!"
   or op BEGINS "@"
   or op BEGINS "&"
   then do:
    /* extdbtype1 replaces "SUBSTRING(op,2)" in messages */
    extdbtype1 = {adecomm/ds_type.i
                     &direction = "itoe" 
                     &from-type = "substring(op,2,-1,""character"")" }.
    /* extdbtype2 replaces "user_dbtype" in messages */                                    
    extdbtype2 = {adecomm/ds_type.i
                     &direction = "itoe" 
                     &from-type = "user_dbtype" }.
    if NOT CAN-DO(DATASERVERS,SUBSTRING(op,2,-1,"character"))
     then do:
      HIDE MESSAGE NO-PAUSE.
      /* Operations on <dbtype> are not supported in this copy of PROGRESS. */
      MESSAGE new_lang[1] extdbtype1 new_lang[2]
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      user_path = "".
      end.
    else if op BEGINS "!" or op BEGINS "@"
     then do:
      if user_dbtype <> SUBSTRING(op,2,-1,"character")
       then do:
        HIDE MESSAGE NO-PAUSE.
        /* You tried to perform some <type> operation on a <type> database. */
        MESSAGE new_lang[4] extdbtype1 new_lang[5] extdbtype2 new_lang[6]
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        user_path = "".
        end.
      else if op BEGINS "@" AND NOT CONNECTED (user_dbname)
       then do:
        HIDE MESSAGE NO-PAUSE.
        /* You can only perform this operation when the <type> database
      	   is connected. */
        MESSAGE new_lang[7] extdbtype1 new_lang[8] 
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        user_path = "".
        end.
      end.
      else if op BEGINS "&" 
       then do:
       l = NO.
       /* l = YES if there are any foreign schema logical db's, Also assigned "selected" db */
       IF LDBNAME("DICTDB") <> ? THEN DO: 
        FOR EACH DICTDB._DB NO-LOCK:
          IF DICTDB._DB._Db-type = SUBSTRING(op,2,-1,"character") THEN DO:
            IF DICTDB._DB._Db-name = user_dbname THEN 
              select_dbname = user_dbname.
            l = YES.
          end.
      end.
      end.
      if NOT l THEN DO:  
        HIDE MESSAGE NO-PAUSE.
        /* Schema holder database has no logical database of type <type>. */
        MESSAGE new_lang[9] SUBSTRING(op,2,-1,"character") 
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        user_path = "".
      end.
    end.
  end.
  else
  if op BEGINS "*" then   /* Is this a command? */
  DO:
    if op = "*A" then /*------------------------------*/ /* assignment */
      user_env[INTEGER(SUBSTRING(z,1,i - 1,"character"))]
                    = SUBSTRING(z,i + 1,-1,"character").
     else
    if op = "*C" /*---------------------------*/ /* commit transaction */
     then do:
      assign dict_trans = false.
      RETURN.  /* return to Perform_Func to leave transaction */
      end.
    else if op = "*E" /*------------------------------------*/ /* exit */
     then do:
      user_path = op.
      LEAVE.  /* return to Perform_Func to leave _dictc.p completely */
      end.
    else if op BEGINS "*L" /*------------------*/ /* run local program */
      then RUN VALUE(SUBSTRING(z,4,-1,"character")).
    else if op = "*N" then . /*-----------------------------*/ /* noop */
    else if op = "*O" /*-----------------------*/ /* run opsys program */
     then do:
      PAUSE 0.
      case OPSYS:
        when "MSDOS" then assign p = ( if user_env[2] = ""
                                        then user_env[7]
                                        else user_env[2]
                                     ).
        when "UNIX"  then assign p = ( if user_env[4] = ""
                                        then user_env[7]
                                        else user_env[4]
                                     ).
        when "WIN32" then assign p = ( if user_env[6] = ""
                                        then user_env[7]
                                        else user_env[6]
                                     ).
        end case.
      os-command value(p).
      end.
    else if op = "*Q" then QUIT. /*-------------------------*/ /* quit */
    else if op = "*R" /*--------------------------------*/ /* rollback */
     then do:
      ASSIGN
        user_path   = op
        cache_dirty = TRUE
        dict_trans  = FALSE.
      RETURN.
      end.
    else if op BEGINS "*MSL" /*------------------*/ /* MetaSchema lock */
     then do:
      /* this switch got set in the *T section, after checking dict_rog
       * and setting dict_trans = TRUE.
       * The logic then returned back to _dictc.p (usermenu.i procedure
       * Perform_Func) and called me (_dctexec.p) again with *MSL, as
       * first entry of the user_path.
       * Now, that I'm in  the transaction, I lock the MetaSchema with
       * the following trick...
       */
      _schema-lock:
      DO ON ERROR UNDO,LEAVE:
        CREATE DICTDB._Field.
        UNDO _schema-lock,LEAVE _schema-lock.
        end.
      end.
    else if op BEGINS "*T" /*------------------*/ /* transaction start */
     then do:
      if dict_rog
       then do:
        MESSAGE new_lang[3] VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        ASSIGN user_path = "".
        LEAVE.
        end.
      ASSIGN
        l          = dict_trans
        dict_trans = TRUE
        user_trans = ( if INDEX(z,":") > 0
                         then SUBSTRING(z,4,-1,"character")
                         else "")
        user_path  = "*MSL," + user_path. /* to get MetaSchema lock */
        LEAVE.  /* return to Perform_Func to start transaction */
      end.
    end.  /* end of command processing */
   else DO ON STOP  UNDO, RETURN ERROR 
          ON ERROR UNDO, RETURN ERROR:
    if      z BEGINS "_dct"  then .
    else if z BEGINS "_usr"  then z = "user/" + z.
    else if z BEGINS "_gui"  then z = "gui/"  + z.
    else if z BEGINS "_dmp"
         or z BEGINS "_lod"  then z = "dump/" + z.
    else if z BEGINS "_gat"  then z = "gate/" + z.
    else if z BEGINS "_as4"  then z = "as4/"  + z.  /* AS400 */
    else if z BEGINS "_bti"  then z = "bti/"  + z.  /* CTOS-ISAM */
    else if z BEGINS "_gen"  then z = "gen/"  + z.  /* Generic */
    else if z BEGINS "_ism"  then z = "ism/"  + z.  /* C-ISAM and NetISAM */
    else if z BEGINS "_oag"  then z = "oag/"  + z.  /* Object Access */
    else if z BEGINS "_ora"  then z = "ora/"  + z.  /* Oracle */
    else if z BEGINS "_pro"  then z = "pro/"  + z.  /* PROGRESS */
    else if z BEGINS "_rdb"  then z = "rdb/"  + z.  /* Rdb */
    else if z BEGINS "_rms"  then z = "rms/"  + z.  /* RMS */
    else if z BEGINS "_syb"  then z = "syb/"  + z.  /* SYBASE */
    ELSE IF z BEGINS "_mss"  THEN z = "mss/"  + z.  /* MS SQL Server 7 */
    else if z BEGINS "_odb"  then z = "odb/"  + z.  /* ODBC */
    ELSE IF z BEGINS "_aud"  THEN z = "aud/"  + z.  /* Auditing */
    ELSE IF z BEGINS "_sec"  THEN z = "sec/"  + z.  /* Security */
    ELSE IF z BEGINS "_msc"  THEN z = "mss/key/"  + z. /* MSS constraint */
    ELSE IF z BEGINS "_orc"  THEN z = "ora/key/"  + z. /* ORA constraint */
    /*--------------------------------------------------------------------*
       This had to be changed to allow the "protoxxx" utilities to be 
       called from the DataServer menu (tsn 7/96).  Before, it was just
       "else z = 'misc/' + z", which would tack an unwanted "misc/" on
       the beginning of, for example, "ora/protoora".
     *-----------------------------------------------------------*/
    else if z BEGINS "_"     then z = "misc/" + z.
    RUN VALUE("prodict/" + z + ".p").
    end.
  if CAN-DO(",ALL,SOME",user_filename) then drec_file = ?.
  if user_path = "" AND user_trans <> "*" then user_path = user_trans.
  end.

RETURN.

/*---------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* dictexen.p - dictionary threaded language interpreter - no dbs connected */
/*
File:
    prodict/_dctexen.p
    
descr:
    runs all routines from user_path, locks MetaSchema (search for *T),
    We return from this routine to its caller (usermenu.i: procedure
    perform_Func) either
    a) if the user_path   = ""      (no more programs to run)
    b) entry(1,user_path) = "*E"    (leave _dictc.p)
    c) entry(1,user_path) = "*T"    (start transaction)
    d) entry(1,user_path) = "*C"    (commit transaction)

history:
    hutegger    08/96   changed *O behavior. executable can have different
                        names per OPSYS. So I use user_env[1-6] to hold
                        the names of the programs per opsys. user_env[7]
                        holds the default value, which gets used when
                        one of user_env[1-6] = ""
                        ALSO ported the change of tomn from dctexec.p
    tomn        07/96   Changed the "proc name massage" logic to correctly
                        produce the correct relative path name for the
                        "protoxxx" utilities.  Since they do not follow the
                        original naming convention, the logic had to be changed
                        so as to not attempt to insert a subdirectory spec.
    mcmann      03/00   Added MSS for MS Sql Server 7    
    D. McMann  02/21/03 Replaced GATEWAYS with DATASERVERS         
    kmcintos   04/03/05 Added "Security" (_sec) and "Auditing" (_aud)
                        file-types
*/
/*h-*/
/*---------------------------------------------------------------------*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 3 NO-UNDO INITIAL [
  /*1,2*/ "Operations on", "are not supported in this copy of {&PRO_DISPLAY_NAME}.",
  /*  3*/ "The dictionary is in read-only mode - alterations not allowed."
].
/* LANGUAGE DEPENDENCIES END */ /*------------------------------------------*/

DEFINE VARIABLE i  AS INTEGER   NO-UNDO.
DEFINE VARIABLE op AS CHARACTER NO-UNDO.
DEFINE VARIABLE p  AS CHARACTER NO-UNDO.
DEFINE VARIABLE z  AS CHARACTER NO-UNDO.

ASSIGN
  user_filename = ""
  user_dbname   = ""
  user_dbtype   = "".
DISPLAY user_dbname user_filename WITH FRAME user_ftr.

DO WHILE user_path <> "":
  ASSIGN
    z         = ENTRY(1,user_path)
    i         = INDEX(z,"=")
    op        = (IF i > 0 THEN "*A" ELSE z)
    user_path = TRIM(SUBSTRING(user_path,LENGTH(z) + 2)).
  IF op BEGINS "?" OR op BEGINS "!" THEN _dbim: DO:
    IF CAN-DO(DATASERVERS,SUBSTRING(op,2)) THEN LEAVE _dbim.
    HIDE MESSAGE NO-PAUSE.
    MESSAGE new_lang[1] SUBSTRING(op,2) new_lang[2] 
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    user_path = "".
  END.
  ELSE
  IF op = "*A" THEN /*-------------------------------------*/ /* assignment */
    user_env[INTEGER(SUBSTRING(z,1,i - 1))] = SUBSTRING(z,i + 1).
  ELSE
  IF op = "*C" THEN RETURN. /*---------------------*/ /* commit transaction */
  ELSE
  IF op = "*E" THEN DO: /*---------------------------------------*/ /* exit */
    user_path = op.
    LEAVE.
  END.
  ELSE
  IF op BEGINS "*L" THEN /*-------------------------*/ /* run local program */
    RUN VALUE(SUBSTRING(z,4)).
  ELSE
  IF op = "*N" THEN . /*-----------------------------------------*/ /* noop */
  ELSE
  IF op = "*O" THEN DO: /*--------------------------*/ /* run opsys program */
    PAUSE 0.
      case OPSYS:
        when "MSDOS" then assign p = ( if user_env[2] = ""
                                        then user_env[7]
                                        else user_env[2]
                                     ).
        when "UNIX"  then assign p = ( if user_env[4] = ""
                                        then user_env[7]
                                        else user_env[4]
                                     ).
        when "WIN32" then assign p = ( if user_env[6] = ""
                                        then user_env[7]
                                        else user_env[6]
                                     ).
       end case.
      os-command value(p).
  END.
  ELSE
  IF op = "*Q" THEN QUIT. /*-------------------------------------*/ /* quit */
  ELSE DO:
    IF      z BEGINS "_dct" THEN .
    ELSE IF z BEGINS "_usr" THEN z = "user/" + z.
    ELSE IF z BEGINS "_gui"  THEN z = "gui/"  + z.
    ELSE IF z BEGINS "_dmp"
         OR z BEGINS "_lod" THEN z = "dump/" + z.
    ELSE IF z BEGINS "_gat" THEN z = "gate/" + z.
    ELSE IF z BEGINS "_as4"  THEN z = "as4/"  + z.  /* AS400 */
    ELSE IF z BEGINS "_bti"  THEN z = "bti/"  + z.  /* CTOS-ISAM */
    ELSE IF z BEGINS "_gen"  THEN z = "gen/"  + z.  /* Generic */
    ELSE IF z BEGINS "_ism"  THEN z = "ism/"  + z.  /* C-ISAM and NetISAM */
    ELSE IF z BEGINS "_oag"  THEN z = "oag/"  + z.  /* Object Access */
    ELSE IF z BEGINS "_ora"  THEN z = "ora/"  + z.  /* Oracle */
    ELSE IF z BEGINS "_pro"  THEN z = "pro/"  + z.  /* PROGRESS */
    ELSE IF z BEGINS "_rdb"  THEN z = "rdb/"  + z.  /* Rdb */
    ELSE IF z BEGINS "_rms"  THEN z = "rms/"  + z.  /* RMS */
    ELSE IF z BEGINS "_syb"  THEN z = "syb/"  + z.  /* SYBASE */
    ELSE IF z BEGINS "_mss"  THEN z = "mss/"  + z.  /* MS SQL SERVER 7 */
    ELSE IF z BEGINS "_odb"  THEN z = "odb/"  + z.  /* ODBC */
    ELSE IF z BEGINS "_aud"  THEN z = "aud/"  + z.  /* Auditing */
    ELSE IF z BEGINS "_sec"  THEN z = "sec/"  + z.  /* Security */
    /*--------------------------------------------------------------------*
       This had to be changed to allow the "protoxxx" utilities to be 
       called from the DataServer menu (tsn 7/96).  Before, it was just
       "else z = 'misc/' + z", which would tack an unwanted "misc/" on
       the beginning of, for example, "ora/protoora".
     *-----------------------------------------------------------*/
    else if z BEGINS "_"     then z = "misc/" + z.
    RUN VALUE("prodict/" + z + ".p").
  END.
  user_trans = "". /* not supported when no dbs connected */
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000,2010 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/_dctgues.p

Description:
    guess at which db the user wants to use. We follow the folowing rules:
    a) take the db that DICTDB is pointing to
    b) if this is an empty schemaholder, take the first supported
        foreign schema
    This routine assumes the db cache is good; the new version doesn't
    care about the cache.

    THIS ROUTINE CAN BE RUN WITHOUT A CONNECTED DB
    
Input Parameters:
    none

Output Parameters:
    none

Used/Modified Shared Info:
    cache_dirty     in:  ?    if first call of this routine
                    out: TRUE if first call of this routine
                         unchanged otherwise
    drec_db         RECID of the selected db
    user_dbname     logical name of the selected db
    user_dbtype     type of the selected db (internal name)
    user_filename   unchanged

History:
    95/08    hutegger    new version created
    97/12/18 laurief     Made V8 to "generic version" changes
    00/06/14 D.McMann    When new version created running _dctsset.p was
                         left off so dict_rog not being re-set 20000614001
    09/30/10 fernando     Support for OE 11

--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

/* this assumes the db cache is good */

{ prodict/dictvar.i }
{ prodict/user/uservar.i }
{ prodict/user/userhue.i }
{ prodict/user/userhdr.f }

{ adecomm/getdbs.i
  &new = "new"
  }

define variable l_edbtyp    as character.
define variable l_i         as integer.
define variable old_dbver   as character NO-UNDO.

/* LANGUAGE DEPENDENCIES START */ /*--------------------------------*/
define variable l_msg as character no-undo extent 11 initial [
  /* 1*/ "You have been automatically switched to database",
 /*2,3*/ "There are no R11", "databases connected. This tool cannot",
  /* 4*/ "be used with a OpenEdge", 
  /* 5*/ "database. Use the tool under OpenEdge", 
  /* 6*/ "to access such a database.",
/*7-11*/ "" /* reserved */
  ].
/* LANGUAGE DEPENDENCIES END */ /*----------------------------------*/

/*---------------------------  TRIGGERS  ---------------------------*/
  
/*------------------------  INT.-PROCEDURES  -----------------------*/

/*------------------------  INITIALIZATIONS  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

/* here starts the new version */

repeat l_i = 1 to num-entries(DATASERVERS):
  assign 
    l_edbtyp = l_edbtyp + "," + { adecomm/ds_type.i
                                   &direction = "itoe"
                                   &from-type = "ENTRY(l_i,DATASERVERS)"
                                }.
  end.

if NUM-DBS = 0
 then do:
  assign
    cache_dirty   = TRUE
    drec_db       = ?
    user_dbname   = ""
    user_dbtype   = ""
    user_filename = "".
  delete alias DICTDB.
  delete alias DICTDBG.
  end.
  
 else do:  /* there is at least one db connected */

  assign user_dbtype = "". /* to signal not found yet ... */
  
  RUN adecomm/_getdbs.p.


/*----- 1. gues: try to use DICTDBG ---*/

  if LDBNAME("DICTDBG") <> ?
   then do:  /* DICTDBG set */
    find first s_ttb_db
      where s_ttb_db.ldbnm = LDBNAME("DICTDBG")
      no-error.
    if available s_ttb_db
     and INTEGER(s_ttb_db.vrsn)  > 10
     and LOOKUP(s_ttb_db.dbtyp,l_edbtyp) <> 0
     then assign
      drec_db     = s_ttb_db.dbrcd
      user_dbname = s_ttb_db.ldbnm
      user_dbtype = { adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "s_ttb_db.dbtyp"
                    }.
    end.   /* DICTDBG set */

/*----- 2. gues: try to use DICTDB, if NON-empty ---*/

  if   user_dbtype        = ""
   and LDBNAME("DICTDB") <> ?
   then do:  /* DICTDB set */
    find first s_ttb_db
      where s_ttb_db.ldbnm = LDBNAME("DICTDB")
      no-error.
    if available s_ttb_db
     and INTEGER(s_ttb_db.vrsn)  > 10
     and s_ttb_db.empty  = FALSE
     then assign
      drec_db     = s_ttb_db.dbrcd
      user_dbname = s_ttb_db.ldbnm
      user_dbtype = { adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "s_ttb_db.dbtyp"
                    }.
    end.     /* DICTDB set */

/*----- 3. gues: try to use anything NON-empty---*/

  if   user_dbtype = ""
   then do:  /* take anything NON-empty */
    find first s_ttb_db
      where INTEGER(s_ttb_db.vrsn) > 10
      and s_ttb_db.empty  = FALSE
      and   LOOKUP(s_ttb_db.dbtyp,l_edbtyp) <> 0
      no-error.
    if available s_ttb_db
     then assign
      drec_db     = s_ttb_db.dbrcd
      user_dbname = s_ttb_db.ldbnm
      user_dbtype = { adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "s_ttb_db.dbtyp"
                    }.
    end.     /* take anything NON-empty */

/*----- 4. gues: try to use DICTDB, even if empty ---*/

  if   user_dbtype        = ""
   and LDBNAME("DICTDB") <> ?
   then do:  /* DICTDB set */
    find first s_ttb_db
      where s_ttb_db.ldbnm = LDBNAME("DICTDB")
      no-error.
    if available s_ttb_db
     and INTEGER(s_ttb_db.vrsn) > 10
     then assign
      drec_db     = s_ttb_db.dbrcd
      user_dbname = s_ttb_db.ldbnm
      user_dbtype = { adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "s_ttb_db.dbtyp"
                    }.
    end.     /* DICTDB set */

/*----- 5. gues: try to use ANYTHING ---*/

  if   user_dbtype = ""
   then do:  /* take anything */
    find first s_ttb_db
      where INTEGER(s_ttb_db.vrsn)  > 10
      and   LOOKUP(s_ttb_db.dbtyp,l_edbtyp) <> 0
      no-error.
    if available s_ttb_db
     then assign
      drec_db     = s_ttb_db.dbrcd
      user_dbname = s_ttb_db.ldbnm
      user_dbtype = { adecomm/ds_type.i
                        &direction = "etoi"
                        &from-type = "s_ttb_db.dbtyp"
                    }.
    end.     /* take anything */


/* reset aliases, cache_dirty and user_filename */

  if user_dbtype = ""
   then do:  /* We need to determine the database version here
                 in order to display this message correctly when
                 no current version database is connected */
     find first s_ttb_db where integer(s_ttb_db.vrsn) < 11 no-error.
      repeat:
        if available s_ttb_db then do:
          old_dbver = "R" + s_ttb_db.vrsn.
          message l_msg[2] l_msg[3] skip
                   l_msg[4] old_dbver skip
                   l_msg[5] old_dbver skip
                   l_msg[6]
                   view-as alert-box. 
          find next s_ttb_db where integer(s_ttb_db.vrsn) < 11 no-error.
        end.
        else
          return.
      end.
    end.
  else if LDBNAME("DICTDB")  <> user_dbname
   and    LDBNAME("DICTDBG") <> user_dbname
   then do:  /* ALIAS(es) changed */

    message l_msg[1] '"' + user_dbname + '"'. /* auto-switched */
    assign
      user_filename = ""
      cache_dirty   = TRUE.

    if user_dbtype <> "PROGRESS"
     then do:
      create alias DICTDB  for database value(SDBNAME(user_dbname)).
      if connected(user_dbname)
       then create alias DICTDBG for database value(user_dbname).
       else delete alias DICTDBG.
      end.
     else do:
      create alias DICTDB  for database value(user_dbname).
      delete alias DICTDBG.
      end.
    end.     /* ALIAS(es) changed */
    RUN "prodict/_dctsset.p" (IF user_dbtype = "PROGRESS" THEN ? ELSE user_dbname).
  end.     /* there is at least one db connected */


{ prodict/user/usercon.i user_filename }

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dctlrec.p - create .d of unloadable records from another .d & error .e */

{ prodict/user/uservar.i }
{ prodict/dictvar.i }

DEFINE STREAM dot-d.
DEFINE STREAM dot-e.
DEFINE STREAM third.

DEFINE VARIABLE c	AS CHARACTER NO-UNDO.
DEFINE VARIABLE d-lin	AS INTEGER   NO-UNDO.
DEFINE VARIABLE d-txt	AS CHARACTER NO-UNDO.
DEFINE VARIABLE e-cnt	AS INTEGER   NO-UNDO.
DEFINE VARIABLE e-lin	AS INTEGER   NO-UNDO.
DEFINE VARIABLE e-ofs	AS INTEGER   NO-UNDO.
DEFINE VARIABLE e-txt	AS CHARACTER NO-UNDO.
DEFINE VARIABLE siz	AS INTEGER   NO-UNDO.
DEFINE VARIABLE tmpfile AS CHARACTER NO-UNDO.

FORM
  e-cnt LABEL "Working on error number" COLON 25 SKIP
  e-lin LABEL "For line number"         COLON 25 SKIP
  WITH FRAME working 
  ROW 5 CENTERED ATTR-SPACE SIDE-LABELS USE-TEXT &IF "{&WINDOW-SYSTEM}"
  <> "TTY" &THEN VIEW-AS DIALOG-BOX THREE-D
  TITLE "Reconstruct Bad Load Records" &ENDIF.

COLOR DISPLAY MESSAGES e-cnt e-lin WITH FRAME working.

SESSION:IMMEDIATE-DISPLAY = yes.

IF OPSYS = "UNIX" OR OPSYS = "OS2" THEN
  INPUT STREAM dot-e THROUGH quoter VALUE(user_env[2]) NO-ECHO.
ELSE DO:
  RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
  RUN "prodict/misc/osquoter.p" (user_env[2],?,?,tmpfile).
  INPUT STREAM dot-e FROM VALUE(tmpfile) NO-ECHO.
END.

INPUT  STREAM dot-d FROM VALUE(user_env[1]) NO-ECHO.
OUTPUT STREAM third TO   VALUE(user_env[3]) NO-ECHO.

PAUSE 0.
run adecomm/_setcurs.p ("WAIT").
VIEW FRAME working.

REPEAT:
  IMPORT STREAM dot-e e-txt.
  IF NOT e-txt BEGINS ">>" THEN NEXT.

  ASSIGN
    c     = SUBSTRING(e-txt,INDEX(e-txt,"#") + 1)
    e-lin = INTEGER(SUBSTRING(c,1,INDEX(c," ") - 1))
    c     = SUBSTRING(e-txt,INDEX(e-txt,"=") + 1)
    e-ofs = INTEGER(SUBSTRING(c,1,INDEX(c,")") - 1))
    e-cnt = e-cnt + 1
    d-txt = "".

  DISPLAY e-cnt e-lin WITH FRAME working.
  SEEK STREAM dot-d TO e-ofs.
  IMPORT STREAM dot-d UNFORMATTED d-txt.
  PUT STREAM third UNFORMATTED d-txt SKIP.

END.

INPUT  STREAM dot-d CLOSE.
INPUT  STREAM dot-e CLOSE.
OUTPUT STREAM third CLOSE.
IF OPSYS <> "UNIX" AND OPSYS <> "OS2" THEN OS-DELETE VALUE(tmpfile).
run adecomm/_setcurs.p ("").

MESSAGE "Reconstruction completed" VIEW-AS ALERT-BOX INFORMATION BUTTONS OK.
HIDE FRAME working NO-PAUSE.
SESSION:IMMEDIATE-DISPLAY = no.

user_env[4] = STRING(e-cnt).
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dctname.p - returns TRUE if name is valid PROGRESS identifier */

DEFINE        VARIABLE  i    AS INTEGER   NO-UNDO.
DEFINE INPUT  PARAMETER name AS CHARACTER NO-UNDO.
DEFINE OUTPUT PARAMETER okay AS LOGICAL   NO-UNDO.

okay = LENGTH(name) >= 1 AND LENGTH(name) <= 32
       AND SUBSTRING(name,1,1) >= "A"
       AND SUBSTRING(name,1,1) <= "Z"
       AND KEYWORD(name) = ?.
DO i = 2 TO LENGTH(name) WHILE okay:
  okay = INDEX("#$%&-_0123456789ETAONRISHDLFCMUGYPWBVKXJQZ",
         SUBSTRING(name,i,1)) > 0.
END.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dctquot.p - string quoting utility
 
  Modified:
     10/05/99 Mario B. Added banner warning.
     
*/

/*--------------------------- W A R N I N G ---------------------------------*
 * If you change this file, please consider whether or not you should also   *
 * change a copy of it that is included as an internal procedure in          *
 * prodict/dump/_dmputil.p.                                                  *
 *---------------------------------------------------------------------------*/

DEFINE INPUT  PARAMETER inline  AS CHARACTER            NO-UNDO.
DEFINE INPUT  PARAMETER quotype AS CHARACTER            NO-UNDO.
DEFINE OUTPUT PARAMETER outline AS CHARACTER INITIAL "" NO-UNDO.
DEFINE        VARIABLE  i       AS INTEGER              NO-UNDO.

IF INDEX(inline,quotype) > 0 THEN
  DO i = 1 TO LENGTH(inline):
    outline = outline + (IF SUBSTRING(inline,i,1) = quotype
              THEN quotype + quotype ELSE SUBSTRING(inline,i,1)).
  END.
ELSE
  outline = inline.

outline = (IF outline = ? THEN "?" ELSE quotype + outline + quotype).
RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File:
    prodict/_dctscnt.p

Description:
    counts the user-defined tables in db with ldbname p_dbname
    if the database is version 6 or 5 the number will be 0

Input Parameter:
    p_ldbname   logical name of db to count its files

Output Parameter:
    p_file-nr   number of user defined files in that database

Used/Modified Shared Info:
    none

History:
    95/08       changed 1. parameter to logical db-name
                and changed the overall structure to have defined
                output-behaviour and better sanity testing on the 
                db to be used
    D. McMann 07/09/98 Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                       to FOR EACH _File.  
    D. McMann 10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add          

--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

/*{ prodict/dictvar.i }*/

DEFINE INPUT  PARAMETER p_ldbname  AS character NO-UNDO.
DEFINE OUTPUT PARAMETER p_file-nr  AS integer   NO-UNDO.


/*---------------------------  TRIGGERS  ---------------------------*/

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*------------------------  INITIALIZATIONS  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/


if  DBVERSION(p_ldbname) = "5"
 or DBVERSION(p_ldbname) = "6"
 then assign p_file-nr = 0.
 
 else do:  /* DICTDB is a valid db */

  if DBTYPE(p_ldbname) = "PROGRESS"
   then find DICTDB._Db where DICTDB._Db._Db-name = ? NO-LOCK.
   else find DICTDB._Db where DICTDB._Db._Db-name = p_ldbname NO-LOCK.

  /* we are counting USER files, not UNHIDDEN files */
  for each DICTDB._File of DICTDB._Db
    where DICTDB._File._File-num > 0 
      AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
    p_file-nr = 1 to p_file-nr + 1:
    end.
    
  end.     /* DICTDB is a valid db */

/*------------------------------------------------------------------*/

/*********************************************************************
* Copyright (C) 2000,2010 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/_dctsget.p

Description:
    
    populates the shared variables that hold the available dbs info.
            
Input-Parameters:
    none

Output-Parameters:
    none
    
Used/Modified Shared Objects:
    cache_db_l  array of logical db-names
    cache_db_p  array of physical db-names
    cache_db_s  array of names of the db, thats the schemaholder
    cache_db_t  array of db-types
    cache_db#   index of the current working-db to the above arrays


Author: Tom Hutegger

History:
    hutegger    94/06    creation (derived from & replacing old version)
    mcmann      11/26/02 Changed adecomm/_dictdb.p to prodict/_dictdb.p
    fernando    09/30/10 Support for OE11

                            
--------------------------------------------------------------------*/
/*h-*/

/*----------------------------  DEFINES  ---------------------------*/

{ prodict/dictvar.i }

{ adecomm/getdbs.i
  &new = "NEW"
  }

/*------------------------  INT.-PROCEDURES  -----------------------*/

/*---------------------------  MAIN-CODE  --------------------------*/

ASSIGN
  cache_db#  = 0
  cache_db_l = ""
  cache_db_p = ""
  cache_db_s = ""
  cache_db_t = "".

if NUM-DBS > 0 
 then do:
  RUN prodict/_dictdb.p.
  RUN adecomm/_getdbs.p.
  end.
  
for each s_ttb_db:
  
  /* get rid of older versions, because we can't handle them    */
  /* if s_ttb_db.vrsn <> "10" then next.                         */

  assign
    cache_db#             = cache_db# + 1
    cache_db_e[cache_db#] = s_ttb_db.dbtyp
                          + ( if INTEGER(s_ttb_db.vrsn) < 11 
                                then "/R" + s_ttb_db.vrsn
                                else ""
                            )
    cache_db_l[cache_db#] = s_ttb_db.ldbnm
    cache_db_p[cache_db#] = ( if s_ttb_db.cnnctd
                                then s_ttb_db.pdbnm
                                else ?
                            )
    cache_db_s[cache_db#] = s_ttb_db.sdbnm
    cache_db_t[cache_db#] = {adecomm/ds_type.i
                               &direction = "etoi"
                               &from-type = "s_ttb_db.dbtyp"
                            }
    cache_db_t[cache_db#] = cache_db_t[cache_db#]
                          + ( if integer(s_ttb_db.vrsn) < 11 
                                then "/R" + s_ttb_db.vrsn
                                else ""
                            ).
  end.


/**********************************************************************
* Copyright (C) 2000,2006 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/* called from _usrsget.p, used with _dctsget.p */
/* ----------------------------------------------------------------------
File:   prodict/_dctsset.p

Description:
    1. sets drec_db to the currently selected _Db-record and sets
       dict_rog for this db
    2. issues a message if db-type is not supported by the current
       executable
    3. Reads file-list into cache

Input Parameters:
    none
    
Output Parameters:
    none

history:
        95/07    hutegger   Prefixed _Db with DICTDB
        07/09/98 D. McMann  Added AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN")
                            to _File Finds
        D. McMann 02/21/03 Replaced GATEWAYS with DATASERVERS
        fernando  06/12/06 Support for int64
---------------------------------------------------------------------- */
/*h-*/

{ prodict/dictvar.i }
{ prodict/user/uservar.i }

DEFINE INPUT PARAMETER nam AS CHARACTER NO-UNDO.

DEFINE SHARED VARIABLE fast_track AS LOGICAL. /* FT active? */

DEFINE VARIABLE istrans  AS LOGICAL INITIAL TRUE. /*UNDO (not no-undo!) */
DEFINE VARIABLE i        AS INTEGER NO-UNDO.
DEFINE VARIABLE l_hidden AS LOGICAL NO-UNDO.
DEFINE VARIABLE hBuffer  AS HANDLE  NO-UNDO.

/* ------------------------------------------------------------------- */

DO ON ERROR UNDO:
  istrans = FALSE.
  UNDO,LEAVE.
  end.

/* --- Check to see if dictionary is called from within Fast Track --- */

DO i = 1 TO i + 1
  WHILE PROGRAM-NAME(i) <> ?
  AND   NOT fast_track:
  fast_track = ( "ft.p" 
               = SUBSTRING(PROGRAM-NAME(i)
                          ,MAXIMUM(1
                                  ,LENGTH(PROGRAM-NAME(i)) - 3
                                  )
                          ,-1
                          ,"character"
                          )
               ).
  end.


/* -------------------- set drec_db and dict_rog --------------------- */

find DICTDB._Db WHERE DICTDB._Db._Db-name = nam NO-LOCK.
assign
  drec_db  = RECID(DICTDB._Db)
  dict_rog = 
      istrans  /* cannot change dict if called from w/i a trans */
      OR PROGRESS = "Query"    /* or used with query product    */
      OR PROGRESS = "Run-Time" /* or used with run-time product */
      OR fast_track            /* or called from within Fast Track */
      OR CAN-DO("READ-ONLY",DBRESTRICTIONS("DICTDB")). /* or read-only DB */

/* (los 12/27/94) */
if NOT CAN-DO(DATASERVERS, DICTDB._Db._Db-type)
 then MESSAGE
    "This module does not support connections to this Data Server type."
    view-as alert-box.


/* check if this is a 10.1B db at least, so that we complain about int64 and
   int64 values. If the 'Large Keys' feature is not known by this db, then this
   is a pre-101.B db 
*/
ASSIGN  is-pre-101b-db = YES.

IF INTEGER(DBVERSION("DICTDB")) >= 10 THEN DO:
    /* use a dyn buffer since v9 db's don't have the feature tbl */
    CREATE BUFFER hBuffer FOR TABLE "DICTDB._Code-feature" NO-ERROR.
    IF VALID-HANDLE(hBuffer) THEN DO:
       hBuffer:FIND-FIRST('where _Codefeature_Name = "Large Keys"',NO-LOCK) NO-ERROR.
       IF hBuffer:AVAILABLE THEN
           is-pre-101b-db = NO.
       DELETE OBJECT hBuffer.
    END.

END.


/* -------------------- recreate file-list cache --------------------- */

find first DICTDB._File 
  where DICTDB._File._Db-recid  = drec_db 
  and   DICTDB._File._File-name = user_filename
  AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
   no-lock no-error.
assign l_hidden = ( available DICTDB._File
                    and DICTDB._File._Hidden = TRUE).

run prodict/_dctcach.p 
  ( INPUT l_hidden
  ).

/* ------------------------------------------------------------------- */

/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* this creates the sylk file definition */

FIND FIRST _Db WHERE _Db._Db-local NO-LOCK.

FIND _File "sylk" OF _Db NO-ERROR.
IF AVAILABLE _File AND _File._Frozen THEN RETURN.

IF AVAILABLE _File THEN DO:
  FOR EACH _Index OF _File:
    FOR EACH _Index-field OF _Index:
      DELETE _Index-field.
    END.
    DELETE _Index.
  END.
  FOR EACH _Field OF _File:
    DELETE _Field.
  END.
  DELETE _File.
END.

CREATE _File.
ASSIGN
  _File._Db-recid  = RECID(_Db)
  _File._File-name = "sylk"
  _File._Hidden    = TRUE.

CREATE _Field.
ASSIGN
  _Field._Field-name = "x"
  _Field._Data-type  = "character"
  _Field._Order      = 20
  _Field._File-recid = RECID(_File)
  _Field._Format     = "x(40)"
  _Field._Initial    = ""
  _Field._Extent     = 255.

CREATE _Field.
ASSIGN
  _Field._Field-name = "y"
  _Field._Data-type  = "integer"
  _Field._Order      = 10
  _Field._File-recid = RECID(_File)
  _Field._Format     = "->,>>>,>>9"
  _Field._Initial    = "0".

CREATE _Index.
ASSIGN
  _Index._Index-name = "sylk"
  _File._Prime-Index = RECID(_Index)
  _Index._File-recid = RECID(_File)
  _Index._Unique     = TRUE
  _Index._Active     = TRUE.

CREATE _Index-field.
ASSIGN
  _Index-field._Index-recid = RECID(_Index)
  _Index-field._Field-recid = RECID(_Field)
  _Index-field._Ascending   = TRUE
  _Index-field._Index-seq   = 1.

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* _dctyear.p - returns -d <mdy> setting and -yy <nnnn> setting */

/* Removed all do loops that tried to figure out the settings and use
   the session options instead.  Old code had problem if -yr4def startup
   parameter was used.  D. McMann 12/01/99
*/

DEFINE OUTPUT PARAMETER mdy AS CHARACTER         NO-UNDO.
DEFINE OUTPUT PARAMETER yy  AS INTEGER INITIAL ? NO-UNDO.

ASSIGN mdy = SESSION:DATE-FORMAT
       yy  = SESSION:YEAR-OFFSET.

RETURN.





/*********************************************************************
* Copyright (C) 2006 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*==========================================================================
 dict.p - PROGRESS DATA DICTIONARY main program 

NAMING CONVENTIONS:
  prefixes:
    dict* - dictionary kernal routines
    dump* - export programs
    help* - dictionary on-line help (reserved)
    list* - reporting programs
    load* - import programs
    menu* - menu programs
    os*   - opsys-specific functions
    run_* - programs compiled on-the-fly (always .i)
    tool* - tools
    user* - user interface
    xref* - cross-reference utilities (reserved)
    _*    - temporary files
  suffixes:
    *?gen - generates code
    *?get - selects objects. the ? in ?get is one of:
            f - Field
            i - Index
            s - Schema (Database)
            t - Table (File)
            v - View
            w - Workfile
  types:
    *.d  - database contents dump
    *.df - database structure dump
    *.ds - listing from load data screen
    *.e  - error files listing load errors
    *.f  - FORM statements for user interface
    *.fd - bulkload description files
    *.i  - include files or procedures compiled on-the-fly
    *.p  - procedures
    *.pl - prolib r-code library
    *.r  - compiled procedures (one per .p)

DATABASE GATEWAY (formerly DBIM):
  prefixes:
    pro_* - PROGRESS GATEWAY drivers
    sql_* - PROGRESS/SQL drivers (shares code with pro_*)
    rms_* - RMS GATEWAY drivers
    rdb_* - Rdb GATEWAY drivers
    ora_* - ORACLE GATEWAY drivers
  suffixes:
    *_dbs.p - database manager code
    *_fil.p - file manager code
    *_fld.p - field editor update code
    *_idx.p - index manager code
    *_dmp.p - df dump code
    *_lod.p - df load code

To add support for a new non-PROGRESS (foreign) database type:
  1. Select a three letter prefix, and make a subdir in prodict named that.
  2. Then add:
     ???_sys.p ???_typ.p
     The best way to write these is to copy an existing set and modify the
     settings.
  3. Then alter:
     dictgate.i
     This is to put in support for the name of the new database type.
  4. Finally, add any new special options specific to that database type.
     You will probably want to add a "??? Utilities" entry to the Admin menu.
     See usermenu.i for details.

TRANSLATION:
To translate dictionary into foreign language:
  1. Edit all *.f files to fix frame information
  2. Edit _runload.i to fix language dependencies there.
  3. Fix all *.p files.  All language-dependent text will be isolated in
     array or form definitions between the following comment markers, and
     will be near the beginning of the file:
       /* LANGUAGE DEPENDENCIES START */ /*---------------------------------*/
       /* LANGUAGE DEPENDENCIES END */ /*-----------------------------------*/

============================================================================*/


&SCOPED-DEFINE DATASERVER                 YES
&SCOPED-DEFINE FOREIGN_SCHEMA_TEMP_TABLES INCLUDE
{ prodict/dictvar.i NEW }
{ prodict/odb/odbvar.i NEW }
&UNDEFINE FOREIGN_SCHEMA_TEMP_TABLES
&UNDEFINE DATASERVER
{ prodict/user/uservar.i NEW }
{ prodict/user/userhue.i NEW }

DEFINE VARIABLE i       AS INTEGER              NO-UNDO.
DEFINE VARIABLE istrans AS LOGICAL INITIAL TRUE. /*UNDO (not no-undo!) */
DEFINE VARIABLE j       AS INTEGER              NO-UNDO.
DEFINE VARIABLE mode    AS CHARACTER            NO-UNDO.
DEFINE VARIABLE stat    AS LOGICAL              NO-UNDO.
DEFINE VARIABLE mti_sav AS INTEGER              NO-UNDO.
DEFINE VARIABLE sw_sav  AS LOGICAL              NO-UNDO.
/* Variables needed for Taskbar orientation check */
DEFINE VARIABLE TBOrientation AS CHARACTER NO-UNDO.
DEFINE VARIABLE TBHeight      AS INTEGER   NO-UNDO.
DEFINE VARIABLE TBWidth       AS INTEGER   NO-UNDO.
DEFINE VARIABLE AutoHide      AS LOGICAL   NO-UNDO.

DEFINE NEW SHARED VARIABLE fast_track AS LOGICAL. /* FT active? */
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
   DEFINE NEW SHARED VARIABLE win AS WIDGET-HANDLE NO-UNDO.
&ENDIF

{ prodict/user/userhdr.f NEW }


/*--- LANGUAGE DEPENDENCIES START ----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 8 NO-UNDO INITIAL [
  /* 1*/ "the {&PRO_DISPLAY_NAME} Data Dictionary",
  /* 2*/ "{&PRO_DISPLAY_NAME} Data Administration",
  /* 3*/ "You are not allowed to use the dictionary on a database that",
  /* 4*/ "has a logical name",
  /* 5*/ "(alias is okay, but not ldbname).",
  /* 6*/ "or",
  /* 7*/ "to select",
  /* 8*/ "Main Menu"
].

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
FORM SKIP(1)
  "You may use these facilities to set up or alter the structure of" 
               AT 2 SPACE(1) SKIP
  "your database(s) or to perform various administrative functions."
               AT 2 SPACE(1) SKIP(1)
  WITH FRAME guten-tag 
  ROW 6 CENTERED TOP-ONLY NO-ATTR-SPACE NO-LABELS OVERLAY USE-TEXT
  TITLE COLOR VALUE(IF head-bg = "MESSAGES" THEN "NORMAL" ELSE head-bg)
  " Welcome to " + new_lang[1] + " ". 
&ELSE
FORM SKIP(1)
  "You may use these facilities to set up or alter the structure of      " AT 4 SPACE(1) SKIP
  "your database(s) or to perform various administrative functions.      " AT 4 SPACE(1) SKIP(1)
  WITH FRAME guten-tag THREE-D
  ROW 6 width &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN 72 &ELSE 55 &ENDIF
  CENTERED TOP-ONLY NO-ATTR-SPACE NO-LABELS OVERLAY USE-TEXT
  TITLE COLOR VALUE(IF head-bg = "MESSAGES" THEN "NORMAL" ELSE head-bg)
  " Welcome to  " + new_lang[2] + "  ".
&ENDIF


/*--- LANGUAGE DEPENDENCIES END ------------------------------------------*/

/*===================Triggers/Internal Procedures==========================*/

/* Menu definition, triggers and internal procedures */
{prodict/user/usermenu.i NEW}

/*==========================Mainline code==================================*/

USE "" NO-ERROR.  /* resets to startup default file */
sw_sav = SESSION:SUPPRESS-WARNINGS.
SESSION:SUPPRESS-WARNINGS = YES. /* no warnings on platform specific funcs */

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
   ASSIGN
      SESSION:APPL-ALERT-BOXES = NO
      SESSION:SYSTEM-ALERT-BOXES = YES.

   /* In GUI environment create a new window. */
   CREATE WINDOW win
      ASSIGN
        X = 5
        Y = 5
               HEIGHT-CHARS = 15
               TITLE = "Data Administration"
               MENUBAR = MENU mnu_Admin_Tool:HANDLE
               STATUS-AREA = no

      TRIGGERS:
               ON WINDOW-CLOSE DO:
                  APPLY "CHOOSE" to MENU-ITEM mi_Exit IN MENU mnu_Database.
                  RETURN NO-APPLY.
               END.
               ON HELP ANYWHERE DO:
                  APPLY "CHOOSE" TO MENU-ITEM mi_Hlp_Topics IN MENU mnu_Help.
                  RETURN NO-APPLY.
               END.
      END TRIGGERS.
    IF SESSION:WINDOW-SYSTEM BEGINS "MS-WIN":U THEN DO: 
       ASSIGN TBOrientation= ""
              TBHeight = 0
              TBWidth = 0.
       RUN adeshar/_taskbar.p (OUTPUT TBOrientation, OUTPUT TBHeight,
                               OUTPUT TBWIdth,       OUTPUT AutoHide).
    
       IF NOT AutoHide THEN DO:
         IF TBOrientation = "LEFT":U AND win:X <= TBWidth THEN
            ASSIGN win:X = TBWidth.
         IF TBOrientation = "TOP":U THEN DO:
            IF win:Y <= TBHeight THEN win:Y = TBHeight + 10.
         END.
         IF TBOrientation = "BOTTOM" AND win:Y + win:HEIGHT-P > SESSION:HEIGHT-P - TBHeight THEN DO:
            win:Y = win:Y - ((win:Y + win:HEIGHT-P) - (SESSION:HEIGHT-P - TBHeight)).  
         END.
         IF TBOrientation = "RIGHT" AND win:X + win:WIDTH-P > SESSION:WIDTH-P - TBWidth THEN DO:
            win:X = win:X - ((win:X + win:WIDTH-P) - (SESSION:WIDTH-P - TBWidth)).
         end.
       END. /* if NOT AutoHide */
    END. /* if SESSION:WINDOW-SYSTEM BEGINS "MS-WIN" */

  
   
   CURRENT-WINDOW = win.
   stat = win:load-icon("adeicon/admin%").

   /* To force correct paint behavior on startup. */
   mti_sav = SESSION:MULTITASKING-INTERVAL.
   SESSION:MULTITASKING-INTERVAL = 10.
   
   &IF "{&WINDOW-SYSTEM}" = "ms-windows" &THEN
       assign win:width-chars = win:max-width + 15
              win:max-width = win:width-chars
              /*frame user_ftr:width-chars = win:max-chars */.
   &endif.
   
&ELSE
   ASSIGN
      SESSION:APPL-ALERT-BOXES = NO
      SESSION:SYSTEM-ALERT-BOXES = NO.

   /* for TTY we use the default window */
   ASSIGN
      DEFAULT-WINDOW:MENUBAR = MENU mnu_Admin_Tool:HANDLE.
&ENDIF

RUN "adecomm/_setcurs.p" ("WAIT").  

/* COLOR SETTINGS for C080-------------------------------------------*/
IF TERMINAL = "CO80" THEN ASSIGN
  menu-fg = "WHITE/MAGENTA"      menu-bg = "YELLOW/BLUE"
  dbox-fg = "WHITE/RED"          dbox-bg = "WHITE/GRAY"
  head-fg = "LIGHT-CYAN/BLUE"    head-bg = "WHITE/GRAY"
  pick-fg = "WHITE/GRAY"         pick-bg = "LIGHT-CYAN/BLUE".

/*-----
IF TERMINAL = "CO80" THEN
  DISPLAY SPACE(80)
    WITH FRAME background OVERLAY NO-BOX COLOR WHITE/BLACK NO-ATTR-SPACE
    SCREEN-LINES - 2 DOWN ROW 2 COLUMN 1.
-----*/

HIDE ALL NO-PAUSE.
ASSIGN
  drec_db    = ?
  drec_file  = ?.

/* this checks aliases that dict needs internally */
DO i = 1 TO 3:
  mode = ENTRY(i,"DICTDB,DICTDBG,DICTDB2").
  IF LDBNAME(mode) <> mode THEN NEXT.
  RUN "adecomm/_setcurs.p" ("").  
  MESSAGE new_lang[3] SKIP /* DICTDB as logical name confuses dictionary */
                new_lang[4] mode new_lang[5] /* try again. */
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.

IF DBTYPE("DICTDB") = "PROGRESS" AND INTEGER(DBVERSION("DICTDB")) < 10 THEN
  DELETE ALIAS "DICTDB".

cache_dirty = ?. /* flag to dictgues that this is first time */
RUN "prodict/_dctsget.p". /* build db cache */
IF NUM-DBS > 0
 THEN RUN "prodict/_dctgues.p". /* select initial db */
 ELSE ASSIGN
  user_dbname = (IF LDBNAME("DICTDB") = ? THEN "" ELSE LDBNAME("DICTDB"))
  user_dbtype = (IF LDBNAME("DICTDB") = ? THEN "" ELSE DBTYPE("DICTDB")).

DO ON ERROR UNDO:
  istrans = FALSE.
  UNDO,LEAVE.
END.

ASSIGN
/*  user_dbname = (IF LDBNAME("DICTDB") = ? THEN "" ELSE LDBNAME("DICTDB"))*/
/*  user_dbtype = (IF LDBNAME("DICTDB") = ? THEN "" ELSE DBTYPE("DICTDB")) */
  cache_dirty = TRUE.

/* Gray menus according to PROGRESS capabilities and database connection */
RUN Initial_Menu_Gray.

/* Initialize for first function */
ASSIGN
   dict_trans  = FALSE
   dict_dirty  = FALSE
   user_trans  = ""
   user_env    = "".

/* Display Welcome frame */
VIEW FRAME guten-tag. 

/* Display current context in header and footer lines */
{prodict/user/userhdr.i new_lang[8]}
{ prodict/user/usercon.i '' @ user_filename }

&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
   SESSION:MULTITASKING-INTERVAL = mti_sav.
   WIN:HEIGHT = WIN:MAX-HEIGHT. /* put in so window ok on Japanese Windows */
&ENDIF

/* Set global active ade tool procedure handle to Admin. */
ASSIGN h_ade_tool = THIS-PROCEDURE.

/* Main WAIT-FOR.  On TTY, ENDKEY will get you out, but on GUI,
   it shouldn't.
*/
RUN "adecomm/_setcurs.p" ("").  /* Make sure wait cursor is off */
DO
   &IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
   ON ERROR UNDO, RETRY  ON ENDKEY UNDO, RETRY
   &ENDIF
   ON STOP UNDO, LEAVE:
   WAIT-FOR "CHOOSE" OF MENU-ITEM mi_Exit IN MENU mnu_Database.
END.

SESSION:SUPPRESS-WARNINGS = sw_sav.
&IF "{&WINDOW-SYSTEM}" BEGINS "MS-WIN" &THEN
   HIDE ALL NO-PAUSE IN WINDOW win.
   run adecomm/_adehelp.p ("dict", "QUIT", ?, ?).
   DELETE WIDGET win. 
&ELSE
   HIDE ALL NO-PAUSE.
&ENDIF

PAUSE 0.
RETURN.





/*********************************************************************
* Copyright (C) 2006,2009 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* admnhlp.i */

/*
   This file contains
   Help Context Identifiers for PROGRESS GUI ADMIN TOOL
   embedded in PROGRESS pre-processor statements.

   The form used in this file is:

	   <Name of the Help Topic>
	   &Global-Define <context-string> <context-number>

   Please contact Documentation to make changes to this file. 
   Thanks. 
   
   History:
     kmcintos June 7, 2005  Added context help ids for auditing options.
     fernando     09/12/06  Added context help id for Adjust Schema
     fernando     06/30/09  Added context help id for Encryption/AltBufPool options
     
*/

/* Admin Help Contents screen */
&Global-define Adjust_Schema_dialog_box 37

/* Oracle Dataservers - Server Attributes - Create Foreign Constraints */ 
&Global-define ORACLE_DatatServer_Create_Constraints_Dialog 53
/* Oracle Dataservers - Server Attributes - Delete Foreign Constraints */ 
&Global-define ORACLE_DataServer_Delete_Constraints_Dialog_Box 54
/* Dataservers - Server Attributes - Activate/Deactivaye Constraints */ 
&Global-define DataServer_Activate_Deactivate_Constraint_Definitions_Dialog_Box 55

/* MSS Dataservers - Server Attributes - Create Foreign Constraints */ 
&Global-define MS_SQL_Server_Data_Server_Create_Constraints_Dialog 61
/* MSS Dataservers - Server Attributes - Delete Foreign Constraints */ 
&Global-define MS_SQL_Server_DataServer_Delete_Constraints_Dialog_Box 62

/*  */
&Global-define MS_SQL_Server_DataServer_View_Maintains_Foreign_Constraints 63
/* MSS Dataservers - Server Attributes - Constraint Properties */
&Global-define MS_SQL_Server_DataServer_View_Modify_Contraint_Properties_Dialog_Box 64

/* Create MSS DataServer Schema - migration "Advanced" button */
&Global-define OpenEdge_DB_to_MS_SQL_Advanced_Dialog_Box 65
/* Create Oracle DataServer Schema - migration "Advanced" button */
&Global-define OpenEdge_DB_to_ORACLE_Advanced_Dialog_Box 66

/*  */
&Global-define ORACLE_DataServer_View_Maintains_Foreign_Constraints 67
/* Oracle Dataservers - Server Attributes - Constraint Properties */
&Global-define ORACLE_DataServer_View_Modify_Contraint_Properties_Dialog_Box 68

/* Admin Help Contents screen */
&Global-define Main_Contents 49153

/* Admin Window  */
&Global-define Admin_Window 49154

/* Admin Menu Commands  */
&Global-define Menu_Commands 49155

/* List of Views Dialog Box */
&Global-define List_Views_Dlg_Box 49156

/* Edit User List Dialog Box */
&Global-define Edit_User_List_Dlg_Box 49157

/* Add User Dialog Box */
&Global-define Add_User_Dlg_Box 49158

/* Modify User Dialog Box */
&Global-define Modify_User_Dlg_Box 49159

/* List Tables (select 1 or All) Dialog Box */
&Global-define List_Tables_1orAll_Dlg_Box 49160

/* List Tables (select some) Dialog Box */
&Global-define List_Tables_Some_Dlg_Box 49161

/* List Tables (select one) Dialog Box */
&Global-define List_Tables_1_Dlg_Box 49162

/* Select Table by Pattern Match Dialog Box */
&Global-define Select_by_Pattern_Dlg_Box 49163

/* Select Database Dialog Box */
&Global-define Select_Database_Dlg_Box 49164

/* Edit Data Security Dialog Box */
&Global-define Edit_Data_Security_Dlg_Box 49165

/* Edit Parameter File Dialog Box */
&Global-define Edit_Parameter_File_Dlg_Box 49166

/* Edit Auto Connect List Dialog Box */
&Global-define Edit_Auto_Connect_List_Dlg_Box 49167

/* Add Auto Connect Record Dialog Box */
&Global-define Add_Auto_Connect_Dlg_Box 49168

/* Modify Auto Connect Record Dialog Box */
&Global-define Modify_Auto_Connect_Dlg_Box 49169

/* Fixed Length Field Columns Dialog Box */
&Global-define Fixed_Length_Field_Columns_Dlg_Box 49170

/* Pick a Database for Incremental Dump Dialog Box */
&Global-define Pick_DB_For_Incr_Dump_Dlg_Box 49171

/* Ordered Pick Dialog Box */
&Global-define Ordered_Pick_Dlg_Box 49172

/* Generate Workfile Dialog Box */
&Global-define Generate_Workfile_Dlg_Box 49173

/* Dump Create View Dialog Box */
&Global-define Dump_Create_View_Dlg_Box 49174

/* Dump Create Table Dialog Box */
&Global-define Dump_Create_Table_Dlg_Box 49175

/* Change Password Dialog Box */
&Global-define Change_Your_Password_Dlg_Box 49176

/* Import dBase Definitions Dialog Box */
&Global-define Import_dBase_Definitions_Dlg_Box 49177

/* Connect Database Dialog Box */
&Global-define Connect_Database_Dlg_Box 49178

/* Quote Entire Lines Dialog Box */
&Global-define Quote_Entire_Lines_Dlg_Box 49179

/* Quote By Delimiter Dialog Box */
&Global-define Quote_By_Delimiter_Dlg_Box 49180

/* Quote By Column Ranges Dialog Box */
&Global-define Quote_By_Column_Ranges_Dlg_Box 49181

/* Quoter Include File Dialog Box */
&Global-define Quoter_Include_File_Dlg_Box 49182

/* Quoter Conversion Completed Dialog Box */
&Global-define Quoter_Conversion_Completed_Dlg_Box 49183

/* Include File Created Dialog Box */
&Global-define Include_File_Created_Dlg_Box 49184

/* Password Verification Dialog Box */
&Global-define Password_Verification_Dlg_Box 49185

/* Parameter File Name Dialog Box */
&Global-define Parameter_File_Name_Dlg_Box 49186


/* Reconstruct Bad Load Records Dialog Box */
&Global-define Reconstruct_Bad_Load_Records_Dlg_Box 49187

/* Load Stuff Dialog Box (used for sequences, views and user records) */
&Global-define Load_Stuff_Dlg_Box 49188

/* Load Database Options Dialog Box */
&GLOBAL-DEFINE Load_Database_Options_Dialog_Box 123

/* Load Database Identification Properties Dialog Box */
&GLOBAL-DEFINE Load_Database_Identification_Properties_Dialog_Box 122

/* Load Application Audit Events Dialog Box */
&GLOBAL-DEFINE Load_Application_Audit_Events_Dialog_Box 121

/* Dump Database Options Dialog Box */
&GLOBAL-DEFINE Dump_Database_Options_Dialog_Box 120

/* Dump Audit Data -- Filter Dialog Box */
&GLOBAL-DEFINE Dump_Audit_Data_Filter_Dialog_Box 119

/* Database Identification Maintenance Dialog Box */
&GLOBAL-DEFINE Database_Identification_Maintenance_Dialog_Box 116

/* New Database Passkey/Identifier Dialog Box */
&GLOBAL-DEFINE Database_Passkey_Identifier_Dialog_Box 117

/* Database Identification History Dialog Box */
&GLOBAL-DEFINE Database_Identification_History_Dialog_Box 115

/* Database Options Dialog Box */
&GLOBAL-DEFINE Database_Options_Dialog_Box 109

/* Authentication Systems Dialog Box */
&GLOBAL-DEFINE Authentication_Systems_Dialog_Box 101

/* Edit Audit Permissions Dialog Box */
&GLOBAL-DEFINE Edit_Audit_Permissions_Dialog_Box 5

/* Cascade Revoke Dialog Box*/
&GLOBAL-DEFINE Cascade_Revoke_Permissions_Dialog_Box 6

/* Authentication System Domains Dialog Box */
/* &GLOBAL-DEFINE Authentication_System_Domains_Dialog_Box 80 */
/* &GLOBAL-DEFINE Authentication_System_Domains_Dialog_Box 80 */

/* Select Audit Policies for Dump Dialog Box */
&GLOBAL-DEFINE Select_Audit_Policies_for_Dump_Dialog_Box 118

/* Load Definitions Dialog Box */
&Global-define Load_Data_Definitions_Dlg_Box 49189

/* Load Data Contents Dialog Box */
&Global-define Load_Data_Contents_Dlg_Box 49190

/* Video Attribute Settings Dialog Box */
&Global-define Video_Attribute_Settings_Dlg_Box 49191

/* Dump Incremental Definitions Dialog Box */
&Global-define Dump_Incremental_Definitions_Dlg_Box 49192

/* Import Stuff Dialog Box (used for DIF and SYLK files) */
&Global-define Import_Stuff_Dlg_Box 49193

/* Import dBase File Contents Dialog Box */
&Global-define Import_dBase_File_Contents_Dlg_Box 49194

/* Import Delimited ASCII Dialog Box */
&Global-define Import_Delimited_ASCII_Dlg_Box 49195

/* Import Fixed Length Dialog Box */
&Global-define Import_Fixed_Length_Dlg_Box 49196

/* Index Deactivation Dialog Box */
&Global-define Index_Deactivation_Dlg_Box 49197

/* Generate Form Dialog Box */
&Global-define Generate_Form_Dlg_Box 49198

/* Export Stuff Dialog Box (used for export of everything but ASCII */
&Global-define Export_Stuff_Dlg_Box 49199

/* Export ASCII Dialog Box */
&Global-define Export_ASCII_Dlg_Box 49200

/* Dump Stuff Dialog Box 
   (used for dump of everything except table (data) contents */
&Global-define Dump_Stuff_Dlg_Box 49201

/* Dump Data Contents Dialog Box */
&Global-define Dump_Data_Contents_Dlg_Box 49202

/* Freeze/Unfreeze Table Dialog Box */
&Global-define Freeze_Unfreeze_Table_Dlg_Box 49203

/* Generate Assign Dialog Box */
&Global-define Generate_Assign_Dlg_Box 49204

/* Security Administrators Dialog Box */
&Global-define Security_Administrators_Dlg_Box 49205

/* Convert df File Format Dialog Box */
&Global-define Convert_df_File_Format_Dlg_Box 49206

/* Import Dbase Definition Results Dialog Box */
&Global-define Import_dBase_Definition_Results_Dlg_Box 49207

/* Resolve Mismatched Table Dialog Box (used in incremental dump) */
&Global-define Resolve_Mismatched_Table_Dlg_Box 49208

/* Resolve Mismatched Field Dialog Box (used in incremental dump)*/
&Global-define Resolve_Mismatched_Field_Dlg_Box 49209

/* Resolve Mismatched Sequence Dialog Box (used in incremental dump)*/
&Global-define Resolve_Mismatched_Sequence_Dlg_Box 49210

/* Fields for Export Dialog Box */
&Global-define Fields_For_Export_Dlg_Box 49211

/* Fields for Import Dialog Box */
&Global-define Fields_For_Import_Dlg_Box 49212

/* Indexes for Deactivation Dialog Box */
&Global-define Indexes_For_Deactivation_Dlg_Box 49213

/* Make Bulk Load Description File Dialog Box */
&Global-define Make_Bulk_Load_Dlg_Box 49214

/* Output Record Dialog Box */
&Global-define Output_Record_Dlg_Box 49215

/* Dump Data Contents Some Dialog Box */
&Global-define Dump_Data_Contents_Some_Dlg_Box 49216

/* Load Data Contents Some Dialog Box */
&Global-define Load_Data_Contents_Some_Dlg_Box 49217

/* Dump CREATE VIEW All Dialog Box */
&Global-define Dump_Create_View_All_Dlg_Box 49218

/* Dump CREATE TABLE All Dialog Box */
&Global-define Dump_Create_Table_All_Dlg_Box 49219

/* Edit Variable Length Settings Dialog Box */
&Global-define Edit_Var_AS400 49220

/* Create/Modify Database Record for DataServer Schema Dialog Box */
&Global-define Create_DataServer_Schema_Dlg_Box 49221

/* User ID and Password Dialog Box */
&Global-define User_ID_Dlg_Box 49222

/* Select DataServer Tables Dialog Box */
&Global-define Select_DataServer_Tables_Dlg_Box 49223

/* Verify DataServer Dialog Box */
&Global-define Verify_DataServer_Dlg_Box 49224

/* Adding ISAM Table Definitions Dialog Box */
&Global-define Add_Table_Defs_Dlg_Box 49225

/* Codepage Dialog Box */
&Global-define Code_Page_Dlg_Box 49226

/* Deselect Tables by Pattern Match Dialog Box */
&Global-define Deselect_by_Pattern_Dlg_Box 49

/* Select Tables by Pattern Match Dialog Box (DataServer context) */
&Global-define Select_by_Pattern_DataServer_Dlg_Box 49228

/* Deselect Tables by Pattern Match Dialog Box  (DataServer context) */
&Global-define Deselect_by_Pattern_DataServer_Dlg_Box 49229

/* Change Code Page Dialog Box */
&Global-define Change_Code_Page_Dlg_Box 49230

/* Pre-selection Criteria for Schema Pull Dialog Box */
&Global-define Presel_Schema_Pull_Dlg_Box 49231

/* Pre-selection Criteria for Schema Pull Dialog Box (Qualifier version) */
&Global-define Presel_Schema_Pull_Qual_Dlg_Box 49232

/* User-defined Data Types Selection Dialog Box */
&Global-define User_Def_Datatype_Dlg_Box 49233

/* User-defined Data Types Add/Update Dialog Box */
&Global-define User_Def_Datatype_Dlg_Box_Prop 49234

/* Links to Distributed Databases Dialog Box (ORACLE DataServer) */
&Global-define Link_Distrib_DB_Dlg_Box 49235

/* Help Menu How To Help screen. */
&Global-define How_To 49236

/* Redefining RMS Idexes - Index selection */
&Global-define Redef_Index_IdxSel_Dlg_Box 49237

/* Redefining RMS Idexes - Index-fields selection */
&Global-define Redef_Index_IdxFldSel_Dlg_Box 49238

/* Adding RMS Table Definitions Dialog Box */
&Global-define Add_RMS_Table_Defs_Dlg_Box 49239

/* Folling 2 help # moved to dictghlp.i */
/* ROWID-Index Dialog Box */
/*  &Global-define RowID_Idx_Dlg_Box 49240 */
/* ROWID-Index Detail Dialog Box */
/* &Global-define RowID_Idx_Dtl_Dlg_Box 49241 */

/* Schema Verify Dialog Box */
&Global-define Schema_Verify_Dlg_Box 49242

/* Schema Verify Reports Detail Dialog Box */
&Global-define Verify_Report_Dlg_Box 49243

/* Migration from Progress DB to an ODBC Data Source */
&Global-define PROGRESS_DB_to_ODBC_Dlg_Box	650

/* Create a SQL script and a df for the schema holder from a Progress delta.df */
&Global-define Incremental_Schema_Migration_Dlg_Box	651

/* Migration from Progress DB to an Oracle Database */
&Global-define PROGRESS_DB_to_ORACLE_Dlg_Box	652

/* Migration from Progress DB to a SQL Server Database */
&Global-define Progress_DB_To_SQL_Dlg_Box  2511111

/* ROWID-Index Dialog Box */
&Global-define RowID_Idx_Dlg_Box 49240

/* ROWID-Index Detail Dialog Box */
&Global-define RowID_Idx_Dtl_Dlg_Box 49241

/* Alternate Buffer Pool Maintenance dialog box */
&Global-define Alternate_Buffer_Pool_Maintenance_Dialog_Box 40

/* Alternate Buffer Pool Object Selector dialog box */
&Global-define Alternate_Buffer_Pool_Object_Selector_Dialog_Box 41

/* Encryption Policies Object Selector dialog box */
&Global-define Encryption_Policies_Object_Selector_Dialog_Box1 44

/* Edit Encryption Policies dialog box */
&Global-define Edit_Encryption_Policy_Dialog_Box1 45

/* Encryption Policy History dialog box */
&Global-define Encryption_Policy_History_Dialog_Box 46

/* Encryption Policy Generate Encryption Keys dialog box */
&Global-define Generate_Encryption_Keys_Dialog_Box 47

/* Copy Current Setting To dialog box */
&Global-define Copy_Current_Setting_To            48

&Global-define Deselect_Objects_by_Pattern_Match   51

&Global-define Select_Objects_by_Pattern_Match       52

/* Confirm Domain dialog box */
&Global-define Domains_Dialog_Box 56 

/* Confirm dump data Multi-tenancy dialog box */
&Global-define Dump_Data_Contents_for_Some_Tables_Multi_tenant_enabled_Dialog_Box 57

/* Confirm Select tenant dialog box */
&Global-define Select_Tenant_Dialog_Box 60
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* dictgate.i - (another) performs routine for the different db mgrs 

  History:  D. McMann 03/20/00 Changed MSSQLSRV to MSS 

*/

{&output} = "{&action}".
RUN VALUE("prodict/" +
  ENTRY(LOOKUP({&dbtype},
               "AS400,CTOSISAM,GENERIC," 
             + "OBJECTA,ORACLE,RDB,SYBASE,ODBC," 
             + "SYB10,ALLBASE,DB2,DB2-DRDA,MSS") + 1,
        "pro/_pro,as4/_as4,bti/_bti,gen/_gen,"
      + "oag/_oag,ora/_ora,rdb/_rdb,syb/_syb,odb/_odb,"
      + "odb/_odb,odb/_odb,odb/_odb,odb/_odb,mss/_mss")
  + "_sys.p")
  ({&dbrec},INPUT-OUTPUT {&output}).
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* dictnext.i - executes the next simple entry in user_path */
/* {1} = the name of a temp char variable */

IF user_path <> ""
  AND INDEX(ENTRY(1,user_path),"=") = 0
  AND INDEX(ENTRY(1,user_path),"*") = 0
  AND INDEX(ENTRY(1,user_path),"!") = 0
  AND INDEX(ENTRY(1,user_path),"?") = 0 THEN DO:
  ASSIGN
    {1}       = ENTRY(1,user_path)
    user_path = SUBSTRING(user_path,LENGTH({1},"character") + 2,-1,"character").
  IF {1} <> "*N" THEN DO:
    IF      {1} BEGINS "_dct" THEN .
    ELSE IF {1} BEGINS "_usr" THEN {1} = "user/" + {1}.
    ELSE IF {1} BEGINS "_gui" THEN {1} = "gui/"  + {1}.
    ELSE IF {1} BEGINS "_dmp"
         OR {1} BEGINS "_lod" THEN {1} = "dump/" + {1}.
    ELSE IF {1} BEGINS "_gat" THEN {1} = "gate/" + {1}.
    ELSE IF {1} BEGINS "_as4" THEN {1} = "as4/"  + {1}.  /* AS400 */
    ELSE IF {1} BEGINS "_bti" THEN {1} = "bti/"  + {1}.  /* CTOS-ISAM */
    ELSE IF {1} BEGINS "_gen" THEN {1} = "gen/"  + {1}.  /* Generic */
    ELSE IF {1} BEGINS "_oag" THEN {1} = "oag/"  + {1}.  /* Object Access */
    ELSE IF {1} BEGINS "_ora" THEN {1} = "ora/"  + {1}.  /* Oracle */
    ELSE IF {1} BEGINS "_pro" THEN {1} = "pro/"  + {1}.  /* PROGRESS */
    ELSE IF {1} BEGINS "_rdb" THEN {1} = "rdb/"  + {1}.  /* VMS Rdb */
    ELSE IF {1} BEGINS "_syb" THEN {1} = "syb/"  + {1}.  /* SYBASE */
    ELSE IF {1} BEGINS "_odb" THEN {1} = "odb/"  + {1}.  /* ODBC */
    ELSE                           {1} = "misc/" + {1}.
    RUN VALUE("prodict/" + {1} + ".p").
  END.
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* dictsplt.i - this routine will split a string into several array elements */

/*
  {&src} = variable to split into array elements
  {&dst} = array variable to hold pieces
  {&num} = number of pieces
  {&len} = maximum length of each piece
  {&chr} = char to split at (e.g. " " or ",")
*/

{&dst}[1] = {&src}.

DO j = 1 TO {&num} - 1:
  IF LENGTH({&dst}[j],"character") > {&len} THEN
    ASSIGN
      i             = R-INDEX({&dst}[j],"{&chr}",{&len})
      i             = (IF i = 0 THEN {&len} ELSE i)
      {&dst}[j + 1] = TRIM(SUBSTRING({&dst}[j],i + 1,-1,"character"))
      {&dst}[j    ] = SUBSTRING({&dst}[j],1,i,"character").
  ELSE
    {&dst}[j + 1] = "".
END.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* dictsrch.i - BINARY SEARCH THROUGH A SORTED ARRAY. */
/*
Necessary definitions:
DEFINE VARIABLE hb AS INTEGER NO-UNDO.
DEFINE VARIABLE lb AS INTEGER NO-UNDO.

&vector = array name
&extent = array limit
&tofind = value to find
&result = holds element number in array or -1 for not found
*/

ASSIGN
  hb = {&extent}
  lb = 1
  {&result} = 1.

DO WHILE {&result} <> -1:
  {&result} = TRUNCATE((hb + lb) / 2,0).
  IF hb < 1 OR lb > {&extent} OR hb < lb THEN {&result} = -1.
  ELSE IF {&vector}[{&result}] BEGINS {&tofind} THEN LEAVE.
  ELSE IF {&tofind} > {&vector}[{&result}] THEN lb = {&result} + 1.
  ELSE IF {&tofind} < {&vector}[{&result}] THEN hb = {&result} - 1.
  /*ELSE IF {&tofind} = {&vector}[{&result}] THEN LEAVE.*/
END.
DO WHILE {&result} > 1:
  IF {&vector}[{&result} - 1] BEGINS {&tofind} THEN
    {&result} = {&result} - 1.
  ELSE
    LEAVE.
END.
/*********************************************************************
* Copyright (C) 2006,2008-2009,2011,2015 by Progress Software Corporation.*
* All rights reserved.  Prior versions of this work may contain      *
* portions contributed by participants of Possenet.                  *
*                                                                    *
*********************************************************************/

/*dictvar.i - dictionary shared variable definitions 

Modified:
   02/19/97 DLM     Changed cache_file from extent 1024 to 2048 (97-02-14-001) 
   12/28/98 Mario B 12/28/98 Add s_In_Schema_Area enable 1 time notification. 
   07/28/99 Mario B Support for array data types. BUG 19990716-033.
   10/14/99 Mario B Removed shared variable s_Set_Anyway.  No longer needed.
   03/13/06 fernando Store table names in temp-table - bug 20050930-006.
   06/12/06 fernando Support for int64
   06/26/08 fernando Adding pre-processors for encryption stuff
   07/21/08 fernando Adding shared var for epolicy
   04/13/09 fernando Change for alternate buffer pool
*/

DEFINE {1} SHARED VARIABLE dict_rog        AS LOGICAL               NO-UNDO.
DEFINE {1} SHARED VARIABLE dict_trans      AS LOGICAL               NO-UNDO.
DEFINE {1} SHARED VARIABLE dict_dirty      AS LOGICAL               NO-UNDO.

DEFINE {1} SHARED VARIABLE cache_dirty     AS LOGICAL  INITIAL TRUE NO-UNDO.

DEFINE {1} SHARED VARIABLE cache_db#        AS INTEGER   INITIAL 0   NO-UNDO.
DEFINE {1} SHARED VARIABLE cache_db_s       AS CHARACTER EXTENT 480  NO-UNDO.
DEFINE {1} SHARED VARIABLE cache_db_l       AS CHARACTER EXTENT 480  NO-UNDO.
DEFINE {1} SHARED VARIABLE cache_db_p       AS CHARACTER EXTENT 480  NO-UNDO.
DEFINE {1} SHARED VARIABLE cache_db_t       AS CHARACTER EXTENT 480  NO-UNDO.
DEFINE {1} SHARED VARIABLE cache_db_e       AS CHARACTER EXTENT 480  NO-UNDO.
/* s=schema_db, l=logical_db, p=physical_db, t=db_type(int), e=db_type(ext)*/

DEFINE {1} SHARED VARIABLE cache_file#      AS INTEGER  INITIAL 0    NO-UNDO.
DEFINE {1} SHARED VARIABLE cache_file       AS CHARACTER EXTENT 2048 NO-UNDO.
DEFINE {1} SHARED VARIABLE l_cache_tt       AS LOGICAL  INIT NO      NO-UNDO.

DEFINE {1} SHARED VARIABLE drec_db          AS RECID    INITIAL ?    NO-UNDO.
DEFINE {1} SHARED VARIABLE drec_file        AS RECID    INITIAL ?    NO-UNDO.

DEFINE {1} SHARED VARIABLE s_DbType1        AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE {1} SHARED VARIABLE s_DbType2        AS CHARACTER INITIAL ?   NO-UNDO.
DEFINE {1} SHARED VARIABLE s_DbRecId        AS RECID    INITIAL ?    NO-UNDO.
DEFINE {1} SHARED VARIABLE s_In_Schema_Area AS LOGICAL  INIT NO      NO-UNDO.

/* set when a pre-101b db, so we don't allow 10.1B stuff */
DEFINE {1} SHARED VARIABLE is-pre-101b-db   AS LOGICAL               NO-UNDO.

DEFINE {1} SHARED VARIABLE dictObjAttrCache AS LOGICAL                      NO-UNDO.
DEFINE {1} SHARED VARIABLE dictEPolicy      AS prodict.sec._sec-pol-util    NO-UNDO.
DEFINE {1} SHARED VARIABLE dictObjAttrs     AS prodict.pro._obj-attrib-util NO-UNDO.
DEFINE {1} SHARED VARIABLE dictLoadOptions  AS OpenEdge.DataAdmin.Binding.IDataDefinitionOptions NO-UNDO.
DEFINE {1} SHARED VARIABLE dictMonitor      AS OpenEdge.DataAdmin.Binding.ITableDataMonitor NO-UNDO.

/* for bug fix 20050930-006 */
&IF DEFINED(NOTTCACHE) = 0 &THEN

DEFINE {1} SHARED TEMP-TABLE tt_cache_file NO-UNDO
    FIELD nPos       AS INTEGER
    FIELD cName      AS CHARACTER
    FIELD p_flag     AS LOGICAL
    FIELD multitenant  AS LOGICAL
    INDEX nPos IS UNIQUE PRIMARY nPos
    INDEX cName cName.
&ENDIF

&IF "{&DATASERVER}" = "YES" OR "{&ORACLE-DATASERVER}" = "YES"
 &THEN
  { prodict/ora/ora_lkdf.i 
      &new = " {1}"
      } /* Defines temp-table s_ttb_link for DATASERVER*/
  {prodict/gate/gatework.i 
    &new        = " {1}"
    &selvartype = "{1} shared variable s"
    &options    = "initial ""*"" "
    } /* Defines: temp-table gate-work */
 &ENDIF
 

/* List of areas that should not be available to the user */
&GLOBAL-DEFINE INVALID_AREAS "Encryption Policy Area":U

/* List of schema tables to be filtered out */
&GLOBAL-DEFINE INVALID_SCHEMA_TABLES "_sec-db-policy,_sec-obj-policy,_sec-pwd-policy":U
/***********************************************************************
* Copyright (C) 2007-2012 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/

/* file-name may be either a specific file or ALL */
/* 
File:   prodict/dump_d.p

Description:
    This was changed to that callers can call it persistently, so
    that we provide support for setting other settings that were
    not available before, such as the LOB-DIR. We can't change
    the signature of this for backward compatibility reasons, so
    we are providing another way for setting it. See Other-settings
    for the new settings that can be set. Each one of them can be
    set by calling the corresponding setter internal procedure.
    
    NOTE that this can still be called as a regular procedure, in
    which case we will run it as previously with no change in behavior.
    
IN:
    file-name                : "ALL" or "<file-name>"
    dot-d-dir                : directory relativ to working-directory
    code-page                : ?, "", "<code-page>"
    
    
Other-settings:    
    cLob-Dir                 : ?, "", directory
    map-option              : "MAP <name>" or "NO-MAP" OR ""
        
History
    fernando    12/12/07 Don't need to set user_env[4] anymore    
    fernando    02/27/07 Support for long dump name - OE00146586    
    fernando    10/12/06 Allow this to be called persistently
    fernando    03/16/06 Handle case with too many tables selected - bug 20050930-006.
    mcmann      10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
    mcmann      00/08/14 Changed _db-name to DICTDB for dbversion 20000810035
    mcmann      98/07/13 Added _Owner for _File finds
    laurief     97/12    Removed RMS,CISAM code
    kkelley     95/08    Multi-db with multiple tables
    hutegger    95/01    multi-db support
    hutegger    94/02    code-page support

Multi-DB-Support:
    the syntax of file-name is:
           [ <DB>. ] <tbl>             [ <DB>. ] <tbl>
        {  ---------------  }  [ , {  ---------------  } ] ...
             <DB>."ALL"                  <DB>."ALL"
    {   -----------------------------------------------------------  }
                        "ALL"

Code-page - support:
    code-page = ?             : no-conversion
    code-page = ""            : default conversion (SESSION:STREAM)
    code-page = "<code-page>" : convert to <code-page>

    if not convertable to code-page try to convert to SESSION:STREAM
    if still not convertable don't convert at all

Example:

This is an example on how to call this proc persistently to set the
newly added options:

DEF VAR h AS HANDLE NO-UNDO.
RUN prodict/dump_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir, INPUT code-page).
RUN setLobDir IN h (input cLob-Dir). /* this is optional */
RUN setMap IN h (input "NO-MAP"). /* this is optional */
RUN doDump IN h.
DELETE PROCEDURE h.

super-tenant rules.
Setting set-effective-tenant before calling this will cause tenant data
to be dumped in the (dot-d-dir) standard directory or file-name 

This is an example on how to call this proc persistently to have more control
over multi-tenant options:

    
--- default location - create subdirs if necessary  --
RUN prodict/dump_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir, INPUT code-page).
RUN setEffectiveTenant IN h (gtenant). 
RUN doDump IN h.

shared data will be dumped in            dot-d-dir
effective tenant data will be dumpbed in dot-d-dir + "/" + gtenant
shared lobs will be dumped in            dot-d-dir + "/lobs"
effective tenant lobs will be dumpbed in dot-d-dir+ "/" + gtenant + "/lobs"

--- default location no-lobs - create subdirs if necessary  --
RUN prodict/dump_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir, INPUT code-page).
RUN setEffectiveTenant IN h (gtenant). 
RUN setNoLobs IN h (true). 
RUN doDump IN h.

shared data will be dumped in            dot-d-dir
effective tenant data will be dumpbed in dot-d-dir + "/" + gtenant

--- specify location  ---
RUN prodict/dump_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir, INPUT code-page).
RUN setUseDefaultLocation IN h (false). 
RUN setEffectiveTenant IN h (gtenant). 
RUN setTenantDir IN h (gtenantdir). 
RUN setLobDir IN h (globdir). 
RUN setTenantLobDir IN h (gtenantlobdir). 

RUN doDump IN h.

shared data will be dumped in            dot-d-dir
effective tenant data will be dumpbed in gtenantdir
shared lobs will be dumped in            globdir
effective tenant lobs will be dumpbed in gtenantlobdir

--- all data in current directory  don't use default  ---
RUN prodict/dump_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir, INPUT code-page).
RUN setEffectiveTenant IN h (gtenant). 
RUN setUseDefaultLocation IN h (false). 
RUN doDump IN h.

all data will be dumped in dot-d-dir
Multi-tenant Summary:     
Use setEffectiveTenant :
1. Use default location = true (this is default)  
The following subdirectories will be created if necessary 
is used (assuming default Use default location = true):
 - Tenant data will be dumped in subdirs named after tenant 
 - Group data will be dumped in subdir setGroupDirName (default = "groups") 
   with subdirs named after group. 
 - Lobs will be dumped in subdir setLobDirName (default = "lobs") under the root, 
   tenants and groups directories.
2. Set UseDefaultLocation = false  
Dumps data in setTenantDir, setLobDir, SetGroupDir and setTenantLobDir. 
Group data will be dumped in setGroupDir with subdirs named after group. 

Not using setEffectiveTenant:
Gives transparent behavior for regular tenants with all data dumped in specified 
work and lob directories with no directory separation of tenant and group data 
just as if the database is non multi-tenant. 
***************************************************************************************/

using OpenEdge.DataAdmin.Binding.ITableDataMonitor from propath .

DEFINE INPUT PARAMETER file-name AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER dot-d-dir AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER code-page AS CHARACTER NO-UNDO.

/* This are new settings that can be set by calling the provided setter
   internal procedures, if this is called persistently. Otherwise, the
   behavior remains the same as previous versions, with the same default
   values.
*/
DEFINE VARIABLE gLobDir         AS CHARACTER NO-UNDO.
DEFINE VARIABLE gLobDirName     AS CHARACTER NO-UNDO init "lobs":U.
DEFINE VARIABLE gTenantDir      AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenantLobDir   AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenant         AS CHARACTER NO-UNDO.
define variable gNoLobs          as logical   no-undo.
define variable gUseDefault      as logical   no-undo init ?.
define variable gGroupDir        as CHARACTER no-undo.
define variable gGroupDirName    as CHARACTER no-undo init "groups":U.
DEFINE VARIABLE gMapOption       AS CHARACTER NO-UNDO .
DEFINE VARIABLE gSilent          AS LOGICAL NO-UNDO.
DEFINE VARIABLE gSkipilent       AS LOGICAL NO-UNDO.
DEFINE VARIABLE gExternalTenant  AS char      NO-UNDO.
DEFINE VARIABLE gSkipCodePageValidation  AS logical      NO-UNDO.
DEFINE VARIABLE isCpUndefined    AS LOGICAL NO-UNDO.
define variable ghTempTable      as handle no-undo.
define variable gUseDefaultOut   as character no-undo init "<default>".
define variable gMonitor         as ITableDataMonitor no-undo.



{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i NEW }


define temp-table ttb_dump
        field db        as character
        field tbl       as character
        index upi is primary unique db tbl.

       
/*--------------------------- FUNCTIONS  --------------------------*/
function validDirectory returns logical ( cValue as char):
  
    IF cValue <> "" THEN 
    DO:
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        return SUBSTRING(FILE-INFO:FILE-TYPE,1,1) = "D".
    END.
        
    return true.
 
end function. /* validateDirectory */

function createDirectoryIf returns logical ( cdirname as char):
    define variable iStat as integer no-undo.
    if not validdirectory(cdirname) then
    do:
        OS-CREATE-DIR VALUE(cdirname). 
        iStat = OS-ERROR. 
        
        if iStat <> 0 then
           MESSAGE "Cannot create directory " + cdirname + ". System error:" iStat
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return istat = 0.
    end.
    return true.
end function. /* validateDirectory */
        
/*---------------------------  MAIN-CODE  --------------------------*/

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

/* if not running persistenty, go ahead and dump the definitions */
IF NOT THIS-PROCEDURE:PERSISTENT THEN
   RUN doDump.

/*--------------------------- INTERNAL PROCS  --------------------------*/
PROCEDURE setFileName:
    DEFINE INPUT PARAMETER pfile-name AS CHAR NO-UNDO.
    ASSIGN file-name = pfile-name.
    ghTempTable = ?.
END.

PROCEDURE setDirectory:
    DEFINE INPUT PARAMETER pdot-d-dir AS CHAR NO-UNDO.
    ASSIGN dot-d-dir = pdot-d-dir.
END.

PROCEDURE setCodePage:
    DEFINE INPUT PARAMETER pcodepage AS CHAR NO-UNDO.
    ASSIGN code-page = pcodepage.
END.

PROCEDURE setNoLobs:
    DEFINE INPUT PARAMETER pNoLobs AS logical NO-UNDO.
    ASSIGN gNoLobs = pNoLobs.
END.

PROCEDURE setLobDir:
    DEFINE INPUT PARAMETER pcLob-Dir AS CHAR NO-UNDO.
    ASSIGN gLobDir = pcLob-Dir.
END.

PROCEDURE setLobDirName:
    DEFINE INPUT PARAMETER pcLobName AS CHAR NO-UNDO.
    ASSIGN gLobDirName = pcLobName.
END.

PROCEDURE setUseDefaultLocation:
    DEFINE INPUT PARAMETER pldefault AS logical NO-UNDO.
    ASSIGN gUseDefault = pldefault.
END.

PROCEDURE setEffectiveTenant:
    DEFINE INPUT PARAMETER pcTenant AS CHAR NO-UNDO.
    if gExternalTenant = "" then
        gExternalTenant = get-effective-tenant-name("dictdb").
  
    gTenant = pctenant.
    if gUseDefault = ? then 
       gUseDefault = true.
END.

PROCEDURE setGroupDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    gGroupDir = pcDir.
END.

PROCEDURE setGroupDirName:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    gGroupDirName = pcDir.
END.

PROCEDURE setTenantDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    ASSIGN gTenantDir = pcDir.
END.

PROCEDURE setTenantLobDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    ASSIGN gTenantLobDir = pcDir.
END.

PROCEDURE setMap:
    DEFINE INPUT PARAMETER pcmap-option AS CHAR NO-UNDO.
    ASSIGN gMapOption = pcmap-option.
END.

PROCEDURE SetSilent:
    DEFINE INPUT PARAMETER setsilent AS LOGICAL NO-UNDO.
    ASSIGN gSilent = setsilent.
END.

PROCEDURE SetSkipCodePageValidation:
    DEFINE INPUT PARAMETER plskip as logical NO-UNDO.
    ASSIGN gSkipCodePageValidation = plskip .
END.
/** set a temptable handle with lsit of tables to dump.
    the table must have databasename with logical name (currently only used with ldbname("dictdb"))
    and a name field with the table name */ 
PROCEDURE SetTable:
    DEFINE INPUT PARAMETER table-handle h.
    ASSIGN ghTempTable = h.
END.

/** set the monitor for status log */
PROCEDURE SetMonitor:
    DEFINE INPUT PARAMETER pmon as ITableDataMonitor.
    ASSIGN gMonitor = pmon.
END.

/* This is the meat of this procdure */

PROCEDURE doDump:
    define variable GroupCount as integer no-undo.
    define variable lFound as logical no-undo.
    define variable iMtcount         as integer no-undo.
    define variable hQ as handle no-undo.
    define variable hBuffer as handle no-undo.
          
    DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
    DEFINE VARIABLE l_db-name   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_for-type  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_int       AS INTEGER   NO-UNDO.
    DEFINE VARIABLE l_item      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_list      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE save_ab     AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE all_shared  AS LOGICAL   NO-UNDO INITIAL FALSE.
    DEFINE VARIABLE all_multitenant  AS LOGICAL   NO-UNDO INITIAL FALSE.
    define variable cSlash         as character no-undo.
    
    /* as of current just let the ABL  deal with error */
    if gtenant > "" then
        set-effective-tenant(gtenant,"dictdb"). 
    
    /* make sure table is empty */
    EMPTY TEMP-TABLE ttb_dump NO-ERROR.

    IF gMapOption = ? THEN
        gMapOption = "".
    if file-name = "<shared>" then
    do: 
        assign all_shared = true
               file-name = "ALL".
    end.
    else if file-name = "<tenant>" then 
    do:
        assign all_multitenant = true
               file-name = "ALL".    
    end.
                   
    /* make sure these are clear */
    ASSIGN user_env = ""
           user_longchar = (IF isCpUndefined THEN user_longchar ELSE "").
    
    if code-page <> "<internal defaults apply>" then
    do: 
        if code-page = ?  then 
            assign code-page = "<internal defaults apply>".
        else do:
            if code-page = "" then 
                assign code-page = SESSION:STREAM.
            else if codepage-convert("a",code-page,SESSION:CHARSET) = ? then 
                assign code-page = SESSION:STREAM.
            if codepage-convert("a",code-page,SESSION:CHARSET) = ? then 
                assign code-page = "<internal defaults apply>".
        end.
    end.  
    assign
      save_ab                   = SESSION:APPL-ALERT-BOXES
      SESSION:APPL-ALERT-BOXES  = NO.
    
    if not valid-handle(ghTempTable) then
    do:
        /****** 1. step: create temp-table from input file-list ***********/
        if file-name = "ALL" then 
        do:  /* dump ALL files of ALL dbs */
            for each DICTDB._DB NO-LOCK:
                create ttb_dump.
                assign
                   ttb_dump.db  = ( if DICTDB._DB._DB-Type = "PROGRESS" 
                                    THEN LDBNAME("DICTDB")
                                    ELSE DICTDB._DB._Db-name
                             )
                   ttb_dump.tbl = "ALL".
            end.    
         
        end.     /* dump ALL fiels of ALL dbs */        
            
        else do:  /* dump SOME files of SOME dbs */
         
            assign l_list = file-name.
            repeat i = 1 to num-entries(l_list):
                create ttb_dump.
                assign
                    l_item = entry(i,l_list)
                    l_int  = index(l_item,".").
                if l_int = 0 then 
                    assign 
                        ttb_dump.db  = ""
                        ttb_dump.tbl = l_item.
                else 
                    assign
                        ttb_dump.db  = substring(l_item,1,l_int - 1,"character")
                ttb_dump.tbl = substring(l_item,l_int + 1, -1,"character").
            end.
        end.     /* dump SOME files of SOME dbs */
    end.
    
    
    /****** 2. step: load in all files according to temp-table ******/     
    for each DICTDB._Db NO-LOCK:
    
      assign
        l_db-name   = ( if DICTDB._DB._DB-Type = "PROGRESS" 
                         THEN LDBNAME("DICTDB")
                         ELSE _DB._DB-name
                      )
        user_env[1] = ""
        user_longchar = (IF isCpUndefined THEN user_longchar ELSE "")
        l_for-type  = ( if CAN-DO("PROGRESS",DICTDB._DB._DB-Type) 
                         THEN ?
                         ELSE "TABLE,VIEW"
                      ).
      
      if not valid-handle(ghTempTable) then
      do:
        
          /* to generate the list of tables of this _db-record to be dumped and
           * assign it to user_longchar we
           * a) try to use all tables WITHOUT db-specifyer
           */
          for each ttb_dump where ttb_dump.db = "" 
          while user_env[1] <> ",all":
              if ttb_dump.tbl <> "all" then 
              do:
                  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
                      find first DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                                 AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                                                 no-lock no-error.
                  ELSE
                      find first DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                                 no-lock no-error.                           
                  if available DICTDB._File and ( can-do(l_for-type,DICTDB._File._For-type) or l_for-type = ? ) then 
                  do:
                      IF isCpUndefined THEN
                          assign user_env[1] = user_env[1] + "," + ttb_dump.tbl.
                      ELSE
                          assign user_longchar = user_longchar + "," + ttb_dump.tbl.
                      if DICTDB._File._file-attributes[1] then
                         iMtCount = iMtCount + 1.
                  END.
              end.
              else 
                  assign user_env[1] = ",all".
          end.
        
          /* b) try to use all tables WITH db-specifyer */
          for each ttb_dump where ttb_dump.db = l_db-name 
          while user_env[1] <> ",all":
              if ttb_dump.tbl <> "all" then 
              do:
                  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN     
                      find first DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                               AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                                               no-lock no-error.
                  ELSE
                      find first DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                               no-lock no-error.                            
                  if available DICTDB._File
                  and ( can-do(l_for-type,DICTDB._File._For-type)
                  or    l_for-type = ? ) then 
                  do:
                     IF isCpUndefined THEN
                         assign user_env[1] = user_env[1] + "," + ttb_dump.tbl.
                     ELSE
                         assign user_longchar = user_longchar + "," + ttb_dump.tbl.
                     if DICTDB._File._file-attributes[1] then
                         iMtCount = iMtCount + 1.
                  END.
              end.
              else 
                 assign user_env[1] = ",all".
          end.
            
          /* c) if either "all" or "all of this db" then we take every file
           *    of the current _Db
          */
        
          IF user_env[1]  = ",all" then 
          do:  /* all files of this _Db */
    
              assign user_env[1] = "".
              IF NOT isCpUndefined THEN
                  assign user_longchar = "".
            
              /** this for each and the NEXT is duplicated in GetTableList in TableDataCommand */ 
                 
              for each DICTDB._File WHERE DICTDB._File._File-number > 0
                                    AND   DICTDB._File._Db-recid = RECID(_Db)
                                    AND   (if all_multitenant  then _file-attributes[1] = true 
                                           else if all_shared then _file-attributes[1] <> true
                                           else true)
                                     AND   NOT DICTDB._File._Hidden
              BY DICTDB._File._File-name:
                  
                  IF INTEGER(DBVERSION("DICTDB")) > 8 
                  AND DICTDB._File._Tbl-Type <> "V"     
                  AND (DICTDB._File._Owner <> "PUB" AND DICTDB._File._Owner <> "_FOREIGN") THEN 
                      NEXT.
                      
                  if l_for-type = ?
                  or can-do(l_for-type,DICTDB._File._For-type) then 
                  do:
                      IF isCpUndefined THEN
                         assign user_env[1] = user_env[1] + "," + DICTDB._File._File-name.
                      ELSE
                         assign user_longchar = user_longchar + "," + DICTDB._File._File-name.
                      
                      if DICTDB._File._file-attributes[1] then
                         iMtCount = iMtCount + 1.
                  end.
              end. /* for each _file */ 
           
              IF isCpUndefined THEN
                  assign user_env[1] = substring(user_env[1],2,-1,"character").
              ELSE
                  assign user_longchar = substring(user_longchar,2,-1,"character").
          end.     /* all files of this _Db */
          
          else do:
               IF isCpUndefined THEN
                  user_env[1] = substring(user_env[1],2,-1,"character").
               else
                  user_longchar = substring(user_longchar,2,-1,"character").
          END.
      end. /* not valid ghTempTable */
      else do:
          create query hq.
          hBuffer = ghTempTable:default-buffer-handle.
          hq:add-buffer(hBuffer).
          hq:query-prepare("for each " + ghTempTable:name
                           + " where " + ghTempTable:name + ".databasename = " + quoter(l_db-name)
                           + " by " + ghTempTable:name + ".name "). 
          hq:query-open().
          hq:get-first ().
          do while hBuffer:avail:
              IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
                  find DICTDB._File of DICTDB._Db where DICTDB._File._File-name = hBuffer::name
                                                        AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                                                        no-lock no-error.
              ELSE
                  find DICTDB._File of DICTDB._Db where DICTDB._File._File-name = hBuffer::name
                                                 no-lock no-error.                           
                  
              if avail DICTDB._File then
              do:
                  IF isCpUndefined THEN
                      assign user_env[1] = user_env[1] 
                                         + (if user_env[1] = "" then "" else ",") 
                                         + hBuffer::name .
                  ELSE
                      assign user_longchar = user_longchar 
                                           + (if user_longchar = "" then "" else ",") 
                                           + hBuffer::name.
                      
                  if DICTDB._File._file-attributes[1] then
                      iMtCount = iMtCount + 1.
              end.
              hq:get-next.
         
          end.
         
          delete object Hq.
      end.       
      
      /* is there something to dump in this _db? */
      if NOT isCpUndefined AND user_longchar = "" then next.
      if     isCpUndefined AND user_env[1] = ""   then next.
      
      /* where to put the dump? single table needs file name  */
      
      /* deal with  the single table variation  
         but not if using temp-table - add file in _dmpdata
          */
      if not valid-handle(ghTempTable)                         
      and ((isCpUndefined AND INDEX(user_env[1],",") = 0)
           OR 
           (NOT isCpUndefined AND INDEX(user_longchar,",") = 0))
            then 
      do:  /* ev. get dump-name */
           
          IF NOT isCpUndefined THEN
              ASSIGN user_env[1] = user_longchar.
    
          IF INTEGER(DBVERSION("DICTDB")) > 8 THEN 
              FIND dictdb._File OF dictdb._Db WHERE dictdb._File._File-name = user_env[1]
                              AND (dictdb._File._Owner = "PUB" OR dictdb._File._Owner = "_FOREIGN").
          ELSE
              FIND dictdb._File OF dictdb._Db WHERE dictdb._File._File-name = user_env[1].
         
          assign
              user_env[2] = ( if  dot-d-dir matches "*" + "/"
                              or dot-d-dir = ""
                              then dot-d-dir
                              else dot-d-dir + "/"
                            ) 
                            +          
                            (( if dictdb._file._Dump-name = ?
                                 THEN dictdb._file._File-name 
                                 ELSE dictdb._file._Dump-name) 
                                 + ".d")
                            .
      END.     /* ev. get dump-name */
      else  
          /* NOTE dump_d checks if user_env[2] ends with "/"
             to add filename also for the single table case 
             when the temp-talbe is used   */ 
          assign
              user_env[2] = ( if  dot-d-dir matches "*" + "/"
                              or dot-d-dir = ""
                              then dot-d-dir
                              else dot-d-dir + "/"
                            ).
      
      /* remaining needed assignments */

      assign
        user_env[3] = gMapOption /* "MAP <name>" or "NO-MAP" OR "" */
        user_env[4] = ""
        user_env[5] = if gSkipCodePageValidation 
                      then "skip-" + (if code-page = ? then "?" else code-page)
                      else code-page   
        user_env[6] = if gSilent then "dump-silent" else "no-alert-boxes"
        user_env[31] = if gNoLobs then " NO-LOBS" else ""
        drec_db     = RECID(_Db)
        user_dbname = if _Db._Db-name = ? THEN LDBNAME("DICTDB")
                                          ELSE _Db._Db-Name
        user_dbtype = if _Db._Db-name = ? THEN DBTYPE("DICTDB")
                                          ELSE _Db._Db-Type
        user_env[30] = "" 
        user_env[33] = ""
         /* lobdirname is set if use default */
        user_env[40] = "".
    /*    user_dbname = LDBNAME("DICTDB") */
    /*    user_dbtype = DBTYPE("DICTDB")  */
         .
      if gTenant <> "" then 
      do:
          assign
              user_env[32] = gTenant
              user_env[34] = "" 
              user_env[37] = "".
          if gUseDefault then 
          do:   
              user_env[33] = gUseDefaultOut.
              if gNoLobs = false then 
                  user_env[40] = gLobDirName.     
               /* defaults to groups - can be set to blank to 
                  avoid group dump*/
              if gGroupDirName > "" then   
                  user_env[37] = gGroupDirName.
          end.
          else do:
              user_env[33] = gTenantDir.
              if gNoLobs = false then 
              do:
                  assign
                      user_env[30] = gLobDir
                      user_env[34] = gTenantLobDir. 
              end. 
              if gGroupDir > "" then   
                  user_env[37] = gGroupDir.    
          end.
      end. /* gTenant <> "" */
      else do:
          if gUseDefault then
          do: 
              user_env[33] = gUseDefaultOut.
              if gNoLobs = false then 
                  user_env[40] = gLobDirName.
          end.
          else if gNoLobs = false then 
              user_env[30] = gLobDir. 
      end. 
      
      /* Indicate "y"es to disable triggers for dump of all files */
      /* Now we don't have to do this. A blank string will indicate disable
         triggers for all files 
      */
      /*assign
        user_env[4] = substring(fill(",y",
                                     num-entries((IF isCpUndefined THEN user_env[1] ELSE user_longchar)))
                               ,2
                               ,-1
                               ,"character"
                               ).
      */
    
      IF NOT isCpUndefined THEN 
      DO:
          /* see if we can put user_longchar into user_env[1] */
          ASSIGN user_env[1] = user_longchar NO-ERROR.
          IF NOT ERROR-STATUS:ERROR THEN
             /* ok to use user_env[1] */
             ASSIGN user_longchar = "". 
          ELSE
             ASSIGN user_env[1] = "".
      END.
      
      if valid-object(gMonitor) then
          dictMonitor = gMonitor. 
      RUN "prodict/dump/_dmpdata.p".
      catch e as Progress.Lang.Error :
        if gSilent then
            undo, throw e.
        else do i = 1 to e:NumMessages:
            message e:GetMessage(i)
                view-as alert-box error.      
        end.             
      end catch.
      
    
    END.    /* for each  _Db's */
    catch e as Progress.Lang.Error :
	    if gSilent then
            undo, throw e.
        else do i = 1 to e:NumMessages:
            message e:GetMessage(i)
                view-as alert-box error.      
        end.             
    end catch.
    
    finally:
        /* clean up tenant and globals - keep properties */
        assign
            dictMonitor = ?
            user_env = ""
            SESSION:APPL-ALERT-BOXES = save_ab.
        if gExternalTenant > "" then
            set-effective-tenant(gExternalTenant,"dictdb").   		
    end finally.    


END PROCEDURE.






/*********************************************************************
* Copyright (C) 2007,2009,2011 by Progress Software Corporation. All *
* rights reserved.  Prior versions of this work may contain portions *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/*--------------------------------------------------------------------   

File: prodict/dump_df.p

Description:
    This routine dumps the definition of all schemas in the first 
    Schema-Holder - all other schema-holders are ignored
    
    This was changed to that callers can call it persistently, so
    that we provide support for setting other settings that were
    not available before, such as the RCODE-POSITION. We can't change
    the signature of this for backward compatibility reasons, so
    we are providing another way for setting it. See Other-settings
    for the new settings that can be set. Each one of them can be
    set by calling the corresponding setter internal procedure.
    
    NOTE that this can still be called as a regular procedure, in
    which case we will run it as previously with no change in behavior.

Input-Parameters:
    file-name                : "ALL" or "<file-name> [,<filename>] ..."
    df-file-name             : Name of file to dump to
    code-page                : ?, "", "<code-page>"
    
Other-settings:    
    rcode-position           : yes or no
    
History
    fernando  05/14/09  Support for encryption/alternate buffer pool
    fernando  10/12/06  Allow this to be called persistently
    fernando  03/14/06  Handle case with too many tables selected - bug 20050930-006.    
    McMann    10/17/03  Add NO-LOCK statement to _Db find in support of on-line schema add
    McMann    02/10/03  Added USER-INDEX _file-name for On-line schema add
    Mario B   99/03/15  Default user_env[26] to "y" for dump _Field._Field-rpos
    mcmann    98/07/13  Added _Owner to _file finds
    laurief     97/12   Removed RMS,CISAM code
    hutegger    95/01   single-files in multiple schemas
    hutegger    94/04   multiple schema/db support (DataServers)
    hutegger    94/02   code-page support
    
Multi-DB-Support:
    the syntax of file-name is:
           [ <DB>. ] <tbl>             [ <DB>. ] <tbl>
        {  ---------------  }  [ , {  ---------------  } ] ...
             <DB>."ALL"                  <DB>."ALL"
    {   -----------------------------------------------------------  }
                        "ALL"

Code-page - support:
    code-page = ?             : no-conversion
    code-page = ""            : default conversion (SESSION:STREAM)
    code-page = "<code-page>" : convert to <code-page>

    if not convertable to code-page try to convert to SESSION:STREAM
    if still not convertable don't convert at all

Example:

This is an example on how to call this proc persistently to set the
newly added options:


DEF VAR h AS HANDLE NO-UNDO.
RUN prodict/dump_df.p PERSISTENT SET h 
    (INPUT file-name, INPUT df-file-name, INPUT code-page).
RUN IncludeRcodePosition IN h (NO). /* this is optional */
RUN doDump IN h.
DELETE PROCEDURE h.

FOR OE Architect: CR# OE00198400

This is an example on how to call this proc persistently to set the
newly added option of silent dump and to catch any errors:
    
routine-level on error undo, throw.
define variable h as handle no-undo.

run prodict/dump_df.p PERSISTENT SET h ("customer,order","C:\OpenEdge\WRK\110\dump12.df",?).
run setSilent in h(yes).
run doDump in h.
delete procedure h. 

catch e as Progress.Lang.AppError :
    message e:ReturnValue
    view-as  alert-box .  
end catch.
  
  
--------------------------------------------------------------------*/        
using Progress.Lang.*.
routine-level on error undo, throw.


/*h-*/


/*----------------------------  DEFINES  ---------------------------*/

DEFINE INPUT PARAMETER file-name    AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER df-file-name AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER code-page    AS CHARACTER NO-UNDO.

/* This is the new setting that can be set by calling the provided setter
   internal procedures, if this is called persistently. Otherwise, the
   behavior remains the same as previous versions, with the same default
   value.
*/
DEFINE VARIABLE rcode-position      AS LOGICAL   NO-UNDO INIT YES.
DEFINE VARIABLE dumpPol             AS LOGICAL   NO-UNDO.
DEFINE VARIABLE dumpAltBuf          AS LOGICAL   NO-UNDO.
DEFINE VARIABLE setdmpSilent        AS LOGICAL   NO-UNDO INIT NO.

{ prodict/user/uservar.i NEW }
{ prodict/dictvar.i NEW }


DEFINE VARIABLE i             AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_first-db    AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_int         AS INTEGER   NO-UNDO.
DEFINE VARIABLE l_item        AS CHARACTER NO-UNDO.
DEFINE VARIABLE l_list        AS CHARACTER NO-UNDO.
DEFINE VARIABLE save_ab       AS LOGICAL   NO-UNDO.
DEFINE VARIABLE l_dmp-files   AS CHARACTER NO-UNDO format "x(256)":u
    INITIAL ["_file,_field,_index,_index-field,_file-trig,_field-trig" ].
DEFINE VARIABLE isCpUndefined AS LOGICAL NO-UNDO.

define temp-table ttb_dump
        field db        as character
        field tbl       as character
        index upi is primary unique db tbl.
        
DEFINE STREAM   ddl.

/*--------------------------- INTERNAL PROCS  --------------------------*/

PROCEDURE setFileName:
    DEFINE INPUT PARAMETER pfile-name AS CHAR NO-UNDO.
    ASSIGN file-name = pfile-name.
END.


PROCEDURE setDfFileName:
    DEFINE INPUT PARAMETER pdf-file-name AS CHAR NO-UNDO.
    ASSIGN df-file-name = pdf-file-name.
END.


PROCEDURE setCodePage:
    DEFINE INPUT PARAMETER pcodepage AS CHAR NO-UNDO.
    ASSIGN code-page = pcodepage.
END.


PROCEDURE IncludeRcodePosition:
    DEFINE INPUT PARAMETER prcode-position AS LOGICAL NO-UNDO.
    ASSIGN rcode-position = prcode-position.
END.

PROCEDURE SetSilent:
    DEFINE INPUT PARAMETER setsilent AS LOGICAL NO-UNDO.
    ASSIGN setdmpSilent = setsilent.
END.

/* This is the meat of this procedure */
PROCEDURE doDump:
    DEFINE VARIABLE l_tmp-file    AS CHARACTER NO-UNDO format "x(256)":u.
    DEFINE VARIABLE l_db-name     AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_for-type    AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cMsg          AS CHARACTER NO-UNDO.
    
    IF df-file-name = ? THEN 
    DO on error undo, throw:
        cMsg = "ERROR: You must specify the .df file name".
        if setdmpSilent then 
        do: 
            undo, throw new AppError(cMsg).
        end.
        else do:   
            MESSAGE cMsg.
            RETURN.
        end.
    END.

    /* make sure table is empty */
    EMPTY TEMP-TABLE ttb_dump NO-ERROR.

    /* make sure these are clear */
    ASSIGN user_env = ""
           user_longchar = (IF isCpUndefined THEN user_longchar ELSE "").
    
    if      code-page = ?  
     then assign code-page = "<internal defaults apply>".
     else do:
      if code-page = "" then assign code-page = SESSION:STREAM.
      else if codepage-convert("a":u,code-page,SESSION:CHARSET) = ?
                        then assign code-page = SESSION:STREAM.
      if codepage-convert("a":u,code-page,SESSION:CHARSET) = ?
                        then assign code-page = "<internal defaults apply>".
      end.
      
                               
    /* dump/_dmpsddl.p dumps into a file without append-option       */
    /* -> a) dump definitions into temporary file                    */
    /*    b) concatenate these to the file according input-parameter */
    
    /* get a unique name, delete ev. existing source-file */
    RUN adecomm/_tmpfile.p (l_tmp-file, ".df", OUTPUT l_tmp-file). 
    if search(df-file-name) <> ? then OS-DELETE value(df-file-name).
      
    assign
      l_first-db               = TRUE
      save_ab                  = SESSION:APPL-ALERT-BOXES
      SESSION:APPL-ALERT-BOXES = NO
      user_env[25]             = "AUTO"
      user_env[26]             = (IF rcode-position THEN "y" ELSE "n").  
    
                           
    /****** 1. step: create temp-table from input file-list ***********/
    
    if file-name = "ALL" then 
    do:  /* dump ALL file-definitions of ALL dbs */
        for each DICTDB._DB NO-LOCK:
            create ttb_dump.
            assign
               ttb_dump.db  = ( if DICTDB._DB._DB-Type = "PROGRESS" 
                                THEN LDBNAME("DICTDB")
                                ELSE DICTDB._DB._Db-name
                               )
               ttb_dump.tbl = "*ALL*".
        end.    
     end.     /* dump ALL file-definitions of ALL dbs */
      
     else do:  /* dump SOME file-definitions of SOME dbs */
     
      assign l_list = file-name.
      repeat i = 1 to num-entries(l_list):
        create ttb_dump.
        assign
          l_item = entry(i,l_list)
          l_int  = index(l_item,".").
        if l_int = 0
         then assign
          ttb_dump.db  = ""
          ttb_dump.tbl = l_item.
         else assign
          ttb_dump.db  = substring(l_item,1,l_int - 1,"character")
          ttb_dump.tbl = substring(l_item,l_int + 1, -1,"character").
        end.
        
      end.     /* dump SOME file-definitions of SOME dbs */
    
    /****** 2. step: dump definitions according to temp-table ******/
      
    for each DICTDB._DB NO-LOCK
      by DICTDB._Db._Db-name DESCENDING : /* all schemas of current
                                          * schema-holder beginning with
                                          * the PROGRESS-DB
                                          */
                                 
      /* check run-time read-privileges */
      FOR EACH DICTDB._File
        WHERE DICTDB._File._File-name begins "_":
        IF  INDEX(l_dmp-files,DICTDB._File._File-name) = 0 
         OR CAN-DO(DICTDB._File._Can-read,USERID("DICTDB")) 
         THEN NEXT.
        if setdmpSilent then 
        do: 
            undo, throw new AppError("You do not have permission to dump table definitions.").
        end.
        ELSE         
        MESSAGE "You do not have permission to dump table definitions.".
        NEXT.
      END.
    
      assign
        l_db-name   = ( if DICTDB._DB._DB-Type = "PROGRESS" 
                         THEN LDBNAME("DICTDB")
                         ELSE DICTDB._DB._DB-name
                      )
        user_env[1] = ""
        user_longchar = (IF isCpUndefined THEN user_longchar ELSE "")
        l_for-type  = ( if CAN-DO("PROGRESS",DICTDB._DB._DB-Type)
                         THEN ?
                         ELSE "TABLE,VIEW"
                      ).
    /* to generate the list of tables of this _db-record to be dumped and
     * assign it to user_longchar we
     * a) try to use all tables WITHOUT db-specifyer
     */
      for each ttb_dump
        where ttb_dump.db = ""
        while user_env[1] <> ",all":
        if ttb_dump.tbl <> "*ALL*"
         then do:
          FOR EACH DICTDB._File of DICTDB._Db
            where DICTDB._File._File-name = ttb_dump.tbl
            USE-INDEX _File-name no-lock:
            
            IF INTEGER(DBVERSION("DICTDB")) > 8
               AND DICTDB._File._Tbl-Type = "V"
               AND (DICTDB._File._Owner <> "PUB" OR DICTDB._File._Owner <> "_FOREIGN")  
               THEN NEXT.
            ELSE
             LEAVE.     
          END.     
          if available DICTDB._File
           and ( can-do(l_for-type,DICTDB._File._For-type)
           or    l_for-type = ? )
           then do:
              IF isCpUndefined THEN
                 user_env[1] = user_env[1] + "," + ttb_dump.tbl.
              ELSE
                 user_longchar = user_longchar + "," + ttb_dump.tbl.

             drec_file   = RECID(DICTDB._File).
          END.
          end.
         else assign user_env[1] = ",all".
        end.
    
    /* b) try to use all tables WITH db-specifier */
      for each ttb_dump
        where ttb_dump.db = l_db-name
        while user_env[1] <> ",all":
        if ttb_dump.tbl <> "*ALL*"
         then do:
          FOR EACH DICTDB._File of DICTDB._Db
            where DICTDB._File._File-name = ttb_dump.tbl
            USE-INDEX _File-name no-lock:
            
            IF INTEGER(DBVERSION("DICTDB")) > 8
               AND DICTDB._File._Tbl-Type = "V"
               AND (DICTDB._File._Owner <> "PUB" OR DICTDB._File._Owner <> "_FOREIGN")  
               THEN NEXT.
            ELSE
               LEAVE.
          END.          
          if available DICTDB._File
           and ( can-do(l_for-type,DICTDB._File._For-type)
           or    l_for-type = ? )
           then do:
              IF isCpUndefined THEN
                 user_env[1] = user_env[1] + "," + ttb_dump.tbl.
              ELSE
                 user_longchar = user_longchar + "," + ttb_dump.tbl.

             drec_file   = RECID(DICTDB._File).
           END.
          end.
         else assign user_env[1] = ",all".
        end.
        
    /* c) if either "all" or "all of this db" then we take every file
     *    of the current _Db
     */
    
      IF user_env[1] = ",all"
       then do:  /* all files of this _Db */
        assign user_env[1] = "".
        IF NOT isCpUndefined THEN
           assign user_longchar = "".

        for each DICTDB._File
          WHERE DICTDB._File._File-number > 0
          AND   DICTDB._File._Db-recid = RECID(DICTDB._Db)
          AND   NOT DICTDB._File._Hidden
          USE-INDEX _File-name
          BY    DICTDB._File._File-name:
    
            IF INTEGER(DBVERSION("DICTDB")) > 8
               AND DICTDB._File._Tbl-Type = "V"
               AND (DICTDB._File._Owner <> "PUB" OR DICTDB._File._Owner <> "_FOREIGN")  
               THEN NEXT.
               
          if l_for-type = ?
           or can-do(l_for-type,DICTDB._File._For-type)
           then do:
              IF isCpUndefined THEN
                 assign user_env[1] = user_env[1] + "," + DICTDB._File._File-name.
              ELSE
                 assign user_longchar = user_longchar + "," + DICTDB._File._File-name.
          END.
        END.
        IF isCpUndefined THEN
            assign user_env[1] = substring(user_env[1],2,-1,"character").
        ELSE
            assign user_longchar = substring(user_longchar,2,-1,"character").
        END.     /* all files of this _Db */
      else do:

         IF isCpUndefined THEN
            user_env[1] = substring(user_env[1],2,-1,"character").
         ELSE
            user_longchar = substring(user_longchar,2,-1,"character").
      END.
       
      /* is there something to dump in this _db? */
      if NOT isCpUndefined AND user_longchar = "" then next.
      if     isCpUndefined AND user_env[1] = ""   then next.
      
      /* remaining needed assignments */
      ASSIGN
        user_dbname   = l_db-name
        user_dbtype   = l_for-type
        drec_db       = RECID(_Db)
        user_env[2]   = l_tmp-file
        user_env[5]   = code-page
        user_env[6]   = if setdmpSilent then "dump-silent" else "no-alert-boxes"
        user_env[9]   = "d"
        user_filename = ( if file-name = "ALL"
                           then "ALL"
                          else if index((IF isCpUndefined THEN user_env[1] ELSE user_longchar),",") = 0
                           then "ONE"  + string(l_first-db,"/ MORE")
                           else "SOME" + string(l_first-db,"/ MORE")
                        ).
      IF NOT isCpUndefined THEN DO:
          /* see if we can put user_longchar into user_env[1] */
          ASSIGN user_env[1] = user_longchar NO-ERROR.
          IF NOT ERROR-STATUS:ERROR THEN
             /* ok to use user_env[1] */
             ASSIGN user_longchar = "". 
          ELSE
             ASSIGN user_env[1] = "".
      END.

      DO TRANSACTION ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
        RUN "prodict/dump/_dmpsddl.p".

        IF LOOKUP("encpolicy", user_filename) > 0 THEN
           dumpPol = YES.

        IF LOOKUP("bufpool", user_filename) > 0 THEN
           dumpAltBuf = YES.
      END.
      
      OS-APPEND value(l_tmp-file) VALUE(df-file-name).
      
      assign l_first-db = FALSE.
      
      END.         /* all schemas of current schema-holder */
    
    OS-DELETE value(l_tmp-file).
    
    OUTPUT STREAM ddl TO VALUE(df-file-name) APPEND.
          {prodict/dump/dmptrail.i
            &entries = "IF dumpPol THEN PUT STREAM ddl UNFORMATTED
                        ""encpolicy=yes"" SKIP.
                        IF dumpAltBuf THEN PUT STREAM ddl UNFORMATTED
                        ""bufpool=yes"" SKIP."            
            &seek-stream  = "ddl"
            &stream       = "stream ddl"
            }  /* adds trailer with code-page-entrie to end of file */
    OUTPUT STREAM ddl CLOSE.
    
    assign SESSION:APPL-ALERT-BOXES = save_ab.
  
END PROCEDURE.


/*---------------------------  MAIN-CODE  --------------------------*/

IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.

/* if not running persistenty, go ahead and dump the definitions */
IF NOT THIS-PROCEDURE:PERSISTENT THEN
   RUN doDump.

/*********************************************************************
* Copyright (C) 2000,2007 by Progress Software Corporation. All rights *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/* History:

   04/13/2007   fernando    Fixing case where the table name is passed 
   
*/

DEFINE INPUT PARAMETER file-name    AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER fd-file-name AS CHARACTER NO-UNDO.

{ prodict/user/uservar.i NEW }
{ prodict/dictvar.i NEW }

FIND FIRST _Db WHERE _Db._Db-local NO-LOCK.

IF file-name NE "ALL":U THEN DO:

    /* need to also find the table based on the file name */
    FIND _File WHERE _Db-recid = RECID(_Db) AND _File-name = file-name
        AND (_File._Owner = "PUB" OR _File._Owner = "_FOREIGN" ) NO-LOCK NO-ERROR.
    
    IF NOT AVAILABLE(_File) THEN DO:
        MESSAGE "Cannot find table" file-name.
        RETURN.
    END.
END.

ASSIGN
  user_dbname   = LDBNAME("DICTDB")
  user_dbtype   = DBTYPE("DICTDB")
  drec_db       = RECID(_Db)
  drec_file     = RECID(_File)
  user_filename = file-name
  user_env[1]   = file-name
  user_env[2]   = fd-file-name.
DO TRANSACTION ON ERROR UNDO,LEAVE ON ENDKEY UNDO,LEAVE:
  RUN "prodict/dump/_dmpbulk.p".
END.
RETURN.
/*********************************************************************
* Copyright (C) 2000,2011 by Progress Software Corporation. All      *
* rights reserved. Prior versions of this work may contain portions  *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/*--------------------------------------------------------------------   

File: prodict/dump_inc.p

Description:
    Batch-mode incremental .df maker 
    DICTDB  is the current database 
            (it's the first connected database, "master")
    DICTDB2 is the database chosen to compare against (second connected,
            (it's the second connected database,

Usage:
    In scripts, e.q.:
       #!/bin/sh
       DUMP_INC_DFFILE=/tmp/delta.df
       DUMP_INC_CODEPAGE=iso8859-2
       DUMP_INC_INDEXMODE=active
       DUMP_INC_RENAMEFILE=/tmp/master.rf
       DUMP_INC_DEBUG=2
       export DUMP_INC_DFFILE DUMP_INC_CODEPAGE DUMP_INC_INDEXMODE \
              DUMP_INC_RENAMEFILE DUMP_INC_DEBUG

       $DLC/bin/_progres -b -db master \
                            -db slave  \ 
                            -p prodict/dump_inc.p > /tmp/dump_inc.log

DataServer Usage:

       $DLC/bin/_progres -b -db master \
                            -db slave  \ 
                            -p prodict/dump_inc.p > /tmp/dump_inc.log

       SHDBNAME1=/dlc/schema-holder1.db
       SHDBNAME2=/dlc/schema-holder2.db
       MSSDBNAME=<logical database name inside SHDBNAME1 schema holder with MSS foreign schema master target>
       MSSDBNAME2=<logical database name inside SHDBNAME2 schema holder with MSS foreign schema slave target>
       ORADBNAME1=<logical database name inside SHDBNAME1 schema holder with ORACLE foreign schema master target>
       ORADBNAME2=<logical database name inside SHDBNAME2 schema holder with ORACLE foreign schema slave target>

       NOTE: If -db parameters are not set at run-time, environment variables must be set to make up for them.
             If -db parameters are set at run-time, they are used for defaulting when certain environment variables is not set.
    
Environment Variables:
    DUMP_INC_DFFILE          : name of file to dump to
    DUMP_INC_CODEPAGE        : output codepage
    DUMP_INC_INDEXMODE       : index-mode for newly created indexes
                               allowed values are: "active", "inactive"
    DUMP_INC_RENAMEFILE      : name of the file with rename definitions
    DUMP_INC_DEBUG           : debug-level: 0 = debug off (only errors
                                                and important warnings)
                                            1 = all the above plus all warnings
                                            2 = all the above plus config info
    
History
    Gary C    01/06/21  This FILE created, author of the original idea
    vap       02/01/29  patched accordingly to changed specs
    moloney   13/06/12  Extended to schema holder comparisons

Code-page - support:
    code-page = ?,""          : default conversion (SESSION:STREAM)
    code-page = "<code-page>" : convert to <code-page>

    if not convertable to code-page try to convert to SESSION:STREAM

rename field support
  The rename-file parameter is used to identify tables, database fields
  and sequences that have changed names. The format of the file is a comma 
  seperated list that identifies the renamed object, its old name and the new 
  name. When an object is found missing, this file is checked to determine if
  it was renamed.  If no matching entry is found, then the object
  If rename-file is ? or "", then all missing objects are deleted.
  The rename-file has following format:
       T,<old-table-name>,<new-table-name>
       F,<table-name>,<old-field-name>,<new-field-name>
       S,<old-sequence-name>,<new-sequence-name>


Silent Icremental dump process:
  FOR OE Architect: CR# OE00198400

  This is an example on how to call this proc persistently to set the
  newly added option of silent dump and to catch any errors:
    
routine-level on error undo, throw.
define variable h as handle no-undo.

CONNECT -1 t1 NO-ERROR.
CREATE ALIAS "DICTDB2":U FOR DATABASE t1.
run prodict/dump_inc.p PERSISTENT SET h .
run setFileName in h("inc7.df").
run setCodePage in h("ibm850").
run setIndexMode in h("active").
run setRenameFilename in h("r.rf").
run setDebugMode in h(1).
run setSilent in h(yes).
RUN doDumpIncr IN h.
delete procedure h. 

catch e as Progress.Lang.AppError :
    message e:ReturnValue
    view-as  alert-box .  
end catch.
--------------------------------------------------------------------*/        
/*h-*/

/* Definitions */ /*-------------------------------------------------------*/

&GLOBAL-DEFINE errFileName "incrdump.e"

&SCOPED-DEFINE VAR_PREFIX       DUMP_INC
&SCOPED-DEFINE DEFAULT_DF       delta.df
&SCOPED-DEFINE DEFAULT_INDEX    inactive

DEFINE VARIABLE rename-file  AS CHARACTER NO-UNDO.
DEFINE VARIABLE df-file-name AS CHARACTER NO-UNDO.
DEFINE VARIABLE code-page    AS CHARACTER NO-UNDO.
DEFINE VARIABLE index-mode   AS CHARACTER NO-UNDO.
DEFINE VARIABLE debug-mode   AS INTEGER   NO-UNDO.

DEFINE VARIABLE foo          AS CHARACTER NO-UNDO.
DEFINE VARIABLE setincrdmpSilent        AS LOGICAL   NO-UNDO INIT NO.
DEFINE VARIABLE hBuf         AS HANDLE    NO-UNDO.

/* For DataServer Use */
DEFINE VARIABLE ds_shname1   AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE ds_mssname1  AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE ds_oraname1  AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE ds_dbname1   AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE user-dbtype1 AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE rtconnect1   AS LOGICAL   INITIAL no NO-UNDO.
DEFINE VARIABLE ds_shname2   AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE ds_mssname2  AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE ds_oraname2  AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE ds_dbname2   AS CHARACTER INITIAL "" NO-UNDO.
DEFINE VARIABLE user-dbtype2 AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE ds_alias     AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE sav_dictdb   AS CHARACTER INITIAL ? NO-UNDO.
DEFINE VARIABLE sav_dictdb2  AS CHARACTER INITIAL ? NO-UNDO. 
DEFINE VARIABLE shdb1-id     AS RECID     INITIAL ? NO-UNDO.
DEFINE VARIABLE dictdb-id    AS RECID     INITIAL ? NO-UNDO.
DEFINE VARIABLE shdb2-id     AS RECID     INITIAL ? NO-UNDO.
DEFINE VARIABLE dictdb2-id   AS RECID     INITIAL ? NO-UNDO.
DEFINE VARIABLE errcode      AS INTEGER   INITIAL 0 NO-UNDO.
/* For DataServer Use */

DEFINE STREAM err-log. 

{ prodict/user/uservar.i NEW }
{ prodict/user/userhue.i NEW }
{ prodict/dictvar.i NEW }

/* LANGUAGE DEPENDENCIES START */ /*----------------------------------------*/
DEFINE VARIABLE new_lang AS CHARACTER EXTENT 24 NO-UNDO INITIAL [
  /*01*/ "ERROR: ~"&1~" only runs persistent or in batch mode." ,
  /*02*/ "ERROR: You must have at least 2 databases connected." ,
  /*03*/ ?  /* see below */ ,
  /*04*/ "Using default value of ~"&1~" for &2." ,
  /*05*/ ?  /* see below */ ,
  /*06*/ ?  /* see below */, 
  /*07*/ "First connected database that defines the new baseline definitions for incremental dump is required.",
  /*08*/ "Second connected database that defines old comparative definitions for incremental dump is required.", 
  /*09*/ "Resource failure.  Aborting operations.",
  /*10*/ "Unable to connect to logical database ~"&1~".",
  /*11*/ "  Reason for failure: ~&1~"",
  /*12*/ ?, /* see below */
  /*13*/ "Oracle User Password is required.",
  /*14*/ "Oracle connect parameters are required or ORACLE_SID must be set.",
  /*15*/ "Logical schema ~"&1~" is not in the schema holder database ~"&2~".",
  /*16*/ ?  /* see below */,
  /*17*/ ?,
  /*18*/ ?,
  /*19*/ ?,
  /*20*/ ?,
  /*21*/ ?,
  /*22*/ ?,
  /*23*/ "~nStarting Incremental dump at ~"&1~" ...",
  /*24*/ ?
]. 
new_lang[03] = "WARNING: Rename file ~"&1~" doesn~'t exist or is unreadable," +
               " ignoring.".
new_lang[05] = "WARNING: ~"&1~" is not valid codepage. " +
               "Using default value of ~"&2~" instead.".
new_lang[06] = "WARNING: ~"&1~" is not valid ~"index-mode~" identifier. " +
               "Using default value of ~"&2~" instead.".
new_lang[12] = "You can set a DataServer incremental dump to two logical databases in the same schema holder.  " +
               "Or, you can set one database to a logical database and the other to the PROGRESS schema in the " +
               "same schema holder database.  But you must select at least one database in which your schemas " +
               "can be found.".
new_lang[16] = "There is already a logical database ~"&1~" opened in another schema holder: ~"&2~".  " + 
               "Aborting operations: Logical database can only associated with one schema holder in a session.".

new_lang[18] = "Conflict with settings:  You must either set MSS environment variables or " +
               "ORA environment variables for incremental dump, not both.".
new_lang[19] = "First connected database ~"&1~" is being overridden by database selection ~"&2~" from " +
               "environment variables as the new, baseline definitions for the incremental dump.".
new_lang[20] = "Second connected database ~"&1~" is being overridden by database selection ~"&2~" from " +
               "environment variables as the old, comparative definitions for the incremental dump.".
new_lang[21] = "WARNING: Specified schema holder database ~"1~" did not have any non-PROGRESS logical databases.  " +
               "PROGRESS database schema will be used for the incremental dump.".
new_lang[22] = "Specified schema holder database ~"&1~" had more than one non-PROGRESS logical database.  " +
               "Your environement variables must select a logical database value when there are more than one in the specified schema holder.".
new_lang[24] = "Logical database ~"&1~" not found in specified schema holder ~"&2~".  " +
               "Use environement variables to set your databases explicitly.  Also ensure you are using the correct database names.".

/* LANGUAGE DEPENDENCIES END */ /*-------------------------------------------*/

/* function prototypes ****************************************************/
FUNCTION getEnvironment RETURNS CHARACTER (
  INPUT pcVariableName AS CHARACTER) FORWARD.

FUNCTION getEnvironmentInt RETURNS INTEGER (
  INPUT pcVariableName AS CHARACTER) FORWARD.

PROCEDURE setSilent:
    DEFINE INPUT PARAMETER setsilent AS LOGICAL NO-UNDO.
    ASSIGN setincrdmpSilent = setsilent.
END.

PROCEDURE setFileName:
    DEFINE INPUT PARAMETER inc_dffile AS CHARACTER NO-UNDO.
    ASSIGN df-file-name   =  inc_dffile.
END.

PROCEDURE setCodePage:
    DEFINE INPUT PARAMETER inc_codepage AS CHARACTER NO-UNDO.
    ASSIGN code-page   =  inc_codepage.
END.

PROCEDURE setIndexMode:
    DEFINE INPUT PARAMETER inc_indexmode AS CHARACTER NO-UNDO.
    ASSIGN index-mode   =  inc_indexmode.
END.

PROCEDURE setRenameFilename:
    DEFINE INPUT PARAMETER inc_renamefile AS CHARACTER NO-UNDO.
    ASSIGN rename-file   =  inc_renamefile.
END.

PROCEDURE setDebugMode:
    DEFINE INPUT PARAMETER inc_debug AS INTEGER NO-UNDO.
    ASSIGN debug-mode   =  inc_debug.
END.

Procedure doDumpIncr:

IF debug-mode GT 0 THEN
      OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.

IF NUM-DBS LT 2 THEN DO:
  IF user-dbtype1 = "PROGRESS" AND user-dbtype2 = "PROGRESS" THEN DO:
    IF debug-mode GT 0 THEN
      PUT STREAM err-log UNFORMATTED new_lang[02].
    IF LDBNAME(2) = ? THEN
        PUT STREAM err-log UNFORMATTED new_lang[08] SKIP.
    RETURN.
  END.
  ELSE DO:
    IF NUM-DBS LT 1 THEN DO:
      IF debug-mode GT 0 THEN
        PUT STREAM err-log UNFORMATTED new_lang[12].
      RETURN.
    END.
  END.
END.  /* NUM-DBS LT 2 */

/* test, if `rename-file' exists */
IF rename-file NE "":U THEN DO:
  ASSIGN FILE-INFO:FILE-NAME = rename-file.
  IF FILE-INFO:FILE-TYPE MATCHES "*R*":U THEN.  /* this deals with the ? */
  ELSE DO:
    IF debug-mode GT 0 THEN
      PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[03], rename-file) SKIP.
    ASSIGN rename-file = "":U.
  END.
END.

/* setting the default value for df file */
IF df-file-name EQ "":U THEN DO:
  ASSIGN df-file-name = "{&DEFAULT_DF}":U.
  IF debug-mode GT 0 THEN
    PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[04], "{&DEFAULT_DF}":U, "delta file":U) SKIP.
END.

/* codepage checking */
IF code-page NE "":U THEN DO:
  ASSIGN foo = CODEPAGE-CONVERT("x":U, SESSION:CPSTREAM, code-page) NO-ERROR.
  IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES GT 0 THEN DO:
    IF debug-mode GT 0 THEN
      PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[05], code-page, SESSION:CPSTREAM) SKIP.
    ASSIGN code-page = SESSION:CPSTREAM.
  END.  /* codepage error */
  ERROR-STATUS:ERROR = NO.
END.
ELSE DO:
  ASSIGN code-page = SESSION:CPSTREAM.
  IF debug-mode GT 0 THEN
    PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[04], code-page, "code page":U) SKIP.
END.  /* code-page EQ "":U */

/* index-mode checking */
IF index-mode NE "":U THEN DO:
  IF NOT CAN-DO("active,inactive":U, index-mode) THEN DO:
    IF debug-mode GT 0 THEN
      PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[06], index-mode, "{&DEFAULT_INDEX}":U) SKIP.
    ASSIGN index-mode = "{&DEFAULT_INDEX}":U.
  END.
END.
ELSE DO:
  ASSIGN index-mode = "{&DEFAULT_INDEX}":U.
  IF debug-mode GT 0 THEN
    PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[04], index-mode, "index mode":U) SKIP.
END.  /* index-mode EQ "":U */

/* user_env[19] will be changed BY _dmpincr.p */
ASSIGN user_env[19] = rename-file + ",":U + index-mode + ",":U + 
                      STRING(debug-mode) + ",":U + STRING(setincrdmpSilent)
       user_env[02] = df-file-name
       user_env[05] = code-page.

IF debug-mode GT 1 THEN DO:
  PUT STREAM err-log UNFORMATTED "DUMP_INC_DFFILE     = ":U df-file-name SKIP.
  PUT STREAM err-log UNFORMATTED "DUMP_INC_CODEPAGE   = ":U code-page SKIP.
  PUT STREAM err-log UNFORMATTED "DUMP_INC_INDEXMODE  = ":U index-mode SKIP.
  PUT STREAM err-log UNFORMATTED "DUMP_INC_RENAMEFILE = ":U rename-file SKIP.
  PUT STREAM err-log UNFORMATTED "DUMP_INC_DEBUG      = ":U debug-mode SKIP.

  IF user-dbtype1 <> "PROGRESS" THEN DO: 
    PUT STREAM err-log UNFORMATTED "SHDBNAME1           = ":U ds_shname1 SKIP.
    PUT STREAM err-log UNFORMATTED "MSSDBNAME1          = ":U ds_mssname1 SKIP.
    PUT STREAM err-log UNFORMATTED "ORADBNAME1          = ":U ds_oraname1 SKIP.
  END.
  IF user-dbtype2 <> "PROGRESS" THEN DO:
    PUT STREAM err-log UNFORMATTED "SHDBNAME2           = ":U ds_shname2 SKIP.
    PUT STREAM err-log UNFORMATTED "MSSDBNAME2          = ":U ds_mssname2 SKIP.
    PUT STREAM err-log UNFORMATTED "ORADBNAME2          = ":U ds_oraname2 SKIP.
  END.
END.  /* debug-mode GT 1 */

IF user-dbtype1 = "PROGRESS" THEN DO:
  /* Perform FIND on DICTDB dynamically to avoid compile errors that allow no feedback */
  CREATE BUFFER hBuf FOR TABLE "DICTDB._Db".
  IF VALID-HANDLE(hBuf) THEN DO:
    hBuf:FIND-FIRST('WHERE DICTDB._Db._Db-local = true', NO-LOCK) NO-ERROR.
    IF NOT hBuf:AVAILABLE OR ERROR-STATUS:ERROR THEN DO:
      IF debug-mode GT 0 THEN DO:
        PUT STREAM err-log UNFORMATTED new_lang[07] SKIP.
        IF ERROR-STATUS:ERROR THEN
          PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[11], ERROR-STATUS:GET-MESSAGE(1)).
      END.
      RETURN.
    END.
  END.
  ELSE DO:
    PUT STREAM err-log UNFORMATTED new_lang[09] SKIP.
    RETURN.
  END.

  ASSIGN drec_db = hBuf:RECID.
  s_DbType1 = user-dbtype1.
END.

IF  s_DbRecId = ? THEN DO:
    IF  NOT this-procedure:persistent THEN DO:
        DELETE ALIAS "DICTDB2":U.
        CREATE ALIAS "DICTDB2":U FOR DATABASE VALUE(LDBNAME(2)).
        s_DbType2 = "PROGRESS".
    END.
    ELSE DO : 
        s_DbType2 = "PROGRESS".
        s_DbType1 = "PROGRESS".
    END.
END.

IF drec_db EQ ? AND this-procedure:persistent THEN DO:
    FIND FIRST DICTDB._Db where DICTDB._db._db-local = true NO-LOCK.
    ASSIGN drec_db = RECID(DICTDB._Db).
END.

IF debug-mode GT 0 THEN DO:
  PUT STREAM err-log UNFORMATTED "" SKIP.
  OUTPUT STREAM err-log CLOSE.
END.

RUN prodict/dump/_dmpincr.p.

RETURN.
END. /* end of doDumpIncr */

/* mainline code **********************************************************/

IF NOT SESSION:BATCH-MODE THEN DO:
  if not THIS-PROCEDURE:persistent THEN 
    MESSAGE SUBSTITUTE(new_lang[01], "{0}":U) 
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN.
END. /* NOT SESSION:BATCH-MODE */

IF this-procedure:persistent THEN DO:
  IF debug-mode GT 0 THEN DO:
    OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
    PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[23], STRING(NOW)) SKIP(1).
  END.
END.
ELSE DO:

  ASSIGN debug-mode   = getEnvironmentInt("{&VAR_PREFIX}_DEBUG":U)
         rename-file  = getEnvironment("{&VAR_PREFIX}_RENAMEFILE":U)
         df-file-name = getEnvironment("{&VAR_PREFIX}_DFFILE":U)
         code-page    = getEnvironment("{&VAR_PREFIX}_CODEPAGE":U)
         index-mode   = getEnvironment("{&VAR_PREFIX}_INDEXMODE":U)
         ds_shname1   = getEnvironment("SHDBNAME1":U)
         ds_shname2   = getEnvironment("SHDBNAME2":U)
         ds_mssname1  = getEnvironment("MSSDBNAME1":U)
         ds_mssname2  = getEnvironment("MSSDBNAME2":U)
         ds_oraname1  = getEnvironment("ORADBNAME1":U)
         ds_oraname2  = getEnvironment("ORADBNAME2":U).

  IF debug-mode GT 0 THEN DO:
    OUTPUT STREAM err-log TO {&errFileName} APPEND NO-ECHO.
    PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[23], STRING(NOW)) SKIP(1).
  END.

  IF debug-mode GT 1 THEN DO:
    IF ds_shname1 <> "" THEN
      PUT STREAM err-log UNFORMATTED "~nSHDBNAME1           = ":U ds_shname1 SKIP.
    IF ds_mssname1 <> "" THEN
      PUT STREAM err-log UNFORMATTED "MSSDBNAME1          = ":U ds_mssname1 SKIP.
    IF ds_oraname1 <> "" THEN
      PUT STREAM err-log UNFORMATTED "ORADBNAME1          = ":U ds_oraname1 SKIP.
    IF ds_shname2 <> "" THEN
      PUT STREAM err-log UNFORMATTED "SHDBNAME2           = ":U ds_shname2 SKIP.
    IF ds_mssname2 <> "" THEN
      PUT STREAM err-log UNFORMATTED "MSSDBNAME2          = ":U ds_mssname2 SKIP.
    IF ds_oraname2 <> "" THEN
      PUT STREAM err-log UNFORMATTED "ORADBNAME2          = ":U ds_oraname2 SKIP.
  END.  /* debug-mode GT 1 */

  /* PROGRESS determines normal legacy execution from here on */
  ASSIGN user-dbtype1 = "PROGRESS"
         user-dbtype2 = "PROGRESS". 

  IF ds_mssname1 <> "" THEN 
    ASSIGN user-dbtype1 = "MSS"
             ds_dbname1 = ds_mssname1.

  IF ds_mssname2 <> "" THEN 
    ASSIGN user-dbtype2 = "MSS"
             ds_dbname2 = ds_mssname2.

  IF ds_oraname1 <> "" AND user-dbtype1 = "MSS" THEN DO:
    IF debug-mode GT 0 THEN
      PUT STREAM err-log UNFORMATTED new_lang[18] SKIP.
    RETURN.
  END.
  ELSE IF ds_oraname1 <> "" THEN 
    ASSIGN user-dbtype1 = "ORACLE"
             ds_dbname1 = ds_oraname1.

  /* Check for setting conflicts */
  IF ds_oraname2 <> "" AND user-dbtype2 = "MSS" THEN DO:
    IF debug-mode GT 0 THEN
      PUT STREAM err-log UNFORMATTED new_lang[18] SKIP.
    RETURN.
  END.
  ELSE IF ds_oraname2 <> "" THEN 
    ASSIGN user-dbtype2 = "ORACLE"
             ds_dbname2 = ds_oraname2.

  IF LDBNAME(1) <> ? THEN DO:
    IF ds_shname1 = "" THEN DO:
      IF ds_dbname1 <> "" OR CAPS(ds_dbname1) = CAPS("<none>") THEN 
        ds_shname1 = LDBNAME(1). /* For now, assume logical db is in connected sh */
    END.
    ELSE DO:
      IF ds_shname1 <> LDBNAME(1) THEN DO:
        sav_dictdb = LDBNAME(1).
        IF debug-mode GT 0 THEN 
          PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[19], LDBNAME(1), ds_shname1) SKIP.
      END.
    END. 
  END.
  ELSE IF user-dbtype1 = "PROGRESS" OR ds_shname1 = "" THEN DO:
    IF debug-mode GT 0 THEN 
      PUT STREAM err-log UNFORMATTED new_lang[07] SKIP.
    IF user-dbtype2 <> "PROGRESS" AND ds_shname1 <> "" THEN 
      rtconnect1 = yes. /* ok to not have LDBNAME(1) when one or more db's is foreign */
    ELSE 
      RETURN.
  END.
 
  IF ds_shname1 <> "" AND ds_dbname1 = "" THEN user-dbtype1 = "". /* Need to search for db type */

  IF LDBNAME(2) <> ? THEN DO:
    IF ds_shname2 = "" THEN DO:
      IF ds_dbname2 <> "" OR CAPS(ds_dbname2) = CAPS("<none>") THEN 
        ds_shname2 = LDBNAME(2). /* For now, assume logical db is in connected sh */
    END.
    ELSE DO:
      IF ds_shname2 <> LDBNAME(2) THEN DO:
           sav_dictdb2 = LDBNAME(2).
           IF debug-mode GT 0 THEN 
             PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[20], LDBNAME(2), ds_shname2) SKIP.
      END.
    END.
  END.
  ELSE IF user-dbtype2 = "PROGRESS" OR ds_shname2 = "" THEN DO:
    IF debug-mode GT 0 THEN 
      PUT STREAM err-log UNFORMATTED new_lang[08] SKIP.
    RETURN.
  END.
 
  IF ds_shname2 <> "" AND ds_dbname2 = "" THEN user-dbtype2 = "". /* Need to search for db type */

  /* Connect any unconnected schema holder databases */
  IF (user-dbtype1 <> "PROGRESS" OR rtconnect1) AND NOT CONNECTED(ds_shname1) THEN DO:
    CONNECT VALUE(ds_shname1) -1 NO-ERROR.

    IF ERROR-STATUS:ERROR AND NOT CONNECTED(ds_shname1) THEN DO:
      IF debug-mode GT 0 THEN DO:
        PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[10], ds_shname1) SKIP.
        PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[11], ERROR-STATUS:GET-MESSAGE(1)).
      END.
      RETURN.
    END.
    ELSE
      rtconnect1 = yes. /* Reuse run-time connect flag if LDBNAME(1) is successful */ 
  END.

  IF user-dbtype2 <> "PROGRESS" AND NOT CONNECTED(ds_shname2) THEN DO:
    CONNECT VALUE(ds_shname2) -1 NO-ERROR.

    IF ERROR-STATUS:ERROR AND NOT CONNECTED(ds_shname2) THEN DO:
      IF debug-mode GT 0 THEN DO:
        PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[10], ds_shname2) SKIP.
        PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[11], ERROR-STATUS:GET-MESSAGE(1)).
      END.
      RETURN.
    END.
  END.

  IF user-dbtype1 <> "PROGRESS" THEN DO:

    IF ds_shname1 <> LDBNAME(1) OR rtconnect1 THEN DO:
      DELETE ALIAS "DICTDB":U.
      CREATE ALIAS "DICTDB":U FOR DATABASE VALUE(ds_shname1).
    END.

    ASSIGN ds_alias = "DICTDB".

    RUN "prodict/misc/_valsch.p" (INPUT ds_alias            /* Dictionary Alias Name */,
                                  INPUT ds_shname1          /* Schema holder name */,
                                  INPUT-OUTPUT ds_dbname1   /* Logical database name */,
                                  INPUT-OUTPUT user-dbtype1 /* Logical database type */,
                                  OUTPUT shdb1-id           /* RECID of DICTDB */,
                                  OUTPUT dictdb-id          /* RECID of DICTDB logical db */,
                                  OUTPUT errcode            /* Error Code */).  
    
    IF errcode > 0 THEN DO:
      ASSIGN dictdb-id = ?.
      CASE errcode:
        WHEN 1 THEN DO: 
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[15], ds_dbname1, ds_shname1) SKIP.
        END.
        WHEN 2 THEN DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[16], ds_dbname1, SDBNAME(ds_dbname1)) SKIP.
        END.
        WHEN 3 THEN DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[22], ds_shname1) SKIP.
        END.
        WHEN 4 THEN DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[24], ds_dbname1, ds_shname1) SKIP.
        END.
      END CASE.
      RETURN.
    END.

    IF ds_dbname1 <> "" THEN DO:
      IF dictdb-id = ? THEN DO:
        IF CAPS(ds_dbname1) = CAPS("<none>") THEN DO:
          drec_db = shdb1-id.
          s_DbType1 = "PROGRESS".
        END. 
        ELSE DO:
          IF debug-mode GT 0 THEN 
            PUT STREAM err-log UNFORMATTED new_lang[17] SKIP.
          RETURN.
        END.
      END.
      ELSE DO:
        drec_db = dictdb-id.
        s_DbType1 = user-dbtype1.
      END.
    END.
    ELSE DO:
      PUT STREAM err-log UNFORMATTED new_lang[09] SKIP.
      RETURN.
    END.
  END.

  IF user-dbtype2 <> "PROGRESS" THEN DO:

    DELETE ALIAS "DICTDB2":U.
    CREATE ALIAS "DICTDB2":U FOR DATABASE VALUE(ds_shname2).

    ASSIGN ds_alias = "DICTDB2".

    RUN "prodict/misc/_valsch.p" (INPUT ds_alias            /* Dictionary Alias Name */,
                                  INPUT ds_shname2          /* Schema holder name */,
                                  INPUT-OUTPUT ds_dbname2   /* Logical database name */,
                                  INPUT-OUTPUT user-dbtype2 /* Logical database type */,
                                  OUTPUT shdb2-id           /* RECID of DICTDB2 */,
                                  OUTPUT dictdb2-id         /* RECID of DICTDB2 logical db */,
                                  OUTPUT errcode            /* Error Code */).  
    
    IF errcode > 0 THEN DO:
      ASSIGN dictdb2-id = ?.
      CASE errcode:
        WHEN 1 THEN DO: 
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[15], ds_dbname2, ds_shname2) SKIP.
        END.
        WHEN 2 THEN DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[16], ds_dbname2, SDBNAME(ds_dbname2)) SKIP.
        END.
        WHEN 3 THEN DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[22], ds_shname2) SKIP.
        END.
        WHEN 4 THEN DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED SUBSTITUTE(new_lang[24], ds_dbname2, ds_shname2) SKIP.
        END.
      END CASE.
      RETURN.
    END.

    s_DbRecId = ?. /* Borrow ADE dictionary variable not used by incremental dump */
    IF ds_dbname2 <> "" THEN DO:
      IF dictdb2-id = ? THEN DO:
        IF CAPS(ds_dbname2) = CAPS("<none>") THEN DO:
          s_DbRecId = shdb1-id.
          s_DbType2 = "PROGRESS".
        END.
        ELSE DO:
          IF debug-mode GT 0 THEN
            PUT STREAM err-log UNFORMATTED new_lang[17] SKIP.
          RETURN.
        END.
      END.
      ELSE DO:
        s_DbRecId = dictdb2-id.
        s_DbType2 = user-dbtype2.
      END.
    END.
    ELSE DO:
      PUT STREAM err-log UNFORMATTED new_lang[09] SKIP.
      RETURN.
    END.
  END.

  run doDumpIncr.

END.

/* functions **************************************************************/

FUNCTION getEnvironment RETURNS CHARACTER (INPUT pcVariableName AS CHARACTER).
  DEFINE VARIABLE cReturnValue AS CHARACTER NO-UNDO.
  ASSIGN cReturnValue = OS-GETENV(pcVariableName)
         cReturnValue = IF cReturnValue EQ ? THEN "":U
                        ELSE cReturnValue.
  RETURN cReturnValue.
END FUNCTION.  /* getEnvironment() */

FUNCTION getEnvironmentInt RETURNS INTEGER (INPUT pcVariableName AS CHARACTER).
  DEFINE VARIABLE iReturnValue AS INTEGER   NO-UNDO.
  DEFINE VARIABLE cValue       AS CHARACTER NO-UNDO.
  
  ASSIGN cValue       = getEnvironment(pcVariableName)
         iReturnValue = INTEGER(cValue) NO-ERROR.

  ERROR-STATUS:ERROR = NO.

  RETURN iReturnValue.
END FUNCTION.  /* getEnvironmentInt() */

/* prodict/dump_inc.p */
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/


/**************************************************************************
    Procedure:  _fhidden.i

    Purpose:    Defines a 'static' variable which determines whether or
                not hidden tables are shown in the DD or Admin tool. The
                DD/Admin reports will use this value when they run.
                
    Syntax :    {prodict/_fhidden.i}

    Parameters: None

    Description:
    Notes  :
    Authors: Gerry Seidl
    Date   : 05/31/95
**************************************************************************/

DEFINE NEW GLOBAL SHARED VARIABLE fhidden AS LOGICAL NO-UNDO INITIAL NO.
/***********************************************************************
* Copyright (C) 2007-2012 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions          *
* contributed by participants of Possenet.                             *
*                                                                      *
***********************************************************************/


/* file-name may be either a specific file or ALL */
/* 
File:   prodict/load_d.p

IN:
    file-name                : "ALL" or "<file-name>"
    dot-d-dir                : directory relativ to working-directory
    
History
    mcmann     10/17/03 Add NO-LOCK statement to _Db find in support of on-line schema add
    mcmann     07/13/01 Added check for environmental variable DSTYPE
    mcmann     98/07/13 Added _Owner check for V9
    laurief     97/12   Removed RMS,CISAM code
    hutegger    95/06   multi-db support
    kmcintos   10/19/05 Added error handling for not connected dbs and 
                        unavailable tables.  Also fixed dump-name logic to
                        use _file-name when blank and generally made the
                        procedure more readable 20050930-008. 
    fernando   03/16/06 Handle case with too many tables selected - bug 20050930-006.    
    fernando   02/27/07 Support for long dump name - OE00146586
    fernando   12/12/07 Don't need to set user_env[5] anymore
    
Multi-DB-Support:
    the syntax of file-name is:
           [ <DB>. ] <tbl>             [ <DB>. ] <tbl>
        {  ---------------  }  [ , {  ---------------  } ] ...
             <DB>."ALL"                  <DB>."ALL"
    {   -----------------------------------------------------------  }
                        "ALL"
Example:

This is an example on how to call this proc persistently to set the
newly added options:

DEF VAR h AS HANDLE NO-UNDO.
RUN prodict/load_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir).
RUN setLobDir IN h (input cLob-Dir). /* this is optional */ 
RUN doLoad IN h.
DELETE PROCEDURE h.

super-tenant rules.
Setting set-effective-tenant before calling this will cause tenant data
to be dumped in the (dot-d-dir) standard directory or file-name 

This is an example on how to call this proc persistently to have more control
over multi-tenant options:

    
--- default location - create subdirs if necessary  --
RUN prodict/load_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir).
RUN setEffectiveTenant IN h (gtenant). 
RUN doLoad IN h.
DELETE PROCEDURE h.

shared data will be loaded from            dot-d-dir
effective tenant data will be loaded from  dot-d-dir + "/" + gtenant
shared lobs will be loaded from            dot-d-dir + "/lobs"
effective tenant lobs will be loaded from  dot-d-dir+ "/" + gtenant + "/lobs"

--- default location no-lobs - create subdirs if necessary  --
RUN prodict/load_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir).
RUN setEffectiveTenant IN h (gtenant). 
RUN setNoLobs IN h (true). 
RUN doLoad IN h.
DELETE PROCEDURE h.

shared data will be loaded from           dot-d-dir
effective tenant data will be loaded from dot-d-dir + "/" + gtenant

--- specify location  ---
RUN prodict/load_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir).
RUN setUseDefaultLocation IN h (false). 
RUN setEffectiveTenant IN h (gtenant). 
RUN setTenantDir IN h (gtenantdir). 
RUN setLobDir IN h (globdir). 
RUN setTenantLobDir IN h (gtenantlobdir). 

RUN doLoad IN h.
DELETE PROCEDURE h.

shared data will be loaded from            dot-d-dir
effective tenant data will be loaded from gtenantdir
shared lobs will be loaded from            globdir
effective tenant lobs will be loaded from gtenantlobdir

--- all data in current directory  don't use default  ---
RUN prodict/load_d.p PERSISTENT SET h 
    (INPUT file-name, INPUT dot-d-dir).
RUN setEffectiveTenant IN h (gtenant). 
RUN setUseDefaultLocation IN h (false). 
RUN doLoad IN h.
DELETE PROCEDURE h.

all data will be loaded from dot-d-dir
--
Multi-tenant Summary:     
Use setEffectiveTenant :
1. Use default location = true (this is default)  
The following subdirectories will be 
used (assuming default Use default location = true):
 - Tenant data will be loaded from subdirs named after tenant 
 - Group data will be loaded from subdir setGroupDirName (default = "groups") 
   with subdirs named after group. 
 - Lobs will be loaded from subdir setLobDirName (default = "lobs") under the root, 
   tenants and groups directories.
2. Set UseDefaultLocation = false  
Loads data from setTenantDir, setLobDir, SetGroupDir and setTenantLobDir. 
Group data will be loaded from setGroupDir with subdirs named after group. 

Not using setEffectiveTenant:
Gives transparent behavior for regular tenants with all data loaded from specified 
work and lob directories with no directory separation of tenant and group data 
just as if the database is non multi-tenant.     
***************************************************************************************/

using OpenEdge.DataAdmin.Binding.ITableDataMonitor from propath .

DEFINE INPUT PARAMETER file-name AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER dot-d-dir AS CHARACTER NO-UNDO.

{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i NEW }
 
DEFINE VARIABLE isCpUndefined AS LOGICAL NO-UNDO.

DEFINE VARIABLE gLobDir         AS CHARACTER NO-UNDO.
DEFINE VARIABLE gLobDirName     AS CHARACTER NO-UNDO init "lobs":U.
DEFINE VARIABLE gTenantDir      AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenantLobDir   AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenant         AS CHARACTER NO-UNDO.
define variable gNoLobs         as logical   no-undo.
define variable gUseDefault     as logical   no-undo init ?.
define variable gGroupDir       as CHARACTER no-undo.
DEFINE VARIABLE gSilent         AS LOGICAL   NO-UNDO.
DEFINE VARIABLE gErrorPercent   AS  int      NO-UNDO.
DEFINE VARIABLE gExternalTenant AS char      NO-UNDO.
define variable ghTempTable     as handle    no-undo.
define variable gGroupDirName   as CHARACTER no-undo init "groups":U.
define variable gUseDefaultOut   as character no-undo init "<default>".
define variable gMonitor         as ITableDataMonitor no-undo.

DEFINE TEMP-TABLE ttb_dump
        FIELD db        AS CHARACTER
        FIELD tbl       AS CHARACTER
        INDEX upi IS PRIMARY UNIQUE db tbl.
        

/*---------------------------  MAIN-CODE  --------------------------*/
/* if not running persistenty, go ahead and dump the definitions */
IF SESSION:CPINTERNAL EQ "undefined":U THEN
    isCpUndefined = YES.
    
IF NOT THIS-PROCEDURE:PERSISTENT THEN
   RUN doLoad.

/*--------------------------- INTERNAL PROCS  --------------------------*/

PROCEDURE doLoad:
    
    define variable GroupCount as integer no-undo.
    define variable lFound as logical no-undo.
    define variable iMtcount         as integer no-undo.
    define variable hQ as handle no-undo.
    define variable hBuffer as handle no-undo.
  
    /* for the single table variation */
    define variable l_Dump-name as character no-undo.
    define variable l_Mt        as logical  no-undo.
          
    DEFINE VARIABLE i           AS INTEGER   NO-UNDO.
    DEFINE VARIABLE l_db-name   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_for-type  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_int       AS INTEGER   NO-UNDO.
    DEFINE VARIABLE l_item      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE l_list      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE save_ab     AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE all_shared  AS LOGICAL   NO-UNDO INITIAL FALSE.
    DEFINE VARIABLE all_multitenant  AS LOGICAL   NO-UNDO INITIAL FALSE.
    define variable cSlash         as character no-undo.    
    
    EMPTY TEMP-TABLE ttb_dump NO-ERROR.
     
    /* as of current just let the ABL  deal with error */
    if gtenant > "" then
        set-effective-tenant(gtenant,"dictdb"). 
    
    IF SESSION:CPINTERNAL EQ "undefined":U THEN
        isCpUndefined = YES.
        
    if file-name = "<shared>" then 
      do: 
        assign all_shared = true
               file-name = "ALL".
    end.
    else if file-name = "<tenant>" then 
     do:
        assign all_multitenant = true
               file-name = "ALL".    
    end.
             
    ASSIGN save_ab                   = SESSION:APPL-ALERT-BOXES
           SESSION:APPL-ALERT-BOXES  = NO
           user_env[3]               = "" /* "MAP <name>" or "NO-MAP" OR "" */
           user_env[4]               = (if gErrorPercent > 0 then string(gErrorPercent) else "0")
           user_env[6]               = "f"  /* log errors to file by default */
           dot-d-dir                 = (IF dot-d-dir MATCHES "*" + "/"   OR 
                                           dot-d-dir MATCHES "*" + ".d"  OR 
                                           dot-d-dir MATCHES "*" + ".ad" OR
                                           dot-d-dir    =    "" THEN  
                                          dot-d-dir ELSE dot-d-dir + "/").
    if gSilent then assign user_env[6] = "load-silent".
    
    /* This allows the bulk load utility of a dataserver to be run */
    IF OS-GETENV("DSTYPE")   <> ? THEN
      user_env[35]  = OS-GETENV("DSTYPE").
    /****** 1. step: create temp-table from input file-list ***********/
    if not valid-handle(ghTempTable) then
    do:   
      IF file-name = "ALL" THEN DO:  /* load ALL files of ALL dbs */
        FOR EACH DICTDB._DB NO-LOCK:
          CREATE ttb_dump.
          ASSIGN ttb_dump.db  = (IF DICTDB._DB._DB-Type = "PROGRESS" THEN 
                                   LDBNAME("DICTDB") ELSE DICTDB._DB._Db-name)
                 ttb_dump.tbl = "ALL".
        END.  
        assign file-name = "ALL".  
      END.     /* load ALL fiels of ALL dbs */
      ELSE DO:  /* load SOME files of SOME dbs */
     
        ASSIGN l_list = file-name.
        REPEAT i = 1 TO NUM-ENTRIES(l_list):
          CREATE ttb_dump.
          ASSIGN l_item = ENTRY(i,l_list)
                 l_int  = INDEX(l_item,".").
          IF l_int = 0 THEN  
            ASSIGN ttb_dump.db  = ""
                   ttb_dump.tbl = l_item.
          ELSE 
            ASSIGN ttb_dump.db  = SUBSTRING(l_item,1,l_int - 1,"character")
                   ttb_dump.tbl = SUBSTRING(l_item,l_int + 1, -1,"character").
    
          IF ttb_dump.db > '' AND
             NOT CONNECTED(ttb_dump.db) THEN 
             MESSAGE "Database " + ttb_dump.db + " not connected!".
        END.
      END.     /* dump SOME files of SOME dbs */
   end.  
    
    /****** 2. step: prepare user_longchar for this _db-record **********/
      
    FOR EACH DICTDB._Db NO-LOCK:
    
      ASSIGN l_db-name   = (IF DICTDB._DB._DB-Type = "PROGRESS" THEN 
                              LDBNAME("DICTDB") ELSE _DB._DB-name)
             user_env[1] = ""
             user_longchar = (IF isCpUndefined THEN user_longchar ELSE "")
             l_for-type  = (IF CAN-DO("PROGRESS",DICTDB._DB._DB-Type) THEN 
                              ? ELSE "TABLE,VIEW").
                              
     if not valid-handle(ghTempTable) then
     do:                         
      /* to generate the list of tables of this _db-record to be loaded and
       * assign it to user_longchar we
       * a) try to use all tables WITHOUT db-specifyer
       */
        FOR EACH ttb_dump WHERE ttb_dump.db = "" 
                          WHILE user_env[1] <> ",all":
          IF ttb_dump.tbl <> "all" THEN DO: 
            IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
                      find DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                                 AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                                                 no-lock no-error.
                  ELSE
                      find DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                                 no-lock no-error.                           
                  if available DICTDB._File and ( can-do(l_for-type,DICTDB._File._For-type) or l_for-type = ? ) then 
                  do:
                      /* these two vars are only for the single table variation */
                      assign
                         l_dump-name = (IF DICTDB._File._dump-name <> ? 
                                        THEN DICTDB._File._dump-name 
                                         ELSE LC(DICTDB._File._file-name))
                         l_mt        =   dictdb._File._file-attributes[1].
                      IF isCpUndefined THEN
                          assign user_env[1] = user_env[1] + "," + ttb_dump.tbl.
                      ELSE
                          assign user_longchar = user_longchar + "," + ttb_dump.tbl.
                      if DICTDB._File._file-attributes[1] then
                         iMtCount = iMtCount + 1.
                  END.
              end.
              else 
                  assign user_env[1] = ",all".
          end.
        
          /* b) try to use all tables WITH db-specifyer */
          for each ttb_dump where ttb_dump.db = l_db-name 
          while user_env[1] <> ",all":
              if ttb_dump.tbl <> "all" then 
              do:
                  IF INTEGER(DBVERSION("DICTDB")) > 8 THEN     
                      find DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                               AND (DICTDB._File._Owner = "PUB" OR DICTDB._File._Owner = "_FOREIGN")
                                               no-lock no-error.
                  ELSE
                      find DICTDB._File of DICTDB._Db where DICTDB._File._File-name = ttb_dump.tbl
                                               no-lock no-error.                            
                  if available DICTDB._File
                  and ( can-do(l_for-type,DICTDB._File._For-type)
                  or    l_for-type = ? ) then 
                  do:
                      /* these two vars are only for the single table variation */
                      assign
                         l_dump-name = (IF DICTDB._File._dump-name <> ? 
                                        THEN DICTDB._File._dump-name 
                                         ELSE LC(DICTDB._File._file-name))
                         l_mt        =   dictdb._File._file-attributes[1].
           
                     IF isCpUndefined THEN
                         assign user_env[1] = user_env[1] + "," + ttb_dump.tbl.
                     ELSE
                         assign user_longchar = user_longchar + "," + ttb_dump.tbl.
                     if DICTDB._File._file-attributes[1] then
                         iMtCount = iMtCount + 1.
                  END.
              end.
              else 
                 assign user_env[1] = ",all".
          end.
            
          /* c) if either "all" or "all of this db" then we take every file
           *    of the current _Db
          */
        
          IF user_env[1]  = ",all" then 
          do:  /* all files of this _Db */
    
              assign user_env[1] = "".
              IF NOT isCpUndefined THEN
                  assign user_longchar = "".
            
              /** this for each and the NEXT is duplicated in GetTableList in TableDataCommand */ 
                 
              for each DICTDB._File WHERE DICTDB._File._File-number > 0
                                    AND   DICTDB._File._Db-recid = RECID(_Db)
                                    AND   (if all_multitenant  then _file-attributes[1] = true 
                                           else if all_shared then _file-attributes[1] <> true
                                           else true)
                                     AND   NOT DICTDB._File._Hidden
              BY DICTDB._File._File-name:
                  
                  IF INTEGER(DBVERSION("DICTDB")) > 8 
                  AND DICTDB._File._Tbl-Type <> "V"     
                  AND (DICTDB._File._Owner <> "PUB" AND DICTDB._File._Owner <> "_FOREIGN") THEN 
                      NEXT.
                      
                  if l_for-type = ?
                  or can-do(l_for-type,DICTDB._File._For-type) then 
                  do:
                      /* these two vars are only for the single table variation */
                      assign
                         l_dump-name = (IF DICTDB._File._dump-name <> ? 
                                        THEN DICTDB._File._dump-name 
                                         ELSE LC(DICTDB._File._file-name))
                         l_mt        =   dictdb._File._file-attributes[1].
           
                      IF isCpUndefined THEN
                         assign user_env[1] = user_env[1] + "," + DICTDB._File._File-name.
                      ELSE
                         assign user_longchar = user_longchar + "," + DICTDB._File._File-name.
                      
                      if DICTDB._File._file-attributes[1] then
                         iMtCount = iMtCount + 1.
                  end.
              end. /* for each _file */ 
             
              IF isCpUndefined THEN
                  assign user_env[1] = substring(user_env[1],2,-1,"character").
              ELSE
                  assign user_longchar = substring(user_longchar,2,-1,"character").
          end.     /* all files of this _Db */
          
          else do:
               IF isCpUndefined THEN
                  user_env[1] = substring(user_env[1],2,-1,"character").
               else
                  user_longchar = substring(user_longchar,2,-1,"character").
          END.
      end. /* not valid ghTempTable */
      else do:
          create query hq.
          hBuffer = ghTempTable:default-buffer-handle.
          hq:add-buffer(hBuffer).
          hq:query-prepare("for each " + ghTempTable:name
                           + " where " + ghTempTable:name + ".databasename = " + quoter(l_db-name)
                           + " by " + ghTempTable:name + ".name ").
          hq:query-open().
          hq:get-first ().
          
          do while hBuffer:avail:              
              IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
                  FIND DICTDB._File OF DICTDB._Db 
                       WHERE DICTDB._File._File-name = hBuffer::name AND 
                        (DICTDB._File._Owner = "PUB" OR 
                         DICTDB._File._Owner = "_FOREIGN") NO-LOCK NO-ERROR.
              ELSE
                  FIND DICTDB._File OF DICTDB._Db 
                      WHERE DICTDB._File._File-name = hBuffer::name NO-LOCK NO-ERROR. 
     
              IF AVAILABLE DICTDB._File THEN 
              DO: 
                  IF CAN-DO(l_for-type,DICTDB._File._For-type) 
                  OR l_for-type = ? THEN 
                  DO:
              
                      l_dump-name = (IF DICTDB._File._dump-name <> ? 
                                     THEN DICTDB._File._dump-name 
                                     ELSE LC(DICTDB._File._file-name)).
                      IF isCpUndefined THEN
                          user_env[1] = user_env[1] 
                                      + (if user_env[1] = "" then "" else ",") 
                                      + hBuffer::name .
                      ELSE
                          user_longchar = user_longchar 
                                        +  (if user_longchar = "" then "" else ",") 
                                        + hBuffer::name.
          
                      if DICTDB._File._file-attributes[1] then
                           iMtCount = iMtCount + 1.
                  END.    
              END.
              hq:get-next.
          end.
          delete object Hq.
      end.  
    
       /* is there something to load into this _db? */
      if NOT isCpUndefined AND user_longchar = "" then next.
      if     isCpUndefined AND user_env[1] = ""   then next.
    
      /****** 3. step: prepare user_env[2] and user_env[5] **************/
      /* if one file =>  .d-name otherwise path
         always do this if temp-table is used 
         load_d checks if user_env[2] ends with "/"
         to add filename also for the single table case 
         when the temp-tablee is used   */ 
      IF  NUM-ENTRIES((IF isCpUndefined THEN user_env[1] ELSE user_longchar)) > 1 
      OR  valid-handle(ghTempTable) 
      OR  dot-d-dir MATCHES "*" + ".d" OR
          dot-d-dir MATCHES "*" + ".ad" THEN 
          ASSIGN user_env[2] = dot-d-dir.  /* just path or .d-file-name */
      ELSE  /* full path and name of .d-file */
          ASSIGN user_env[2] = dot-d-dir + 
                             (IF l_Dump-name = ? THEN 
                                          STRING((IF isCpUndefined THEN user_env[1] ELSE user_longchar)) ELSE l_Dump-name) +
                             (IF l_Dump-name BEGINS "_aud" THEN 
                                ".ad" ELSE ".d"). 
      /* Indicate "y"es to disable triggers for dump of all files */
      /* Now we don't have do this. A blank string will indicate disable triggers
         for all files.
      */
      /*
      ASSIGN user_env[5] = "y".
      DO i = 2 TO NUM-ENTRIES((IF isCpUndefined THEN user_env[1] ELSE user_longchar)):
        ASSIGN user_env[5] = user_env[5] + ",y".
      END.
      */
    
      /* other needed assignments */
      ASSIGN drec_db     = RECID(_Db)
             user_dbname = (IF _Db._Db-name = ? THEN 
                              LDBNAME("DICTDB") ELSE _Db._Db-Name)
             user_dbtype = (IF _Db._Db-name = ? THEN 
                              DBTYPE("DICTDB") ELSE _Db._Db-Type).
    
    /****** 4. step: the actual loading-process ***********************/
    
      IF NOT isCpUndefined THEN DO:
          /* see if we can put user_longchar into user_env[1] */
          ASSIGN user_env[1] = user_longchar NO-ERROR.
          IF NOT ERROR-STATUS:ERROR THEN
             /* ok to use user_env[1] */
             ASSIGN user_longchar = "". 
          ELSE
             ASSIGN user_env[1] = "".
      END.
      assign
         user_env[30] = "" 
         user_env[33] = ""
         /* lobdirname is set if use default */
         user_env[40] = "".
      
      if gTenant <> "" then 
      do:
          assign
              user_env[32] = gTenant
              user_env[34] = "" 
              user_env[37] = "".
          
          if gUseDefault then 
          do:         
              user_env[33] = gUseDefaultOut.
              if gNoLobs = false then 
                  user_env[40] = gLobDirName.     
               /* defaults to groups - can be set to blank to 
                  avoid group load*/
              if gGroupDirName > "" then   
                   user_env[37] = gGroupDirName.
          end.
          else do:
             user_env[33] = gTenantDir.
              if gNoLobs = false then 
              do:
                  assign
                      user_env[30] = gLobDir
                      user_env[34] = gTenantLobDir. 
              end. 
              if gGroupDir > "" then   
                  user_env[37] = gGroupDir.  
          end.
      end.
      else do:
          if gUseDefault then
          do: 
              user_env[33] = gUseDefaultOut.
              if gNoLobs = false then 
                  user_env[40] = gLobDirName.
          end.
          else if gNoLobs = false then 
              user_env[30] = gLobDir. 
      end. 
      if valid-object(gMonitor) then
          dictMonitor = gMonitor. 
      RUN "prodict/dump/_loddata.p".
      catch e as Progress.Lang.Error :
          if gSilent then
              undo, throw e.
          else 
              run showError(e).       
      end catch.
    
    END.    /* for each  _Db's */
    
    RETURN.
    catch e as Progress.Lang.Error :
         if gSilent then
              undo, throw e.
         else 
             run showError(e).     
    end catch.
    
    finally:
        /* clean up tenant and globals - keep properties */
        assign
            dictMonitor = ?
            user_env = ""           
            SESSION:APPL-ALERT-BOXES = save_ab.
        if gExternalTenant > "" then
            set-effective-tenant(gExternalTenant,"dictdb").         
    end finally.      
END. /* doLoad*/

procedure showError:
   define input  parameter pError as Progress.Lang.Error no-undo.
   define variable i as integer no-undo.
   do i = 1 to pError:NumMessages:
       message pError:GetMessage(i)
         view-as alert-box error.      
   end.        
end.    

PROCEDURE setFileName:
    DEFINE INPUT PARAMETER pfile-name AS CHAR NO-UNDO.
    ASSIGN file-name = pfile-name.
    ghTempTable = ?.
END.

PROCEDURE setDirectory:
    DEFINE INPUT PARAMETER pdot-d-dir AS CHAR NO-UNDO.
    ASSIGN dot-d-dir = pdot-d-dir.
END.

PROCEDURE setNoLobs:
    DEFINE INPUT PARAMETER pNoLobs AS logical NO-UNDO.
    ASSIGN gNoLobs = pNoLobs.
END.

PROCEDURE setLobDir:
    DEFINE INPUT PARAMETER pcLob-Dir AS CHAR NO-UNDO.
    ASSIGN gLobDir = pcLob-Dir.
END.

PROCEDURE setLobDirName:
    DEFINE INPUT PARAMETER pcLobName AS CHAR NO-UNDO.
    ASSIGN gLobDirName = pcLobName.
END.

PROCEDURE setUseDefaultLocation:
    DEFINE INPUT PARAMETER pldefault AS logical NO-UNDO.
    ASSIGN gUseDefault = pldefault.
END.

PROCEDURE setEffectiveTenant:
    DEFINE INPUT PARAMETER pcTenant AS CHAR NO-UNDO.
    if gExternalTenant = "" then
        gExternalTenant = get-effective-tenant-name("dictdb").
  
    gTenant = pctenant.
    if gUseDefault = ? then 
       gUseDefault = true.
END.

PROCEDURE setGroupDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    gGroupDir = pcDir.
END.

PROCEDURE setGroupDirName:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    gGroupDirName = pcDir.
END.

PROCEDURE setTenantDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    ASSIGN gTenantDir = pcDir.
END.

PROCEDURE setTenantLobDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    ASSIGN gTenantLobDir = pcDir.
END.

PROCEDURE SetSilent:
    DEFINE INPUT PARAMETER setsilent AS LOGICAL NO-UNDO.
    ASSIGN gSilent = setsilent.
END.

PROCEDURE SetAcceptableErrorPercentage:
    DEFINE INPUT PARAMETER errpercent AS INTEGER NO-UNDO.
    ASSIGN gErrorPercent = errpercent.
END.
 
/** set a temptable handle with lsit of tables to load.
    the table must have databasename with logical name (currently only used with ldbname("dictdb"))
    and a name field with the table name */ 
PROCEDURE SetTable:
    DEFINE INPUT PARAMETER table-handle h.
    ASSIGN ghTempTable = h.
END.

/** set the monitor for status log */
PROCEDURE SetMonitor:
    DEFINE INPUT PARAMETER pmon as ITableDataMonitor.
    ASSIGN gMonitor = pmon.
END.

/*********************************************************************
* Copyright (C) 2007-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: prodict/load_df.p

    End-user entry point for Admin Tool's "Load .df file" utility
      
Input Parameters:
    df-file-name    The name of the .df file to be loaded into DICTDB
    
Output Parameters:
    none
    
Used/Modified Shared Objects:
 
    
History:
    moved to prodict/dump/_load_df.p See 
----------------------------------------------------------------------------*/
 
/*==========================  DEFINITIONS ===========================*/

DEFINE INPUT PARAMETER df-file-name AS CHARACTER NO-UNDO.
define variable dictOptions as OpenEdge.DataAdmin.Binding.IDataDefinitionOptions no-undo.
 
/* If user wants to commit even if there are errors in the df, they can
   pass in a string composed of "df-file-name,yes"  If user_env[15] is
   set to yes, the _lodsddl.p will handle for committing with errors.
   
   If user wants to load new tables and sequences on-line than df-file-name
   must have three entries, "df-file-name,<commit>,<session parameter>".  
   example:  Commit with errors and loading on-line = "sports,df,yes,NEW OBJECTS" 
             Do not commit with errors and loading on line = "sports.df,,NEW OBJECTS"
             Just passing in file name "sports.df".
*/   

 
dictOptions = new prodict.dump._load_options().

IF NUM-ENTRIES(df-file-name) = 3 THEN
    ASSIGN dictOptions:FileName = ENTRY(1,df-file-name)
           dictOptions:ForceCommit = ENTRY(2,df-file-name) =  "yes"
           dictOptions:SchemaChange = ENTRY(3,df-file-name).
ELSE 
IF NUM-ENTRIES(df-file-name) = 2 THEN
    ASSIGN dictOptions:FileName = ENTRY(1,df-file-name)
           dictOptions:ForceCommit = ENTRY(2,df-file-name) =  "yes".
ELSE
   ASSIGN dictOptions:FileName = df-file-name.

run prodict/dump/_load_df.p(dictOptions). 
finally:
    delete object dictOptions.
end. /**********************************************************************
* Copyright (C) 2000,2006-2007 by Progress Software Corporation. All rights*
* reserved.  Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                            *
*                                                                     *
**********************************************************************/

/* load_seq.p - load _Sequence file from _Seqvals.d and set w/ CURRENT-VALUE

   History: Mario B  01/27/99  Created
            D. McMann 08/08/02 Eliminated any sequences whose name begins "$" - Peer Direct
            fernando  09/21/06 Eliminated use of user_env from generated pcode - 20060921-032
            fernando  07/23/07 Support for 64-bit sequences
   
*/

&SCOPED-DEFINE ErrFile load_seq.e

{ prodict/dictvar.i NEW}
{ prodict/user/uservar.i NEW}

DEFINE NEW SHARED STREAM s_err.

DEFINE INPUT PARAMETER file-name AS CHARACTER NO-UNDO.
DEFINE INPUT PARAMETER dot-d-dir AS CHARACTER NO-UNDO.

DEFINE VARIABLE cerror    AS CHARACTER           NO-UNDO.
DEFINE VARIABLE codepage  AS CHARACTER           NO-UNDO init "UNDEFINED".
DEFINE VARIABLE i         AS INTEGER             NO-UNDO.
DEFINE VARIABLE lvar      AS CHARACTER EXTENT 10 NO-UNDO.
DEFINE VARIABLE lvar#     AS INTEGER             NO-UNDO.
DEFINE VARIABLE tmpfile   AS CHARACTER           NO-UNDO.
DEFINE VARIABLE err-file  AS CHARACTER           NO-UNDO.

FIND DICTDB._Db NO-LOCK NO-ERROR.
IF INTEGER(DBVERSION("DICTDB")) > 8 THEN
FIND FIRST DICTDB._File OF DICTDB._Db WHERE
   DICTDB._File._Db-recid     = RECID(DICTDB._Db) AND
   DICTDB._File._Owner = "PUB" OR
   DICTDB._File._Owner = "_FOREIGN"
NO-LOCK NO-ERROR.
ELSE 
FIND FIRST DICTDB._File of DICTDB._Db WHERE
     DICTDB._File._Db-recid = RECID(DICTDB._Db)
NO-LOCK NO-ERROR.

ASSIGN 
  dot-d-dir                 = ( if dot-d-dir matches "*" + "/"
                                or dot-d-dir matches "*" + ".d"
                                or dot-d-dir    =    ""
                                then dot-d-dir 
                                else dot-d-dir + "/"
                              )
 
  drec_db     = RECID(_Db)
  user_dbname = if _Db._Db-name = ? THEN LDBNAME("DICTDB")
                                    ELSE _Db._Db-Name
  user_dbtype = if _Db._Db-name = ? THEN DBTYPE("DICTDB")
                                    ELSE _Db._Db-Type
  err-file    = IF file-name matches "*.d" THEN
                   substring(file-name, 1, r-index(file-name, ".d")) + "e"
		ELSE
		   "{&ErrFile}".
		      
/* This effectively tests for the existence of the directory, creates it if  *
 * it doesn't exist, aborts if it can't create it.                           */
OS-CREATE-DIR VALUE(dot-d-dir). 
IF OS-ERROR <> 0 THEN
DO:
   PUT UNFORMATTED "Input directory " + dot-d-dir + " doesn't exist." SKIP.
   RETURN ERROR.
END.

/* Get rid of any previous error files if they exist */
OS-DELETE VALUE(dot-d-dir + err-file).

/* Test for existence of file */
IF SEARCH(dot-d-dir + file-name) = ? THEN
DO:
  OUTPUT STREAM s_err TO VALUE(dot-d-dir + err-file).
  PUT STREAM s_err UNFORMATTED "File " + file-name + " doesn't exist." SKIP.
  OUTPUT STREAM s_err CLOSE.
  RETURN ERROR. 
END.

user_env[2] = dot-d-dir + file-name. 
RUN "adecomm/_tmpfile.p" (INPUT "", INPUT ".adm", OUTPUT tmpfile).
OUTPUT TO VALUE(tmpfile) NO-MAP NO-ECHO NO-MAP.

PUT UNFORMATTED
  'DEFINE INPUT PARAMETER fName     AS CHARACTER.' SKIP
  'DEFINE INPUT PARAMETER dot-d-dir AS CHARACTER.' SKIP
  'DEFINE INPUT PARAMETER errorFile AS CHARACTER.' SKIP
  'DEFINE SHARED STREAM s_err.' SKIP
  'DEFINE VARIABLE seqname   AS CHARACTER NO-UNDO.' SKIP
  'DEFINE VARIABLE seqnumber AS CHARACTER NO-UNDO.' SKIP
  'DEFINE VARIABLE seqvalue  AS INT64     NO-UNDO.' SKIP
  'REPEAT:' SKIP
  '  IMPORT seqnumber seqname seqvalue NO-ERROR.' SKIP
  '  IF ERROR-STATUS:ERROR THEN DO:' SKIP
  '     OUTPUT STREAM s_err TO VALUE(dot-d-dir + "/" + errorFile) APPEND.' SKIP 
  '     PUT STREAM s_err UNFORMATTED "Error loading value for " seqname ": "' SKIP
  '         ERROR-STATUS:GET-MESSAGE(1) SKIP.' SKIP
  '     OUTPUT STREAM s_err CLOSE.' SKIP
  '  END.' SKIP
  '  IF INDEX(seqname,".") = 0 THEN seqname = "' LDBNAME(user_dbname)
    '." + seqname.' SKIP
  '  CASE seqname:' SKIP.
FOR EACH _Sequence WHERE _Sequence._Db-recid = drec_db 
                     AND NOT _Sequence._Seq-name BEGINS "$" NO-LOCK:
  PUT UNFORMATTED 
    '    WHEN "' LDBNAME(user_dbname) '.' _Sequence._Seq-Name '" THEN DO:' SKIP
    '      CURRENT-VALUE(' _Sequence._Seq-Name ',' LDBNAME(user_dbname)
      ') = seqvalue NO-ERROR.' SKIP
      '     IF ERROR-STATUS:ERROR OR ERROR-STATUS:NUM-MESSAGES > 1 THEN DO:' SKIP
      '       OUTPUT STREAM s_err TO VALUE(dot-d-dir + "/" + errorFile) APPEND.' SKIP 
      '       PUT STREAM s_err UNFORMATTED "Error loading value for ' _Sequence._Seq-Name ': "' SKIP
      '         ERROR-STATUS:GET-MESSAGE(1) SKIP.' SKIP
      '       OUTPUT STREAM s_err CLOSE.' SKIP
      '     END.' SKIP
      SKIP
      'END.' SKIP.
END.
PUT UNFORMATTED
  '    OTHERWISE DO:' SKIP
  '       OUTPUT STREAM s_err TO VALUE(dot-d-dir + "/" + errorFile) APPEND.' SKIP 
  '       PUT STREAM s_err UNFORMATTED fName " had a value of " SKIP' SKIP 
  '           seqvalue " for " seqname SKIP' SKIP
  '           "but no sequence was found with a matching name." SKIP(1).' SKIP
  '       OUTPUT STREAM s_err CLOSE.' SKIP
  '    END.' SKIP
  '  END CASE.' SKIP
  'END.' SKIP
  'RETURN.' SKIP.
OUTPUT CLOSE.

{prodict/dump/lodtrail.i
  &file    = user_env[2]
  &entries = " " 
  }  /* read trailer, sets variables: codepage and cerror */

IF codepage <> "UNDEFINED" AND SESSION:CHARSET <> ? THEN
   ASSIGN cerror = CODEPAGE-CONVERT("a",SESSION:CHARSET,codepage).
ELSE ASSIGN cerror = "no-convert".

IF cerror = ? THEN
DO:  /* conversion needed but NOT possible */
  OS-DELETE VALUE(tmpfile).
  OUTPUT STREAM s_err TO VALUE(dot-d-dir + err-file) APPEND.
  PUT UNFORMATTED "Codepage conversion error. Sequence values NOT loaded.".
  OUTPUT STREAM s_err CLOSE.
END.     /* conversion needed but NOT possible */
ELSE DO:  /* conversion not needed OR needed and possible */  

  if cerror = "no-convert"
   then INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP NO-CONVERT.
   else INPUT FROM VALUE(user_env[2]) NO-ECHO NO-MAP
               CONVERT SOURCE codepage TARGET SESSION:CHARSET.

  RUN VALUE(tmpfile) (INPUT user_env[2], INPUT dot-d-dir, INPUT err-file).

  INPUT CLOSE.

  OS-DELETE VALUE(tmpfile). 

END.     /* conversion not needed OR needed and possible */

RETURN.
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*
File: prodict/send_sql.p

Description:
    UI to _snd_sql.i to allow users to send an sql-file to a foreign db
    
History:
    95/08   hutegger    created
*/
/*--------------------------------------------------------------------*/

define variable l_cmmnt-chr     as character format "xxxxx" init ?.
define variable l_db-name       as character format "x(32)".
define variable l_db-type       as character format "x(8)".
define variable l_debug         as logical   format "on/off".
define variable l_eosttmnt      as character format "xxxx".
define variable l_owner         as character format "x(32)".
define variable l_sql-file      as character format "x(32)".

form
  l_db-name     colon 20 label "DB-Name"   
  l_owner       colon 20 label "Owner"            /* only for oracle */
  l_sql-file    colon 20 label "SQL-File"
  l_cmmnt-chr   colon 20 label "Comment-Chars"
  l_eosttmnt    colon 20 label "End-Of-Statement"     /* ";" or "go" */
  l_db-type     colon 20 label "DB-Type" /* "ORACLE" or "<anything>" */
  l_debug       colon 20 label "Debugging-Mode"  /* on/off */
  with side-labels centered row 5
  frame frm_snd_sql.

update 
  l_db-name
  l_owner
  l_sql-file
  l_cmmnt-chr
  l_eosttmnt
  l_db-type
  l_debug
  with frame frm_snd_sql.

if LDBNAME("DICTDBG") = ?
 then do:
  create alias DICTDBG for database value(l_db-name) no-error.
  end.

if LDBNAME("DICTDBG") = ? then leave.

if LDBNAME("DICTDB") = ?
 then do:
  create alias DICTDB for database value(SDBNAME("DICTDBG")) no-error.
  end.

if LDBNAME("DICTDB") = ? then leave.

run prodict/gate/_snd_sql.p 
  ( INPUT l_cmmnt-chr,
    INPUT l_debug,
    INPUT l_db-name,
    INPUT l_db-type,
    INPUT l_eosttmnt,
    INPUT l_owner,
    INPUT l_sql-file
  ).

/*--------------------------------------------------------------------*/
/*********************************************************************
* Copyright (C) 2000 by Progress Software Corporation. All rights    *
* reserved. Prior versions of this work may contain portions         *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*-----------------------------------------------------------------------

File: prodict/_dictdb.p

Copied from from adecomm/_dictdb.p to remove dependency on ADECOMM for 
dictionaries.

Description:   
   This procedure checks the setting of DICTDB. In case it's ? or pointing
   to a non-progress db it resets it to the first PROGRESS-db it finds

Shared Output:
   DICTDB       pointing at valid db

History:
    created 11/26/02 D. McMann

-----------------------------------------------------------------------*/

define variable l_dbnr          as integer.

/*-----------------------------  TRIGGERS  ----------------------------*/

/*--------------------------  INT.-PROCEDURES  ------------------------*/

/*--------------------------  INITIALIZATIONS  ------------------------*/

/*-----------------------------  MAIN-CODE  ---------------------------*/

if NUM-DBS > 0 AND LDBNAME("DICTDB") = ?
 OR  DBTYPE("DICTDB") <> "PROGRESS" then do:  /* change/set DICTDB alias */
  repeat while l_dbnr < NUM-DBS and DBTYPE(l_dbnr) <> "PROGRESS":
    assign l_dbnr = l_dbnr + 1.
  end.
  
  if l_dbnr <= NUM-DBS
   then create alias DICTDB for database value(LDBNAME(l_dbnr)).
   
end.     /* change/set DICTDB alias */
ELSE IF INTEGER(DBVERSION("DICTDB")) < 10 THEN DO:
  DO l_dbnr = 1 TO NUM-DBS:
    IF DBTYPE(l_dbnr) <> "PROGRESS" THEN NEXT.
    IF INTEGER(DBVERSION(l_dbnr)) < 10 THEN NEXT.
    ELSE LEAVE.
  END.
 
  IF l_dbnr <= NUM-DBS THEN
    CREATE ALIAS DICTDB FOR DATABASE VALUE(LDBNAME(l_dbnr)).
END.
/*---------------------------------------------------------------------*/
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Select-Frame
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/
/*------------------------------------------------------------------------

  File: prodict/aud/_aud-pol.p

  Description: Filter dialog for Audit Policies.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: February 14, 2005
  History: 
    kmcintos May 23, 2005  Removed AUTO-GO option from OK button 20050517-007.
    kmcintos June 7, 2005  Added context help to dialog and removed appbuilder 
                           friendly code.  
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

/* Parameters Definitions ---                                           */

{prodict/aud/aud-tts.i}
{prodict/user/uservar.i}
{prodict/sec/sec-func.i}

IF NOT hasRole(USERID("DICTDB"),"_sys.audit.admin",FALSE) THEN DO:
  MESSAGE "You must have Audit Administrator permissions to access this " + 
          "Dump Option!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      
  user_path = "".
  user_env[1] = ?.
  RETURN.
END.

/* Local Variable Definitions ---                                       */

DEFINE QUERY qPolicy FOR ttPolicy SCROLLING.

DEFINE BROWSE bPolicy QUERY qPolicy
    DISPLAY ttPolicy.tcPolName COLUMN-LABEL "Policy Name"
            ttPolicy.tcPolDesc COLUMN-LABEL "Policy Description"
    WITH &IF "{&WINDOW-SYSTEM}" <> "TTY" 
           &THEN 11 &ELSE 6 
         &ENDIF DOWN WIDTH 65 MULTIPLE.

DEFINE VARIABLE giPolicies AS INTEGER     NO-UNDO.

DEFINE VARIABLE lImmedDisp AS LOGICAL     NO-UNDO.

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

&Scoped-define LAYOUT-VARIABLE CURRENT-WINDOW-layout

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Select-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-1 tbSelectAll btnOK btnCancel 
&Scoped-Define DISPLAYED-OBJECTS tbSelectAll 

/* Define a variable to store the name of the active layout.            */
DEFINE VAR CURRENT-WINDOW-layout AS CHAR INITIAL "Master Layout":U NO-UNDO.

/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnCancel
     LABEL "Cancel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON BtnHelp DEFAULT 
     LABEL "&Help" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .
&ENDIF

DEFINE BUTTON btnOK
     LABEL "OK" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 66 BY 1
     &ELSE SIZE 65.6 BY 1.38 &ENDIF.

DEFINE VARIABLE tbSelectAll AS LOGICAL INITIAL no 
     LABEL "Select &All" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 13 BY 1
     &ELSE SIZE 13.4 BY .81 &ENDIF NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Select-Frame
     tbSelectAll
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 13 COL 2
          &ELSE AT ROW 12.76 COL 2 &ENDIF
     btnOK
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 20
          &ELSE AT ROW 13.95 COL 2.8 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 32
          &ELSE AT ROW 13.95 COL 14.4 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       BtnHelp AT ROW 13.95 COL 55.6
     &ENDIF
     RECT-1
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 15 COL 3
          &ELSE AT ROW 13.71 COL 2 &ENDIF
     SPACE(0.99) SKIP(0.19)
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER DEFAULT-BUTTON btnOk
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Select Audit Policies for Dump".


/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

ASSIGN FRAME Select-Frame:SCROLLABLE = FALSE
       FRAME Select-Frame:HIDDEN     = TRUE.
                                                                        
IF SESSION:DISPLAY-TYPE = 'TTY':U  THEN 
  RUN CURRENT-WINDOW-layouts (INPUT 'Standard Character':U) NO-ERROR.

/* ************************  Control Triggers  ************************ */

ON GO OF FRAME Select-Frame /* Select Audit Policies for Dump */ DO:
  DEFINE VARIABLE iRow AS INTEGER     NO-UNDO.

  IF BROWSE bPolicy:NUM-SELECTED-ROWS = 0 THEN DO:
    MESSAGE "No Audit Policies were selected!" SKIP(1)
            "Please select Audit Policies to dump or select Cancel."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN NO-APPLY.
  END.
  ELSE DO:
    IF BROWSE bPolicy:NUM-SELECTED-ROWS = giPolicies THEN
      user_env[1] = "All".
    ELSE DO:
      FOR EACH ttPolicy WHERE ttPolicy.tlSelected = TRUE:
        user_env[1] = user_env[1] + (IF user_env[1] NE "" THEN "," ELSE "") +
                      ttPolicy.tcPolName.
      END.
    END.
  END.
END.

ON WINDOW-CLOSE OF FRAME Select-Frame /* Select Audit Policies for Dump */ 
  APPLY "END-ERROR":U TO SELF.

ON CHOOSE OF btnCancel IN FRAME Select-Frame /* Cancel */ 
   APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN

  ON CHOOSE OF BtnHelp IN FRAME Select-Frame /* Help */ OR 
     HELP OF FRAME {&FRAME-NAME} 
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Select_Audit_Policies_for_Dump_Dialog_Box},
                               INPUT ? ).
&ENDIF

ON VALUE-CHANGED OF tbSelectAll IN FRAME Select-Frame /* Select All */ DO:
  IF SELF:CHECKED THEN
    BROWSE bPolicy:SELECT-ALL() NO-ERROR.
  ELSE
    BROWSE bPolicy:DESELECT-ROWS() NO-ERROR.

  FOR EACH ttPolicy:
    ttPolicy.tlSelected = SELF:CHECKED.
  END.
END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

PAUSE 0 NO-MESSAGE.
lImmedDisp = SESSION:IMMEDIATE-DISPLAY.
SESSION:IMMEDIATE-DISPLAY = TRUE.

DEFINE FRAME {&FRAME-NAME} bPolicy AT COLUMN 2 ROW 2.

ON VALUE-CHANGED OF BROWSE bPolicy DO:
  IF AVAILABLE ttPolicy THEN
    ttPolicy.tlSelected = (SELF:FOCUSED-ROW-SELECTED).
END.

ON DEFAULT-ACTION OF BROWSE bPolicy
  APPLY "CHOOSE" TO btnOk IN FRAME {&FRAME-NAME}.

ON CHOOSE OF btnOk IN FRAME {&FRAME-NAME}
  APPLY "GO" TO FRAME {&FRAME-NAME}.

ON END-ERROR OF FRAME {&FRAME-NAME}
  user_env[1] = ?.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  
  RUN loadPolicies.
  BROWSE bPolicy:MAX-DATA-GUESS = giPolicies.
  IF giPolicies < 1 THEN
    tbSelectAll:SENSITIVE IN FRAME {&FRAME-NAME} = FALSE.

  OPEN QUERY qPolicy FOR EACH ttPolicy.
  ENABLE bPolicy WITH FRAME {&FRAME-NAME}.
  RUN enable_UI.
  APPLY "ENTRY" TO BROWSE bPolicy.
  
  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
SESSION:IMMEDIATE-DISPLAY = lImmedDisp.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Select-Frame.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY tbSelectAll 
      WITH FRAME Select-Frame.
  ENABLE {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN RECT-1 BtnHelp &ENDIF
      WITH FRAME Select-Frame.
  VIEW FRAME Select-Frame.
END PROCEDURE.

PROCEDURE loadPolicies :
/*------------------------------------------------------------------------------
  Purpose:     Loads ttPolicy Temp-Table with all of the Audit Policy records 
               in the current DICTDB database
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hBuffer AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery  AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hField  AS HANDLE      NO-UNDO.
    
  CREATE BUFFER hBuffer FOR TABLE "DICTDB._aud-audit-policy" NO-ERROR.
  CREATE QUERY hQuery.

  hQuery:SET-BUFFERS(hBuffer) NO-ERROR.
  hQuery:QUERY-PREPARE("FOR EACH " + hBuffer:NAME + " NO-LOCK") NO-ERROR.
  hQuery:QUERY-OPEN().

  hBuffer:GET-FIRST() NO-ERROR.
  giPolicies = 0.
  
  DO WHILE NOT hQuery:QUERY-OFF-END TRANSACTION:
    IF hBuffer:AVAILABLE THEN DO:
      giPolicies = giPolicies + 1.
      CREATE ttPolicy.
      ASSIGN hField             = hBuffer:BUFFER-FIELD("_Audit-Policy-Name")
             ttPolicy.tcPolName = hField:BUFFER-VALUE
             hField             = hBuffer:BUFFER-FIELD("_Audit-Policy-Description")
             ttPolicy.tcPolDesc = hField:BUFFER-VALUE.
    END.
    hQuery:GET-NEXT().
  END.

  hQuery:QUERY-CLOSE() NO-ERROR.
  DELETE OBJECT hQuery NO-ERROR.
  DELETE OBJECT hBuffer NO-ERROR.
END PROCEDURE.

PROCEDURE CURRENT-WINDOW-layouts:
  DEFINE INPUT PARAMETER layout AS CHARACTER                     NO-UNDO.
  DEFINE VARIABLE lbl-hndl AS WIDGET-HANDLE                      NO-UNDO.
  DEFINE VARIABLE widg-pos AS DECIMAL                            NO-UNDO.

  /* Copy the name of the active layout into a variable accessible to   */
  /* the rest of this file.                                             */
  CURRENT-WINDOW-layout = layout.

  CASE layout:
    WHEN "Master Layout" THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Select-Frame:HIDDEN      = yes &ENDIF
             FRAME Select-Frame:HEIGHT        = 14.29 + 
                                                FRAME Select-Frame:BORDER-TOP + 
                                                FRAME Select-Frame:BORDER-BOTTOM
             FRAME Select-Frame:WIDTH         = 67.6 + 
                                                FRAME Select-Frame:BORDER-LEFT + 
                                                FRAME Select-Frame:BORDER-RIGHT.

      ASSIGN btnCancel:HIDDEN                 = yes
             btnCancel:COL                    = 14.4
             btnCancel:HEIGHT                 = .95
             btnCancel:ROW                    = 13.95
             btnCancel:HIDDEN                 = no.

      &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
        ASSIGN BtnHelp:HIDDEN                 = yes
               BtnHelp:COL                    = 55.6
               BtnHelp:HEIGHT                 = .95
               BtnHelp:ROW                    = 13.95
               BtnHelp:HIDDEN                 = no
               BtnHelp:HIDDEN                 = no.
      &ENDIF
      
      ASSIGN btnOK:HIDDEN                     = yes
             btnOK:COL                        = 2.8
             btnOK:HEIGHT                     = .95
             btnOK:ROW                        = 13.95
             btnOK:HIDDEN                     = no.

      ASSIGN RECT-1:HIDDEN                    = yes
             RECT-1:COL                       = 2
             RECT-1:EDGE-PIXELS               = 2
             RECT-1:HEIGHT                    = 1.38
             RECT-1:ROW                       = 13.71
             RECT-1:WIDTH                     = 65.6
             RECT-1:HIDDEN                    = no
             RECT-1:HIDDEN                    = no.

      ASSIGN tbSelectAll:HIDDEN               = yes
             tbSelectAll:HEIGHT               = .81
             tbSelectAll:ROW                  = 12.76
             tbSelectAll:WIDTH                = 13.4
             tbSelectAll:HIDDEN               = no.

      ASSIGN FRAME Select-Frame:VIRTUAL-WIDTH = 67.60
                               WHEN FRAME Select-Frame:SCROLLABLE
             &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Select-Frame:HIDDEN      = no &ENDIF.

    END.  /* Master Layout Layout Case */

    WHEN "Standard Character":U THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Select-Frame:HIDDEN      = yes &ENDIF
             FRAME Select-Frame:HEIGHT        = 15 + 
                                                FRAME Select-Frame:BORDER-TOP + 
                                                FRAME Select-Frame:BORDER-BOTTOM
             FRAME Select-Frame:WIDTH         = 68 + 
                                                FRAME Select-Frame:BORDER-LEFT + 
                                                FRAME Select-Frame:BORDER-RIGHT
           NO-ERROR.

      ASSIGN btnCancel:HIDDEN                 = yes
             btnCancel:COL                    = 32
             btnCancel:HEIGHT                 = 1
             btnCancel:ROW                    = 14
             btnCancel:HIDDEN                 = no NO-ERROR.

      ASSIGN btnOK:HIDDEN                     = yes
             btnOK:COL                        = 20
             btnOK:HEIGHT                     = 1
             btnOK:ROW                        = 14
             btnOK:HIDDEN                     = no NO-ERROR.

      ASSIGN tbSelectAll:HIDDEN               = yes
             tbSelectAll:HEIGHT               = 1
             tbSelectAll:ROW                  = 13
             tbSelectAll:WIDTH                = 13
             tbSelectAll:HIDDEN               = no NO-ERROR.

      ASSIGN FRAME Select-Frame:VIRTUAL-WIDTH = 69.00
                    WHEN FRAME Select-Frame:SCROLLABLE
             &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
               FRAME Select-Frame:HIDDEN      = no &ENDIF NO-ERROR.

    END.  /* Standard Character Layout Case */

  END CASE.
END PROCEDURE.  /* CURRENT-WINDOW-layouts */
&ANALYZE-RESUME

/*************************************************************/  
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------
  File: prodict/aud/aud-tts.i

  Description: Include with definitions of common temp-tables used
               in the audit utilities.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: February 11, 2005
------------------------------------------------------------------------*/

DEFINE TEMP-TABLE ttPolicy NO-UNDO RCODE-INFORMATION
    FIELD tcPolName  AS CHARACTER FORMAT "x(25)"
    FIELD tcPolDesc  AS CHARACTER FORMAT "x(80)"
    FIELD tlSelected AS LOGICAL
    INDEX idxPolName  IS PRIMARY UNIQUE tcPolName
    INDEX idxSelected tlSelected.

DEFINE TEMP-TABLE ttDetail NO-UNDO RCODE-INFORMATION
    FIELD tcDBGuid       AS CHARACTER LABEL "DB Identifier" FORMAT "x(48)"
    FIELD tcDescription  AS CHARACTER LABEL "Description" FORMAT "x(45)"
    FIELD tcCustomDetail AS CHARACTER LABEL "Private-Data" FORMAT "x(45)"
    FIELD tlHasMacKey    AS LOGICAL
    FIELD tlModified     AS LOGICAL
    INDEX tcDBGuid AS PRIMARY UNIQUE tcDBGuid.

&GLOBAL-DEFINE FRAME-NAME cascRevoke
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

  File: prodict/sec/_cascrvk.p

  Description: Dialog for selecting permissions, for revocation,
               as a result of revoking the permissions of the user
               who granted them.

  Input Parameters:
      INPUT pcGrantor   -   UserId of the parent user who's permission 
                            is being revoked.

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: May 16, 2005

  History: 
    kmcintos May 25, 2005  Ensured that child record is not the same as the 
                           current record, in getRevokeList 20050524-014.
    kmcintos May 27, 2005  Removed SIZE phrase from dialog 20050526-024.
    kmcintos May 27, 2005  Using guid to remove first record from revoke list 
                           20050526-026.
    kmcintos June 7, 2005  Added context sensitive help to dialog.
    kmcintos Aud 18, 2005  Removed check for "IF Granter" 20050620-003.
           
------------------------------------------------------------------------*/
DEFINE INPUT  PARAMETER pcGrantor    AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcPermission AS CHARACTER   NO-UNDO.
DEFINE INPUT  PARAMETER pcGuid       AS CHARACTER   NO-UNDO.

DEFINE VARIABLE lRvkAll      AS LOGICAL     NO-UNDO INITIAL TRUE.
DEFINE VARIABLE lRvkNone     AS LOGICAL     NO-UNDO INITIAL FALSE.
DEFINE VARIABLE lRvkSel      AS LOGICAL     NO-UNDO INITIAL FALSE.

DEFINE VARIABLE cWarningLine AS CHARACTER   NO-UNDO EXTENT 5.
DEFINE VARIABLE gcSort       AS CHARACTER   NO-UNDO 
                                INITIAL "selGrantor".

DEFINE VARIABLE giRevoke     AS INTEGER     NO-UNDO.

{prodict/sec/sec-func.i}
{prodict/admnhlp.i}

CREATE WIDGET-POOL.

DEFINE TEMP-TABLE ttRevoke NO-UNDO
    FIELD selGrantee   AS CHARACTER FORMAT "x(12)" LABEL "UserID"
    FIELD selGrantor   AS CHARACTER FORMAT "x(12)" LABEL "Granted by"
    FIELD selIntPerm   AS CHARACTER
    FIELD selPerm      AS CHARACTER FORMAT "x(50)" LABEL "Permission"
    FIELD selGuid      AS CHARACTER
    FIELD selForRevoke AS LOGICAL   FORMAT "Revoke/Retain" 
                                    LABEL "Revoke/Retain "
                                    INITIAL TRUE
    INDEX selGuid   AS PRIMARY UNIQUE selGuid.

DEFINE BUFFER bfRevoke FOR ttRevoke.

DEFINE QUERY qRevoke FOR ttRevoke SCROLLING.

DEFINE BROWSE bRevoke QUERY qRevoke
    DISPLAY selForRevoke
            selGrantee
            selPerm 
            selGrantor
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      ENABLE selForRevoke &ENDIF
    WITH &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 7 &ELSE NO-BOX 3 &ENDIF DOWN 
         WIDTH 77 NO-ROW-MARKERS NO-SEPARATORS
         MULTIPLE.

DEFINE BUTTON btnRvkAll  LABEL "Revoke &All"      SIZE 18 BY .93.
DEFINE BUTTON btnRvkNone LABEL "Revoke &None"     SIZE 18 BY .93.
DEFINE BUTTON btnRvkSel  LABEL "Re&voke Selected" SIZE 18 BY .93.
DEFINE BUTTON btnRtnSel  LABEL "Re&tain Selected" SIZE 18 BY .93.

DEFINE BUTTON btnDone    LABEL "Done" AUTO-GO SIZE 11 BY .93.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  DEFINE BUTTON btnHelp LABEL "&Help"         SIZE 11 BY .93.
&ENDIF

RUN getRevokeList ( INPUT pcGrantor,
                    INPUT pcPermission,
                    INPUT pcGuid ).

FORM cWarningLine[1]  VIEW-AS TEXT FORMAT "x(75)" 
                      &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
                        AT ROW 1.5 COL 2 &ELSE AT 2 &ENDIF SKIP
     cWarningLine[2]  VIEW-AS TEXT FORMAT "x(75)" AT 2 
                      &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN SKIP(1) &ENDIF
     cWarningLine[3]  VIEW-AS TEXT FORMAT "x(75)" 
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
       AT ROW 3 COL 2 &ELSE AT 2 &ENDIF SKIP
     cWarningLine[4]  VIEW-AS TEXT FORMAT "x(75)" AT 2 
                      &IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN SKIP(1) 
                        &ELSE SKIP &ENDIF
     bRevoke    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
                  AT ROW 4.5  COL 2 &ELSE AT 2 &ENDIF SKIP(1)
     btnRvkAll  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                  AT ROW 12 COL 2 &ELSE AT 2 &ENDIF 
     btnRvkNone AT 21
     btnRvkSel  AT 40 
     btnRtnSel  AT 59 SKIP(1)
     btnDone    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
                  AT ROW 13.5 COL 34 &ELSE AT 34 &ENDIF
     &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
       btnHelp AT ROW 13.5 COL 66 &ENDIF
  WITH FRAME cascRevoke CENTERED DEFAULT-BUTTON btnDone
       TITLE "Cascade Revoke Permissions" NO-LABELS USE-TEXT
       &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
         VIEW-AS DIALOG-BOX THREE-D
       &ENDIF.

&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
  ON START-SEARCH OF bRevoke DO:
    DEFINE VARIABLE cCol AS CHARACTER NO-UNDO.
    
    cCol = SELF:CURRENT-COLUMN:NAME.
    IF gcSort EQ cCol THEN gcSort = cCol + " DESC".
    ELSE gcSort = cCol.
    RUN openQuery.
    
    APPLY "END-SEARCH" TO SELF.
  END.

  ON HELP   OF FRAME {&FRAME-NAME} OR
     CHOOSE OF btnHelp IN FRAME {&FRAME-NAME}
    RUN adecomm/_adehelp.p ( INPUT "admn", 
                             INPUT "CONTEXT", 
                             INPUT {&Cascade_Revoke_Permissions_Dialog_Box},
                             INPUT ? ).
&ENDIF

ON CHOOSE OF btnRvkAll IN FRAME {&FRAME-NAME} DO:
  BROWSE bRevoke:DESELECT-ROWS() NO-ERROR.
  
  ASSIGN SELF:SENSITIVE       = FALSE
         lRvkAll              = TRUE
         lRvkNone             = FALSE
         btnRvkNone:SENSITIVE = TRUE.

  FOR EACH ttRevoke TRANSACTION:
    selForRevoke = TRUE.
  END.
  RUN openQuery.
END.

ON CHOOSE OF btnRvkNone IN FRAME {&FRAME-NAME} DO:
  BROWSE bRevoke:DESELECT-ROWS() NO-ERROR.

  ASSIGN SELF:SENSITIVE      = FALSE
         lRvkNone            = TRUE
         lRvkAll             = FALSE
         btnRvkAll:SENSITIVE = TRUE.

  FOR EACH ttRevoke TRANSACTION:
    selForRevoke = FALSE.
  END.
  RUN openQuery.
END.

ON CHOOSE OF btnRvkSel IN FRAME {&FRAME-NAME} DO:
  DEFINE VARIABLE iSelect AS INTEGER     NO-UNDO.
  
  DO iSelect = 1 TO bRevoke:NUM-SELECTED-ROWS 
      TRANSACTION:
    bRevoke:FETCH-SELECTED-ROW(iSelect).
    IF NOT AVAILABLE ttrevoke THEN NEXT.
    selForRevoke = TRUE.
    bRevoke:REFRESH().
  END.
  
END.

ON CHOOSE OF btnRtnSel IN FRAME {&FRAME-NAME} DO:
  DEFINE VARIABLE iSelect AS INTEGER     NO-UNDO.
  
  DO iSelect = 1 TO bRevoke:NUM-SELECTED-ROWS:
    bRevoke:FETCH-SELECTED-ROW(iSelect).
    IF NOT AVAILABLE ttrevoke THEN NEXT.
    selForRevoke = FALSE.
    bRevoke:REFRESH().
  END.
  
END.

ON WINDOW-CLOSE OF FRAME {&FRAME-NAME}
  RETURN NO-APPLY.

ON DEFAULT-ACTION OF BROWSE bRevoke DO:
  IF NOT AVAILABLE ttRevoke THEN
    RETURN NO-APPLY.

  DO TRANSACTION:
    selForRevoke = (NOT selForRevoke).
  END.
  giRevoke = giRevoke + (IF selForRevoke THEN 1 ELSE -1).
  SELF:REFRESH().
END.

ON GO OF FRAME {&FRAME-NAME} DO:
  DEFINE VARIABLE hSGRole AS HANDLE      NO-UNDO.

  CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".

  DO TRANSACTION:
    FOR EACH ttRevoke WHERE selForRevoke EQ TRUE:
      hSGRole:FIND-FIRST("WHERE _granted-role-guid = ~'" + 
                         ttRevoke.selGuid + "~'").
      hSGRole:BUFFER-DELETE().
    END.
  END.

  DELETE OBJECT hSGRole.
END.

ON END-ERROR OF FRAME {&FRAME-NAME}
  RETURN NO-APPLY.

/*-------------------Main-Line Code-------------------------------------*/
FRAME {&FRAME-NAME}:TITLE = FRAME {&FRAME-NAME}:TITLE + 
                            " Granted by " + pcGrantor.
ASSIGN cWarningLine[1] = "When a permission is revoked, the assumption is " +
                         "that all permissions that"
       cWarningLine[2] = "were granted as a result of that permission should" +
                         " also be revoked."
       cWarningLine[3] = "Please carefully review the permissions listed " +
                         "below and Retain or Revoke"
       cWarningLine[4] = "permissions as necessary".

DISPLAY cWarningLine[1] 
        cWarningLine[2]
        cWarningLine[3]
        cWarningLine[4]
    WITH FRAME cascRevoke.

ENABLE ALL WITH FRAME {&FRAME-NAME}.
btnRvkAll:SENSITIVE IN FRAME cascRevoke = FALSE.
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
  selForRevoke:READ-ONLY IN BROWSE bRevoke = TRUE.
&ENDIF

RUN openQuery.
BROWSE bRevoke:SELECT-ALL().

WAIT-FOR GO OF FRAME cascRevoke.

PROCEDURE getRevokeList:
  DEFINE INPUT  PARAMETER pcGrantor    AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcPermission AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcGuid       AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hPermission AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery      AS HANDLE      NO-UNDO.
  
  DEFINE VARIABLE lChild      AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAdminRight AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE cPermission AS CHARACTER   NO-UNDO.

  IF pcPermission EQ "" OR pcPermission EQ ? THEN RETURN.

  IF pcPermission NE "_sys.audit.admin" THEN
    cPermission = " AND _role-name = ~'" + pcPermission + "~'".
  ELSE lAdminRight = TRUE.

  CREATE WIDGET-POOL.

  CREATE BUFFER hPermission FOR TABLE "DICTDB._sec-granted-role".

  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(hPermission).
  hQuery:QUERY-PREPARE("FOR EACH _sec-granted-role WHERE _grantor = ~'" +
                       pcGrantor + "~'  AND _granted-role-guid NE ~'" + 
                       pcGuid + "~'" + cPermission).
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  DO WHILE NOT hQuery:QUERY-OFF-END:
    IF hPermission::_grantee = hPermission::_grantor AND
       NOT lAdminRight THEN DO: 
      hQuery:GET-NEXT().
      NEXT.
    END.

    CREATE ttRevoke.
    ASSIGN selGrantee   = hPermission::_grantee
           selGrantor   = hPermission::_grantor
           selIntPerm   = hPermission::_role-name
           selPerm      = getRoleDesc(hPermission::_role-name)
           selGuid      = hPermission::_granted-role-guid
           selForRevoke = TRUE.

    RUN getRevokeList ( INPUT hPermission::_grantee,
                        INPUT hPermission::_role-name,
                        INPUT hPermission::_granted-role-guid ).

    hQuery:GET-NEXT().
  END.
END PROCEDURE.

PROCEDURE openQuery:
  giRevoke = 0.
  FOR EACH bfRevoke WHERE bfRevoke.selForRevoke = TRUE NO-LOCK:
    giRevoke = giRevoke + 1.
  END.

  QUERY qRevoke:QUERY-PREPARE("FOR EACH ttRevoke BY " + gcSort).
  QUERY qRevoke:QUERY-OPEN().
  
END PROCEDURE.
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
/*************************************************************/
/* Copyright (c) 1984-2007,2011 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

  File: prodict/sec/_sec-dom.p

  Description: Maintenance dialog for the _sec-authentication-domain table.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 25, 2005

  History: 
    kmcintos May 24, 2005  Added validation for Name and Type fields 
                           20050524-013.
    kmcintos May 25, 2005  Removed return when not available from browse 
                           value-changed trigger 20050524-012.
                           
                           Also had to refine some navigation logic.
    kmcintos May 26, 2005  Added validation to prevent saving duplicate 
                           domain 20050525-047.
    kmcintos June 7, 2005  Removed local help button trigger to allow the one 
                           in sec-trgs.i to fire.
    kmcintos June 17, 2005 Added logic in localSave to encrypt access code 
                           using the new ENCRYPT-AUDIT-MAC-KEY method of
                           the AUDIT-POLICY handle 20050614-032.
    kmcintos Oct 28, 2005  Added code to enforce mandatory assignment of
                           access code 20051028-022.
    fernando 11/30/07      Check if read-only mode.   
    rkamboj  08/16/11      Added new terminology for security items and windows.  
    rkamboj  09/14/11      Added support for allowing edit of all fields 
                           except Domain name, Tenant Name and System Type.
    rkmaboj  05/04/2012    Fixed default domain save problem.                       
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

{prodict/sec/sec-func.i}
{prodict/sec/ui-procs.i}
{prodict/misc/misc-funcs.i}

/* ***************************  Definitions  ************************** */
CREATE WIDGET-POOL.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to access this utility!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.
          
IF checkReadOnly("DICTDB","_sec-authentication-system") NE "" OR
   checkReadOnly("DICTDB","_sec-authentication-domain") NE "" THEN
   RETURN.

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE TEMP-TABLE saDom NO-UNDO RCODE-INFORMATION
    FIELD dName       AS CHARACTER LABEL "Name"             FORMAT "x(70)"
/*                                   CASE-SENSITIVE*/
    FIELD dType       AS CHARACTER LABEL "System Type" /* "Type" */             FORMAT "x(70)"
    FIELD dTenantName AS CHARACTER LABEL "Tenant Name"      FORMAT "x(32)"
    FIELD dDescrip    AS CHARACTER LABEL "Description"      FORMAT "x(255)"
    FIELD dAccessCode AS CHARACTER LABEL "Access Code"      FORMAT "x(255)"
    FIELD dAContext   AS CHARACTER LABEL "Auditing Context" FORMAT "x(255)"
    FIELD dROptions   AS CHARACTER LABEL "Runtime Options"  FORMAT "x(255)"
    FIELD dPAMOptions AS CHARACTER LABEL "System Options" /* "PAM Options" */     FORMAT "x(255)"
    FIELD dComments   AS CHARACTER LABEL "Custom Detail"    FORMAT "x(255)"
    FIELD dEnabled    AS LOGICAL   LABEL "Enabled"          FORMAT "Yes/No"
    FIELD dCategory   as integer   label "Category"    format "9"
    INDEX idxDomain   AS PRIMARY UNIQUE dName.

DEFINE VARIABLE gcSort        AS CHARACTER   NO-UNDO INITIAL "dName".
DEFINE VARIABLE gcSystemList  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcMods        AS CHARACTER   NO-UNDO.
define variable gcDoneLabel   as character   no-undo.
DEFINE VARIABLE inbuild       AS LOGICAL     NO-UNDO.
define variable gcOkLabel   as character   no-undo init "&OK".

define variable glInSelect      as logical no-undo.
/* ui behavior variables set in loadMultiTenantInfo */
define variable gcTenantName    as character  no-undo.
define variable glViewTenant    as logical    no-undo.
define variable glEnableTenant  as logical    no-undo.
define variable glMultiTenant   as logical    no-undo.
define variable ghBrowse        as handle     no-undo.
define variable ghQuery         as handle     no-undo.
define variable glInit          as logical    no-undo.

DEFINE QUERY qDomain1 FOR saDom SCROLLING.
DEFINE QUERY qDomain2 FOR saDom SCROLLING.

DEFINE BROWSE bDomainTenant  QUERY qDomain1
    DISPLAY dName width 42
            dTenant width 32
            dType width 20
            dDescrip width 45
             dEnabled view-as toggle-box
            /*
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      ENABLE dName &ENDIF
    */
    WITH NO-ROW-MARKERS SEPARATORS  
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 14 DOWN WIDTH 75 NO-BOX
         &ELSE 15 DOWN WIDTH 98 &ENDIF FIT-LAST-COLUMN.

DEFINE BROWSE bDomainShared QUERY qDomain2
    DISPLAY dName width 32
            dType width 20
            dDescrip width 32
            dEnabled view-as toggle-box
    /*
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      ENABLE dName &ENDIF
    */
    WITH NO-ROW-MARKERS SEPARATORS
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 14 DOWN WIDTH 75 NO-BOX
         &ELSE 15 DOWN WIDTH 98 &ENDIF FIT-LAST-COLUMN.



/* ********************  Preprocessor Definitions  ******************** */


&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame
 
/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnCancel 
     LABEL "Ca&ncel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnCreate 
     LABEL "&Create" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnDelete 
     LABEL "Delete" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnDone 
     LABEL "&Done" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnTenant 
     LABEL "&Select Tenant..." 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 18 BY 1
     &ELSE SIZE 18 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnNext 
     LABEL ">" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 8 BY 1
     &ELSE SIZE 4 BY .95 &ENDIF
     BGCOLOR 8 .
     
DEFINE BUTTON btnPrev 
     LABEL "<" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 8 BY 1
     &ELSE SIZE 4 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnSave 
     LABEL "&Save" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnModify 
     LABEL "&Modify" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 10 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.



&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  DEFINE BUTTON BtnHelp DEFAULT 
       LABEL "&Help" 
       SIZE 11 BY .95
       BGCOLOR 8 .
        
  DEFINE RECTANGLE RECT-1
       EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 2 BY 1
       &ELSE SIZE 98 BY 1.52 &ENDIF.      
       
  DEFINE RECTANGLE RECT-2
       EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 2 BY 1
       &ELSE SIZE 78 BY 1.52 &ENDIF.
&ENDIF


DEFINE VARIABLE cbType AS CHARACTER FORMAT "X(256)":U 
     LABEL "System Type" /* "Type" */
     VIEW-AS COMBO-BOX 
     INNER-LINES &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 3 &ELSE 5 &ENDIF
     LIST-ITEMS "Item 1" 
     DROP-DOWN-LIST
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
     SIZE 36 BY 1
     &ELSE 
     SIZE 59.4 BY 1 
     &ENDIF 
     NO-UNDO.


DEFINE VARIABLE fiAContext AS CHARACTER FORMAT "X(256)":U 
     LABEL "Audit Context" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 1
     &ELSE SIZE 59.4 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiAccessCode AS CHARACTER FORMAT "X(256)":U  
     LABEL "Access Code" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 1
     &ELSE SIZE 59.4 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE edDescription AS CHARACTER
     LABEL "Description"  
      VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 4
     &ELSE SIZE 59.4 BY 2.91 &ENDIF NO-UNDO.

DEFINE VARIABLE edComments AS CHARACTER
     LABEL "Comments"  
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 4
     &ELSE SIZE 59.4 BY 2.91 &ENDIF NO-UNDO.



DEFINE VARIABLE fiTenant AS CHARACTER FORMAT "X(32)":U 
     LABEL "Tenant Name" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 32 BY 1
     &ELSE SIZE 40.49 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiName AS CHARACTER FORMAT "X(256)":U 
     LABEL "Name" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 1
     &ELSE SIZE 59.4 BY 1 &ENDIF NO-UNDO.

 
DEFINE VARIABLE lblEnabled AS CHARACTER FORMAT "X(256)":U 
                              INITIAL "Domain Enabled:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 16 BY 1
     &ELSE SIZE 17 BY .62 &ENDIF NO-UNDO.


DEFINE VARIABLE fiROptions AS CHARACTER FORMAT "X(256)":U 
     LABEL "Runtime Options" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 1
     &ELSE SIZE 59.4 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE fiPAMOptions AS CHARACTER FORMAT "X(256)":U 
     LABEL "System Options" /* "PAM Options" */ 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 58 BY 1
     &ELSE SIZE 59.4 BY 1 &ENDIF NO-UNDO.
                    
DEFINE VARIABLE tbEnabled AS LOGICAL INITIAL no 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
     LABEL "Domain Enabled" 
     VIEW-AS FILL-IN 
     SIZE 3 BY 1
     &ELSE 
     LABEL "" 
     VIEW-AS TOGGLE-BOX
     SIZE 3 BY .71 
     &ENDIF 
     NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Browse-Frame
     bDomainTenant at 2
     bDomainShared at col-of bDomainTenant row-of bDomainTenant
     btnDone
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT row 18 col 2
          &ELSE AT ROW 15.62 COL 3 &ENDIF  
     btnCreate
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 25
          &ELSE AT ROW 15.62 COL 18.2 &ENDIF
     btnModify
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 36
          &ELSE AT ROW 15.62 COL 29.6 &ENDIF
     btnDelete
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 47
          &ELSE AT ROW 15.62 COL 41 &ENDIF
     
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
       BtnHelp AT ROW 15.62 COL 88
       RECT-1 AT ROW 15.33 COL 2 
     &ENDIF 

WITH 
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
     VIEW-AS DIALOG-BOX THREE-D WIDTH 100
        &ELSE

        overlay
        
        &ENDIF 
     KEEP-TAB-ORDER ROW 1 SIDE-LABELS  
     NO-UNDERLINE 
     SCROLLABLE /* avoid rect-2 size error in gui */
     CENTERED
     
     TITLE "Domains" /* "Authentication System Domains" */
     DEFAULT-BUTTON btnDone.
 
DEFINE FRAME Dialog-Frame
     
     fiName   COLON 18      
     fiTenant COLON 18 btnTenant 
     cbType colon 18
   /*
           &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
     tbEnabled   SKIP
           &endif
     */
     fiAccessCode PASSWORD-FIELD COLON 18
     fiAContext COLON 18 
     
     fiROptions  COLON 18
     fiPAMOptions  COLON 18
     edDescription   COLON 18 
     edComments  COLON 18 
     lblEnabled NO-LABEL VIEW-AS TEXT 
        &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        AT 3
        &ELSE
        AT 4
        &ENDIF 
     tbEnabled NO-LABEL COLON 18 SKIP(1)
            
     btnDone
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 2
          &ELSE AT ROW 19.6 COL 3 &ENDIF
     btnCreate
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 15
          &ELSE AT ROW 19.62 COL 14.2 &ENDIF
     btnSave
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 26
          &ELSE AT ROW 19.62 COL 25.4 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 37
          &ELSE AT ROW 19.62 COL 36.8 &ENDIF
     btnDelete
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 48
          &ELSE AT ROW 19.62 COL 48 &ENDIF
     btnPrev
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
             LABEL "&Prev" AT 61
          &ELSE 
             AT ROW 19.62 COL 59.2 
          &ENDIF     
     btnNext
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
              LABEL "&Next"  AT 70
          &ELSE 
            AT ROW 19.62 COL 63.5 
          &ENDIF
     &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
       BtnHelp AT ROW 19.62 COL 67.76
       RECT-2 AT ROW 19.33 COL 2 
       
     &ENDIF 
/*     SPACE(1.39) SKIP(0.14)*/
 WITH 
        &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
     VIEW-AS DIALOG-BOX THREE-D 
        &ELSE
    
    VIEW-AS DIALOG-BOX 
    WIDTH 80
        
        &ENDIF 
     KEEP-TAB-ORDER ROW 1 SIDE-LABELS  
     NO-UNDERLINE 
     SCROLLABLE /* avoid rect-2 size error in gui */
     CENTERED
     TITLE "Domains" /* "Authentication System Domains" */
     DEFAULT-BUTTON btnDone.


/* ************************  Functions ********************** */


function createQuery returns handle (  ):
    define variable hQuery as handle no-undo. 
    create query hQuery.
    hQuery:add-buffer(buffer saDom:handle).
    return hQuery.
end function.    

/* ** load MT info and define triggers ************************************************* */


RUN loadMultiTenantInfo.
if glViewTenant then
do: 
     ghBrowse = browse bdomainTenant:handle.
     browse bDomainShared:hidden = true.
end.
else do:
     ghBrowse = browse bdomainShared:handle.
     browse bDomainTenant:hidden = true.
end.

{prodict/sec/sec-trgs.i
      &frame_name    =   "Dialog-Frame"}
      
&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  ghBrowse:HELP = KBLABEL("CTRL-A") + "=Create  " +
                        KBLABEL("DEL")    + "=Delete  " +
                        KBLABEL("GO")     + "=Done".
  cbType:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Domain Type then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  fiName:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Domain Name then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  fiAccessCode:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Access Code then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  fiAContext:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Auditing Context then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  fiROptions:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Runtime Options then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  edDescription:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Description then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  edComments:HELP IN FRAME {&FRAME-NAME} =
                  "Enter Comments then hit " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  tbEnabled:HELP IN FRAME {&FRAME-NAME} =
                  "Hit Spacebar, " + KBLABEL("GO") +
                  " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
&ENDIF

/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

/* SETTINGS FOR DIALOG-BOX Dialog-Frame FRAME-NAME */
ASSIGN FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame  
DO:
  APPLY "END-ERROR":U TO SELF.
END.

ON WINDOW-CLOSE OF FRAME Browse-Frame  
DO:
  APPLY "END-ERROR":U TO SELF.
END.

on choose of btnCreate in frame browse-frame do: 
   run OpenDialog("create").
end.

on choose of btnModify in frame browse-frame do: 
   run OpenDialog("Modify").
end.

on choose of btnDelete in frame browse-frame do: 
   RUN deleteRecord.
   RUN localTrig ( INPUT "Delete" ).
end.

on default-action of ghBrowse do:
   run OpenDialog("Modify").
end.    

ON CHOOSE OF btnTenant IN FRAME {&FRAME-NAME} 
DO:
    run selectTenant.
END.

ON CHOOSE OF btnNext IN FRAME {&frame-name} DO:
    ghQuery:reposition-forward (0).
    run display.
END.

ON CHOOSE OF btnPrev IN FRAME {&frame-name} DO:
    ghQuery:reposition-backward (2).  
    run display.
END.

/* overrides sec-trgs.i */
ON CHOOSE OF btnSave DO :
    DEFINE VARIABLE err AS LOGICAL NO-UNDO.
  IF inbuild THEN 
  DO:
      
      RUN localSave ( INPUT "Before" ).
      IF RETURN-VALUE NE "" THEN
         RETURN RETURN-VALUE.  
      FIND FIRST DICTDB._sec-authentication-domain 
           WHERE DICTDB._sec-authentication-domain._Domain-name = TRIM(fiName:SCREEN-VALUE) NO-ERROR.
      IF AVAILABLE (DICTDB._sec-authentication-domain) THEN 
      DO:
          ASSIGN DICTDB._sec-authentication-domain._Domain-enabled = LOGICAL(tbEnabled:SCREEN-VALUE)
                 err = no.
          FIND FIRST saDom WHERE saDom.dName = TRIM(fiName:SCREEN-VALUE) NO-ERROR.
          IF AVAILABLE (saDom) THEN 
          DO:
              
             ASSIGN saDom.dEnabled =  DICTDB._sec-authentication-domain._Domain-enabled.
          END.              
          IF cbType:SCREEN-VALUE <>  DICTDB._sec-authentication-domain._Domain-type THEN 
          DO:
             err = YES. 
             RUN saveRecord.
             ASSIGN saDom.dType = DICTDB._sec-authentication-domain._Domain-type.
          END.   
      END.
      IF NOT err THEN 
      DO:
          RUN localSave ( INPUT "After" ).
          RUN setButtonState ( INPUT "ResetMode" ).
          RUN setFieldState  ( INPUT "ResetMode" ).
      END.    
              
  END.
  else    
     RUN saveRecord.
  
  IF RETURN-VALUE = "Retry" THEN
    RETURN NO-APPLY.
  IF RETURN-VALUE = "Fatal" THEN DO:
    RUN cancelRecord.
    RETURN NO-APPLY.
  END.
                 
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Save" ).

  APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
ON CHOOSE OF btnHelp IN FRAME BROWSE-Frame OR
CHOOSE OF btnHelp IN FRAME BROWSE-Frame 
DO:
    RUN adecomm/_adehelp.p ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Domains_Dialog_Box},
                               INPUT ? ).
end.
&ENDIF
ON CHOOSE OF btnDone IN FRAME {&frame-name} DO:
   IF btnSave:SENSITIVE IN FRAME {&FRAME-NAME} = true THEN
   do:
       apply "choose" to btnSave IN FRAME {&FRAME-NAME}.
   end.
   IF btnSave:SENSITIVE IN FRAME {&FRAME-NAME} = false then
       APPLY "WINDOW-CLOSE" TO FRAME {&frame-name}.
    
END.

ON CHOOSE OF btnDone IN FRAME browse-frame DO:
    APPLY "WINDOW-CLOSE" TO FRAME browse-frame.
end.

ON "GO" OF FRAME {&FRAME-NAME} DO:
  IF btnSave:SENSITIVE IN FRAME {&FRAME-NAME} = FALSE THEN
    LEAVE.
  
  APPLY "CHOOSE" TO btnSave IN FRAME {&FRAME-NAME}.
  RETURN NO-APPLY.
END.

ON VALUE-CHANGED OF fiTenant IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saDom AND
    saDom.dTenant NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.

ON VALUE-CHANGED OF cbType IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saDom AND
    saDom.dType NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.



ON VALUE-CHANGED OF edDescription IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saDom AND
    saDom.dDescrip NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.

ON VALUE-CHANGED OF fiAccessCode IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saDom AND
    saDom.dAccessCode NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.

ON VALUE-CHANGED OF fiROptions IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saDom AND
    saDom.dROptions NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.

ON VALUE-CHANGED OF fiPAMOptions IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF  AVAILABLE saDom 
  AND saDom.dPAMOptions NE SELF:SCREEN-VALUE THEN 
  DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.


ON VALUE-CHANGED OF tbEnabled IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  IF AVAILABLE saDom AND
    saDom.dEnabled NE logical(SELF:screen-value) THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.

ON VALUE-CHANGED OF ghBrowse DO:
  RUN display. 
END.

ON END-ERROR ANYWHERE DO:
   
  IF glinselect = false and btnCancel:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
    APPLY "CHOOSE" TO btnCancel.
/*    RETURN NO-APPLY.*/
  END.
  
END.

ON VALUE-CHANGED OF fiAContext IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saDom AND
    saDom.dAContext NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      ghBrowse:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
/*  saDom.dName:READ-ONLY IN ghBrowse = TRUE.*/
  ON START-SEARCH OF ghBrowse DO:
    DEFINE VARIABLE cCol AS CHARACTER  NO-UNDO.
    ghBrowse:clear-sort-arrows().
    cCol = SELF:CURRENT-COLUMN:NAME.
    IF gcSort EQ cCol THEN
    do:
       SELF:CURRENT-COLUMN:sort-ascending = false.
       gcSort = cCol + " DESC".
    end.
    ELSE do:
       SELF:CURRENT-COLUMN:sort-ascending = true. 
       gcSort = cCol.
    end.
    RUN openQuery.
    apply "end-search" to ghBrowse. 
  END.

  ON VALUE-CHANGED OF edComments IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.
    
    IF AVAILABLE saDom AND
       saDom.dComments NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN 
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
    END.
    ELSE DO:
      gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
      IF gcMods EQ "" OR 
         gcMods EQ "," THEN DO:
        ghBrowse:SENSITIVE = TRUE.
        gcMods = "".
        RUN setButtonState ( "ResetMode" ).
      END.  
    END.
  END.
&ELSE
  /* tbenabled is fill-in in tty so disallow ? */
  ON ANY-PRINTABLE OF tbEnabled IN FRAME {&FRAME-NAME} DO:
      if last-event:label = "?" then
      do:
          bell.
          return no-apply. 
      end.    
  END. 
  /*  
  ON ENTRY OF ghBrowse DO:
    IF LAST-EVENT:WIDGET-LEAVE = 
        btnDelete:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
      APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
      RETURN NO-APPLY.
    END.
  END.

  ON LEAVE OF btnCreate IN FRAME {&FRAME-NAME} DO:
    IF btnDelete:SENSITIVE IN FRAME {&FRAME-NAME} EQ FALSE THEN DO:
      APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
      RETURN NO-APPLY.
    END.
  END.
                        
  ON ENTRY OF btnDone IN FRAME {&FRAME-NAME} DO:
    IF NOT ronly AND LAST-EVENT:WIDGET-LEAVE EQ
              ghBrowse:HANDLE THEN DO:
      APPLY "ENTRY" TO btnCreate IN FRAME {&FRAME-NAME}.
      RETURN NO-APPLY.
    END.
  END.
           
  ON ENTRY OF btnCreate DO:
     
    IF LAST-EVENT:WIDGET-LEAVE =
        btnDone:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
/*      APPLY "ENTRY" TO ghBrowse.*/
      RETURN NO-APPLY.
    END.
  END.
  */
  ON CTRL-N ANYWHERE DO:
    IF btnCancel:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
      IF FOCUS EQ edcomments:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
        IF gcMods NE "" THEN
          APPLY "CHOOSE" TO btnCancel IN FRAME {&FRAME-NAME}.
        ELSE RETURN NO-APPLY.
      END.
      ELSE APPLY "CHOOSE" TO btnCancel IN FRAME {&FRAME-NAME}.
    END.
    ELSE RETURN NO-APPLY.
  END.
  
  ON CTRL-CURSOR-RIGHT ANYWHERE DO:
    IF btnNext:SENSITIVE IN FRAME {&FRAME-NAME} THEN  
        APPLY "CHOOSE" TO btnNext IN FRAME {&FRAME-NAME}.
   RETURN NO-APPLY.
  END.
  
  ON CTRL-CURSOR-LEFT ANYWHERE DO:
    IF btnPrev:SENSITIVE IN FRAME {&FRAME-NAME} THEN  
        APPLY "CHOOSE" TO btnPrev IN FRAME {&FRAME-NAME}.
   RETURN NO-APPLY.
  END.
  
  
  ON CTRL-A ANYWHERE DO:
    IF btnCreate:SENSITIVE IN FRAME {&FRAME-NAME} OR
       (FOCUS = edcomments:HANDLE IN FRAME {&FRAME-NAME} AND
        gcMods EQ "") THEN
      APPLY "CHOOSE" TO btnCreate IN FRAME {&FRAME-NAME}.
    ELSE RETURN NO-APPLY.
  END.
  
  ON CTRL-S ANYWHERE DO:
    IF btnSave:SENSITIVE IN FRAME {&FRAME-NAME} OR
       (FOCUS = edcomments:HANDLE IN FRAME {&FRAME-NAME} AND
        gcMods EQ "") THEN
      APPLY "CHOOSE" TO btnSave   IN FRAME {&FRAME-NAME}.
    ELSE RETURN NO-APPLY.
  END.

  ON DEL OF ghBrowse DO:
    IF AVAILABLE saDom THEN
      APPLY "CHOOSE" TO btnDelete IN FRAME {&FRAME-NAME}.
  END.

  ON ENTRY OF edComments IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.

    RUN setButtonState ( INPUT "UpdateMode" ).
    ghBrowse:SENSITIVE = FALSE.
  END.

  ON LEAVE OF edComments IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.

    IF AVAILABLE saDom AND
     saDom.dComments NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      ghBrowse:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
    END.
    ELSE DO:
      gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
      IF gcMods EQ "" OR
         gcMods EQ "," THEN DO:
        ghBrowse:SENSITIVE = TRUE.
        gcMods = "".
        RUN setButtonState ( "ResetMode" ).
      END.
      /** go to create if save was disabled **/
      IF LAST-EVENT:WIDGET-ENTER = btnSave:HANDLE IN FRAME {&FRAME-NAME} THEN 
      DO:
         if btnSave:sensitive = false then 
         do:      
            APPLY "ENTRY" TO btnCreate IN FRAME {&FRAME-NAME}.  
            RETURN NO-APPLY.
         end. 
       END.     
    END.
  END.

&ENDIF

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  RUN enableBrowseUI.
  RUN initializeBrowseUI.
  WAIT-FOR GO OF FRAME browse-frame.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.


PROCEDURE OpenDialog:
    define input  parameter pcMode as character no-undo.
    if not glInit then
    do: 
        
        run initializeUI.
        run enable_UI.
        glInit = true.
    end.    
    else 
        view frame dialog-frame.
    run display.
    if pcMode = "Create" then 
        apply "choose" to btnCreate in frame dialog-frame.
    do on error   undo, leave
       on end-key undo, leave:
        wait-for go of frame dialog-frame.
    end.
    hide frame dialog-Frame.
end.

PROCEDURE enableBrowseUI :
   ENABLE 
       bDomainTenant when glViewtenant
       bDomainShared when not glViewtenant
       btnDone
       btnCreate
       btnModify
    &IF "{&WINDOW-SYSTEM}" <>  "TTY" &THEN
       btnHelp
    &ENDIF
    WITH FRAME BROWSE-Frame.
    VIEW FRAME BROWSE-Frame.

END procedure.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
   
  DISPLAY 
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      cbType   tbEnabled fiTenant when glViewtenant fiName fiAccessCode fiAContext edDescription fiROptions edComments lblEnabled  
  &ELSE
      
      cbType fiTenant when glViewtenant fiName fiAccessCode fiAContext edDescription   fiROptions edComments lblEnabled tbEnabled
   &ENDIF
    
   WITH FRAME Dialog-Frame.
 
  
  ENABLE
  &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      fiTenant when glViewtenant
      btnTenant when glViewtenant
      cbType 
      tbEnabled  
      fiName 
      fiAccessCode 
      fiAContext 
      edDescription 
      fiROptions 
      edComments 
      btnSave 
      btnCancel 
      btnDone 
  
  &ELSE  
      fiTenant when glViewtenant
      btnTenant when glViewtenant
      cbType 
      fiName 
      fiAccessCode 
      fiAContext 
      edDescription 
      fiROptions 
      edComments 
      tbEnabled 
      btnCreate 
      btnSave 
      btnCancel 
      btnPrev
      btnNext
      btnDelete 
      btnDone 
      BtnHelp RECT-2 
      &ENDIF
  
   WITH FRAME Dialog-Frame.
 
   VIEW FRAME Dialog-Frame.
END PROCEDURE.

PROCEDURE initializeBrowseUI:
  ghBuffer   = BUFFER saDom:HANDLE.
  gcFileName = "Domains" /* "Authentication System Domains" */ .
  
 
  RUN loadDomains.
  
  IF NUM-DBS > 0 THEN
    FRAME browse-frame:TITLE = FRAME browse-frame:TITLE +
                                " (" + LDBNAME("DICTDB") + ")".
  ghFrame  = FRAME {&FRAME-NAME}:HANDLE.
  gcDBBuffer = "DICTDB._sec-authentication-domain".
  gcKeyField = "_domain-name,dName,CHAR".
  
  ghQuery = createQuery().
  ghBrowse:query = ghQuery. 
  RUN openQuery.
  
  ghBrowse:set-repositioned-row(1 ,"conditional":U). 
   
   &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ghBrowse:allow-column-searching = true. 
   &ENDIF
    
  APPLY "ENTRY" TO ghBrowse.
  APPLY "VALUE-CHANGED" TO ghBrowse.
END PROCEDURE.

PROCEDURE initializeUI:
  ghBuffer   = BUFFER saDom:HANDLE.
  gcFileName = "Domains" /* "Authentication System Domains" */ .
  
  DO WITH FRAME {&FRAME-NAME}:
    /* order is not same as ui  - new fields have been added at end (less risk) */ 
     setFieldHandles(STRING(cbType:HANDLE)        + "," +
                     STRING(fiName:HANDLE)        + "," + 
                     STRING(fiAccessCode:HANDLE)  + "," + 
                     STRING(fiAContext:HANDLE)    + "," + 
                     STRING(fiROptions:HANDLE)    + "," + 
                     STRING(edDescription:HANDLE) + "," +
                     STRING(edComments:HANDLE)    + "," + 
                     STRING(tbEnabled:HANDLE)     + "," + 
                     STRING(fiTenant:handle)     + "," + 
                     STRING(fiPAMOptions:handle)). 
      setInitValues("_oeusertable" + CHR(1)
                    + "" + CHR(1) 
                    + "" + CHR(1)
                    + "" + CHR(1) 
                    + "" + CHR(1) 
                    + "" + CHR(1) 
                    + "" + CHR(1) 
                    + "YES" + CHR(1) 
                    + gcTenantName + CHR(1)
                    + "").
      /*tenantname 9 is handled in localFieldState */                                     
      setCreateModeValues("yes,yes,yes,yes,yes,yes,yes,yes,no,yes").
      /* we handle fields in localFieldState 
         editors 6 7 are set to sensitive here and read-only is used in localFieldState */  
       setResetModeValues("iab,no,no,no,no,yes,yes,iab,no,no"). 
            setDisableModeValues("no,no,no,no,no,no,no,no,no,no").
      assign
           gcDBFields          = "_domain-type,_domain-name," +
                                 "_domain-access-code,_auditing-context," +
                                 "_domain-runtime-options," +
                                 "_domain-description," +
                                 "_domain-custom-detail,_domain-enabled," +
                                 "_tenant-name,_PAM-options"
           gcTTFields          = "dType,dName,dAccessCode,dAContext," + 
                                 "dROptions,dDescrip,dComments,dEnabled," +
                                 "dTenantName,dPAMOptions"
           ghFrame             = FRAME {&FRAME-NAME}:HANDLE.
          
   
    RUN loadSystemList.
    IF NUM-DBS > 0 THEN
        FRAME {&FRAME-NAME}:TITLE = FRAME {&FRAME-NAME}:TITLE +
                                   " (" + LDBNAME("DICTDB") + ")".
    cbType:LIST-ITEMS = gcSystemList.
  END.

  RUN layout. 
  
END PROCEDURE.

PROCEDURE loadSystemList:
  DEFINE VARIABLE hBuff  AS HANDLE    NO-UNDO.
  DEFINE VARIABLE hQuery AS HANDLE    NO-UNDO.
  
  CREATE BUFFER hBuff FOR TABLE "DICTDB._sec-authentication-system".
  
  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(hBuff).
  hQuery:QUERY-PREPARE("FOR EACH _sec-authentication-system NO-LOCK" +
                       " BY _domain-type").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  DO WHILE NOT hQuery:QUERY-OFF-END:
    gcSystemList = gcSystemList 
                   + (if gcSystemList = "" then "" else  ",")
                   + hBuff::_domain-type.
    hQuery:GET-NEXT().
  END.
  DELETE OBJECT hQuery.
  DELETE OBJECT hBuff.
END PROCEDURE.

PROCEDURE checkTenantName:
   define input  parameter pcTenant as character no-undo. 
   define output  parameter plOk as logical no-undo.
   define variable hBuff as handle no-undo.

   CREATE BUFFER hBuff FOR TABLE "DICTDB._tenant".
   plok = hBuff:find-unique ("where _tenant._Tenant-name = " + quoter(pcTenant)) no-error.
end procedure. 

PROCEDURE loadMultiTenantInfo:
  define variable hBuff     as handle no-undo.  
  define variable iTenantid as integer no-undo.
  
  /* the code has no static db reference so use buffer */
  if int(dbversion("dictdb")) > 10 then
  do:
      CREATE BUFFER hBuff FOR TABLE "DICTDB._tenant".
      glMultiTenant = hBuff:find-first () no-error.
      if glMultiTenant then 
      do:
          gcTenantName = tenant-name(ldbname("dictdb")).
          glViewTenant = yes.
          glEnableTenant = yes. 
    
      end.
  end.
   
END.

PROCEDURE loadDomains:
  DEFINE VARIABLE hBuff  AS HANDLE    NO-UNDO.
  DEFINE VARIABLE hQuery AS HANDLE    NO-UNDO.
  
  CREATE BUFFER hBuff FOR TABLE "DICTDB._sec-authentication-domain".
  
  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(hBuff).
  
  hQuery:QUERY-PREPARE("FOR EACH _sec-authentication-domain NO-LOCK").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().
  
  DO WHILE NOT hQuery:QUERY-OFF-END:
    DO TRANSACTION ON ERROR UNDO, NEXT:
      CREATE saDom.
      ASSIGN dName       = hBuff::_domain-name
             dType       = hBuff::_domain-type
             dTenant     = hBuff::_tenant-name
             dDescrip    = hBuff::_domain-description
             dAccessCode = hBuff::_domain-access-code
             dAContext   = hBuff::_auditing-context
             dROptions   = hBuff::_domain-runtime-options
             dEnabled    = hBuff::_domain-enabled
             dComments   = hBuff::_domain-custom-detail
             dCategory   = hBuff::_domain-category
             dPAMOptions = hBuff::_PAM-options.
    END.
    hQuery:GET-NEXT().
  END.

  DELETE OBJECT hQuery.
  DELETE OBJECT hBuff.
END PROCEDURE.

procedure localFieldState:
/*------------------------------------------------------------------------------
        Purpose:                                                                      
        Notes:                                                                        
------------------------------------------------------------------------------*/
  define input  parameter pcMode as character no-undo.
  define variable lok as logical no-undo.
  
  if pcMode = "CreateMode":u then 
  do with frame {&frame-name}:
       if glEnableTenant then 
          assign         
              fiTenant:sensitive = true
              btnTenant:sensitive = true.     
        assign
             edDescription:read-only = false
             edComments:read-only = false.
                 
  end.
  else if pcMode = "ResetMode":u then 
  do:
      /* don't enable fields for built-ins - category = 0 user defined
         (finame is always disabled in edit mode   
          tbEnabled is defined as "iab" and handled in ui-procs.i */
      if ghbuffer:avail 
      and ( ghBuffer::dCategory = 0 or ghBuffer::dCategory = 1 ) then
      do with frame {&frame-name}:
          assign
              fiTenant:sensitive = if ghBuffer::dCategory = 1  then false else glViewTenant 
              cbType:sensitive = true 
              btnTenant:sensitive = if ghBuffer::dCategory = 1  then false else true
              fiAccessCode:sensitive = true
              fiROptions:sensitive = true
              fiPAMOptions:sensitive = true
              fiAContext:sensitive = true
              /* use read-only for editors */
              edDescription:read-only = false
              edComments:read-only = false
              inbuild              = no.
           
      end.
      else do:
         assign
              /* use read-only for editors otherwise it cannot be scrolled and copied  */
             edDescription:read-only = true
             edComments:read-only = true
             btnTenant:sensitive = false
             inbuild             = yes.
      end. 
     
  end.
  
end procedure.

procedure localButtonState:
/*------------------------------------------------------------------------------
        Purpose:                                                                      
        Notes:                                                                        
------------------------------------------------------------------------------*/
  define input  parameter pcMode as character no-undo.
  
  define variable lok as logical no-undo.
  case pcMode:
      when "ResetMode":u then 
      do:
          /* don't enable fields for built-ins - category = 0 user defined
             (finame is always disabled in edit mode   
              tbEnabled and cbtype are defined as "iab" and handled in ui-procs.i 
              */
          if not ghbuffer:avail 
          or ghBuffer::dCategory <> 0 then
          do with frame {&frame-name}:
              assign
                  btndelete:sensitive = false.
                  btndelete:sensitive in frame browse-frame = false.
          end.
          else 
              btndelete:sensitive in frame browse-frame = true.
       
          assign
              btnPrev:sensitive in frame {&frame-name} = ghQuery:current-result-row > 1 
              btnNext:sensitive in frame {&frame-name} = ghQuery:NUM-RESULTS > ghQuery:current-result-row.
          
          if gcDoneLabel > "" then    
              btnDone:label in frame {&frame-name} = gcDoneLabel.
         
      end.
      when "CreateMode":u or when "UpdateMode":u then
      do:
          if gcDoneLabel = "" then 
               gcDoneLabel = btnDone:label in frame {&frame-name}.             
          assign
              btnPrev:sensitive in frame {&frame-name} = false
              btnNext:sensitive in frame {&frame-name} = false
              btnDone:sensitive in frame {&frame-name} = true
              btnDone:label in frame {&frame-name} = gcOkLabel.
             
      end.
           
  end case.      
  
end procedure.

PROCEDURE localDelete :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during the 
               deleteRecord event.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTxnLoc AS CHARACTER   NO-UNDO.
 
  DEFINE VARIABLE lDelete   AS LOGICAL     NO-UNDO.

  CASE pcTxnLoc:
    WHEN "Before" THEN DO:
        if can-find(first dictdb._user  where dictdb._user._domain-name = saDom.dName) then
        do:
            MESSAGE "You cannot delete a Security Authentication Domain record if there are User records associated with it."
            VIEW-AS ALERT-BOX ERROR.
            RETURN "Cancel".      
        end.    
            
        MESSAGE "Are you sure you want to delete this domain?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lDelete.
        IF NOT lDelete THEN RETURN "Cancel".

        RUN setRowidForDelete (ghQuery:PREPARE-STRING ).
        IF RETURN-VALUE NE "" THEN
            RETURN "Cancel".
        ELSE RETURN "".
    END.
    WHEN "After" THEN DO:
        
      RUN openQuery.
      
      RETURN "".
    END.
  END CASE.
END PROCEDURE.

PROCEDURE localSave :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during a saveRecord
               event.
  Parameters:  INPUT pcTxnLoc - The location where this was called in respect
                                to the actual transaction.
  Notes:       "Before" = Before the transaction even begins
               "Start"  = At the start of the transaction, before anything is 
                          done
               "End"    = At the end of the transaction, after all logic has
                          executed
               "After"  = After the transaction has been commited.  
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTxnLoc AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hAuthDom AS HANDLE NO-UNDO.
  define variable lok as logical no-undo.
  
  CASE pcTxnLoc:
    WHEN "Before" THEN DO WITH FRAME {&FRAME-NAME}:
      IF cbType:SCREEN-VALUE EQ ""  OR
         cbType:SCREEN-VALUE EQ "?" OR
       cbType:SCREEN-VALUE EQ ? THEN DO:
        MESSAGE "You must select a domain type for this domain."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        APPLY "ENTRY" TO cbType.
        RETURN "Retry".
      END.
      
      if not glMultiTenant then
           fiTenant:SCREEN-VALUE = ?.
      else if glViewTenant and fiTenant:sensitive then
      do:
          
        if (fiTenant:SCREEN-VALUE EQ ""  OR 
            fiTenant:SCREEN-VALUE EQ "?" OR
            fiTenant:SCREEN-VALUE EQ ?) 
            THEN 
        DO:
           if glEnableTenant then 
               MESSAGE "You must enter a name for the Tenant." 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK. 
           else /* should not happen? */
               MESSAGE "There is no Tenant defined for the domain." 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
           if glEnableTenant then 
               APPLY "ENTRY" TO fiTenant.
           RETURN "Retry".
        END.
        else do:
            run checkTenantName(fiTenant:SCREEN-VALUE,OUTPUT lok).
            if not lok then 
            do:
                MESSAGE "There is no Tenant with name " +  fiTenant:SCREEN-VALUE  + " in the database"
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
                if glEnableTenant then 
                    APPLY "ENTRY" TO fiTenant.
                RETURN "Retry".
            end.
        end.    
      end.
    
      
      IF glCreateMode then
      do:
        /* The tenantname must be ? in a non MT db */   
        if (fiName:SCREEN-VALUE EQ ""  OR 
            fiName:SCREEN-VALUE EQ "?" OR
            fiName:SCREEN-VALUE EQ ?) THEN DO:
           MESSAGE "You must enter a name for this domain." 
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          APPLY "ENTRY" TO fiName.
          RETURN "Retry".
        END.
        IF (fiAccessCode:SCREEN-VALUE EQ ""  OR
            fiAccessCode:SCREEN-VALUE EQ "?" OR
            fiAccessCode:SCREEN-VALUE EQ ?) THEN DO:
          MESSAGE "You must enter an access code."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          APPLY "ENTRY" TO fiAccessCode.
          RETURN "Retry".
        END.
      
        CREATE BUFFER hAuthDom FOR TABLE "DICTDB._sec-authentication-domain".
        hAuthDom:FIND-FIRST("WHERE COMPARE(_domain-name,~"=~",~"" + 
                            fiName:SCREEN-VALUE + 
                            "~",~"CASE-SENSITIVE~")",NO-LOCK) NO-ERROR. 
        IF hAuthDom:AVAILABLE THEN DO:
          MESSAGE "A domain already exists with this name!" SKIP(1)
                  "Please enter a unique name for this domain." SKIP(1)
                  "Note: Domain Names are case sensitive."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          APPLY "ENTRY" TO fiName.
          RETURN "Retry".
        END.
      END. /* If glCreateMode */
      
      IF glCreateMode OR fiAccessCode:MODIFIED THEN
        fiAccessCode:SCREEN-VALUE = 
          AUDIT-POLICY:ENCRYPT-AUDIT-MAC-KEY(fiAccessCode:SCREEN-VALUE).
    END. /* When Before */
    WHEN "After" THEN DO:
      RUN openQuery.
      RETURN "".
    END.
  END CASE.
END PROCEDURE.

PROCEDURE localTrig :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur after a trigger fires
               prodict/sec/sec-trgs.i
  Parameters:  INPUT pcTrigger - The event that was fired
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTrigger AS CHARACTER   NO-UNDO.

  CASE pcTrigger:
    WHEN "Create" THEN DO:
        APPLY "ENTRY" TO fiName IN FRAME {&FRAME-NAME}.
        ghBrowse:SENSITIVE = FALSE.
        RETURN "".
    END.
    WHEN "Save" THEN DO:
        ghBrowse:SENSITIVE = TRUE.
        RETURN "".
    END.
    WHEN "Cancel" THEN DO:
        ghBrowse:SENSITIVE = TRUE.
        RETURN "".
    END.
    
  END CASE.
END PROCEDURE.

PROCEDURE openQuery:
  define variable rid as rowid no-undo.
  if grwLastRowid <> ? then 
     rid = grwLastRowid.
  else if ghQuery:is-open then
      rid = ghQuery:get-buffer-handle(1):rowid.
  ghQuery:QUERY-PREPARE("FOR EACH saDom BY " + gcSort).
/*  ghQuery:QUERY-PREPARE("PRESELECT EACH saDom BY " + gcSort).*/
  ghQuery:QUERY-OPEN().       
  IF rid NE ? THEN
    ghQuery:REPOSITION-TO-ROWID(rid) NO-ERROR.
                     
  run display.          
  RETURN "".
END PROCEDURE.

procedure display:
    RUN displayRecord.
    IF ronly THEN DO:
        RUN setFieldState ( INPUT "DisableMode" ).
        RUN setButtonState ( INPUT "DisableMode" ).
    END.
    ELSE DO:
        RUN setFieldState ( INPUT "ResetMode" ).
        RUN setButtonState ( INPUT "ResetMode" ).
    END.
end.

procedure layout:
    define variable fieldhandle as handle no-undo.   
    define variable hSidelabel as handle no-undo.
    define variable cellhandle as handle no-undo.   
    
    do with frame {&frame-name}:  
         
          &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
      
        if not glViewTenant then 
        do:
            fiTenant:hidden in frame {&frame-name} = true.
            hSidelabel = fiTenant:side-label-handle in frame {&frame-name}.
            hSidelabel:hidden = true.

            btnTenant:hidden in frame {&frame-name}= true.
            fiName:row   in frame {&frame-name} = fiName:row + 1.
            hSidelabel = finame:side-label-handle in frame {&frame-name}.
            hSidelabel:row = fiName:row.  
        end.
       
          &ELSE
          
      /* this is not completely dynamic layout 
        the buttons row, which affects the size of the window,
        is defined statically in the frame 
        The fields are moved dynamically to ensure similar horizontal 
        spacing (which is difficult with decimal rows and no 
        UI designer) */  
        define variable dRow as decimal no-undo.  
        define variable dFill as decimal no-undo init 0.1.
        define variable dMove as decimal no-undo.
        
        drow =  1.5. 
        fieldhandle = frame dialog-frame:first-child.
        fieldhandle = fieldhandle:first-child.
        do while valid-handle(fieldhandle) :
            if lookup(string(fieldhandle),gcFieldHandles) > 0 then
            do:
                if not glViewTenant and fieldhandle:name = "fiTenant" then 
                do:
                     fieldhandle:hidden  = true.
                     btnTenant:hidden in frame {&frame-name} = true. 
                 
                end.
                else
                do:    
                    fieldhandle:row = dRow + (if fieldhandle:height lt 1 
                                              then (1 - fieldhandle:height) / 2
                                              else 0 ).
                    dRow = fieldhandle:Row + fieldhandle:height + dFill.
                    if can-query (fieldhandle,"side-label-handle":U) then
                    do:
                        hsidelabel = fieldhandle:side-label-handle.
                        if valid-handle(hsidelabel) then
                        do:
                            hsidelabel:row = fieldhandle:Row.
                        end.   
                    end.
                end.
            end.
            fieldhandle = fieldhandle:next-sibling.     
        end.
        /* adjust non-default label */ 
        lblEnabled:row = tbEnabled:row.
        /* adjust tenant browse button*/
        btnTenant:row = fiTenant:row.
        /* increase/decrease frame height and button positions according to last move 
          (this assumes adjustments in loop above are small enough to fit in original frame) */ 
       
        dMove = frame {&frame-name}:height - (dRow + 3).
        assign    
            btnDone:row = btnDone:row - dmove 
            btnCreate:row = btnCreate:row - dmove 
            btnSave:row = btnSave:row - dmove 
            btnCancel:row = btnCancel:row - dmove 
            btnDelete:row = btnDelete:row - dmove 
            btnPrev:row = btnPrev:row - dmove 
            btnNext:row = btnNext:row - dmove 
            BtnHelp:row = BtnHelp:row - dmove 
            RECT-2:row = RECT-2:row - dmove .         
        if dmove > 0 then                                                 
            frame {&frame-name}:height = frame {&frame-name}:height -  dmove.       
      &endif
       
    end.   
end.

Procedure selectTenant:
    define variable tenantdlg as prodict.pro._tenant-sel-presenter no-undo.
    tenantdlg = new  prodict.pro._tenant-sel-presenter ().
    do with frame {&frame-name}:
           &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN
        tenantdlg:Row = btnTenant:row + btnTenant:height +  frame {&frame-name}:row + 0.5.
        tenantdlg:Col =  fiTenant:col + frame {&frame-name}:col .
           &ELSE
        tenantdlg:Row = btnTenant:row + btnTenant:height +  frame {&frame-name}:row.
 
           &ENDIF
   
    tenantdlg:Title = "Select Tenant".
    glInSelect = true. /* stop end-error anywhere trigger */     
    if tenantdlg:Wait() then 
    do with frame {&frame-name}:
       fiTenant:screen-value = tenantdlg:ColumnValue("ttTenant.Name").
       apply "value-changed" to fiTenant.
    end.
    glInSelect = false.
   end.
 end.  


/* ************************  Function Implementations ***************** */

 
/*************************************************************/
/* Copyright (c) 1984-2007,2009 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

  File: prodict/sec/_sec-perm.p

  Description: Permissions editor for records in the _sec-granted-role
               table

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 4, 2005

  History: 
    kmcintos  May 24, 2005 Fixed code that checks if Audit Admin already 
                           exists 20050523-033.
    kmcintos  May 25, 2005 Fixed code that checks Grant/Revoke Perms for 
                           DBA 20050525-007.         
    kmcintos  May 27, 2005 Using guid for for hasChildren 20050526-026.
    kmcintos  May 27, 2005 Always reload role list in localDelete (After) 
                           20050527-023.
    kmcintos June 17, 2005 Made calls to security API more generic 
                           20050617-003.      
    kmcintos June 17, 2005 Tweaked security API to allow DBA Audit Admin
                           permissions when none exist 20050606-003.
    kmcintos June 17, 2005 Added localCancel event to apply local logic
                           after a cancel.
    kmcintos June 17, 2005 Added localFieldState routine and changed 
                           function calls in the security API 20050615-024.
    kmcintos June 21, 2005 Added VALUE-CHANGED trigger after save 20050621-011.
    kmcintos Aug 18, 2005  Increased format of gcUserId to x(40) 20050622-022.
    fernando Nov 03, 2005  Make sure 'grant' toggle-box is not selected by default
                           if scrolling through roles, after it gets sensitive again.
    fernando 11/30/07      Check if read-only mode.                           
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
{prodict/user/uservar.i}
{prodict/sec/sec-func.i}
{prodict/misc/misc-funcs.i}
{prodict/sec/ui-procs.i}

DEFINE VARIABLE gcRoles     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcGuid      AS CHARACTER   NO-UNDO.
DEFINE VARIABLE c_sec_mode  AS CHARACTER   NO-UNDO.

DEFINE VARIABLE glAdmin     AS LOGICAL     NO-UNDO.

DEFINE VARIABLE iRole       AS INTEGER     NO-UNDO.

IF checkReadOnly("DICTDB","_sec-granted-role") NE "" OR
   checkReadOnly("DICTDB","_sec-role") NE "" THEN
   RETURN.

c_sec_mode = user_env[9].

gcRoles = getPermissions(USERID("DICTDB"),c_sec_mode).

IF gcRoles EQ "" THEN DO:
  MESSAGE "You do not have permission to run this tool!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN.
END.


DEFINE VARIABLE cRole       AS CHARACTER   NO-UNDO.
DEFINE VARIABLE cPerm       AS CHARACTER   NO-UNDO.

DO iRole = 1 TO NUM-ENTRIES(gcRoles) BY 2:
  ASSIGN cRole   = ENTRY(iRole,gcRoles)
         cPerm   = ENTRY(iRole + 1,gcRoles)
         glAdmin = ((cPerm = "w" AND cRole = "dba") OR
                    (cRole = "_sys.audit.admin")).
  IF glAdmin THEN LEAVE.
END.

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */

DEFINE TEMP-TABLE sgRole RCODE-INFORMATION
    FIELD guid      AS CHARACTER FORMAT "x(40)"
    FIELD grantee   AS CHARACTER FORMAT "x(32)"  LABEL "UserId"
    FIELD role      AS CHARACTER FORMAT "x(32)"
    FIELD roledesc  AS CHARACTER FORMAT "x(40)"  LABEL "Permission"
    FIELD granter   AS LOGICAL                   LABEL "Can Grant"
    FIELD grantor   AS CHARACTER FORMAT "x(32)"  LABEL "Grantor"
    FIELD comments  AS CHARACTER FORMAT "x(300)" LABEL "Comments"
    FIELD deleted   AS LOGICAL
    INDEX guid AS PRIMARY UNIQUE guid.

DEFINE QUERY qRole FOR sgRole SCROLLING.

DEFINE BROWSE bRole QUERY qRole
    DISPLAY grantee
            roledesc
            grantor
            granter
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      ENABLE grantee
    &ENDIF
    WITH &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 5
         &ELSE 3 &ENDIF DOWN
         WIDTH &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 74
               &ELSE 70 NO-BOX &ENDIF.

DEFINE VARIABLE gcQuery       AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcPermissions AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcModFlds     AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcKeys        AS CHARACTER   NO-UNDO
     INITIAL "CTRL-A Grant  CTRL-S Save  CTRL-N/END-ERROR Cancel  DEL/CTRL-D Revoke"  .
DEFINE VARIABLE gcSort        AS CHARACTER   NO-UNDO INITIAL "roledesc".
DEFINE VARIABLE gcUserId      AS CHARACTER   NO-UNDO.

DEFINE VARIABLE glCanChange   AS LOGICAL     NO-UNDO.
DEFINE VARIABLE lImmedDisp    AS LOGICAL     NO-UNDO.

/* ********************  Preprocessor Definitions  ******************** */
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no

&Scoped-define LAYOUT-VARIABLE CURRENT-WINDOW-layout

/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS RECT-3 figrantee cbroledesc edcomments tbgranter btnDone btnCreate btnCancel btnDelete btnHelp 
&Scoped-Define DISPLAYED-OBJECTS figrantee cbroledesc figrantor edcomments tbgranter lblComments gcUserId 

/* ************************  Function Implementations ***************** */
FUNCTION generateKey RETURNS CHARACTER
  ( ) :
/*------------------------------------------------------------------------------
  Purpose:  Generate a new guid for the _granted-role-guid field.
    Notes:  
------------------------------------------------------------------------------*/

  RETURN generateGuid().

END FUNCTION.

FUNCTION hasChildren RETURNS LOGICAL
  ( INPUT pcRole    AS CHARACTER,
    INPUT pcGrantor AS CHARACTER,
    INPUT pcGuid    AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose: Returns whether or not the specified user has granted permissions,
           in the passed role, to any other users.
Parameters: INPUT pcRole    - Permission to check
            INPUT pcGrantor - User who granted the permission
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lChildren AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE hSGRole   AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cQuery    AS CHARACTER   NO-UNDO.

  CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".

  cQuery = "WHERE _grantor = ~'" + pcGrantor + "~'" +
           " AND _granted-role-guid NE ~'" + pcGuid + "~'".

  IF pcRole NE "_sys.audit.admin" THEN
    cQuery = cQuery + " AND _role-name = ~'" + pcRole + "~'".

  hSGRole:FIND-FIRST(cQuery,NO-LOCK) NO-ERROR.
  lChildren = hSGRole:AVAILABLE.

  DELETE OBJECT hSGRole.
  RETURN lChildren.

END FUNCTION.

/* Define a variable to store the name of the active layout.            */
DEFINE VAR CURRENT-WINDOW-layout AS CHAR INITIAL "Master Layout":U NO-UNDO.

/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnCancel 
     LABEL "Ca&ncel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnCreate 
     LABEL "&Grant" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnDelete 
     LABEL "&Revoke" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnDone
     LABEL "&Done" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnHelp 
     LABEL "&Help" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnSave 
     LABEL "&Save" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE VARIABLE cbroledesc AS CHARACTER 
     LABEL "Permission" FORMAT "x(75)"
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 50 BY 1 
       
     &ELSE SIZE 50 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE edcomments AS CHARACTER 
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 50 BY 5
     &ELSE SIZE 50.2 BY 2.86 &ENDIF NO-UNDO.

DEFINE VARIABLE figrantee AS CHARACTER FORMAT "X(75)":U 
     LABEL "UserId" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
     SIZE 50 BY 1
     &ELSE SIZE 50 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE figrantor AS CHARACTER FORMAT "X(256)":U 
     LABEL "Grantor" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 50 BY 1
     &ELSE SIZE 50.2 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE lblComments AS CHARACTER FORMAT "X(256)":U INITIAL "Comments:" 
      VIEW-AS TEXT 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .62 &ENDIF NO-UNDO.

DEFINE RECTANGLE RECT-3
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 74 BY 1
     &ELSE SIZE 74 BY 1.43 &ENDIF.

DEFINE VARIABLE tbgranter AS LOGICAL INITIAL no 
     LABEL "Can Grant Permissions for" 
     VIEW-AS TOGGLE-BOX
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 63 BY 1
     &ELSE SIZE 63 BY .81 &ENDIF NO-UNDO.


/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     figrantee
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 8 COL 11 COLON-ALIGNED
          &ELSE AT ROW 8 COL 10.8 COLON-ALIGNED &ENDIF
     cbroledesc
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 9 COL 11 COLON-ALIGNED
          &ELSE 
            AT ROW 9.1 COL 10.8 COLON-ALIGNED 
          &ENDIF
     figrantor
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 10 COL 11 COLON-ALIGNED
          &ELSE AT ROW 10.19 COL 10.8 COLON-ALIGNED &ENDIF
     edcomments
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 11 COL 13
          &ELSE                          
            AT ROW 11.29 COL 12.8 
          &ENDIF NO-LABEL
     tbgranter
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 
            AT ROW 15 COL 4 
          &ELSE AT ROW 14.19 COL 13 &ENDIF
     btnDone
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 17 COL 3
          &ELSE AT ROW 16.19 COL 3.4 &ENDIF
     btnCreate
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 17 COL 18
          &ELSE AT ROW 16.19 COL 16.2 &ENDIF
     btnSave
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 16 COL 28
          &ELSE AT ROW 16.19 COL 27.8 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 17 COL 41
          &ELSE AT ROW 16.19 COL 39.2 &ENDIF
     btnDelete
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 17 COL 52
          &ELSE AT ROW 16.19 COL 50.6 &ENDIF
     btnHelp
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 65
          &ELSE AT ROW 16.19 COL 63.8 &ENDIF
     lblComments
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 11 COL 2
          &ELSE AT ROW 11.33 COL 1.8 &ENDIF NO-LABEL
     RECT-3
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 2
          &ELSE AT ROW 15.95 COL 2 &ENDIF
     SPACE(0.99) SKIP
     gcUserId VIEW-AS TEXT FORMAT "x(40)" AT 2 NO-LABEL
    WITH &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 
           VIEW-AS DIALOG-BOX &ENDIF KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Edit Audit Permissions"
         DEFAULT-BUTTON btnDone.

DEFINE FRAME {&FRAME-NAME} 
    bRole AT COL 2.5 
             ROW &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN 2 &ELSE 1 &ENDIF.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  BROWSE bRole:HELP = "Press " + KBLABEL("CTRL-A") +
                      " to Grant new Permission or " + KBLABEL("DEL") +
                      " to Revoke selection".
  figrantee:HELP IN FRAME {&FRAME-NAME} = 
                "Enter userid then hit " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  cbroledesc:HELP IN FRAME {&FRAME-NAME} = 
                "Choose Permission then hit " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  edcomments:HELP IN FRAME {&FRAME-NAME} =
                "Enter data then hit " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  tbgranter:HELP IN FRAME {&FRAME-NAME} =
                "Hit spacebar to Select, " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
&ENDIF                

ghFrame = FRAME {&FRAME-NAME}:HANDLE.

gcKeyField = "_granted-role-guid,guid,CHAR".
gcDBBuffer = "DICTDB._sec-granted-role".
BROWSE bRole:SET-REPOSITIONED-ROW(&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 3
                                  &ELSE 2 &ENDIF).

ASSIGN FRAME Dialog-Frame:SCROLLABLE                     = FALSE
       FRAME Dialog-Frame:HIDDEN                         = TRUE
       edcomments:RETURN-INSERTED IN FRAME Dialog-Frame  = TRUE.

IF SESSION:DISPLAY-TYPE = 'TTY':U  THEN 
  RUN CURRENT-WINDOW-layouts (INPUT 'Standard Character':U) NO-ERROR.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame /* Edit Audit Permissions */ DO:
  APPLY "END-ERROR":U TO SELF.
END.

ON ENTRY OF cbroledesc IN FRAME Dialog-Frame /* Permission */ DO:
  DEFINE VARIABLE cLastValue AS CHARACTER NO-UNDO.
  
  cLastValue = SELF:SCREEN-VALUE.

  RUN loadPermissionList ( INPUT c_sec_mode,
                           INPUT "canGrant" ).
  cbroledesc:LIST-ITEM-PAIRS = gcPermissions.
  SELF:SCREEN-VALUE = cLastValue.  
END.

ON LEAVE OF cbroledesc IN FRAME Dialog-Frame /* Permission */ DO:
  DEFINE VARIABLE cLastValue AS CHARACTER NO-UNDO.
  
  cLastValue = SELF:SCREEN-VALUE.
  RUN loadPermissionList ( INPUT c_sec_mode,
                           INPUT "All" ).
  cbroledesc:LIST-ITEM-PAIRS = gcPermissions.
  SELF:SCREEN-VALUE = cLastValue.
END.

ON VALUE-CHANGED OF cbroledesc IN FRAME Dialog-Frame /* Permission */ DO:
  ASSIGN tbgranter:LABEL IN FRAME {&FRAME-NAME} = 
      "Can Grant Permissions for " + ENTRY(LOOKUP(SELF:SCREEN-VALUE,
                                                  SELF:LIST-ITEM-PAIRS) - 1,
                                           SELF:LIST-ITEM-PAIRS).
  RUN localFieldState ( INPUT "Trigger" ).
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN

  ON VALUE-CHANGED OF edcomments IN FRAME Dialog-Frame DO:
    IF glCreateMode EQ FALSE THEN DO: 
      IF (AVAILABLE sgRole      AND 
          SELF:SCREEN-VALUE NE sgRole.comments) THEN DO:
        ASSIGN SELF:MODIFIED          = TRUE
               BROWSE bRole:SENSITIVE = FALSE.
        RUN setButtonState ( INPUT "UpdateMode" ).
    
        IF NOT CAN-DO(gcModFlds,SELF:NAME) THEN
          gcModFlds = gcModFlds + (IF gcModFlds NE "" THEN "," ELSE "") + 
                      SELF:NAME.
      END.
      ELSE 
        ASSIGN SELF:MODIFIED = FALSE
               gcModFlds     = REPLACE(gcModFlds,SELF:NAME,"")
               gcModFlds     = TRIM(REPLACE(gcModFlds,",,",","),",").

      IF gcModFlds = "" THEN DO:
        ASSIGN SELF:MODIFIED          = FALSE
               BROWSE bRole:SENSITIVE = FALSE.
        RUN setButtonState ( INPUT "ResetMode" ).
      END.
    END.
  END.

  ON START-SEARCH OF BROWSE bRole DO:
    DEFINE VARIABLE cCol AS CHARACTER   NO-UNDO.

    IF NOT AVAILABLE sgRole THEN DO:
      APPLY "END-SEARCH" TO SELF.
      RETURN NO-APPLY.
    END.

    grwLastRowid = ROWID(sgRole).
    cCol = SELF:CURRENT-COLUMN:NAME.
    IF cCol = gcSort THEN
      gcSort = cCol + " DESC".
    ELSE gcSort = cCol.
    
    RUN openQuery.
    
    APPLY "END-SEARCH" TO SELF.
  END.
&ENDIF

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

ON VALUE-CHANGED OF bRole IN FRAME {&FRAME-NAME} DO:
  IF AVAILABLE sgRole THEN DO:
    glCanChange = canChange(sgRole.role,
                            sgRole.grantee,
                            sgRole.grantor,
                            USERID("DICTDB"),
                            c_sec_mode).
    
    gcGuid = sgRole.guid.
  END.

  RUN displayRecord.
  RUN setFieldState ( INPUT (IF glCanChange THEN "ResetMode" 
                             ELSE "DisableMode") ).
  RUN setButtonState ( INPUT (IF glCanChange THEN "ResetMode"
                              ELSE "DisableMode") ).
END.

ON DEL OF BROWSE bRole
  APPLY "CHOOSE" TO btnDelete IN FRAME {&FRAME-NAME}.

ON VALUE-CHANGED OF tbgranter IN FRAME Dialog-Frame DO:
  IF glCreateMode THEN LEAVE.

  IF (AVAILABLE sgRole AND 
      SELF:CHECKED NE sgRole.granter) OR
     (NOT AVAILABLE sgRole AND 
      SELF:CHECKED) THEN DO:
    RUN setButtonState ( INPUT "UpdateMode" ).
    ASSIGN SELF:MODIFIED          = TRUE
           BROWSE bRole:SENSITIVE = FALSE.
    
    IF NOT CAN-DO(gcModFlds,SELF:NAME) THEN
      gcModFlds = gcModFlds + (IF gcModFlds NE "" THEN "," ELSE "") + SELF:NAME.
  END.
  ELSE 
    ASSIGN SELF:MODIFIED = FALSE
           gcModFlds     = REPLACE(gcModFlds,SELF:NAME,"")
           gcModFlds     = TRIM(REPLACE(gcModFlds,",,",","),",").
  
  IF gcModFlds = "" THEN DO:
    RUN setButtonState ( INPUT "ResetMode" ).
    BROWSE bRole:SENSITIVE = FALSE.
  END.
END.

ON GO OF FRAME {&FRAME-NAME} DO:
  IF btnSave:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
    APPLY "CHOOSE" TO btnSave.
    RETURN NO-APPLY.
  END.
  ELSE APPLY "CHOOSE" TO btnDone IN FRAME {&FRAME-NAME}.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
  ON CTRL-A ANYWHERE DO:
    IF btnCreate:SENSITIVE IN FRAME {&FRAME-NAME} OR 
      (FOCUS = edcomments:HANDLE IN FRAME {&FRAME-NAME} AND
       gcModFlds EQ "") THEN
      APPLY "CHOOSE" TO btnCreate IN FRAME {&FRAME-NAME}.
    ELSE do:
        BELL.
        RETURN NO-APPLY.
    END.
  END.
             
  ON CTRL-N ANYWHERE DO:
    IF btnCancel:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
      IF FOCUS EQ edcomments:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
        IF gcModFlds NE "" THEN
          APPLY "CHOOSE" TO btnCancel IN FRAME {&FRAME-NAME}.
        ELSE RETURN NO-APPLY.
      END.
      ELSE APPLY "CHOOSE" TO btnCancel IN FRAME {&FRAME-NAME}.
    END.
    ELSE RETURN NO-APPLY.
  END.

  ON "ENTRY" OF edcomments IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode OR ronly THEN LEAVE.
  
    /* There is no "VALUE-CHANGED" event for TTY so we need to assume that
       when the user enters this field they intend to update it.  There is
       a corresponding LEAVE event which resets the state if no changes were
       made. */
    IF gcModFlds = "" THEN
      RUN setButtonState ( INPUT "UpdateMode" ).
  
    IF NOT CAN-DO(gcModFlds,SELF:NAME) THEN
      ASSIGN gcModFlds     = gcModFlds +
                             (IF gcModFlds NE "" THEN "," ELSE "") +
                             SELF:NAME
             SELF:MODIFIED = TRUE.
  END.

  ON "LEAVE" OF edcomments IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode OR ronly THEN LEAVE.
  
    /* If no modifications were made then leave */
    IF (AVAILABLE sgRole AND
        SELF:SCREEN-VALUE NE sgRole.comments) OR
       (NOT AVAILABLE sgRole    AND
        SELF:SCREEN-VALUE NE "" AND
        SELF:SCREEN-VALUE NE ?) THEN LEAVE.
      
    ELSE DO: /* If the field was not modified while we were here, reset it.
                If it was the only field in the modified list, reset the
                buttons and the list.*/
      ASSIGN SELF:MODIFIED = FALSE
             gcModFlds     = REPLACE(gcModFlds,SELF:NAME,"")
             gcModFlds     = TRIM(REPLACE(gcModFlds,",,",","),",").
    
      IF gcModFlds = "" THEN DO:
        ASSIGN SELF:MODIFIED          = FALSE
               BROWSE bRole:SENSITIVE = FALSE.
        RUN setButtonState ( INPUT "ResetMode" ).
      END.
    END.
    BROWSE bRole:SENSITIVE = TRUE.
  END.
&ENDIF

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
  
  PAUSE 0 NO-MESSAGE.
  lImmedDisp = SESSION:IMMEDIATE-DISPLAY.
  SESSION:IMMEDIATE-DISPLAY = TRUE.
  
  &GLOBAL-DEFINE MY-OBJECTS {&ENABLED-OBJECTS} bRole
  &UNDEFINE ENABLED-OBJECTS
  &GLOBAL-DEFINE ENABLED-OBJECTS {&MY-OBJECTS}
  {prodict/sec/sec-trgs.i
      &frame_name = "{&FRAME-NAME}"}

  gcUserId = "User ID: " + USERID("DICTDB").
  RUN enable_UI.
  
  RUN initializeUI.
  IF RETURN-VALUE = "Fatal" THEN
    APPLY "WINDOW-CLOSE" TO FRAME {&FRAME-NAME}.

  WAIT-FOR WINDOW-CLOSE OF FRAME {&FRAME-NAME}.
END.
SESSION:IMMEDIATE-DISPLAY = lImmedDisp.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY figrantee 
          cbroledesc 
          figrantor 
          edcomments 
          tbgranter 
          lblComments 
          gcUserId
      WITH FRAME Dialog-Frame.

  IF ronly THEN
     edcomments:READ-ONLY = YES.

  ENABLE RECT-3 WHEN NOT (SESSION:DISPLAY-TYPE = 'TTY':U ) 
         figrantee
         cbroledesc
         edcomments WHEN NOT ronly
         tbgranter 
         btnDone 
         btnCreate WHEN NOT ronly
         btnCancel 
         btnDelete WHEN NOT ronly
         bRole 
         btnHelp WHEN NOT (SESSION:DISPLAY-TYPE = 'TTY':U ) 
      WITH FRAME Dialog-Frame.

  VIEW FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Initialization of the User Interface, and global variables
  Parameters:  <none>
  Notes:   
------------------------------------------------------------------------------*/
  gcQuery = "FOR EACH _sec-granted-role WHERE " +
            (IF c_sec_mode = "a" THEN "" ELSE "NOT ") +
            "_sec-granted-role._role-name BEGINS ~'_sys.audit~'".

  ghBuffer   = BUFFER sgRole:HANDLE.
  gcFileName = "Edit " + (IF c_sec_mode = "a" THEN 
                            "Audit " ELSE "") + "Permissions".

  RUN loadPermissionList ( INPUT c_sec_mode,
                           INPUT "All" ).
  IF RETURN-VALUE = "Fatal" THEN
    RETURN "Fatal".

  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN gcFieldHandles      = STRING(figrantee:HANDLE)  + "," + "&1," +
                                 STRING(cbroledesc:HANDLE) + "," + "&2," +
                                 STRING(figrantor:HANDLE)  + "," + "&3," +
                                 STRING(edcomments:HANDLE) + "," + "&4," +
                                 STRING(tbgranter:HANDLE)  + ",&5"
           gcFieldInits        = SUBSTITUTE(gcFieldHandles,
                                            CHR(1) + "",
                                            CHR(1) + " ",
                                            CHR(1) + USERID("DICTDB"),
                                            CHR(1) + "",
                                            CHR(1) + "FALSE")
           gcFieldInits        = REPLACE(gcFieldInits,"," + CHR(1),CHR(1))
           gcCreateModeFields  = SUBSTITUTE(gcFieldHandles,
                                            "yes",
                                            "yes",
                                            "no",
                                            "yes",
                                            "yes")
           gcResetModeFields   = SUBSTITUTE(gcFieldHandles,
                                            "no",
                                            "no",
                                            "no",
                                            "iab",
                                            "iab")
           gcDisableModeFields = SUBSTITUTE(gcFieldHandles,
                                            "no",
                                            "no",
                                            "no",
                                            "no",
                                            "no")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&1","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&2","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&3","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&4","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&5","")
           gcDBFields          = "_grantee,_role-name,_grantor," + 
                                 "_custom-grant-detail,_grant-rights"
           gcTTFields          = "grantee,role,grantor,comments,granter".
  END.
  RUN loadRolesTT.
      
  cbroledesc:LIST-ITEM-PAIRS IN FRAME {&FRAME-NAME} = gcPermissions.

  ENABLE bRole WITH FRAME {&FRAME-NAME}.
 
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
    ASSIGN grantee:SENSITIVE IN BROWSE bRole = FALSE
           grantee:READ-ONLY IN BROWSE bRole = TRUE.
  &ENDIF

  FRAME {&FRAME-NAME}:TITLE = FRAME {&FRAME-NAME}:TITLE + " (" +
                              LDBNAME("DICTDB") + ")".

  RUN openQuery.
  APPLY "ENTRY" TO BROWSE bRole.
END PROCEDURE.

PROCEDURE loadPermissionList :
/*------------------------------------------------------------------------------
  Purpose:     Loads appropriate permissions from the _sec-role table.
  Parameters:  INPUT pcMode - Mode this dialog is running in e.g. 
                                "a" = Audit Permissions
                                "o" = Other Permissions 
               INPUT pcPerm - Permissions to load into list
                                "All" = All permissions pertinent to this mode
                                "canGrant" = Just the permissions I can Grant
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.
  DEFINE INPUT  PARAMETER pcPerm AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hSecRole AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery   AS HANDLE      NO-UNDO.

  CREATE BUFFER hSecRole FOR TABLE "DICTDB._sec-role" NO-ERROR.
  IF NOT VALID-HANDLE(hSecRole) THEN DO:
    MESSAGE "This Database doesn~'t contain the necessary tables for" SKIP
            "Permissions Maintenance operations!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "Fatal".
  END.

  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(hSecRole).
  hQuery:QUERY-PREPARE("FOR EACH _sec-role WHERE " + 
                       (IF pcMode EQ "a" THEN "" ELSE "NOT ") +
                       "_sec-role._role-name BEGINS ~'_sys.audit~'").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  gcPermissions = ",".
  DO WHILE NOT hQuery:QUERY-OFF-END:
    IF pcPerm EQ "All" OR
       canGrant(hSecRole::_role-name,gcRoles,c_sec_mode) THEN
      gcPermissions = gcPermissions + (IF gcPermissions NE "" THEN "," ELSE "") +
                      hSecRole::_role-description + "," + hSecRole::_role-name.
    hQuery:GET-NEXT().
  END.

  DELETE OBJECT hQuery.
  DELETE OBJECT hSecRole.
  RETURN "".
END PROCEDURE.

PROCEDURE loadRolesTT :
/*------------------------------------------------------------------------------
  Purpose:     Load existing permissions records into the sgRole temp-table
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSGRole   AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cRoleDesc AS CHARACTER   NO-UNDO.

  CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".

  CREATE QUERY hQuery.
  hQuery:SET-BUFFERS(hSGRole).
  hQuery:QUERY-PREPARE(gcQuery).
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  DO TRANSACTION:
    EMPTY TEMP-TABLE sgRole.
  END.

  DO WHILE NOT hQuery:QUERY-OFF-END:
    DO ON ERROR UNDO, LEAVE TRANSACTION:
      CREATE sgRole.
      cRoleDesc = getRoleDesc(hSGRole::_role-name).
      ASSIGN sgRole.guid     = hSGRole::_granted-role-guid
             sgRole.grantee  = hSGRole::_grantee
             sgRole.role     = hSGRole::_role-name
             sgRole.roledesc = cRoleDesc
             sgRole.granter  = hSGRole::_grant-rights
             sgRole.grantor  = hSGRole::_grantor
             sgRole.comments = hSGRole::_custom-grant-detail.
    END.
    hQuery:GET-NEXT().
  END.
  DELETE OBJECT hQuery.
  DELETE OBJECT hSGRole.
END PROCEDURE.

PROCEDURE localButtonState :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during the 
               setButtonState event.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.

  IF glCreateMode THEN RETURN "".

  DEFINE VARIABLE iPerm      AS INTEGER     NO-UNDO.

  DEFINE VARIABLE lCanGrant  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lCanChange AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lCanRevoke AS LOGICAL     NO-UNDO.

  IF NOT ronly THEN
  GRANT-BLK:
  DO iPerm = 1 TO NUM-ENTRIES(gcRoles) BY 2:
    lCanGrant = canGrant(ENTRY(iPerm,gcRoles),gcRoles,c_sec_mode).
    IF lCanGrant THEN LEAVE GRANT-BLK.
  END.

  lCanChange = canChange(cbroledesc:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                         figrantee:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                         figrantor:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                         USERID("DICTDB"),
                         c_sec_mode).

  lCanRevoke = (NOT ronly) AND 
               canRevoke(cbroledesc:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                         figrantee:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                         figrantor:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                         USERID("DICTDB"),
                         c_sec_mode).

  DO WITH FRAME {&FRAME-NAME}:

    ASSIGN btnCreate:SENSITIVE = lCanGrant AND (gcUIState NE "Update")
           btnSave:SENSITIVE   = (IF CAN-DO("Disable,Reset",gcUIState) THEN 
                                    FALSE 
                                  ELSE (IF btnSave:SENSITIVE THEN 
                                          (gcPermissions NE ",")
                                        ELSE btnSave:SENSITIVE))
           btnCancel:SENSITIVE = (IF CAN-DO("Disable,Reset",gcUIState) THEN 
                                    FALSE 
                                  ELSE (IF btnCancel:SENSITIVE THEN 
                                          (gcPermissions NE ",")
                                        ELSE btnCancel:SENSITIVE))
           btnDelete:SENSITIVE = (IF CAN-DO("Disable",gcUIState) THEN 
                                    FALSE 
                                  ELSE (lCanRevoke                            AND
                                        NOT CAN-DO("Create,Update",gcUIState) AND
                                        AVAILABLE sgRole)).
  END.
  RETURN "".
END PROCEDURE.

PROCEDURE localCancel:
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during a cancelRecord
               event.
  Parameters:  INPUT pcMode  -  Where we are in the cancel process
                                "Before" = Nothing has occurred yet
                                "After"  = All of the cancel logic has transpired
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.

  IF pcMode EQ "After" THEN
    APPLY "VALUE-CHANGED" TO BROWSE bRole.
END PROCEDURE.

PROCEDURE localCreate :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during a newRecord
               event.
  Parameters:  pcMode - Point of execution of standard behavior.  This is
                        either "Start", which is before standard behavior, or
                        "End", which is after standard behavior.
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE iField AS INTEGER     NO-UNDO.
  DEFINE VARIABLE hField AS HANDLE      NO-UNDO.

  IF pcMode = "Start" THEN
    BROWSE bRole:SENSITIVE = FALSE.
  
  IF pcMode = "End" THEN DO:
    DO iField = 1 TO NUM-ENTRIES(gcFieldHandles):
      hField = WIDGET-HANDLE(ENTRY(iField,gcFieldHandles)).
      hField:MODIFIED = TRUE.
    END.
  END.
  RETURN "".
END PROCEDURE.

PROCEDURE localDelete :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during the 
               deleteRecord event.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTxnLoc AS CHARACTER   NO-UNDO.
 
  DEFINE VARIABLE lDelete   AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lChildren AS LOGICAL     NO-UNDO.

  CASE pcTxnLoc:
    WHEN "Before" THEN DO:
      MESSAGE "Are you sure you want to revoke this permission?"
          VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lDelete.
      IF NOT lDelete THEN RETURN "Cancel".

      RUN setRowidForDelete ( INPUT QUERY qRole:PREPARE-STRING ).
      IF RETURN-VALUE NE "" THEN
        RETURN "Cancel".
      ELSE RETURN "".
    END.
    WHEN "After" THEN DO:
      lChildren = hasChildren(cbroledesc:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                              figrantee:SCREEN-VALUE IN FRAME {&FRAME-NAME},
                              gcGuid).
      IF lChildren THEN DO:
        RUN prodict/sec/_cascrvk.p 
            ( INPUT figrantee:SCREEN-VALUE IN FRAME {&FRAME-NAME},
              INPUT cbroledesc:SCREEN-VALUE IN FRAME {&FRAME-NAME},
              INPUT gcGuid ).
        RUN loadRolesTT.
      END.
      RUN openQuery.
      gcRoles = getPermissions(USERID("DICTDB"),c_sec_mode).
      RETURN "".
    END.
  END CASE.
END PROCEDURE.

PROCEDURE localDisplay :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during a displayRecord
               event.  
  Parameters:  <none>
  Notes:       This procedure is called from displayRecord in 
               prodict/sec/sec-funcs.i.
------------------------------------------------------------------------------*/
  IF NOT AVAILABLE sgRole THEN RETURN.

  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN cbroledesc:SCREEN-VALUE = sgRole.role 
           tbgranter:LABEL         = "Can Grant Permissions for " + 
                                     sgRole.roledesc.
  END.
  RETURN "".
END PROCEDURE.

PROCEDURE localFieldState:
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE lCanChange AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAdminRole AS LOGICAL     NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:

    lCanChange = canChange(cbroledesc:SCREEN-VALUE,
                           figrantee:SCREEN-VALUE,
                           figrantor:SCREEN-VALUE,
                           USERID("DICTDB"),
                           c_sec_mode).

    lAdminRole = (cbroledesc:SCREEN-VALUE = "_sys.audit.admin").
    
    IF c_sec_mode = "a" AND 
       (tbgranter:SCREEN-VALUE = "_sys.audit.admin" OR
        lCanChange) THEN
      ASSIGN tbgranter:CHECKED   = (IF lAdminRole THEN 
                                      TRUE 
                                    ELSE IF NOT tbgranter:SENSITIVE THEN FALSE ELSE tbgranter:CHECKED)
             tbgranter:SENSITIVE = (IF lAdminRole THEN FALSE ELSE lCanChange)
             tbgranter:MODIFIED  = (IF glCreateMode THEN 
                                      TRUE ELSE tbgranter:MODIFIED).
    ELSE IF glCreateMode THEN
      ASSIGN tbgranter:CHECKED   = (IF pcMode = "Trigger" THEN 
                                      FALSE ELSE tbgranter:CHECKED)
             tbgranter:SENSITIVE = TRUE
             tbgranter:MODIFIED  = TRUE.
    ELSE tbgranter:SENSITIVE = FALSE.
  END.
END PROCEDURE.

PROCEDURE localSave :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during a saveRecord
               event.
  Parameters:  INPUT pcTxnLoc - The location where this was called in respect
                                to the actual transaction.
  Notes:       "Before" = Before the transaction even begins
               "Start"  = At the start of the transaction, before anything is 
                          done
               "End"    = At the end of the transaction, after all logic has
                          executed
               "After"  = After the transaction has been commited.  
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTxnLoc AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hSGRole AS HANDLE      NO-UNDO.

  DO WITH FRAME {&FRAME-NAME}:
    CASE pcTxnLoc:
      WHEN "Before" THEN DO:
        IF glCreateMode THEN DO:
          IF figrantee:SCREEN-VALUE = "" OR
             figrantee:SCREEN-VALUE = ? THEN DO:
            MESSAGE "You must specify a user to assign this permission to!"
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            APPLY "ENTRY" TO figrantee.
            RETURN "Retry".
          END.
          IF cbroledesc:SCREEN-VALUE = "" OR
             cbroledesc:SCREEN-VALUE = ? THEN DO:
            MESSAGE "You must select a permission to assign!"
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            APPLY "ENTRY" TO cbroledesc.
            RETURN "Retry".
          END.
          CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".
          hSGRole:FIND-FIRST("WHERE _sec-granted-role._grantee = ~'" +
                                          figrantee:SCREEN-VALUE + "~' AND " +
                                          "_sec-granted-role._role-name = ~'" + 
                                          cbroledesc:SCREEN-VALUE + "~'",NO-LOCK) NO-ERROR.
          IF hSGRole:AVAILABLE THEN DO:
            MESSAGE figrantee:SCREEN-VALUE "has already been granted" 
                              getRoleDesc(cbroledesc:SCREEN-VALUE) "Permissions!" SKIP(1)
                             "Change Userid or Permission, or press the Cancel button."
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RETURN "Retry".
          END.
          DELETE OBJECT hSGRole.
        END.
        RETURN "".
      END.
      WHEN "Start"  THEN RETURN "".
      WHEN "End"    THEN RETURN "".
      WHEN "After"  THEN DO:
        IF glCreateMode THEN
          ASSIGN sgRole.role     = sgRole.role 
                 sgRole.roledesc = getRoleDesc(sgRole.role).
        
        gcRoles = getPermissions(USERID("DICTDB"),c_sec_mode).
        RUN openQuery.
        RETURN RETURN-VALUE.
      END.
    END CASE.
  END. /* Do with frame {&FRAME-NAME} */
END PROCEDURE.

PROCEDURE localTrig :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur after a trigger fires
               prodict/sec/sec-trgs.i
  Parameters:  INPUT pcTrigger - The event that was fired
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTrigger AS CHARACTER   NO-UNDO.

  CASE pcTrigger:
    WHEN "Create" THEN DO:
      APPLY "ENTRY" TO figrantee IN FRAME {&FRAME-NAME}.
      RETURN "".
    END.
    WHEN "Save" THEN DO:
      BROWSE bRole:SENSITIVE = TRUE.
      APPLY "VALUE-CHANGED" TO BROWSE bRole.
      RETURN "".
    END.
    WHEN "Cancel" THEN DO:
      BROWSE bRole:SENSITIVE = TRUE.
      RETURN "".
    END.
  END CASE.
END PROCEDURE.

PROCEDURE openQuery :
/*------------------------------------------------------------------------------
  Purpose:     Sets up and opens the query for the sgRole temp-table.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hQuery AS HANDLE      NO-UNDO.
  
  /* This is a static query but we prepare it like a dynamic query so
     that we can get the PREPARE-STRING later on for repositioning */
  hQuery = QUERY qRole:HANDLE.
  hQuery:QUERY-PREPARE("FOR EACH sgRole BY " + gcSort).
  hQuery:QUERY-OPEN().

  IF grwLastRowid NE ? THEN
    REPOSITION qRole TO ROWID grwLastRowid NO-ERROR.
  
  /* This fires off the display of the ui fields */
  APPLY "VALUE-CHANGED" TO BROWSE bRole.
    
  RETURN "".
END PROCEDURE.

PROCEDURE localClearFields:
  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN tbgranter:LABEL         = "Can Grant Permissions for "
           tbgranter:CHECKED       = FALSE.
  END.
END PROCEDURE.

PROCEDURE CURRENT-WINDOW-layouts:
  DEFINE INPUT PARAMETER layout AS CHARACTER                     NO-UNDO.
  DEFINE VARIABLE lbl-hndl AS WIDGET-HANDLE                      NO-UNDO.
  DEFINE VARIABLE widg-pos AS DECIMAL                            NO-UNDO.
  DEFINE VARIABLE hFrame   AS HANDLE                             NO-UNDO.
  
  hFrame = FRAME {&FRAME-NAME}:HANDLE.
  
  /* Copy the name of the active layout into a variable accessible to   */
  /* the rest of this file.                                             */
  CURRENT-WINDOW-layout = layout.

  CASE layout:
    WHEN "Master Layout" THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN
         &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
         hFrame:HIDDEN                = yes &ENDIF
         hFrame:HEIGHT                = 16.43 + 
                                        hFrame:BORDER-TOP + 
                                        hFrame:BORDER-BOTTOM
         hFrame:WIDTH                 = 76 + 
                                        hFrame:BORDER-LEFT + 
                                        hFrame:BORDER-RIGHT.

      ASSIGN
         btnCancel:HIDDEN             = yes
         btnCancel:COL                = 39.2
         btnCancel:HEIGHT             = .95
         btnCancel:ROW                = 16.19
         btnCancel:HIDDEN             = no.

      ASSIGN
         btnCreate:HIDDEN             = yes
         btnCreate:COL                = 16.2
         btnCreate:HEIGHT             = .95
         btnCreate:ROW                = 16.19
         btnCreate:HIDDEN             = no.

      ASSIGN
         btnDelete:HIDDEN             = yes
         btnDelete:COL                = 50.6
         btnDelete:HEIGHT             = .95
         btnDelete:ROW                = 16.19
         btnDelete:HIDDEN             = no.

      ASSIGN
         btnDone:HIDDEN               = yes
         btnDone:COL                  = 3.4
         btnDone:HEIGHT               = .95
         btnDone:ROW                  = 16.19
         btnDone:HIDDEN               = no.

      ASSIGN
         btnHelp:HIDDEN               = yes
         btnHelp:COL                  = 63.8
         btnHelp:HEIGHT               = .95
         btnHelp:ROW                  = 16.19
         btnHelp:HIDDEN               = no
         btnHelp:HIDDEN               = no.

      ASSIGN
         btnSave:HIDDEN               = yes
         btnSave:COL                  = 27.8
         btnSave:HEIGHT               = .95
         btnSave:ROW                  = 16.19
         btnSave:HIDDEN               = no.

      ASSIGN
         edcomments:HIDDEN            = yes
         edcomments:COL               = 12.8
         edcomments:HEIGHT            = 2.86
         edcomments:ROW               = 11.29
         edcomments:WIDTH             = 50.2
         edcomments:HIDDEN            = no.

      ASSIGN
         figrantee:HIDDEN             = yes
         widg-pos                     = figrantee:COL  
         figrantee:COL                = 12.8
         lbl-hndl                     = figrantee:SIDE-LABEL-HANDLE  
         lbl-hndl:COL                 = lbl-hndl:COL + 
                                        figrantee:COL   - widg-pos
         figrantee:HIDDEN             = no.

      ASSIGN
         figrantor:HIDDEN             = yes
         widg-pos                     = figrantor:COL  
         figrantor:COL                = 12.8
         lbl-hndl                     = figrantor:SIDE-LABEL-HANDLE  
         lbl-hndl:COL                 = lbl-hndl:COL + 
                                        figrantor:COL   - widg-pos
         widg-pos                     = figrantor:ROW  
         figrantor:ROW                = 10.19
         lbl-hndl                     = figrantor:SIDE-LABEL-HANDLE  
         lbl-hndl:ROW                 = lbl-hndl:ROW + 
                                        figrantor:ROW   - widg-pos
         figrantor:WIDTH              = 50.2
         figrantor:HIDDEN             = no.

      ASSIGN
         lblComments:HIDDEN           = yes
         lblComments:COL              = 1.8
         lblComments:HEIGHT           = .62
         lblComments:ROW              = 11.33
         lblComments:HIDDEN           = no.

      ASSIGN
         RECT-3:HIDDEN                = yes
         RECT-3:HEIGHT                = 1.43
         RECT-3:ROW                   = 15.95
         RECT-3:HIDDEN                = no
         RECT-3:HIDDEN                = no.

      ASSIGN
         tbgranter:HIDDEN             = yes
         tbgranter:COL                = 13
         tbgranter:HEIGHT             = .81
         tbgranter:ROW                = 14.19
         tbgranter:HIDDEN             = no.

      ASSIGN
         hFrame:VIRTUAL-HEIGHT        = 16.43 WHEN hFrame:SCROLLABLE
         &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
           hFrame:HIDDEN              = no &ENDIF.

    END.  /* Master Layout Layout Case */

    WHEN "Standard Character":U THEN DO WITH FRAME {&FRAME-NAME}:
      ASSIGN
         &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
           hFrame:HIDDEN              = yes &ENDIF
         hFrame:HEIGHT                = 19 +
                                        hFrame:BORDER-TOP + 
                                        hFrame:BORDER-BOTTOM
         hFrame:WIDTH                 = 75 + 
                                        hFrame:BORDER-LEFT + 
                                        hFrame:BORDER-RIGHT NO-ERROR.

      ASSIGN
         btnCancel:HIDDEN             = yes
         btnCancel:COL                = 44
         btnCancel:HEIGHT             = 1
         btnCancel:ROW                = 17
         btnCancel:HIDDEN             = no NO-ERROR.

      ASSIGN
         btnCreate:HIDDEN             = yes
         btnCreate:COL                = 18
         btnCreate:HEIGHT             = 1
         btnCreate:ROW                = 17
         btnCreate:HIDDEN             = no NO-ERROR.

      ASSIGN
         btnDelete:HIDDEN             = yes
         btnDelete:COL                = 57
         btnDelete:HEIGHT             = 1
         btnDelete:ROW                = 17
         btnDelete:HIDDEN             = no NO-ERROR.

      ASSIGN
         btnDone:HIDDEN               = yes
         btnDone:COL                  = 3
         btnDone:HEIGHT               = 1
         btnDone:ROW                  = 17
         btnDone:HIDDEN               = no NO-ERROR.

      
      ASSIGN
         btnHelp:HIDDEN               = yes
         btnHelp:COL                  = 72
         btnHelp:HEIGHT               = 1
         btnHelp:ROW                  = 14 NO-ERROR.

      ASSIGN
         btnSave:HIDDEN               = yes
         btnSave:COL                  = 31
         btnSave:HEIGHT               = 1
         btnSave:ROW                  = 17
         btnSave:HIDDEN               = no NO-ERROR.

      ASSIGN
         edcomments:HIDDEN            = yes
         edcomments:COL               = 13
         edcomments:HEIGHT            = 5
         edcomments:ROW               = 10
         edcomments:WIDTH             = 50
         edcomments:HIDDEN            = no NO-ERROR.

      ASSIGN
         figrantee:HIDDEN             = yes
         widg-pos                     = figrantee:COL  
         figrantee:COL                = 13
         figrantee:ROW                = 7
         lbl-hndl                     = figrantee:SIDE-LABEL-HANDLE  
         lbl-hndl:COL                 = lbl-hndl:COL + 
                                        figrantee:COL   - widg-pos
         lbl-hndl:ROW                 = 7
         figrantee:HIDDEN             = no NO-ERROR.

      ASSIGN
         figrantor:HIDDEN             = yes
         widg-pos                     = figrantor:COL  
         figrantor:COL                = 13
         lbl-hndl                     = figrantor:SIDE-LABEL-HANDLE  
         lbl-hndl:COL                 = lbl-hndl:COL + 
                                        figrantor:COL   - widg-pos
         widg-pos                     = figrantor:ROW           
         figrantor:ROW                = 10
         lbl-hndl                     = figrantor:SIDE-LABEL-HANDLE  
         lbl-hndl:ROW                 = lbl-hndl:ROW + 
                                        figrantor:ROW   - widg-pos
         figrantor:ROW                = 9
         lbl-hndl:ROW                 = 9
         figrantor:WIDTH              = 50
         figrantor:HIDDEN             = no NO-ERROR.

      ASSIGN
         lblComments:HIDDEN           = yes
         lblComments:COL              = 2
         lblComments:HEIGHT           = 1
         lblComments:ROW              = 10
         lblComments:HIDDEN           = no NO-ERROR.

      ASSIGN
         RECT-3:HIDDEN                = yes
         RECT-3:HEIGHT                = 1
         RECT-3:ROW                   = 14 NO-ERROR.

      ASSIGN
         tbgranter:HIDDEN             = yes
         tbgranter:COL                = 13
         tbgranter:HEIGHT             = 1
         tbgranter:ROW                = 15
         tbgranter:HIDDEN             = no NO-ERROR.

      ASSIGN
         cbroledesc:HIDDEN            = yes
         cbroledesc:ROW               = 8
         cbroledesc:WIDTH             = 50
         lbl-hndl                     = cbroledesc:SIDE-LABEL-HANDLE 
         lbl-hndl:ROW                 = 8
         cbroledesc:HIDDEN            = no NO-ERROR.

      ASSIGN 
         gcUserId:HIDDEN              = TRUE
         gcUserId:ROW                 = 18
         gcUserId:HIDDEN              = FALSE NO-ERROR.
             
      ASSIGN
         hFrame:VIRTUAL-HEIGHT        = 16.00 WHEN hFrame:SCROLLABLE
         &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
           hFrame:HIDDEN              = no &ENDIF NO-ERROR.

    END.  /* Standard Character Layout Case */

  END CASE.
END PROCEDURE.  /* CURRENT-WINDOW-layouts */
&Scoped-define WINDOW-NAME CURRENT-WINDOW
&Scoped-define FRAME-NAME Dialog-Frame
/*************************************************************/
/* Copyright (c) 1984-2012 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

  File: prodict/sec/_sec-sys.p

  Description: Maintenance dialog for _sec-authentication-system table.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 25, 2005

  History: 
    kmcintos May 24, 2005  Added validation for Domain Type field 20050524-013.
    kmcintos May 25, 2005  Removed return when not available from browse 
                           value-changed trigger 20050524-009.
                           
                           Also had to remove extra VALUE-CHANGED trigger and 
                           redefine some of the navigation logic.
    kmcintos May 26, 2005  Added validation to prevent saving a duplicate 
                           system 20050525-047.
    kmcintos June 7, 2005  Removed local help button trigger to allow the one 
                           in sec-trgs.i to fire.
    kmcintos Oct 21, 2005  Set initial value of _PAM-plug-in field to FALSE
                           when it's set from this UI 20050926-003.
    fernando 11/30/07      Check if read-only mode.
    rkamboj  08/16/11      Added new terminology for security items and windows. 
    rkamboj  04/04/2012    Added field "Enable Authentication" and "Callback" for the
                           PAM plug-in feature.
------------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.       */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

{prodict/sec/sec-func.i}
{prodict/sec/ui-procs.i}
{prodict/misc/misc-funcs.i}

/* Parameters Definitions ---                                           */

/* Local Variable Definitions ---                                       */
CREATE WIDGET-POOL.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to access this utility!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

IF checkReadOnly("DICTDB","_sec-authentication-system") NE "" THEN
   RETURN.

DEFINE VARIABLE hColumn AS HANDLE      NO-UNDO EXTENT 2.

DEFINE VARIABLE gcSort  AS CHARACTER   NO-UNDO INITIAL "dType".
DEFINE VARIABLE gcMods  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE inbuild AS LOGICAL     NO-UNDO.
DEFINE VARIABLE derr    AS LOGICAL     NO-UNDO.
DEFINE TEMP-TABLE saSys NO-UNDO RCODE-INFORMATION
    FIELD dType         AS CHARACTER LABEL "Domain Type"        FORMAT "x(25)"
    FIELD dDescrip      AS CHARACTER LABEL "Description"        FORMAT "x(65)"
    FIELD dDetails      AS CHARACTER LABEL "Comments" FORMAT "x(200)"
    FIELD dAuthEnabled  AS LOGICAL   LABEL "Enable Authentication"
    FIELD dCallback  AS CHARACTER LABEL "Callback" FORMAT "x(100)"
    INDEX idxSystem AS PRIMARY UNIQUE dType.

DEFINE QUERY qSystem FOR saSys SCROLLING.

DEFINE BROWSE bSystem QUERY qSystem
    DISPLAY dType
            dDescrip
    &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
      ENABLE dType &ENDIF
    WITH NO-ROW-MARKERS SEPARATORS 
         &IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 3 DOWN WIDTH 75 NO-BOX
         &ELSE 4 DOWN WIDTH 77.6  &ENDIF FIT-LAST-COLUMN.

/* ********************  Preprocessor Definitions  ******************** */

&Scoped-define PROCEDURE-TYPE Dialog-Box
&Scoped-define DB-AWARE no
&Scoped-define frame_name  Dialog-Frame
/* Name of designated FRAME-NAME and/or first browse and/or first query */
&Scoped-define FRAME-NAME Dialog-Frame

/* Standard List Definitions                                            */
&Scoped-Define ENABLED-OBJECTS bSystem fiType edDescrip edDetails btnCreate btnSave btnCancel btnDelete btnDone ~
authenabled  callback 

&Scoped-Define DISPLAYED-OBJECTS fiType edDescrip edDetails authenabled  callback  

/* ***********************  Control Definitions  ********************** */

/* Define a dialog box                                                  */

/* Definitions of the field level widgets                               */
DEFINE BUTTON btnCancel 
     LABEL "Ca&ncel" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnCreate 
     LABEL "&Create" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON btnDelete 
     LABEL "&Delete" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE BUTTON BtnDone 
     LABEL "&Done" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON BtnHelp DEFAULT 
     LABEL "&Help" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF
     BGCOLOR 8 .

DEFINE BUTTON btnSave 
     LABEL "&Save" 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 11 BY 1
     &ELSE SIZE 11 BY .95 &ENDIF.

DEFINE VARIABLE edDetails AS CHARACTER label "Comments"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 61 BY 4
     &ELSE SIZE 62.4 BY 2.91 &ENDIF NO-UNDO.

DEFINE VARIABLE fiType AS CHARACTER FORMAT "X(256)":U 
     LABEL "Domain Type" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 47 BY 1
     &ELSE SIZE 47 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE edDescrip AS CHARACTER label "Description"
     VIEW-AS EDITOR SCROLLBAR-VERTICAL
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 61 BY 4
     &ELSE SIZE 62.4 BY 2.91 &ENDIF NO-UNDO.
     
DEFINE VARIABLE authenabled  AS LOGICAL label "Enable Authentication"
     VIEW-AS TOGGLE-BOX NO-UNDO.     

DEFINE VARIABLE callback AS CHARACTER LABEL "Callback" 
     VIEW-AS FILL-IN SIZE &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN 48 
     &ELSE 51 &ENDIF BY 1 NO-UNDO FORMAT "x(100)". 
     
DEFINE BUTTON btnFile LABEL "File..." SIZE 10 BY .95.        
    
/*

DEFINE VARIABLE fiDescrip AS CHARACTER FORMAT "X(256)":U 
     LABEL "Description" 
     VIEW-AS FILL-IN 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 61 BY 1
     &ELSE SIZE 62.4 BY 1 &ENDIF NO-UNDO.
*/
 

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL 
     &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 78 BY 1
     &ELSE SIZE 78 BY 1.43 &ENDIF.

/* ************************  Frame Definitions  *********************** */

DEFINE FRAME Dialog-Frame
     bSystem
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 2 SKIP(1)
          &ELSE AT ROW 1.24 COL 1.8 &ENDIF
     fiType
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN COLON 14 SKIP
          &ELSE AT ROW 5.86 COL 14.6 COLON-ALIGNED &ENDIF
     edDescrip
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN COLON 14 SKIP
          &ELSE AT ROW 7 COL 14.6 COLON-ALIGNED &ENDIF
     
     callback
            &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN COLON 14  
            &ELSE AT ROW 10 COL 14.6 COLON-ALIGNED &ENDIF
     
     btnFile
            &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN COLON 64 SKIP 
            &ELSE AT ROW 10 COL 69 SKIP(1)  &ENDIF          
     
     authenabled
         &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN COLON 14 SKIP
         &ELSE AT ROW 11.00 COL 14.6 COLON-ALIGNED SKIP(1) &ENDIF
       
     edDetails 
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN  COLON 14  SKIP(1)
          &ELSE AT ROW 12.25 COL 14.6 COLON-ALIGNED  &ENDIF 
          
     BtnDone
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 2
          &ELSE AT ROW 15.78 COL 2.6 &ENDIF
     btnCreate
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 23
          &ELSE AT ROW 15.78 COL 17.8 &ENDIF
     btnSave
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 35
          &ELSE AT ROW 15.78 COL 29.2 &ENDIF
     btnCancel
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 47
          &ELSE AT ROW 15.78 COL 40.8 &ENDIF
     btnDelete
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT 59
          &ELSE AT ROW 15.78 COL 52.4 &ENDIF
     &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN               
       BtnHelp AT ROW 15.78 COL 67.4 
       RECT-1 AT ROW 15.55 COL 1.6 &ENDIF
     SPACE(0.00) SKIP(0.18)
    WITH &IF '{&WINDOW-SYSTEM}' <> 'TTY':U &THEN  
           VIEW-AS DIALOG-BOX &ENDIF KEEP-TAB-ORDER ROW 2 CENTERED
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Authentication Systems" 
         DEFAULT-BUTTON BtnDone.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN
  BROWSE bSystem:HELP = KBLABEL("CTRL-A") + "=Create  " + 
                        KBLABEL("DEL")    + "=Delete  " +
                        KBLABEL("GO")     + "=Save/Done".
  fiType:HELP IN FRAME {&FRAME-NAME} = 
                "Enter Domain Type then hit " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  edDescrip:HELP IN FRAME {&FRAME-NAME} =
                "Enter Description then hit " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
  edDetails:HELP IN FRAME {&FRAME-NAME} =
                "Enter Comments then hit " + KBLABEL("GO") +
                " to Save or " + KBLABEL("CTRL-N") + " to Cancel".
&ENDIF

/*{prodict/sec/sec-trgs.i                 */
/*      &frame_name    =   "Dialog-Frame"}*/
/* moved all sec-trgs.i code here, 'coz we need to do modifications in
"on choose of btnsave" button for inbuild types. */
{prodict/admnhlp.i}

DEFINE VARIABLE giContextId AS INTEGER     NO-UNDO.

ON CHOOSE OF btnCancel IN FRAME {&frame_name} DO:
  RUN cancelRecord.
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
     RUN localTrig ( INPUT "Cancel" ).
  IF derr THEN 
  DO:
      RUN setButtonState ( INPUT "ResetMode" ).
      RUN displayRecord.
      
  END.      
END.

ON CHOOSE OF btnCreate IN FRAME {&frame_name} DO:
  RUN newRecord.
  IF RETURN-VALUE = "Retry" THEN
    RETURN NO-APPLY.
  IF RETURN-VALUE = "Fatal" THEN DO:
    RUN cancelRecord.
    RETURN NO-APPLY.
  END.
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Create" ).
END.

ON CHOOSE OF btnDelete IN FRAME {&frame_name} DO:
  RUN deleteRecord.
  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Delete" ).
END.

ON CHOOSE OF btnSave   IN FRAME {&frame_name} DO:
  DEFINE VARIABLE locStr AS CHARACTER NO-UNDO.
  ASSIGN locStr = "0123456789"
         derr   = NO.
  IF index(locstr,substring(fiType:SCREEN-VALUE,1,1)) > 0 THEN 
  DO:
      MESSAGE "Invalid domain type entered!" SKIP
              "Please enter a correct type for this system."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.

          APPLY "ENTRY" TO fiType.
          derr = YES.
          RETURN "Retry".
  END.     
  
  IF NOT inbuild THEN  
  DO:
     RUN saveRecord.
     IF callback:SCREEN-VALUE <> "" THEN 
        ASSIGN authenabled:SENSITIVE    = TRUE.
     else
        ASSIGN authenabled:SENSITIVE    = FALSE.   
  END.   
  else
  DO:
      RUN localSave ( INPUT "Before" ).
      IF RETURN-VALUE NE "" THEN
         RETURN RETURN-VALUE.
      Find first DICTDB._sec-authentication-system 
         WHERE DICTDB._sec-authentication-system._domain-type = fiType:SCREEN-VALUE no-error.
      IF AVAILABLE DICTDB._sec-authentication-system THEN 
         ASSIGN DICTDB._sec-authentication-system._PAM-callback-procedure = callback:SCREEN-VALUE.
      FIND FIRST saSys WHERE saSys.dtype = fiType:SCREEN-VALUE NO-ERROR. 
      IF AVAILABLE saSys then
      DO:
         ASSIGN saSys.dCallBack = callback:SCREEN-VALUE.
         ghBuffer   = BUFFER saSys:HANDLE.
         grwLastRowid = ghBuffer:ROWID.
      END.   
      RUN localSave ( INPUT "After" ).
      RUN setButtonState ( INPUT "ResetMode" ).
      RUN setFieldState  ( INPUT "ResetMode" ).
      ASSIGN authenabled:SENSITIVE    = FALSE.      
  END.    
  
  IF RETURN-VALUE = "Retry" THEN
    RETURN NO-APPLY.
  IF RETURN-VALUE = "Fatal" THEN DO:
    RUN cancelRecord.
    RETURN NO-APPLY.
  END.
                  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Save" ).
  
  APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ON CHOOSE OF btnHelp   IN FRAME {&frame_name} OR 
     HELP OF FRAME {&frame_name} DO:
    
    DEFINE VARIABLE cUtility AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cSlash   AS CHARACTER   NO-UNDO.

    cSlash = &IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN "~\" &ELSE "~/" &ENDIF.

    cUtility = ENTRY(NUM-ENTRIES(THIS-PROCEDURE:FILE-NAME,cSlash),
                     THIS-PROCEDURE:FILE-NAME,
                     cSlash).

    CASE cUtility:
      WHEN "_sec-perm.p" THEN
        giContextId = {&Edit_Audit_Permissions_Dialog_Box}.
      WHEN "_sec-sys.p" THEN
        giContextId = {&Authentication_Systems_Dialog_Box}.
      WHEN "_sec-dom.p" THEN
        giContextId = {&Domains_Dialog_Box}.
      OTHERWISE
        giContextId = 0.
    END CASE.

    IF giContextId > 0 THEN
      RUN adecomm/_adehelp.p ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT giContextId,
                               INPUT ? ).
    ELSE
      MESSAGE "Help for File: {&FILE-NAME}" 
          VIEW-AS ALERT-BOX INFORMATION.
  END.
&ENDIF
  
ON CHOOSE OF btnDone   IN FRAME {&frame_name} DO:
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Done" ).
    
  APPLY "WINDOW-CLOSE" TO FRAME {&frame_name}.
END.

/* ***********  Runtime Attributes and AppBuilder Settings  *********** */

ASSIGN FRAME Dialog-Frame:SCROLLABLE       = FALSE
       FRAME Dialog-Frame:HIDDEN           = TRUE.

/* ************************  Functions  ************************ */

function isReadOnly returns logical(phBuffer as handle):
     return phBuffer:avail and phBuffer::dType begins "_". 
end function.    

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame /* Authentication Systems */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

ON CHOOSE OF BtnDone IN FRAME Dialog-Frame /* Done */
DO:
  APPLY "GO":U TO FRAME {&FRAME-NAME}.
END.

ON VALUE-CHANGED OF BROWSE bSystem DO:

  RUN displayRecord.
  IF ronly THEN DO:
      RUN setFieldState  ( INPUT "DisableMode" ).
      RUN setButtonState ( INPUT "DisableMode" ).
  END.
  ELSE DO:
      RUN setFieldState  ( INPUT "ResetMode" ).
      RUN setButtonState ( INPUT "ResetMode" ).
  END.
  
END.

ON GO OF FRAME {&FRAME-NAME} DO:
  IF btnSave:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
    APPLY "CHOOSE" TO btnSave.
    RETURN NO-APPLY.
  END.
  ELSE APPLY "CHOOSE" TO btnDone IN FRAME {&FRAME-NAME}.
END.

ON VALUE-CHANGED OF edDescrip IN FRAME {&FRAME-NAME} DO:
  IF glCreateMode THEN LEAVE.
  
  IF AVAILABLE saSys AND
     saSys.dDescrip NE SELF:SCREEN-VALUE THEN DO:
    RUN setButtonState ( INPUT "UpdateMode" ).
    BROWSE bSystem:SENSITIVE = FALSE.
    IF NOT CAN-DO(gcMods,SELF:NAME) THEN
      gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
               SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      BROWSE bSystem:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
END.  
ON VALUE-CHANGED OF authenabled IN FRAME {&FRAME-NAME} DO:
   IF AVAILABLE saSys AND
     saSys.dauthenabled NE LOGICAL(SELF:SCREEN-VALUE) THEN DO:
    RUN setButtonState ( INPUT "UpdateMode" ).
    BROWSE bSystem:SENSITIVE = FALSE.
    IF NOT CAN-DO(gcMods,SELF:NAME) THEN
      gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
               SELF:NAME.
  END.
  ELSE DO:
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      BROWSE bSystem:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
      
END.  
ON VALUE-CHANGED OF callback IN FRAME {&FRAME-NAME} DO:
  IF AVAILABLE saSys AND
     saSys.dcallback NE SELF:SCREEN-VALUE THEN DO:
     RUN setButtonState ( INPUT "UpdateMode" ).
    BROWSE bSystem:SENSITIVE = FALSE.
    IF NOT CAN-DO(gcMods,SELF:NAME) THEN
      gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
               SELF:NAME.

  END.
  ELSE DO:
     
    gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
    IF gcMods EQ "" OR
       gcMods EQ "," THEN DO:
      BROWSE bSystem:SENSITIVE = TRUE.
      gcMods = "".
      RUN setButtonState ( "ResetMode" ).
    END.
  END.
  
  IF NOT inbuild THEN 
  DO: 
     IF TRIM(callback:SCREEN-VALUE) <> "" THEN
       ASSIGN authenabled:SENSITIVE    = TRUE
              authenabled:SCREEN-VALUE = "yes".
     ELSE
       ASSIGN authenabled:SENSITIVE    = FALSE
              authenabled:SCREEN-VALUE = "no".     
  END.
END.     

ON LEAVE OF callback IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.
    
    IF AVAILABLE saSys AND
       saSys.dcallback NE SELF:SCREEN-VALUE THEN DO:
       RUN setButtonState ( INPUT "UpdateMode" ).
      BROWSE bSystem:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN  
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
    END.
    ELSE 
    DO:
        gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
        IF gcMods EQ "" OR
           gcMods EQ "," THEN 
        DO:
           BROWSE bSystem:SENSITIVE = TRUE.
           gcMods = "".
           RUN setButtonState ( "ResetMode" ).
        END.
    END.
END.  
  
&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ON START-SEARCH OF BROWSE bSystem DO:
    DEFINE VARIABLE cCol AS CHARACTER   NO-UNDO.

    cCol = SELF:CURRENT-COLUMN:NAME.
    self:clear-sort-arrows().
    cCol = SELF:CURRENT-COLUMN:NAME.
    IF gcSort EQ cCol THEN
    do:
       SELF:CURRENT-COLUMN:sort-ascending = false.
       gcSort = cCol + " DESC".
    end.
    ELSE do:
       SELF:CURRENT-COLUMN:sort-ascending = true. 
       gcSort = cCol.
    end.
     
    RUN openQuery.
    APPLY "END-SEARCH" TO SELF.
  END.
  
  ON VALUE-CHANGED OF edDetails IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.
    
    IF AVAILABLE saSys AND
       saSys.dDetails NE SELF:SCREEN-VALUE THEN DO:
      RUN setButtonState ( INPUT "UpdateMode" ).
      BROWSE bSystem:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN 
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
    END.
    ELSE DO:
      gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
      IF gcMods EQ "" OR 
         gcMods EQ "," THEN DO:
        BROWSE bSystem:SENSITIVE = TRUE.
        gcMods = "".
        RUN setButtonState ( "ResetMode" ).
      END.  
    END.
       
  END.
  
&ELSE

  ON ENTRY OF BROWSE bSystem DO:
    IF LAST-EVENT:WIDGET-LEAVE =
        btnDelete:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
      APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
      RETURN NO-APPLY.
    END.
  END.

  ON LEAVE OF btnCreate IN FRAME {&FRAME-NAME} DO:
    IF btnDelete:SENSITIVE IN FRAME {&FRAME-NAME} EQ FALSE THEN DO:
      APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
      RETURN NO-APPLY.
    END.
  END.
  
  ON ENTRY OF btnDone IN FRAME {&FRAME-NAME} DO:
    IF NOT ronly AND LAST-EVENT:WIDGET-LEAVE EQ 
         BROWSE bSystem:HANDLE  THEN DO:
      APPLY "ENTRY" TO btnCreate IN FRAME {&FRAME-NAME}.
      RETURN NO-APPLY.
    END.
  END.

  ON ENTRY OF btnCreate DO:
    IF LAST-EVENT:WIDGET-LEAVE =
        btnDone:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
      APPLY "ENTRY" TO BROWSE bSystem.
      RETURN NO-APPLY.
    END.
  END.
                  
  ON CTRL-A ANYWHERE DO:
    IF btnCreate:SENSITIVE IN FRAME {&FRAME-NAME} OR
       (FOCUS = edDetails:HANDLE IN FRAME {&FRAME-NAME} AND
        gcMods EQ "") THEN
      APPLY "CHOOSE" TO btnCreate IN FRAME {&FRAME-NAME}.
    ELSE RETURN NO-APPLY.
  END.
                                 
  ON DEL OF BROWSE bSystem DO:
    IF AVAILABLE saSys THEN
      APPLY "CHOOSE" TO btnDelete IN FRAME {&FRAME-NAME}.
  END.

  ON CTRL-N ANYWHERE DO:
    IF btnCancel:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
      IF FOCUS EQ edDetails:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
        IF gcMods NE "" THEN
          APPLY "CHOOSE" TO btnCancel IN FRAME {&FRAME-NAME}.
        ELSE RETURN NO-APPLY.
      END.
      ELSE APPLY "CHOOSE" TO btnCancel IN FRAME {&FRAME-NAME}.
    END.
    ELSE RETURN NO-APPLY.
  END.
                              
  ON ENTRY OF edDetails IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.
    
    RUN setButtonState ( INPUT "UpdateMode" ).
    BROWSE bSystem:SENSITIVE = FALSE.
  END.

  ON LEAVE OF edDetails IN FRAME {&FRAME-NAME} DO:
    IF glCreateMode THEN LEAVE.
    
    IF AVAILABLE saSys AND
       saSys.dDetails NE SELF:SCREEN-VALUE THEN DO:
       RUN setButtonState ( INPUT "UpdateMode" ).
      BROWSE bSystem:SENSITIVE = FALSE.
      IF NOT CAN-DO(gcMods,SELF:NAME) THEN  
        gcMods = gcMods + (IF gcMods NE "" THEN "," ELSE "") +
                 SELF:NAME.
    END.
    ELSE DO:
  
      gcMods = REPLACE(REPLACE(gcMods,SELF:NAME,""),",,",",").
      IF gcMods EQ "" OR
         gcMods EQ "," THEN DO:
        BROWSE bSystem:SENSITIVE = TRUE.
        gcMods = "".
        RUN setButtonState ( "ResetMode" ).
      END.
    END.
  END.
  
  ON ENTRY OF btnDelete IN FRAME {&FRAME-NAME} DO:
    IF LAST-EVENT:WIDGET-LEAVE = 
            edDetails:HANDLE IN FRAME {&FRAME-NAME} THEN DO:
      APPLY "ENTRY" TO btnCreate.
      RETURN NO-APPLY.
    END.
  END.

&ENDIF

/*----- HIT of FILE BUTTON -----*/
ON CHOOSE OF btnFile in frame {&FRAME-NAME} DO:
  DEFINE VARIABLE picked_ok AS logical NO-UNDO.
  DEFINE VARIABLE fname AS CHARACTER NO-UNDO.
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
    SYSTEM-DIALOG GET-FILE callback
       TITLE    "Find File" 
       FILTERS  "*.p"   "*.p",
                "*.*" "*.*"
       MUST-EXIST
       UPDATE   picked_ok.
       
    fname = callback.
  &ELSE  
    fname = callback:SCREEN-VALUE.
    RUN adecomm/_filecom.p ( INPUT "*.*", /* p_Filter */
                           INPUT "", /* p_Dir */
                           INPUT "", /* p_Drive */
                           INPUT NO, /* p_Save_As */
                           INPUT "Find File",
                           INPUT "MUST-EXIST",
                           INPUT-OUTPUT fname,
                           OUTPUT picked_ok ).
                              
  &ENDIF 
  IF picked_ok THEN
    DO: 
       callback:SCREEN-VALUE = fname.
       APPLY "VALUE-CHANGED" TO callback IN FRAME {&FRAME-NAME}.
    END.         
END.

ON END-ERROR ANYWHERE DO:
  IF btnCancel:SENSITIVE IN FRAME {&FRAME-NAME} THEN DO:
    APPLY "CHOOSE" TO btnCancel.
    APPLY "ENTRY" TO SELF.
    RETURN NO-APPLY.
  END.
END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME {&FRAME-NAME}:PARENT eq ?
THEN FRAME {&FRAME-NAME}:PARENT = ACTIVE-WINDOW.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  RUN enable_UI.
  RUN initializeUI.

  WAIT-FOR GO OF FRAME {&FRAME-NAME}.
END.
RUN disable_UI.

/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
/*------------------------------------------------------------------------------
  Purpose:     DISABLE the User Interface
  Parameters:  <none>
  Notes:       Here we clean-up the user-interface by deleting
               dynamic widgets we have created and/or hide 
               frames.  This procedure is usually called when
               we are ready to "clean-up" after running.
------------------------------------------------------------------------------*/
  /* Hide all frames. */
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

PROCEDURE enable_UI :
/*------------------------------------------------------------------------------
  Purpose:     ENABLE the User Interface
  Parameters:  <none>
  Notes:       Here we display/view/enable the widgets in the
               user-interface.  In addition, OPEN all queries
               associated with each FRAME and BROWSE.
               These statements here are based on the "Other 
               Settings" section of the widget Property Sheets.
------------------------------------------------------------------------------*/
  DISPLAY {&DISPLAYED-OBJECTS} 
      WITH FRAME Dialog-Frame.
  ENABLE {&ENABLED-OBJECTS}
         &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
           btnHelp RECT-1
         &ENDIF
      WITH FRAME Dialog-Frame.
  VIEW FRAME Dialog-Frame.
  {&OPEN-BROWSERS-IN-QUERY-Dialog-Frame}
END PROCEDURE.

PROCEDURE initializeUI :
/*------------------------------------------------------------------------------
  Purpose:     Initialization of the User Interface, and global variables
  Parameters:  <none>
  Notes:   
------------------------------------------------------------------------------*/
  ghBuffer   = BUFFER saSys:HANDLE.
  gcFileName = "Domains" /* "Security Authentication Systems" */ .

  DO WITH FRAME {&FRAME-NAME}:
    ASSIGN gcFieldHandles      = STRING(fiType:HANDLE)  + "," + "&1," +
                                 STRING(edDescrip:HANDLE)  + "," + "&2," +
                                 STRING(edDetails:HANDLE)  + "," + "&3," +
                                 STRING(authenabled:HANDLE)  + "," + "&4," +
                                 STRING(callback:HANDLE)  + "," + "&5"
           gcFieldInits        = SUBSTITUTE(gcFieldHandles,
                                            CHR(1) + "",
                                            CHR(1) + "",
                                            CHR(1) + "",
                                            CHR(1) + "",
                                            CHR(1) + "")
           gcFieldInits        = REPLACE(gcFieldInits,"," + CHR(1),CHR(1))
           gcCreateModeFields  = SUBSTITUTE(gcFieldHandles,
                                            "yes",
                                            "yes",
                                            "yes",
                                            "yes",
                                            "yes")
           gcResetModeFields   = SUBSTITUTE(gcFieldHandles,
                                            "no",
                                            "yes",
                                            "yes",
                                            "no",
                                            "no")
           gcDisableModeFields = SUBSTITUTE(gcFieldHandles,
                                            "no",
                                            "no",
                                            "no",
                                            "no",
                                            "no")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&1","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&2","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&3","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&4","")
           gcFieldHandles      = REPLACE(gcFieldHandles,",&5","")
           gcDBFields          = "_domain-type,_domain-type-description," +
                                 "_custom-detail,_PAM-plug-in,_PAM-callback-procedure"
           gcTTFields          = "dType,dDescrip,dDetails,dAuthEnabled,dCallback"
           ghFrame             = FRAME {&FRAME-NAME}:HANDLE
           gcKeyField          = "_domain-type,dType,CHAR"
           gcDBBuffer          = "DICTDB._sec-authentication-system".
  END.

  RUN loadSystems.
      
  &IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
    saSys.dType:READ-ONLY IN BROWSE bSystem = TRUE.
  &ENDIF

  FRAME {&FRAME-NAME}:TITLE = FRAME {&FRAME-NAME}:TITLE + " (" +
                              LDBNAME("DICTDB") + ")".

  IF ronly THEN DO:
      RUN setButtonState ( INPUT "DisableMode" ).
      RUN setFieldState  ( INPUT "DisableMode" ).
      btnFile:SENSITIVE = FALSE.
  END.
  ELSE DO:
      RUN setButtonState ( INPUT "ResetMode" ).
      RUN setFieldState  ( INPUT "ResetMode" ).
      btnFile:SENSITIVE = FALSE.
  END.
  RUN openQuery.

  APPLY "ENTRY" TO BROWSE bSystem.
  APPLY "VALUE-CHANGED" TO BROWSE bSystem.
END PROCEDURE.

PROCEDURE loadSystems:
  DEFINE VARIABLE hSASys AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery AS HANDLE      NO-UNDO.

  CREATE BUFFER hSASys FOR TABLE "DICTDB._sec-authentication-system".
  CREATE QUERY hQuery.

  hQuery:SET-BUFFERS(hSASys).
  hQuery:QUERY-PREPARE("FOR EACH _sec-authentication-system NO-LOCK").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  DO WHILE NOT hQuery:QUERY-OFF-END:
    DO TRANSACTION ON ERROR UNDO, NEXT:
      CREATE saSys.
      ASSIGN dType        = hSASys::_domain-type
             dDescrip     = hSASys::_domain-type-description
             dDetails     = hSASys::_custom-detail
             dAuthEnabled = hSASys::_PAM-plug-in
             dCallBack    = hSASys::_PAM-callback-procedure.
    END.
    hQuery:GET-NEXT().
  END.

  DELETE OBJECT hSASys.
  DELETE OBJECT hQuery.
END PROCEDURE.

PROCEDURE localDelete :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during the 
               deleteRecord event.
  Parameters:  <none>
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTxnLoc AS CHARACTER   NO-UNDO.
 
  DEFINE VARIABLE lDelete   AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lChildren AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE hDom      AS HANDLE      NO-UNDO.

  CASE pcTxnLoc:
    WHEN "Before" THEN DO 
        WITH FRAME {&FRAME-NAME}:
      CREATE BUFFER hDom FOR TABLE "DICTDB._sec-authentication-domain".
      hDom:FIND-FIRST("WHERE _domain-type = ~'" + fiType:SCREEN-VALUE +
                      "~'",NO-LOCK) NO-ERROR.
      lChildren = hDom:AVAILABLE.
      IF lChildren THEN DO:
        MESSAGE "There are Domains defined against this System. you must " +
                "delete all dependant Domains before deleting a System!"
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RETURN "Cancel".
      END.

      MESSAGE "Are you sure you want to delete this system?"
          VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lDelete.
      IF NOT lDelete THEN RETURN "Cancel".

      RUN setRowidForDelete (INPUT QUERY qSystem:PREPARE-STRING ).
      IF RETURN-VALUE NE "" THEN
        RETURN "Cancel".
      ELSE RETURN "".
    END.
    WHEN "After" THEN DO:
      RUN openQuery.
      RETURN "".
    END.
  END CASE.
END PROCEDURE.

PROCEDURE localSave :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur during a saveRecord
               event.
  Parameters:  INPUT pcTxnLoc - The location where this was called in respect
                                to the actual transaction.
  Notes:       "Before" = Before the transaction even begins
               "Start"  = At the start of the transaction, before anything is 
                          done
               "End"    = At the end of the transaction, after all logic has
                          executed
               "After"  = After the transaction has been commited.  
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTxnLoc AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hAuthSys AS HANDLE NO-UNDO.
  DEFINE VARIABLE ans      AS LOGICAL NO-UNDO.
  DEFINE VARIABLE err      AS LOGICAL NO-UNDO.
        
  CASE pcTxnLoc:
    WHEN "Before" THEN DO WITH FRAME {&FRAME-NAME}:
      IF fiType:SCREEN-VALUE EQ "" OR
         fiType:SCREEN-VALUE EQ ? THEN DO:
        MESSAGE "You must enter a domain type for this system."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        APPLY "ENTRY" TO fiType.
        RETURN "Retry".
      END.
      IF glCreateMode THEN DO:
        CREATE BUFFER hAuthSys FOR TABLE "DICTDB._sec-authentication-system".
        hAuthSys:FIND-FIRST("WHERE _domain-type = ~"" +
                            fiType:SCREEN-VALUE + "~"",NO-LOCK) NO-ERROR.
        IF hAuthSys:AVAILABLE THEN DO:
          MESSAGE "A system already exists of this type!" SKIP(1)
                  "Please enter a unique domain type for this system."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.

          APPLY "ENTRY" TO fiType.
          RETURN "Retry".
        END.
      END. /* If glCreateMode */
            
      IF AVAILABLE saSys AND saSys.dcallback NE callback:SCREEN-VALUE THEN
      DO:
           IF SEARCH(callback:SCREEN-VALUE) = ? THEN
             err = yes.
           else
             err = NO.
      END.    
      ELSE IF NOT AVAILABLE saSys AND SEARCH(callback:SCREEN-VALUE) = ? THEN
      err = YES.
     
      IF TRIM(callback:SCREEN-VALUE) = "" THEN 
         ASSIGN err = NO.
        
      IF err THEN 
      DO:
           MESSAGE "The " + callback:SCREEN-VALUE + 
                   " file does not exist." Skip 
                   "Confirm that you want to save this as the callback procedure?"
           VIEW-AS ALERT-BOX QUESTION BUTTON YES-NO UPDATE ans.
           IF NOT ans THEN
           DO:
               APPLY "ENTRY" TO callback.
               RETURN "Retry". 
           END.
      END.       
      IF INDEX(callback:SCREEN-VALUE,".cls") > 0 THEN 
      DO:
          MESSAGE "Classes are currently not supported as callback." skip 
                  "Confirm that you want to save this as the callback procedure?"
           VIEW-AS ALERT-BOX QUESTION BUTTON YES-NO UPDATE ans.
           IF NOT ans THEN
           DO:
               APPLY "ENTRY" TO callback.
               RETURN "Retry". 
           END.
      END.    
      RETURN "".           
    END. /* When Before */

    WHEN "After" THEN DO:
      RUN openQuery.
      RETURN "".
    END.
  END CASE.
  
END PROCEDURE.

PROCEDURE localTrig :
/*------------------------------------------------------------------------------
  Purpose:     Local hook for additional logic to occur after a trigger fires
               prodict/sec/sec-trgs.i
  Parameters:  INPUT pcTrigger - The event that was fired
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcTrigger AS CHARACTER   NO-UNDO.

  CASE pcTrigger:
    WHEN "Create" THEN DO:
      APPLY "ENTRY" TO fiType IN FRAME {&FRAME-NAME}.
      BROWSE bSystem:SENSITIVE = FALSE.
      RETURN "".
    END.
    WHEN "Save" THEN DO:
      BROWSE bSystem:SENSITIVE = TRUE.
      RETURN "".
    END.
    WHEN "Cancel" THEN DO:
      BROWSE bSystem:SENSITIVE = TRUE.
      RETURN "".
    END.
  END CASE.
END PROCEDURE.

procedure localFieldState:
/*------------------------------------------------------------------------------
        Purpose:                                                                      
        Notes:                                                                        
------------------------------------------------------------------------------*/
  define input  parameter pcMode as character no-undo.
  define variable lok as logical no-undo.
  
  if pcMode = "CreateMode":u then 
  do with frame {&frame-name}:
      /* use read-only for editors */
      assign
          edDescrip:read-only = false 
          edDetails:read-only = FALSE
          btnFile:SENSITIVE = TRUE
          authenabled:SCREEN-VALUE = "no"
          authenabled:SENSITIVE = FALSE
          inbuild               = no.     
  end.
  else if pcMode = "ResetMode":u then 
  do:
      /* don't enable fields for built-ins - category = 0 user defined
         (finame is always disabled in edit mode   
          tbEnabled is defined as "iab" and handled in ui-procs.i */
      if ghbuffer:avail 
      and not isReadOnly(ghBuffer) then
      do with frame {&frame-name}:
            /* use read-only for editors */
           
          assign
              edDescrip:read-only = false 
              edDetails:read-only = false
              inbuild               = no.  
          IF callback:SCREEN-VALUE = "" THEN 
             authenabled:SENSITIVE = FALSE.
          ELSE 
             authenabled:SENSITIVE = TRUE.                  
      end.     
      
      else do:
            /* use read-only for editors */
           
          assign
              edDescrip:read-only = true 
              edDetails:read-only = true
              authenabled:SENSITIVE = false
              inbuild               = yes.         
      end. 
      ASSIGN btnFile:SENSITIVE     = TRUE 
             callback:SENSITIVE    = TRUE.
             
  end.
end procedure.


PROCEDURE openQuery:
  DEFINE VARIABLE hQuery AS HANDLE      NO-UNDO.
  
  /* This is a static query but we prepare it like a dynamic query so
     that we can get the PREPARE-STRING later on for repositioning */
  hQuery = QUERY qSystem:HANDLE.
  hQuery:QUERY-PREPARE("FOR EACH saSys BY " + gcSort).
  hQuery:QUERY-OPEN().

  IF grwLastRowid NE ? THEN
    REPOSITION qSystem TO ROWID grwLastRowid NO-ERROR.
  
  /* This fires off the display of the ui fields */
  APPLY "VALUE-CHANGED" TO BROWSE bSystem.
    
  RETURN "".
END PROCEDURE.

&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Include 
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

File        : prodict/sec/sec-func.i
Purpose     : Definitions of common routines, used specifically in
              the security section of the Data Administration Tool

Syntax      :

Description :

Author(s)   : Kenneth S. McIntosh
Created     : April 4, 2005

History     : 
  kmcintos  May 24, 2005 Added sanity checks in canGrant 20050523-033.
  kmcintos  May 27, 2005 Moved hasChildren back to _sec-perm.p 20050526-026.
  kmcintos June 17, 2005 Made security API more generic 20050617-003.
  kmcintos June 17, 2005 Tweaked permissions API to allow DBAs to be 
                         Audit Administrators when there aren't any 
                         20050606-003.  
  kmcintos June 17, 2005 Refined canChange/canRevoke logic 20050615-024.
  kmcintos June 21, 2005 Refined canGrant logic to ignore dba in some
                         cases 20050621-011.
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD canChange Include 
FUNCTION canChange RETURNS LOGICAL
  ( INPUT pcPerm           AS CHARACTER,
    INPUT pcGrantee        AS CHARACTER,
    INPUT pcGrantor        AS CHARACTER,
    INPUT pcUser           AS CHARACTER,
    INPUT pcMode           AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD canGrant Include 
FUNCTION canGrant RETURNS LOGICAL
  ( INPUT pcRole           AS CHARACTER,
    INPUT pcPermissionList AS CHARACTER,
    INPUT pcMode           AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD canRevoke Include 
FUNCTION canRevoke RETURNS LOGICAL
  ( INPUT pcRole    AS CHARACTER,
    INPUT pcGrantee AS CHARACTER,
    INPUT pcGrantor AS CHARACTER,
    INPUT pcUser    AS CHARACTER,
    INPUT pcMode    AS CHARACTER ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getPermissions Include 
FUNCTION getPermissions RETURNS CHARACTER
  ( INPUT pcUserID AS CHARACTER,
    INPUT pcMode   AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getRoleDesc Include 
FUNCTION getRoleDesc RETURNS CHARACTER
  ( INPUT pcRoleName AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD hasRole Include 
FUNCTION hasRole RETURNS LOGICAL
  ( INPUT pcUser    AS CHARACTER,
    INPUT pcRole    AS CHARACTER,
    INPUT plGranter AS LOGICAL ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD roleAvailable Include 
FUNCTION roleAvailable RETURNS LOGICAL
  ( INPUT pcRoleName AS CHARACTER ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD whoGranted Include 
FUNCTION whoGranted RETURNS CHARACTER
  ( INPUT pcRole    AS CHARACTER,
    INPUT pcGrantee AS CHARACTER )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Include
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: INCLUDE-ONLY
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Include ASSIGN
         HEIGHT             = 15
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Include 


/* ***************************  Main Block  *************************** */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Implementations ***************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION canChange Include 
FUNCTION canChange RETURNS LOGICAL
  ( INPUT pcPerm           AS CHARACTER,
    INPUT pcGrantee        AS CHARACTER,
    INPUT pcGrantor        AS CHARACTER,
    INPUT pcUser           AS CHARACTER,
    INPUT pcMode           AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose: Returns whether the specified user has rights to change a specific
           permission record.
Parameters: INPUT pcPerm           - Permission to change
            INPUT pcGrantee        - Grantee of the permission
            INPUT pcGrantor        - Grantor of the permission
            INPUT pcUser           - User attempting to change the permission
            INPUT pcMode           - Operating Mode
                                     "a" = Auditing
                                     no others implemented at this time
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lAudAdmin   AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAdminRole  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lDBA        AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAdminAvail AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE cPerms      AS CHARACTER   NO-UNDO.

  /* Get the user's current list permissions */
  cPerms = getPermissions(pcUser,pcMode).

  /* If this applies to Auditing permissions */
  IF pcMode = "a" THEN DO:
    ASSIGN lAudAdmin   = CAN-DO(cPerms,"_sys.audit.admin")
           lAdminRole  = INDEX(pcPerm,"audit.admin") > 0
           lDBA        = CAN-DO(cPerms,"dba")
           lAdminAvail = roleAvailable("_sys.audit.admin").

    /* If the user is an audit admin he has the ability to 
       change all audit related permissions, even audit admin. */
    IF lAudAdmin THEN DO:
      /* Audit admin can change any audit permission besides admin, so just
         return true if this is the case */
      IF NOT lAdminRole THEN
        RETURN TRUE.

      /* If this is an admin role and there is more than one audit administrator
         then an audit admin can change it */
      IF lAdminRole AND 
         lAdminAvail EQ ? THEN
        RETURN TRUE.
    END. /* If the user is an audit admin */

    /* If this is the last audit admin, and the user is a DBA */
    IF lAdminRole AND 
       lDBA       AND 
       (lAdminAvail = TRUE) THEN
      RETURN TRUE.

    /* If the user has grant-rights for the specified role and
       it's not an admin role and the user was the grantor */
    IF LOOKUP(pcPerm,cPerms) > 0                     AND
       ENTRY(LOOKUP(pcPerm,cPerms) + 1,cPerms) = "w" AND
       NOT lAdminRole                                AND
       (pcGrantor EQ pcUser) THEN
      RETURN TRUE.

    /* If there are no audit administrators and the user is a DBA */
    IF (lAdminAvail = FALSE) AND
       lDBA THEN
      RETURN TRUE.

  END. /* pcMode = "a" */
  ELSE
    /* We have no rules for non audit related permissions, at this point.
       This code will have to change when Security is introduced to the 
       product. */
    RETURN (CAN-DO(cPerms,"dba")).

  RETURN FALSE.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION canGrant Include 
FUNCTION canGrant RETURNS LOGICAL
  ( INPUT pcRole           AS CHARACTER,
    INPUT pcPermissionList AS CHARACTER,
    INPUT pcMode           AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose: Returns whether the current permissions allow to grant a specified
           permission.
Parameters: INPUT pcRole           - Permission to grant
            INPUT pcPermissionList - List of permissions 
            IUNPUT pcMode          - Security Mode
                                     "a" = "Auditing"
                                     no others implemented
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lCanGrant   AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAdminAvail AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE hSecRole    AS HANDLE      NO-UNDO.

  /* If we're in auditing mode and this isn't an auditing permission
     then return false.  Or if we're not in auditing mode and it IS
     an auditing permission return false. */
  IF (pcMode = "a" AND
      INDEX(pcRole,".audit.") = 0) OR
     (pcMode NE "a" AND
      INDEX(pcRole,".audit.") NE 0) THEN
    lCanGrant = FALSE.

  IF pcRole NE "dba" THEN DO:
    CREATE BUFFER hSecRole FOR TABLE "DICTDB._sec-role".

    /* Check to see if this role even exists in the role table */
    hSecRole:FIND-FIRST("WHERE _role-name = ~"" + pcRole + "~"",NO-LOCK) NO-ERROR.
    IF NOT hSecRole:AVAILABLE THEN RETURN FALSE.
  END.

  IF pcRole NE "dba" AND pcMode EQ "a" THEN
    /* If the given role is in the list, followed by a "w", the user has
       permission to grant it. */
    lCanGrant = 
          (ENTRY(LOOKUP(pcRole,pcPermissionList) + 1,pcPermissionList) = "w").
  
  /* Initial value of logicals is FALSE, so this works for both worlds. 
     This will only affect the outcome of the next statement down if we're 
     in auditing mode. */
  IF pcMode = "a" THEN
    lAdminAvail = roleAvailable("_sys.audit.admin").

  /* If there's no Audit Admin and the user is a dba, then that's ok. */
  IF NOT lCanGrant AND 
     CAN-DO(pcPermissionList,"dba") AND
     lAdminAvail = FALSE THEN
    lCanGrant = TRUE.

  RETURN lCanGrant.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION canRevoke Include 
FUNCTION canRevoke RETURNS LOGICAL
  ( INPUT pcRole    AS CHARACTER,
    INPUT pcGrantee AS CHARACTER,
    INPUT pcGrantor AS CHARACTER,
    INPUT pcUser    AS CHARACTER,
    INPUT pcMode    AS CHARACTER ):
/*------------------------------------------------------------------------------
  Purpose: Returns whether the specified user has rights to revoke a specific
           permission record.
Parameters: INPUT pcRole           - Permission to revoke
            INPUT pcGrantee        - Grantee of the permission
            INPUT pcGrantor        - Grantor of the permission
            INPUT pcUser           - User attempting to revoke the permission
            INPUT pcMode           - Operating Mode
                                     "a" = Auditing
                                     no others implemented at this time
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lAdminRole  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lDBA        AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAudAdmin   AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lCanRevoke  AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lAdminAvail AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE cPerms      AS CHARACTER   NO-UNDO.
                             
  cPerms = getPermissions(pcUser,pcMode).
  IF pcMode = "a" THEN DO:
    ASSIGN lAdminRole  = LOOKUP("audit.admin",pcRole,".") > 0
           lDBA        = CAN-DO(cPerms,"dba")
           lAudAdmin   = INDEX(cPerms,"audit.admin") > 0
           lAdminAvail = roleAvailable("_sys.audit.admin").

    /* If the user is an audit admin he has the ability to 
       revoke all audit related permissions, even audit admin. */
    IF lAudAdmin THEN DO:
      /* Audit admin can revoke any audit permission besides admin, so just
         return true if this is the case */
      IF NOT lAdminRole THEN
        RETURN TRUE.

      /* If this is an admin role and there is more than one audit administrator
         then an audit admin can revoke it */
      IF lAdminRole AND 
         lAdminAvail EQ ? THEN
        RETURN TRUE.
    END. /* If the user is an audit admin */

    /* If this is the last audit admin, and the user is a DBA */
    IF lAdminRole AND 
       lDBA       AND 
       (lAdminAvail = TRUE) THEN
      RETURN TRUE.

    /* If the user has grant-rights for the specified role and
       it's not an admin role and the user was the grantor */
    IF LOOKUP(pcRole,cPerms) > 0                     AND
       ENTRY(LOOKUP(pcRole,cPerms) + 1,cPerms) = "w" AND
       NOT lAdminRole                                AND
       (pcGrantor EQ pcUser) THEN
      RETURN TRUE.

    /* If there are no audit administrators and the user is a DBA */
    IF (lAdminAvail = FALSE) AND
       lDBA THEN
      RETURN TRUE.

    RETURN FALSE.
  END. /* Auditing mode */

  RETURN FALSE.
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getPermissions Include 
FUNCTION getPermissions RETURNS CHARACTER
  ( INPUT pcUserID AS CHARACTER,
    INPUT pcMode   AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  Lists the permissions the specified user holds in the currently
            connected database, along with whether those permissions are 
            "read/write" or "read" only.
Parameters: INPUT pcUserID - UserID of user to get permissions for. 
            INPUT pcMode   - Operating Mode
                             "a" = Auditing
                             No others implemented at this time
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSGRole      AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery       AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hSecRole     AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cPermissions AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cRight       AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE lAuditAdmin  AS LOGICAL     NO-UNDO.

  /* The rule is... If there is only one Audit Administrator, the
     DBA can delete the Audit Administrator from the DB.  If there 
     are more than one Audit Administrator, they can only be deleted
     by another Audit Administrator.  Kind of a hole, but necessary. 

     This code block adds DBA as the first permission and indicates 
     that he can delete Audit Administrator roles by placing a "w"
     in the next slot after DBA.  Otherwise DBA is followed by "r" */
  IF hasRole(pcUserID,"dba",FALSE) THEN DO:
    lAuditAdmin = roleAvailable("_sys.audit.admin").
    IF (lAuditAdmin = ?) THEN
      cPermissions = "dba," + (IF pcMode = "a" THEN "r" ELSE "w").
    ELSE cPermissions = "dba,w".
  END.

  /* Is this user an Audit Administrator? */
  lAuditAdmin = hasRole(pcUserID,"_sys.audit.admin",FALSE).

  CREATE BUFFER hSGRole  FOR TABLE "DICTDB._sec-granted-role".
  CREATE BUFFER hSecRole FOR TABLE "DICTDB._sec-role".

  CREATE QUERY hQuery.

  hQuery:SET-BUFFERS(hSecRole).
  hQuery:QUERY-PREPARE("FOR EACH _sec-role NO-LOCK").
  hQuery:QUERY-OPEN().
  hQuery:GET-FIRST().

  /* Here we go through all of the roles that are available in the 
     _sec-role table and try to find permissions records for that role.

     This block contains all the logic for deciding what incendiary 
     permissions granting rights various roles may have.

     For instance; Audit Administrators can grant permissions for all
     other audit roles, so we add all available audit permissions to 
     the list when the user is an audit administrator. */
  DO WHILE NOT hQuery:QUERY-OFF-END:
    hSGRole:FIND-FIRST("WHERE _sec-granted-role._grantee = ~'" + pcUserID + 
                       "~' AND _sec-granted-role._role-name = ~'" + 
                       hSecRole::_role-name + "~'") NO-ERROR.
    IF hSGRole:AVAILABLE THEN DO:
      IF pcMode = "a" THEN DO:
        IF lAuditAdmin THEN DO:
          /* If the user is an audit admin and it's an auditing right but 
             not audit admin, give the user grant-rights for the role.  */
          IF LOOKUP("audit",hSGRole::_role-name,".") > 0 AND
             LOOKUP("admin",hSGRole::_role-name,".") < 1 THEN
            cRight = "w".
          ELSE cRight = "".
        END.
        ELSE cRight = "".
      END. /* pcMode = "a" */
      ELSE DO:
        /* If the user is a DBA and this is not an auditing permission,
           they automatically get this permission, with grant rights. */
        IF CAN-DO(cPermissions,"dba") AND 
           LOOKUP("audit",hSGRole::_role-name,".") < 1 THEN
          cRight = "w".
        ELSE cRight = "".
      END.

      /* Add the permission to the list with the rights that we decided
         on above, or the rights they were actually assigned */
      cPermissions = cPermissions + (IF cPermissions NE "" THEN "," ELSE "") +
                     hSGRole::_role-name + "," + 
                     (IF cRight = "" THEN 
                        (IF hSGRole::_grant-rights THEN "w" ELSE "r")
                      ELSE cRight).
    END.
    ELSE DO:
      IF pcMode = "a" THEN DO:
        IF lAuditAdmin THEN DO:
          IF LOOKUP("audit",hSecRole::_role-name,".") > 0 AND
             LOOKUP("admin",hSecRole::_role-name,".") < 1 THEN
            cPermissions = cPermissions + 
                           (IF cPermissions NE "" THEN "," ELSE "") +
                           hSecRole::_role-name + ",w".
        END.
      END.
      ELSE DO:
        IF CAN-DO(cPermissions,"dba") AND 
           LOOKUP("audit",hSecRole::_role-name,".") < 1 THEN
          cPermissions = cPermissions + 
                         (IF cPermissions NE "" THEN "," ELSE "") +
                         hSecRole::_role-name + ",w".
      END.
    END.
    hQuery:GET-NEXT().
  END.
  hQuery:QUERY-CLOSE().

  DELETE OBJECT hSecRole.
  DELETE OBJECT hQuery.
  DELETE OBJECT hSGRole.
  RETURN cPermissions.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getRoleDesc Include 
FUNCTION getRoleDesc RETURNS CHARACTER
  ( INPUT pcRoleName AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose:  Match up a role name with the role description.
Parameters: INPUT pcRoleName - The name of the role
    Notes:  Roles haven't been implemented yet so, in anticipation
            of the future implementation, we check the _sec-role table
            first for a role description and, if it doesn't exist yet,
            we have a list to use.  
            
            If it isn't in the _sec-role table and it isn't in our
            shortlist, simply return the role name back to the caller.
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSRole    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cRoleDesc AS CHARACTER   NO-UNDO.

  CREATE BUFFER hSRole FOR TABLE "DICTDB._sec-role".

  hSRole:FIND-FIRST("WHERE _role-name = ~'" + pcRoleName + "~'") NO-ERROR.
  IF hSRole:AVAILABLE THEN
    cRoleDesc = hSRole::_role-description.
  ELSE DO:
    CASE pcRoleName:
      WHEN "_sys.audit.admin" THEN
        cRoleDesc = "Audit Administrator".
      WHEN "_sys.audit.archive" THEN
        cRoleDesc = "Audit Archiver".
      WHEN "_sys.audit.appevent.insert" THEN
        cRoleDesc = "Application Audit Event Creator".
      WHEN "_sys.audit.read" THEN
        cRoleDesc = "Audit Data Reader".
    END CASE.
  END.
  DELETE OBJECT hSRole.
  
  RETURN (IF cRoleDesc EQ ? THEN "" 
          ELSE (IF cRoleDesc EQ "" THEN pcRoleName 
                ELSE cRoleDesc)).

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION hasRole Include 
FUNCTION hasRole RETURNS LOGICAL
  ( INPUT pcUser    AS CHARACTER,
    INPUT pcRole    AS CHARACTER,
    INPUT plGranter AS LOGICAL ):
/*------------------------------------------------------------------------------
  Purpose:  Checks whether the supplied userid holds the specified role
            in the connected database.  
Parameters: INPUT pcUser    - UserID of user
            INPUT pcRole    - Role name to check for
            INPUT plGranter - Does user have "grant" rights for this role
    Notes:  If plGranter is TRUE, this returns FALSE unless the user has
            "grant" rights for said role.
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lOk     AS LOGICAL     NO-UNDO.
  DEFINE VARIABLE lDBA    AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE hSGRole AS HANDLE      NO-UNDO.

  RUN prodict/_dctadmn.p ( INPUT pcUser,
                           OUTPUT lDBA ).
                           
  IF pcRole EQ "dba" THEN 
    RETURN lDBA.
  
  CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".
  hSGRole:FIND-FIRST("WHERE _grantee   = ~'" + pcUser + 
                     "~' AND _role-name = ~'" + pcRole + "~'" +
                     (IF plGranter THEN " AND _grant-rights"
                      ELSE ""),NO-LOCK) NO-ERROR.

  lOk = hSGRole:AVAILABLE.
  
  IF INDEX(pcRole,"audit.admin") > 0 AND
     (lOk  = FALSE) THEN DO:
    IF roleAvailable(pcRole) EQ FALSE THEN
      lOk = lDBA.
  END.

  DELETE OBJECT hSGRole.

  RETURN lOk.
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION roleAvailable Include 
FUNCTION roleAvailable RETURNS LOGICAL
  ( INPUT pcRoleName AS CHARACTER ):
/*------------------------------------------------------------------------------
  Purpose:  Checks whether any users have been granted the specified role. 
Parameters: INPUT pcRoleName - Role to test for 
    Notes:  If the role is "_sys.audit.admin" we do a unique find and return
            the unknown value (?) if more than one user holds it.
------------------------------------------------------------------------------*/
  DEFINE VARIABLE hSGRole    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE lAvailable AS LOGICAL     NO-UNDO.

  CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".

  IF INDEX(pcRoleName,"audit.admin") > 0 THEN
    lAvailable = hSGRole:FIND-UNIQUE("WHERE _role-name = ~'" + 
                                     pcRoleName + "~'",NO-LOCK) NO-ERROR.
  ELSE 
    lAvailable = hSGRole:FIND-FIRST("WHERE _role-name = ~'" + 
                                    pcRoleName + "~'",NO-LOCK) NO-ERROR.
  IF NOT lAvailable THEN
    IF hSGRole:AMBIGUOUS THEN lAvailable = ?.
  
  DELETE OBJECT hSGRole.

  RETURN lAvailable.
END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION whoGranted Include 
FUNCTION whoGranted RETURNS CHARACTER
  ( INPUT pcRole    AS CHARACTER,
    INPUT pcGrantee AS CHARACTER ) :
/*------------------------------------------------------------------------------
  Purpose: Returns who the specified permission to the specified grantee.
Parameters: INPUT pcRole    - Permission to grant
            INPUT pcGrantee - User who role was granted to 
    Notes:  
------------------------------------------------------------------------------*/
  DEFINE VARIABLE cGrantor AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hSGRole  AS HANDLE      NO-UNDO.

  CREATE BUFFER hSGRole FOR TABLE "DICTDB._sec-granted-role".
  hSGRole:FIND-FIRST("WHERE _grantee = ~'" + pcGrantee + "~' AND " +
                     "_role-name = ~'" + pcRole + "~'",NO-LOCK) NO-ERROR.
  IF hSGRole:AVAILABLE THEN
    cGrantor = hSGRole::_grantor.
  ELSE cGrantor = ?.

  DELETE OBJECT hSGRole.
  RETURN cGrantor.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------

  File: prodict/sec/sec-trgs.i

  Description: Common User Interface Triggers for Security Toolbar buttons.

  Input Parameters:
      <none>

  Output Parameters:
      <none>

  Author: Kenneth S. McIntosh

  Created: April 4, 2005
  History:
    kmcintos June 7, 2005  Added context sensitive help for security dialogs.
    
------------------------------------------------------------------------*/
{prodict/admnhlp.i}

DEFINE VARIABLE giContextId AS INTEGER     NO-UNDO.

ON CHOOSE OF btnCancel IN FRAME {&frame_name} DO:
  RUN cancelRecord.
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Cancel" ).
END.

ON CHOOSE OF btnCreate IN FRAME {&frame_name} DO:
  RUN newRecord.
  IF RETURN-VALUE = "Retry" THEN
    RETURN NO-APPLY.
  IF RETURN-VALUE = "Fatal" THEN DO:
    RUN cancelRecord.
    RETURN NO-APPLY.
  END.
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Create" ).
END.

ON CHOOSE OF btnDelete IN FRAME {&frame_name} DO:
  RUN deleteRecord.
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Delete" ).
END.

ON CHOOSE OF btnSave   IN FRAME {&frame_name} DO:
  
  RUN saveRecord.
  
  IF RETURN-VALUE = "Retry" THEN
    RETURN NO-APPLY.
  IF RETURN-VALUE = "Fatal" THEN DO:
    RUN cancelRecord.
    RETURN NO-APPLY.
  END.
                  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Save" ).
  
  APPLY "ENTRY" TO btnDone IN FRAME {&FRAME-NAME}.
END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN
  ON CHOOSE OF btnHelp   IN FRAME {&frame_name} OR 
     HELP OF FRAME {&frame_name} DO:
    
    DEFINE VARIABLE cUtility AS CHARACTER   NO-UNDO.
    DEFINE VARIABLE cSlash   AS CHARACTER   NO-UNDO.

    cSlash = &IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN "~\" &ELSE "~/" &ENDIF.

    cUtility = ENTRY(NUM-ENTRIES(THIS-PROCEDURE:FILE-NAME,cSlash),
                     THIS-PROCEDURE:FILE-NAME,
                     cSlash).

    CASE cUtility:
      WHEN "_sec-perm.p" THEN
        giContextId = {&Edit_Audit_Permissions_Dialog_Box}.
      WHEN "_sec-sys.p" THEN
        giContextId = {&Authentication_Systems_Dialog_Box}.
      WHEN "_sec-dom.p" THEN
        giContextId = {&Domains_Dialog_Box}.
      OTHERWISE
        giContextId = 0.
    END CASE.

    IF giContextId > 0 THEN
      RUN adecomm/_adehelp.p ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT giContextId,
                               INPUT ? ).
    ELSE
      MESSAGE "Help for File: {&FILE-NAME}" 
          VIEW-AS ALERT-BOX INFORMATION.
  END.
&ENDIF
  
ON CHOOSE OF btnDone   IN FRAME {&frame_name} DO:
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localTrig") THEN
    RUN localTrig ( INPUT "Done" ).
    
  APPLY "WINDOW-CLOSE" TO FRAME {&frame_name}.
END.
&ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
&ANALYZE-RESUME
&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Include 
/*************************************************************/
/* Copyright (c) 1984-2005 by Progress Software Corporation  */
/*                                                           */
/* All rights reserved.  No part of this program or document */
/* may be  reproduced in  any form  or by  any means without */
/* permission in writing from PROGRESS Software Corporation. */
/*************************************************************/

/*------------------------------------------------------------------------
    
    File        : prodict/sec/ui-procs.i
    Purpose     : Definitions of common User Interface API for Security
                  interfaces in the Data Administration Tool.

    Syntax      :

    Description : 

    Author(s)   : Kenneth S. McIntosh
    Created     : April 18, 2005

    History: kmcintos May 26, 2005 Check for value-change instead of depending
                                   on MODIFIED attribute, bug # 20050525-017.
             kmcintos May 27, 2005 Moved call to localSave(after) to 
                                   the last thing done in saveRecord 
                                   20050527-021.
             kmcintos May 27, 2005 Moved mode reset to after call to localSave
                                   20050527-024.
             kmcintos Oct 21, 2005 Added logic to allow assignment of initial
                                   values for fields not visible in the UI
                                   20050926-003.
  ----------------------------------------------------------------------*/
/*          This .W file was created with the Progress AppBuilder.      */
/*----------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */

/* Variables that are populated, at initialization, in tools that utilize
   this API */
DEFINE VARIABLE gcCreateModeFields  AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcResetModeFields   AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcDisableModeFields AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcFieldHandles      AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcFieldInits        AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcFileName          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcKeyField          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcDBBuffer          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcDBFields          AS CHARACTER   NO-UNDO.
DEFINE VARIABLE gcTTFields          AS CHARACTER   NO-UNDO.

/* Global User Interface State variable, generally assigned by the 
   procedures contained in this file. */
DEFINE VARIABLE gcUIState           AS CHARACTER   NO-UNDO.

/* Global HANDLE variables that are populated, at initialization, in the
   tools that utilize this API */
DEFINE VARIABLE ghFrame             AS HANDLE      NO-UNDO.
DEFINE VARIABLE ghBuffer            AS HANDLE      NO-UNDO.

/* Set/Unset when the User Interface is in Create Mode */
DEFINE VARIABLE glCreateMode        AS LOGICAL     NO-UNDO.

/* Intentionally not a NO-UNDO variable.  Just in case there's a problem 
   with a create operation, we can keep track of the last rowid */
DEFINE VARIABLE grwLastRowid        AS ROWID.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK 

/* ********************  Preprocessor Definitions  ******************** */



/* _UIB-PREPROCESSOR-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Prototypes ********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD mergePairs Include 
FUNCTION mergePairs RETURNS CHARACTER
  ( pcFields as char,pcValues as char,pcdelim as char )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD mergeValues Include  _DB-REQUIRED
FUNCTION mergeValues RETURNS CHARACTER
  (pcFields as char,
   pcValues as char)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setCreateModeValues Include 
FUNCTION setCreateModeValues RETURNS LOGICAL
  ( pcValues as character)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setDisableModeValues Include 
FUNCTION setDisableModeValues RETURNS LOGICAL
  ( pcValues as character )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setFieldHandles Include 
FUNCTION setFieldHandles RETURNS LOGICAL
  ( pcHandles as character )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setInitValues Include 
FUNCTION setInitValues RETURNS LOGICAL
  ( pcValues as character )  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD setResetModeValues Include 
FUNCTION setResetModeValues RETURNS LOGICAL
  (pcValues as character)  FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* *********************** Procedure Settings ************************ */

&ANALYZE-SUSPEND _PROCEDURE-SETTINGS
/* Settings for THIS-PROCEDURE
   Type: Include
   Allow: 
   Frames: 0
   Add Fields to: Neither
   Other Settings: INCLUDE-ONLY
 */
&ANALYZE-RESUME _END-PROCEDURE-SETTINGS

/* *************************  Create Window  ************************** */

&ANALYZE-SUSPEND _CREATE-WINDOW
/* DESIGN Window definition (used by the UIB) 
  CREATE WINDOW Include ASSIGN
         HEIGHT             = 11.86
         WIDTH              = 60.
/* END WINDOW DEFINITION */
                                                                        */
&ANALYZE-RESUME

 


&ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Include 


/* ***************************  Main Block  *************************** */

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* **********************  Internal Procedures  *********************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE cancelRecord Include 
PROCEDURE cancelRecord :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       This routine handles reseting the UI components after the
               user cancels an update or create operation.
------------------------------------------------------------------------------*/
 
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localCancel") THEN DO:
    RUN localCancel ( INPUT "Before" ).
    IF RETURN-VALUE NE "" THEN
      RETURN RETURN-VALUE.
  END.
    
  glCreateMode = FALSE.

  /* Reset the state of the interface. */
  RUN setFieldState ( INPUT "ResetMode" ).
  IF RETURN-VALUE NE "" THEN
    RETURN RETURN-VALUE.
  
  /* Disable/Enable the necessary buttons. */
  RUN setButtonState ( INPUT "ResetMode" ).
  IF RETURN-VALUE NE "" THEN
    RETURN RETURN-VALUE.
  
  /* Redisplay the current record. */
  RUN displayRecord.
  IF RETURN-VALUE NE "" THEN
    RETURN RETURN-VALUE.
  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localCancel") THEN DO:
    RUN localCancel ( INPUT "After" ).
    IF RETURN-VALUE NE "" THEN
      RETURN RETURN-VALUE.
  END.

  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE clearUserFields Include 
PROCEDURE clearUserFields :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       Reset the UI fields to default values...
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iField AS INTEGER     NO-UNDO.

  DEFINE VARIABLE hField AS HANDLE      NO-UNDO.

  DO iField = 1 TO NUM-ENTRIES(gcFieldInits):
    hField = WIDGET-HANDLE(ENTRY(1,ENTRY(iField,gcFieldInits),CHR(1))).
    hField:SCREEN-VALUE = ENTRY(2,ENTRY(iField,gcFieldInits),CHR(1)).
  END.

  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localClearFields") THEN DO:
    RUN localClearFields.
  END.  
  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE deleteRecord Include 
PROCEDURE deleteRecord :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       This routine handles deleting the current record.
------------------------------------------------------------------------------*/
  DEFINE VARIABLE lOk         AS LOGICAL     NO-UNDO.

  DEFINE VARIABLE hDBBuff     AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hTTField    AS HANDLE      NO-UNDO. 

  DEFINE VARIABLE cDBKeyField AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTTKeyField AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cQuote      AS CHARACTER   NO-UNDO.
  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localDelete") THEN DO:
    RUN localDelete ( INPUT "Before" ).
    IF RETURN-VALUE = "Cancel" THEN
      RETURN "Failed".
  END.

  CREATE BUFFER hDBBuff FOR TABLE gcDBBuffer.
  
  ASSIGN cDBKeyField = ENTRY(1,gcKeyField)
         cTTKeyField = ENTRY(2,gcKeyField)
         hTTField    = ghBuffer:BUFFER-FIELD(cTTKeyField)
         cTTKeyField = (IF ghBuffer:AVAILABLE THEN 
                          TRIM(STRING(hTTField:BUFFER-VALUE))
                        ELSE "")
         cQuote      = (IF ENTRY(3,gcKeyField) EQ "CHAR" THEN "~'" ELSE "").

  lOk = hDBBuff:FIND-FIRST("WHERE " + hDBBuff:NAME + "." + cDBKeyField + 
                           " = " + cQuote + cTTKeyField + cQuote) NO-ERROR.
  IF NOT lOk THEN DO:
    MESSAGE "Database record for " hDBBuff:NAME " no longer exists."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "Failed".
  END.

  DEL-BLK:
  DO TRANSACTION ON ERROR UNDO DEL-BLK, LEAVE DEL-BLK:
    IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localDelete") THEN DO:
      RUN localDelete ( INPUT "Start" ).
      IF RETURN-VALUE = "Cancel" THEN
        RETURN "Failed".
    END.

    /* Need lots of error checking in this routine, in order to preserve the
       state of the UI and the location of the record we'll reposition to
       after the delete operation. */
    hDBBuff:BUFFER-DELETE().
     
    IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localDelete") THEN DO:
      RUN localDelete ( INPUT "End" ).
      IF RETURN-VALUE NE "" THEN DO:
        UNDO DEL-BLK, RETURN "Failed".
      END.
    END.
    ghBuffer:BUFFER-DELETE().
    catch e as Progress.Lang.Error :
    	message 
    	    e:GetMessage(1)
        view-as alert-box error.
        return "Failed".	
    end catch.
  END.
  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localDelete") THEN
    RUN localDelete ( INPUT "After" ).

  RETURN "".
  finally:
      if valid-handle(hDBBuff) then
          DELETE OBJECT hDBBuff. 		
  end finally.
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE displayRecord Include 
PROCEDURE displayRecord :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       Displays the current record, or the default values if there is
               no record available...
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iField   AS INTEGER     NO-UNDO.
  
  DEFINE VARIABLE hField   AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hTTField AS HANDLE      NO-UNDO.

  /* If there is no record available we need to reset the fields to their
     initial values. */
  IF NOT ghBuffer:AVAILABLE THEN DO:
    RUN clearUserFields.
    RETURN "".
  END.

  DO iField = 1 TO NUM-ENTRIES(gcFieldHandles):
    hField = WIDGET-HANDLE(ENTRY(iField,gcFieldHandles)).
    
    hTTField = ghBuffer:BUFFER-FIELD(ENTRY(iField,gcTTFields)).
    IF hField:TYPE = "TOGGLE-BOX" THEN
      hField:CHECKED = hTTField:BUFFER-VALUE.
    ELSE hField:SCREEN-VALUE = hTTField:BUFFER-VALUE.
  END.
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localDisplay") THEN DO:
    RUN localDisplay.
    IF RETURN-VALUE NE "" THEN
      RETURN RETURN-VALUE.
  END. 

  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE newRecord Include 
PROCEDURE newRecord :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       This routine handles setting up the state for the creation of
               a new record.
------------------------------------------------------------------------------*/
  glCreateMode = TRUE.
  grwLastRowid = (IF ghBuffer:AVAILABLE THEN ghBuffer:ROWID ELSE ?).

  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localCreate") THEN DO:
    RUN localCreate ( INPUT "Start" ).
    IF RETURN-VALUE NE "" THEN DO:
      glCreateMode = FALSE.
      RETURN RETURN-VALUE.
    END.
  END.

  /* Reset fields to their initial values */
  RUN clearUserFields.
  IF RETURN-VALUE NE "" THEN DO:
    glCreateMode = FALSE.
    RETURN RETURN-VALUE.
  END.

  /* Enable the appropriate UI fields */
  RUN setFieldState ( INPUT "CreateMode" ).
  IF RETURN-VALUE NE "" THEN DO:
    glCreateMode = FALSE.
    RETURN RETURN-VALUE.
  END.

  /* Enable/Disable the appropriate buttons on the toolbar. */
  RUN setButtonState ( INPUT "CreateMode" ).
  IF RETURN-VALUE NE "" THEN DO:
    glCreateMode = FALSE.
    RETURN RETURN-VALUE.
  END.
  
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localCreate") THEN DO:
    RUN localCreate ( INPUT "End" ).
    IF RETURN-VALUE NE "" THEN DO:
      glCreateMode = FALSE.
      RETURN RETURN-VALUE.
    END.
  END.

  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE saveRecord Include 
PROCEDURE saveRecord :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       Saves changes to current record.
------------------------------------------------------------------------------*/
  DEFINE VARIABLE iField      AS INTEGER     NO-UNDO.

  DEFINE VARIABLE hField      AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDBField    AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hDBBuff     AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hTTField    AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cDBKeyField AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cTTKeyField AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cQuote      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cDBKeyValue AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cField      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cValue      AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE cFieldList  AS CHARACTER   NO-UNDO.
  DEFINE VARIABLE lOk         AS LOGICAL     NO-UNDO.

  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localSave") THEN DO:
    RUN localSave ( INPUT "Before" ).
    IF RETURN-VALUE NE "" THEN
      RETURN RETURN-VALUE.
  END.

  CREATE BUFFER hDBBuff FOR TABLE gcDBBuffer.

  ASSIGN cDBKeyField = ENTRY(1,gcKeyField)
         cTTKeyField = ENTRY(2,gcKeyField)
         httField    = ghBuffer:BUFFER-FIELD(cTTKeyField)
         cTTKeyField = (IF ghBuffer:AVAILABLE THEN 
                          STRING(hTTField:BUFFER-VALUE)
                        ELSE "")
         cQuote      = (IF ENTRY(3,gcKeyField) EQ "CHAR" THEN "~'" ELSE "").

  SAVE-BLK:
  DO TRANSACTION ON ERROR UNDO, throw:
    IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localSave") THEN DO:
      RUN localSave ( INPUT "Start" ).
      IF RETURN-VALUE NE "" THEN DO:
        glCreateMode = FALSE.
        RETURN RETURN-VALUE.
      END.
    END.

    IF glCreateMode THEN DO:
      /* Create a new record in the temp-table. */
      lOk = ghBuffer:BUFFER-CREATE().
      IF lOk THEN /* Assign the rowid that we will reposition to. */
        grwLastRowid = ghBuffer:ROWID.
      ELSE DO:
        MESSAGE "Create failed! " SKIP(1) 
                "Cannot create record in table" ghBuffer:NAME "."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        RETURN "Failed".
      END.

      /* Create a new record in the DB buffer. */
      lOk = hDBBuff:BUFFER-CREATE().
      IF NOT lOk THEN DO:
        MESSAGE "Create failed! Cannot create record in table " hDBBuff:NAME "."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        UNDO SAVE-BLK, RETURN "Failed".
      END.
      /* If the key is an abstract, or a GUID, the routine should have it's 
         own routine for generating it.  Call this now, if it indeed exists. */
      IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"generateKey") THEN DO:
        ASSIGN hDBField    = hDBBuff:BUFFER-FIELD(cDBKeyField)
               cDBKeyValue = DYNAMIC-FUNCTION('generateKey').

        IF cDBKeyValue = "" OR
           cDBKeyValue = ? THEN DO:
          MESSAGE "Create failed! " SKIP(1) 
                  "Could not generate key for" hDBBuff:NAME "record."
              VIEW-AS ALERT-BOX ERROR BUTTONS OK.
          UNDO SAVE-BLK, RETURN "Failed".
        END.

        ASSIGN hDBField:BUFFER-VALUE = TRIM(cDBKeyValue)
               hTTField:BUFFER-VALUE = TRIM(cDBKeyValue).
      END. /* If generateKey exists. */
    END. /* If new record */
    ELSE IF NOT ghBuffer:AVAILABLE THEN DO:
      glCreateMode = FALSE.
      MESSAGE "Save failed!  Couldn't locate record in local buffer."
          VIEW-AS ALERT-BOX ERROR BUTTONS OK.
      RETURN "Failed".
    END.
    ELSE DO: 
      grwLastRowid = ghBuffer:ROWID.
      lOk = hDBBuff:FIND-FIRST("WHERE " + hDBBuff:NAME + "." + cDBKeyField +
                               " = " + cQuote + cTTKeyField + cQuote) NO-ERROR.
      IF NOT hDBBuff:AVAILABLE OR NOT lOk OR ERROR-STATUS:ERROR THEN DO:
        glCreateMode = FALSE.
        MESSAGE "Save failed!  Couldn't locate record in database."
            VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        UNDO SAVE-BLK, RETURN "Failed".
      END.
    END.
    
    /* Loop through the UI fields and save their values to the Temp-Table and
       Database Buffers. */
    DO iField = 1 TO NUM-ENTRIES(gcFieldHandles):
      hField   = WIDGET-HANDLE(ENTRY(iField,gcFieldHandles)).
      hDBField = hDBBuff:BUFFER-FIELD(ENTRY(iField,gcDBFields)).
      IF hField:SCREEN-VALUE NE hDBField:BUFFER-VALUE THEN
        hField:MODIFIED = TRUE.

      IF NOT glCreateMode AND
         NOT hField:MODIFIED THEN NEXT.

      IF hField:TYPE = "TOGGLE-BOX" THEN
        ASSIGN hTTField              = ghBuffer:BUFFER-FIELD(ENTRY(iField,
                                                                   gcTTFields))
               hTTField:BUFFER-VALUE = hField:CHECKED
               hDBField:BUFFER-VALUE = hField:CHECKED.
      ELSE  
        ASSIGN hTTField              = ghBuffer:BUFFER-FIELD(ENTRY(iField,
                                                                   gcTTFields))
               hTTField:BUFFER-VALUE = hField:SCREEN-VALUE
               hDBField:BUFFER-VALUE = hField:SCREEN-VALUE.
 
    
    END. /* Field assign loop */

    IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localSave") THEN DO:
      RUN localSave ( INPUT "End" ).
      IF RETURN-VALUE BEGINS "INITIAL" THEN 
        DO iField = 1 TO NUM-ENTRIES(ENTRY(2,RETURN-VALUE,"|")):
        IF iField = 1 THEN 
          cFieldList = ENTRY(2,RETURN-VALUE,"|").

        ASSIGN cField = ENTRY(1,ENTRY(iField,cFieldList),"=") 
               cValue = ENTRY(2,ENTRY(iField,cFieldList),"=").

        ASSIGN hDBField              = hDBBuff:BUFFER-FIELD(cField)
               hDBField:BUFFER-VALUE = cValue.
        
      END. /* Additional assign fields initial values. */
      ELSE IF RETURN-VALUE NE "" THEN DO:
        glCreateMode = FALSE.
        UNDO SAVE-BLK, RETURN RETURN-VALUE.
      END.
    END.
  END. /* Transaction block */
   
  DELETE OBJECT hDBBuff.

  RUN setButtonState ( INPUT "ResetMode" ).
  RUN setFieldState  ( INPUT "ResetMode" ).

  /* Don't bother to return a return-value after localSave, at this point,
     because the transaction is over and it would be pointless. */
  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localSave") THEN 
    RUN localSave ( INPUT "After" ).

  glCreateMode = FALSE.

  RETURN "".                     
  /* Ensure any unexpected message is shown in alert-box.
     Validation in localSave should really ensure that no error should 
     happen here, but when an unexpected error happens in the dynamic 
     assignment there are many messages and if tty the buffer-value error is 
     the only one you see in the message area in tty  */                  
  catch e as Progress.Lang.Error :
      message e:getmessage(1)
          view-as alert-box error.
  end catch. 

END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setButtonState Include 
PROCEDURE setButtonState :
/*------------------------------------------------------------------------------
  Purpose:     Sets up the button state
  Parameters:  INPUT pcMode - Button Mode
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode   AS CHARACTER   NO-UNDO.
  
  DEFINE VARIABLE hButton AS HANDLE      NO-UNDO.

  /* Walk the widget tree and find the toolbar buttons. */
  hButton = ghFrame:FIRST-CHILD:FIRST-CHILD.
  DO WHILE VALID-HANDLE(hButton):
    IF hButton:TYPE = "BUTTON" THEN DO:
      CASE pcMode:
        WHEN "CreateMode" THEN DO:
          IF CAN-DO("btnCreate,btnDelete,btnDone",
                    hButton:NAME) THEN
            hButton:SENSITIVE = FALSE.
          ELSE IF CAN-DO("btnSave,btnCancel",hButton:NAME) THEN
            hButton:SENSITIVE = TRUE.
          gcUIState = "Create".
        END. /* WHEN CreateMode */
        WHEN "ResetMode" THEN DO:
          IF CAN-DO("btnCreate,btnDone",
                    hButton:NAME) THEN
            hButton:SENSITIVE = TRUE.
          ELSE IF CAN-DO("btnSave,btnCancel",hButton:NAME) THEN
            hButton:SENSITIVE = FALSE.
          ELSE IF hButton:NAME = "btnDelete" THEN
            hButton:SENSITIVE = ghBuffer:AVAILABLE.
          gcUIState = "Reset".  
        END. /* WHEN CreateMode */
        WHEN "UpdateMode" THEN DO:
          IF CAN-DO("btnCreate,btnDelete,btnDone",
                    hButton:NAME) THEN
            hButton:SENSITIVE = FALSE.
          ELSE IF CAN-DO("btnSave,btnCancel",
                         hButton:NAME) THEN
            hButton:SENSITIVE = TRUE.
          gcUIState = "Update".  
        END.
        WHEN "DisableMode" THEN DO:
          IF CAN-DO("btnCreate,btnDelete,btnSave,btnCancel",
                    hButton:NAME) THEN
            hButton:SENSITIVE = FALSE.
          ELSE
            hButton:SENSITIVE = TRUE.
          gcUIState = "Disable".
        END.
      END CASE.
    END. /* IF type = button */
    hButton = hButton:NEXT-SIBLING.
  END. /* DO WHILE */

  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localButtonState") THEN
    RUN localButtonState ( INPUT pcMode ).

  IF RETURN-VALUE NE "" THEN
    RETURN RETURN-VALUE.
  
  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setFieldState Include 
PROCEDURE setFieldState :
/*------------------------------------------------------------------------------
  Purpose:     Generic procedure for use with common security UI features.
  Parameters:  <none>
  Notes:       Enable/Disable fields in interface.
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcMode AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hField AS HANDLE      NO-UNDO.

  DEFINE VARIABLE iField AS INTEGER     NO-UNDO.

  DEFINE VARIABLE cField AS CHARACTER   NO-UNDO.
  
  DO iField = 1 TO NUM-ENTRIES(gcFieldHandles):
    cField = ENTRY(iField,gcFieldHandles).
    hField = WIDGET-HANDLE(cField).
    CASE pcMode:
      WHEN "CreateMode" THEN
        ASSIGN 
        hField:SENSITIVE = (IF ENTRY(LOOKUP(cField,gcCreateModeFields) + 1,
                                     gcCreateModeFields) EQ "yes" THEN TRUE
                            ELSE (IF ENTRY(LOOKUP(cField,
                                                  gcCreateModeFields) + 1,
                                           gcCreateModeFields) = "iab" THEN
                                    ghBuffer:AVAILABLE
                                  ELSE FALSE))
        hField:MODIFIED   = TRUE.
      WHEN "ResetMode" THEN
        ASSIGN
        hField:SENSITIVE = (IF ENTRY(LOOKUP(cField,gcResetModeFields) + 1,
                                     gcResetModeFields) EQ "yes" THEN TRUE
                            ELSE (IF ENTRY(LOOKUP(cField,gcResetModeFields) + 1,
                                           gcResetModeFields) = "iab" THEN
                                    ghBuffer:AVAILABLE
                                  ELSE FALSE))
        hField:MODIFIED  = FALSE.
      WHEN "DisableMode" THEN
        ASSIGN
        hField:SENSITIVE = (IF ENTRY(LOOKUP(cField,gcDisableModeFields) + 1,
                                     gcDisableModeFields) EQ "yes" THEN TRUE
                            ELSE (IF ENTRY(LOOKUP(cField,
                                                  gcDisableModeFields) + 1,
                                           gcDisableModeFields) = "iab" THEN
                                    ghBuffer:AVAILABLE
                                  ELSE FALSE))
        hField:MODIFIED  = FALSE.
    END CASE.
  END.

  IF CAN-DO(THIS-PROCEDURE:INTERNAL-ENTRIES,"localFieldState") THEN
    RUN localFieldState ( INPUT pcMode ).

  IF RETURN-VALUE NE "" THEN
    RETURN RETURN-VALUE.
  
  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE setRowidForDelete Include 
PROCEDURE setRowidForDelete :
/*------------------------------------------------------------------------------
  Purpose:     Find a rowid to reposition the query to after a delete 
               operation.  First we search forward and, if there are no 
               more records, we search backward.
  Parameters:  pcQuery - Query string from the current query
  Notes:       
------------------------------------------------------------------------------*/
  DEFINE INPUT  PARAMETER pcQuery AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE hBuff  AS HANDLE      NO-UNDO.
  DEFINE VARIABLE hQuery AS HANDLE      NO-UNDO.

  DEFINE VARIABLE cQuery AS CHARACTER   NO-UNDO.

  DEFINE VARIABLE lOk    AS LOGICAL     NO-UNDO.

  cQuery = pcQuery.

  /* Create a new buffer for the temp-table so that we
     don't affect the current query's position */
  CREATE BUFFER hBuff FOR TABLE ghBuffer.
  
  /* We use a query, instead of buffer methods, so that 
     we search, forward and backward, in exactly the same 
     order as the query was opened */
  CREATE QUERY hQuery.

  lOk = hQuery:SET-BUFFERS(hBuff).
  IF lOk THEN
    lOk = hQuery:QUERY-PREPARE(cQuery).
  ELSE RETURN "Cancel".
  IF lOk THEN
    lOk = hQuery:QUERY-OPEN().
  ELSE RETURN "Cancel".
  IF lOk THEN
    lOk = hQuery:GET-FIRST().
  IF NOT lOk THEN
    RETURN "Cancel".

  /* Reposition to the record we're currently positioned at in 
     the browser */
  lOk = hQuery:REPOSITION-TO-ROWID(ghBuffer:ROWID).
  IF lOk THEN
    lOk = hQuery:GET-NEXT().
  
  /* Try going forward */
  IF lOk THEN
    lOk = hQuery:GET-NEXT().
  IF hBuff:AVAILABLE THEN
    grwLastRowid = hBuff:ROWID.
  ELSE DO:
    /* Replace the query's cursor to the current record before
       searching backward */
    lOk = hQuery:REPOSITION-TO-ROWID(ghBuffer:ROWID).
    IF lOk THEN
      lOk = hQuery:GET-NEXT().

    /* If we couldn't find a record below it, try going
       backward */
    IF lOk THEN
      lOk = hQuery:GET-PREV().
    IF lOk THEN
      grwLastRowid = hBuff:ROWID.

    /* We're out of records... */
    ELSE grwLastRowid = ?.
  END.

  DELETE OBJECT hQuery.
  DELETE OBJECT hBuff.

  RETURN "".
END PROCEDURE.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/* ************************  Function Implementations ***************** */

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION mergePairs Include 
FUNCTION mergePairs RETURNS CHARACTER
  ( pcFields as char,pcValues as char,pcdelim as char ) :
/*------------------------------------------------------------------------------
  Purpose: returns comma separate list with pairs delimited by pcdelim 
           fieldhandle|pcValue,fieldhandle|pcValue  (| = pcDelim) 
    Notes:  
------------------------------------------------------------------------------*/
   define variable i as integer no-undo.
   define variable cfield as character no-undo.
   define variable cValue as character no-undo.
   define variable cList as character no-undo.
   if pcDelim = ? then 
       pcdelim = ",".
   
   do i = 1 to num-entries(pcFields):
      assign
          cfield = entry(i,pcfields)
          cValue = entry(i,pcValues,pcdelim)
          cList = cList 
                + (if i = 1 then "" else ",") 
                + cfield + pcdelim + cValue.
                 
   end.
   return cList.    
 

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION mergeValues Include 
FUNCTION mergeValues RETURNS CHARACTER
  ( pcFields as char,pcValues as char) :
/*------------------------------------------------------------------------------
  Purpose: returns comma separated pairs: fieldhandle,pcValue,fieldhandle,pcValue  
    Notes:  
------------------------------------------------------------------------------*/
   define variable i as integer no-undo.
   define variable cfield as character no-undo.
   define variable cValue as character no-undo.
   define variable cList as character no-undo.
   do i = 1 to num-entries(pcFields):
      assign
          cfield = entry(i,pcfields)
          cValue = entry(i,pcValues)
          cList = cList 
                + (if i = 1 then "" else ",") 
                + cfield + "," + cValue. 
   end.
   return cList.    

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setCreateModeValues Include 
FUNCTION setCreateModeValues RETURNS LOGICAL
  ( pcValues as character) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
    gcCreateModeFields = mergeValues(gcFieldHandles,pcvalues).
    RETURN true.   /* Function return value. */

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setDisableModeValues Include 
FUNCTION setDisableModeValues RETURNS LOGICAL
  ( pcValues as character ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
    gcDisableModeFields = mergeValues(gcFieldHandles,pcvalues).
    RETURN true.    

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setFieldHandles Include 
FUNCTION setFieldHandles RETURNS LOGICAL
  ( pcHandles as character ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
   gcFieldHandles = pcHandles.
  RETURN true.   

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setInitValues Include 
FUNCTION setInitValues RETURNS LOGICAL
  ( pcValues as character ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
    gcFieldInits = mergePairs(gcFieldHandles,pcvalues,chr(1)).
    RETURN true.    

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION setResetModeValues Include 
FUNCTION setResetModeValues RETURNS LOGICAL
  ( pcValues as character ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/
  gcResetModeFields = mergeValues(gcFieldHandles,pcvalues).
  RETURN true.   

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_sec-gen-key.p

Description:
    Interface for generating new key for encryption policy

Input-Parameters:
    myEPolicy - _sec-pol-util object
    dsObjAttrs - dataset with objects selected by user

Output-Parameters:
    none
    
History:
    10/21/08  fernando   created

                            
--------------------------------------------------------------------*/
CREATE WIDGET-POOL.

{prodict/sec/sec-pol.i}
{adecomm/adestds.i}

DEFINE INPUT PARAMETER myEPolicy AS CLASS prodict.sec._sec-pol-util.
DEFINE INPUT PARAMETER DATASET FOR dsObjAttrs.

DEFINE VARIABLE Committed       AS LOGICAL NO-UNDO.
DEFINE VARIABLE onlyOne         AS LOGICAL NO-UNDO.
DEFINE VARIABLE cObjType        AS CHARACTER NO-UNDO.

DEFINE VARIABLE cCipher AS CHARACTER FORMAT "X(30)":U 
     LABEL "Cip&her".

DEFINE VARIABLE Pass-phrase AS CHARACTER FORMAT "X(256)":U 
     LABEL "Pa&ssphrase" 
     VIEW-AS FILL-IN
     SIZE 42 BY 1  NO-UNDO.

DEFINE VARIABLE Verify-pass-phrase AS CHARACTER FORMAT "X(256)":U 
     LABEL "&Verify Passphrase" 
     VIEW-AS FILL-IN 
     SIZE 42 BY 1 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN SIZE 76 BY 5
&ELSE SIZE 77 BY 4 &ENDIF .

DEFINE BUTTON Btn_Save 
     LABEL "&Save" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Copy 
     LABEL "Co&py..." 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Revert 
     LABEL "&Revert" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON btn_Commit LABEL "&Commit" {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel"  {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN   &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN   /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
   &GLOBAL-DEFINE   STATUS NO
   &GLOBAL-DEFINE   BOX_BTN   &BOX = "rect_Btns"
   &SCOPED-DEFINE   ORIG_OKBOX {&OKBOX}
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
   &GLOBAL-DEFINE   BOX_BTN
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF

/* main browse */
DEFINE QUERY BrowseList FOR ttObjAttrs SCROLLING.
DEFINE BROWSE BrowseList
    QUERY BrowseList NO-LOCK DISPLAY
    ttObjAttrs.disp-name COLUMN-LABEL "Object Name" FORMAT "x(66)":U WIDTH 66
    cObjType COLUMN-LABEL "Type" FORMAT "x(4)":U WIDTH 4
    WITH NO-LABELS NO-ROW-MARKERS
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 76 BY 9 
&ELSE
    SIZE 77 BY 9
&ENDIF
     FIT-LAST-COLUMN.

/* ************************  Frame Definitions  *********************** */

/* main frame */
DEFINE FRAME Dialog-Frame
     "Hit the Commit button to commit changes" VIEW-AS TEXT
       AT ROW 1 COL 2
     BrowseList AT ROW 2.00 COL 2 WIDGET-ID 2
     cCipher 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 12 COL 15
       &ELSE AT ROW 11.33 COL 20 COLON-ALIGNED &ENDIF WIDGET-ID 4
     Btn_Save 
        &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 12 COL 67
        &ELSE AT ROW 11.77 COL 66 &ENDIF WIDGET-ID 6
     Pass-phrase 
        &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 13 COL 21
        &ELSE AT ROW 12.52 COL 20 &ENDIF COLON-ALIGNED PASSWORD-FIELD WIDGET-ID 8
     Btn_Copy 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 13 COL 67
       &ELSE  AT ROW 12.77 COL 66 &ENDIF WIDGET-ID 10
     Verify-pass-phrase
        &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN  AT ROW 14 COL 21
        &ELSE AT ROW 13.71 COL 20 &ENDIF COLON-ALIGNED PASSWORD-FIELD WIDGET-ID 12
     Btn_Revert 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 14 COL 67
       &ELSE AT ROW 13.77 COL 66 &ENDIF WIDGET-ID 14
     Btn_Commit AT ROW 15.57 COL 2
     Btn_Cancel AT ROW 15.57 COL 14
     &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
       Btn_Help AT ROW 15.57 COL 69 
     &ENDIF
     RECT-1 
      &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 11 COL 2
      &ELSE AT ROW 11 COL 2 &ENDIF WIDGET-ID 16
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
     SPACE(.5) SKIP(1)
&ENDIF
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Generate Encryption Keys"
         DEFAULT-BUTTON Btn_Commit CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.

/*adjust buttons to be in the middle for tty */
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN

  DEFINE VARIABLE eff_frame_width1 AS DECIMAL.  /* effective frame width */

  /* first for the main frame */
  ASSIGN eff_frame_width1 = FRAME Dialog-Frame:WIDTH-CHARS - 
                          FRAME Dialog-Frame:BORDER-LEFT-CHARS - 
                          FRAME Dialog-Frame:BORDER-RIGHT-CHARS.

  /* no help button for tty, and buttons in the middle */
   btn_Commit:COLUMN IN FRAME Dialog-Frame  = (eff_frame_width1 -
                          btn_Commit:WIDTH-CHARS IN FRAME Dialog-Frame -
                          btn_Cancel:WIDTH-CHARS IN FRAME Dialog-Frame -
                           5 ) / 2.
   btn_Cancel:COLUMN IN FRAME Dialog-Frame = btn_Commit:COLUMN IN FRAME Dialog-Frame + 
                            btn_Commit:WIDTH-CHARS IN FRAME Dialog-Frame + 
                                2.5.
&ENDIF

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame /* Generate Encryption Keys */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN

/*----- HELP -----*/

ON CHOOSE OF Btn_Help IN FRAME Dialog-Frame /* Help */
OR HELP OF FRAME Dialog-Frame
DO: /* Call Help Function (or a simple message). */
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Generate_Encryption_Keys_Dialog_Box},
                               INPUT ?).  
  
END.



&ENDIF

&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN

ON ANY-PRINTABLE OF BrowseList IN FRAME Dialog-Frame
DO:
    DEF VAR ch   AS CHAR NO-UNDO.
    DEF VAR curr AS CHAR NO-UNDO.

    /* simulate search on tty so user can find object taht starts with a given character */
    ch = CHR(LASTKEY).

    BrowseList:FETCH-SELECTED-ROW(1).
    curr = ttObjAttrs.obj-name.

    IF ttObjAttrs.obj-name BEGINS ch THEN DO:
        FIND FIRST ttObjAttrs WHERE obj-name > curr NO-ERROR.

        IF NOT AVAILABLE ttObjAttrs THEN
           FIND FIRST ttObjAttrs WHERE obj-name BEGINS ch NO-ERROR.
    END.
    ELSE
       FIND FIRST ttObjAttrs WHERE obj-name BEGINS ch NO-ERROR.

    IF AVAILABLE ttObjAttrs AND obj-name BEGINS ch THEN DO:
        REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs).
        APPLY "VALUE-CHANGED" TO BrowseList.
    END.
    ELSE
        BrowseList:FETCH-SELECTED-ROW(1).
END.

&ENDIF

ON ROW-DISPLAY OF BrowseList IN FRAME Dialog-Frame
DO:
    CASE ttObjAttrs.obj-type:
        WHEN "TABLE" THEN
            cObjType = "Tbl".
        WHEN "INDEX" THEN
            cObjType = "Idx".
        OTHERWISE
            cObjType = ttObjAttrs.obj-type.
    END CASE.
END.

ON VALUE-CHANGED OF BrowseList IN FRAME Dialog-Frame
DO:
    DO WITH FRAME Dialog-Frame:
        
        cCipher =  ttObjAttrs.obj-cipher.

        DISPLAY cCipher WITH FRAME Dialog-Frame.

        /* if there are changes that can be undone, enable the revert button */
        Btn_Revert:SENSITIVE = (IF ttObjAttrs.disp-name BEGINS "*" THEN YES ELSE NO).
    END.
END.

ON GO OF FRAME Dialog-Frame 
DO:
  DEF VAR answer AS LOGICAL NO-UNDO.

  MESSAGE 'You are about to generate the encryption key for all objects' SKIP
          'on the list. Do you want to proceed?'
       VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.

  IF answer = NO THEN
     RETURN NO-APPLY.

  /* doCommit will return an error when commit doesn't go through, so we return no-apply and 
     let the user decide what to do.
  */
  DO ON ERROR UNDO, RETURN NO-APPLY.
     RUN doCommit.
  END.
END.


ON END-ERROR OF  FRAME Dialog-Frame OR
   CHOOSE OF Btn_Cancel IN FRAME Dialog-Frame 
DO:
    
    DEF VAR answer AS LOGICAL NO-UNDO.

    MESSAGE 'The encryption key for each object on the list has not' SKIP
            'been generated. Are you sure you want to close?'
        VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.

    IF answer = NO THEN
       RETURN NO-APPLY /* no*/.

END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME Dialog-Frame:PARENT eq ?
THEN FRAME Dialog-Frame:PARENT = ACTIVE-WINDOW.


/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  /* start tracking-changes */
  TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = YES.

  RUN enable_UI.

  /* get the first row to display the details  */
  APPLY "VALUE-CHANGED" TO BrowseList.

  APPLY "ENTRY" TO btn_Commit IN FRAME Dialog-Frame.
  WAIT-FOR GO OF FRAME Dialog-Frame.
END.
RUN disable_UI.

/* if we got here and the user did not save the changes, we return
   error to the caller so that it undoes the transaction, if there is
   one.
*/
IF NOT Committed THEN 
   RETURN ERROR.


/* **********************  Internal Procedures  *********************** */

/* PROCEDURE: disable_UI
 *            Disable widgets
 */
PROCEDURE disable_UI :
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

/* PROCEDURE: doCommit
 *            Commit changes to the database
 */
PROCEDURE doCommit:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.
    DEFINE VARIABLE answer AS LOGICAL NO-UNDO.

    /* get an exclusive lock on the schema, so that other users get 
       blocked when trying to change any schema info or enc policies
    */
    DO ON STOP UNDO, RETURN ERROR:
        myEPolicy:getDbLock(YES).
    END.

    /* this will mark all of them to get key generate */
    FOR EACH ttObjAttrs:
        ttObjAttrs.obj-genkey = YES.
    END.

    /* now pass the changes to out epolicy object and save them to the db */
    myEPolicy:updatePolicies(INPUT ?, INPUT DATASET dsObjAttrs BY-REFERENCE).

    /* if updatePolicies throws error, we won't get here, will get in the catch block below */
    ASSIGN Committed = YES.

    CATCH e AS PROGRESS.Lang.ProError:
       MESSAGE 'Failed to generate key.' skip e:GetMessage(1)
           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       
       DELETE OBJECT e.
       /* we return error which then will get propagated so that we let the user decide what to do */
       RETURN ERROR.
       
    END CATCH.

END PROCEDURE.

/* PROCEDURE: enable_UI
 *            Enable widgets
 */
PROCEDURE enable_UI :
  DISPLAY BrowseList cCipher Pass-phrase Verify-pass-phrase 
      WITH FRAME Dialog-Frame.
  ENABLE RECT-1 BrowseList Btn_Commit Btn_Cancel
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
      WITH FRAME Dialog-Frame.

  VIEW FRAME Dialog-Frame.
  OPEN QUERY BrowseList FOR EACH ttObjAttrs NO-LOCK INDEXED-REPOSITION.

END PROCEDURE.
/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_sec-obj-sel.p

Description:
    Interface for choosing objects for various tasks on encryption 
    policies (encryption)

Input-Parameters:
    myEPolicy - _sec-pol-util object
    dsObjAttrs - dataset with objects selected by user

Output-Parameters:
    none
    
History:
    07/01/08  fernando   created

--------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
USING Progress.Security.DB.* .
USING prodict.sec.*.

ROUTINE-LEVEL ON ERROR UNDO, THROW.

{prodict/sec/sec-pol.i}
{adecomm/adestds.i}

/* Parameters Definitions ---                                           */

DEFINE INPUT  PARAMETER myEPolicy AS CLASS _sec-pol-util.
DEFINE OUTPUT PARAMETER DATASET FOR dsObjAttrs.

/* Local Variable Definitions ---                                       */

DEFINE VARIABLE CipherListAvailable AS LOGICAL   NO-UNDO.
DEFINE VARIABLE numPrevSelected     AS INTEGER   NO-UNDO.
DEFINE VARIABLE pprompt             AS CHARACTER NO-UNDO.
DEFINE VARIABLE pattern             AS CHARACTER NO-UNDO INITIAL "*".
DEFINE VARIABLE cHeader             AS CHARACTER NO-UNDO EXTENT 2 FORMAT "X(77)".
DEFINE VARIABLE cHelp               AS CHARACTER NO-UNDO.
DEFINE VARIABLE cObjType            AS CHARACTER NO-UNDO.

DEFINE VARIABLE msg                 AS CHARACTER NO-UNDO EXTENT 5 INITIAL
    ["Cannot change the object encryption policy until its encrypted",
     "data has been updated. Refer to the proutil epolicy utility.",
     "Objects that cannot have the encryption policy changed until its encrypted",
     "data is updated were not selected. Refer to the proutil epolicy utility.",
     "Select at least one object or press Cancel"
    ].

DEFINE BUTTON btn_Ok     LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN   &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN   /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
   &GLOBAL-DEFINE   STATUS NO
   &GLOBAL-DEFINE   BOX_BTN   &BOX = "rect_Btns"
   &SCOPED-DEFINE   ORIG_OKBOX {&OKBOX}
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
   &GLOBAL-DEFINE   BOX_BTN
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF


/* ***********************  Control Definitions  ********************** */

DEFINE BUTTON Btn_Select_Some 
     LABEL "&Select Some..." .

DEFINE BUTTON Btn_Deselect_Some 
     LABEL "&Deselect Some...". 

DEFINE VARIABLE Cipher AS CHARACTER FORMAT "X(256)":U 
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 17 BY 1 
&ELSE SIZE 25 BY 1 &ENDIF
    NO-UNDO.

DEFINE RECTANGLE Rect1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN SIZE 76 BY 4.
&ELSE SIZE 77 BY 3.33 &ENDIF.

/*DEFINE VARIABLE TogTables AS LOGICAL INITIAL YES 
     LABEL "&Tables" 
     VIEW-AS TOGGLE-BOX
     SIZE 14.6 BY .81 NO-UNDO. */

DEFINE VARIABLE TogIndex AS LOGICAL INITIAL YES 
     LABEL "Show &Indexes" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 17.6 BY .81 &endif NO-UNDO.

DEFINE VARIABLE TogLobs AS LOGICAL INITIAL NO 
     LABEL "Show &LOBs" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 15.6 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE TogAllEnc AS LOGICAL INITIAL YES 
     LABEL "E&nabled"
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 21 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE TogAllNonEnc AS LOGICAL INITIAL YES 
     LABEL "Di&sabled"
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 14 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE TogCipher AS LOGICAL INITIAL NO 
     LABEL "Filter Ci&pher" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 16 BY .81 &ENDIF NO-UNDO.

DEFINE QUERY BrowseList FOR ttObjAttrs SCROLLING.

DEFINE BROWSE BrowseList
    QUERY BrowseList NO-LOCK DISPLAY
        ttObjAttrs.disp-name COLUMN-LABEL "Object Name" FORMAT "x(65)":U WIDTH 65
        cObjType COLUMN-LABEL "Type" FORMAT "x(4)":U WIDTH 4
    WITH NO-LABELS MULTIPLE
    &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 76 BY 9 
    &ELSE
    SIZE 77 BY 9 
    &ENDIF
    FIT-LAST-COLUMN.

/* ************************  Frame Definitions  *********************** */

/* frame for select / deselect some */
DEFINE FRAME  obj_patt
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pprompt  FORMAT "x(40)" NO-LABEL at 2 view-as TEXT
   "Use '*' and '.' for wildcard patterns.":t45 at 2 view-as TEXT 
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pattern  FORMAT "x(50)"   LABEL "Object Name":t17 at 2
   {prodict/user/userbtns.i}
   with view-as DIALOG-BOX TITLE "Select Objects by Pattern Match"
        SIDE-LABELS CENTERED THREE-D
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.

/* don't want box for this one */
&UNDEFINE OKBOX
&GLOBAL-DEFINE OKBOX NO

/* main frame */
DEFINE FRAME ObjSelFrame
     cHeader[1] NO-LABEL VIEW-AS TEXT
          SIZE 75 BY .62 
          &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 1 COL 2
          &ELSE AT ROW 1 COL 2 WIDGET-ID 30 &ENDIF          
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN          
    cHeader[2] NO-LABEL VIEW-AS TEXT
         SIZE 75 BY .62  AT ROW 2 COL 2
&ENDIF
     Btn_Select_Some 
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 15
       &ELSE AT ROW 2 COL 20 WIDGET-ID 8 &ENDIF
     Btn_Deselect_Some
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 4 COL 45
       &ELSE AT ROW 2 COL 38  WIDGET-ID 8 &ENDIF
     BrowseList
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 5 COL 1
       &ELSE AT ROW 3.2 COL 2 WIDGET-ID 2  &ENDIF 
     Rect1
         &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 14 COL 1
         &ELSE AT ROW 12.65 COL 2 WIDGET-ID 34 &ENDIF 
     TogIndex 
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 15 COL 2
       &ELSE AT ROW 12.80 COL 3 WIDGET-ID 16 &ENDIF
     TogLobs
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 16 COL 2
       &ELSE AT ROW 13.80 COL 3 WIDGET-ID 18 &ENDIF
    "Show Encryption:" VIEW-AS TEXT
         SIZE 18 BY .62 
         &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 15 COL 20
         &ELSE AT ROW 12.80 COL 29 WIDGET-ID 28 &ENDIF       
     TogAllEnc
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 15 COL 37
       &ELSE AT ROW 12.80 COL 47 WIDGET-ID 20 &ENDIF
     TogAllNonEnc
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 15 COL 49
       &ELSE AT ROW 12.80 COL 60 WIDGET-ID 22 &ENDIF
     TogCipher
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 16 COL 37
       &ELSE AT ROW 13.80 COL 47 WIDGET-ID 24 &ENDIF
     Cipher
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 16 COL 54
       &ELSE AT ROW 14.80 COL 49 COLON-ALIGNED &ENDIF NO-LABEL WIDGET-ID 26
    {prodict/user/userbtns.i}
    WITH 
         VIEW-AS DIALOG-BOX ROW 1 CENTERED
         KEEP-TAB-ORDER SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Object Selector"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.

/* revert to original value */
&UNDEFINE OKBOX
&GLOBAL-DEFINE OKBOX {&ORIG_OKBOX}

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME ObjSelFrame /* Object Selector */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
/*----- HELP -----*/

ON CHOOSE OF Btn_Help IN FRAME ObjSelFrame /* Help */
OR HELP OF FRAME ObjSelFrame
DO: /* Call Help Function (or a simple message). */
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Encryption_Policies_Object_Selector_Dialog_Box1},
                               INPUT ?).
  
END.

on HELP of frame obj_patt OR CHOOSE of Btn_Help in frame obj_patt
DO:
   IF FRAME obj_patt:TITLE = "Select Objects by Pattern Match" THEN
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Select_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
   ELSE 
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Deselect_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
END.      	       	

&ENDIF

ON ROW-DISPLAY OF BrowseList
DO:
    /* to save space, make the obj type shorter */
    CASE ttObjAttrs.obj-type:
        WHEN "TABLE" THEN
            cObjType = "Tbl".
        WHEN "INDEX" THEN
            cObjType = "Idx".
        OTHERWISE
            cObjType = ttObjAttrs.obj-type.
    END CASE.
END.

ON GO OF FRAME ObjSelFrame
DO:
    DEFINE VARIABLE nRows  AS INTEGER NO-UNDO.
    DEFINE VARIABLE i      AS INTEGER NO-UNDO.

    /* make sure there is at least one object selected */
    nRows = BrowseList:NUM-SELECTED-ROWS NO-ERROR.
    IF nRows <= 0 THEN DO:
        MESSAGE msg[5]
         VIEW-AS ALERT-BOX ERROR BUTTONS OK.

        RETURN NO-APPLY.
    END.
    
   REPEAT i = 1 TO nRows:
       BrowseList:FETCH-SELECTED-ROW(i).
       /* make sure we never let objects with 'previous' policy go through */
       IF NOT ttObjAttrs.has-prev-pol THEN
          ASSIGN ttObjAttrs.obj-selected = YES.
   END.

   /* only leave the selected ones */
   FOR EACH ttObjAttrs WHERE ttObjAttrs.obj-selected = NO.
       DELETE ttObjAttrs.
   END.
END.

ON VALUE-CHANGED OF TogCipher IN FRAME ObjSelFrame
DO:
    /* this toggle controls whether the cipher combo-box is enabled or not */
    IF SELF:SCREEN-VALUE IN FRAME ObjSelFrame = "no" THEN DO:
        ASSIGN Cipher:SENSITIVE = NO.
        RUN refreshObjList.
    END.
    ELSE DO:
        ASSIGN Cipher:SENSITIVE = YES.
        APPLY 'value-changed' TO cipher.
    END.

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* don't show it if can't pick cipher */
    Cipher:HIDDEN = NOT Cipher:SENSITIVE.
&ENDIF

END.

ON VALUE-CHANGED OF TogAllEnc IN FRAME ObjSelFrame
DO:
    IF SELF:SCREEN-VALUE IN FRAME ObjSelFrame = "no" THEN DO:
        /* if hiding objects with encryption enabled, warn user if he has selected
           such objects since they will be automatically deselected.
        */
        RUN confirmBeforeShowChange(INPUT SELF).
        IF RETURN-VALUE = "NO-APPLY" THEN DO:
            SELF:SCREEN-VALUE = "yes".
            APPLY "ENTRY" TO SELF.
            RETURN NO-APPLY.
        END.

        ASSIGN TogCipher:SENSITIVE = NO
               Cipher:SENSITIVE = NO
               TogCipher = NO
               TogCipher:SCREEN-VALUE = "no".

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
       /* don't show it if can't pick cipher */
        Cipher:HIDDEN = NOT TogCipher:SENSITIVE.
&ENDIF


        /* don't let both to be unchecked */
        IF TogAllNonEnc:SCREEN-VALUE = "no" THEN DO:
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
            /* on GUI, the toggle remains de-selected, so change it manually */
            ASSIGN TogAllNonEnc:SCREEN-VALUE = "YES".
&ENDIF
            APPLY "value-changed" TO TogAllNonEnc.
            RETURN.
        END.
    END.
    ELSE
        ASSIGN TogCipher:SENSITIVE = YES.
    RUN refreshObjList.
END.

ON VALUE-CHANGED OF TogAllNonEnc IN FRAME ObjSelFrame
DO:
    IF SELF:SCREEN-VALUE IN FRAME ObjSelFrame = "no" THEN DO:
        /* if hiding objects with encryption disabled, warn user if he has selected
           such objects since they will be automatically deselected.
        */
        RUN confirmBeforeShowChange(INPUT SELF).
        IF RETURN-VALUE = "NO-APPLY" THEN DO:
            SELF:SCREEN-VALUE = "yes".
            APPLY "ENTRY" TO SELF.
            RETURN NO-APPLY.
        END.

        /* don't let both to be unchecked */
        IF TogAllEnc:SCREEN-VALUE = "no" THEN DO:
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
            /* on GUI, the toggle remains de-selected, so change it manually */
           ASSIGN TogAllEnc:SCREEN-VALUE = "YES".
&ENDIF
           APPLY "value-changed" TO TogAllEnc.
           RETURN.
        END.
    END.

    RUN refreshObjList.
END.

ON END-ERROR OF FRAME ObjSelFrame OR
   CHOOSE OF Btn_Cancel IN FRAME ObjSelFrame
DO:
    DEFINE VARIABLE answer AS LOGICAL NO-UNDO.
    DEFINE VARIABLE nRows  AS INTEGER NO-UNDO.

    /* ask for confirmation if user tried to cancel and there are objects selected */
    nRows = BrowseList:NUM-SELECTED-ROWS NO-ERROR.
    IF nRows > 0 THEN DO:
        MESSAGE "There are objects selected. Are you sure you want to close this window ?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
    
        IF NOT answer THEN
            RETURN NO-APPLY.
    END.

    EMPTY TEMP-TABLE ttObjAttrs NO-ERROR.
END.

ON VALUE-CHANGED OF Cipher IN FRAME ObjSelFrame
DO:
    /* if changing the cipher for the objects to be shown, warn user if he has selected
       objects with other cuphers since they will be automatically deselected.
    */
    RUN confirmBeforeShowChange(INPUT SELF).
    IF RETURN-VALUE = "NO-APPLY" THEN DO:
        APPLY "ENTRY" TO SELF.
        /* put original value back */
        cipher:SCREEN-VALUE = cipher.
        RETURN NO-APPLY.
    END.

    /* save current value in case we need to return no-apply (above) */
    cipher = cipher:SCREEN-VALUE.

    RUN refreshObjList.
END.

ON VALUE-CHANGED OF TogIndex IN FRAME ObjSelFrame OR
   /*VALUE-CHANGED OF TogTables IN FRAME ObjSelFrame OR*/
   VALUE-CHANGED OF TogLobs IN FRAME ObjSelFrame
DO: 
    IF SELF:SCREEN-VALUE = "no" THEN DO:

        /* if hiding objects with specific type, warn user if he has selected
           such objects since they will be automatically deselected.
        */
       RUN confirmBeforeShowChange(INPUT SELF).
       IF RETURN-VALUE = "NO-APPLY" THEN DO:
           SELF:SCREEN-VALUE = "yes".
           APPLY "ENTRY" TO SELF.
           RETURN NO-APPLY.
       END.
    END.

    RUN refreshObjList.
    
END.

ON CHOOSE OF Btn_Select_Some IN FRAME ObjSelFrame
DO:
   DEFINE VARIABLE n             AS INT    NO-UNDO.
   DEFINE VARIABLE filterCipher  AS CHAR   NO-UNDO.
   DEFINE VARIABLE cTypes        AS CHAR   NO-UNDO.
   DEFINE VARIABLE rrowid        AS ROWID  NO-UNDO.

   ASSIGN n = BrowseList:FOCUSED-ROW.

   ASSIGN FRAME obj_patt:TITLE = "Select Objects by Pattern Match"
          pprompt = "Enter name of object to select.".

   display pprompt with frame obj_patt.
 
   do ON ENDKEY UNDO, LEAVE:
      update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
          with frame obj_patt.

      pattern = TRIM(pattern).
      IF pattern = "*" THEN
         BrowseList:SELECT-ALL().
      ELSE DO:
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
          /* can't have this since this causes issues with selected rows
             on multi-select browse on tty - OE00172180 
          */
          BrowseList:SET-REPOSITIONED-ROW(n,"conditional").
&ENDIF
          /* get the objects that are displayed now */
          RUN getCurrentOptions(OUTPUT cTypes, OUTPUT filterCipher).
          
          FOR EACH ttObjAttrs WHERE ttObjAttrs.obj-name MATCHES pattern.
              /* Let's avoid repositioning to a record that we know it's
                 not been displayed, or the reposition will fail!
              */
              IF CAN-DO(cTypes,ttObjAttrs.obj-type) THEN DO:
                 /* check if the user has cipher filter */

                 /* if no cipher filtered, or only encrypted or
                     a specific cipher or disabled
                 */
                 IF filterCipher = ? 
                    OR (filterCipher = "ALL" AND ttObjAttrs.obj-cipher NE "")
                    OR CAN-DO(filterCipher,ttObjAttrs.obj-cipher) THEN DO:
                     /* store the rowid of the first row selected so we move
                        focus to it later - OE00172180.
                     */
                     IF rrowid = ? THEN
                        rrowid = ROWID(ttObjAttrs).
                    REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs).
                    BrowseList:SELECT-ROW(BrowseList:FOCUSED-ROW).
                 END.
              END.
          END.

          /* move to the first selected, if any - OE00172180 */
          IF rrowid NE ? THEN
              REPOSITION BrowseList TO ROWID rrowid.
      END.
    
      /* make sure we don't select objects with 'previous' policy */
      RUN check-multi-selected.

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty Windows, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

   END.
END.

ON CHOOSE OF Btn_Deselect_Some IN FRAME ObjSelFrame
DO:
   DEFINE VAR nRows AS INTEGER NO-UNDO.
   DEFINE VAR i     AS INTEGER NO-UNDO.

   ASSIGN FRAME obj_patt:TITLE = "Deselect Objects by Pattern Match"
          pprompt = "Enter name of object to deselect.".
     
   display pprompt with frame obj_patt.
 
   do ON ENDKEY UNDO, LEAVE:
      update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
           with frame obj_patt.
      
      nRows = BrowseList:NUM-SELECTED-ROWS.
     
      IF nRows > 0 THEN DO:
          pattern = TRIM(pattern).
          IF pattern = "*" THEN
             BrowseList:DESELECT-ROWS().
          ELSE DO:
               rpt-blk:
               REPEAT i = 1 TO nRows:
                   BrowseList:FETCH-SELECTED-ROW(i).
                   IF ttObjAttrs.obj-name MATCHES pattern THEN DO:
                        BrowseList:DESELECT-SELECTED-ROW(i).
                        /* now that we have deselected the row, decrement the counters */
                        ASSIGN i = i - 1
                               nRows = nRows - 1.
                   END.
               END.
          END.
      END.
   END.
END.

/* when selecting with CTRL + mouse click */
ON MOUSE-EXTEND-UP OF BrowseList IN FRAME ObjSelFrame
DO:
    IF BrowseList:FOCUSED-ROW-SELECTED THEN DO:
        IF ttObjAttrs.has-prev-pol THEN DO:

           BrowseList:DESELECT-FOCUSED-ROW().

           MESSAGE msg[1] SKIP msg[2]
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        END.
    END.
END.

/* to handle selection with mouse dragging on GUI */
ON mouse-select-down OF BrowseList IN FRAME ObjSelFrame
DO:
    /* keep track of how many rows are selected now, so that if the user
       drags the mouse to select multiple rows, we know if he has selected
       one row or multiple rows, so that we do the right thing in the
       mouse-select-up trigger.
    */
    numPrevSelected = BrowseList:NUM-SELECTED-ROWS.
END.

/* to handle selection with mouse dragging on GUI */
ON mouse-select-up OF BrowseList IN FRAME ObjSelFrame
DO:
    DEF VAR i AS INT NO-UNDO.
    DEF VAR j AS INT NO-UNDO.
    DEF VAR dispMsg AS LOGICAL NO-UNDO.

    i = BrowseList:NUM-SELECTED-ROWS.

    IF i = numPrevSelected THEN DO:
        /* if the user is selecting a row with an object that has a 'previous'
           policy, don't let it be selected.
        */
        IF BrowseList:FOCUSED-ROW-SELECTED THEN DO:
            IF ttObjAttrs.has-prev-pol THEN DO:
    
               BrowseList:DESELECT-FOCUSED-ROW().
    
               MESSAGE msg[1] SKIP msg[2]
                   VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            END.
        END.
    END.
    ELSE IF i > numPrevSelected THEN DO:
        RUN check-multi-selected.
    END.
END.

ON VALUE-CHANGED OF BrowseList IN FRAME ObjSelFrame
DO:
    /* only check this when there are rows selected. When there is no row
       selected, i.e. you had selected one row, and now you deselected that
       only selected row, the available record is the first one in the
       browse, and if that happens to have a previous policy, we will
       display the message althought that is not the table that got
       deselected.
    */
    IF BrowseList:NUM-SELECTED-ROWS > 0 AND AVAILABLE ttObjAttrs THEN DO:
        IF ttObjAttrs.has-prev-pol THEN DO:
            BrowseList:DESELECT-FOCUSED-ROW().
            MESSAGE msg[1] SKIP msg[2]
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
            RETURN NO-APPLY.
        END.
    END.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
  ON F5 OF FRAME ObjSelFrame ANYWHERE DO:
     APPLY "CHOOSE" TO Btn_Select_Some IN FRAME ObjSelFrame.
  END.

  ON F6 OF FRAME ObjSelFrame ANYWHERE DO:
     APPLY "CHOOSE" TO Btn_Deselect_Some IN FRAME ObjSelFrame.
  END.

  ON F7 OF FRAME ObjSelFrame ANYWHERE DO:
     APPLY "ENTRY" TO TogIndex IN FRAME ObjSelFrame.
  END.
             
&ENDIF

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME ObjSelFrame:PARENT eq ?
THEN FRAME ObjSelFrame:PARENT = ACTIVE-WINDOW.

RUN populateValues.

IF NOT CAN-FIND (FIRST ttObjAttrs) THEN DO:
   IF myEPolicy:EncryptionEnabledOnly THEN
       MESSAGE "There are no objects with encryption currently enabled."
           VIEW-AS ALERT-BOX INFO BUTTONS OK.
   ELSE
       MESSAGE "There are no objects that can have encryption policies~nmaintained through this client."
           VIEW-AS ALERT-BOX INFO BUTTONS OK.
   RETURN ERROR.
END.
ELSE DO:
    
    /* if all objects have a previous policy, can't select any */
    IF NOT CAN-FIND (FIRST ttObjAttrs WHERE NOT has-prev-pol) THEN DO:
       IF myEPolicy:EncryptionEnabledOnly THEN DO:
          MESSAGE "All objects with encryption enabled have a policy in transition." SKIP
                  "You must complete the transition before generating the encryption" SKIP
                  "key for any given object. Refer to the proutil epolicy utility."
              VIEW-AS ALERT-BOX INFO.
       END.
       ELSE DO:
           MESSAGE "All encryptable objects have a policy in transition." SKIP
                   "You must complete the transition before updating the policy" SKIP
                   "for any given object. Refer to the proutil epolicy utility." SKIP
               VIEW-AS ALERT-BOX INFO.
       END.
       RETURN ERROR.
    END.

    /* if only selecting from enabled ones, check if only LOBS are selectable */
    IF myEPolicy:EncryptionEnabledOnly THEN DO:
       DEFINE VARIABLE opt AS LOGICAL NO-UNDO.

       IF NOT CAN-FIND (FIRST ttObjAttrs WHERE NOT has-prev-pol AND 
                        (obj-type = "Table" OR obj-type = "Index"))  THEN DO:
           MESSAGE "There are no tables or indexes with encryption enabled or" SKIP
                   "that do not have a policy in transition. " SKIP 
                   "Do you want to view LOB fields?"
                   VIEW-AS ALERT-BOX QUESTION BUTTON YES-NO UPDATE opt.
           IF NOT opt THEN
              RETURN ERROR.

           /* turn on the lobs toggle-box */
           togLobs = YES.
       END.
    END.
END.

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
/* assign help for all elements */
ASSIGN cHelp = KBLABEL("GO") + "=OK " +
                             KBLABEL("END-ERROR") + "=Cancel  " +
                             KBLABEL("F5") + "/"  +
                             KBLABEL("F6") + "=Select/Deselect Some  " +
                             KBLABEL("F7") + "=Focus to Filter"
        BROWSE BrowseList:HELP = cHelp
        Btn_Select_Some:HELP = cHelp
        Btn_Deselect_Some:HELP = cHelp
        TogIndex:HELP = cHelp
        TogLobs:HELP = cHelp
        TogAllNonEnc:HELP = cHelp
        TogAllEnc:HELP = cHelp
        TogCipher:HELP = cHelp
        Cipher:HELP = cHelp
        Btn_OK:HELP = cHelp
        Btn_Cancel:HELP = cHelp.
      
&ENDIF

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
ASSIGN cHeader[1] = "Select one or more objects with the [SPACEBAR] key."
       cHeader[2] = "Press [" + KBLABEL("GO") + "] to go to the next screen.".
&ELSE
ASSIGN cHeader[1] = "Select one or more objects and hit the OK button to go to the next screen.".
&ENDIF

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME obj_patt" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

{adecomm/okrun.i  
   &FRAME  = "FRAME ObjSelFrame" 
   &OKBOX  = NO
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  /* set the display name as the object name */
  FOR EACH ttObjAttrs:
      ttObjAttrs.disp-name = ttObjAttrs.obj-name.
  END.

  /* if only selecting from objects that have encryption currently
     enabled, adjust the toggle-boxes values.
  */
  IF myEPolicy:EncryptionEnabledOnly THEN DO:
     ASSIGN TogAllEnc = YES
            TogAllNonEnc = NO.
  END.

  RUN enable_UI.

  WAIT-FOR GO OF FRAME ObjSelFrame.
END.

RUN disable_UI.


/* **********************  Internal Procedures  *********************** */

/* Check if any one of the selected objects has a 'previous' policy and 
   de-select it.
*/
PROCEDURE check-multi-selected.

    DEF VAR i       AS INT NO-UNDO.
    DEF VAR numS    AS INT NO-UNDO.
    DEF VAR dispMsg AS LOGICAL NO-UNDO.

    numS = BrowseList:NUM-SELECTED-ROWS IN FRAME ObjSelFrame.

    REPEAT i = 1 TO numS:
        BrowseList:FETCH-SELECTED-ROW(i).
        IF ttObjAttrs.has-prev-pol THEN DO:
            IF NOT dispMsg THEN
                dispMsg = YES.

            BrowseList:DESELECT-SELECTED-ROW(i).
            /* now that we have deselected the row, decrement the counters */
            ASSIGN i = i - 1
                   numS = numS - 1.
        END.
    END.

    IF dispMsg THEN
        MESSAGE msg[3] SKIP msg[4]
            VIEW-AS ALERT-BOX WARNING BUTTONS OK.

END.

/* If user is changing the objects to be display, let user know that any selected
   objects that are not going to be displayed will be deselected.
*/   
PROCEDURE confirmBeforeShowChange:
    DEFINE INPUT  PARAMETER hObj AS HANDLE NO-UNDO.
    
    DEFINE VARIABLE answer  AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE cType   AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cCipher AS CHARACTER NO-UNDO INIT ?.
    DEFINE VARIABLE nRows   AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i       AS INTEGER   NO-UNDO.

    /* the object we get here is what is getting changed */
    IF hObj:NAME = "TogIndex" THEN
       ASSIGN cType = "Index".
    ELSE IF hObj:NAME = "TogLobs" THEN
            ASSIGN cType = "CLOB,BLOB".
    ELSE IF hObj:NAME = "Cipher" THEN DO:
        /* we are moving to a cipher, so check if any one of the selected rows has a
          different cipher.
        */
        cCipher = "!" + cipher:SCREEN-VALUE IN FRAME ObjSelFrame + ",*".
    END.
    ELSE IF hObj:NAME = "TogAllEnc" THEN
        cCipher = "ALL".
    ELSE IF hObj:NAME = "TogAllNonEnc" THEN
        cCipher = "".

    nRows = BrowseList:NUM-SELECTED-ROWS.

    IF nRows > 0 THEN DO:
       rpt-blk:
       REPEAT i = 1 TO nRows:
           BrowseList:FETCH-SELECTED-ROW(i).
           /* if type is being turned off and objects with that type were selected,
              or want all objects with a valid cipher and object select does not have a
              policy with a encryption cipher
              or not the "diplay all" case and cipher is the one it going to be hidden
              then warn user that those objects will get deselected.
           */
           IF (cType NE "" AND CAN-DO(cType, ttObjAttrs.obj-type)) 
               OR (cCipher EQ "ALL" AND ttObjAttrs.obj-cipher NE "")
               OR (cCipher NE ? AND CAN-DO(cCipher, ttObjAttrs.obj-cipher)) THEN DO:
               MESSAGE "You have selected objects which will get deselected"
                   SKIP "when changing this setting. Do you want to continue?"
                   VIEW-AS ALERT-BOX WARNING BUTTONS YES-NO UPDATE answer.

               IF NOT answer THEN DO:
                  RETURN "NO-APPLY".
               END.
               LEAVE rpt-blk. /* get out of loop */
           END.
       END.
    END.

    RETURN "".
END.

PROCEDURE disable_UI :
  /* Hide all frames */
  HIDE FRAME ObjSelFrame.
END PROCEDURE.

PROCEDURE enable_UI :

  DISPLAY cHeader[1] 
&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
          cHeader[2]
&ENDIF
          BrowseList /*TogTables*/
          TogIndex TogLobs TogAllNonEnc TogAllEnc  TogCipher Cipher Rect1
      WITH FRAME ObjSelFrame.
  ENABLE BrowseList Btn_Select_Some Btn_Deselect_Some /*TogTables*/ TogIndex
         TogLobs TogAllNonEnc TogAllEnc TogCipher Btn_OK Btn_Cancel
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
      WITH FRAME ObjSelFrame.

  IF NOT CipherListAvailable THEN
    DISABLE TogCipher WITH FRAME ObjSelFrame.

  IF myEPolicy:EncryptionEnabledOnly THEN
      DISABLE TogAllNonEnc TogAllEnc WITH FRAME ObjSelFrame.

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    Cipher:HIDDEN = YES.
&ENDIF

  VIEW FRAME ObjSelFrame.

  RUN refreshObjList.

END PROCEDURE.


PROCEDURE populateValues:         
    DEF VAR cList AS CHAR NO-UNDO.

    /* populate the dataset */
    myEPolicy:getTableList(INPUT YES, /* get current policy info */
                           OUTPUT DATASET dsObjAttrs BY-REFERENCE).

    cList = myEPolicy:CipherNames NO-ERROR.
    IF NOT (cList = ? OR cList = "") THEN DO:
       ASSIGN cipher:LIST-ITEMS IN FRAME ObjSelFrame = cList
              CipherListAvailable = TRUE
              cipher = myEPolicy:DefaultCipher.
    END.
END.

PROCEDURE refreshObjList:
    DEFINE VARIABLE filterCipher  AS CHAR      NO-UNDO.
    DEFINE VARIABLE cTypes        AS CHARACTER NO-UNDO.
    DEFINE VARIABLE nRows         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE i             AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFocused      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cQueryStr     AS CHARACTER NO-UNDO.
    DEFINE VARIABLE needtoSelect  AS LOGICAL   NO-UNDO.

    RUN getCurrentOptions(OUTPUT cTypes, OUTPUT filterCipher).

    /*mantain selected rows */
    nRows = BrowseList:NUM-SELECTED-ROWS IN FRAME ObjSelFrame.
    
    IF nRows > 0 THEN DO:

       REPEAT i = 1 TO nRows:
           BrowseList:FETCH-SELECTED-ROW(i).
           /* only keep track of objects that need to be reselected after we reopen the
              query.
           */
           IF CAN-DO(cTypes,ttObjAttrs.obj-type) THEN DO:
               IF filterCipher = ?
                  OR (filterCipher = "ALL" AND ttObjAttrs.obj-cipher NE "")
                  OR CAN-DO(filterCipher,ttObjAttrs.obj-cipher) THEN
              ASSIGN ttObjAttrs.obj-selected = YES.
           END.
       END.
    END.

    CLOSE QUERY BrowseList.

    /* build query based on the options the user selected on what objects to be displayed */
    IF CAN-FIND(FIRST ttObjAttrs WHERE obj-selected = YES) THEN
       ASSIGN needToSelect = YES
              cQueryStr = "PRESELECT ".
    ELSE
        cQueryStr = "FOR ".

    cQueryStr = cQueryStr + "EACH ttObjAttrs WHERE CAN-DO(" 
                + QUOTER(cTypes) + ",ttObjAttrs.obj-type) ".

    IF filterCipher EQ "ALL" THEN
        cQueryStr = cQueryStr + 'AND obj-cipher NE "" '.
    ELSE IF filterCipher NE ? THEN DO:
        
        cQueryStr = cQueryStr + 'AND (obj-cipher = ' + QUOTER(ENTRY(1,filterCipher)).
        IF NUM-ENTRIES(filterCipher) > 1 THEN
            cQueryStr = cQueryStr + ' OR obj-cipher = ' + QUOTER(ENTRY(2,filterCipher)).
        cQueryStr = cQueryStr + ")". /* close the AND */
    END.
    
    cQueryStr = cQueryStr + " NO-LOCK" /*+ (IF NOT needToSelect THEN " INDEXED-REPOSITION" ELSE "")*/ .

    QUERY BrowseList:QUERY-PREPARE(cQueryStr).
    QUERY BrowseList:QUERY-OPEN().

    IF CAN-FIND(FIRST ttObjAttrs WHERE obj-selected = YES) THEN DO:
       FOR EACH ttObjAttrs WHERE obj-selected = YES:
           /* try to re-select the rows */
           REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs) NO-ERROR.
           IF NOT ERROR-STATUS:ERROR THEN
              BrowseList:SELECT-ROW(BrowseList:FOCUSED-ROW).
           ASSIGN obj-selected = NO.
       END.
    END.

    /* if no objects are available, can't select/deselect all */
    ASSIGN  Btn_Select_Some:SENSITIVE = QUERY BrowseList:NUM-RESULTS > 0
            Btn_Deselect_Some:SENSITIVE = Btn_Select_Some:SENSITIVE.


&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty Windows, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

END.

PROCEDURE getCurrentOptions:
    DEFINE OUTPUT PARAMETER cTypes       AS CHAR.
    DEFINE OUTPUT PARAMETER filterCipher AS CHAR.

    /*DEFINE VARIABLE showTables  AS LOGICAL NO-UNDO.*/
    DEFINE VARIABLE showIndexes   AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE showLobs      AS LOGICAL   NO-UNDO.

    ASSIGN /*showTables = TogTables:SCREEN-VALUE IN FRAME ObjSelFrame = "yes"*/
           showIndexes = TogIndex:SCREEN-VALUE IN FRAME ObjSelFrame = "yes"
           showLobs = TogLobs:SCREEN-VALUE IN FRAME ObjSelFrame = "yes".

    IF Cipher:SENSITIVE THEN DO:
        IF TogAllNonEnc:SCREEN-VALUE = "yes"  THEN
           filterCipher = "," + Cipher:SCREEN-VALUE.
        ELSE
            filterCipher = Cipher:SCREEN-VALUE.
    END.
    ELSE IF TogAllEnc:SCREEN-VALUE = "yes" AND TogAllNonEnc:SCREEN-VALUE = "no" THEN
        filterCipher = "ALL". /* means all valid ciphers */
    ELSE  IF TogAllEnc:SCREEN-VALUE = "no" AND TogAllNonEnc:SCREEN-VALUE = "yes" THEN
        filterCipher = "". /* means cipher not enabled (or null_null_null) */
    ELSE /*if both are yes, we leave filterCipher as ? which means no cipher filter */
        filterCipher = ?.
    
    ASSIGN cTypes = "Table".
    IF showIndexes THEN
        ASSIGN cTypes = cTypes + ",Index".
    IF showLobs THEN
        ASSIGN cTypes = cTypes + ",CLOB,BLOB".

END.
/*********************************************************************
* Copyright (C) 2008-2010 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_sec-pol-driver.p

Description:
    Driver program for various utilities on security policies (encryption).

Input-Parameters:
    cMode: edit - edit policies
           generate - generate encryption key
           history - shows history of policies

Output-Parameters:
    none
    
History:
    07/01/08  fernando   created

--------------------------------------------------------------------*/
                                
DEFINE INPUT PARAMETER cMode AS CHARACTER NO-UNDO.
DEFINE VARIABLE cMsg         AS CHARACTER NO-UNDO.

/*DEF VAR cMode AS CHAR INIT "generate".*/

{prodict/misc/misc-funcs.i}
{prodict/sec/sec-pol.i}

DEF VAR myEPolicyCache AS prodict.sec._sec-pol-util.

IF NOT CAN-DO("edit,generate,history",cMode) THEN DO:
    MESSAGE 'Called with an invalid context'
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN ERROR. 
END.

IF NOT CONNECTED("DICTDB") THEN DO:
    MESSAGE "DICTDB database is required but it is not connected!"
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF NOT dbAdmin(USERID("DICTDB")) THEN DO:
  MESSAGE "You must be a Security Administrator to access this utility!"
      VIEW-AS ALERT-BOX ERROR BUTTONS OK.
  RETURN "".
END.

IF NOT CAN-DO("history",cMode)
   AND CAN-DO("READ-ONLY",DBRESTRICTIONS("DICTDB")) THEN DO:
    MESSAGE "The dictionary is in read-only mode - alterations not allowed."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.

IF DBTYPE("DICTDB") NE "PROGRESS" THEN DO:
    MESSAGE "Cannot run this utility with this database type."
        VIEW-AS ALERT-BOX ERROR BUTTONS OK.
    RETURN "".
END.


DO TRANSACTION ON ERROR UNDO, LEAVE
               ON STOP  UNDO, LEAVE:
   /* this will acquire a schema lock for us on the DICTDB database */
   myEPolicyCache = NEW prodict.sec._sec-pol-util().

   IF cMode = "history" THEN
       RUN prodict/sec/_sec-pol-hist.p(INPUT myEPolicyCache).
   ELSE DO:
   
       IF NOT myEPolicyCache:canMantainPolicies THEN
          UNDO, THROW NEW Progress.Lang.AppError("Cannot run this utility if you are not the Key Store Administrator", 1).

       /* for the generate key tool, only want objects with encryption
          currently enabled (and not using the null_null_null cipher
       */
       IF cMode = "generate" THEN
          myEPolicyCache:EncryptionEnabledOnly = TRUE.

       RUN prodict/sec/_sec-obj-sel.p (INPUT myEPolicyCache,
                                       OUTPUT DATASET dsObjAttrs BY-REFERENCE).
    
       IF CAN-FIND(FIRST ttObjAttrs) THEN DO:
          /* now we have the objects selected by the user */
    
          IF cMode = "edit" THEN DO:
              RUN prodict/sec/_sec-pol-edit.p(INPUT myEPolicyCache,
                                              INPUT DATASET dsObjAttrs BY-REFERENCE).
              /* if something goes wrong, an error is thrown and we don't get to the
                 next statement.
              */
              cMsg = 'Changes committed.'.
          END.
          ELSE IF cMode = "generate" THEN DO:
              RUN prodict/sec/_sec-gen-key.p (INPUT myEPolicyCache,
                                              INPUT DATASET dsObjAttrs BY-REFERENCE).

              /* if something goes wrong, an error is thrown and we don't get to the
                 next statement.
              */
              cMsg = 'Keys generated.'.
          END.
       END.
   END.
                
   CATCH ae AS PROGRESS.Lang.AppError:
       /* 'edit' mode returns error if user did not commit, so that we undo
          the transaction. If message is blank, no need to display anything.
       */
       IF ae:GetMessage(1) NE "" THEN
          MESSAGE  ae:GetMessage(1) 
               VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       DELETE OBJECT ae.
   END CATCH.
   FINALLY:
      IF VALID-OBJECT(myEPolicyCache) THEN
         DELETE OBJECT myEPolicyCache NO-ERROR.
   END FINALLY.

END.
 
/* display message when all was ok, outside the transaction so that the
   message doesn't hold the transaction open if the user leaves for a while.
*/
IF cMsg NE '' THEN
    MESSAGE cMsg
        VIEW-AS ALERT-BOX INFO BUTTONS OK.
/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_sec-pol-edit.p

Description:
    Interface for editing and saving encryption policies (encryption)

Input-Parameters:
    myEPolicy - _sec-pol-util object
    dsObjAttrs - dataset with objects selected by user for editing

Output-Parameters:
    none
    
History:
    07/01/08  fernando   created

                            
--------------------------------------------------------------------*/
CREATE WIDGET-POOL.

{prodict/sec/sec-pol.i}
{adecomm/adestds.i}

DEFINE INPUT PARAMETER myEPolicy AS CLASS prodict.sec._sec-pol-util.
DEFINE INPUT PARAMETER DATASET FOR dsObjAttrs.

DEFINE VARIABLE isEditing       AS LOGICAL NO-UNDO.
DEFINE VARIABLE Committed       AS LOGICAL NO-UNDO.
DEFINE VARIABLE onlyOne         AS LOGICAL NO-UNDO.
DEFINE VARIABLE currdefCipher   AS CHAR    NO-UNDO.
DEFINE VARIABLE cipherChanged   AS LOGICAL NO-UNDO.
DEFINE VARIABLE hFakeCipher     AS HANDLE  NO-UNDO.
DEFINE VARIABLE isCurrDisabled  AS LOGICAL NO-UNDO.
DEFINE VARIABLE pprompt         AS CHARACTER NO-UNDO.
DEFINE VARIABLE pattern         AS CHARACTER NO-UNDO INITIAL "*".
DEFINE VARIABLE cHelp           AS CHARACTER NO-UNDO.
DEFINE VARIABLE firstUpdate     AS LOGICAL   NO-UNDO INITIAL YES.
DEFINE VARIABLE cObjType        AS CHARACTER NO-UNDO.

/* temp-table for review option */
DEFINE TEMP-TABLE ttReport NO-UNDO
    FIELD obj-name    AS CHAR
    FIELD obj-type    AS CHAR
    FIELD old-cipher  AS CHAR
    FIELD new-cipher  AS CHAR
    INDEX obj-name IS UNIQUE obj-name obj-type new-cipher.

/* temp-table for copy option */
DEFINE TEMP-TABLE ttCopy NO-UNDO
    FIELD seq         AS INT
    FIELD obj-name    AS CHAR
    FIELD obj-type    AS CHAR
    FIELD obj-cipher  AS CHAR
    FIELD obj-genkey  AS LOGICAL
    INDEX obj-name IS UNIQUE seq obj-name.

DEFINE VARIABLE TogEnabled AS LOGICAL INITIAL no 
     LABEL "&Encryption enabled" 
     VIEW-AS TOGGLE-BOX
     SIZE 24 BY .81 NO-UNDO.

DEFINE VARIABLE TogGenKey AS LOGICAL INITIAL no 
     LABEL "New encr&yption key" 
     VIEW-AS TOGGLE-BOX
     SIZE 27 BY .81 NO-UNDO.

DEFINE VARIABLE objType AS CHARACTER FORMAT "X(6)":U 
     LABEL "Object Type" 
     VIEW-AS FILL-IN 
     SIZE 8 BY 1 NO-UNDO.

DEFINE VARIABLE cbCipher AS CHARACTER FORMAT "X(30)":U 
     LABEL "Cip&her" 
     VIEW-AS COMBO-BOX INNER-LINES 5
     DROP-DOWN-LIST
  &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN SIZE 30 BY 1 &ELSE SIZE 42 BY 1 &ENDIF NO-UNDO.

DEFINE VARIABLE Pass-phrase AS CHARACTER FORMAT "X(256)":U 
     LABEL "Pa&ssphrase" 
     VIEW-AS FILL-IN
     SIZE 42 BY 1  NO-UNDO.

DEFINE VARIABLE Verify-pass-phrase AS CHARACTER FORMAT "X(256)":U 
     LABEL "&Verify Passphrase" 
     VIEW-AS FILL-IN 
     SIZE 42 BY 1 NO-UNDO.

DEFINE RECTANGLE RECT-1
     EDGE-PIXELS 2 GRAPHIC-EDGE  NO-FILL   
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN SIZE 77 BY 7
&ELSE SIZE 78 BY 5.5 &ENDIF .

DEFINE BUTTON Btn_Commit AUTO-GO 
     LABEL "Co&mmit" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Review
     LABEL "&Review" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Save 
     LABEL "&Save" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Copy 
     LABEL "Co&py..." 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .

DEFINE BUTTON Btn_Revert 
     LABEL "&Revert" 
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 11 BY .95 &ENDIF .


DEFINE BUTTON Btn_Select_Some LABEL "&Select Some...".
DEFINE BUTTON Btn_Deselect_Some LABEL "&Deselect Some...".

DEFINE BUTTON btn_Ok     LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN   &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN   /* we have one but it's not passed to okrun.i */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
   &GLOBAL-DEFINE   STATUS NO
   &GLOBAL-DEFINE   BOX_BTN   &BOX = "rect_Btns"
   &SCOPED-DEFINE   ORIG_OKBOX {&OKBOX}
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN  &CANCEL = "btn_Cancel" /* so btn can be centered */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
   &GLOBAL-DEFINE   BOX_BTN
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF

/* main browse */
DEFINE QUERY BrowseList FOR ttObjAttrs SCROLLING.
DEFINE BROWSE BrowseList
    QUERY BrowseList NO-LOCK DISPLAY
    ttObjAttrs.disp-name COLUMN-LABEL "Object Name" FORMAT "x(66)":U WIDTH 66
    WITH NO-LABELS NO-ROW-MARKERS
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 77 BY 9 
&ELSE
    SIZE 78 BY 9
&ENDIF
     FIT-LAST-COLUMN.

/* browse for copy option */
DEFINE QUERY browse-Copy FOR ttCopy.
DEFINE BROWSE browse-Copy
   QUERY browse-Copy NO-LOCK DISPLAY
   ttCopy.obj-name COLUMN-LABEL "Object Name" FORMAT "x(65)":U WIDTH 66
   cObjType COLUMN-LABEL "Type" FORMAT "x(4)":U WIDTH 5
   WITH NO-LABELS MULTIPLE SIZE 77 BY 9 FIT-LAST-COLUMN.

/* ************************  Frame Definitions  *********************** */

/* main frame */
DEFINE FRAME Dialog-Frame
     BrowseList AT ROW 1.95 COL 1 WIDGET-ID 2
     TogEnabled AT ROW 11.90 COL 4 WIDGET-ID 10
     TogGenKey AT ROW 11.90 COL 29 WIDGET-ID 12
     objType   AT ROW 11.60 COL 56 WIDGET-ID 36
     cbCipher 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 14 COL 14
       &ELSE AT ROW 13.33 COL 20 COLON-ALIGNED &ENDIF WIDGET-ID 14
     Btn_Save 
        &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 14 COL 67
        &ELSE AT ROW 12.77 COL 66 &ENDIF WIDGET-ID 18
     Pass-phrase AT ROW 14.52 COL 20 COLON-ALIGNED PASSWORD-FIELD WIDGET-ID 20
     Btn_Copy 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 15 COL 67
       &ELSE  AT ROW 13.77 COL 66 &ENDIF WIDGET-ID 22
     Verify-pass-phrase AT ROW 15.71 COL 20 COLON-ALIGNED PASSWORD-FIELD WIDGET-ID 24
     Btn_Revert 
       &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 16 COL 67
       &ELSE AT ROW 14.77 COL 66 &ENDIF WIDGET-ID 26
     Btn_Commit AT ROW 17.57 COL 2
     Btn_Cancel AT ROW 17.57 COL 14
     Btn_Review AT ROW 17.57 COL 26 WIDGET-ID 32
     &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
       Btn_Help AT ROW 17.57 COL 69 
     &ENDIF
     "Objects (* = changed policy):" VIEW-AS TEXT
          SIZE 35 BY .62 AT ROW 1.24 COL 2 WIDGET-ID 34
     RECT-1 
      &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 11 COL 1
      &ELSE AT ROW 11.5 COL 1 &ENDIF WIDGET-ID 36
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
     SPACE(.5) SKIP(1)
&ENDIF
    WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
         SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
         TITLE "Edit Encryption Policy"
         DEFAULT-BUTTON Btn_Commit CANCEL-BUTTON Btn_Cancel WIDGET-ID 100.

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
  BROWSE BrowseList:HELP = KBLABEL("GO") + "=Commit  " +
                           KBLABEL("END-ERROR") + "=Cancel  " +
                           KBLABEL("F5") + "=Copy  " +
                           KBLABEL("F6") + "=Revert  " +
                           KBLABEL("F7") + "=Review".
      
&ENDIF

/* frame for copy option */
DEFINE FRAME SelectionCopy
   "If you want to copy the settings from the encryption policy of the current"
   VIEW-AS TEXT AT ROW 1 COL 2
   "object to other object(s), select them on the list below." 
   VIEW-AS TEXT AT ROW 1.7 COL 2
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
    Btn_Select_Some   AT 15 WIDGET-ID 2
    Btn_Deselect_Some  AT 45 WIDGET-ID 4
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SKIP(.1) &ENDIF
    browse-Copy AT 1 WIDGET-ID 6
   {prodict/user/userbtns.i}
WITH VIEW-AS DIALOG-BOX KEEP-TAB-ORDER 
    SIDE-LABELS NO-UNDERLINE THREE-D  SCROLLABLE 
    TITLE "Copy Encryption Policy Settings To"
    DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_Cancel WIDGET-ID 300.

/* frame for select - deselect some */
DEFINE FRAME  obj_patt
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pprompt  FORMAT "x(40)" NO-LABEL at 2 view-as TEXT
   "Use '*' and '.' for wildcard patterns.":t45 at 2 view-as TEXT 
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
   SKIP(1)
&ELSE
   SKIP(.5)
&ENDIF
   pattern  FORMAT "x(50)"   LABEL "Object Name":t17 at 2
   {prodict/user/userbtns.i}
   with view-as DIALOG-BOX TITLE "Select Objects by Pattern Match"
        SIDE-LABELS CENTERED THREE-D
        DEFAULT-BUTTON btn_OK CANCEL-BUTTON btn_Cancel.

/*adjust buttons to be in the middle for tty */
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN

  DEFINE VARIABLE eff_frame_width1 AS DECIMAL.  /* effective frame width */

  /* first for the main frame */
  ASSIGN eff_frame_width1 = FRAME Dialog-Frame:WIDTH-CHARS - 
                          FRAME Dialog-Frame:BORDER-LEFT-CHARS - 
                          FRAME Dialog-Frame:BORDER-RIGHT-CHARS.

  /* no help button for tty, and buttons in the middle */
   btn_Commit:COLUMN IN FRAME Dialog-Frame  = (eff_frame_width1 -
                          btn_Commit:WIDTH-CHARS IN FRAME Dialog-Frame -
                          btn_Cancel:WIDTH-CHARS IN FRAME Dialog-Frame -
                          btn_Review:WIDTH-CHARS IN FRAME Dialog-Frame -
                           5 ) / 2.
   btn_Cancel:COLUMN IN FRAME Dialog-Frame = btn_Commit:COLUMN IN FRAME Dialog-Frame + 
                            btn_Commit:WIDTH-CHARS IN FRAME Dialog-Frame + 
                                2.5.
   btn_Review:COLUMN IN FRAME Dialog-Frame = btn_Cancel:COLUMN IN FRAME Dialog-Frame + 
                            btn_Cancel:WIDTH-CHARS IN FRAME Dialog-Frame + 
                                2.5.
&ENDIF

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME Dialog-Frame /* Edit Encryption Policy */
DO:
  IF isEditing THEN DO:
      MESSAGE 'You are currently editing an encryption policy.' SKIP
              'Either save or cancel the changes.'
          VIEW-AS ALERT-BOX INFO BUTTONS OK.
      RETURN NO-APPLY.
  END. 
  
  APPLY "END-ERROR":U TO SELF.
END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN

/*----- HELP -----*/

ON CHOOSE OF Btn_Help IN FRAME Dialog-Frame /* Help */
OR HELP OF FRAME Dialog-Frame
DO: /* Call Help Function (or a simple message). */
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Edit_Encryption_Policy_Dialog_Box1},
                               INPUT ?).  
END.

on HELP of frame obj_patt OR CHOOSE of Btn_Help in frame obj_patt
DO:
   IF FRAME obj_patt:TITLE = "Select Objects by Pattern Match" THEN
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Select_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
   ELSE 
     RUN "adecomm/_adehelp.p" (INPUT "admn", INPUT "CONTEXT", 
      	       	     	       INPUT {&Deselect_Objects_by_Pattern_Match},
      	       	     	       INPUT ?).
END.      	       	


&ENDIF

&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN

ON ANY-PRINTABLE OF BrowseList IN FRAME Dialog-Frame
DO:
    DEF VAR ch   AS CHAR NO-UNDO.
    DEF VAR curr AS CHAR NO-UNDO.

    /* simulate search on tty so user can find object that starts with a given character */
    ch = CHR(LASTKEY).

    BrowseList:FETCH-SELECTED-ROW(1).
    curr = ttObjAttrs.obj-name.

    IF ttObjAttrs.obj-name BEGINS ch THEN DO:
        FIND FIRST ttObjAttrs WHERE obj-name > curr NO-ERROR.

        IF NOT AVAILABLE ttObjAttrs THEN
           FIND FIRST ttObjAttrs WHERE obj-name BEGINS ch NO-ERROR.
    END.
    ELSE
       FIND FIRST ttObjAttrs WHERE obj-name BEGINS ch NO-ERROR.

    IF AVAILABLE ttObjAttrs AND obj-name BEGINS ch THEN DO:
        REPOSITION BrowseList TO ROWID ROWID(ttObjAttrs).
        APPLY "VALUE-CHANGED" TO BrowseList.
    END.
    ELSE
        BrowseList:FETCH-SELECTED-ROW(1).
END.

&ENDIF

ON VALUE-CHANGED OF BrowseList IN FRAME Dialog-Frame
DO:
    DO WITH FRAME Dialog-Frame:
        
        ASSIGN isCurrDisabled = NO.

        /* remember if encryption is currently disabled for this object */
        FIND FIRST bfttObjAttrs WHERE ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        IF AVAILABLE bfttObjAttrs THEN DO:
            IF bfttObjAttrs.obj-cipher = "" THEN
                isCurrDisabled = YES.
        END.
        ELSE IF ttObjAttrs.obj-cipher = "" THEN
            isCurrDisabled = YES.

        ASSIGN objType = ttObjAttrs.obj-type
               TogGenKey = ttObjAttrs.obj-genkey.

        IF ttObjAttrs.obj-cipher = "" THEN DO:
            ASSIGN cbCipher:SENSITIVE = NO
                   hFakeCipher:HIDDEN = NO
                   togEnabled = NO
                   TogGenKey:SENSITIVE = NO.
        END.
        ELSE DO:
            ASSIGN cbCipher:SENSITIVE = YES
                   cbCipher =  ttObjAttrs.obj-cipher
                   togEnabled = YES
                   hFakeCipher:HIDDEN = YES.

            DISPLAY cbCipher WITH FRAME Dialog-Frame.

            RUN enableGenKey.
        END.

        DISPLAY objType togEnabled TogGenKey WITH FRAME Dialog-Frame.

        /* if there are changes that can be undone, enable the revert button */
        Btn_Revert:SENSITIVE = (IF ttObjAttrs.disp-name BEGINS "*" THEN YES ELSE NO).

        /* only enable copy if there was a change, and not only one object on the lsit */
        IF NOT onlyOne THEN
           Btn_Copy:SENSITIVE = Btn_Revert:SENSITIVE.

    END.
END.

ON VALUE-CHANGED OF TogEnabled IN FRAME Dialog-Frame 
DO:
    DEFINE VARIABLE savedCipher AS CHAR NO-UNDO.

    RUN StartEdit.                    

    DO WITH FRAME Dialog-Frame:
    
        IF SELF:SCREEN-VALUE = "no" THEN DO:
            ASSIGN cbCipher:SENSITIVE = NO
                   hFakeCipher:HIDDEN = NO
                   TogGenKey:SENSITIVE = NO
                   TogGenKey:SCREEN-VALUE = "NO".
        END.
        ELSE DO:
            ASSIGN cbCipher:SENSITIVE = YES
                   hFakeCipher:HIDDEN = YES.
              
            /* if this is enabling encryption, use the default, otherwise,
               use the value in the record, unless it got changed by the user
               while editing, in which case we leave it as the last value
               selected.
            */
            savedCipher = cbCipher.
            IF NOT cipherChanged AND ttObjAttrs.obj-cipher = "" THEN
                cbCipher = currdefCipher.
            ELSE IF cbCipher NE cbCipher:SCREEN-VALUE THEN
                cbCipher = cbCipher:SCREEN-VALUE.

            DISPLAY cbCipher WITH FRAME Dialog-Frame.
            /* revert it back */
            cbCipher = savedCipher.
    
            /* this handles an implicit genkey for an object that is not saved yet */
            RUN enableGenKey.
        END.
    END.
END.

ON VALUE-CHANGED OF TogGenKey IN FRAME Dialog-Frame OR
   VALUE-CHANGED OF cbCipher IN FRAME Dialog-Frame 
DO:
    DEFINE VARIABLE origCipher AS CHAR NO-UNDO.

    RUN StartEdit.

    IF SELF:NAME = "cbcipher" THEN DO:
        
        /* when changing ciphers, try to keep the implict genkey setting, which is set when
           changing ciphers. So if this is the first cipher changed, check against the value in 
           the ttObjAttrs record. If not the first change, we have a before-image record,
           and we check against it. But if the user si changing it back and forth, and it
           ends up going back to the original value, there is no change at all.
        */
        FIND FIRST bfttObjAttrs WHERE ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        IF AVAILABLE bfttObjAttrs AND  bfttObjAttrs.obj-cipher NE "" THEN
            origCipher = bfttObjAttrs.obj-cipher.
        ELSE IF NOT AVAILABLE bfttObjAttrs AND ttObjAttrs.obj-cipher NE "" THEN
            origCipher = ttObjAttrs.obj-cipher.
        ELSE
            origCipher = cbCipher:SCREEN-VALUE.

        IF origCipher NE cbCipher:SCREEN-VALUE THEN DO:
            /* implicit generate */
            ASSIGN TogGenKey = YES
                   TogGenKey:SENSITIVE IN FRAME  Dialog-Frame = NO.
            DISPLAY TogGenKey WITH FRAME  Dialog-Frame.
        END.
        ELSE DO:
            ASSIGN TogGenKey = ttObjAttrs.obj-genkey.
            /* genkey should not be enabled if user is enabling encryption on an
               object that has encryption off at this point.
            */
            TogGenKey:SENSITIVE IN FRAME  Dialog-Frame = NOT isCurrDisabled.
    
            DISPLAY TogGenKey WITH FRAME  Dialog-Frame.
        END.

        DISPLAY TogGenKey WITH FRAME  Dialog-Frame.

        ASSIGN cipherChanged = YES.
&IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
        /* to fix focus issue on tty */
        APPLY "ENTRY" TO SELF.
&ENDIF
    END.
END.

ON CHOOSE OF Btn_Save IN FRAME Dialog-Frame 
DO:
    DEFINE VARIABLE reverted AS LOGICAL NO-UNDO.

    DO WITH FRAME Dialog-Frame :

        /* if this is the first update to a policy, get an exclusive lock on
           the schema, so that other users get blocked when trying to 
           change any schema info or enc policies.
        */
        IF firstUpdate THEN DO ON STOP UNDO, RETURN NO-APPLY:
            myEPolicy:getDbLock(YES).
            firstUpdate = NO.
        END.

        IF togEnabled:SCREEN-VALUE = "yes" THEN DO:
           ASSIGN ttObjAttrs.obj-cipher = cbCipher:SCREEN-VALUE.

           /* if an implicity gen-key, don't need to update it. The rationale is that if there is a
              before-image record and have different cipher, this is the implict genkey case,
              so we don't want to save that in the record.
           */
           FIND FIRST bfttObjAttrs WHERE ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
           IF NOT TogGenKey:SENSITIVE AND TogGenKey:SCREEN-VALUE = "yes" THEN
               ttObjAttrs.obj-genkey = NO.
           ELSE IF AVAILABLE bfttObjAttrs AND 
               bfttObjAttrs.obj-cipher EQ ttObjAttrs.obj-cipher THEN
                  ttObjAttrs.obj-genkey = TogGenKey:SCREEN-VALUE = "yes".

           /* remember the last cipher that was saved */
           IF cipherChanged THEN
              ASSIGN currdefCipher = cbCipher:SCREEN-VALUE.
        END.
        ELSE
           ASSIGN ttObjAttrs.obj-cipher = ""
                  ttObjAttrs.obj-genkey = NO.

        /* signal that this has changes with an asterisk */
        ttObjAttrs.disp-name = "*" + ttObjAttrs.obj-name.

        /* let's see if this changed the record to the previous state, meaning that
           now there are no effective changes to the record
        */
        FIND FIRST bfttObjAttrs WHERE 
            ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        IF AVAILABLE bfttObjAttrs THEN DO:
            IF bfttObjAttrs.obj-cipher = ttObjAttrs.obj-cipher 
                AND bfttObjAttrs.obj-genkey = ttObjAttrs.obj-genkey THEN DO:
                /* same values, so reject the changes that happened until now */
                BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().
                ASSIGN reverted = YES.
            END.
        END.

        /* refresh column in browse in case we added the asterisk above */
        /* fetch record just in case we lost it due to the reject-row-changes above */
        BrowseList:FETCH-SELECTED-ROW(1).
        DISPLAY ttObjAttrs.disp-name WITH BROWSE BrowseList.

        RUN EndEdit.
        IF reverted THEN
            MESSAGE "This reverted the policy for this object to its original state." SKIP
                    "You can use the 'Revert' button instead."
                    VIEW-AS ALERT-BOX INFO.
    END.            
END.

ON CHOOSE OF Btn_Copy IN FRAME Dialog-Frame 
DO:
   RUN DoCopy.

   /* refresh the browse in case there were changes made */
   BROWSE BrowseList:REFRESH().

&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

    RUN EndEdit.

END.

ON CHOOSE OF Btn_Revert IN FRAME Dialog-Frame 
DO:
    IF INDEX(SELF:LABEL, "Revert") > 0 THEN DO:
        /* we will reject any changes to get the original record before any changes were done */
        FIND FIRST bfttObjAttrs WHERE  ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        IF AVAILABLE bfttObjAttrs THEN DO:
           BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().

            /* refresh column in browse to remove the asterisk */
            /* fetch record since we lost it due to the reject-row-changes */
            BrowseList:FETCH-SELECTED-ROW(1).
            DISPLAY ttObjAttrs.disp-name WITH BROWSE BrowseList.
        END.
    END.

    RUN EndEdit.
END.

&IF "{&WINDOW-SYSTEM}" = "TTY" &THEN 
  ON F5 OF FRAME Dialog-Frame ANYWHERE DO:
    IF Btn_Copy:SENSITIVE IN FRAME Dialog-Frame THEN
       APPLY "CHOOSE" TO Btn_Copy IN FRAME Dialog-Frame.
    ELSE DO:
        BELL.
        RETURN NO-APPLY.
    END.
  END.
             
  ON F6 OF FRAME Dialog-Frame ANYWHERE DO:
    IF Btn_Revert:SENSITIVE IN FRAME Dialog-Frame THEN
       APPLY "CHOOSE" TO Btn_Revert IN FRAME Dialog-Frame.
    ELSE DO:
        BELL.
        RETURN NO-APPLY.
    END.
  END.

  ON F7 OF FRAME Dialog-Frame ANYWHERE DO:
    IF Btn_Review:SENSITIVE IN FRAME Dialog-Frame THEN
       APPLY "CHOOSE" TO Btn_Review IN FRAME Dialog-Frame.
    ELSE DO:
        BELL.
        RETURN NO-APPLY.
    END.
  END.

&ENDIF

ON GO OF FRAME Dialog-Frame 
DO:
  DEF VAR answer AS LOGICAL NO-UNDO.

  IF isEditing THEN DO:
     APPLY "CHOOSE" TO Btn_Save.
     RETURN NO-APPLY.
  END.

  /* if nothing to commit, return */
  IF NOT btn_Commit:SENSITIVE THEN DO:
     BELL.
     RETURN NO-APPLY.
  END.

  MESSAGE 'You are about to save the changes to the database.' SKIP
          'Do you want to proceed ?'
       VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.

  IF answer = NO THEN
     RETURN NO-APPLY.

  /* doCommit will return an error when commit doesn't go through, so we return no-apply and 
     let the user decide what to do.
  */
  DO ON ERROR UNDO, RETURN NO-APPLY.
     RUN doCommit.
  END.
END.


ON END-ERROR OF  FRAME Dialog-Frame OR
   CHOOSE OF Btn_Cancel IN FRAME Dialog-Frame 
DO:
    
    IF isEditing THEN DO:
       APPLY "CHOOSE" TO Btn_Revert.
       RETURN NO-APPLY.
    END.

  /* checkUpdatesBeforeExit will return an error when commit doesn't go through, so we 
     return no-apply and let the user decide what to do.
  */
  DO ON ERROR UNDO, RETURN NO-APPLY:
     RUN checkUpdatesBeforeExit.
  END.

END.

ON CHOOSE OF Btn_Review IN FRAME Dialog-Frame 
DO:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.

    DEF VAR iCount     AS INT      NO-UNDO.
    DEF VAR lDisable   AS LONGCHAR NO-UNDO.
    DEF VAR lGen       AS LONGCHAR NO-UNDO.
    DEF VAR lReport    AS LONGCHAR
        VIEW-AS EDITOR LARGE SCROLLBAR-VERTICAL
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN 
        SIZE 97 BY 15
&ELSE 
        SIZE 77 BY 15 
&ENDIF
        FONT 0 /* fixed font */  NO-UNDO.

    /* now look at the after and before table and see what has really changed */
    FOR EACH bfttObjAttrs:

        FIND FIRST bttObjAttrs WHERE ROWID(bttObjAttrs) = BUFFER bfttObjAttrs:AFTER-ROWID.

        /* should always find it and BUFFER bfttObjAttrs:ROW-STATE = ROW-MODIFIED since we
           only have modified records
        */
        
        IF bttObjAttrs.obj-cipher NE bfttObjAttrs.obj-cipher THEN DO:
            ASSIGN iCount = iCount + 1.

            IF bttObjAttrs.obj-cipher = "" THEN DO:
                lDisable = lDisable + "  " + bfttObjAttrs.obj-name  
                           + " (" + bfttObjAttrs.obj-type + ")" + CHR(10).
            END.
            ELSE DO:
                CREATE ttReport.
                ASSIGN ttReport.obj-name = bfttObjAttrs.obj-name
                       ttReport.obj-type = bfttObjAttrs.obj-type
                       ttReport.old-cipher = bfttObjAttrs.obj-cipher 
                       ttReport.new-cipher = bttObjAttrs.obj-cipher.
            END.
        END.
        ELSE IF bttObjAttrs.obj-genkey NE bfttObjAttrs.obj-genkey THEN DO:
            ASSIGN iCount = iCount + 1
                   lGen = lGen + "  " + bfttObjAttrs.obj-name 
                          + " (" + bfttObjAttrs.obj-type + ")" + CHR(10).
        END.
        
    END.

    IF iCount > 0 THEN DO:

        lReport =   "Summary of changes to encryption policies" + CHR(10)
                  + "=========================================".

        /* first all newly enabled policies */
        FOR EACH ttReport WHERE ttReport.old-cipher = "" BREAK BY ttReport.new-cipher:
            IF FIRST-OF (new-cipher) THEN
                lReport = lReport + CHR(10) + CHR(10) + "Enable encryption with cipher '" + 
                          ttReport.new-cipher + "' for objects:" + CHR(10).
              
            lReport = lReport + "  " + ttReport.obj-name 
                      + " (" + ttReport.obj-type + ")" + CHR(10).
            DELETE ttReport.
        END.

        IF lDisable NE "" THEN
           lReport = lReport + CHR(10) + CHR(10)
                     + "Disable encryption for objects:" + CHR(10) + lDisable .

        IF lGen NE "" THEN
           lReport = lReport + CHR(10) + CHR(10) 
            + "Generate new key for objects:" + CHR(10) + lGen.

        /* first all newly enabled policies */
        FOR EACH ttReport BREAK BY ttReport.new-cipher:
            IF FIRST-OF (new-cipher) THEN
                lReport = lReport + CHR(10) + CHR(10) 
                          + "Change encryption policy to cipher '" + 
                          ttReport.new-cipher + "' for objects:" + CHR(10).
              
            lReport = lReport + "  " + ttReport.obj-name + " (" + ttReport.obj-type + ")".
            DELETE ttReport.
        END.

        lReport = lReport + CHR(10) + CHR(10) + "Total number of changes: " + STRING(iCount).

        EMPTY TEMP-TABLE ttReport NO-ERROR.

        /* build a very simple frame and display the report */
        DEFINE BUTTON bClose LABEL "&Close" 
            &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &then SIZE 15 BY 1.14 &ENDIF 
            TOOLTIP "Close window" AUTO-ENDKEY.
        
        DEFINE FRAME frame-report
            lReport NO-LABEL AT ROW 1 COL 1 WIDGET-ID 2 PFCOLOR 0
            bClose 
               &IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN AT ROW 16 COL 36
               &ELSE AT ROW 16.4 COL 42 &ENDIF WIDGET-ID 4
            WITH KEEP-TAB-ORDER OVERLAY 
                 SIDE-LABELS NO-UNDERLINE THREE-D CENTERED
                 TITLE "Review changes"
                 VIEW-AS DIALOG-BOX CANCEL-BUTTON bClose DEFAULT-BUTTON bClose
                 &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN  SIZE 99 BY 18
                 &ELSE SIZE 80 BY 18 &ENDIF .
                 
        ON WINDOW-CLOSE OF FRAME frame-report
        DO:
           APPLY 'CHOOSE' TO bClose.
        END.

        DO ON ENDKEY UNDO, LEAVE:
           DISPLAY lReport WITH FRAME frame-report.
           ASSIGN  lReport:READ-ONLY= YES
                   lReport:SENSITIVE = YES.
           UPDATE bClose WITH FRAME frame-report.
        END.
    END.
    ELSE
        MESSAGE "There are no changes to the current encryption policies"
        &IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN 
        VIEW-AS ALERT-BOX INFO BUTTONS OK &ENDIF .
END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME Dialog-Frame:PARENT eq ?
THEN FRAME Dialog-Frame:PARENT = ACTIVE-WINDOW.

/* Run time layout for button areas for SelectionCopy and obj_patt frames */
{adecomm/okrun.i  
   &FRAME  = "FRAME SelectionCopy" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

{adecomm/okrun.i  
   &FRAME  = "FRAME obj_patt" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

/* We create a fake widget to put on top of the cipher combo-box so that
   when encryption is disabled for an object, we don't display anything.
*/        
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
CREATE FILL-IN hFakeCipher
   ASSIGN
&ELSE
CREATE COMBO-BOX hFakeCipher
   ASSIGN
      SUBTYPE = "SIMPLE"
&ENDIF
      FRAME =  cbCipher:FRAME:HANDLE
      X = cbCipher:X
      Y = cbCipher:Y
      WIDTH = cbCipher:WIDTH
      HIDDEN = YES.

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  /* start tracking-changes */
  TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = YES.

  RUN populateCombo.
  RUN enable_UI.

  /* get the first row to display the details  */
  APPLY "VALUE-CHANGED" TO BrowseList.

  WAIT-FOR GO OF FRAME Dialog-Frame.
END.
RUN disable_UI.

/* if we got here and the user did not save the changes, we return
   error to the caller so that it undoes the transaction, if there is
   one.
*/
IF NOT Committed THEN 
   RETURN ERROR.


/* **********************  Internal Procedures  *********************** */

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN

/* assign the help string for the widgets on TTY */
PROCEDURE assignHelp:
    IF isEditing THEN
        ASSIGN cHelp = KBLABEL("GO") + "=Save  " +
                       KBLABEL("END-ERROR") + "=Reset"
               cbCipher:HELP IN FRAME Dialog-Frame = cHelp
               togEnabled :HELP = cHelp
               TogGenKey:HELP = cHelp
               Btn_Save:HELP = cHelp
               Btn_Review:HELP = cHelp
               Btn_Revert:HELP = cHelp.
    ELSE
        ASSIGN cHelp = BrowseList:HELP IN FRAME Dialog-Frame
               cbCipher:HELP = cHelp
               togEnabled :HELP = cHelp
               TogGenKey:HELP = cHelp
               Btn_Revert:HELP = cHelp
               Btn_Copy:HELP = cHelp
               Btn_Review:HELP = cHelp
               Btn_Cancel:HELP = cHelp
               Btn_Commit:HELP = cHelp.
END PROCEDURE.

&ENDIF

/* PROCEDURE: checkUpdatesBeforeExit
 *            Called when user wants to exit. Check if there are chnages and alert to that fact
 *            so they get a chance to save them.
 */
PROCEDURE checkUpdatesBeforeExit:
   DEF VAR answer AS LOGICAL NO-UNDO.

   /* if there are any errors trying to save the chnages, we return error */
   IF CAN-FIND (FIRST bfttObjAttrs NO-LOCK) THEN 
   DO ON ERROR UNDO, RETURN ERROR:
       
       /* initialize as the cancel button */
       ASSIGN answer = ?.

       MESSAGE 'You have not saved the current changes to the database.' SKIP
               'The changes will be lost once you exit this utility.' SKIP(1)
               'Do you wish to save the changes before you exit?'
           VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO-CANCEL UPDATE answer.

       IF answer = ? THEN
          RETURN ERROR /*cancel */.
       ELSE IF answer = YES THEN DO:
           /* doCommit will return an error when commit doesn't go through, so we 
             return error. Caller should return no-apply and let the user decide what to do.
           */
           RUN doCommit.
       END.

   END.

END PROCEDURE.

/* PROCEDURE: disable_UI
 *            Disable widgets
 */
PROCEDURE disable_UI :
  HIDE FRAME Dialog-Frame.
END PROCEDURE.

/* PROCEDURE: doCommit
 *            Commit changes to the database
 */
PROCEDURE doCommit:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.
    DEFINE VARIABLE answer AS LOGICAL NO-UNDO.

    /* check if there are any that haven't been changed */
    FIND FIRST bttObjAttrs WHERE NOT bttObjAttrs.disp-name BEGINS "*" NO-ERROR.
    IF AVAILABLE bttObjAttrs THEN DO:
        MESSAGE "Some of the selected objects have not been changed." SKIP
                "Do you want to proceed?"
            VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE answer.
        IF answer = NO THEN DO:
            REPOSITION BrowseList TO ROWID ROWID(bttObjAttrs).
            APPLY "VALUE-CHANGED" TO BrowseList IN FRAME Dialog-Frame.
            RETURN ERROR.
        END.
    END.

    /* now pass the changes to out epolicy object and save them to the db */
    myEPolicy:updatePolicies(INPUT ?, INPUT DATASET dsObjAttrs BY-REFERENCE).

    /* if updatePolicies throws error, we won't get here, will get in the catch block below */
    ASSIGN Committed = YES.

    CATCH e AS PROGRESS.Lang.ProError:
       MESSAGE 'Failed to save changes.' skip e:GetMessage(1)
           VIEW-AS ALERT-BOX ERROR BUTTONS OK.
       
       DELETE OBJECT e.
       /* we return error which then will get propagated so that we let the user decide what to do */
       RETURN ERROR.
       
    END CATCH.

END PROCEDURE.

/* PROCEDURE: doCopy
 *            Copy settings from current object to other object(s)
 */
PROCEDURE doCopy:
    DEFINE BUFFER bttObjAttrs FOR ttObjAttrs.

    DEF VAR rRowid   AS ROWID NO-UNDO.

    ON WINDOW-CLOSE OF FRAME SelectionCopy
    DO:
         APPLY "END-ERROR":U TO SELF.
    END.

    ON ROW-DISPLAY OF browse-Copy IN FRAME SelectionCopy
    DO:
        CASE ttCopy.obj-type:
            WHEN "TABLE" THEN
                cObjType = "Tbl".
            WHEN "INDEX" THEN
                cObjType = "Idx".
            OTHERWISE
                cObjType = ttCopy.obj-type.
        END CASE.
    END.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 

    ON CHOOSE OF Btn_Help IN FRAME SelectionCopy /* Help */
    OR HELP OF FRAME SelectionCopy
    DO: /* Call Help Function (or a simple message). */
        RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                                   INPUT "CONTEXT", 
                                   INPUT {&Copy_Current_Setting_To},
                                   INPUT ?).  
    END.
&ENDIF

    ON CHOOSE OF Btn_Select_Some IN FRAME SelectionCopy
    DO:
       DEFINE VARIABLE n        AS INT    NO-UNDO.
       DEFINE VARIABLE rrowid   AS ROWID  NO-UNDO.

       ASSIGN n = browse-Copy:FOCUSED-ROW.

       ASSIGN FRAME obj_patt:TITLE = "Select Objects by Pattern Match"
              pprompt = "Enter name of object to select.".

       display pprompt with frame obj_patt.

       do ON ENDKEY UNDO, LEAVE:
          update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
              with frame obj_patt.

          pattern = TRIM(pattern).
          IF pattern = "*" THEN
             browse-Copy:SELECT-ALL().
          ELSE DO:
&IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN
              /* can't have this since this causes issues with selected rows
                 on multi-select browse on tty - OE00172180 
              */
              browse-Copy:SET-REPOSITIONED-ROW(n,"conditional").
&ENDIF
              /* don't look at the one selected on the main browse, as it's
                 not in browse-Copy - see open query below.
              */
              FOR EACH ttCopy WHERE ttCopy.obj-name NE ttObjAttrs.obj-name AND 
                              NOT (ttCopy.obj-cipher EQ ttObjAttrs.obj-cipher AND
                                   ttCopy.obj-genkey EQ ttObjAttrs.obj-genkey) AND
                              ttCopy.obj-name MATCHES pattern.
                  /* store the rowid of the first row selected so we move
                     focus to it later - OE00172180.
                  */
                  IF rrowid = ? THEN
                      rrowid = ROWID(ttCopy).
                  REPOSITION browse-Copy TO ROWID ROWID(ttCopy).
                  browse-Copy:SELECT-ROW(browse-Copy:FOCUSED-ROW).
              END.

              /* move to the first selected, if any - OE00172180 */
              IF rrowid NE ? THEN
                  REPOSITION browse-Copy TO ROWID rrowid.
          END.

    &IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
        /* On tty Windows, we end up with a weird behavior, as if a line in the browse is
           selected, even though the focus in on something else, so this does the trick.
        */
        IF SELF:TYPE NE "Browse" THEN
           APPLY "leave" TO browse-Copy.
        APPLY "entry" TO SELF.
    &ENDIF

       END.
    END.

    ON CHOOSE OF Btn_Deselect_Some IN FRAME SelectionCopy
    DO:
       DEFINE VAR nRows AS INTEGER NO-UNDO.
       DEFINE VAR i     AS INTEGER NO-UNDO.

       ASSIGN FRAME obj_patt:TITLE = "Deselect Objects by Pattern Match"
              pprompt = "Enter name of object to deselect.".

       display pprompt with frame obj_patt.

       do ON ENDKEY UNDO, LEAVE:
          update pattern btn_OK btn_Cancel {&HLP_BTN_NAME}
               with frame obj_patt.

          pattern = TRIM(pattern).
          nRows = browse-Copy:NUM-SELECTED-ROWS.

          IF nRows > 0 THEN DO:
              IF pattern = "*" THEN
                 browse-Copy:DESELECT-ROWS().
              ELSE DO:
                   rpt-blk:
                   REPEAT i = 1 TO nRows:
                       browse-Copy:FETCH-SELECTED-ROW(i).
                       IF ttCopy.obj-name MATCHES pattern THEN DO:
                            browse-Copy:DESELECT-SELECTED-ROW(i).
                            /* now that we have deselected the row, decrement the counters */
                            ASSIGN i = i - 1
                                   nRows = nRows - 1.
                       END.
                   END.
              END.
          END.
       END.
    END.

    ON GO OF FRAME SelectionCopy
    DO:
        DEF VAR i AS INT NO-UNDO.
        DEF VAR j AS INT NO-UNDO.
        DEF VAR newcipherVal AS CHAR NO-UNDO.
        DEF VAR newgenkeyVal AS LOGICAL NO-UNDO.

        ASSIGN i = browse-Copy:NUM-SELECTED-ROWS IN FRAME SelectionCopy.
        IF i = 0 THEN DO:
            MESSAGE "Select ay least one object or press Cancel"
                  VIEW-AS ALERT-BOX ERROR BUTTONS OK.

            RETURN NO-APPLY.
        END.

        ASSIGN newcipherVal = ttObjAttrs.obj-cipher
               newgenkeyVal = ttObjAttrs.obj-genkey.

        REPEAT j = 1 TO i:
            browse-Copy:FETCH-SELECTED-ROW(j).
            FIND FIRST bttObjAttrs WHERE bttObjAttrs.obj-name = ttCopy.obj-name AND
                bttObjAttrs.obj-type = ttCopy.obj-type.
            /* if the values are different, assign them */
            IF bttObjAttrs.obj-cipher NE newcipherVal OR
               bttObjAttrs.obj-genkey NE newgenkeyVal THEN DO:
                ASSIGN bttObjAttrs.obj-cipher = newcipherVal
                       bttObjAttrs.obj-genkey = newgenkeyVal
                       bttObjAttrs.disp-name = "*" + bttObjAttrs.obj-name.

                /* let's see if this changed the record to the previous state, meaning that
                   now there are no effective changes to the record
                */
                FIND FIRST bfttObjAttrs WHERE 
                    ROWID(bfttObjAttrs) = BUFFER bttObjAttrs:BEFORE-ROWID NO-ERROR.
                IF AVAILABLE bfttObjAttrs THEN DO:
                    IF bfttObjAttrs.obj-cipher = bttObjAttrs.obj-cipher 
                        AND bfttObjAttrs.obj-genkey = bttObjAttrs.obj-genkey THEN DO:
                        /* same values, so reject the changes that happened until now */
                        BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().
                    END.
                END.

            END.
        END.
    END.

    DO ON ERROR UNDO, LEAVE
       ON STOP UNDO, LEAVE
       ON ENDKEY UNDO, LEAVE: /* trap errors */

        /* check if there is any with a different setting */
        FIND FIRST bttObjAttrs 
             WHERE bttObjAttrs.obj-cipher NE ttObjAttrs.obj-cipher OR
                   bttObjAttrs.obj-genkey NE ttObjAttrs.obj-genkey NO-ERROR.

        IF NOT AVAILABLE bttObjAttrs THEN DO:
           MESSAGE "All objects on the list already have the same setting as"
                   "the current one." 
               VIEW-AS ALERT-BOX INFO.

        END.
        ELSE DO:
    
            IF NOT CAN-FIND (FIRST ttCopy) THEN DO:
                /* populate the table the first time */
                FOR EACH bttObjAttrs:
                    CREATE ttCopy.
                    ASSIGN ttcopy.seq = bttObjAttrs.seq-num
                           ttCopy.obj-name = bttObjAttrs.obj-name
                           ttCopy.obj-type = bttObjAttrs.obj-type
                           ttCopy.obj-cipher = bttObjAttrs.obj-cipher
                           ttCopy.obj-genkey = bttObjAttrs.obj-genkey.
                END.
            END.
            ELSE DO:
                /* otherwise make sure it is up-to-date */
                FOR EACH bttObjAttrs:
                    FIND FIRST ttCopy WHERE ttcopy.seq = bttObjAttrs.seq-num.
                    ASSIGN ttCopy.obj-cipher = bttObjAttrs.obj-cipher
                           ttCopy.obj-genkey = bttObjAttrs.obj-genkey.
                END.
    
            END.
    
            /* exclude the currently selected one from the Copy browse */
            FIND ttCopy WHERE ttCopy.obj-name EQ ttObjAttrs.obj-name AND
                ttCopy.obj-type EQ ttObjAttrs.obj-type NO-LOCK.
            rRowid = ROWID(ttCopy).
            RELEASE ttCopy.
    
            /* only display the ones that have different settings from the current one */
            OPEN QUERY browse-Copy FOR EACH ttCopy WHERE ROWID(ttCopy) NE rRowid AND
                      (ttCopy.obj-cipher NE ttObjAttrs.obj-cipher OR
                      ttCopy.obj-genkey NE ttObjAttrs.obj-genkey).
    
            DISPLAY browse-Copy WITH FRAME SelectionCopy.
    
            ENABLE browse-Copy Btn_Select_Some Btn_Deselect_Some Btn_OK Btn_Cancel
                 &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
                WITH FRAME SelectionCopy.
    
            WAIT-FOR GO OF FRAME SelectionCopy.
    
            CLOSE QUERY browse-Copy.
        END.
    END.

    /* we are done one way or the other */
    HIDE FRAME SelectionCopy.

END PROCEDURE.

/* PROCEDURE: enable_UI
 *            Enable widgets
 */
PROCEDURE enable_UI :
  DISPLAY BrowseList TogEnabled TogGenKey cbCipher Pass-phrase Verify-pass-phrase 
      WITH FRAME Dialog-Frame.
  ENABLE RECT-1 BrowseList TogEnabled Btn_Cancel
         &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
      WITH FRAME Dialog-Frame.

  VIEW FRAME Dialog-Frame.
  OPEN QUERY BrowseList FOR EACH ttObjAttrs NO-LOCK INDEXED-REPOSITION.

  /* remember that user selected just 1 object, so we don't enable the Copy option */
  IF QUERY BrowseList:NUM-RESULTS = 1 THEN
      ASSIGN onlyOne = YES.

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
  /* assign help */
  RUN assignHelp.
&ENDIF

END PROCEDURE.

/* PROCEDURE: enableGenKey
 *            Deal with enabling the genket toggle-box - handles the implict case
 */
PROCEDURE enableGenKey:

    IF NOT isCurrDisabled THEN DO:
        /* when the user changes the cipher, we carry an implicit genkey so then we check
           the genkey toggle-box just to signal that the key will get generated.
           As the user starts enabling/disabling it before commiting the changes, we then try to
           keep the implicit case consistent.
           If there is a before-image and the cipher is the same, then it's not the implicit case,
           so we don't set the implict genkey.
        */
        FIND FIRST bfttObjAttrs WHERE ROWID(bfttObjAttrs) = BUFFER ttObjAttrs:BEFORE-ROWID NO-ERROR.
        /* if changing cipher, there is an implicit generate key action */
        IF (AVAILABLE bfttObjAttrs AND bfttObjAttrs.obj-cipher NE ""
            AND bfttObjAttrs.obj-cipher NE cbCipher:SCREEN-VALUE IN FRAME Dialog-Frame ) OR
            (NOT AVAILABLE bfttObjAttrs AND ttObjAttrs.obj-cipher NE "" AND 
             ttObjAttrs.obj-cipher NE cbCipher:SCREEN-VALUE IN FRAME Dialog-Frame) THEN DO:
            ASSIGN TogGenKey:SENSITIVE IN FRAME Dialog-Frame = NO
                   TogGenKey:SCREEN-VALUE = "yes".
    
           IF NOT isEditing THEN
              ASSIGN TogGenKey = YES.
        END.
        ELSE
            ASSIGN TogGenKey:SENSITIVE = YES.
    END.
    ELSE
       TogGenKey:SENSITIVE = NO.

END.

/* PROCEDURE: EndEdit
 *            Called when user reset or save changes to current object
 */
PROCEDURE EndEdit:
    
    ASSIGN isEditing = NO
           Btn_Revert:LABEL IN FRAME Dialog-Frame = "&Revert".

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
    RUN assignHelp.
&ENDIF

    DISABLE Btn_Save Btn_Revert WITH FRAME Dialog-Frame.
    ENABLE BrowseList Btn_Cancel WITH FRAME Dialog-Frame.

    /* get values from record */
    APPLY "VALUE-CHANGED" TO BrowseList.
    
    ASSIGN cipherChanged = NO
           btn_Commit:SENSITIVE = CAN-FIND (FIRST bfttObjAttrs NO-LOCK)
           btn_Review:SENSITIVE = btn_Commit:SENSITIVE.
      
     /* go back to the browse */ 
     APPLY "ENTRY" TO BrowseList.
END PROCEDURE.

/* PROCEDURE: populateCombo
 *            Populate combo-box with cipher names
 */
PROCEDURE populateCombo:         
    DEFINE VARIABLE cList         AS CHAR    NO-UNDO.

    cList = myEPolicy:CipherNames NO-ERROR.
    IF NOT (cList = ? OR cList = "") THEN DO:
       ASSIGN cbCipher:LIST-ITEMS IN FRAME Dialog-Frame = cList
              cbCipher = myEPolicy:DefaultCipher
              currdefCipher = cbCipher.
    END.
END PROCEDURE.

/* PROCEDURE: startEdit
 *            Called when user makes a change to the current object
 */
PROCEDURE startEdit:

    ASSIGN isEditing = YES
           Btn_Revert:LABEL IN FRAME Dialog-Frame = "&Reset".

&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
    RUN assignHelp.

    APPLY "ENTRY" TO SELF.
&ENDIF


    ENABLE Btn_Save Btn_Revert WITH FRAME Dialog-Frame.
    DISABLE BrowseList Btn_Copy Btn_Commit Btn_Cancel WITH FRAME Dialog-Frame.


END PROCEDURE.
/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_sec-obj-hist.p

Description:
    Interface for viewing encryption policies (encryption)

Input-Parameters:
    myEPolicy - _sec-pol-util object

Output-Parameters:
    none
    
History:
    07/22/08  fernando   created

--------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
USING Progress.Security.DB.* .
USING prodict.sec.*.

{prodict/sec/sec-pol.i}
{adecomm/adestds.i}

/* Parameters Definitions ---                                           */

DEFINE INPUT  PARAMETER myEPolicy AS CLASS _sec-pol-util.

/* Local Variable Definitions ---                                       */

DEFINE TEMP-TABLE ttFetch NO-UNDO
    FIELD objNum  AS INT
    FIELD objType AS CHAR
    INDEX objNum objNum objType.

DEFINE VARIABLE opt           AS LOGICAL   NO-UNDO.
DEFINE VARIABLE cObjType      AS CHARACTER NO-UNDO.

DEFINE BUTTON btn_Ok     LABEL "OK"     {&STDPH_OKBTN} AUTO-GO.
DEFINE BUTTON btn_Cancel LABEL "Cancel" {&STDPH_OKBTN} AUTO-ENDKEY.

&IF "{&WINDOW-SYSTEM}" <> "TTY" &THEN 
   DEFINE RECTANGLE rect_Btns {&STDPH_OKBOX}.
   DEFINE BUTTON    btn_Help LABEL "&Help" {&STDPH_OKBTN}.

   &GLOBAL-DEFINE   HLP_BTN   &HELP = "btn_Help"
   &GLOBAL-DEFINE   HLP_BTN_NAME btn_Help
   &GLOBAL-DEFINE   CAN_BTN  /* no cancel button */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP({&VM_WIDG})
   &GLOBAL-DEFINE   STATUS NO
   &GLOBAL-DEFINE   BOX_BTN   &BOX = "rect_Btns"
&ELSE
   &GLOBAL-DEFINE   HLP_BTN  /* no help for tty */
   &GLOBAL-DEFINE   HLP_BTN_NAME /* no help for tty */
   &GLOBAL-DEFINE   CAN_BTN /* no cancel button */
   &GLOBAL-DEFINE   WIDG_SKIP SKIP /*Often don't need and can't afford blnklin*/
   &GLOBAL-DEFINE   BOX_BTN
&ENDIF

&IF "{&WINDOW-SYSTEM}" <> "TTY"
 &THEN 
   /* Help context defines and the name of the help file */
   {prodict/admnhlp.i}
   &global-define ADM_HELP_FILE "adehelp/admin.hlp"  
&ENDIF

/* ***********************  Control Definitions  ********************** */

DEFINE VARIABLE TogTables AS LOGICAL INITIAL YES 
     LABEL "&Tables" 
     VIEW-AS TOGGLE-BOX
     SIZE 14.6 BY .81 NO-UNDO.

DEFINE VARIABLE TogIndex AS LOGICAL INITIAL YES 
     LABEL "&Indexes" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 14.6 BY .81 &endif NO-UNDO.

DEFINE VARIABLE TogLobs AS LOGICAL INITIAL NO 
     LABEL "&LOBs" 
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 14.6 BY .81 &ENDIF NO-UNDO.

DEFINE VARIABLE TogAll AS LOGICAL
     LABEL "&Disabled"
     VIEW-AS TOGGLE-BOX
&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN SIZE 18 BY .81 &ENDIF NO-UNDO.

DEFINE QUERY BrowseList FOR ttObjAttrs    SCROLLING.
DEFINE QUERY BrowsePol  FOR ttObjEncPolicyVersions SCROLLING.

DEFINE BROWSE BrowseList
    QUERY BrowseList NO-LOCK DISPLAY
        ttObjAttrs.disp-name COLUMN-LABEL "Object Name" FORMAT "x(65)":U WIDTH 65
        cObjType COLUMN-LABEL "Type" FORMAT "x(4)":U WIDTH 4
    WITH NO-LABELS
    &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 75 BY 8 
    &ELSE
    SIZE 77 BY 9 
    &ENDIF
    FIT-LAST-COLUMN.

DEFINE BROWSE BrowsePol
    QUERY BrowsePol NO-LOCK DISPLAY
        ttObjEncPolicyVersions.pol-version COLUMN-LABEL "Version" FORMAT "zzzzzzzzz9":U
        ttObjEncPolicyVersions.pol-state COLUMN-LABEL "State" FORMAT "X(15)"
        ttObjEncPolicyVersions.pol-cipher COLUMN-LABEL "Cipher" FORMAT "x(20)":U
    WITH NO-ROW-MARKERS SEPARATORS
    &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN
    SIZE 50 BY 7
    &ELSE
    SIZE 60 BY 3.4 
    &ENDIF
    FIT-LAST-COLUMN.

/* ************************  Frame Definitions  *********************** */

/* main frame */
DEFINE FRAME ObjList
     BrowseList
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 1 COL 1
       &ELSE AT ROW 1.2 COL 2 WIDGET-ID 2  &ENDIF 
     TogTables
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 2
       &ELSE AT ROW 10.2 COL 2 WIDGET-ID 4 &ENDIF
     TogIndex 
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 14
       &ELSE AT ROW 10.2 COL 15 WIDGET-ID 6 &ENDIF
     TogLobs
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 27
       &ELSE AT ROW 10.2 COL 29 WIDGET-ID 8 &ENDIF
     TogAll
       &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 9 COL 37
       &ELSE AT ROW 10.2 COL 41 WIDGET-ID 10 &ENDIF
    BrowsePol
      &IF '{&WINDOW-SYSTEM}' = 'TTY':U &THEN AT ROW 10 COL 13
      &ELSE AT ROW 11.5 COL 12 WIDGET-ID 14  &ENDIF 
    {prodict/user/userbtns.i}
    WITH 
         VIEW-AS DIALOG-BOX ROW 1 CENTERED
         KEEP-TAB-ORDER SIDE-LABELS NO-UNDERLINE THREE-D
         TITLE "Encryption Policy History"
         DEFAULT-BUTTON Btn_OK CANCEL-BUTTON Btn_OK WIDGET-ID 100.

/* ************************  Control Triggers  ************************ */

ON WINDOW-CLOSE OF FRAME ObjList /* Object Selector */
DO:
  APPLY "END-ERROR":U TO SELF.
END.

&IF '{&WINDOW-SYSTEM}' NE 'TTY':U &THEN
/*----- HELP -----*/

ON CHOOSE OF Btn_Help IN FRAME ObjList /* Help */
OR HELP OF FRAME ObjList
DO: /* Call Help Function (or a simple message). */
    RUN "adecomm/_adehelp.p" ( INPUT "admn", 
                               INPUT "CONTEXT", 
                               INPUT {&Encryption_Policy_History_Dialog_Box},
                               INPUT ?).
  
END.
&ENDIF

ON VALUE-CHANGED OF TogAll IN FRAME ObjList
DO:
    RUN refreshObjList.
END.

ON VALUE-CHANGED OF TogIndex IN FRAME ObjList OR
   VALUE-CHANGED OF TogTables IN FRAME ObjList OR
   VALUE-CHANGED OF TogLobs IN FRAME ObjList
DO: 
    RUN refreshObjList.
END.

ON ROW-DISPLAY OF BrowseList IN FRAME ObjList
DO:
    CASE ttObjAttrs.obj-type:
        WHEN "TABLE" THEN
            cObjType = "Tbl".
        WHEN "INDEX" THEN
            cObjType = "Idx".
        OTHERWISE
            cObjType = ttObjAttrs.obj-type.
    END CASE.
END.

ON VALUE-CHANGED OF BrowseList IN FRAME ObjList
DO:
    DEFINE VARIABLE isNew AS LOGICAL NO-UNDO.

    CLOSE QUERY BrowsePol.
    IF AVAILABLE (ttObjAttrs) THEN DO:
        /* see if this is the first time */
        FIND FIRST ttFetch WHERE ttFetch.objNum = ttObjAttrs.obj-num AND
              ttFetch.objType = ttObjAttrs.obj-type NO-ERROR.

        IF NOT AVAILABLE ttFetch THEN DO:
            /* first time, so create record for this */
            CREATE ttFetch.
            ASSIGN ttFetch.objNum = ttObjAttrs.obj-num 
                   ttFetch.objType = ttObjAttrs.obj-type
                   isNew = YES.
            VALIDATE ttFetch.
        END.

        /*if the first time, we have to retrieve the policy info. */
        IF isNew THEN DO:

            myEpolicy:getPolicyVersions(ttObjAttrs.obj-num, 
                                        ttObjAttrs.obj-type, 
                                        OUTPUT DATASET dsObjAttrs BY-REFERENCE).
        END.
    
        OPEN QUERY BrowsePol FOR EACH ttObjEncPolicyVersions 
            WHERE ttObjEncPolicyVersions.seq-num = ttObjAttrs.seq-num NO-LOCK.

        BrowsePol:SENSITIVE = QUERY BrowsePol:NUM-RESULTS > 0.
        IF NOT BrowsePol:SENSITIVE THEN
            CLOSE QUERY BrowsePol.
&IF '{&WINDOW-SYSTEM}' EQ 'TTY':U &THEN
        /* fix issue with focus on browse after query is open. It looks as if more
           than one thing has focus 
        */
        APPLY 'leave' TO BrowsePol.
&ENDIF
    END.
END.

/* ***************************  Main Block  *************************** */

/* Parent the dialog-box to the ACTIVE-WINDOW, if there is no parent.   */
IF VALID-HANDLE(ACTIVE-WINDOW) AND FRAME ObjList:PARENT eq ?
THEN FRAME ObjList:PARENT = ACTIVE-WINDOW.

RUN populateValues.

/* set the display name as the object name */
FOR EACH ttObjAttrs:
   /* don't want objects with no policy information */
   IF ttObjAttrs.obj-cipher = "" AND NOT ttObjAttrs.has-prev-pol THEN
       DELETE  ttObjAttrs.
   ELSE
      ttObjAttrs.disp-name = ttObjAttrs.obj-name.
END.


IF NOT CAN-FIND (FIRST ttObjAttrs) THEN DO:
   MESSAGE "There are no objects with encryption policy information."
       VIEW-AS ALERT-BOX INFO BUTTONS OK.
   RETURN ERROR.
END.

/* Run time layout for button areas. */
{adecomm/okrun.i  
   &FRAME  = "FRAME ObjList" 
   {&BOX_BTN}
   &OK     = "btn_OK" 
   {&CAN_BTN}
   {&HLP_BTN}
}

/* Now enable the interface and wait for the exit condition.            */
/* (NOTE: handle ERROR and END-KEY so cleanup code will always fire.    */
MAIN-BLOCK:
DO ON ERROR   UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK
   ON END-KEY UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:

  RUN enable_UI.

  IF QUERY BrowseList:NUM-RESULTS = 0 THEN DO:
      IF CAN-FIND(FIRST ttObjAttrs WHERE obj-cipher NE "") THEN DO: /* must be LOBs */
          ASSIGN  TogLobs = YES.
          DISPLAY TogLobs WITH FRAME ObjList.
          MESSAGE "There are no tables or indexes with encryption currently enabled." SKIP
                  "List will contain LOBs with encryption enabled."
                  VIEW-AS ALERT-BOX WARNING.
      END.
      ELSE DO:
          MESSAGE "There are no objects with encryption currently enabled." SKIP
                  "Do you want to review objects with policies but that have encryption disabled?"
                  VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE opt.
          IF NOT opt THEN DO:
              RUN disable_UI.
              RETURN.
          END.

          ASSIGN  TogAll = YES
                  TogLobs = YES.
          DISPLAY TogAll TogLobs WITH FRAME ObjList.
      END.

      RUN refreshObjList.
  END.

  /* get the first row to display the details  */
  APPLY "VALUE-CHANGED" TO BrowseList.

  WAIT-FOR GO OF FRAME ObjList.
END.
RUN disable_UI.


/* **********************  Internal Procedures  *********************** */

PROCEDURE disable_UI :
  /* Hide all frames */
  HIDE FRAME ObjList.
END PROCEDURE.

PROCEDURE enable_UI :
  DISPLAY BrowseList TogTables TogIndex TogLobs BrowsePol 
      WITH FRAME ObjList.

  /* don't need cancel button */
  HIDE Btn_Cancel IN FRAME ObjList.
  ENABLE BrowseList TogTables TogIndex TogLobs TogAll BrowsePol
       Btn_OK
       &IF "{&WINDOW-SYSTEM}" NE "TTY" &THEN Btn_Help &ENDIF
      WITH FRAME ObjList.

  VIEW FRAME ObjList.

  /* default is tables with encryption on */
  OPEN QUERY BrowseList FOR EACH ttObjAttrs WHERE 
      (ttObjAttrs.obj-type = "Table" OR ttObjAttrs.obj-type = "Index")
      AND ttObjAttrs.obj-cipher NE "" NO-LOCK INDEXED-REPOSITION.
END PROCEDURE.


PROCEDURE populateValues:         
    DEF VAR cList AS CHAR NO-UNDO.

    /* populate the dataset */
    myEPolicy:getTableList(INPUT YES, /* get current policy info */
                           OUTPUT DATASET dsObjAttrs BY-REFERENCE).
END.

PROCEDURE refreshObjList:

    DEFINE VARIABLE showTables    AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE showIndexes   AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE showLobs      AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE showAll       AS LOGICAL   NO-UNDO.
    DEFINE VARIABLE cTypes        AS CHARACTER NO-UNDO.
    DEFINE VARIABLE i             AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFocused      AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cQueryStr     AS CHARACTER NO-UNDO.
    DEFINE VARIABLE rRowid        AS ROWID     NO-UNDO.

    ASSIGN showTables = TogTables:SCREEN-VALUE IN FRAME ObjList = "yes"
           showIndexes = TogIndex:SCREEN-VALUE IN FRAME ObjList = "yes"
           showLobs = TogLobs:SCREEN-VALUE IN FRAME ObjList = "yes".

    IF TogAll:SCREEN-VALUE = "yes"  THEN
       showAll = YES.

    IF showTables THEN
       ASSIGN cTypes = "Table".
    IF showIndexes THEN
        ASSIGN cTypes = (IF cTypes = "" THEN "" ELSE cTypes + ",") + "Index".
    IF showLobs THEN
        ASSIGN cTypes = (IF cTypes = "" THEN "" ELSE cTypes + ",") + "CLOB,BLOB".         
    
    BrowseList:FETCH-SELECTED-ROW(1) NO-ERROR.
    /* only keep track of objects that need to be reselected after we reopen the
       query.
    */
    IF AVAILABLE ttObjAttrs THEN DO:
        IF CAN-DO(cTypes,ttObjAttrs.obj-type) THEN
            rRowid = ROWID(ttObjAttrs).
    END.

    CLOSE QUERY BrowseList.

    cQueryStr = "FOR EACH ttObjAttrs WHERE CAN-DO(" 
                + QUOTER(cTypes) + ",ttObjAttrs.obj-type) ".

    IF NOT showAll THEN
       cQueryStr = cQueryStr + 'AND obj-cipher NE "" '.
    
    cQueryStr = cQueryStr + " NO-LOCK" /*+ " INDEXED-REPOSITION" */ .

    QUERY BrowseList:QUERY-PREPARE(cQueryStr).
    QUERY BrowseList:QUERY-OPEN().

    IF rRowid NE ? THEN
       REPOSITION BrowseList TO ROWID rRowid NO-ERROR.

    APPLY "value-changed" TO BrowseList.
&IF "{&WINDOW-SYSTEM}" EQ "TTY" &THEN
    /* On tty, we end up with a weird behavior, as if a line in the browse is
       selected, even though the focus in on something else, so this does the trick.
    */
    IF SELF:TYPE NE "Browse" THEN
       APPLY "leave" TO BrowseList.
    APPLY "entry" TO SELF.
&ENDIF

END.
/*********************************************************************
* Copyright (C) 2008-2010 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/_sec-pol-util.cls

Description:
    Object for interfacing with encryption. This is the object that will get
    and set the encryption policies for encryption.
    
History:
    07/01/08  fernando   created

                            
--------------------------------------------------------------------*/

/* ***************************  Definitions  ************************** */
USING Progress.Security.DB.* .

ROUTINE-LEVEL ON ERROR UNDO, THROW.

CLASS prodict.sec._sec-pol-util:

{prodict/sec/sec-pol.i}

&SCOPED-DEFINE TABLE_TYPE "Table"
&SCOPED-DEFINE INDEX_TYPE "Index"
&SCOPED-DEFINE CLOB_TYPE  "Clob"
&SCOPED-DEFINE BLOB_TYPE  "Blob"


DEFINE PRIVATE VARIABLE myEPolicy     AS EncryptionPolicy    NO-UNDO.
DEFINE PRIVATE VARIABLE TablePolicies AS TablePolicy  EXTENT NO-UNDO.
DEFINE PRIVATE VARIABLE IndexPolicies AS IndexPolicy  EXTENT NO-UNDO.
DEFINE PRIVATE VARIABLE LobPolicies   AS LobPolicy    EXTENT NO-UNDO.
DEFINE PRIVATE VARIABLE seq           AS INTEGER             NO-UNDO.
DEFINE PRIVATE VARIABLE hDB           AS HANDLE              NO-UNDO.

DEFINE PUBLIC PROPERTY CipherNames AS CHARACTER
    GET():
      DEFINE VARIABLE cList AS CHAR NO-UNDO.
      DEFINE VARIABLE cTmp AS CHAR NO-UNDO.
      DEFINE VARIABLE i     AS INT  NO-UNDO.
      DEFINE VARIABLE j     AS INT  NO-UNDO.

      IF NOT VALID-OBJECT(myEPolicy) THEN
          RETURN ?.
      ELSE DO:
          /* filter out null and pbe ciphers */
          ASSIGN ctmp = myEPolicy:CipherNames
                 ctmp = REPLACE(ctmp,"NULL_NULL_NULL,","")
                 j = NUM-ENTRIES(ctmp).

          REPEAT i = 1 TO j:
              IF NOT ENTRY(i,cTmp) MATCHES "*_PBE" THEN DO:
                  IF cList = "" THEN
                     ASSIGN cList = cList + ENTRY(i,cTmp).
                  ELSE
                      ASSIGN cList = cList + "," + ENTRY(i,cTmp).
              END.
          END.

          RETURN cList.
      END.
    END GET.

DEFINE PUBLIC PROPERTY DefaultCipher AS CHARACTER
    GET():
      IF NOT VALID-OBJECT(myEPolicy) THEN
          RETURN ?.
      ELSE
          RETURN myEPolicy:DefaultCipher.
    END GET.

DEFINE PUBLIC PROPERTY EncryptionEnabledOnly AS LOGICAL
    GET.
    SET.

DEFINE PUBLIC PROPERTY FillAreaNum AS LOGICAL
    GET.
    SET.

DEFINE PRIVATE PROPERTY nextSeqNum AS INTEGER
    GET():
         /* get next value if the instantiator is adding records to the temp-table */
         ASSIGN seq = seq + 1.
         RETURN seq.
    END GET.

DEFINE PUBLIC PROPERTY canMantainPolicies AS LOGICAL
    GET():
        RETURN myEPolicy:isKeyStoreAdmin.
    END GET.

CONSTRUCTOR _sec-pol-util():
    getEpolicyObj("DICTDB").
END CONSTRUCTOR.

CONSTRUCTOR _sec-pol-util(INPUT cDbName AS CHAR):
    getEpolicyObj(cDbName).
END CONSTRUCTOR.

METHOD PRIVATE VOID getEpolicyObj (INPUT cDbName AS CHAR):
   DEFINE VARIABLE lOk AS LOGICAL     NO-UNDO.
   DEFINE VARIABLE cOrig AS CHAR      NO-UNDO.

    myEPolicy = NEW EncryptionPolicy(cDbName).

    /* _dctadmn.p used DICTDB, but DICTDB may not be the db we are looking at */
    IF cDbName NE "DICTDB":U AND (LDBNAME("DICTDB") NE cDbName) THEN DO:
       cOrig = LDBNAME("DICTDB").
       CREATE ALIAS DICTDB FOR DATABASE VALUE(cDbName).
    END.

    RUN prodict/_dctadmn.p ( INPUT USERID(cDbName), OUTPUT lOk ).

    IF cOrig NE ? AND cOrig NE "" THEN
       CREATE ALIAS DICTDB FOR DATABASE VALUE(cOrig).
    
    IF NOT lOk THEN DO:
        /* make sure we delete the object now */
       DELETE OBJECT myEPolicy NO-ERROR.
       UNDO, THROW NEW Progress.Lang.AppError("You must be a Security Administrator to maintain encryption policies.", 14893).
    END.

    /* get a share lock on the schema so no one can make changes to it
       while we are in the same transaction.
    */
    getDbLock(NO).

    CATCH e AS PROGRESS.Lang.ProError:
       DEFINE VARIABLE cError AS CHAR    NO-UNDO.
       DEFINE VARIABLE iNum   AS INTEGER NO-UNDO.

       IF VALID-OBJECT(myEPolicy) THEN
           DELETE OBJECT myEPolicy.

       ASSIGN iNum = e:GetMessageNum(1).

       CASE iNum:
           WHEN 14889 THEN
               cError = "Database "  + LDBNAME(cDbName) + " does not have the encryption feature enabled.".
           WHEN 14890 THEN
               cError = "Cannot read encryption policies if database is remote.".
           WHEN 14888 THEN
               cError = "Database is not connected.".
           WHEN 14893 THEN
               cError = "You must be a Security Administrator to maintain encryption policies.".
           OTHERWISE
               cError=  'Error: ' + e:GetMessage(1).
       END CASE.

       DELETE OBJECT e.

       /* throw an application error */
       UNDO, THROW NEW Progress.Lang.AppError(cError, iNum).
    END CATCH. 

END METHOD.

/* get list of objects (table/index/lob) that are encryptable and info on the current 
  policy. The code is database reference-free - we use the db passed to the constructor.
*/
METHOD PUBLIC VOID getTableList(INPUT getCurrPolicyInfo AS LOGICAL,
                                OUTPUT DATASET dsObjAttrs):

    DEFINE VARIABLE cTmp    AS CHAR   NO-UNDO.
    DEFINE VARIABLE hQuery1 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery2 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery3 AS HANDLE NO-UNDO.

    DEFINE VARIABLE hFile   AS HANDLE NO-UNDO.
    DEFINE VARIABLE hField  AS HANDLE NO-UNDO.
    DEFINE VARIABLE hIndex  AS HANDLE NO-UNDO.
    DEFINE VARIABLE cType   AS CHAR   NO-UNDO.

    EMPTY TEMP-TABLE ttObjAttrs NO-ERROR.
    ASSIGN seq = 0 /* initial */
           cTmp = myEpolicy:LogicalDBName  + "._File".

    /* will not suppress errors - which will get thrown back to the caller */
    CREATE BUFFER hFile FOR TABLE cTmp.

    CREATE QUERY hQuery1.
    hQuery1:SET-BUFFERS(hFile).
    hQuery1:QUERY-PREPARE("FOR EACH " + cTmp + " WHERE ((_File-number > 0 AND _File-number < 32000) OR _File-name BEGINS '_aud-')"
                            + " AND _Owner = 'PUB' USE-INDEX _File-name" ).
    hQuery1:QUERY-OPEN().

    REPEAT ON ERROR UNDO, THROW:
       hQuery1:GET-NEXT(NO-LOCK).  
       IF hQuery1:QUERY-OFF-END THEN
          LEAVE.
       addIfEncryptable(INPUT hFile::_File-number,
                        INPUT hFile::_File-name,
                        INPUT hFile::_ianum,
                        INPUT {&TABLE_TYPE},
                        INPUT getCurrPolicyInfo).

       /* look for fields */
        IF NOT VALID-HANDLE(hField) THEN DO:
           CREATE BUFFER hField FOR TABLE myEPolicy:LogicalDBName + "._Field".
        
           CREATE QUERY hQuery2.
           hQuery2:SET-BUFFERS(hField).
        END.

        hQuery2:QUERY-PREPARE("FOR EACH _Field WHERE (_Field._Data-type = 'CLOB' OR _Field._Data-type = 'BLOB')"
                              + " AND _File-recid = " + STRING(hFile:RECID) ).
        hQuery2:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery2:GET-NEXT(NO-LOCK).  
            IF hQuery2:QUERY-OFF-END THEN
               LEAVE.

            /* use values from pre-processor so all of them show up with
               first letter as uppercase.
            */
            IF hField::_Data-type = {&BLOB_TYPE} THEN
                cType = {&BLOB_TYPE}.
            ELSE
                cType = {&CLOB_TYPE}.

            addIfEncryptable(INPUT hField::_Fld-stlen,
                             INPUT hFile::_File-name
                                  + "." + hField::_Field-name,
                             INPUT ?,
                             INPUT cType,
                             INPUT getCurrPolicyInfo).
        END.
        hQuery2:QUERY-CLOSE().

        /* look for indexes */
        IF NOT VALID-HANDLE(hIndex) THEN DO:
           CREATE BUFFER hIndex FOR TABLE myEPolicy:LogicalDBName + "._Index".
        
           CREATE QUERY hQuery3.
           hQuery3:SET-BUFFERS(hIndex).
        END.

        hQuery3:QUERY-PREPARE("FOR EACH _Index WHERE _File-recid = " + STRING(hFile:RECID)).
        hQuery3:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery3:GET-NEXT(NO-LOCK).  
            IF hQuery3:QUERY-OFF-END THEN
               LEAVE.

            addIfEncryptable(INPUT hIndex::_Idx-num,
                             INPUT hFile::_File-name 
                                   + "." + hIndex::_Index-name,
                             INPUT hIndex::_ianum,
                             INPUT {&INDEX_TYPE},
                             INPUT getCurrPolicyInfo).
        END.
        hQuery3:QUERY-CLOSE().
    END.

    hQuery1:QUERY-CLOSE().

   /* OUTPUT TO policies.txt.
    FOR EACH ttObjAttrs.
        EXPORT ttObjAttrs.
    END.
    OUTPUT CLOSE.*/

    CATCH e AS PROGRESS.Lang.ProError:
       UNDO, THROW NEW Progress.Lang.AppError(e:GetMessage(1), e:GetMessageNum(1)).
    END CATCH.
    FINALLY:
        DELETE OBJECT hQuery1 NO-ERROR.
        DELETE OBJECT hQuery2 NO-ERROR.
        DELETE OBJECT hQuery3 NO-ERROR.
        DELETE OBJECT hFile   NO-ERROR.
        DELETE OBJECT hField  NO-ERROR.
        DELETE OBJECT hIndex  NO-ERROR.
    END FINALLY.
        
END METHOD.

/* get list of table and/or its indexes and LOB columns that can be encryptable */
METHOD PUBLIC VOID getObjectList(INPUT cTableName AS CHARACTER,
                                 INPUT getCurrPolicyInfo AS LOGICAL,
                                 OUTPUT DATASET dsObjAttrs):

    DEFINE VARIABLE cTmp    AS CHAR   NO-UNDO.
    DEFINE VARIABLE hQuery1 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery2 AS HANDLE NO-UNDO.
    DEFINE VARIABLE hQuery3 AS HANDLE NO-UNDO.

    DEFINE VARIABLE hFile   AS HANDLE NO-UNDO.
    DEFINE VARIABLE hField  AS HANDLE NO-UNDO.
    DEFINE VARIABLE hIndex  AS HANDLE NO-UNDO.
    DEFINE VARIABLE cType   AS CHAR   NO-UNDO.

    EMPTY TEMP-TABLE ttObjAttrs NO-ERROR.
    ASSIGN seq = 0 /* initial */
           cTmp = myEpolicy:LogicalDBName  + "._File".

    /* will not suppress errors - which will get thrown back to the caller */
    CREATE BUFFER hFile FOR TABLE cTmp.

    CREATE QUERY hQuery1.
    hQuery1:SET-BUFFERS(hFile).
    hQuery1:QUERY-PREPARE("FOR EACH " + cTmp + " WHERE _File-name = '" +
                            cTableName + "' AND _Owner = 'PUB' USE-INDEX _File-name" ).
    hQuery1:QUERY-OPEN().

    REPEAT ON ERROR UNDO, THROW:
       hQuery1:GET-NEXT(NO-LOCK).  
       IF hQuery1:QUERY-OFF-END THEN
          LEAVE.
       addIfEncryptable(INPUT hFile::_File-number,
                        INPUT hFile::_File-name,
                        INPUT hFile::_ianum,
                        INPUT {&TABLE_TYPE},
                        INPUT getCurrPolicyInfo).

       /* look for fields */
        IF NOT VALID-HANDLE(hField) THEN DO:
           CREATE BUFFER hField FOR TABLE myEPolicy:LogicalDBName + "._Field".
        
           CREATE QUERY hQuery2.
           hQuery2:SET-BUFFERS(hField).
        END.

        hQuery2:QUERY-PREPARE("FOR EACH _Field WHERE (_Field._Data-type = 'CLOB' OR _Field._Data-type = 'BLOB')"
                              + " AND _File-recid = " + STRING(hFile:RECID) ).
        hQuery2:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery2:GET-NEXT(NO-LOCK).  
            IF hQuery2:QUERY-OFF-END THEN
               LEAVE.

            /* use values from pre-processor so all of them show up with
               first letter as uppercase.
            */
            IF hField::_Data-type = {&BLOB_TYPE} THEN
                cType = {&BLOB_TYPE}.
            ELSE
                cType = {&CLOB_TYPE}.

            addIfEncryptable(INPUT hField::_Fld-stlen,
                             INPUT hFile::_File-name
                                  + "." + hField::_Field-name,
                             INPUT ?,
                             INPUT cType,
                             INPUT getCurrPolicyInfo).
        END.
        hQuery2:QUERY-CLOSE().

        /* look for indexes */
        IF NOT VALID-HANDLE(hIndex) THEN DO:
           CREATE BUFFER hIndex FOR TABLE myEPolicy:LogicalDBName + "._Index".
        
           CREATE QUERY hQuery3.
           hQuery3:SET-BUFFERS(hIndex).
        END.

        hQuery3:QUERY-PREPARE("FOR EACH _Index WHERE _File-recid = " + STRING(hFile:RECID)).
        hQuery3:QUERY-OPEN().
        REPEAT ON ERROR UNDO, THROW:
            hQuery3:GET-NEXT(NO-LOCK).  
            IF hQuery3:QUERY-OFF-END THEN
               LEAVE.

            addIfEncryptable(INPUT hIndex::_Idx-num,
                             INPUT hFile::_File-name 
                                   + "." + hIndex::_Index-name,
                             INPUT hIndex::_ianum,
                             INPUT {&INDEX_TYPE},
                             INPUT getCurrPolicyInfo).
        END.
        hQuery3:QUERY-CLOSE().
    END.

    hQuery1:QUERY-CLOSE().

   /* OUTPUT TO policies.txt.
    FOR EACH ttObjAttrs.
        EXPORT ttObjAttrs.
    END.
    OUTPUT CLOSE.*/

    CATCH e AS PROGRESS.Lang.ProError:
       UNDO, THROW NEW Progress.Lang.AppError(e:GetMessage(1), e:GetMessageNum(1)).
    END CATCH.
    FINALLY:
        DELETE OBJECT hQuery1 NO-ERROR.
        DELETE OBJECT hQuery2 NO-ERROR.
        DELETE OBJECT hQuery3 NO-ERROR.
        DELETE OBJECT hFile   NO-ERROR.
        DELETE OBJECT hField  NO-ERROR.
        DELETE OBJECT hIndex  NO-ERROR.
    END FINALLY.
        
END METHOD.

/* Given an object name and type, get the encryption policy info.
*/
METHOD PUBLIC VOID getPolicyVersions(INPUT objName AS CHAR, 
                                     INPUT objectType AS CHAR, 
                                     OUTPUT DATASET dsObjAttrs):
    DEFINE VARIABLE cTable AS CHAR NO-UNDO.
    DEFINE VARIABLE cObj   AS CHAR NO-UNDO.

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name EQ objName AND 
                                  ttObjAttrs.obj-type EQ objectType NO-ERROR.
    IF NOT AVAILABLE ttObjAttrs THEN DO:

       /* if not on the table yet, we will check if we can get it now */
       findAndAdd(INPUT NO, ?, objName, objectType).

       FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name EQ objName NO-ERROR.
    END.

    /* if we can't find it for the object specified, bad table-name passed */    
    IF AVAILABLE ttObjAttrs THEN
        fillPolicyInfo(INPUT ttObjAttrs.seq-num, 
                       INPUT ttObjAttrs.obj-name, 
                       INPUT ttObjAttrs.obj-type, 
                       INPUT YES). /* fill policy versions table*/
END METHOD.

/* Given an object num and type, get the encryption policy info.
*/
METHOD PUBLIC VOID getPolicyVersions(INPUT objNum AS INTEGER, 
                                     INPUT objectType AS CHAR, 
                                     OUTPUT DATASET dsObjAttrs):

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-num = objNum AND 
        ttObjAttrs.obj-type = objectType NO-ERROR.

    IF NOT AVAILABLE ttObjAttrs THEN DO:
       /* if not on the table yet, we will check if we can get it now */
       findAndAdd(INPUT YES, objNum, ?, objectType).

       FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-num = objNum AND 
           ttObjAttrs.obj-type = objectType NO-ERROR.
    END.

    /* if we can't find it for the object specified, bad table-name passed */    
    IF AVAILABLE ttObjAttrs THEN
        fillPolicyInfo(INPUT ttObjAttrs.seq-num, 
                       INPUT ttObjAttrs.obj-name, 
                       INPUT ttObjAttrs.obj-type, 
                       INPUT YES). /* fill policy versions table*/
END METHOD.

/* Given an object num and type, get the encryption policy info.
   The object name is also passed. If we can't find an entry for it, we create it as a placeholder.
*/
METHOD PUBLIC VOID getPolicyVersions(INPUT objNum AS INTEGER, 
                                     INPUT objName AS CHAR, 
                                     INPUT objectType AS CHAR, 
                                     OUTPUT DATASET dsObjAttrs):

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = objName AND 
        ttObjAttrs.obj-type = objectType NO-ERROR.

    IF NOT AVAILABLE ttObjAttrs THEN DO:
        addIfEncryptable(INPUT objNum, INPUT objName, INPUT ?, 
                         INPUT objectType, INPUT YES).
        /* see if we added it */
        FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = objName AND 
             ttObjAttrs.obj-type = objectType NO-ERROR.
    END.

    /* if we can't find it for the object specified, bad table-name passed */    
    IF AVAILABLE ttObjAttrs THEN
        fillPolicyInfo(INPUT ttObjAttrs.seq-num, 
                       INPUT ttObjAttrs.obj-name, 
                       INPUT ttObjAttrs.obj-type, 
                       INPUT YES). /* fill policy versions table*/
END METHOD.

/* update encryption policy for the objects in the dataset */
METHOD PUBLIC VOID updatePolicies (INPUT callerForCallBack AS HANDLE,
                                   INPUT DATASET dsObjAttrs):

    DEFINE BUFFER bAfter FOR ttObjAttrs.
    DEF VAR cipherName AS CHAR NO-UNDO.
    DEF VAR fullobjName    AS CHAR NO-UNDO.
    DEF VAR tableName  AS CHAR NO-UNDO.
    DEF VAR objName    AS CHAR NO-UNDO.
    DEF VAR objType    AS CHAR NO-UNDO.
    DEFINE VARIABLE myTPol AS TablePolicy NO-UNDO.
    DEFINE VARIABLE myIPol AS IndexPolicy NO-UNDO.
    DEFINE VARIABLE myLPol AS LobPolicy   NO-UNDO.

    /* now go through all the changed records and make the necessary 
       changes. We are here either because the user wants to enable,
       disable or generate the encryption key. They are translated to
       a new policy, so we can just create a policy with the cipher
       we have. The only case to watch for is when the cipher is blank,
       which then means we have to pass the 'null_null_null' cipher.
    */
    main-trans:
    DO TRANS ON ERROR UNDO, THROW:

        FOR EACH bfttObjAttrs ON ERROR UNDO, THROW
            ON STOP UNDO, LEAVE: /* catches canceled lock */

            FIND FIRST bAfter WHERE ROWID(bAfter) = BUFFER bfttObjAttrs:AFTER-ROWID.
            ASSIGN cipherName = bAfter.obj-cipher
                   fullobjName = bAfter.obj-name
                   objType = bAfter.obj-type
                   tableName = ENTRY(1,fullobjName,".").

            IF cipherName = "" THEN
               ASSIGN cipherName = "NULL_NULL_NULL".

            CASE bAfter.obj-type:
                WHEN {&TABLE_TYPE} THEN DO:
                    myTPol = myEPolicy:CreateTablePolicy(tableName,cipherName).
                    DELETE OBJECT myTPol.
                END.
                WHEN {&INDEX_TYPE} OR 
                    WHEN {&CLOB_TYPE} OR 
                    WHEN {&BLOB_TYPE} THEN DO:

                    IF NUM-ENTRIES(fullobjName,".") > 1 THEN
                       objName = ENTRY(2,fullobjName,".").
                    ELSE
                       UNDO main-trans, THROW NEW Progress.Lang.AppError("Missing object name in : " + fullobjName, 1).

                    IF bAfter.obj-type = {&INDEX_TYPE} THEN DO:
                       myIPol = myEPolicy:CreateIndexPolicy(tableName, objName, cipherName).
                       DELETE OBJECT myIPol.
                    END.
                    ELSE DO:
                       myLPol = myEPolicy:CreateLobPolicy(tableName, objName, cipherName).
                       DELETE OBJECT myLPol.
                    END.

                END.
                OTHERWISE
                    UNDO, THROW NEW Progress.Lang.AppError("Invalid object type: " + bAfter.obj-type, 1).
            END CASE.

            CATCH e AS PROGRESS.Lang.ProError:
                DEFINE VARIABLE cError    AS CHAR    NO-UNDO.
                DEFINE VARIABLE iNum      AS INTEGER NO-UNDO.
                DEFINE VARIABLE lContinue AS LOGICAL NO-UNDO.
                
                ASSIGN  iNum = e:GetMessageNum(1)
                        cError = "Error: ".
    
                IF iNum = 14896 THEN
                   cError = cError + "Cannot change the object encryption policy until its encrypted data has been updated".
                ELSE IF iNum NE 12536 THEN
                   cError = cError + e:GetMessage(1).
    
                DELETE OBJECT e.
    
                IF iNum = 12536 THEN /* can't get schema lock */
                    STOP.
    
                cError = cError + " (Object: " + fullobjName +
                         " Type: "   + objType + ")".

                /* if callback is set up, caller wants to be notified or
                   errors and deal with them. If we should continue, we 
                   will just move on to the next record. If not, we undo
                   the transaction and return.
                   If not callback is defined, we throw an error.
                */
                IF callerForCallBack NE ? THEN DO:
                    RUN secErrorCallback IN callerForCallBack 
                         (INPUT cError, OUTPUT lContinue) NO-ERROR.
                    IF NOT lContinue THEN
                         UNDO main-trans, LEAVE main-trans.
                    NEXT.
                END.
                ELSE
                /* throw an application error */
                UNDO, THROW NEW Progress.Lang.AppError(cError, iNum).
            END CATCH.

        END.
    END.

END METHOD.

/* For the load process - cache settings from the .df */
METHOD PUBLIC LOGICAL cacheObjForLoad (INPUT cObjName AS CHAR,
                                       INPUT objType AS CHAR,
                                       INPUT objNum AS INT,
                                       INPUT-OUTPUT cipher AS CHAR):
DEFINE VARIABLE hasPrev AS LOGICAL NO-UNDO.
DEFINE VARIABLE cTmp    AS CHAR    NO-UNDO.

    FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = cObjName
      AND ttObjAttrs.obj-type = objType NO-ERROR.

    IF NOT AVAILABLE ttObjAttrs THEN DO:

        /* we are only called by the load process, but make sure the object name has the
           information needed.
        */
        cTmp = ENTRY(1,cObjName, ".").
        IF cTmp = "" OR cTmp = ? THEN
            UNDO, THROW NEW Progress.Lang.AppError("Invalid object name: "+ cObjName, 1).
        IF objType NE {&TABLE_TYPE} THEN DO:
            IF NUM-ENTRIES(cObjName, ".") = 2 THEN
               cTmp = ENTRY(2,cObjName, ".").
            ELSE
                ASSIGN cTmp = "".

            IF cTmp = "" OR cTmp = ? THEN
                UNDO, THROW NEW Progress.Lang.AppError("Invalid object name: " + cObjName, 1).
        END.


        TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = NO.

        /* let's get the info for the policy on this object, 
           in case there is one, but don't do it if object number is zero,
           which means the object is being created in the same transaction.
        */
        IF objNum NE 0 THEN
           getPolicyVersions(INPUT cObjName, 
                             INPUT objType, 
                             OUTPUT DATASET dsObjAttrs BY-REFERENCE).

        FIND FIRST ttObjAttrs WHERE ttObjAttrs.obj-name = cObjName
             AND ttObjAttrs.obj-type = objType NO-ERROR.
        IF NOT AVAILABLE ttObjAttrs THEN DO:
            /* if this is a new object, it won't have any policies, so
               just add it manually for now.
            */
            CREATE ttObjAttrs.
            ASSIGN ttObjAttrs.seq-num = nextSeqNum
                   ttObjAttrs.obj-name = cObjName
                   ttObjAttrs.obj-type = objType
                   ttObjAttrs.obj-num = objNum.
        END.

        TEMP-TABLE ttObjAttrs:TRACKING-CHANGES = YES.
    END.

    ASSIGN hasPrev = ttObjAttrs.has-prev-pol.

    /* we will now record the new value (or first value). tracking changes should be on
       by now, so we will use the values in the before-table to see if there is an effective change
       when it's time to save the changes.
     */  
    IF cipher <> ttObjAttrs.obj-cipher THEN DO:
        IF NOT hasPrev THEN
            ttObjAttrs.obj-cipher = cipher.     
    END.
    ELSE
        cipher = ?. /* singal the caller that it was the same cipher */

    /* so we will return if it has a previous version, and cipher will be ? if it's the same
       cipher name of the current policy version
    */
    RETURN hasPrev.

END METHOD.

/* For the load process - save policy settings that we cached from the .df */
METHOD PUBLIC LOGICAL cacheSavePolicy(INPUT callerProc AS handle, 
                                      OUTPUT invalidObjName AS CHAR):

     DEFINE VARIABLE fixedAll  AS LOGICAL NO-UNDO.

     /* check if there are any changes at all */
     IF NOT CAN-FIND (FIRST bfttObjAttrs) THEN 
        RETURN YES.

     fixedAll = cacheFixObjNumBeforeUpdate().

     /* if we find a record with an invalid obj num, then we can't move on because
        we have some transaction above us that is holding up the creation of the objects.
        So if we couldn't fix them up, return no 
     */
     IF NOT fixedAll THEN DO:
         ASSIGN invalidObjName = ttObjAttrs.obj-name.
         RETURN NO.
     END.

     IF NOT canMantainPolicies THEN 
         UNDO, THROW NEW Progress.Lang.AppError("You must be the Key Store Administrator" +
                                                " to mantain encryption policies", 1).

     /* if not yet locked, get a lock on the schema so no one can make 
        changes to it while we are in this transaction.
     */
     getDbLock(YES).

     /* this throws an error if we fail to save a policy. Caller must catch the error */
     updatePolicies(INPUT callerProc, INPUT DATASET dsObjAttrs BY-REFERENCE).

     RETURN YES.
END METHOD.


/* this gets called when the caller wants us to get a lock on the _db
   so that no other user can make changes while we have the info cached 
*/
METHOD PUBLIC VOID getDbLock(INPUT lExclusive AS LOGICAL):

    /* if the first time, create the dynamic buffer object */
    IF NOT VALID-HANDLE(hDB) THEN
        CREATE BUFFER hDB FOR TABLE myEPolicy:LogicalDBName + "._Db" NO-ERROR.
    IF VALID-HANDLE(hDB) THEN DO:
        IF lExclusive  THEN
           hDB:FIND-FIRST("", EXCLUSIVE-LOCK) NO-ERROR.
        ELSE
           hDB:FIND-FIRST("", SHARE-LOCK) NO-ERROR.

        IF hDB:AVAILABLE THEN
           hDB:BUFFER-RELEASE().
    END.

END METHOD.

/* This is called through the load process to fix up the object number on the records in the
   temp-table before going through with the update of the policies.
*/
METHOD PRIVATE LOGICAL cacheFixObjNumBeforeUpdate():
   DEFINE VARIABLE cTable   AS CHAR    NO-UNDO.
   DEFINE VARIABLE cObj     AS CHAR    NO-UNDO.
   DEFINE VARIABLE fixedAll AS LOGICAL NO-UNDO INIT YES.

   DEFINE VARIABLE hFile  AS HANDLE NO-UNDO.
   DEFINE VARIABLE hField AS HANDLE NO-UNDO.
   DEFINE VARIABLE hIndex AS HANDLE NO-UNDO.

   /* go through changed records and see if we have any recors to fix up.
      Note that they will still remain invalid if there is a transaction outside the
      load process
    */
   FOR EACH bfttObjAttrs.
         FIND FIRST ttObjAttrs WHERE ROWID(ttObjAttrs) = BUFFER bfttObjAttrs:AFTER-ROWID.
         /* they should be different, but in any case... */
         IF ttObjAttrs.obj-cipher NE bfttObjAttrs.obj-cipher THEN DO:
             IF ttObjAttrs.obj-num = ? THEN DO:
                 /* this is the case where the table/field/index was newly created. Need to
                    refind the _File record and get the obj number.
                 */
                 ASSIGN cTable = ENTRY(1,ttObjAttrs.obj-name,".").
                 IF ttObjAttrs.obj-type NE {&TABLE_TYPE} THEN
                     ASSIGN cObj = ENTRY(2,ttObjAttrs.obj-name,".").

                 IF NOT VALID-HANDLE(hFile) THEN DO:
                     /* will assume that by now we can create the buffer */
                     CREATE BUFFER hFile FOR TABLE myEPolicy:LogicalDBName + "._File".
                 END.

                 hFile:FIND-FIRST("where _File-name = " + QUOTER(ctable), NO-LOCK).
                 IF hFile::_File-number > 0 THEN DO:
                     IF ttObjAttrs.obj-type = {&TABLE_TYPE} THEN
                        ttObjAttrs.obj-num = hFile::_File-number.
                     ELSE IF ttObjAttrs.obj-type = {&INDEX_TYPE} THEN DO:
                         IF NOT VALID-HANDLE(hIndex) THEN DO:
                             /* will assume that by now we can create the buffer */
                             CREATE BUFFER hIndex FOR TABLE myEPolicy:LogicalDBName + "._Index".
                         END.

                         hIndex:FIND-FIRST("where _Index-name = " + QUOTER(cObj) 
                                           + " AND _File-recid = " + STRING(hFile:RECID), NO-LOCK).

                         IF hIndex::_Idx-num > 0 THEN DO:
                             ttObjAttrs.obj-num = hIndex::_Idx-num.
                         END.
                         ELSE
                             fixedAll = NO.
                     END.
                     ELSE DO: /* lobs */
                         IF NOT VALID-HANDLE(hField) THEN DO:
                             /* will assume that by now we can create the buffer */
                             CREATE BUFFER hField FOR TABLE myEPolicy:LogicalDBName + "._Field".
                         END.

                         hField:FIND-FIRST("where _Field-name = " + QUOTER(cObj) 
                                           + " AND _File-recid = " + STRING(hFile:RECID), NO-LOCK).

                         /* for lobs, the _Fld-stlen field is set to the area number upon creation. So
                            it won't be zero, and I can't assume that it hasn't been created if
                            it's the area number, since it may have gotten it once it got created.
                         */
                         ttObjAttrs.obj-num = hField::_Fld-stlen.
                     END.
                 END.
                 ELSE
                     fixedAll = NO.
             END.
         END.
         ELSE DO:
             /* if cipher name is the same, reject the change */
             BUFFER bfttObjAttrs:REJECT-ROW-CHANGES().
         END.
   END.

   IF VALID-HANDLE(hFile) THEN
       DELETE OBJECT hFile.
   IF VALID-HANDLE(hField) THEN
       DELETE OBJECT hField.
   IF VALID-HANDLE(hIndex) THEN
       DELETE OBJECT hIndex.

   RETURN fixedAll.

END METHOD.

/* Database reference-free code to look for objects in the db (table/index/lobs),
   and add them to the temp-table with the encryption policy info.
   We use the db passed to the constructor.
*/
METHOD PRIVATE VOID findAndAdd(INPUT numMode AS LOGICAL, INPUT objNum AS INT, 
                               INPUT objName AS CHAR, INPUT objectType AS CHAR):
    DEFINE VARIABLE cTable AS CHAR NO-UNDO.
    DEFINE VARIABLE cObj   AS CHAR NO-UNDO.

    DEFINE VARIABLE hFile  AS HANDLE NO-UNDO.
    DEFINE VARIABLE hField AS HANDLE NO-UNDO.
    DEFINE VARIABLE hIndex AS HANDLE NO-UNDO.

    CREATE BUFFER hFile FOR TABLE myEPolicy:LogicalDBName + "._File" NO-ERROR.
    IF NOT VALID-HANDLE(hFile) THEN
       RETURN.

    IF NOT numMode THEN DO:
       /* It must be a string for table, or table.obj-name for indexes and LOBs */
       ASSIGN ctable = ENTRY(1,objName, ".").
       IF objectType NE {&TABLE_TYPE} THEN DO:
          IF NUM-ENTRIES(objName,".") = 2 THEN
             cObj = ENTRY(2,objName, ".").
       END.
    END.

    hFile:FIND-FIRST("where " 
                     + (IF numMode THEN "_File-number = " + STRING(objNum) 
                        ELSE "_File-name = " + QUOTER(ctable)) 
                     + " AND _Owner = 'PUB'" 
                     + (IF numMode THEN "" ELSE " USE-INDEX _File-name"), NO-LOCK) NO-ERROR.

    IF hFile:AVAILABLE AND (hFile::_File-name BEGINS "_aud-" OR
          (hFile::_File-number > 0 AND hFile::_file-number < 32000)) THEN DO:

       IF objectType = {&TABLE_TYPE} THEN
          addIfEncryptable(INPUT hFile::_File-number,
                           INPUT hFile::_File-name,
                           INPUT hFile::_ianum,
                           INPUT {&TABLE_TYPE},
                           INPUT YES).
       ELSE IF objectType = {&INDEX_TYPE} THEN DO:

          CREATE BUFFER hIndex FOR TABLE myEPolicy:LogicalDBName + "._Index" NO-ERROR.
          IF NOT VALID-HANDLE(hIndex) THEN DO:
            DELETE OBJECT hFile NO-ERROR.
            RETURN.
          END.

          hIndex:FIND-FIRST("where " 
                            + (IF numMode THEN "_Idx-num = " + STRING(objNum) 
                               ELSE "_Index-name = " + QUOTER(cObj) + " AND _File-recid = " + STRING(hFile:RECID)) 
                            + (IF numMode THEN "" ELSE " USE-INDEX _File/Index"), NO-LOCK) NO-ERROR.
          IF hIndex:AVAILABLE THEN
             addIfEncryptable(INPUT hIndex::_Idx-num,
                              INPUT hFile::_File-name 
                                  + "." + hIndex::_Index-name,
                              INPUT hIndex::_ianum,
                              INPUT {&INDEX_TYPE},
                              INPUT YES).
       END.
       ELSE IF objectType = {&CLOB_TYPE} OR objectType = {&BLOB_TYPE} THEN DO:
           CREATE BUFFER hField FOR TABLE myEPolicy:LogicalDBName + "._Field" NO-ERROR.
           IF NOT VALID-HANDLE(hField) THEN DO:
              DELETE OBJECT hFile NO-ERROR.
              RETURN.
           END.

           hField:FIND-FIRST("where _Data-type = " + QUOTER(objectType) + " AND "
                             + (IF numMode THEN "_Fld-stlen = " + STRING(objNum) 
                                ELSE "_Field-name = " + QUOTER(cObj) + " AND _File-recid = " + STRING(hFile:RECID)) 
                             + (IF numMode THEN "" ELSE " USE-INDEX _File/_Field"), NO-LOCK) NO-ERROR.
           IF hField:AVAILABLE THEN
              addIfEncryptable(INPUT hField::_Fld-stlen,
                               INPUT hFile::_File-name
                                     + "." + hField::_Field-name,
                               INPUT ?,
                               INPUT hField::_Data-type,
                               INPUT YES).
       END.
    END.

    IF VALID-HANDLE(hFile) THEN
        DELETE OBJECT hFile.
    IF VALID-HANDLE(hField) THEN
        DELETE OBJECT hField.
    IF VALID-HANDLE(hIndex) THEN
        DELETE OBJECT hIndex.
END METHOD.

METHOD PRIVATE VOID addObject(INPUT objNum AS INTEGER, 
                              INPUT objName AS CHAR, 
                              INPUT objArea AS INT,
                              INPUT objType AS CHAR,
                              INPUT getCurrPolicyInfo AS LOGICAL):

    CREATE ttObjAttrs.
    ASSIGN ttObjAttrs.seq-num = nextSeqNum
           ttObjAttrs.obj-num = objNum
           ttObjAttrs.obj-type = objType
           ttObjAttrs.obj-name = objName
           ttObjAttrs.obj-area = objArea.

    IF getCurrPolicyInfo THEN DO:
       fillPolicyInfo(INPUT ttObjAttrs.seq-num,
                      INPUT objName,
                      INPUT objType, 
                      INPUT NO). /* fill policy versions table */

       IF EncryptionEnabledOnly THEN DO:
           /* if we are interested only on objs with encryption enabled, 
              get rid of record if there is no policy or current policy is 
              'disabled' .
           */
           IF ttObjAttrs.obj-cipher = ? OR
              ttObjAttrs.obj-cipher = "" THEN
              DELETE ttObjAttrs.
       END.


    END.
    CATCH e AS PROGRESS.Lang.ProError:
        /* temp-table is no-undo, so if we failed to create the record, just 
           delete it now, and throw the exception to the caller which will get
           thrown all the way to the driver procedure.
        */
        DELETE ttObjAttrs NO-ERROR.
        UNDO, THROW e.
    END.
END METHOD.


METHOD PRIVATE VOID addIfEncryptable(INPUT objNum AS INT,
                                     INPUT fullName AS CHAR,
                                     INPUT objArea AS INT,
                                     INPUT objectType AS CHAR,
                                     INPUT getCurrPolicyInfo AS LOGICAL):

DEFINE VARIABLE hStorage  AS HANDLE NO-UNDO.
DEFINE VARIABLE cTmp      AS CHAR   NO-UNDO.
DEFINE VARIABLE cType     AS CHAR   NO-UNDO.
DEFINE VARIABLE tableName AS CHAR   NO-UNDO.
DEFINE VARIABLE objName   AS CHAR   NO-UNDO.

   ASSIGN tableName = ENTRY(1,fullName,".").

   IF NUM-ENTRIES(fullName,".") > 1 THEN
      objName = ENTRY(2,fullName,".").

   IF (objectType = {&TABLE_TYPE} AND myEPolicy:IsTableEncryptable(tableName)) OR
      (objectType = {&INDEX_TYPE} AND myEPolicy:IsIndexEncryptable(tableName, objName)) OR 
      ((objectType = {&CLOB_TYPE} OR objectType = {&BLOB_TYPE}) AND myEPolicy:IsLOBEncryptable(tableName, objName)) THEN
   DO:
       /* find the area num*/
      IF FillAreaNum THEN DO:
         /* for lobs and _aud- tables, we have to always find the area through the
             _Storageobject table.
         */
         IF objectType = {&CLOB_TYPE} OR objectType = {&BLOB_TYPE} OR objArea = ? THEN DO:
              IF objectType = {&TABLE_TYPE} THEN
                  cType = "1".
              ELSE IF objectType = {&INDEX_TYPE} THEN
                  cType = "2".
              ELSE
                  cType = "3".
                  
              ASSIGN cTmp= myEpolicy:LogicalDBName  + "._Storageobject".
              CREATE BUFFER hStorage FOR TABLE cTmp NO-ERROR.
              IF VALID-HANDLE(hStorage) THEN DO:
                  hStorage:FIND-FIRST("where _Object-type = " + cType + " AND _Object-number = "
                                      + STRING(objNum), NO-LOCK) NO-ERROR.
                  IF hStorage:AVAILABLE THEN DO:
                     objArea = hStorage::_Area-number.
                     hStorage:BUFFER-RELEASE().
                  END.
                  DELETE OBJECT hStorage NO-ERROR.
              END.
         END.
      END.

      addObject(INPUT objNum,
                INPUT fullName,
                INPUT objArea,
                INPUT objectType,
                INPUT getCurrPolicyInfo).
   END.
END METHOD.

METHOD PRIVATE VOID fillPolicyInfo(INPUT seqNum AS INT,
                                   INPUT fullName AS CHAR, 
                                   INPUT objType AS CHAR,
                                   INPUT fillVersions AS LOGICAL): /* fill policy versions table */

    DEFINE VARIABLE i         AS INTEGER NO-UNDO.
    DEFINE VARIABLE b         AS LOGICAL NO-UNDO.
    DEFINE VARIABLE tableName AS CHAR    NO-UNDO.
    DEFINE VARIABLE objName   AS CHAR    NO-UNDO.

    ASSIGN tableName = ENTRY(1,fullName, ".").

    IF NUM-ENTRIES(fullName,".") > 1 THEN
       objName = ENTRY(2,fullName, ".").

    IF objType = {&TABLE_TYPE} THEN DO:
        b = myEPolicy:GetTablePolicies (INPUT tableName, 
                                        OUTPUT TablePolicies).

        DO I = 1 TO EXTENT (TablePolicies):
           getPolicyInfo(INPUT CAST(TablePolicies[I],"Progress.Security.DB.Policy"),
                         INPUT seqNum,
                         INPUT fillVersions).
          DELETE OBJECT TablePolicies[I].
        END.

        /* reset extent size */
        EXTENT (TablePolicies) = ?.
    END.
    ELSE IF objType = {&INDEX_TYPE} THEN DO:
        b = myEPolicy:GetIndexPolicies (INPUT tableName, 
                                        INPUT objName,
                                        OUTPUT IndexPolicies).

        DO I = 1 TO EXTENT (IndexPolicies):
           getPolicyInfo(INPUT CAST(IndexPolicies[I],"Progress.Security.DB.Policy"),
                         INPUT seqNum,
                         INPUT fillVersions).
           DELETE OBJECT IndexPolicies[I].
        END.

        /* reset extent size */
        EXTENT (IndexPolicies) = ?.
    END.
    ELSE IF objType = {&CLOB_TYPE} OR objType = {&BLOB_TYPE} THEN DO:
        b = myEPolicy:GetLobPolicies (INPUT tableName, 
                                      INPUT objName, 
                                      OUTPUT LobPolicies).

        DO I = 1 TO EXTENT (LobPolicies):
           getPolicyInfo(INPUT CAST(LobPolicies[I],"Progress.Security.DB.Policy"),
                         INPUT seqNum,
                         INPUT fillVersions).
           DELETE OBJECT LobPolicies[I].
        END.
        /* reset extent size */
        EXTENT (LobPolicies) = ?.

    END.

END METHOD.

METHOD PRIVATE VOID getPolicyInfo(INPUT policyObj AS Progress.Security.DB.Policy,
                                  INPUT seqNum       AS INTEGER,
                                  INPUT fillVersions AS LOGICAL):
    
    /* we set cipher as an empty string, when disabled. Also, record whether we find
      a previous policy.*/
    IF policyObj:PolicyState = "Current" THEN DO:
       IF policyObj:CipherName NE "NULL_NULL_NULL" THEN
          ttObjAttrs.obj-cipher = policyObj:CipherName.
    END.
    ELSE IF policyObj:PolicyState = "Previous" THEN
        ttObjAttrs.has-prev-pol = YES.
     
    /* check if we need to add policy records too */
    IF fillVersions THEN DO:
       /* make sure we never add 2 records for the same obj and version */
       /* seq-num is unique for each object name. object name may not be unique
          if you have a LOB column and an index with the same name on the same
          table.
       */
       FIND FIRST ttObjEncPolicyVersions WHERE ttObjEncPolicyVersions.seq-num  = ttObjAttrs.seq-num 
           AND ttObjEncPolicyVersions.pol-version = policyObj:VersionNumber NO-ERROR.
       IF NOT AVAILABLE ttObjEncPolicyVersions THEN DO:
           CREATE ttObjEncPolicyVersions.
           ASSIGN ttObjEncPolicyVersions.obj-name = ttObjAttrs.obj-name
                  /* seq-num is unique for each object name. object name may 
                     not be unique if you have a LOB column and an index with
                     the same name on the same table.
                  */
                  ttObjEncPolicyVersions.seq-num = seqNum
                  ttObjEncPolicyVersions.pol-version = policyObj:VersionNumber
                  ttObjEncPolicyVersions.pol-state = policyObj:PolicyState.

           IF policyObj:CipherName NE "NULL_NULL_NULL" THEN
               ttObjEncPolicyVersions.pol-cipher = policyObj:CipherName.
           ELSE
               ttObjEncPolicyVersions.pol-cipher = "Disabled".
       END.
    END.
END METHOD.

DESTRUCTOR _sec-pol-util():

    IF VALID-HANDLE (hDb) THEN
       DELETE OBJECT hDB.

    IF VALID-OBJECT(myEPolicy) THEN
       DELETE OBJECT myEPolicy.
END DESTRUCTOR.

END CLASS.


/*********************************************************************
* Copyright (C) 2008-2009 by Progress Software Corporation. All rights    *
* reserved.                                                          *
*                                                                    *
*********************************************************************/

/*--------------------------------------------------------------------

File: prodict/sec/sec-pol.i

Description:
    Defines temp-table for object attributes such as encryption
    policy settings and alternate buffer pool.
        
History:
    07/01/08  fernando   created
    04/08/09  fernando   adding fields for buffer pool

--------------------------------------------------------------------*/

DEFINE TEMP-TABLE ttObjAttrs NO-UNDO BEFORE-TABLE bfttObjAttrs
    FIELD seq-num      AS INT
    FIELD obj-num      AS INT
    FIELD obj-type     AS CHAR
    FIELD obj-name     AS CHAR
    FIELD obj-area     AS INT
    FIELD disp-name    AS CHAR
    FIELD obj-cipher   AS CHAR
    FIELD has-prev-pol AS LOGICAL
    FIELD obj-genkey   AS LOGICAL
    FIELD obj-buf-pool AS CHARACTER  /* for buffer pool */
    FIELD area-buf-pool AS CHARACTER /* for buffer pool*/
    FIELD obj-selected  AS LOGICAL
    INDEX idx-seq  IS UNIQUE PRIMARY seq-num
    INDEX idx-name IS UNIQUE obj-name obj-type
    INDEX idx-num  obj-num obj-type.

DEFINE TEMP-TABLE ttObjEncPolicyVersions NO-UNDO
    FIELD obj-name    AS CHAR
    FIELD seq-num     AS INT
    FIELD pol-version AS INTEGER
    FIELD pol-state   AS CHAR
    FIELD pol-cipher  AS CHAR
    INDEX idx-name IS UNIQUE seq-num pol-version DESC.

DEFINE DATASET dsObjAttrs FOR ttObjAttrs, ttObjEncPolicyVersions.


/*********************************************************************
* Copyright (C) 2007 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/
/* 
   Created:  fernando 12/04/07

             Wrapper for ORACLE, MSS or ODBC schema pull that can be executed 
             in batch  mode.
                  
                  
   Input: p_sh_name   - schema holder logical name
          p_db_name   - logical name of schema image
          p_obj_name  - object name for object selection
          p_obj_owner - owner name for object selection
          p_obj_type  - type for object selection
          
          p_obj_* can be '*' to match all, a string or a string containing '*'
          (i.e. 'cust*').

          Both databases need to be connected and the user connected
          must have permissions to query the schema information.

  History:  
 
*/

define input parameter p_sh_name       as character. 
define input parameter p_db_name       as character. 
define input parameter p_obj_name      as character.
define input parameter p_obj_owner     as character. 
define input parameter p_obj_type      as character. 

DEFINE VARIABLE cDbType  AS CHARACTER NO-UNDO.

IF NOT CONNECTED(p_sh_name) THEN DO:
    MESSAGE "Database" p_sh_name "is not connected.".
    RETURN ERROR.
END.

IF NOT CONNECTED(p_db_name) THEN DO:
    MESSAGE "Database" p_db_name "is not connected.".
    RETURN ERROR.
END.

IF CAN-DO("READ-ONLY", DBRESTRICTIONS(p_sh_name)) THEN DO:
    MESSAGE "Database" p_sh_name "is read-only.".
    RETURN ERROR.
END.

cDbType = DBTYPE(p_db_name).

CREATE ALIAS "DICTDB" FOR DATABASE VALUE(p_sh_name).

PAUSE 0 BEFORE-HIDE.

IF cDbType = "ORACLE" THEN DO:
   RUN prodict/ora/_bpullora.p (p_db_name, p_obj_name, p_obj_owner, p_obj_type ).
END.
ELSE IF cDbType = "MSS" OR cDbType = "ODBC" THEN DO:
    RUN prodict/odb/_bpullodb.p (p_db_name, p_obj_name, p_obj_owner, p_obj_type).
END.
ELSE DO:
    MESSAGE "This utility only works with DataServer Schemas.".
END.


/*********************************************************************
* Copyright (C) 2011 by Progress Software Corporation. All rights    *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/* file-name may be either a specific file or ALL */
/* 
File:   prodict/dmpseqvals.p

Description:
    
    
IN:
    file-name                : "ALL" or "<file-name>"
    dot-d-dir                : directory relativ to working-directory
    code-page                : ?, "", "<code-page>"
    
    
Other-settings:    
    cLob-Dir                 : ?, "", directory
    map-option               : "MAP <name>" or "NO-MAP" OR ""
        
History
    rkumar                   created for dumping sequence values 

*/
using Progress.Lang.*.
routine-level on error undo, throw.


DEFINE /*INPUT PARAMETER */ VARIABLE dot-d-dir AS CHARACTER NO-UNDO.
DEFINE /*INPUT PARAMETER */ VARIABLE code-page AS CHARACTER NO-UNDO.
DEFINE /*INPUT PARAMETER */ VARIABLE file-name AS CHARACTER NO-UNDO.


/* This are new settings that can be set by calling the provided setter
   internal procedures, if this is called persistently. Otherwise, the
   behavior remains the same as previous versions, with the same default
   values.
*/
/* This are new settings that can be set by calling the provided setter
   internal procedures, if this is called persistently. Otherwise, the
   behavior remains the same as previous versions, with the same default
   values.
*/
DEFINE VARIABLE gLobDir         AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenantDir      AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenantLobDir   AS CHARACTER NO-UNDO.
DEFINE VARIABLE gTenant         AS CHARACTER NO-UNDO.
define variable gNoLobs         as logical   no-undo.
define variable gUseDefault     as logical   no-undo init ?.
DEFINE VARIABLE gSeqSel         AS CHARACTER NO-UNDO.

DEFINE VARIABLE map-option       AS CHARACTER NO-UNDO INIT "".

{ prodict/dictvar.i NEW }
{ prodict/user/uservar.i NEW }

DEFINE VARIABLE save_ab     AS LOGICAL   NO-UNDO.
DEFINE VARIABLE save_tenant AS char      NO-UNDO.

DEFINE VARIABLE setdmpSilent  AS LOGICAL NO-UNDO.

/*--------------------------- FUNCTIONS  --------------------------*/
function validDirectory returns logical ( cValue as char):
  
    IF cValue <> "" THEN 
    DO:
        ASSIGN FILE-INFO:FILE-NAME = cValue. 
        return SUBSTRING(FILE-INFO:FILE-TYPE,1,1) = "D".
    END.
        
    return true.
 
end function. /* validateDirectory */

function createDirectoryIf returns logical ( cdirname as char):
    define variable iStat as integer no-undo.
    if not validdirectory(cdirname) then
    do:
        OS-CREATE-DIR VALUE(cdirname). 
        iStat = OS-ERROR. 
        
        if iStat <> 0 then
           MESSAGE "Cannot create directory " + cdirname + ". System error:" iStat
                VIEW-AS ALERT-BOX ERROR BUTTONS OK.
        return istat = 0.
    end.
    return true.
end function. /* validateDirectory */
        
       
/*--------------------------- INTERNAL PROCS  --------------------------*/
PROCEDURE setFileName:
    DEFINE INPUT PARAMETER pfile-name AS CHAR NO-UNDO.
    ASSIGN file-name = pfile-name.
END.

PROCEDURE setDirectory:
    DEFINE INPUT PARAMETER pdot-d-dir AS CHAR NO-UNDO.
    ASSIGN dot-d-dir = pdot-d-dir.
END.

PROCEDURE setCodePage:
    DEFINE INPUT PARAMETER pcodepage AS CHAR NO-UNDO.
    ASSIGN code-page = pcodepage.
END.

PROCEDURE setNoLobs:
    DEFINE INPUT PARAMETER pNoLobs AS logical NO-UNDO.
    ASSIGN gNoLobs = pNoLobs.
END.

PROCEDURE setLobDir:
    DEFINE INPUT PARAMETER pcLob-Dir AS CHAR NO-UNDO.
    ASSIGN gLobDir = pcLob-Dir.
END.

PROCEDURE setUseDefaultLocation:
    DEFINE INPUT PARAMETER pldefault AS logical NO-UNDO.
    ASSIGN gUseDefault = pldefault.
END.

PROCEDURE setEffectiveTenant:
    DEFINE INPUT PARAMETER pcTenant AS CHAR NO-UNDO.
    if save_tenant = "" then
        save_tenant = get-effective-tenant-name("dictdb").
  
    gTenant = pctenant.
    if gUseDefault = ? then 
       gUseDefault = true.
END.

PROCEDURE setTenantDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    ASSIGN gTenantDir = pcDir.
END.

PROCEDURE setTenantLobDir:
    DEFINE INPUT PARAMETER pcDir AS CHAR NO-UNDO.
    ASSIGN gTenantLobDir = pcDir.
END.

PROCEDURE setMap:
    DEFINE INPUT PARAMETER pcmap-option AS CHAR NO-UNDO.
    ASSIGN map-option = pcmap-option.
END.

PROCEDURE SetSilent:
    DEFINE INPUT PARAMETER setsilent AS LOGICAL NO-UNDO.
    ASSIGN setdmpSilent = setsilent.
END.

PROCEDURE SetSequenceSelection:
    DEFINE INPUT PARAMETER setseqsel AS CHARACTER NO-UNDO.
    ASSIGN gSeqSel = setseqsel.
END.

/* This is the meat of this procdure */

PROCEDURE doDump:

    /* as of current just let the ABL  deal with error */
    if gtenant > "" then
        set-effective-tenant(gtenant,"dictdb"). 
        
    /* make sure these are clear */
    ASSIGN user_env = "".

    if      code-page = ?  
     then assign code-page = "<internal defaults apply>".
     else do:
      if code-page = "" then assign code-page = SESSION:STREAM.
      else if codepage-convert("a",code-page,SESSION:CHARSET) = ?
                        then assign code-page = SESSION:STREAM.
      if codepage-convert("a",code-page,SESSION:CHARSET) = ?
                        then assign code-page = "<internal defaults apply>".
    end.
      
    assign
      save_ab                   = SESSION:APPL-ALERT-BOXES
      SESSION:APPL-ALERT-BOXES  = NO.
       fOR EACH DICTDB._Db NO-LOCK:
          assign
           user_env[2] = file-name
           user_env[4] = ""
           user_env[5] = code-page
           user_env[6] = if setdmpSilent then "dump-silent" else "no-alert-boxes"
           user_env[33] = if gseqsel EQ "ALL" THEN "" else gseqsel
           drec_db     = RECID(_Db)
           .
        
        RUN "prodict/dump/_dmpseqs.p". 
    
   end.  /* FOR EACH _DB */

          
    finally:
        /* clean up tenant */
        assign
            user_env[32] = ""
        SESSION:APPL-ALERT-BOXES = save_ab.
        if save_tenant > "" then
            set-effective-tenant(save_tenant,"dictdb").         
    end finally.    


END PROCEDURE.

/*---------------------------  MAIN-CODE  --------------------------*/

/* if not running persistenty, go ahead and dump the definitions */
IF NOT THIS-PROCEDURE:PERSISTENT THEN
   RUN doDump.




/*********************************************************************
* Copyright (C) 2007-2010 by Progress Software Corporation. All rights *
* reserved.  Prior versions of this work may contain portions        *
* contributed by participants of Possenet.                           *
*                                                                    *
*********************************************************************/

/*----------------------------------------------------------------------------

File: prodict/load_df_silent.p

    This is the silent end-user entry point for Admin Tool's "Load .df file" utility
    
    The other .df utilitites; dump_df.p and dump_inc.p supports silent mode 
    as follows: 
              run <.p> persistent set h (param). 
              run setSilent in h (true).
              run <dump> (different name)
    
    The load_df.p does currently NOT support the persistent run silent mode 
    since the .df file only can be loaded once (and the filename is the 
    input parameter) 
    
input parameters:
     pcFileName - The name of the .df file to be loaded into DICTDB
     pcOptions  - Optional comma separated list of one or some of the following 
                  options: 
                  - AddObjectsOnline  - load new tables and sequences on-line 
                  - ForceCommit  - commit even with errors
                  - ForceIndexDeactivate - create new indexes inactive
                  - ForceSharedSchema - ignore Multi-tenant properties
                  
output Parameters:    
     pcWarnings - displayable warnings.
     
     Error will be thrown. 
     
    Notes:   
----------------------------------------------------------------------------*/
 
 routine-level on error undo , throw.
 
/*==========================  DEFINITIONS ===========================*/

define input parameter pcFileName as character no-undo.
define input parameter pcOptions as character no-undo.
define output parameter pcWarnings as character no-undo.

define variable dictOptions as prodict.dump._load_options no-undo.
 
dictOptions = new prodict.dump._load_options(new prodict.dump._load_logger()).
dictOptions:FileName = pcFileName.

/* If user wants to load new tables and sequences on-line 
   pass "AddObjectsOnline" in options */
if lookup("AddObjectsOnline",pcOptions) > 0 then
    dictOptions:AddObjectsOnline = true.
if lookup("ForceCommit",pcOptions) > 0 then
    dictOptions:ForceCommit = true.
if lookup("ForceIndexDeactivate",pcOptions) > 0 then
    dictOptions:ForceIndexDeactivate = true.
if lookup("ForceSharedSchema",pcOptions) > 0 then
    dictOptions:ForceSharedSchema = true.
 
run prodict/dump/_load_df.p(dictOptions). 

pcWarnings = dictOptions:Logger:RemoveWarningMessages().
 
if valid-object(dictOptions:Logger:Error) then
    undo, throw dictOptions:Logger:Error.

finally:
    delete object dictOptions.
end. ÿprodict/dump/_dmp5cvt.p6*ÿ+±[ŸöØ[ŸöRÿprodict/dump/_dmp_raw.póŽ+Ûÿ[ŸöØ[ŸöRÿprodict/dump/_dmpasci.pqp1áÿÙ[ŸöØ[ŸöRÿprodict/dump/_dmpbulk.pÌ¬JºÿW[ŸöØ[ŸöRÿprodict/dump/_dmpdata.pg^ÿƒ[ŸöØ[ŸöRÿprodict/dump/_dmpdefs.püá-ÿ§T[ŸöØ[ŸöRÿprodict/dump/_dmpdiff.pÇ£ˆÿ[ŸöØ[ŸöRþÿprodict/dump/_dmpincr.pL´§ ÿõ·[ŸöØ[ŸöRÿprodict/dump/_dmpisub.pÅªWÿ,[[ŸöØ[ŸöRÿprodict/dump/_dmpsddl.p›.É²ÿUÖ[ŸöØ[ŸöRÿprodict/dump/_dmpseqs.pZˆÿ[ŸöØ[ŸöRÿprodict/dump/_dmpsylk.p­ß-›ÿ¸[ŸöØ[ŸöRÿprodict/dump/_dmpuser.pÞÜ@Sÿ†[ŸöØ[ŸöRÿprodict/dump/_dmputil.pñoGÙÿS—[ŸöØ[ŸöRþÿprodict/dump/_dmpv5df.pÿ³›pÿ	[ŸöØ[ŸöRÿprodict/dump/_dmpview.p`S¤‰ÿq[ŸöØ[ŸöRÿprodict/dump/_lod_dbs.pà«úÿ4[ŸöØ[ŸöRÿprodict/dump/_lod_fil.p4àÿ:Ó[ŸöØ[ŸöRÿprodict/dump/_lod_fld.pýçÓÿV¤[ŸöØ[ŸöRÿprodict/dump/_lod_idx.pqwÿ%[ŸöØ[ŸöRÿprodict/dump/_lod_raw.i×–“ÿ©[ŸöØ[ŸöRþÿprodict/dump/_lod_seq.p`¢<ÿ9[ŸöØ[ŸöRÿprodict/dump/_lodasci.pÚX¶uÿÄ[ŸöØ[ŸöRÿprodict/dump/_loddata.p…=Ã9ÿ±[ŸöØ[ŸöRÿprodict/dump/_loddbff.pQWtKÿ[ŸöØ[ŸöRÿprodict/dump/_loddiff.pô·hÿ*«[ŸöØ[ŸöRÿprodict/dump/_lodfini.p0Ã¬ÿ}[ŸöØ[ŸöRÿprodict/dump/_lodname.p‡~³ÿ£[ŸöØ[ŸöRþÿprodict/dump/_lodsdbf.p¶O»3ÿ±[ŸöØ[ŸöRÿprodict/dump/_lodsddl.p§ÍäÿÔ[ŸöØ[ŸöRÿprodict/dump/_lodseqs.pxèÛ¸ÿ­[ŸöØ[ŸöRÿprodict/dump/_lodsylk.p’÷ñeÿÙ[ŸöØ[ŸöSÿprodict/dump/_loduser.pé	>ÿ+[ŸöØ[ŸöSÿprodict/dump/_lodv5df.pËi	iÿ0Ž[ŸöØ[ŸöSÿprodict/dump/_lodview.pO3	I÷ÿ!'[ŸöØ[ŸöSþÿprodict/dump/copy_dbs.i¾x	kÿk[ŸöØ[ŸöSÿprodict/dump/copy_fil.i¡©	s‰ÿ[ŸöØ[ŸöSÿprodict/dump/copy_fit.i˜¬	€§ÿ{[ŸöØ[ŸöSÿprodict/dump/copy_fld.iØ	ƒ"ÿš[ŸöØ[ŸöSÿprodict/dump/copy_flt.i7Í	¼ÿ×[ŸöØ[ŸöSÿprodict/dump/copy_idx.i¨	““ÿ	²[ŸöØ[ŸöSÿprodict/dump/copy_ixf.iŠ	Eÿ³[ŸöØ[ŸöSþÿprodict/dump/copy_seq.iX»	Ÿøÿ;[ŸöØ[ŸöSÿprodict/dump/dmptrail.iùÓ	¥3ÿ[ŸöØ[ŸöSÿprodict/dump/dtrigchk.iÂ	¬DÿÈ[ŸöØ[ŸöSÿprodict/dump/dumpname.i­,	±ÿî[ŸöØ[ŸöSÿprodict/dump/dumpvars.iŒÏ	¾úÿ
ü[ŸöØ[ŸöSÿprodict/dump/loaddefs.iPå	Éöÿœ[ŸöØ[ŸöSÿprodict/dump/loadkill.i{Ä	×’ÿ[ŸöØ[ŸöSþÿprodict/dump/lodtrail.i®_	Ýÿ"Á[ŸöØ[ŸöSÿprodict/dump/ltrigchk.iû	ÿÒÿ][ŸöØ[ŸöSÿprodict/dump/_dmpaudp.pÚ
/ÿ[ŸöØ[ŸöSÿprodict/dump/_exptbln.pð
Kÿ	N[ŸöØ[ŸöSÿprodict/dump/_exptblnap.p¯/
'™ÿ[ŸöØ[ŸöSÿprodict/dump/_impbln.p
0&ÿf[ŸöØ[ŸöSÿprodict/dump/_impblnap.pŒ˜
>Œÿ	a[ŸöØ[ŸöSþÿprodict/dump/_lodaudp.pP
GíÿÏ[ŸöØ[ŸöSÿprodict/dump/dmpsectr.i
e¼ÿÜ[ŸöØ[ŸöSÿprodict/dump/loadvars.i,H
k˜ÿó[ŸöØ[ŸöSÿprodict/dump/lodsectr.iX·
o‹ÿú[ŸöØ[ŸöSÿprodict/dump/_load_df.p³.
ƒ…ÿE![ŸöØ[ŸöSÿprodict/dump/_load_logger.clsQs
È¦ÿ`[ŸöØ[ŸöSþÿprodict/dump/_load_options.cls}€
Ìÿ'[ŸöØ[ŸöSÿprodict/dump/_lod_con.pM`
Ð-ÿì[ŸöØ[ŸöSÿprodict/dump/testdump.pÁà
äÿ0[ŸöØ[ŸöSÿprodict/dump/_dmpsec.pB•
æIÿœp[ŸöØ[Ÿö\ÿprodict/dump/_lodsec.prµ‚¹ÿ†[ŸöØ[Ÿö\ÿprodict/gate/_gat_atg.pópÒÿÈ[ŸöØ[ŸöSÿprodict/gate/_gat_cmp.pšÿ¥@[ŸöØ[ŸöSþÿprodict/gate/_gat_con.pù\³Úÿ	o[ŸöØ[ŸöSÿprodict/gate/_gat_cp.pŸÓ½Iÿy[ŸöØ[ŸöSÿprodict/gate/_gat_cp1.p_®ÜÂÿ[ŸöØ[ŸöSÿprodict/gate/_gat_cro.plçÕÿ9\[ŸöØ[ŸöSÿprodict/gate/_gat_drv.p¨Þ!1ÿ·[ŸöØ[ŸöSÿprodict/gate/_gat_fnm.p˜+0èÿý[ŸöØ[ŸöSÿprodict/gate/_gat_ini.p‚Nåÿ!¨[ŸöØ[ŸöSþÿprodict/gate/_gat_md9.iƒ'pÿâ[ŸöØ[ŸöSÿprodict/gate/_gat_nam.pÒ”oÿA[ŸöØ[ŸöSÿprodict/gate/_gat_prt.p58†°ÿ	·[ŸöØ[ŸöSÿprodict/gate/_gat_row.pµgÿt[ŸöØ[ŸöSÿprodict/gate/_gat_trg.pša~ÿ÷[ŸöØ[ŸöSÿprodict/gate/_gat_xlt.p^©uÿ[ŸöØ[ŸöSÿprodict/gate/_gatxnum.pÿõuÿ¼[ŸöØ[ŸöSþÿprodict/gate/_snd_sql.i_$1ÿoë[ŸöØ[ŸöSÿprodict/gate/_snd_sql.pƒ-”ÿ¹[ŸöØ[ŸöSÿprodict/gate/beauty.ièNŸÕÿ[ŸöØ[ŸöSÿprodict/gate/beauty1.pâ¹eÿç[ŸöØ[ŸöSÿprodict/gate/cmp_fld.isÜ¿Lÿ+§[ŸöØ[ŸöSÿprodict/gate/cmp_idf.iêóÿ
[ŸöØ[ŸöSÿprodict/gate/cmp_idx.iI©õÿß[ŸöØ[ŸöSþÿprodict/gate/cmp_msg.i0ðêÿ	i[ŸöØ[ŸöSÿprodict/gate/cmp_nav.ibSÿq[ŸöØ[ŸöSÿprodict/gate/cmp_sum.iÌ‰Äÿã[ŸöØ[ŸöSÿprodict/gate/cmp_tbl.iN1§ÿ5[ŸöØ[ŸöSÿprodict/gate/gat-trgm.i$uKÜÿ[ŸöØ[ŸöSÿprodict/gate/gat-trig.ie®Qkÿ.C[ŸöØ[ŸöSÿprodict/gate/gat_cp1a.i9†®ÿ<[ŸöØ[ŸöSþÿprodict/gate/gat_cpvl.i¸†êÿ[ŸöØ[ŸöSÿprodict/gate/gat_get.i–iÿ-[ŸöØ[ŸöSÿprodict/gate/gat_getd.i'ÑÃƒÿ][ŸöØ[ŸöSÿprodict/gate/gat_mdi1.i©Ñàÿ	[ŸöØ[ŸöSÿprodict/gate/gat_mdi2.iÛeÜéÿ[ŸöØ[ŸöSÿprodict/gate/gat_mdi3.ildïÿÿ[[ŸöØ[ŸöSÿprodict/gate/gat_pul.ißöZÿÛ«[ŸöØ[ŸöTþÿprodict/gate/gat_pul2.i°±Ýÿ.)[ŸöØ[ŸöTÿprodict/gate/gat_pulf.iH¯.ÿd[ŸöØ[ŸöTÿprodict/gate/gat_puli.iæY!’ÿ
Ç[ŸöØ[ŸöTÿprodict/gate/gatework.iŽó,YÿG[ŸöØ[ŸöTÿprodict/gate/nogatwrk.iB.s`ÿn[ŸöØ[ŸöTÿprodict/gate/odb_ctl.i-¨{Îÿ~4[ŸöØ[ŸöTÿprodict/gate/presel.i.}úÿ9[ŸöØ[ŸöTþÿprodict/gate/sndsqui.iß£;ÿ[ŸöØ[ŸöTÿprodict/gate/ttygget.iE=ÿ1¾[ŸöØ[ŸöTÿprodict/gui/_closqlw.pÁ‚Iûÿ¢[ŸöØ[ŸöTÿprodict/gui/_guiauto.pÐÃOÿA![ŸöØ[ŸöTÿprodict/gui/_guifixd.pé+¾ÿ+4[ŸöØ[ŸöTÿprodict/gui/_guigge1.p˜D»òÿ[ŸöØ[ŸöTÿprodict/gui/_guigget.p~Ãÿ[ŸöØ[ŸöTþÿprodict/gui/_guipfed.p05Êÿ-Ý[ŸöØ[ŸöTÿprodict/gui/_guipick.pî	÷íÿDŸ[ŸöØ[ŸöTÿprodict/gui/_guisecu.põ<ŒÿT¯[ŸöØ[ŸöTÿprodict/gui/_guisget.p“ž‘;ÿ9p[ŸöØ[ŸöTÿprodict/gui/_guisqlw.pCÊ«ÿ+”[ŸöØ[ŸöTÿprodict/gui/_guitget.pŽ]ö?ÿmß[ŸöØ[ŸöTÿprodict/gui/_guiuchg.p—dÿXt[ŸöØ[ŸöTþÿprodict/gui/_guivget.pmš¼’ÿ@[ŸöØ[ŸöTÿprodict/gui/_savwidt.pŽïÒÒÿ	©[ŸöØ[ŸöTÿprodict/gui/guigget.izÜ{ÿs-[ŸöØ[ŸöTÿprodict/gui/widthvar.iñÂO¨ÿ![ŸöØ[ŸöTÿprodict/gui/widttrig.i3á^Éÿ¹[ŸöØ[ŸöTÿprodict/misc/_clproto.pup‚ÿ[ŸöØ[ŸöTÿprodict/misc/_del-db.p©àvÿM[ŸöØ[ŸöTþÿprodict/misc/_filebtn.peÚ|\ÿ
þ[ŸöØ[ŸöTÿprodict/misc/_getconp.p*‡Zÿ ¡[ŸöØ[ŸöTÿprodict/misc/_prt_rpt.phŸ§ûÿ&[ŸöØ[ŸöTÿprodict/misc/_resxlat.pqÎÿ-ì[ŸöØ[ŸöTÿprodict/misc/_rptaqik.p ]üÿ.[ŸöØ[ŸöTÿprodict/misc/_rptflds.pƒ ÿ/ÿ6[ŸöØ[ŸöTÿprodict/misc/_rptfqik.pŒNeÿ6[ŸöØ[ŸöTþÿprodict/misc/_rptiqik.põJ
›ÿp[ŸöØ[ŸöTÿprodict/misc/_rptrels.pñâÿ—[ŸöØ[ŸöTÿprodict/misc/_rptsqik.p”Ã¢ÿ©[ŸöØ[ŸöTÿprodict/misc/_rpttqik.p\‹Kÿ¦[ŸöØ[ŸöTÿprodict/misc/_rpttrig.p+Eñÿ‰[ŸöØ[ŸöTÿprodict/misc/_rptuqik.p>]zÿ£[ŸöØ[ŸöTÿprodict/misc/_rptvqik.p	f"ÿå[ŸöØ[ŸöTþÿprodict/misc/_rptwdat.p©b&ÿ,µ[ŸöØ[ŸöTÿprodict/misc/_rptwdth.pUCR·ÿ…[ŸöØ[ŸöTÿprodict/misc/_rundift.i¢ÐV<ÿI[ŸöØ[ŸöTÿprodict/misc/_rundump.iý}X…ÿ[ŸöØ[ŸöTÿprodict/misc/_runload.iÎšd”ÿ)z[ŸöØ[ŸöTÿprodict/misc/_runsylk.iÇcŽÿ[ŸöØ[ŸöTÿprodict/misc/_tstsh.p «ÿT[ŸöØ[ŸöTþÿprodict/misc/_wrkcgen.p§­ãÿÛ[ŸöØ[ŸöTÿprodict/misc/_wrkfgen.p}$¹¾ÿÌ[ŸöØ[ŸöTÿprodict/misc/_wrkfnum.pµÎÎŠÿ
Æ[ŸöØ[ŸöTÿprodict/misc/_wrktgen.p0ÙPÿ8~[ŸöØ[ŸöTÿprodict/misc/_wrkvgen.plhÎÿ)[ŸöØ[ŸöTÿprodict/misc/_wrkwgen.pxr#÷ÿ([ŸöØ[ŸöTÿprodict/misc/filesbtn.i¤8ÿ´[ŸöØ[ŸöTþÿprodict/misc/osappend.pÇ-;Óÿ-[ŸöØ[ŸöTÿprodict/misc/osdbfutl.p‹¹?ÿ>[ŸöØ[ŸöTÿprodict/misc/osprefix.pöJ>ÿÕ[ŸöØ[ŸöTÿprodict/misc/osquoter.pÕ-Oÿ¬[ŸöØ[ŸöTÿprodict/misc/ostodir.pÁ6[¿ÿ»[ŸöØ[ŸöTÿprodict/misc/_dirbtn.pÈï_zÿ[ŸöØ[ŸöTÿprodict/misc/_db-chgid.p¶feŠÿ@,[ŸöØ[ŸöTþÿprodict/misc/_db-id-hst.p)¥¶ÿaì[ŸöØ[ŸöTÿprodict/misc/_db-id-mnt.pé¢ÿfÍ[ŸöØ[ŸöUÿprodict/misc/_db-optn.pZ­noÿE[ŸöØ[ŸöUÿprodict/misc/_rptaud.pß³üÿÞ[ŸöØ[ŸöUÿprodict/misc/misc-funcs.i7ÀÀÚÿ*[ŸöØ[ŸöUÿprodict/misc/_db-lkey.p
^Õÿ [ŸöØ[ŸöUÿprodict/misc/_rptaltbuf.p=…æ¤ÿÌ[ŸöØ[ŸöUÿprodict/misc/_rptencp.p¿ëpÿŠ[ŸöØ[ŸöUÿprodict/misc/_browse.cls¾pñúÿ|[ŸöØ[ŸöUÿprodict/misc/_eventhandler.pU	vÿ¸[ŸöØ[ŸöUÿ prodict/misc/_iwidgethandler.clsG±.ÿ»[ŸöØ[ŸöUÿprodict/misc/_query.clsn=éÿkP[ŸöØ[ŸöUÿprodict/misc/_valsch.pœõ}9ÿî[ŸöØ[ŸöUþÿprodict/mss/_beauty.pœ'ÿã[ŸöØ[ŸöUÿprodict/mss/_mss_crp.pÊî‘
ÿã7[ŸöØ[ŸöUÿprodict/mss/_mss_fix.pÕ tAÿ[ŸöØ[ŸöUÿprodict/mss/_mss_get.p˜¿Ñÿbq[ŸöØ[ŸöUÿprodict/mss/_mss_md0.p)ŠgBÿÞ[ŸöØ[ŸöUÿprodict/mss/_mss_md1.pl˜m ÿÞ[ŸöØ[ŸöUÿprodict/mss/_mss_md2.p«Ü‰þÿÁ[ŸöØ[ŸöUþÿprodict/mss/_mss_md5.pI*‘¿ÿE[ŸöØ[ŸöUÿprodict/mss/_mss_md9.pƒi—ÿ÷[ŸöØ[ŸöUÿprodict/mss/_mss_pul.pr<˜ûÿ6[ŸöØ[ŸöUÿprodict/mss/_mss_sdb.pôô°1ÿT[ŸöØ[ŸöUÿprodict/mss/_mss_sys.p"Â…ÿé[ŸöØ[ŸöUÿprodict/mss/_mss_typ.pKü×nÿB[ŸöØ[ŸöUÿprodict/mss/_mssschg.pL ~ÿ5õ[ŸöØ[ŸöUþÿprodict/mss/_snd_sql.p- Osÿ[ŸöØ[ŸöUÿprodict/mss/_sndinfo.p:ò S‹ÿ¦[ŸöØ[ŸöUÿprodict/mss/mss_fix.p¡9 `1ÿ±[ŸöØ[ŸöUÿprodict/mss/mss_pul.iež eâÿ7^[ŸöØ[ŸöUÿprodict/mss/mss_pulp.iå× @ÿë[ŸöØ[ŸöUÿprodict/mss/mss_qe.pŠ ½+ÿÝ[ŸöØ[ŸöUÿprodict/mss/mss_sys.i—Ó Áÿ„[ŸöØ[ŸöUþÿprodict/mss/mss_typ.iÞð ÆŒÿ[ŸöØ[ŸöUÿprodict/mss/mssvar.iÍd Î—ÿø[ŸöØ[ŸöUÿprodict/mss/protoms1.p
ª áÿOy[ŸöØ[ŸöUÿprodict/mss/protomss.på‹!1ÿS[ŸöØ[ŸöUÿprodict/mss/_gendsql.p)!„!ÿ@2[ŸöØ[ŸöVÿprodict/mss/_mss_inc.pêË%ÄSÿE¿[ŸöØ[ŸöVÿprodict/mss/procbfrpul.py&
ÿ³[ŸöØ[ŸöVþÿprodict/mss/protomss1.pËX&Åÿ;…[ŸöØ[ŸöVÿprodict/mss/_mss_gid.pöD&ZJÿM[ŸöØ[ŸöVÿprodict/mss/genrowid.in&\—ÿ§[ŸöØ[ŸöVÿprodict/mss/genrowid.pv&&s>ÿ:[ŸöØ[ŸöVÿprodict/mss/key/_msc_act.p›ÿ&Žxÿº[ŸöØ[ŸöVÿprodict/mss/key/_msc_del.p“À&©2ÿ][ŸöØ[ŸöVÿprodict/mss/key/_msc_viw.pá"&Åÿ#d[ŸöØ[ŸöVþÿprodict/mss/key/check.ióß&èóÿ$H[ŸöØ[ŸöVÿprodict/mss/key/clust.iÕ–';ÿ)[ŸöØ[ŸöVÿprodict/mss/key/constraint.iTf'6¼ÿ&v[ŸöØ[ŸöVÿprodict/mss/key/constraint.pýc']2ÿ‹[ŸöØ[ŸöVÿprodict/mss/key/default.iÙj'q½ÿ%«[ŸöØ[ŸöVÿprodict/mss/key/del_con.pòd'—hÿ
Š[ŸöØ[ŸöVþÿprodict/mss/key/fillin.i+'¡òÿ][ŸöØ[ŸöVÿprodict/mss/key/foreign.iÆe'®OÿGÏ[ŸöØ[ŸöVÿprodict/mss/key/modcheck.i§'öÿ?[ŸöØ[ŸöVÿprodict/mss/key/modclus.i²=(]ÿ#p[ŸöØ[ŸöVÿprodict/mss/key/modcons.iÆÍ(7Íÿ,[ŸöØ[ŸöVÿprodict/mss/key/modcons.p™(cÓÿ[ŸöØ[ŸöVþÿprodict/mss/key/moddef.iô±(pÓÿØ[ŸöØ[ŸöVÿprodict/mss/key/modforg.iJ(Ž«ÿG*[ŸöØ[ŸöVÿprodict/mss/key/modpri.i%p(ÕÕÿ"^[ŸöØ[ŸöVÿprodict/mss/key/moduni.iï'(ø3ÿ=[ŸöØ[ŸöVÿprodict/mss/key/primary.iZ)pÿ-4[ŸöØ[ŸöVÿprodict/mss/key/unique.ifô)>¤ÿ"…[ŸöØ[ŸöVþÿprodict/mss/key/viewmnt.i«M)a)ÿý[ŸöØ[ŸöVÿprodict/mss/schpullmss.pò)e&ÿC‚[ŸöØ[ŸöVÿprodict/mss/schmsstopro.p¤s)¨¨ÿÓ[ŸöØ[ŸöVÿprodict/mss/schconnect.p_K)Á{ÿ*#[ŸöØ[ŸöVÿprodict/mss/deltasql.p÷2)ëžÿR[ŸöØ[ŸöVÿprodict/mss/deltaconnect.p€Ë*=¤ÿÆ[ŸöØ[ŸöVÿprodict/mss/_clrank.pË¸*SjÿN[ŸöØ[ŸöVþÿprodict/mss/_cnrank.pü*o¸ÿAœ[ŸöØ[ŸöWÿprodict/mss/_ctestr.p
†*±Tÿ/e[ŸöØ[ŸöWÿprodict/mss/_rankpdb.p§×*à¹ÿQ0[ŸöØ[ŸöWÿprodict/odb/_beauty.pö½+1éÿ,[ŸöØ[ŸöWÿprodict/odb/_odb_crp.pÀ4+6ÿ¼©[ŸöØ[ŸöWÿprodict/odb/_odb_fix.pË+ò¾ÿnË[ŸöØ[ŸöWÿprodict/odb/_odb_fld.p¶·,a‰ÿZ’[ŸöØ[ŸöWþÿprodict/odb/_odb_get.pô•,¼ÿ“[ŸöØ[ŸöWÿprodict/odb/_odb_md0.pé-OÿÞ[ŸöØ[ŸöWÿprodict/odb/_odb_md1.pU-Tùÿú[ŸöØ[ŸöWÿprodict/odb/_odb_md2.p3Ô-oóÿû[ŸöØ[ŸöWÿprodict/odb/_odb_md3.pG.-vîÿi[ŸöØ[ŸöWÿprodict/odb/_odb_md5.pv-„WÿE[ŸöØ[ŸöWÿprodict/odb/_odb_md9.pìü-‰œÿC[ŸöØ[ŸöWþÿprodict/odb/_odb_pul.p7-‹ßÿö¯[ŸöØ[ŸöWÿprodict/odb/_odb_sdb.pjÇ.‚ŽÿË[ŸöØ[ŸöWÿprodict/odb/_odb_sys.pFÃ.“Yÿc[ŸöØ[ŸöWÿprodict/odb/_odb_typ.pàí.«¼ÿ'R[ŸöØ[ŸöWÿprodict/odb/_odbxnum.pèa.Óÿ¥[ŸöØ[ŸöWÿprodict/odb/_snd_sql.pH.Ö³ÿ
´[ŸöØ[ŸöWÿprodict/odb/_sndinfo.pÉ}.ágÿ_[ŸöØ[ŸöWþÿprodict/odb/odb_fix.pé­.îÆÿ²[ŸöØ[ŸöWÿprodict/odb/odb_fprp.pÊ.ôxÿI[ŸöØ[ŸöWÿprodict/odb/odb_pul.iç.úÁÿ4Q[ŸöØ[ŸöWÿprodict/odb/odb_pulp.iŒV//ÿÿ[ŸöØ[ŸöWÿprodict/odb/odb_qe.pÐ//>ÿÞ[ŸöØ[ŸöWÿprodict/odb/odb_sys.iJ/AïÿÅ[ŸöØ[ŸöWÿprodict/odb/odb_typ.i~6/G´ÿ{[ŸöØ[ŸöWþÿprodict/odb/odbvar.i6Ì/N/ÿq[ŸöØ[ŸöWÿprodict/odb/protood1.pµg/[ ÿHË[ŸöØ[ŸöWÿprodict/odb/protoodb.pŽë/¤kÿyÓ[ŸöØ[ŸöWÿprodict/odb/_bpullodb.p 0>ÿÇ[ŸöØ[ŸöWÿprodict/ora/_beauty.pÛŠ0,ÿ[ŸöØ[ŸöWÿprodict/ora/_gendsql.pµÞ00ÿÃ[ŸöØ[ŸöWÿprodict/ora/_ora_als.pš×3óÿ[ŸöØ[ŸöWþÿprodict/ora/_ora_cra.p¥x3ù/ÿ"Ÿ[ŸöØ[ŸöWÿprodict/ora/_ora_crc.pž4Îÿ9[ŸöØ[ŸöWÿprodict/ora/_ora_crg.p²Š44ÿ*[ŸöØ[ŸöWÿprodict/ora/_ora_cri.p9ñ4C1ÿ	‚[ŸöØ[ŸöWÿprodict/ora/_ora_crk.p+«4L³ÿ	[ŸöØ[ŸöWÿprodict/ora/_ora_crl.p4t4Uºÿ[ŸöØ[ŸöWÿprodict/ora/_ora_crm.p{ÿ4nÕÿ	[ŸöØ[ŸöWþÿprodict/ora/_ora_cro.pÜ$4wòÿì[ŸöØ[ŸöWÿprodict/ora/_ora_crp.pùÿ4„Þÿs[ŸöØ[ŸöWÿprodict/ora/_ora_crs.p}²4QÿÙ[ŸöØ[ŸöWÿprodict/ora/_ora_crt.p°º4*ÿ¼[ŸöØ[ŸöWÿprodict/ora/_ora_cru.pÕ4ºæÿl[ŸöØ[ŸöWÿprodict/ora/_ora_fix.pº74ÂRÿ¨[ŸöØ[ŸöWÿprodict/ora/_ora_fld.pœ5jXÿ+°[ŸöØ[ŸöWþÿprodict/ora/_ora_inc.pD5–ÿ5Ð[ŸöØ[ŸöWÿprodict/ora/_ora_lk0.pì35ËØÿà[ŸöØ[ŸöWÿprodict/ora/_ora_lkc.p[i5Ø¸ÿ	c[ŸöØ[ŸöWÿprodict/ora/_ora_lkg.p•$5âÿdû[ŸöØ[ŸöWÿprodict/ora/_ora_lkl.p 6Gÿ9Ö[ŸöØ[ŸöWÿprodict/ora/_ora_lks.p·06€ìÿÖ[ŸöØ[ŸöWÿprodict/ora/_ora_lkx.p*}6ŽÂÿ–[ŸöØ[ŸöWþÿprodict/ora/_ora_lkz.py¦6—XÿÅ[ŸöØ[ŸöWÿprodict/ora/_ora_md0.p÷v6®ÿK[ŸöØ[ŸöWÿprodict/ora/_ora_md1.pOé6¹hÿ!¢[ŸöØ[ŸöWÿprodict/ora/_ora_md2.p{ 6Û
ÿž[ŸöØ[ŸöWÿprodict/ora/_ora_md3.poÊ6à¨ÿ
U[ŸöØ[ŸöWÿprodict/ora/_ora_md5.p\=6êýÿÎ[ŸöØ[ŸöWÿprodict/ora/_ora_md9.p„K6îËÿf[ŸöØ[ŸöXþÿprodict/ora/_ora_prc.pÆ	6ö1ÿKÔ[ŸöØ[ŸöXÿprodict/ora/_ora_pul.pöl7BÿÇ[ŸöØ[ŸöXÿprodict/ora/_ora_sys.p4×7SÌÿ$[ŸöØ[ŸöXÿprodict/ora/_ora_typ.p<+7wßÿ([ŸöØ[ŸöXÿprodict/ora/_ora_vts.pBn7Ÿñÿ½[ŸöØ[ŸöXÿprodict/ora/_oraload.pVß7«®ÿ_“[ŸöØ[ŸöXÿprodict/ora/_runload.iË¸8Aÿs[ŸöØ[ŸöXþÿprodict/ora/_snd_sql.pÏ¼8&´ÿ
´[ŸöØ[ŸöXÿprodict/ora/ora_ctl.i‹D81hÿ[ŸöØ[ŸöXÿprodict/ora/ora_get.iþ«8?ÿ$[ŸöØ[ŸöXÿprodict/ora/ora_lkdf.i¼8c ÿ	P[ŸöØ[ŸöXÿprodict/ora/ora_mak.ipÐ8lðÿ‡[ŸöØ[ŸöXÿprodict/ora/ora_mak1.i ý8{wÿ$[ŸöØ[ŸöXÿprodict/ora/ora_sys.iÊ28Ÿ’ÿœ[ŸöØ[ŸöXþÿprodict/ora/ora_typ.i;8¤.ÿÕ[ŸöØ[ŸöXÿprodict/ora/oravar.i.Ú8°ÿ^[ŸöØ[ŸöXÿprodict/ora/protoor1.p”?8¾aÿ9Ô[ŸöØ[ŸöXÿprodict/ora/protoora.p”—8ø5ÿZ[ŸöØ[ŸöXÿprodict/ora/_bpullora.pÿ½9R<ÿä[ŸöØ[ŸöXÿprodict/ora/_get_oraver.p¬:9_ ÿË[ŸöØ[ŸöXÿprodict/ora/_get_orauser.p‰9bëÿ¥[ŸöØ[ŸöXþÿprodict/ora/_ora_crn.p¨E9eÿî[ŸöØ[ŸöXÿprodict/ora/_ora_nlsvld.pÙØ9~ÿ[ŸöØ[ŸöXÿprodict/ora/_protoora.pl@9„ÿ)ë[ŸöØ[ŸöXÿprodict/ora/key/_orc_act.p À9­øÿ*[ŸöØ[ŸöXÿprodict/ora/key/_orc_del.p¶[9Æ"ÿ[ŸöØ[ŸöXÿprodict/ora/key/_orc_viw.p]†9à4ÿ&[ŸöØ[ŸöXþÿprodict/ora/key/check.iê:µÿ#R[ŸöØ[ŸöXÿprodict/ora/key/constraint.i{:*ÿ"ù[ŸöØ[ŸöXÿprodict/ora/key/constraint.p½w:Mÿ˜[ŸöØ[ŸöXÿprodict/ora/key/foreign.iEF:]˜ÿEØ[ŸöØ[ŸöXÿprodict/ora/key/modcheck.i:Þ:£pÿª[ŸöØ[ŸöXÿprodict/ora/key/modcons.iô×:Áÿ'5[ŸöØ[ŸöXþÿprodict/ora/key/modcons.p‚4:èOÿ
™[ŸöØ[ŸöXÿprodict/ora/key/modforg.i~:òèÿBÁ[ŸöØ[ŸöXÿprodict/ora/key/modpri.i0ÿ;5©ÿ1[ŸöØ[ŸöXÿprodict/ora/key/moduni.iœ³;PÚÿ½[ŸöØ[ŸöXÿprodict/ora/key/primary.iJa;i—ÿ#P[ŸöØ[ŸöXÿprodict/ora/key/unique.ižV;Œçÿ!1[ŸöØ[ŸöXþÿprodict/ora/key/viewmnt.i+%;®ÿý[ŸöØ[ŸöXÿprodict/pro/_pro_fld.p2;²ÿµº[ŸöØ[ŸöXÿprodict/pro/_pro_sql.pdÖ<gÏÿU[ŸöØ[ŸöXÿprodict/pro/_pro_sys.pàÕ<|$ÿ8[ŸöØ[ŸöXÿprodict/pro/_pro_typ.p<’\ÿD[ŸöØ[ŸöXÿprodict/pro/fldfuncs.i˜Œ<• ÿK[ŸöØ[ŸöXÿprodict/pro/_pro_int64.p8 <¤ëÿ˜[ŸöØ[ŸöXþÿprodict/pro/_alt-buf-driver.p”µ<°ƒÿŠ[ŸöØ[ŸöXÿprodict/pro/_alt-buf-edit.pÅú<¾ÿŽt[ŸöØ[ŸöXÿprodict/pro/_alt-buf-sel.pÆÂ=Lÿ_Î[ŸöØ[ŸöYÿ prodict/pro/_obj-attrib-util.clsŽË=¬OÿÕ[ŸöØ[ŸöYÿprodict/pro/_domain-model.cls">:$ÿ¤[ŸöØ[ŸöYÿ"prodict/pro/_domain-sel-browse.clsìk>=Èÿ		[ŸöØ[ŸöYþÿ$prodict/pro/_domain-sel-nonmt-browse¡ç>FÑÿ[ŸöØ[ŸöYÿ(prodict/pro/_domain-sel-nonmt-browse.clsò>FÑÿœ[ŸöØ[ŸöYÿ%prodict/pro/_domain-sel-presenter.clsI¿>Omÿ“[ŸöØ[ŸöYÿprodict/pro/_imodel.cls«ë>WÿÃ[ŸöØ[ŸöYÿprodict/pro/_ipresenter.clsðM>[Ãÿ0[ŸöØ[ŸöYÿprodict/pro/_iview.cls÷B>bóÿÚ[ŸöØ[ŸöYþÿprodict/pro/_pro-model.clsn>gÍÿ[ŸöØ[ŸöYÿprodict/pro/_pro-presenter.clsz:>{Þÿk[ŸöØ[ŸöYÿ#prodict/pro/_pro-sel-dialog-gui.cls€>Iÿî[ŸöØ[ŸöYÿ#prodict/pro/_pro-sel-dialog-tty.clsµ_>œ7ÿÓ[ŸöØ[ŸöYÿprodict/pro/_pro-sel-dialog.clsÒË>©
ÿ²[ŸöØ[ŸöYÿprodict/pro/_pro_area_list.pìR>¹¼ÿ][ŸöØ[ŸöYþÿprodict/pro/_pro_domain_list.pÚ’>ÉÿŠ[ŸöØ[ŸöYÿprodict/pro/_pro_mt_seq.p?Ú>Ð£ÿ)[ŸöØ[ŸöYÿprodict/pro/_pro_mt_tbl.pv>ÛÌÿ
Ì[ŸöØ[ŸöYÿprodict/pro/_tenant-model.cls²–>æ˜ÿ€[ŸöØ[ŸöYÿ"prodict/pro/_tenant-sel-browse.clsAD>ëÿë[ŸöØ[ŸöYÿ%prodict/pro/_tenant-sel-presenter.cls¤>ôÿð[ŸöØ[ŸöYþÿprodict/pro/arealabel.iÃn>úóÿ[ŸöØ[ŸöYÿprodict/pro/confirmmt.i7þ?	ƒÿ[ŸöØ[ŸöYÿprodict/user/_usershw.pw?ÿz[ŸöØ[ŸöYÿprodict/user/_usr_dif.p¥ý?/ÿ[ŸöØ[ŸöYÿprodict/user/_usr_gsl.pEà?EÿG2[ŸöØ[ŸöYÿprodict/user/_usradmn.pi]?ŒNÿ À[ŸöØ[ŸöYÿprodict/user/_usrauto.pk™?­ÿG±[ŸöØ[ŸöYþÿprodict/user/_usrblnk.p‘Ê?ô¿ÿ[ŸöØ[ŸöYÿprodict/user/_usrcgen.pí¹@>ÿ—[ŸöØ[ŸöYÿprodict/user/_usrcold.pVÇ@Õÿ [ŸöØ[ŸöYÿprodict/user/_usrdbox.pÅ/@%uÿß[ŸöØ[ŸöYÿprodict/user/_usrdump.p!@+Tÿp[ŸöØ[ŸöYÿprodict/user/_usrebox.p»»B@Äÿ,[ŸöØ[ŸöYÿprodict/user/_usrexpo.pQ\BDðÿcR[ŸöØ[ŸöYþÿprodict/user/_usrfchg.p¹‘B¨Bÿ~í[ŸöØ[ŸöYÿprodict/user/_usrfcpy.p8C'/ÿ/
[ŸöØ[ŸöYÿprodict/user/_usrfgen.p-½CV9ÿÖ[ŸöØ[ŸöYÿprodict/user/_usrfglo.pÁÆCvÿ&[ŸöØ[ŸöYÿprodict/user/_usrfixd.p2ìCœ'ÿ[ŸöØ[ŸöYÿprodict/user/_usrfnum.p~×C¯;ÿð[ŸöØ[ŸöYÿprodict/user/_usrftrg.p°¡C¿+ÿD[ŸöØ[ŸöYþÿprodict/user/_usrgget.pf>C×oÿ6[ŸöØ[ŸöYÿprodict/user/_usriact.pž-CÙ¥ÿ9[ŸöØ[ŸöYÿprodict/user/_usriadd.pÒCøÞÿJÆ[ŸöØ[ŸöYÿprodict/user/_usribro.p\žDC¤ÿº[ŸöØ[ŸöYÿprodict/user/_usrichg.p$&D\^ÿÉp[ŸöØ[ŸöYÿprodict/user/_usrimpo.pU×E%Îÿ…b[ŸöØ[ŸöYÿprodict/user/_usrincr.pÕE«0ÿA³[ŸöØ[ŸöZþÿprodict/user/_usrinf2.psÐEìãÿ&y[ŸöØ[ŸöZÿprodict/user/_usrinf3.p™MF\ÿ¹[ŸöØ[ŸöZÿprodict/user/_usrinfo.pbZFÿ
6[ŸöØ[ŸöZÿprodict/user/_usrkchg.pÙgF)KÿyÜ[ŸöØ[ŸöZÿprodict/user/_usrload.pÏ¢F£'ÿ¹Š[ŸöØ[ŸöZÿprodict/user/_usrlrec.pÇûH\±ÿ£[ŸöØ[ŸöZÿprodict/user/_usrpfed.pý+H|Tÿ<?[ŸöØ[ŸöZþÿprodict/user/_usrpick.pRáH¸“ÿF¡[ŸöØ[ŸöZÿprodict/user/_usrprdb.p9ŸHÿ4ÿ[ŸöØ[ŸöZÿprodict/user/_usrpwd2.p{DIµÿÝ[ŸöØ[ŸöZÿprodict/user/_usrquot.p/I
’ÿqÞ[ŸöØ[ŸöZÿprodict/user/_usrschg.p¹ÔI|pÿ>¹[ŸöØ[ŸöZÿprodict/user/_usrscon.p"”I»)ÿ,p[ŸöØ[ŸöZÿprodict/user/_usrsdbf.pòìIç™ÿG[ŸöØ[ŸöZþÿprodict/user/_usrsdel.p9J.¸ÿÍ[ŸöØ[ŸöZÿprodict/user/_usrsecu.p:ÈJ>…ÿ9O[ŸöØ[ŸöZÿprodict/user/_usrsget.pÓîJwÔÿ=[ŸöØ[ŸöZÿprodict/user/_usrtchg.p?†J´åÿV[ŸöØ[ŸöZÿprodict/user/_usrtdel.p¯nK
ñÿ [ŸöØ[ŸöZÿprodict/user/_usrtgen.p7EK+ÿ¶Õ[ŸöØ[ŸöZÿprodict/user/_usrtget.púüKáàÿT$[ŸöØ[ŸöZþÿprodict/user/_usrtrax.phÄL6ÿ=[ŸöØ[ŸöZÿprodict/user/_usrtrig.pŠÞLDAÿx[ŸöØ[ŸöZÿprodict/user/_usruchg.pËÀL\¹ÿ`[ŸöØ[ŸöZÿprodict/user/_usrupwd.pì­L¼Æÿ‡[ŸöØ[ŸöZÿprodict/user/_usrvgen.p–LÎMÿ.‹[ŸöØ[ŸöZÿprodict/user/_usrvget.pH¼LüØÿ¦[ŸöØ[ŸöZÿprodict/user/_usrwdth.pÄ¯M
~ÿZ\[ŸöØ[ŸöZþÿprodict/user/_usrwgen.pw)MdÚÿ~[ŸöØ[ŸöZÿprodict/user/user-d.i-ÁMvXÿ+i[ŸöØ[ŸöZÿprodict/user/user-f.iûÛM¡Áÿ.b[ŸöØ[ŸöZÿprodict/user/user-s.i,7MÐ#ÿ9[ŸöØ[ŸöZÿprodict/user/user-v.iOaM×\ÿ	)[ŸöØ[ŸöZÿprodict/user/userbtns.iìMà…ÿk[ŸöØ[ŸöZÿprodict/user/usercon.i÷Måðÿæ[ŸöØ[ŸöZþÿprodict/user/userctr.iãŒMéÖÿ7[ŸöØ[ŸöZÿprodict/user/userfchg.iÛMîÿ‰[ŸöØ[ŸöZÿprodict/user/userhdr.fÀMñ–ÿ[ŸöØ[ŸöZÿprodict/user/userhdr.ió8Möÿ[ŸöØ[Ÿö[ÿprodict/user/userhue.iâÃMø2ÿc[ŸöØ[Ÿö[ÿprodict/user/usermenu.iücMü•ÿf[ŸöØ[Ÿö[ÿprodict/user/userpaus.iÐ]Obœÿá[ŸöØ[Ÿö[þÿprodict/user/userpfed.idðOe}ÿÓ[ŸöØ[Ÿö[ÿprodict/user/userpik.is]OƒPÿ³[ŸöØ[Ÿö[ÿprodict/user/userquot.i/O“ÿC[ŸöØ[Ÿö[ÿprodict/user/usersecu.i‘ÄO›Fÿ•[ŸöØ[Ÿö[ÿprodict/user/usertrgw.iáO Ûÿw[ŸöØ[Ÿö[ÿprodict/user/usertrig.i
ÈO§Rÿý[ŸöØ[Ÿö[ÿprodict/user/uservar.iÜ$O°Oÿ`[ŸöØ[Ÿö[þÿprodict/user/usrdump1.i:O¾¯ÿ«[ŸöØ[Ÿö[ÿprodict/user/_usrtget-tt.pˆÂOÄZÿdF[ŸöØ[Ÿö[ÿprodict/_dctadmn.p˜P( ÿ][ŸöØ[Ÿö[ÿprodict/_dctalia.p™#P/ýÿ@[ŸöØ[Ÿö[ÿprodict/_dctcach.pÊÑP6=ÿ{[ŸöØ[Ÿö[ÿprodict/_dctexec.pØPL¸ÿ/[ŸöØ[Ÿö[ÿprodict/_dctexen.pÑ‚P{ÒÿŸ[ŸöØ[Ÿö[þÿprodict/_dctgues.p©úP•qÿ“[ŸöØ[Ÿö[ÿprodict/_dctlrec.p¼jPµÿ
ž[ŸöØ[Ÿö[ÿprodict/_dctname.pçïP¿¢ÿ¸[ŸöØ[Ÿö[ÿprodict/_dctquot.p_ÿPÃZÿÖ[ŸöØ[Ÿö[ÿprodict/_dctscnt.pJìPÉ0ÿ
[ŸöØ[Ÿö[ÿprodict/_dctsget.p–PÓ6ÿU[ŸöØ[Ÿö[ÿprodict/_dctsset.p‡›PÞ‹ÿþ[ŸöØ[Ÿö[þÿprodict/_dctsylk.pûŽPî‰ÿà[ŸöØ[Ÿö[ÿprodict/_dctyear.pË_Põiÿs[ŸöØ[Ÿö[ÿprodict/_dictc.pg†PøÜÿ-ÿ[ŸöØ[Ÿö[ÿprodict/admnhlp.ivöQ&Ûÿ7[ŸöØ[Ÿö[ÿprodict/dictgate.i‘ÕQ^hÿÝ[ŸöØ[Ÿö[ÿprodict/dictnext.im]QbEÿ{[ŸöØ[Ÿö[ÿprodict/dictsplt.iøãQiÀÿL[ŸöØ[Ÿö[þÿprodict/dictsrch.i”uQnÿ[ŸöØ[Ÿö[ÿprodict/dictvar.irQsÿR[ŸöØ[Ÿö[ÿprodict/dump_d.p¤üQƒiÿqÜ[ŸöØ[Ÿö[ÿprodict/dump_df.pÅQõEÿC[ŸöØ[Ÿö[ÿprodict/dump_fd.p]ÇR8Rÿ¡[ŸöØ[Ÿö[ÿprodict/dump_inc.põR=óÿjs[ŸöØ[Ÿö[ÿprodict/fhidden.iµsR¨fÿ[ŸöØ[Ÿö[þÿprodict/load_d.pRÝR¬ÿhš[ŸöØ[Ÿö[ÿprodict/load_df.p¶Sÿ	[ŸöØ[Ÿö[ÿprodict/load_seq.p$SÿÅ[ŸöØ[Ÿö[ÿprodict/send_sql.pÄÔS7ßÿÁ[ŸöØ[Ÿö[ÿprodict/_dictdb.péÀS@ ÿà[ŸöØ[Ÿö[ÿprodict/aud/_aud-pol.p0ÑSH€ÿ=|[ŸöØ[Ÿö[ÿprodict/aud/aud-tts.iB”S…üÿü[ŸöØ[Ÿö[þÿprodict/sec/_cascrvk.pÎNS‹øÿ*[ŸöØ[Ÿö[ÿprodict/sec/_sec-dom.ppÐS¶ÿÙQ[ŸöØ[Ÿö[ÿprodict/sec/_sec-perm.p”TgÿÒÜ[ŸöØ[Ÿö[ÿprodict/sec/_sec-sys.p‹MUbCÿ”[ŸöØ[Ÿö[ÿprodict/sec/sec-func.iÅUUö[ÿ_[ŸöØ[Ÿö[ÿprodict/sec/sec-trgs.ihVUxÿ5[ŸöØ[Ÿö[ÿprodict/sec/ui-procs.i³ˆVb­ÿƒ%[ŸöØ[Ÿö[þÿprodict/sec/_sec-gen-key.pÆxVåÒÿ/[ŸöØ[Ÿö[ÿprodict/sec/_sec-obj-sel.p¶ÓWÒÿˆ7[ŸöØ[Ÿö[ÿprodict/sec/_sec-pol-driver.pÎœW	ÿÝ[ŸöØ[Ÿö[ÿprodict/sec/_sec-pol-edit.pK+W®æÿµc[ŸöØ[Ÿö[ÿprodict/sec/_sec-pol-hist.p hXdIÿ3š[ŸöØ[Ÿö[ÿprodict/sec/_sec-pol-util.cls(÷X—ãÿ§M[ŸöØ[Ÿö\þÿprodict/sec/sec-pol.iÂ#Y?0ÿµ[ŸöØ[Ÿö\ÿprodict/upd_sch.p¾sYEåÿß[ŸöØ[Ÿö\ÿprodict/dmpseqvals.pn^YNÄÿ[ŸöØ[Ÿö\ÿprodict/load_df_silent.pÚŸYhaÿR[ŸöØ[Ÿö\ÿÈ:d'þ