*DECK DLSYNTX 
PROC DLSYNTX
*CALL SCSYNCOM
+ 
                    THE FOLLOWING LIST ARE TERMS REFERENCED IN THE
                    LIST OF ROUTINES
                    AREAHEAD: FIRST ENTRY OF THE AREA CHAIN IN THE
                              SYMBOL TABLE
                    AREALIST: LAST ENTRY ON THE AREA CHAIN
                    ANAMECOUNT:  CONTAINS A COUNT OF ALL THE AREA NAMES 
                    APTR:     CONTAINS THE LOCATION OF THE AREA 
                              HEADER WORD 
                    BBPLOC:   BEGINNING BIT POSITION FOR DBI"S
                    PBPTR:    POINTS TO THE NEXT AVAILABLE LOCATION 
                              IN THE PRIVACY LOCK BUFFER
                    PLB:      PRIVACY LOCK BUFFER 
                    CURWORDADOR:  CONTAINS THE NEXT AVAILABLE WORD
                                  ADDRESS AT WHICH TO WRITE A DIRECTORY 
                                  ENTRY 
                    CHKPTR:   POINTS TO FIRST WORD OF THE CHECK CLAUSE
                              WORD IN THE DIRBUILD ARRAY. 
                    DBI:      DATA BASE IDENTIFIER
                    DBN:      DATA BASE NAME
                    DBP:      DATA BASE PROCEDURE 
                    DPTR:     POINTS TO THE NEXT AVAILABLE WORD IN
                              THE DIRBUILD ARRAY. 
                    DIRBUILD:  THE ARRAY IN WHICH ENTRIES TO THE
                               DIRECTORY ARE BUILT PRIOR TO WRITING 
                               THEM OUT.
                    HASHTABLE:  THE ARRAY CONTAINING THE LOCATIONS
                                OF ENTRIES IN THE SYMBOL TABLE. 
                    IPTR:     POINTS TO HEADER WORD OF AN ITEM DESCRIPTI
                              IN DIRBUILD 
                    ITEMHEAD: FIRST ENTRY OF THE ITEM CHAIN IN THE
                              SYMBOL TABLE. 
                    ITEMLAST:  LAST ENTRY ON THE ITEM CHAIN 
                    LASTWORDADOR:  THE WORD ADDRESS OF THE HEADER 
                                   WORD FOR THE ENTRY WRITTEN TO
                                   THE DIRECTORY. 
                    LOCKTYPE: CONTAINS A VALUE INDICATING THE TYPE
                              OF PRIVACY LOCK; LITERAL, 
                              OF PRIVACY LOCK;LITERAL,PROCEDURE,OR
                              LOCK-NAME.
                    LPTR:     POINTS TO FIRST WORD FOR THE LOCATION 
                              MODE CLAUSE IN DIRBUILD.
                    MPTR:     POINTS TO FIRST WORD OF THE SET MEMBER
                              SUB-ENTRY 
                    NAMETYPE:  CONTAINS A VALUE INDICATING THE
                               TYPE OF NAME; AREA,SET,RECORD OR ITEM. 
                    NEXTCELL:  CONTAINS THE LOCATION OF THE NEXT
                               AVAILABLE CELL IN THE SYMBOL TABLE 
                    OMPTR:    POINTS TO THE FIRST WORD FOR THE
                              ON MEMBERS CLAUSE IN DIRBUILD.
                    ONPTR:    POINTS TO THE FIRST WORD FOR THE
                              ON... CALL CLAUSE IN DIRBUILD 
                    PLPTR:    PROCEDURE LIST POINTER
                    PRIPTR:   PRIOR ENTRY LOCATION IN THE SYMBOL TABLE
                    PRIVKIND:  CONTAINS THE CURRENT SYNTACTIC TYPE
                               FOR PRIVACY LOCKS; LITERAL,OBP,LOCK-NAME.
                    PRIVPTR:  POINTS TO PRIVACY LIST HEADER IN DIRBUILD 
                    RECSYM:   CONTAINS THE SYMBOL TABLE LOCATION OF 
                              A RECORD ENTRY. 
                    RECORDHEAD:  LOCATION IN THE SYMBOL TABLE OF
                                 THE FIRST RECORD ON THE RECORD CHAIN.
                    RECORDLAST:  LOCATION OF LAST RECORD ON THE CHAIN 
                    RPTR:     POINTS TO THE HEADER WORD OF A RECORD 
                              DESCRIPTION ENTRY IN DIRBUILD 
                    REFDEF:   A FLAG THAT INDICATES TO THE HASH 
                              ROUTINE THAT THE SOURCE WORD IS EITHER
                              BEING DEFINED OR REFERENCED.
                    RSYMPTR:  POINTS TO A RECORD ENTRY IN THE SYMBOL
                              TABLE 
                    SELPTR:   POINTS TO THE HEADER WORD OF A SET
                              SELECTION ENTRY IN DIRBUILD 
                    SPTR:     POINTS TO THE HEADER WORD OF A SET
                              ENTRY IN DIRBUILD 
                    SRCLINE:  CONTAINS THE BINARY VALUE FOR THE 
                              SOURCE LINE NUMBER OF THE SOURCE CARD 
                              BEING SCANNED.
                    SYMBUFIN:  THE INPUT WORK AREA INTO WHICH SYMBOL
                               TABLE ENTRIES ARE READ.
                    SYMBUFOUT:  THE OUTPUT WORK AREA IN WHICH SYMBOL
                                TABLE ENTRIES ARE BUILT AND WRITTEN 
                                TO THE SYMBOL TABLE.
                    SYMENTRY:  POINTS TO A SYMBOL TABLE ENTRY 
                               THAT IS BEING DEFINED. 
                    SYMPTR:   POINTS TO A SYMBOL TABLE ENTRY
                              THAT IS BEING REFERENCED. 
                    WPTR:     A WORK POINTER IN DIRBUILD
ABORT               TERMINATES THE DDL COMPILATION
ACHECKBA
ANAMETEST           TEST THE ANAME FLAG  =  0  STDNO
                                         "  0  STDYES 
AINIT               INITIALIZES THE DIRECTORY DESCRIPTION ARRAY 
                    TO ZERO AND SETS THE DIRECTORY DESCRIPTION
                    SUBSCRIPT (OPTR) AND AREA INFO POINTER (APTR) 
                    TO ZERO.  STDNO 
ARACPTR             STORES OFFSET POINTER TO THE ACCESS-CONTROL ENTRY.
                    INITIALIZES FLAGS AND ACCESS-CONTROL POINTER. 
                    RETURN IS TO STDYES.
ARACUPDATE          CHECKS ACCESS-CONTROL UPDATE FLAG. IF SET,RETURNS 
                    TO STDNO.ELSE,STORES UPDATE BITS IN ACCESS-CONTROL
                    ENTRY, AND RETURNS TO STDYES. 
ARACRETRVL          CHECKS ACCESS-CONTROL RETRIEVAL FLAG. IF SET,RETURNS
                    TO STDNO. ELSE,STORES UPDATE BITS IN ACCESS-CONTROL 
                    ENTRY, AND RETURNS TO STDYES. 
ARACCKUPRT          CHECKS IF EITHER UPDATE OR RETRIEVAL FLAGS SET. IF
                    NOT, SETS BOTH FLAGS AND ASSOCIATED BITS IN THE 
                    ACCESS-CONTROL ENTRY. RETURN IS TO STDNO. 
ARNAME              ARNAME IS HASHED TO THE SYMBOL TABLE IF IT IS 
                    NOT UNIQUE RETURN IS TO STDNO. ELSE THE NAME
                    IS STORED INTO THE SYMBOL TABLE AND IN THE
                    AREA NAME AT OPTR. CURLENW IS STORED IN THE 
                    AREA NAME LENGTH AT APTR. OPTR IS INCREMENTED 
                    BY CURLENW. STDYES
ARNEXTON            SETS NEXT ON TO 1 AT DPTR-1 RETURNS STDNO 
ARONCALLBA
ARONCALLUPRT        SETS UPDATE/RETRIEVAL BITS IN THE AREA CALL ENTRY.
                    RETURN IS TO STDNO. 
ARONLISTPTR         SET AREA ON...CALL LIST PTR. STDNO
ARONOPTION          IF THE TEMPORARY BIT IS SET AT APTR RETURN STDNO. 
                    ELSE OR CURP1 IN TO THE ON CALL OPTIONS AT DPTR.
                    STDYES
ARONPROC            IF THE DATA BASE PROCEDURE (DBP) IS NOT A VALID 
                    PROCEDURE NAME THEN INCREMENT DPTR BY 1 AND 
                    RETURN STDNO. 
                    ELSE STORE THE DBP AT OPTR, INCREMENT DPTR AND
                    RETURN STDYES.
ARPUT               STORE THE NEXT 6RM WORD ADDRESS INTO THE SYMBOL 
                    TABLE ENTRY FOR THIS AREA NAME. USING DPTR-1
                    AS THE LENGTH ISSUE A 6RM WRITE TO THE DIRECTORY
                    INCREMENT THE 6RM WORD ADDRESS BY THE LENGTH. 
                    STDNO.
ARTESTRTRN          TESTS TO DETERMINE IF ANY AREA CLAUSES WERE 
                    SPECIFIED. IF THE FIRST AND SECOND WORDS
                    APTR AND APTR+1 ARE NOT ZERO. = 0 STDNO 
                                                  " 0 STDYES
CHECKDBP            IF DBP IS NOT A VALID PROCEDURE NAME RETURN STDNO 
                    ELSE STORE DBP AT DPTR, SET PLPTR TO DPTR, SET
                    THE DBP POINTER AT CHKPTR TO (DPTR - CHKPTR)
                    SET THE CHECK OPTION BIT AT SYMENTRY + 2. 
                    INCREMENT DPTR BY 1. STDYES 
CHECKISPIC          SET THE PICTURE BIT AT CHKPTR.
                    SET THE CHECK OPTION AT SYMENTRY +2. STDNO. 
CHECKLIT1           CONVERTS LITERAL IN CURWORD TO ITEM TYPE
                    STDNO IF CONVERSION NOT POSSIBLE, ELSE STDYES 
CHECKLIT2           IF LIT1 IS GREATER THAN LIT2 RETURN STDNO.
CHECKRTRN           IF THE CHECK OPTION AT SYMENTRY +2 IS ZERO
                    RETURN STDNO. ELSE STDYES.
                    IF YES RETURN, MOVE LITERALS FROM TABLE TO
                    ITEM ENTRY
CHECKSPEC           SET CHKPTR TO DPTR. SET IN ITEM AT
                    (IPTR)+3 THE CHECKLIST POINTER (DPTR - IPTR)
                    INCREMENT DPTR BY 1. SET AT SYMENTRY +2 THE CHECK 
                    BIT STDNO 
CHECKTHRU           SETS RANGE BIT FOR LITERAL JUST STORED
CHKCHK              CHECK,
CHKCLR              CLEAR, AND
CHKSET              SET THE FLAG THAT 
                        INDICATES A SUB PART OF CHECK 
                        CLAUSE HAS BEEN FOUND IN THIS PASS
                        THRU CHECK CLAUSE LOOP. 
CHKDCTL             CHECK FOR NEXTWORD = CONTROL
CHKUNQPROC          CHECK ONLY ONE PROC NAME FOR CHECK CLAUSE 
CKPIC 
CODEALWAYS          SET THE ALWAYS BIT IN THE ENCODING WORD AT DPTR.
                    STDNO 
CODEDBP             IF THE DBF IS NOT A VALID PROCEDURE NAME RETURN 
                    STDNO. ELSE STORE THE PROCEDURE NAME AT DPTR
                    IF ENCFLAG IS SET THEN SET THE NEXT BIT AT
                    DPTR - 1. INCREMENT DPTR BY 1 RETURN STDYES.
CODEOPT             STORES CURP1 INTO THE ENC/DEC BIT AT DPTR 
                    INCREMENT ENCFLAG BY 1. 
                    IF ENCFLAG IS GREATER THAN 1 THEN SET THE NEXT BIT A
                    ENCODING LIST POINTER, (DPTR - IPTR). RETURN
                    STDNO 
DINIT               ZEROS OUT THE DIRECTORY AREA FOR PROCESSING 
                    THE ITEMS ASSOCIATED WITH THE PREVIOUS RECORD 
                    SETS IPTR TO DPTR. ADD 3 TO DPTR. STDNO 
DPUTITEM            CALCULATES BEGINNING WORD POSITION, BIT POSITION
                    AND LENGTH. SET PRIOR POINTER AT IPTR +3
                    TO IPTR - PRIPTR. SET NEXT POINTER OF PRIOR 
                    ITEM TO IPTR - PRIPTR. SET PRIPTR TO IPTR.
                    SET IPTR TO DPTR
GETANAMELOC 
HASHITDA            SET NAMETYPE TO AREA AND REFDET TO DEFINED CALL HASH
HASHITDR            SET NAMETYPE TO RECORD AND REFDEF TO DEFINED CALL HA
HASHITDI            SET NAMETYPE TO ITEM AND REFDEF TO DEFINED CALL HASH
HASHITRA            SET NAMETYPE TO AREA AND REFDEF TO REFER. CALL HASHI
HASHITRR            SET NAMETYPE TO RECORD AND REFDEF TO REFER. CALL HAS
HASHITRI            SET NAMETYPE TO ITEM AND REFDEF TO REFER. CALL HASHI
ICHECKBA
INCRDPTR            ADDS 1 TO DPTR. STDNO 
INCRDPTRA           INCREMENTS DPTR BY 1. CALLED FROM AREA ENTRY. 
LOADDCT              LOAD DATA CONTROL OVERLAY
NOLEV               SETS LFLAG AND DEFAULTS LEVEL NUMBER TO ONE 
                    IF NO LEVEL NUMBER SPECIFIED.RETURN STDYES. 
NUMTYPE             COMPARES KEYWORD WITH PREDECESSORS, IF INVALID, 
                    RETURNS TO STDNO, ELSE, SETS DATA CLASS AND SIZE. 
                    RETURN IS TO STDYES.
OCCURSINT           CHECKS TO SEE IF THE INTEGER VALUE IN CURWORD 
                    IS GREATER THAN ZERO IF SO STDNO. ELSE THE
                    INTEGER VALUE IS STORED IN IPTR +1. SET AT
                    SYMENTRY +2 THE OCCURS BIT. STDYES. 
OCCURSNAME          HASH THE DBN TO THE SYMBOL TABLE IF THE NAME
                    IS NOT THERE OR UNDEFINED RETURN STDNO. ELSE
                    STORE THE POINTER AT SYMPTR +2 INTO DEPENDING 
                    ON NAME LOCATION AT IPTR +1, SET THE OCCURS 
                    BIT IN SYMPTR +2, AND SET THE DEPENDING ON BIT
                    AT IPTR +1. STDYES. 
ONITEMBA
ONITEMDBP           IF THE DBP IS NOT A VALID PROCEDURE NAME RETURN 
                    STDNO. ELSE STORE THE NAME IN CURWORD AT DPTR.
                    STDYES. 
ONINIT              ADD 1 TO ONCOUNT IF IT IS GREATER THAN 1
                    THEN SET THE NEXTON BIT AT ONPTR, 
                    SET 
                    ONPTR TO DPTR. SET THE ON BIT AT SYMENTRY. STDNO
ONITEMEND           SET ONCOUNT TO ZERO. AND IF THE DBI POINTER 
                    BIT POSITION IS NOT A ZERO ADD 1 TO DPTR. 
                    STDNO 
ONITEMOPT           CURP2 IS OR"ED INTO THE ON OPTIONS AT ONPTR.
                    STDNO 
ONITEMDFLT          ALL OF THE ON OPTIONS ARE TURNED ON AT ONPTR
                    STDNO.
PICTURE 
PICTYPCHECK         CHECKS TO SEE IF TYPE WAS PREVIOUSLY SPECIFIED, IF  000380
                    IT WAS THEN WE SHOULD NOT STORE ( CRACK) PICTURE    000390
                    AND RETURNS TO STDNO. IF THIS IS  FIRST TYPE OR     000400
                    PICTURE  CLAUSE, RETURNS TO STDYES TO CRACK PICTURE.000410
                    STDNO 
QUALDEFAULT         SET DEFAULT QUALIFIER TO CURRENT RECORD 
RCHECKBA
RECNAMEQUAL         STORES THE RECORD NAME IN CURWORD INTO RECQUAL. 
                    AND STORES THE REC POINTER INTO THE SYMENTRY FOR
                    THE ITEM. 
                    STDNO 
RESPNAME            IF THE DBP IS NOT A VALID PROCEDURE NAME RETURN 
                    STDNO. ELSE SET RSLTPTR TO DPTR SET THE 
                    RESULT/SOURCE POINTER AT IPTR +2 TO (DPTR - IPTR) 
                    STORE ACTVIR (SET BE SAVFAV) INTO THE 
                    ACTUAL/VIRTUAL BIT AT PSLTPTR. STORE THE DBP
                    IN CURWORD INTO THE RESULT LIST HEADER. ADD 
                    1 TO DPTR. SET THE RESULT BIT AT SYMENTRY +2. 
                    SET EITHER THE ACTUAL OR VIRTUAL BIT AT 
                    SYMENTRY +2, DEPENDING ON ACTVIR. STDYES
RINIT               INITIALIZES ALL SWITCHES AND DIRECTORY AREA 
                    FOR PROCESSING A RECORD DESCRIPTION.
                    SET ANAMECOUNT AND ONCOUNT TO ZERO. SET THE NEXT
                    POINTER FOR THE LAST RECORD.
                    RPTR IS SET TO ZERO, AND DPTR IS SET TO 2.
RNAME               THE RECORD NAME IS HASHED TO THE SYMBOL TABLE,
                    AND IF THERE IS A DEFINED ENTRY RETURN IS TO
                    STDNO. ELSE CURLENW IS STORED IN NAME LENGTH
                    AT RPTR +1, AN CURWORD IS STORED AT DPTR. 
                    STORE THE SYMBOL TABLE LOCATION IN RECSYM.
                    DPTR IS INCREMENTED BY CURLENW. STDYES. 
RONCALLBA 
RONCALLINIT         ADD 1 TO ONCOUNT IF IT IS GREATER THAN 1 SET
                    NEXTON BIT AT DPTR TO 1, ELSE SET THE ON LIST 
                    POINTER AT RPTR TO (DPTR - RPTR). ADD 1 TO DPTR.
                    STDNO.
RONCALLEND          SET ONCOUNT TO ZERO. STDNO
RONCALLOPT          CURP1 IS OR"ED INTO THE ON CALL OPTIONS AT DPTR.
                    STDNO.
RPUT                WRITES OUT TO THE DIRECTORY THE RECORD INFO AND 
                    ALL OF THE ASSOCIATED ITEM DESCRIPTIONS.
RTESTNAME           TESTS THE NAME LENGTH FIELD AT RPTR +1 IF IT
                    IS ZERO RETURN STDNO ELSE STDYES
SAVEAV              STORES CURP1 INTO ACTVIR. TEST SYMENTRY +2 FOR
                    ACTUAL OR VIRTUAL BITS AND IF ON RETURN STDNO 
                    ELSE STDYES.
SAVNAME 
SCACSETB            COMPUTES THE BUFFER SIZE TO BE ALLOCATED FOR
                    STORAGE OF ACCESS-CONTROL LITERALS AND DBPS.
                    RETURN IS TO STDNO. 
SCACLIT             CHECK LITERAL LENGTH. IF LENGTH GRETER THAN 30
                    CHARACTERS,TRUNCATE LENGTH AND ISSUE DIAGNOSTIC.
                    STORE LOCK TYPE IN ACCESS-CONTROL ENTRY. RETURN 
                    IS TO STDNO.
SCACLOCKS           STORE LITERAL/DBP IN BUFFER. CHECK BUFFER OVERFLOW. 
                    STORE HEADER DESCRIPTOR FOR LITERAL/DBP IN ACCESS-
                    CONTROL ENTRY. RETURN IS TO STDNO.
SCACPROC            STORE HEADER DESCRIPTOR IN ACCESS-CONTROL ENTRY.
                    CHECK DBP NAME LENGTH. IF LENGTH GREATER THAN 7 
                    CHARACTERS,TRUNCATE LENGTH AND ISSUE DIAGNOSTIC.
                    RETURN IS TO STDNO. 
SCACSTOR            STORE OFFSET POINTER TO THE START OF LITERALS/DBPS
                    IN THE ACCESS-CONTROL ENTRY. MOVE LITERALS FROM 
                    LITERAL/DBP BUFFER TO THEIR APPROPRIATE POSITIONS 
                    IN THE ACCESS-CONTROL ENTRY. RETURN IS TO STDNO.
SCACNEXT            STORES THE NEXT ACCESS-CONTROL ENTRY POINTER IN 
                    THE PREVIOUS ACCESS-CONTROL ENTRY. INITIALIZES
                    ACCESS-CONTROL POINTER. RETURN IS TO STDNO. 
SCNAME              CURWORD IS STORED AT DPTR SET SPTR TO DPTR. 
                    STORE CURLENW IN NAME LENGTH AT SPTR. ADD 
                    CURLENW TO DPTR. STDNO
SCPUT               WRITES OUT THE SCHEMA INFO TO THE DIRECTORY 
SETCHAR 
SETSERT             SETS UP CALL TO ROUTINE TO COMPUTE SUB-ENTRY
                    LENGTH. RETURN IS TO STDNO. 
SETVALUE                                                                003130
STODNAME            SET THE 
                    DEFINED FLAG. STORE THE CURWORD BEGINNING 
                    AT DPTR. SET THE NAME LENGTH FIELD AT IPTR +1 
                    ADD CURLENW TO DPTR. STDNO. 
STORDCHARL
STORINT 
STORINTP
STORONPROC          IF THE DBP IS NOT A VALID PROC NAME RETURN
                    STDNO. ELSE STORE CURWORD AT DPTR. STDYES 
TSTAGGREG           IF THE OCCURS BIT IS ON AT SYMENTRY +2 RETURN 
                    STDNO, ELSE STDYES
TSTCODEPIC          IF BOTH THE TYPE AND PIC BITS ARE OFF AT SYMENTRY 
                    THEN RETURN STDNO ELSE STDYES 
TSTCODERSLT         IF BOTH THE ACTUAL AND VIRTUAL BITS ARE SET AT      000300
                    SYMENTRY RETURN STDNO ELSE STDYES.
TSTDUPNOTALL        IF AT OWNPTR THE DUP NOT ALLOWED BIT IS OFF 
                    AND THE CALL BIT IS ON RETURN STDNO. ELSE STDYES
TSTITEM             TEST FOR TYPE, PICTURE, OR OCCURS CLAUSES.
                    STDNO IF NONE OF THEM, ELSE STDYES. 
TSTLEVEL            CHECKS FOR VALID LEVEL NUMBER. IF NOT 
                    ISSUES DIAGNOSTIC. AFTER CHECK, GOES TO 
                    TSTMDOM ROUTINE TO SET DOMINANT POINTERS. 
                    RETURN IS TO STDNO IF DIAGNOSTIC FLAG(DFLAG)
                    IS SET, OTHERWISE STDYES. 
TSTOCCDBI1          CHECKS TO SEE IF DEPENDING ON ITEM IS AN ELEMENTARY 
                    ITEM. ALSO IT SHOULD NOT BE DEFINED WITH EITHER 
                    DECIMAL POINT(ACTUAL OR ASSUMED) OR SIGN.IF THE ITEM
                    IS SO DEFINED RETURN IS STDNO. ELSE RETURN IS STDYES
                    IT ALSO SETS THE MAX. VALUE FOR VARIABLE DIMENSION
                    REPEATING GROUP AND THE ORDINAL NUMBER OF THE DEP-
                    ENDING ON ITEM. 
TSTOCCDBI2          CHECKS TO SEE IF THE CHECK VALUE CLAUSE HAS BEEN
                    SPECIFIED FOR THE DEPENDING ON ITEM. IF SO RETURN 
                    STDYES. ELSE RETURN STDNO.
TSTOCCDBI3          CHEKS TO SEE IF DEPENDING ON ITEM IS A PART OF A
                    REPEATING GROUP OF VARIABLE DIMENSION. IF SO RETURN 
                    IS TO STDNO. ELSE RETURN IS TO STDYES.
TSTOCCDBI4          SYMPTR IS POINTING TO THE SYMBOL TABLE ENTRY FOR
                    THE DEPENDING ON ITEM. IF THE VIRTUAL AN RESULT BITS
                    ARE SET RETURN STDNO,ELSE STDYES. 
TSTOCCDBI5          CHECKS TO SEE IF SUBJECT ITEM IS A PART OF A REPEAT-
                    ING GROUP OF VARIABLE DIMENSION. IF SO RETURN IS TO 
                    STDNO. ELSE RETURN STDYES.
TSTOCCURS1          IF AT SYMENTRY IN THE SYMBOL TABLE THE RESULT 
                    OR SOURCE BITS ARE SET RETURN STDNO ELSE STDYES 
TSTRONOPT           IF NO OPTIONS WERE SPECIFIED ALL OPTIONS ARE SET
                    STDNO.
TSTUNIQUEDBN        IF AT RECPTR IN THE SYMBOL TABLE THE DBN AND DIRECT 
                    BITS ARE SET GET THE DBN POINTER AND CHECK
                    IF IT IS UNIQUE. IF SO STDYES, ELSE STDNO 
TSTVALIDOCC         CHECKS IF NO PROCEDURE CLAUSES( ENC/DEC, CHECK, 
                    CALL ) ARE NOT SPECIFIED AT THE GROUP LEVEL.
TSTVIRTRES          CHECK IF ENCODING/DECODING OR CALL CLAUSES
                    SPECIFIED WITH THE VIRTUAL RESULT CLAUSE. IF
                    SO, RETURN STDNO. 
TYPEEND             CHECKS FOR COMPLETE TYPE OPTION, NO, RETURN STDNO.
                    IF OK SET CLASS IN SCHEMA AND RETURN TO STDYES. 
VALIDAR             CHECK IF AREA NAME IS VALID 
VALIDINT            CONVERTS CURWORD TO BINARY AND STORES IT IN 
                    LEVEL.
VALUENOT            SETS FLAG INDICATING *NOT* IN CHECK CLAUSE SPECIFIED
+ 
:START:03   +EOT   05 
        /   D101   *ABORT 
          :05   SCHEMA  D100  *ABORT
      :10   AREA
            RECORD
            DATA   25 
        /   10
      :25   +EOT   30 
        /   *ANAMETEST   D222 
        /  *LOADDCT 
       :30   SKIPF  10
:DATA  :05  $DATA   NO
         /  *CHKDCTL    D105    SKIPF     NO
         /  *LOADDCT
:SCHEMA:05   $SCHEMA   NO 
        /   -NAME 
            -IS 
            +NAME   D102   +SNC   NO
        /   *SCNAME 
      :70   *SCPUT                                                      002900
            $.   D108 
        /   YES 
:AREA :05   *AINIT
            ARNAME   NO 
      :10   ARCALL
            ARACINIT   30 
        /   10                                                          000320
      :30   *ARTESTRTRN   NO
        /  *ARPUT 
            $.   D108 
        /   YES 
:RECORD:05   *RINIT 
            RNAME   NO
       :10  WITHIN    SKIPF    15 
         /  RONCALL    SKIPF    15
         /  $.    D108
       :15  *RTESTNAME    D161
         /  DATAITEM    25
        /   *TSTUNIQUEDBN   D238
      :25   *RPUT     D121
      :30   YES                                                         000250
:ARNAME:05   $AREA   NO 
        /   -NAME 
            -IS 
            +NAME            D129      NO                               000170
        /   *HASHITDA 
        /   *ARNAME   D112
        /  *VALIDAR  D129 
        /   YES 
:ARCALL:05  $CALL   NO                                                  000410
        /   *ARONLISTPTR                                                000420
      :07   +NAME   D119  +SNC   05                                     000430
        /   *ARONPROC     D144                                          000440
      :10   $BEFORE                                                     000450
            $AFTER                                                      000460
            -ON                                                         000470
            $ERROR                                                      000480
            15                                                          000490
        /   -DURING                                                     000500
            *ARONCALLBA  10 
      :15   *ACHECKBA        D187                                       000520
      :20   $OPEN    40 
        /   *ARONOPTION 
      :25   -FOR
            $UPDATE    30 
        /   *ARONCALLUPRT 
      :30   $RETRIEVAL    40
        /   *ARONCALLUPRT 
      :35   $UPDATE    40 
        /   *ARONCALLUPRT 
      :40   $CLOSE    50
        /   *ARONOPTION 
      :50   *INCRDPTRA
            $CALL    *SETSERT    YES
        /   *ARNEXTON                                                   000700
            07                                                          000710
:ARACINIT :05   $ACCESS-CONTROL   NO
        /   *ARACPTR   D264   NO
        /   SCACCTRL
        /   YES 
:RNAME:05   $RECORD   NO
        /   -NAME 
            -IS 
            +NAME             D106  SKIPF  YES
        /   *HASHITDR 
        /   *RNAME   D120 
        /   YES 
:WITHIN:05   $WITHIN   NO 
         /  +NAME    D126    NO 
      :10   *HASHITRA                                                   000120
            *GETANAMELOC   D127 
         /  YES 
:RONCALL :05  $CALL    YES
       :10  *RONCALLINIT
       :15  +NAME    D119    NO 
        /   *STORONPROC      D144                                       000840
      :20   $BEFORE                                                     000850
            $AFTER                                                      000860
            -ON                                                         000870
            $ERROR                                                      000880
            25                                                          000890
        /   -DURING                                                     000900
            *RONCALLBA       20                                         000910
      :25   *RCHECKBA        D187                                       000920
      :30   $STORE                  # INSERT LATER INSERT AND REMOVE   #000930
            $DELETE                                                     000960
            $MODIFY                                                     000970
            $FIND                                                       000980
            $GET                                                        000990
            35
        /   *RONCALLOPT                                                 001010
            30                                                          001020
      :35   *TSTRONOPT                                                  001030
      :40   $CALL                                                       001040
            *RONCALLEND                                                 001050
            *SETSERT
            YES                                                         001060
        /   10                                                          001070
  
                                   #-------DATA DESCRIPTION ENTRY------#
  
:DATAITEM:05   *DINIT              # SET ITEM ENTRY POINTERS           #
  
       :10  LEVEL        YES       # PROCESS LEVEL NUMBER-WRITE RECORD #
         /  DBDATANAME   SKIPF     # HASH AND STORE ITEM NAME          #
            95                     # ON ERROR SKIP ENTRY               #
  
       :20  $PICTURE     30        #      -PICTURE DESCRIPTION         #
         /  PICTURE      20 
  
       :30  $TYPE        40        #       -TYPE DESCRIPTION-          #
         /  TYPE         SKIPND 
            95
         /  20
  
       :40  $OCCURS      50        #      -OCCURS DESCRIPTION-         #
         /  OCCURS       SKIPF
            95
         /  20
  
       :50  -IS                    #       -RESULT DESCRIPTION-        #
            $ACTUAL 
            $VIRTUAL     60 
         /  RESORCE      SKIPF
            95
         /  20
  
       :60  $CHECK       70        #       -CHECK DESCRIPTION-         #
         /  CHECK        SKIPF
            95
         /  20
  
       :70  $CALL        80        #   -PROCEDURE CALL DESCRIPTION-    #
         /  ICALL        SKIPF
            95
         /  20
  
       :80  -FOR                   #       -CODE DESCRIPTION-          #
            $ENCODING 
            $DECODING    90 
         /  CODE         SKIPF
            95
         /  20
  
       :90  $.           NOTERM    # CHECK FOR LINE TERMINATOR         #
       :95  *TSTITEM     D298      # TYPE, PIC, OCCURS UNSPECIFIED     #
         /  *TSTLEVEL   D173
         /  *DPUTITEM 
         /  *TSTVIRTRES    D166 
       /    *TSTCODEPIC   D239
       /    *TSTCODERSLT   D240 
        /   *TSTOCCURS1   D246
         /   *TSTOCCDBI5   D250 
         /  *TSTVALIDOCC
         /  10                     # LOOP TO NEXT LEVEL NUMBER         #
  
:NOTERM:05  *TSTITEM    10         #--------SKIP TO TERMINATOR---------#
            D108                   # NO DESCRIPTION-ASSUME INVALID WORD#
       :10  SKIPF       YES 
  
  
:LEVEL:05   +INT         15        #----------LEVEL NUMBER CHECK-------#
       :10  *VALIDINT   YES 
       :15  *NOLEV   NO 
        /   +EOT   10 
         /  *RPUT    D121 
        /   *ANAMETEST   D222 
        /   *LOADDCT
:DBDATANAME:05  +NAME   NO
        /  *HASHITDI
         /   *STODNAME   D238 
       /   YES
  
:PICTURE:10 -IS                    #------------PICTURE CLAUSE---------#
            +LIT         D201      # PICTURE SPEC MUST HAVE QUOTES     #
            NO
         /  *PICTYPCHECK D138      # TYPE OVERRIDES PICTURE            #
         /  *PICTURE
         /  NO
  
:TYPE:05    *CKPIC       D138      #------------TYPE CLAUSE------------#
         /  -IS 
       :10  $CHARACTER   20        # CHARACTER OPTION                  #
         /  *SETCHAR
            +INT         40 
         /  *STORDCHARL  40 
       :20  $DECIMAL               # NUMERIC OPTION                    #
            $COMPLEX
            $FIXED
            $FLOAT
            $CHARACTER
            $REAL        30 
         /  *NUMTYPE     D346      # INVALID TYPE CLAUSE               #
            NO
         /  20
       :30  +INT         40 
         /  *STORINT     D323      # INTEGER-1 INVALID                 #
         /  +INT         40 
         /  *STORINTP    D237      # INTEGER-2 INVALID                 #
       :40  *TYPEEND     D346      # CHECK FOR COMPLETE CLAUSE         #
            NO
         /  YES 
  
:OCCURS:05  +INT         10        #-----------OCCURS CLAUSE-----------#
        /   *OCCURSINT   D247 
        /  -TIMES 
            YES 
       :10  +NAME        D176      # INVALID NAME OR INTEGER           #
            NO
        /  *SAVNAME 
           $OF
           $IN      *QUALDEFAULT  15
         /  +NAME        D176      # INVALID NAME OR INTEGER           #
            NO
        /  *RECNAMEQUAL 
      :15  *HASHITRI
        /   *OCCURSNAME   D248     20 
         /   *TSTOCCDBI1   D249 
         /   *TSTOCCDBI2   D254 
         /   *TSTOCCDBI3   D255 
         /   *TSTOCCDBI4   D251 
       :20  -TIMES
            YES 
  
:RESORCE:05 *SAVEAV                #-------------RESULT CLAUSE---------#
            D141         10        # MULTIPLE RESULT CLAUSES           #
        /  *TSTAGGREG   D225
       :10  $RESULT    D165    NO 
        /   RESULT   YES
:RESULT:05  -OF 
            +NAME        D143      # PROCEDURE UNSPECIFIED             #
            NO
         /  *RESPNAME    D144      # INVALID NAME - NAME TRUNCATED     #
         /  NO
  
:CHECK:05   *CHECKSPEC   D297      #-----------CHECK CLAUSE------------#
        /   -IS 
      :07   *CHKCLR 
      :10  $PICTURE          20 
         /  *CHKSET 
            *CHECKISPIC     D232
      :20   +NAME            25                                         001890
         /  *CHKSET 
            *CHKUNQPROC     D232  25
        /   *CHECKDBP  D151                                             000110
      :25   $VALUE           35                                         001840
         /  *CHKSET 
            *SETVALUE       NO
         /  $NOT  30
        /   *VALUENOT                                                   001860
       :30  +LIT         D154      # 1ST LITERAL INVALID               #
            NO
         /  *CHECKLIT1        D231
         /  *CHECKLIT2      D236
      :31   $THRU            32                                         001873
         /  *CHECKTHRU
         /  +LIT         D156      # 2ND LITERAL INVALID               #
            NO
         /  *CHECKLIT1        D231
        /   *CHECKLIT2       D236                                       001876
       :32  +LIT     10 
         /  *CHECKLIT1        D231
        /   *CHECKLIT2       D236                                       001878
        /   31                                                          001879
       :35  *CHKCHK     36
         / 07 
       :36  *CHECKRTRN      D157
         /  *SETSERT
        /   YES 
  
CALL:10   *ONINIT                #-----------CALL CLAUSE-------------#
       :15  +NAME    D171    NO 
        /   *ONITEMDBP      D144                                        002360
      :20   $BEFORE                                                     002370
            $AFTER                                                      002380
            -ON                                                         002390
            $ERROR                                                      002400
            25                                                          002410
        /   -DURING                                                     002420
            *ONITEMBA       20                                          002430
      :25   *ICHECKBA       D187                                        002440
      :30   $STORE                                                      002450
            $GET                                                        002460
            $MODIFY                                                     002470
            *ONITEMDFLT                                                 000400
            35                                                          002480
        /   *ONITEMOPT                                                  002490
            30                                                          002500
      :35   $CALL                                                       002510
            *ONITEMEND                                                  002520
            *SETSERT
            YES                                                         002530
        /   *INCRDPTR                                                   000270
            10                                                          000280
  
:CODE:05    *CODEOPT               #------ENCODING/DECODING CLAUSE-----#
            $ALWAYS   10
        /   *CODEALWAYS 
      :10   $CALL        D162      # NO CALL IN ENCODING CLAUSE        #
            NO
         /  +NAME        D163      # NO ENCODING PROCEDURE             #
            NO
         /  *CODEDBP     D164      # PROCEDURE NAME TRUNCATED          #
         /  YES 
:SCACCTRL :10   -LOCK   -FOR
            *SCACSETB 
      :15   $UPDATE   20
        /   *ARACUPDATE   D265
      :20   $RETRIEVAL   30 
        /   *ARACRETRVL    D266 
      :25   $UPDATE   30
        /   *ARACUPDATE   D265
      :30   *ARACCKUPRT   -IS 
      :35   +CHARLIT   40 
        /   *SCACLIT   *SCACLOCKS   45
      :40   $PROCEDURE   D270 
        /   +NAME   D267   NO 
        /   *SCACPROC   *SCACLOCKS
      :45   $OR   50
        /   35
       :50  *SCACSTOR    *SETSERT 
      :55   $ACCESS-CONTROL   YES 
        /   *SCACNEXT 
            10
  
                                   #-----------SKIP ROUTINES-----------#
:SKIPF:05   D200         SKIPND    # ISSUE ERROR - SKIP TO PERIOD      #
            NO
:SKIPND:10  +EOT         15        # SKIP TO PERIOD - NO ERROR MESSAGE #
        /   *ANAMETEST   D222                                           000480
        /  *LOADDCT 
      :15   $.  +SNW  10
        /   D195   NO                                                   000510
END 
