*******************************************************************************
*
*	Description: Initialize a secondary key file
*
*	Module	%M%	Version	%I% 	Date	%H%
*
*	(c) Copyright 1998 Ardent Software Inc. - All Rights Reserved
*	This is unpublished proprietary source code of Ardent Software Inc.
*	The copyright notice above does not evidence any actual or intended
*	publication of such source code.
*
*******************************************************************************
*
*	Maintenence log - insert most recent change descriptions at top
*
*	Date.... GTAR# WHO Description.........................................
*	04/30/99 24742 GMH Create index file type same as data file
*	04/23/99 24742 GMH Add support for new headers
*	10/14/98 23801 SAP Change copyrights. 
*	09/26/97 14997 KAM Remove 'Var prev undefined' warning from 87902
*	07/18/97 17516 DJL Index name wrong for long file name
*	07/18/97 17383 DJL add check to make sure MV field of I or D is M or S
*	06/23/97 20380 DTM Added support for default COLLATE value, if not spec.
*	06/20/97 19819 KAM Add support for UNIX filenames with special chars
*	05/20/97 20380 DTM Added code for COLLATE keyword
*	01/23/97 19949 PEJ Fix binary value conversion when NLS is on
*	09/04/96 18639 DJL CREATE.INDEX doesnt use secondary group privileges.
*	06/27/96 18571 HSB Support single and double quotes in SQL index identifiers
*	05/30/96 18438 JC  Additional porting to NT.
*	04/08/96 18360 HSB Write SQL index info in proper hardware byte order.
*	04/03/96 18235 WSM Redo fix to keep rm errors out of COMO files
*	02/22/96 17804 GMM Replace 'SH -c' with OS.EXEC and handle remote paths
*	01/10/96 17832 HSB Add code to write SQL index map to type-25 file header
*	11/08/95 16356 WSM Keep rm errors out of COMO files
*	06/06/95 16638 EAP Change to use BYTE,BYTEVAL,BYTELEN for NLSsupport
*	05/05/95 15741 EAP undid last change NLS binary mapping now in WRITEBLK
*	03/30/95 15741 EAP Use BYTE() instead of CHAR() to encode lengths
*	03/28/95 15741 EAP Added -M NONE to set NLS map for mkdbfile 
*	02/23/95 16030 SHK Only check for "V" in first position of SH verb
*	11/14/94 13388 DPB Abort if the SH verb is not in the VOC file.
*	11/14/94 14082 DPB Allow different A correlative on the same field.
*	11/02/94 15025 DPB Fix printing of error message for type 1 & 25 files.
*	10/21/94 15136 GMH Correct writes/deletes for ISOMODE level 2
*	08/01/94 14545 EAP Don't allow CREATE.INDEX on files which are being logged
*	07/20/94 14296 WLG Carry over NO.NULLS for distributed files.
*	06/27/94 14313 GMH Correct spelling of call
*	02/24/94 12743 GMH Correct calls for remote machines, enhance msg handling
*	11/23/93 12614 GMH Correct DIRECTORY argument
*	11/23/93 12614 GMH Correct argument to REMOTE.B
*	10/28/93 12435 GMH Correct parsing
*	10/15/93 12393 GMH Correct message
*	09/30/93 12344 JSM Fix UNIXlnode for machine type
*	09/23/93 12326 GMH Allow super-user to override permission check
*	09/23/93 12323 GMH Correct I-type compilation
*	09/22/93 12324 JWT Fix incorrect write of datalen
*	09/22/93 12201 GMH Fix longnames
*	09/08/93 12201 GMH Remove pathname type30 fix, compile DF i-types
*	09/07/93 12201 GMH Set @SYSTEM.RETURN.CODE on exit
*	09/07/93 12201 GMH Fix path name for type30 data files in DF
*	09/03/93 12201 JWT Fix path name for type 30 data file open
*	09/03/93 12201 GMH Enable creation on DICT & PDICT files
*	09/01/93 12138 GMH Fix code problems
*	08/31/93 12138 GMH Implement in BASIC
*
*******************************************************************************
$OPTIONS DEFAULT
      ID = "%W%"
!
* Declare functions
!
DECLARE GCI NLSsetseqmap
DECLARE GCI BYTEreplace
DEFFUN UVREADMSG(num,args) CALLING '*UVREADMSG'
!
* Declare keyword values
!
INCLUDE UNIVERSE.INCLUDE FILENAMES.H
INCLUDE UNIVERSE.INCLUDE KEYWORD.H
INCLUDE UNIVERSE.INCLUDE MACHINE.NAME
INCLUDE UNIVERSE.INCLUDE FILEINFO.H
INCLUDE UNIVERSE.INCLUDE TLOG.H
INCLUDE UNIVERSE.INCLUDE OSDEF.H
INCLUDE	UNIVERSE.INCLUDE UVNLSLOC.H

!
* Define multipliers
!
  DIM POWER(5) 
  POWER(1) = 1  
  POWER(2) = 256
  POWER(3) = 65536
  POWER(4) = 16777216
!
* Define UNIX equates
!
  EQU UNIXlnode TO BYTE(0):BYTE(2)
!
* Define XINU equates
!
  EQU XINUlnode TO 512
!
* Declare general equates
!
  EQU T25LEAFoffset  TO 8192  ;* Offset to first leaf node
  EQU FALSE          TO 0
  EQU TRUE           TO 1
  EQU VOC.ENTRY      TO 1
  EQU UNIX.PATH      TO 2
  EQU MAXindices     TO 999   ;* Maximum number of indices
  EQU WANT.DICT      TO 100
  EQU WANT.PDICT     TO 200

!
* Declare variables
!
  PERMISSIONS   = '-PERMISSIONS';* Subroutine for determining file permissions
  Index.info    = ""         ;* Secondary Index information
  Index.file    = ""         ;* Secondary Index file descriptor
  DKEY          = 0          ;* DICT on command line
  FILE          = ''         ;* Name of FILE
  UDICT         = ''         ;* Dict file descriptor
  UDATA         = ''         ;* Data file descriptor
  ODICT         = ''         ;* Dict file desc for USING clause
  IDX.TO.ADD    = ''         ;* List of indices to add
  USING.CLAUSE  = FALSE      ;* USING clause
  USING.NAME    = ''         ;* File for USING clause
  USING.DICT    = 0          ;* DICT was found after USING clause
  AT.CLAUSE     = FALSE      ;* AT clause
  AT.PATH       = ''         ;* Path for AT clause
  NULLS.ALLOWED = TRUE       ;* Allow Empty Strings as default
  UNIQUE.INDEX  = FALSE      ;* Unique 
  NUMERIC.INDEX = FALSE      ;* Numeric
  SQLITYP.INDEX = FALSE      ;* SQL I-type 
  AKdirPATH     = ''         ;* Path of AK
  LONGNAMES.ON  = FALSE      ;* From FIELD 5 of CREATE.FILE
  IDXcnt        = 0          ;* Number of active indices
  process.status= 0          ;* return value for @system.return.code
  SYSTEM.name   = ''         ;* name of remote system
  COLLATE.NAME	= ''		 ;* Collation sequence not defined

  IF SYSTEM( 100 ) AND SYSTEM( 101 ) THEN
  *	Get current locale information
	COLLATE.NAME = GETLOCALE( UVLC$COLLATE )
  END
!
* Set up command and data matrix
!
  DIM COMMAND(125)           ;* Command line arguments
  DIM DICT.TEXT(1000)        ;* Contents of DICT items to add
  DIM INDEX.MAP(1000)        ;* Contents of INDEX.MAP file
  MAT INDEX.MAP = ""         ;* Initialization
  DIM DATA.MAP(1000)         ;* Contents of Data from INDEX.MAP file
  MAT DATA.MAP = ""          ;* Initialization
!
* Define equates for INDEX.MAP array
!
  EQU IDXname        LIT 'INDEX.MAP(1)'
  EQU IDXkeylen      LIT 'INDEX.MAP(2)'
  EQU IDXkeytext     LIT 'INDEX.MAP(3)'
  EQU IDXtype        LIT 'INDEX.MAP(4)'
  EQU IDXmulti       LIT 'INDEX.MAP(5)'
  EQU IDXbuilt       LIT 'INDEX.MAP(6)'
  EQU IDXnulls       LIT 'INDEX.MAP(7)'
  EQU IDXenabled     LIT 'INDEX.MAP(8)'
  EQU IDXdatalen     LIT 'INDEX.MAP(9)'
  EQU IDXdatatext    LIT 'INDEX.MAP(10)'
!
* Disable auto pagination
!
  ASSIGN 0 TO SYSTEM(1005)
!
* Open VOC file
!
  OPEN 'VOC' TO VOC.FILE ELSE
    ** "Unable to open VOC file."
    err.number = 1720
    err.args = ""
    process.status = -1
    GOTO EXIT.OUT:
  END 
!
* Open UV.ACCOUNT file
!
  OPENPATH UV.ROOT:'/UV.ACCOUNT' TO UVACCT.FILE ELSE
    ** "Unable to open UVACCT file."
    err.number = 85303
    err.args = "UV.ACCOUNT"
    process.status = -1
    GOTO EXIT.OUT:
  END 
!
* Read for LONGNAMES
!
  READV TEMP FROM VOC.FILE,"CREATE.FILE",5 ELSE TEMP = ""
  IF TEMP = "LONGNAMES" THEN
     LONGNAMES.ON = TRUE
  END
!
* Check for SH verb in VOC file.
!
  READV TEMP FROM VOC.FILE,"SH",1 ELSE TEMP = ""
  IF TEMP[1,1] <> "V" THEN
    err.number = 35065
    err.args = ""
    process.status = -1
    GOTO EXIT.OUT:
  END 
!
* Parse out COMMAND line
!
  WORK = TRIM(@SENTENCE)
  MATPARSE COMMAND FROM WORK , ' '
  TOKENS = INMAT()
!
* Look at all TOKENS on the command line
!
  FOR I = 2 TO TOKENS
     * See if word is in VOC
     READ VDESC FROM VOC.FILE, COMMAND(I) ELSE
        * Check for multi-level data file
        IF INDEX(COMMAND(I),",",1) THEN
           MAINFILE = FIELD(COMMAND(I),",",1)
           READ VDESC FROM VOC.FILE,MAINFILE ELSE
              err.number = 85300
              err.args = COMMAND(I)
              process.status = -1
              GOTO EXIT.OUT:
           END
        END ELSE
           * Add as possible index
           VDESC=""
        END
     END
!
* Examine for Keywords
!
     BEGIN CASE
     CASE VDESC[1,1] = 'K' 
        BEGIN CASE
			* See if COLLATE is on command line
			CASE VDESC<2> = KW$COLLATE
				IF SYSTEM( 100 ) AND SYSTEM ( 101 ) THEN
				*	NLS/NLSlocales loaded, get names...
					I += 1
					IF COMMAND(I) = "OFF" THEN
						COLLATE.NAME = "NONE"
					END
					ELSE
						COLLATE.NAME = COMMAND(I)
					END
				END
				ELSE
				*	Can't specify collation name unless NLS loaded up
					process.status = -1
					err.number = 32114
					err.args = ""
					GOTO EXIT.OUT
				END
            * See if DICT is on command line
            CASE VDESC<2> = KW$DICT AND FILE = ''
               DKEY = WANT.DICT
            * See if PDICT is on command line
            CASE VDESC<2> = KW$PDICT AND FILE = ''
               DKEY = WANT.PDICT
            * If DICT is used in USING clause
            CASE VDESC<2> = KW$DICT AND USING.CLAUSE = TRUE
               USING.DICT = WANT.DICT
            * If PDICT is used in USING clause
            CASE VDESC<2> = KW$PDICT AND USING.CLAUSE = TRUE
               USING.DICT = WANT.PDICT
            * See if NO.NULLS is on command line
            CASE VDESC<2> = KW$NO.NULLS
               NULLS.ALLOWED = FALSE
            * See if BRIEF is on command line
            CASE VDESC<2> = KW$BRIEF
               HUSH ON
            * See if USING is on command line
            CASE VDESC<2> = KW$USING
               USING.CLAUSE = TRUE
            * See if SYSTEM is on command line
            CASE VDESC<2> = KW$SYSTEM
               I += 1
               SYSTEM.name = COMMAND(I)
            * See if AT is on command line
            CASE VDESC<2> = KW$PRINTER
               I += 1
               * Check if path is given
               IF COMMAND(I)[1,1] = "/" OR COMMAND(I)[1,1] = "\" THEN
                  AT.PATH = COMMAND(I)
                  * Verify that path exists
CHECK.PATH:
                  OPENPATH AT.PATH TO TMPfile ELSE
                     * Path %n cannot be opened for reading.  Verify exists
                     err.number = 32100
                     err.args = AT.PATH
                     process.status = -1
                     GOTO EXIT.OUT:
                  END
                  * Must be Type1 or Type19
                  STATUS TMPstatus FROM TMPfile else TMPstatus = ""
                  IF TMPstatus<21> # 1 AND TMPstatus<21> # 19 THEN
                     * Location where indices are to reside not a UNIX directory!
                     err.number = 32101
                     err.args = ""
                     process.status = -1
                     GOTO EXIT.OUT:
                  END
                  CLOSE TMPfile 
               END ELSE
                  * Read from UV.ACCOUNT file
                  READV AT.PATH FROM UVACCT.FILE, COMMAND(I), 11 ELSE
                     * Unable to read item "%s".
                     err.number = 1205
                     err.args = COMMAND(I)
                     process.status = -1
                     GOTO EXIT.OUT:
                  END
                  GOTO CHECK.PATH:
               END
               AT.CLAUSE = TRUE
            * See if UNIQUE is on command line
            CASE VDESC<2> = KW$UNIQUE
              UNIQUE.INDEX = TRUE
            * See if NUMERIC is on command line
            CASE VDESC<2> = KW$NUMERIC
              NUMERIC.INDEX = TRUE
            CASE VDESC<2> = KW$SQLITYP
              SQLITYP.INDEX = TRUE
            * Encountered unknown
            CASE 1
               GOTO ADD.IDX:
        END CASE
!
* Check for FILE
! 
     CASE upcase(VDESC[1,1])='F' OR upcase(VDESC[1,1])='Q'
        * Exit if more than 1 file name on command line and no USING clause
        IF FILE # '' AND USING.CLAUSE = TRUE AND USING.NAME # '' THEN
           ** "Unexpected file name "%s" in command line."
           err.number = 85302
           err.args = COMMAND(I)
           process.status = -1
           GOTO EXIT.OUT:
        END ELSE
           * Assign file
           IF FILE = "" THEN
              FILE = COMMAND(I)
           END ELSE
              IF USING.CLAUSE = TRUE THEN
                 USING.NAME = COMMAND(I)
                 USING.CLAUSE = VOC.ENTRY
              END ELSE
                 GOTO ADD.IDX
              END
           END
        END
!
* Stack as possible entry
!
     CASE 1
        * Check for possible path for USING clause
        IF USING.CLAUSE = TRUE AND USING.NAME = "" THEN
           USING.NAME = COMMAND(I)
           USING.CLAUSE = UNIX.PATH
        END ELSE
ADD.IDX:
           IF IDX.TO.ADD = '' THEN
              IDX.TO.ADD = COMMAND(I)
           END ELSE
              IDX.TO.ADD := @FM:COMMAND(I)
           END
        END
     END CASE
!
* Process next TOKEN item
!
  NEXT I
!
* If FILE not on command line, prompt for it
!
  PROMPT ' '
  IF FILE = '' THEN
     ** "File name:"
     PRINT UVREADMSG(85304,""):'  ':
     INPUT FILE
  END
!
* Check for DICT
!
  IF INDEX(FILE," ",1) THEN
     DKEY = 0
     AWORD = FIELD(FILE," ",1)
     READ VDESC FROM VOC.FILE,AWORD THEN
        * Check that this is DICT keyword
        IF VDESC[1,1] = "K" THEN
           IF VDESC<2> = KW$DICT THEN DKEY = WANT.DICT
           IF VDESC<2> = KW$PDICT THEN DKEY = WANT.PDICT
        END
     END
     IF DKEY = 0 THEN
       ** "Unrecognized keyword "%s" in command line"
       err.number = 85300
       err.args = AWORD
       process.status = -1
       GOTO EXIT.OUT:
     END
     FILE=TRIMF(FILE[LEN(AWORD)+1,999])
  END
!
* Verify file is legit
!
  IF FILE = '' THEN
     ** "No file name specified."
     err.number = 10138
     err.args = ""
     process.status = -1
     GOTO EXIT.OUT:
  END ELSE
     READ VDESC FROM VOC.FILE, FILE ELSE
        * Check for multi-level data files
        IF INDEX(FILE,",",1) THEN
           MAINFILE = FIELD(FILE,",",1)
           READ VDESC FROM VOC.FILE, MAINFILE ELSE
              ** "%n" is not a file name.
              err.number = 45006
              err.args = FILE
              process.status = -1
              GOTO EXIT.OUT:
           END
        END ELSE
           ** "%n" is not a file name.
           err.number = 45006
           err.args = FILE
           process.status = -1
           GOTO EXIT.OUT:
        END
     END

     * Check for USING clause for which DICT to open
     IF USING.CLAUSE # UNIX.PATH THEN
        IF USING.CLAUSE = FALSE THEN
           DFILE = IF DKEY THEN "DICT.DICT" ELSE "DICT ":FILE
        END ELSE
           DFILE = USING.NAME
           IF USING.DICT = WANT.DICT THEN DFILE = "DICT "DFILE
           IF USING.DICT = WANT.PDICT THEN DFILE = "PDICT "DFILE
        END 
        OPEN DFILE TO UDICT ELSE
           ** "Unable to open "%s"."
           err.number = 85303
           err.args = DFILE
           process.status = -1
           GOTO EXIT.OUT:
        END
     END ELSE
        OPENPATH USING.NAME TO UDICT ELSE
           ** "Unable to open "%s"."
           err.number = 85303
           err.args = USING.NAME
           process.status = -1
           GOTO EXIT.OUT:
        END
        DFILE = USING.NAME
     END
     * Get file status info
     STATUS index.dict FROM UDICT ELSE
        * Unable to stat file %s
        err.number = 32007
        err.args = DFILE
        process.status = -1
        GOTO EXIT.OUT:
     END
  END
!
* Open the file
!
  IF DKEY = WANT.DICT THEN FILE = "DICT ":FILE
  IF DKEY = WANT.PDICT THEN FILE = "PDICT ":FILE
  OPEN FILE TO UDATA ELSE
     ** "Unable to open "%s"."
     err.number = 85303
     err.args = FILE
     process.status = -1
     GOTO EXIT.OUT:
  END
!
* Get file status info
!
  STATUS index.item FROM UDATA ELSE
     * Unable to stat file %s
     err.number = 32007
     err.args = FILE
     process.status = -1
     GOTO EXIT.OUT:
  END
!
* Can we even create indices
!
  IF index.item<21> = 1 OR index.item<21> = 19 THEN
     * Secondary index facility is not support for type 1 or 19 files.
     * PRINT;CALL *UVPRINTMSG(35038,"")
     err.number = 35038
     err.args = ""
     process.status = -1
     GOTO EXIT.OUT:
  END

  STATE = 0
  RECIO(STATE,FINFO$AI.STATE,RECIO$FINFO)
  IF FILEINFO(UDATA,FINFO$RECOVERYTYPE) # 0 AND STATE = AI$LOGGING THEN
     * PRINT;CALL *UVPRINTMSG(87902,"")
     err.number = 87902
     err.args = ""
     process.status = -1
     GOTO EXIT.OUT
  END
!
* Get a list of INDICES.  A null list is returned if none
!
  IF IDX.TO.ADD = '' THEN
     ** "Index name(s): "
     PRINT UVREADMSG(32009,""):
     INPUT IDX.TO.ADD
     IF IDX.TO.ADD = '' THEN
        ** "No Index name specified."
        err.number = 85307
        err.args = ""
        process.status = -1
        GOTO EXIT.OUT:
     END
     * Add as possible index key and convert space or comma to FM
     * in case we got a string of index names
     IDX.TO.ADD = CONVERT(\ ,\,@FM:@FM,IDX.TO.ADD)
  END

  HDRLAYOUT = FILEINFO(UDATA, FINFO$HDRLAYOUT)
  AKPATHoffset = HDRLAYOUT<FH$INDEXPATH,1>
  AKPATHlength = HDRLAYOUT<FH$INDEXPATH,2>
  IDXOFFoffset = HDRLAYOUT<FH$INDEXFLAGS,1>
  IDXOFFlength = HDRLAYOUT<FH$INDEXFLAGS,2>
  SQLIDXoffset = HDRLAYOUT<FH$IDXCOLCNT,1>
  SQLIDXlength = HDRLAYOUT<FH$IDXCOLCNT,2>

  if index.item<32> = 5 then
    FILETYPE = " -64BIT"
  end else
    if index.item<32> = 3 then
      FILETYPE = " -32BIT"
    end else
      FILETYPE = " -OLDSTYLE"
    end
  end

!
* Disable interrupts
!
  BREAK OFF
!
* Special handling for Distributed Files
!
  IF index.item<21> = 27 THEN
     * This is a Distributed File, so there are NO indices on the file
     * itself.  We must spawn a CREATE.INDEX for each partfile, and do
     * them sequentially.  The PF vocnames will be in F26 of the result
     * from the above STATUS statement.
     *
     * Get absolute path of DICT file
     DICT.UNIX.PATH = index.dict<27>
     *
     * Make certain I-types are compiled
*     EXECUTE "COMPILE.DICT ":FILE:" ":CONVERT(@fm," ",IDX.TO.ADD)
     *
     * Get hostname
     EXECUTE OS.EXEC:" '":HOSTNAME:"'" CAPTURING LocalHOSTNAME
     LocalHOSTNAME = LocalHOSTNAME<1>
     MAX.PFS = DCOUNT(index.item<26>,@vm)
     FOR I = 1 TO MAX.PFS
         * Set up spawn command
         cmd = "CREATE.INDEX ":index.item<26,I>:" "
         * Add names
         cmd := CONVERT(@fm," ",IDX.TO.ADD)
         * Is this PF a remote?
         IF (index.item<25,I> MATCHES "1X0X'!/'0X") OR (index.item<25,I> MATCHES "1X0X'!\'0X") OR (index.item<25,I> MATCHES "1X0X'!'1A':'0X") THEN
            * Let PF use DICT of DF prepended with LocalHOSTNAME
            cmd := " USING ":LocalHOSTNAME:"!":DICT.UNIX.PATH
         END ELSE
            * Let PF's use DICT of DF
            cmd := " USING ":DICT.UNIX.PATH
         END
         * Is there an AT clause
         IF AT.CLAUSE = TRUE THEN
            cmd := " AT ":AT.PATH
         END
         IF NULLS.ALLOWED = FALSE THEN
            cmd := " NO.NULLS"
         END
         * Creating indice(s) for partfile '%s'!
         *CALL *UVPRINTMSG(32102,index.item<26,I>)
         * Go do command
         EXECUTE cmd SETTING return.code
         * Stop if error
         IF return.code = -1 THEN
            process.status = -1
         END
     NEXT I
     GOTO EXIT.OUT:
END
!
* Special handling for Remote Files
!
$IFDEF UV.MSWIN
 CONVERT '\' TO '/' IN index.item<20>
$ENDIF
 IF (index.item<20> MATCHES "1X0X'!/'0X") THEN
    IS.REMOTE = TRUE
    NODE = FIELD(index.item<20>,"!/",1)
    DIRECTORY =  FIELD(index.item<20>,"!/",2,9999)
 END ELSE IF (index.item<20> MATCHES "1X0X'!'1A':'0X") THEN
    IS.REMOTE = TRUE
    NODE = FIELD(index.item<20>,"!",1)
    DIRECTORY =  FIELD(index.item<20>,"!",2,9999)
 END ELSE
    IS.REMOTE = FALSE
 END
 IF IS.REMOTE THEN
    * Set up for remote execute call
    IF INDEX(DIRECTORY,"/DATA.30",1) THEN
       DIRECTORY = FIELD(DIRECTORY, "/", 1, COUNT(DIRECTORY,"/"))
    END
    DIRECTORY = FIELD(DIRECTORY, "/", 1, COUNT(DIRECTORY,"/"))
    * Clean up command - get rid of determining string
    THING.TO.DO = "CREATE.INDEX ":FILE:" ":CONVERT(@fm," ",IDX.TO.ADD)
    IF USING.CLAUSE # FALSE THEN
        THING.TO.DO := " USING ":USING.NAME
    END
    * Add node name
    THING.TO.DO := " SYSTEM ":NODE
    RESULT=""
    * Calling remote node '":NODE:"'. Please wait..."
    * CALL *UVPRINTMSG(32103,NODE)
    * Go do remote command
    CALL *REMOTE.B(NODE, THING.TO.DO, DIRECTORY, RESULT)
    if RESULT # "" THEN PRINT RESULT
    TEMP=""
    DIRECTORY=""
    NODE=""
    GOTO EXIT.OUT:
 END
!
* Some initializations
!
  MAX.INDICES   = 0
  FROM.VOC      = STR(0,1000) ;* Assume read is from DICT
  AVAILABLE     = STR(1,1000) ;* Slots which are available - assume all
!
* Loop through named items and read from DICT FILE or VOC
!
  LOOP
     MAX.INDICES += 1
     REMOVE IDX.ITEM FROM IDX.TO.ADD SETTING DELIM
     * Check if item is in DICT
     READ VDESC FROM UDICT, IDX.ITEM ELSE
        * Check if item is in VOC
        READ VDESC FROM VOC.FILE, IDX.ITEM ELSE
           * Cannot find field name %s in field dictionary or VOC, no index"
           err.number = 35033
           err.args = IDX.ITEM
           process.status = -1
           GOTO EXIT.OUT:
        END
        FROM.VOC[MAX.INDICES,1] = TRUE
     END
     * If not correct type, croak
     IF NOT(INDEX("ADIS",VDESC<1>[1,1],1)) THEN
        * Only records of type A, D, I or S allowed!
        err.number = 32104
        err.args = ""
        process.status = -1
        GOTO EXIT.OUT:
     END
     * Save DICT text
     DICT.TEXT(MAX.INDICES) = VDESC
  UNTIL DELIM = 0 DO
     * Have we exceeded limit
     IF MAX.INDICES > MAXindices THEN
        * Maximum number of indices exceed
        err.number = 32105
        err.args = MAXindices
        process.status = -1
        GOTO EXIT.OUT:
     END
  REPEAT
!
* Check that I-types are compiled
!
  IDX.TO.ADD = IDX.TO.ADD ;* Reset REMOVE pointer
  IDX.CNT  = 1
  LOOP
     REMOVE IDX.ITEM FROM IDX.TO.ADD SETTING DELIM
     * If this is an Itype - make certain its compiled
     IF DICT.TEXT(IDX.CNT)[1,1] = 'I' THEN
        * open local dict
        OPEN 'DICT',FILE TO ODICT ELSE
           ** Unable to open
           err.number = 85303
           err.args = 'DICT ':FILE
           process.status = -1
           GOTO EXIT.OUT:
        END
        * Read from remote dict
        IF FROM.VOC[IDX.CNT,1] = FALSE THEN
           READ VDESC FROM UDICT, IDX.ITEM ELSE
              * Unable to read item "%s".
              err.number = 1205
              err.args = IDX.ITEM
              process.status = -1
              GOTO EXIT.OUT:
           END
        END ELSE
           READ VDESC FROM VOC.FILE, IDX.ITEM ELSE
              * Unable to read item "%s".
              err.number = 1205
              err.args = IDX.ITEM
              process.status = -1
              GOTO EXIT.OUT:
           END
        END
        * Write to temp record
        READU ISOLOCK FROM ODICT,IDX.ITEM:".tEmPP" ELSE null
        WRITE VDESC ON ODICT, IDX.ITEM:".tEmPP"
        * Compile 
        * Quote the thing if it contains a single or double quote.
        IF INDEX(IDX.ITEM, "'", 1) OR INDEX(IDX.ITEM, '"', 1)
        THEN tmpidx.item = SYSTEM(1031, IDX.ITEM:".tEmPP")
        ELSE tmpidx.item = IDX.ITEM:".tEmPP"

        EXECUTE "COMPILE.DICT ":FILE:" ":tmpidx.item CAPTURING screen
        * Re-read
        READU VDESC FROM ODICT, IDX.ITEM:".tEmPP" ELSE
           DELETE ODICT, IDX.ITEM:".tEmPP"
           * Unable to read item "%s".
           err.number = 1205
           err.args = IDX.ITEM:".tEmPP"
           process.status = -1
           GOTO EXIT.OUT:
        END
        * delete
        DELETE ODICT, IDX.ITEM:".tEmPP"
        * Is there stuff beyond field 15
        IF VDESC<20> = "" THEN
           * I-descriptor must be compiled before execution.
           err.number = 40018
           err.args = ""
           process.status = -1
           GOTO EXIT.OUT:
        END
        * Replace
        DICT.TEXT(IDX.CNT) = VDESC
        VDESC = ""
     END
  UNTIL DELIM = 0 DO
    IDX.CNT += 1
  REPEAT
!
* Check for existence of index directory - read file header
!
$IFDEF UV.MSWIN
  CONVERT '\' TO '/' IN index.item<27>
$ENDIF
  ABSOLUTE.FILE.PATH = index.item<27>
  FILENAME = FIELD(ABSOLUTE.FILE.PATH,"/",DCOUNT(ABSOLUTE.FILE.PATH,"/"))
  IF index.item<21> = 30 THEN ABSOLUTE.FILE.PATH := "/DATA.30"
  IF SYSTEM(100) THEN
     * NLS is enabled
     * First Save the original sequential file map
     OLD.SEQ.MAP = SYSTEM(106)
     * SET.SEQ.MAP to NONE to ensure binary access to index file
     IGNORE = NLSsetseqmap("NONE")
  END
  OPENSEQ ABSOLUTE.FILE.PATH TO SEQ.FILE ELSE
     IF SYSTEM(100) THEN
        * Restore the original sequential file map
        IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
     END
     * Unable to openseq %s
     err.number = 85309
     err.args = ABSOLUTE.FILE.PATH
     process.status = -1
     GOTO EXIT.OUT:
  END
  IF SYSTEM(100) THEN
     * Restore the original sequential file map
     IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
  END
  * Seek to AK position
  SEEK SEQ.FILE, AKPATHoffset, 0 ELSE
     * Unable to seq in %s
     err.number = 85310
     err.args = ABSOLUTE.FILE.PATH
     process.status = -1
     GOTO EXIT.OUT:
  END
  * Read in AKdirPATH
  READBLK AKdirPATH FROM SEQ.FILE, AKPATHlength ELSE
     * Unable to read index directory name in file header block.
     err.number = 35030
     err.args = ""
     process.status = -1
     GOTO EXIT.OUT:
  END
!
* Extract important create data
!
  OWNER = index.item<8>
  GROUP = index.item<9>
  PERMS = index.item<5>
  PERMS = BITAND(PERMS, 511)  ;* Get lowest 3 bits
  EXPERMS = BITAND(PERMS, 73) ;* Give execute permissions
!
* Check
!
  IF AKdirPATH[1,1] # BYTE(0) THEN
    * We have a directory, with indices - truncate at first BYTE(0)
    AKdirPATH = AKdirPATH[1,INDEX(AKdirPATH,BYTE(0),1)-1]
    GOSUB LOAD.INDEX.MAP:
    IF AT.CLAUSE THEN
       * Indices exist at xxx! AT clause ignored!
       err.number = 32106
       err.args = AKdirPATH
       AT.CLAUSE = FALSE
    END
  END ELSE
    * Create path
    IF AT.CLAUSE THEN
       * Create at given account path
       AKdirPATH = AT.PATH
    END ELSE
       * Create index directory where file exists
       AKdirPATH = FIELD(index.item<27>,"/",1,COUNT(index.item<27>,"/"))
       AT.PATH = AKdirPATH
    END
    * Open this directory
    OPENPATH AKdirPATH TO TMPfile ELSE
       * Unable to open the UNIX directory %s
       err.number = 10001
       err.args = AKdirPATH
       process.status = -1
       GOTO EXIT.OUT:
    END
    * Must be Type1 or Type19
    STATUS TMPstatus FROM TMPfile else TMPstatus = ""
    IF TMPstatus<21> # 1 AND TMPstatus<21> # 19 THEN
       * Location where indices are to reside not a UNIX directory!
       err.number = 32101
       err.args = ""
       process.status = -1
       GOTO EXIT.OUT:
    END
    * Check that we have permissions to create
    MYuid = SYSTEM(28)
    WRITEABLE=0
    CALL @PERMISSIONS(TMPfile,1,6,WRITEABLE)
    IF NOT(WRITEABLE) AND MYuid # 0 THEN
       * Privileges insufficient to create index directory in %s.
       err.number = 35025
       err.args = AT.PATH
       process.status = -1
       GOTO EXIT.OUT:
    END
    * CLose
    CLOSE TMPfile
$IFDEF UV.UNIX
    *
    * Get the name of the file as saved in the file header. This will include
    * any mapping done for special characters (ie X/Y is X?\Y at unix).
    *
    AKname = FIELD(index.item<27>,"/",(COUNT(index.item<27>,"/")+1))
$ELSE
    * Convert name
    BEGIN CASE
       CASE DKEY = 0
          AKname = FILENAME
       CASE DKEY = WANT.DICT
          AKname = CHANGE(FILENAME,"DICT ","D_",-1)
       CASE DKEY = WANT.PDICT
          AKname = CHANGE(FILENAME,"PDICT ","P_",-1)
    END CASE
$ENDIF
    AKdirPATH := "/I_":AKname
    * Check path length
    IF BYTELEN(AKdirPATH) > AKPATHlength THEN
       * Index directory path name %n exceed %i character limit.
       err.number = 35026
       err.args = AKdirPATH:@fm:AKPATHlength
       process.status = -1
       GOTO EXIT.OUT:
    END
    
    * Does this new sub-directory already exist
    PATH.OK = FALSE
    PATH.CT = 0
    LOOP
      OPENPATH AKdirPATH TO TMPfile ELSE
         PATH.OK = TRUE
      END
    UNTIL PATH.OK = TRUE DO
      * Close
      CLOSE TMPfile
      * Start sequencing
      AKdirPATH[2] = ('0':PATH.CT)"R#2"
      PATH.CT += 1
      IF PATH.CT >= MAXindices THEN
         * Unable to generate unique index directory name. Last tried %n.
         err.number = 35027
         err.args = AKdirPATH
         process.status = -1
         GOTO EXIT.OUT:
      END
    REPEAT
    * Build command
$IFDEF UV.UNIX
    *
    *   quote the filename so that the unix shell won't try to 
    *         interpret special chars
    *
    cmd = UV.BIN:UV.FSEP:"mkdbfile ":"'":AKdirPATH:"'":" 19 -u ":OWNER
    cmd := " -g ":GROUP:" -m ":EXPERMS:" -M NONE"
    EXECUTE OS.EXEC:' "':cmd:'"' CAPTURING screen
$ELSE
    cmd = UV.BIN:UV.FSEP:"mkdbfile ":AKdirPATH:" 19 -u ":OWNER
    cmd := " -g ":GROUP:" -m ":EXPERMS:" -M NONE"
    * Go create directory
    EXECUTE OS.EXEC:" '":cmd:"'" CAPTURING screen
$ENDIF
    * If anything came back, then its an error
    IF screen # "" THEN
       * Attempt to create index directory %n failed.
       *PRINT screen
       err.number = 35028
       err.args = AKdirPATH
       process.status = -1
       GOTO EXIT.OUT:
    END
    * Seek to AK position
    SEEK SEQ.FILE, AKPATHoffset, 0 ELSE
       * Unable to seq in %s
       err.number = 85310
       err.args = ABSOLUTE.FILE.PATH
       process.status = -1
       GOTO EXIT.OUT:
    END
    * Write out new path
    TEMP = (AKdirPATH:STR(BYTE(0),AKPATHlength))("L#":AKPATHlength)
    WRITEBLK TEMP ON SEQ.FILE ELSE
       * Unable to write index directory name in file header block.
       err.number = 35029
       err.args = ""
       process.status = -1
       GOTO EXIT.OUT:
    END
  END
!
* Close
!
  CLOSESEQ SEQ.FILE
!
* Add
!
  IDX.TO.ADD = IDX.TO.ADD ;* Reset REMOVE pointer
  STARTcnt = IDXcnt
  NEWcnt = 0
  LOOP
    REMOVE IDX.ITEM FROM IDX.TO.ADD SETTING DELIM
    NEWcnt += 1
    * Look through INDEX.MAP for similar
    ONE.IDX = 0
    LOOP
      ONE.IDX += 1
      ADD.THIS.ONE = TRUE ;* Assume we can add this
      CORRELATIVE  = FALSE;* Assume none
      TESTcnt = IDXdatatext<ONE.IDX>
      * Get MV
      IF INDEX("DI", DICT.TEXT(NEWcnt)<1>[1,1], 1) THEN
         MV = DICT.TEXT(NEWcnt)<6>
         IF MV = "" THEN MV = "S" ;* Assume Single-value if nothing given
      END ELSE
         * Pick-style: assume multi-valued
         MV = "M"
         * Check if this has correlative
         IF DICT.TEXT(NEWcnt)<8> # "" THEN
            CORRELATIVE = TRUE
         END
      END
	IF MV # "M" AND MV # "S" THEN
		* invalid multivalue field
		IF SYSTEM.name # '' then
			CALL *UVPRINTMSG(32112,SYSTEM.name)
		END
		CALL *UVPRINTMSG(35034,IDX.ITEM:@fm:IDXkeytext<ONE.IDX>)
		ADD.THIS.ONE=FALSE
		EXIT
	END
    UNTIL ONE.IDX > IDXcnt DO
      * First, check name
      IF IDX.ITEM = IDXkeytext<ONE.IDX> THEN
         print
         if SYSTEM.name # "" then
            CALL *UVPRINTMSG(32112,SYSTEM.name)
         end
         * Index field %s is a duplicate of %n, no new index created.
         CALL *UVPRINTMSG(35032, IDX.ITEM:@fm:IDXkeytext<ONE.IDX>)
         ADD.THIS.ONE = FALSE
         EXIT ;* Get next key
      END
      * Second, check type
      BEGIN CASE
      CASE INDEX("D",DICT.TEXT(NEWcnt)<1>[1,1],1)
         * Does field 2 match
         IF DICT.TEXT(NEWcnt)<2> = DATA.MAP(TESTcnt)<2> THEN
            * Test M/S
            IF MV = IDXmulti<ONE.IDX> THEN
               print
               if SYSTEM.name # "" then
                  CALL *UVPRINTMSG(32112,SYSTEM.name)
               end
               * Index field %s is a duplicate of %n, no new index created.
               CALL *UVPRINTMSG(35032, IDX.ITEM:@fm:IDXkeytext<ONE.IDX>)
               ADD.THIS.ONE = FALSE
               EXIT             ; * Get next key
            END
         END
         * Check if this is a Pick-style
      CASE INDEX("ACS",DICT.TEXT(NEWcnt)<1>[1,1],1)
         * Is there correlative code
         OKAY = 1
         IF DICT.TEXT(NEWcnt)<2> = DATA.MAP(TESTcnt)<2> THEN
            IF DICT.TEXT(NEWcnt)<8> # "" THEN
               * Does it match
               IF DICT.TEXT(NEWcnt)<8> = DATA.MAP(TESTcnt)<8> THEN
                  OKAY = 0
               END
            END ELSE
               OKAY = 0
            END
            IF NOT(OKAY) THEN
               * Index field %s is a duplicate of %n, no new index created.
               print
               if SYSTEM.name # "" then
                  CALL *UVPRINTMSG(32112,SYSTEM.name)
               end
               CALL *UVPRINTMSG(35032, IDX.ITEM:@fm:IDXkeytext<ONE.IDX>)
               ADD.THIS.ONE = FALSE
               EXIT             ; * Get next key
            END
         END
      CASE DICT.TEXT(NEWcnt)<1>[1,1] = 'I'
         * Do nothing 
      CASE 1
         * Error initializing index file "%n", no index created.
         print
         if SYSTEM.name # "" then
            CALL *UVPRINTMSG(32112,SYSTEM.name)
         end
         CALL *UVPRINTMSG(35034, FILE);
         ADD.THIS.ONE = FALSE
         EXIT
      END CASE
    REPEAT
    * Add one to memory INDEX.MAP
    IF ADD.THIS.ONE = TRUE THEN
       IDXcnt += 1
       * Add namelen and nametext
       IDXkeylen<IDXcnt>     = BYTE(BYTELEN(IDX.ITEM)+1)
       IDXkeytext<IDXcnt>    = IDX.ITEM
       * Add type
       IF CORRELATIVE = FALSE THEN
          IDXtype<IDXcnt>    = DICT.TEXT(NEWcnt)<1>[1,1]
       END ELSE
          IDXtype<IDXcnt>    = 'C'
       END
       * Add multi
       IDXmulti<IDXcnt>      = MV
       * Add built
       IDXbuilt<IDXcnt>      = 'N'
       * Add nulls
       IDXnulls<IDXcnt>      = IF NULLS.ALLOWED = TRUE THEN 'Y' ELSE 'N'
       * Add enabled
       IDXenabled<IDXcnt>    = 'Y'
       * Add datalen and datatext
       IF IDXtype<IDXcnt> = 'C' OR IDXtype<IDXcnt> = 'I' THEN
          IDXdatalen<IDXcnt>    = BYTELEN(DICT.TEXT(NEWcnt))+1
          IDXdatatext<IDXcnt>   = IDXcnt
          DATA.MAP(IDXcnt)      = DICT.TEXT(NEWcnt):BYTE(0)
       END ELSE
          IDXdatalen<IDXcnt>    = BYTELEN(DICT.TEXT(NEWcnt)<2>)+1
          IDXdatatext<IDXcnt>   = IDXcnt
          DATA.MAP(IDXcnt)      = DICT.TEXT(NEWcnt)<2>:BYTE(0)
       END
       * Go create file
       GOSUB CREATE.EMPTY.INDEX.FILE:
       * Go set IDXOFF tags
       GOSUB SET.IDXOFF.TAG:
       * Set process.status
       process.status += 1
    END
  UNTIL DELIM = 0 DO
    * Check for max
    IF IDXcnt = MAXindices THEN
       print
       if SYSTEM.name # "" then
          CALL *UVPRINTMSG(32112,SYSTEM.name)
       end
       * Maximum number of indices (":MAXindices:") reached!
       CALL *UVPRINTMSG(32107,MAXindices)
       EXIT
    END
  REPEAT
!
* Write out INDEX.MAP file
!
  GOSUB WRITE.INDEX.MAP:
!
* Just exit
!
EXIT.OUT:
  @SYSTEM.RETURN.CODE = process.status
  BREAK ON
  if process.status = -1 then
     PRINT
     if SYSTEM.name # "" then
        CALL *UVPRINTMSG(32112,SYSTEM.name)
     end
     CALL *UVPRINTMSG(err.number,err.args)
  end
  STOP
!
* End of MAIN code - Start of subroutines
!
LOAD.INDEX.MAP:
!
* Open the INDEX.MAP file
!
  INDEX.MAP.PATH = AKdirPATH:"/INDEX.MAP"
  Islocked = 0
  IF SYSTEM(100) THEN
     * NLS is enabled
     * First Save the original sequential file map
     OLD.SEQ.MAP = SYSTEM(106)
     * SET.SEQ.MAP to NONE to ensure binary access to index file
     IGNORE = NLSsetseqmap("NONE")
  END
  LOOP
    OPENSEQ INDEX.MAP.PATH TO MAP.FILE LOCKED
       Islocked = 1
    END ELSE
       IF SYSTEM(100) THEN
          * Restore the original sequential file map
          IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
       END
       * "Unable to open index map '%n' for read/write."
       err.number = 35031
       err.args = INDEX.MAP.PATH
       process.status = -1
       RETURN TO EXIT.OUT:
    END
  WHILE Islocked DO
    SLEEP 10
  REPEAT
  IF SYSTEM(100) THEN
     * Restore the original sequential file map
     IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
  END
!
* Load in contents of INDEX.MAP file
!
  IDXcnt = 0
  LOOP
    * Get file name
    READBLK TEMP FROM MAP.FILE,10 ELSE EXIT
    IDXcnt += 1
    IDXname<IDXcnt> = TEMP
    * Mark in AVAILABLE as already used
    TEMP = TRIM(TEMP, BYTE(0), 'T')
    AVAILABLE[(TEMP[3]+1),1] = 0
    * Get keylen
    READBLK IKL FROM MAP.FILE,1 ELSE IKL = 0
    IDXkeylen<IDXcnt> = IKL
    * Get keytext
    READBLK TEMP FROM MAP.FILE, BYTEVAL(IKL) ELSE TEMP=""
    * Remove BYTE(0) from end
    IDXkeytext<IDXcnt> = TEMP[1,LEN(TEMP)-1]
    * Get next 5 chars
    READBLK TEMP FROM MAP.FILE, 5 ELSE TEMP=""
    IDXtype<IDXcnt>    = TEMP[1,1]
    IDXmulti<IDXcnt>   = TEMP[2,1]
    IDXbuilt<IDXcnt>   = TEMP[3,1]
    IDXnulls<IDXcnt>   = TEMP[4,1]
    IDXenabled<IDXcnt> = TEMP[5,1] 
    * Read in datalen
    READBLK IKL FROM MAP.FILE, 2 ELSE IKL = 0

    * GTAR 19949
    * Character substrings are not the same as byte substrings when NLS on

    * IKL = BYTEVAL(IKL[1,1]) + 256 * BYTEVAL(IKL[2,1])

    HEXIKL = OCONV( IKL, "MX0C" )

    IKL = ICONV( HEXIKL[1,2], "MCD" ) + 256 * ICONV( HEXIKL[3,2], "MCD" )

    IDXdatalen<IDXcnt> = IKL
    * Read in datatext
    READBLK TEMP FROM MAP.FILE, IKL ELSE TEMP=""
    IDXdatatext<IDXcnt> = IDXcnt
    DATA.MAP(IDXcnt) = TEMP

  REPEAT
!
* Close and return
!
  CLOSESEQ MAP.FILE
  RETURN
!
* Write the INDEX.MAP file
!
WRITE.INDEX.MAP:
!
* Open it first
!
  INDEX.MAP.PATH = AKdirPATH:"/INDEX.MAP"
  Islocked = 0
  IF SYSTEM(100) THEN
     * NLS is enabled
     * First Save the original sequential file map
     OLD.SEQ.MAP = SYSTEM(106)
     * SET.SEQ.MAP to NONE to ensure binary access to index file
     IGNORE = NLSsetseqmap("NONE")
  END
  LOOP
    OPENSEQ INDEX.MAP.PATH TO MAP.FILE LOCKED
       Islocked = 1
    END ELSE
       IF SYSTEM(100) THEN
          * Restore the original sequential file map
          IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
       END
       CREATE MAP.FILE ELSE 
          * Unable to create INDEX.MAP file
          err.number = 32108
          err.args = ""
          process.status = -1
          RETURN TO EXIT.OUT:
       END
    END
  WHILE Islocked DO
    SLEEP 10
  REPEAT
  IF SYSTEM(100) THEN
     * Restore the original sequential file map
     IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
  END
!
* Rewrite INDEX.MAP file
!
  SEEK MAP.FILE, 0, 0 ELSE
    * Unable to seq in %s.
    err.number = 85310
    err.args = INDEX.MAP.PATH
    process.status = -1
    RETURN TO EXIT.OUT:
  END
!
* Truncate file
!
  WEOFSEQ MAP.FILE
!
* Lay down remaining values
!
  C = DCOUNT(IDXname,@fm)
  B = 0
  D = 0
  F = 0
  LOOP
    B += 1
  UNTIL B > C DO
    TEMP = IDXname<B>
    * Is last byte a BYTE(0)? If not, add one
    IF TEMP[1] # BYTE(0) THEN
       TEMP := BYTE(0)
    END
    TEMP := IDXkeylen<B>:IDXkeytext<B>:BYTE(0)
    TEMP := IDXtype<B>:IDXmulti<B>:IDXbuilt<B>
    TEMP := IDXnulls<B>:IDXenabled<B>
    F = INT(IDXdatalen<B> / 256)
    IF F > 0 THEN
       D = BYTE((IDXdatalen<B>-(F*256))):CHAR(F)
    END ELSE
       D = BYTE(IDXdatalen<B>):BYTE(0)
    END
    TEMP := D
    TEMP := DATA.MAP(IDXdatatext<B>)
    WRITEBLK TEMP ON MAP.FILE ELSE
      * Error updating INDEX.MAP file!
      err.number = 32109
      err.args = ""
      process.status = -1
      EXIT
    END
  REPEAT
!
* Close
!
  CLOSESEQ MAP.FILE

  RETURN
!
* Create an index file
!
CREATE.EMPTY.INDEX.FILE:
  * Let's go create/assume the next available
  Next.entry = INDEX(AVAILABLE,1,1)
  * Did we get anything
  IF Next.entry = 0 THEN
     * Unable to generate unique index file name! 
     err.number = 32110
     err.args = ""
     process.status = -1
     RETURN TO EXIT.OUT:
  END
  * Mark as taken
  AVAILABLE[Next.entry,1] = 0
  * Save name
  IDXname<IDXcnt> = "INDEX.":FMT(Next.entry-1,"R%3")
  * Set up name
  NEW.FILE = AKdirPATH:UV.FSEP:IDXname<IDXcnt>
  * Remove any existing file
  HUSH ON SETTING HUSH.STATE
$IFDEF UV.UNIX
  cmd = RM.CMD:" ":"'":NEW.FILE:"'"
  EXECUTE OS.EXEC:' "':cmd:'"' CAPTURING screen
$ELSE
  EXECUTE OS.EXEC:" '":RM.CMD:" ":NEW.FILE:"'" CAPTURING screen
$ENDIF
  HUSH HUSH.STATE
  * Build command
$IFDEF UV.UNIX
  cmd = UV.BIN:UV.FSEP:"mkdbfile ":"'":NEW.FILE:"'":" 25 -u ":OWNER:" -M NONE"
  cmd := " -g ":GROUP:" -m ":PERMS:FILETYPE
  IF COLLATE.NAME THEN
  	cmd:= " -S ":COLLATE.NAME
  END
  * Go create file
  EXECUTE OS.EXEC:' "':cmd:'"' CAPTURING screen
$ELSE
  cmd = UV.BIN:UV.FSEP:"mkdbfile ":NEW.FILE:" 25 -u ":OWNER:" -M NONE"
  cmd := " -g ":GROUP:" -m ":PERMS:FILETYPE
  IF COLLATE.NAME THEN
  	cmd:= " -S ":COLLATE.NAME
  END
  * Go create file
  EXECUTE OS.EXEC:" '":cmd:"'" CAPTURING screen
$ENDIF
  * If anything came back, then its an error
  IF screen # "" THEN
     * Try another file
     GOTO CREATE.EMPTY.INDEX.FILE:
  END
  RETURN
!
* Update tags
!
SET.IDXOFF.TAG:
  * Openseq file
  IF SYSTEM(100) THEN
     * NLS is enabled
     * First Save the original sequential file map
     OLD.SEQ.MAP = SYSTEM(106)
     * SET.SEQ.MAP to NONE to ensure binary access to index file
     IGNORE = NLSsetseqmap("NONE")
  END
  OPENSEQ NEW.FILE TO TMPfile ELSE
     IF SYSTEM(100) THEN
        * Restore the original sequential file map
        IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
     END
     * Unable to openseq %s
     err.number = 85309
     err.args = NEW.FILE
     process.status = -1
     RETURN TO EXIT.OUT:
  END
  IF SYSTEM(100) THEN
     * Restore the original sequential file map
     IGNORE = NLSsetseqmap(OLD.SEQ.MAP)
  END
  * Initialize to being set by CREATE.INDEX
  IDXOFF.VALUE = BITOR(0,8)
  * Check justification
  Fvalue = IF IDXtype<IDXcnt>="D" OR IDXtype<IDXcnt>="I" THEN 5 ELSE 9
  TMPval = TRIMB(DICT.TEXT(NEWcnt)<Fvalue>)
  IF TMPval[1] = "R" THEN
     * Mark
     IDXOFF.VALUE = BITOR(IDXOFF.VALUE, 4)
       END
  * Check unique
  IF UNIQUE.INDEX = TRUE THEN
     * Mark
     IDXOFF.VALUE = BITOR(IDXOFF.VALUE, 16)
  END
  * Check unique
  IF NUMERIC.INDEX = TRUE THEN
     * Mark
     IDXOFF.VALUE = BITOR(IDXOFF.VALUE, 32)
  END
  IF SQLITYP.INDEX = TRUE THEN
     * Mark
     IDXOFF.VALUE = BITOR(IDXOFF.VALUE, 64)
  END
  * Determine if UNIX or XINU system
  SEEK TMPfile, T25LEAFoffset, 0 ELSE
     * Unable to seq in %s
     err.number = 85310
     err.args = NEW.FILE
     process.status = -1
     RETURN TO EXIT.OUT:
  END
  * Read a short
  READBLK NODE FROM TMPfile, 2 ELSE
     * Unable to read block at %i in index file %s. Aborting!
     err.number = 85341
     err.args = T25LEAFoffset:@fm:NEW.FILE
     process.status = -1
     RETURN TO EXIT.OUT:
  END
  * Convert number IDXOFF.VALUE to ascii
  CONVERTED.VALUE = STR(0,IDXOFFlength)
  type = IF NODE = UNIXlnode THEN 0 ELSE 1 ; * UNIX or XINU
  spot = 1
  FOR p = 4 TO 1 STEP -1
     temp = INT(IDXOFF.VALUE/POWER(p))
     IF type = 0 THEN
        CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE,spot,1,BYTE(temp))
        spot += 1
     END ELSE
        CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE,spot+(p-1),1,BYTE(temp))
     END
     IDXOFF.VALUE -= (temp*POWER(p))
  NEXT p
  * Seek to IDXoff
  SEEK TMPfile, IDXOFFoffset, 0 ELSE
     * Unable to seq in %s
     err.number = 85310
     err.args = NEW.FILE
     process.status = -1
     RETURN TO EXIT.OUT:
  END
  * Write value
  WRITEBLK CONVERTED.VALUE ON TMPfile ELSE
     * Error updating IDXOFF value in file header block!
     err.number = 32111
     err.args = ""
     process.status = -1
     RETURN TO EXIT.OUT:
  END

  * If this is a SQL I-type index:
  IF IDXtype<IDXcnt> = "I" AND SQLITYP.INDEX THEN
	  * Retrieve index map information from dictionary.
     TMPval = TRIMB(DICT.TEXT(NEWcnt)<10>)
	  * How many table columns are part of this index?
     IDX.COLS = DCOUNT(TMPval, @VM)
     IDX.MAP = 0
	  * Index map is a 32 bit value with two bits used to represent each col.
	  * working right to left.
     FOR I = IDX.COLS TO 1 STEP -1
        IDX.MAP = (IDX.MAP * 4) + TMPval<1,I>
     NEXT I
	  * Convert to a format appropriate for WRITEBLK.
     CONVERTED.VALUE = STR(0,(2*SQLIDXlength))
     IF type = 0 THEN
        CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE, 1, 3, STR(BYTE(0),3))
        CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE, 4, 1, BYTE(IDX.COLS))
     END ELSE
        CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE, 2, 3, STR(BYTE(0),3))
        CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE, 1, 1, BYTE(IDX.COLS))
     END
     spot = 5
     FOR p = 4 TO 1 STEP -1
	     temp = INT(IDX.MAP/POWER(p))
        IF type = 0 THEN
           CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE,spot,1,BYTE(temp))
           spot += 1
        END ELSE
           CONVERTED.VALUE = BYTEreplace(CONVERTED.VALUE,spot+(p-1),1,BYTE(temp))
        END
        IDX.MAP -= (temp*POWER(p))
     NEXT p
     SEEK TMPfile, SQLIDXoffset, 0 ELSE
        * Unable to seq in %s
        err.number = 85310
        err.args = NEW.FILE
        process.status = -1
        RETURN TO EXIT.OUT:
     END
     WRITEBLK CONVERTED.VALUE ON TMPfile ELSE
        * Error updating SQLIDXMAP value on file header block!
        err.number = 32113
        err.args = ""
        process.status = -1
        RETURN TO EXIT.OUT:
     END
  END
  * Close
  CLOSESEQ TMPfile
  RETURN
!
* End of code
!
END