*DECK DLSCHMA                                                           000100
USETEXT TSCXREF,TDLSCOM,TSCHTBL,TCKSCOM 
      PRGM DL30101;                # THIS IS 1,1 OVERLAY               # DL3A030
      BEGIN 
      DEF AREA$NAME #4#;                                                000130
      DEF COMPLEX #24#;      # COMPLEX KEYWORD CURP1 VALUE             #
      DEF DATA$NAME #5#;                                                000140
      DEF DECIMAL #25#;      # DECIMAL KEYWORD CURP1 VALUE             #
      DEF DEFINED #1#;                                                  000160
      DEF ENTRYPTR   #2#;                                               000180
      DEF FITLENGTH #35#;    # LENGTH OF AREA FIT IN DATA CONTROL ENT. #
      DEF FIXED #26#;        # FIXED KEYWORD CURP1 VALUE               #
      DEF FLOAT #27#;        # FLOAT KEYWORD CURP1 VALUE               #
      DEF TEMPTR # 2 #;                                                 000190
      DEF DIRPTR #4#; 
      DEF ITEM$NAME #1#;                                                000210
      DEF MAXAREAS #4095#;   # MAX. NO. OF AREAS AS IMPOSED BY CDCS 2  #
      DEF MAXRECDS #4095#;   # MAX. NO. OF RECORDS AS IMPOSED BY CDCS 2#
      DEF MAXITMS      #81870#;    # MAXIMUM NUMBER OF ITEMS IN RECORD #
      DEF MAXITEMSIZ #32767#;# MAXIMUM ITEM SIZE IN CHARACTERS         #
                             # - AS IMPOSED BY CDCS 2.                 #
      DEF MAXRITEMS #4095#;  # MAXIMUM ITEMS PER RECORD AS IMPOSED BY  #
                             # CDCS 2.                                 #
      DEF MAXRECENTLEN #2097151#; #MAX RECORD ENTRY LENGTH.            #
      DEF MAXITMENTLEN #262143#;  #MAXIMUM ITEM ENTRY LENGTH.          #
      DEF MAXRECSIZ    #81870#;    # MAXIMUM RECORD LENGTH IN CHARS    #
      DEF MINSUBENTLG #FITLENGTH#; # MIN SUB-ENTRY LENG = FIT LENGTH.  #
                             # NOTE: SUB-ENTRY LENGTHS FOR THE FOLLOW- #
                             # ING ARE NOT COMPUTED BECAUSE THEIR LENG.#
                             # WILL BE LESS THAN MINSUBENTLG:          #
                             #     ITEM ACTUAL/VIRTUAL RESULT SUB-ENT. #
                             #     ITEM ENCODE/DECODE SUB-ENT.         #
                             #     RELATION SEARCH TABLE ENTRY FOR     #
                             #   EACH RANK.                            #
      DEF REAL #28#;         # REAL KEYWORD CURP1 VALUE                #
      DEF RECORD$NAME  #2#;                                             000260
      DEF REFERENCED #0#;                                               000280
      DEF SET$NAME #3#;                                                 000290
  
      XDEF ITEM RECENTADDR;  # WORD ADDRESS OF THE RECORD WSA          #
      XDEF ITEM RECSIZE;     # CONTAINS THE RECORD SIZE IN CHARS       #
      XDEF
        ARRAY LEVELINFO [0:99] S(1);
          ITEM DOMGRP U(0,0,60);
  
  
      ITEM ACLITPTR;     # VARIABLE ACCESS-CONTROL LITERAL/DBP BUFFER  #
                         # POINTER.                                    #
      ITEM ACLITSTRT;    # FIRST WORD ADDRESS OF ACCESS-CONTROL        #
                         # LITERAL/DBP BUFFER.                         #
      ITEM ACRETRFG B;   # SET TO TRUE IF RETRIEVAL OPTION SPECIFIED   #
                         # IN THE ACCESS-CONTROL CLAUSE.               #
      ITEM ACUPDFG B;    # SET TO TRUE IF UPDATE OPTION SPECIFIED IN   #
                         # THE ACCESS-CONTROL CLAUSE.                  #
      ITEM ANAMEFLAG;                                                   000970
      ITEM ACTVIR;                                                      000980
      ITEM APTR;                                                        000990
      ITEM AREAPTR;      # POINTER TO AREA ENTRY #
      ITEM BITLENG;                                                     001050
      ITEM BITPOS;                                                      001060
      ITEM BITPOSBF;                                                    000860
      ITEM CHARFLAG B;   # CHARACTER TYPE KEYWORD FLAG                 #
      ITEM CKPTR;                                                       001080
      ITEM CLASS;                                                       001090
      ITEM CTEMP;                                                       001100
      ITEM CHARPTR;                                                     001110
      ITEM DFLAG;     #DIAGNOSTIC FLAG. SET IF INVALID LEVEL NOS. USED #
      ITEM CHKFLG B;
      ITEM CKLITPTR;
      ITEM CKLITSTART;
      ITEM CPLXFLAG B;   # COMPLEX TYPE KEYWORD FLAG                   #
      ITEM DECFLAG B;    # DECIMAL TYPE KEYWORD FLAG                   #
      ITEM DIRWA;                                                       001140
      ITEM ENCFLAG;                                                     001190
      ITEM ENTTYPE;   #INTEGER VALUE OF ENTRY TYPE IN ITEM SUBENTRY    #
      ITEM EXCKPTR; 
      ITEM EXCKSTART; 
      ITEM EXPCNT;                                                      001210
      ITEM FIXFLAG B;    # FIXED TYPE KEYWORD FLAG                     #
      ITEM FLAG  B; 
      ITEM FLOTFLAG B;   # FLOAT TYPE KEYWORD FLAG                     #
      ITEM I;                                                           001230
      ITEM J;                                                           001290
      ITEM K;                                                           001300
      ITEM L;                                                           001310
      ITEM L1;          # DO NOT USE AS SCRATCH VARIABLE #
      ITEM LFLAG;     #SET TO A ZERO, IF NO LEVEL NUMBER SPECIFIED     #
      ITEM LVNUM; 
      ITEM LASTEXLIT; 
      ITEM LITCTR;
      ITEM LITWRD U;
      ITEM M;                                                           001380
      ITEM N;                # SCRATCH VARIABLE  #
      ITEM NXIPTR;                                                      001480
      ITEM ONCOUNT;                                                     001500
      ITEM ONPTR;                                                       001510
      ITEM ORDINALCTR;      #  KEEPS TRACK OF ORDINAL COUNTER W/IN REC #000540
      ITEM PICLENG;                                                     001550
      ITEM PPTR;
      ITEM PRIORTYP;  #ENTRY TYPE OF LAST PROCESSED ITEM ENTRY         #
      ITEM PTLOC;                                                       001590
      ITEM RECORDERR;              # ITEM TO COUNT ERRORS IN A RECORD  #
      ITEM RECORDITEMS = 0;    # CONTAINS NUMBER OF ITEMS PER RECORD   #000890
      ITEM REALFLAG B;   # REAL TYPE KEYWORD FLAG                      #
      ITEM RIGHT;                                                       000810
      ITEM RPTR;                                                        001690
      ITEM SAVELEVEL; #LEVEL NUMBER OF LAST PROCESSED ITEM ENTRY       #
      ITEM SCACCPTR;     # VARIABLE ACCESS-CONTROL HEADER POINTER.     #
      ITEM SCCWPTR = 0;                                                 000720
      ITEM SCPTR = 0;                                                   001730
  
      ITEM SEPTR;     # POINTS TO THE START OF A SUB-ENTRY.            #
      ITEM SIGNIND;                                                     001770
      ITEM SLOC;                                                        001780
      ITEM SOPFLAG B; 
      ITEM STATE;                                                       001830
      ITEM TPFLAG;    #SET IF TYPE OR PICTURE SPECIFIED IN ITEM ENTRY  #
      ITEM VGRPFLAG;  # LEVEL NBR OF VARIABLE DIM GRP, OR -2 IF ERROR#
      ITEM WORDPOS;                                                     001930
      ITEM WORDPOSBF;                                                   000880
      ITEM WRDPTR;                                                      001950
  
      ARRAY LITSTOR[3] S(1);
        BEGIN 
          ITEM LITCHKTYP R(0,0,60); 
          ITEM LITCHKINT I(0,0,60); 
          ITEM LITCHKPIC U(0,0,60); 
        END 
      BASED ARRAY STATETABLE [0];                                       003780
        ITEM STATETBLE U(0,0,60);                                       003790
      SWITCH SCHEMAJUMP                                                 005570
        ABORT       ,                                                   005580
        ACHECKBA   ,                                                    000670
        ANAMETEST   ,                                                   005590
        AINIT       ,                                                   005600
        ARACPTR,
        ARACUPDATE, 
        ARACRETRVL, 
        ARACCKUPRT, 
        ARNAME      ,                                                   005630
        ARNEXTON    ,                                                   005650
        ARONCALLBA  ,                                                   000400
        ARONCALLUPRT, 
        ARONLISTPTR ,                                                   005660
        ARONOPTION  ,                                                   005670
        ARONPROC    ,                                                   005680
        ARPUT       ,                                                   005760
        ARTESTRTRN  ,                                                   005780
        CHECKDBP    ,                                                   005840
        CHECKISPIC  ,                                                   005860
        CHECKLIT1   ,                                                   005880
        CHECKLIT2   ,                                                   005890
        CHECKRTRN   ,                                                   005910
        CHECKSPEC   ,                                                   005920
        CHECKTHRU   , 
        CHKCHK      , 
        CHKCLR      , 
        CHKSET      , 
        CHKDCTL     , 
        CHKUNQPROC  , 
        CKPIC       ,                                                   000410
        CODEALWAYS  ,                                                   005950
        CODEDBP     ,                                                   005960
        CODEOPT     ,                                                   005970
        DINIT       ,                                                   005990
        DPUTITEM    ,                                                   006060
        GETANAMELOC ,                                                   006110
        HASHITDA    ,                                                   006140
        HASHITDR    ,                                                   006170
        HASHITDI    ,                                                   006180
        HASHITRA    ,                                                   006190
        HASHITRR    ,                                                   006210
        HASHITRI    ,                                                   006220
        ICHECKBA   ,                                                    000690
        INCRDPTR    ,                                                   006230
        INCRDPTRA,
          LOADDCT     , 
        NOLEV   , 
        NUMTYPE     ,              # SETS CLASS, SIZE FOR TYPE NUMERIC #
        OCCURSINT   ,                                                   006350
        OCCURSNAME  ,                                                   006360
        ONITEMBA    ,                                                   000560
        ONITEMDBP   ,                                                   006380
        ONINIT      ,                                                   006390
        ONITEMEND   ,                                                   006400
        ONITEMOPT   ,                                                   006410
        ONITEMDFLT  ,                                                   006420
           PICTURE     ,
        PICTYPCHECK ,                                                   000430
      QUALDEFAULT , 
        RCHECKBA   ,                                                    000710
        RECNAMEQUAL ,                                                   006590
        RESPNAME    ,                                                   006620
        RINIT       ,                                                   006660
        RNAME       ,                                                   006670
        RONCALLBA   ,                                                   000380
        RONCALLINIT ,                                                   006680
        RONCALLEND  ,                                                   006690
        RONCALLOPT  ,                                                   006700
        RPUT        ,                                                   006770
        RTESTNAME   ,                                                   006780
        SAVEAV      ,                                                   006800
        SAVNAME     ,                                                   006820
        SCACSETB, 
        SCACLIT,
        SCACLOCKS,
        SCACPROC, 
        SCACSTOR, 
        SCACNEXT, 
        SCNAME      ,                                                   006840
        SCPUT       ,                                                   006890
        SETCHAR  ,                                                      000350
        SETSERT,
        SETVALUE    ,                                                   001010
        STODNAME    ,                                                   007280
        STORDCHARL ,                                                    000450
        STORINT     ,                                                   000500
        STORINTP    ,                                                   000510
        STORONPROC  ,                                                   007300
        TSTAGGREG   ,                                                   007380
        TSTCODEPIC  ,                                                   007450
        TSTCODERSLT ,                                                   007470
        TSTDUPNOTALL,                                                   007490
        TSTITEM     , 
        TSTLEVEL    , 
        TSTOCCDBI1  ,                                                   007570
        TSTOCCDBI2  ,                                                   007580
        TSTOCCDBI3  ,                                                   007590
        TSTOCCDBI4  , 
        TSTOCCDBI5  , 
        TSTOCCURS1  ,                                                   007600
        TSTRONOPT   ,                                                   007700
        TSTUNIQUEDBN,                                                   007770
        TSTVALIDOCC,
        TSTVIRTRES, 
        TYPEEND    ,                                                    000900
        VALIDAR     , 
        VALIDINT    ,                                                   007820
        VALUENOT    ,              # SETS *NOT* IN CHECK CLAUSE FLAG   #
                    ;              #--------END OF JUMP SWITCH---------#
      SWITCH JMPVECTOR ERR16,STATE1,STATE2,STATE3,STATE4,STATE5,STATE6, 000660
                     STATE7,STATE8,STATE9,TABLEB,STATE4V,STATE4D,STATES,007850
                       STATE3T,REPITION,STATE4P,CKSIGN,CKTSIGN,STATE6K, 007860
                       STATE6E,FLTSIGN,STATE7F,STATEF,ALPHANUM,ALPHA,   007870
                       INTEGERD,FIXPTD,FLTPTD,INTEGERB,FIXPTB,FLTPTB,   007880
                       STATE2P,STATE1V,STATE3K,STATE3E,ERR1,ERR2,ERR3,  007890
                       ERR4,ERR5,ERR6,ERR7,ERR8,ERR9,ERR10,ERR11,ERR12, 007900
                       ERR13,ERR14,ERR15,ERR16,ERR17,NEXCHAR,TABLE6B,   007910
                       STATE9P,FIXPTPR,TABLE30B,FIXPTPRB,DTRTYPE,BLANK; 000140
      ARRAY STATETRANS [62];                                            007930
         ITEM STATETRNS U(0,0,60) = [O"63303132336464346470",  # : #    003460
                                   O"02650201444445454500",   # A #     007950
                                   O"00000000000000000000",   # B #     007960
                                   O"00000000000000000000",   # C #     007970
                                   O"00000000000000000000",   # D #     007980
                                   O"60606024246161616100",  # E #      000560
                                   O"00000000000000000000",   # F #     008000
                                   O"00000000000000000000",   # G #     008010
                                   O"00000000000000000000",   # H #     008020
                                   O"00000000000000000000",   # I #     008030
                                   O"00000000000000000000",   # J #     008040
                                   O"60606023236161616100",  # K #      000580
                                   O"00000000000000000000",   # L #     008060
                                   O"00000000000000000000",   # M #     008070
                                   O"00000000000000000000",   # N #     008080
                                   O"00000000000000000000",   # O #     008090
                                   O"67535320525254545400",  # P #      000600
                                   O"00000000000000000000",   # Q #     008110
                                   O"00000000000000000000",   # R #     008120
                                   O"15555521215625565600",   # S #     001340
                                   O"16555522225725575722",   # T # 
                                   O"00000000000000000000",   # U #     008150
                                   O"13535313525254545400",  # V #      000540
                                   O"00000000000000000000",   # W #     008170
                                   O"01650101454546464600",  # X #      000620
                                   O"00000000000000000000",   # Y #     008190
                                   O"00000000000000000000",   # Z #     008200
                                   O"00000000000000000000",   # 0 #     008210
                                   O"12474747474747474771",   # 1 #     000830
                                   O"50505050505050505000",  # 2 #      000460
                                   O"51515151515100515100",  # 3 #      000440
                                   O"00000000000000000000",   # 4 #     008250
                                   O"00000000000000000000",   # 5 #     008260
                                   O"00000000000000000000",   # 6 #     008270
                                   O"00000000000000000000",   # 7 #     008280
                                   O"00000000000000000000",   # 8 #     008290
                                   O"03650165650407650704",    # 9 #    000490
                                   O"00000000000000000000",   # + #     008310
                                   O"00000000000000000000",   # - #     008320
                                   O"00000000000000000000",   # * #     008330
                                   O"00000000000000000000",   # / #     008340
                                   O"62171717176262526200",  # ( #      000480
                                   O"00000000000000000000",   # ) #     008360
                                   O"00000000000000000000",   # $ #     008370
                                   O"00000000000000000000",   # = #     008380
                                   O"74303132336464346470",   # BLNK #  000160
                                   O"00000000000000000000",   # " #     008400
                                   O"14535314525254545400",  # . #      000640
                                   O"00000000000000000000",   #   #     008420
                                   O"00000000000000000000",   # [ #     008430
                                   O"00000000000000000000",   # ] #     008440
                                   O"00000000000000000000",   #   #     008450
                                   O"00000000000000000000",   # " #     008460
                                   O"00000000000000000000",   # _ #     008470
                                   O"00000000000000000000",   # ! #     008480
                                   O"00000000000000000000",   # & #     008490
                                   O"00000000000000000000",   # ' #     008500
                                   O"00000000000000000000",   # ? #     008510
                                   O"00000000000000000000",   # < #     008520
                                   O"00000000000000000000",   # > #     008530
                                   O"00000000000000000000",   # @ #     008540
                                   O"00000000000000000000",   # \ #     008550
                                   O"00000000000000000000"];  # ^ #     008560
  
  
  START:                                                                009210
#**********************************************************************#001980
#                   ***   S T A R T   ***                              #001984
#   FIRST SEMANTIC ROUTINE IN DLSCHMA. INITIALIZES ITEMS TO LOCATIONS  #001990
#   IN MEMORY FOR DDLDIAG, TRACE, SYNTBLE, ETC.                        #002000
#**********************************************************************#002010
      DDLDIAG = LOC(DIAGSTD);                                           009220
*IF DEF,DEBUG 
      TRACE = LOC(TRACEM);                                              009230
*ENDIF
      LEXWD = LOC(LEXWORD);                                             009240
      LEXICO = LOC(LEXICON);                                            009250
      SYNTBL = LOC(SYNTBLE);                                            009260
      LBLPTR = LOC(LBLPTRS);                                            009270
      SWITCHVCTR = LOC(SCHEMAJUMP);                                     009280
      NEXTPTR = CTLWDLENG + 1;  # SET FIRST WORD ADDRESS     #
      PRIORPTR = NEXTPTR;       #    FOR DIRECTBUILD         #
      MAXSUBENTLG = MINSUBENTLG;   # INITIALIZE MAXIMUM SUB-ENTRY      #
                                   # LENGTH.                           #
      OPENSC;                               # OPEN SCHEMA FILE        # 
      P<SCWORKBUF> = SCHBUFF;      # POINT TO SCHEMA DIRECTORY WRK BUF #
      DDLINIT;                                                          009290
      STD$START;                                                        009300
ABORT:    #    #
#********************************************************************#
#                         A B O R T                                  #
#  ALL FILES ARE CLOSED.  DDL IS STOPPED.                            #
#********************************************************************#
      DDLSU = MAXFL;                        #SET FL FOR ABORT CONDITION#
      CLSEOUT;
      CLSESC; 
      IF CURTYPE NQ O"14" 
        THEN  DDLABT (0); 
      ELSE
      ABRT3;
  
  
  ACHECKBA:   # #                                                       000780
#**********************************************************************#000140
#                  ***  A C H E C K B A  ***                           #000150
#   CHECKS IF AREA ON CLAUSE ENDS WITH BEFORE/AFTER, IF NOT RETURN     #000160
#   IS TO STDNO, OTHERWISE STDYES.                                     #000170
#**********************************************************************#000180
      IF SCAREAONBFAF [DPTR] EQ 0 THEN                                  000240
       STDNO;                                                           000800
      STDYES;                                                           000810
  AINIT:                                                                009370
#**********************************************************************#009380
#         ***  A I N I T  ***  (AREA ENTRY)                            #009390
#   INITIALIZES THE WORKING BUFFER AND POINTERS FOR THE AREA ENTRY.    #009400
#                                                                      #009410
#   INITIALIZES THE DIRECTORY WORKING BUFFER TO ZERO. SETS THE AREA    #009420
#   HEADER POINTER (APTR) TO ZERO. THE DIRECTORY WORKING BUFFER POINTER#009430
#   (DPTR) IS SET TO THE FIRST WORD FOLLOWING THE AREA HEADER. THE     #009440
#   PRIVACY OPTION BIT POSITION POINTER (PBITPTR) IS SET TO 15. RETURNS#009450
#   TO STDNO.                                                          #009460
#**********************************************************************#009470
      FOR I = 0 STEP 1 UNTIL DPTR DO
        SCBUFWORD[I] = 0;    #ZERO OUT DIRECTORY WORKING BUFFER#
      DPTR = AREAFIXW;
      APTR = 0;                                                         009520
      STDNO;                                                            009530
  ARACPTR:  
#**********************************************************************#
#                ***  A R A C P T R  ***                               #
#   STORES OFFSET POINTER TO THE ACCESS-CONTROL ENTRY. INITIALIZES     #
#   FLAGS AND ACCESS-CONTROL POINTER. RETURN IS TO STDYES.             #
#**********************************************************************#
      IF SCAREAPRVPTR[APTR] GR 0 THEN 
        STDNO;     # ACCESS-CONTROL ENTRY IS NOT CONTIGUOUS # 
  
      SCAREAPRVPTR[APTR] = DPTR - APTR;  # STORE OFFSET POINTER # 
      SCACCPTR = DPTR;       # STORE ACCESS-CONTROL HEADER POINTER #
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      ACUPDFG = FALSE;       # INITIALIZE UPDATE FLAG # 
      ACRETRFG = FALSE;      # INITIALIZE RETRIEVAL FLAG #
      STDYES; 
  ARACUPDATE: 
#**********************************************************************#
#                ***  A R A C U P D A T E  ***                         #
#   CHECKS IF THE UPDATE OPTION HAS ALREADY BEEN SPECIFIED IN AN       #
#   ACCESS-CONTROL CLAUSE FOR A PARTICULAR ENTRY. IF SO, RETURNS TO    #
#   STDNO IF NOT,SET UPDATE FLAG AND SET UPDATE BITS IN THE SCHEMA     #
#   DIRECTORY WORK BUFFER. RETURN IS TO STDYES.                        #
#**********************************************************************#
      IF ACUPDFG THEN 
        STDNO;   # UPDATE OPTION PREVIOUSLY SPECIFIED - ERROR.         #
      ACUPDFG = TRUE;        # SET UPDATE FLAG                         #
  
#   STORE UPDATE BITS IH THE SCHEMA DIRECTORY WORK BUFFER # 
      SCAREALOCKOP[SCACCPTR] = SCAREALOCKOP[SCACCPTR] LXR CURP1;
      STDYES; 
  ARACRETRVL: 
#**********************************************************************#
#                ***  A R A C R E T R V L  ***                         #
#   CHECKS IF THE RETRIEVAL OPTION HAS ALREADY BEEN SPECIFIED IN AN    #
#   ACCESS-CONTROL CLAUSE FOR A PARTICULAR ENTRY.  IF SO, RETURNS TO   #
#   STDNO. IF NOT,SET RETRIEVAL FLAG AND SET RETRIEVAL BITS IN THE     #
#   SCHEMA DIRECTORY WORK BUFFER. RETURN IS TO STDYES.                 #
#**********************************************************************#
      IF ACRETRFG THEN
        STDNO;   # RETRIEVAL OPTION PREVIOUSLY SPECIFIED - ERROR       #
      ACRETRFG = TRUE;
  
#   STORE RETRIEVAL BITS IN THE SCHEMA DIRECTORY WORK BUFFER #
      SCAREALOCKOP[SCACCPTR] = SCAREALOCKOP[SCACCPTR] LXR CURP1;
      STDYES; 
  ARACCKUPRT: 
#**********************************************************************#
#                ***  A R A C C K U P R T  ***                         #
#   CHECKS IF UPDATE/RETRIEVAL OPTIONS HAVE BEEN SPECIFIED IN ACCESS-  #
#   CONTROL ENTRIES FOR A PARTICULAR AREA. IF NEITHER SPECIFIED, SET   #
#   BOTH UPDATE AND RETRIEVAL FLAGS, AND ALSO SET RESPECTIVE BITS      #
#   IN THE SCHEMA DIRECTORY WORK BUFFER. RETURNS TO STDNO.             #
#**********************************************************************#
      IF ACUPDFG OR ACRETRFG THEN 
        STDNO;   # UPDATE/RETRIEVAL OPTIONS SPECIFIED                  #
  
#   SET BOTH UPDATE AND RETIEVAL FLAGS(DEFAULT CONDITION) # 
      ACUPDFG = TRUE; 
      ACRETRFG = TRUE;
  
#   SET UPDATE AND RETRIEVAL BITS IN SCHEMA DIRECTORY WORK BUFFER # 
        SCAREALOCKOP[SCACCPTR] = O"77"; 
        STDNO;
  ANAMETEST:                                                            009540
#**********************************************************************#000120
#                ***  A N A M E T E S T  ***                           #009550
#                                                                      #009560
#   CHECKS IF THERE IS AN AREA NAME SPECIFIED FOR THE SCHEMA.          #009570
#                                                                      #009580
#   RETURNS TO STDNO IF AREA NAME WAS NOT SPECIFIED, ELSE RETURNS TO   #009590
#   STDYES.                                                            #009600
#**********************************************************************#000140
      IF ANAMEFLAG EQ 0 THEN                                            009610
        STDNO;                                                          009620
      STDYES;                                                           009630
  ARNAME:                                                               010480
#**********************************************************************#010490
#                ***  A R N A M E  ***  (AREA ENTRY)                   #010500
#   STORES THE AERA NAME INTO THE DIRECTORY WORKING BUFFER.            #010510
#                                                                      #010520
#   CHECKS IF THE AREA NAME WAS PREVIOUSLY DEFINED. IF PREVIOUSLY DE-  #010530
#   FINED, RETURN TO STDNO, ELSE STORES THE AREA NAME INTO THE         #010540
#   DIRECTORY WORKING BUFFER AT DPTR AND STORES THE LENGTH OF THE AREA #010550
#   NAME IN WORDS AND CHARACTERS INTO THE DIRECTORY WORKING BUFFER AT  #010560
#   APTR. RETURNS TO STDNO.                                            #010570
#**********************************************************************#010580
      IF DUPDEFINE EQ 1 THEN                                            010590
          STDNO;                                                        010600
      I = 0;
      FOR J = 1  STEP 1  UNTIL NUMNAMES - 1  DO 
        BEGIN      # GO THRU SYMBOL TABLE ENTRIES # 
 ANRDSY: DDLRDSY ( SYMBUFWK, 5, I );
        IF SYMREFWK [0] EQ 1
          THEN
          BEGIN    # SKIP REFERENCE ENTRIES       # 
          I = I + 1;
          GOTO ANRDSY;
          END 
        IF SYMDEFWK [0] EQ 0
          THEN
          BEGIN    # SKIP UNDEFINED NAMES         # 
          I = I + SYMNEXTWK [0];
          GOTO ANRDSY;
          END 
        IF SYMNAMTYPEWK [0] EQ AREA$NAME
          THEN     # LOOK ONLY AT AREA NAME ENTRIES # 
          IF B<0,42>SYMNAMEWK [4] EQ B<0,42>CURWORD [0] 
            THEN STDNO;    # ERROR IF SAME AREA NAME FOUND #
        END 
      C<0,CURLENG>SCHAREANAM30[DPTR] = C<0,CURLENG>CURWRD30[0]; 
      SCARNAMEPTR[APTR] = DPTR;    # OFFSET POINTER TO AREA NAME.      #
      DPTR = DPTR + APTR + CURLENW;                                     000210
      SCHAREANAMEL[APTR] = CURLENW;    # STORE LENGTH IN WORDS         #000350
      SCHAREANAMEC[APTR] = CURLENG;    # STORE LENGTH IN CHARACTERS    #000360
      SCAREADATATY[APTR] = 0;       # STORES DATA TYPE TO 0, WAS 8     #000140
      ANAMEFLAG = 1;   #  SET FLAG TO INDICATE AN AREA NAME IS SPECIFI-#010710
                      # ED IN THE SCHEMA.                         #     010720
      SCARNXTAREA[0] = 0; 
      TOTALAREAS = TOTALAREAS + 1;                                      000560
      SCAREAORD[APTR] = TOTALAREAS;   #SET ORDINAL IN AREA ENTRY       #
      IF TOTALAREAS EQ MAXAREAS + 1 THEN
        DIAGDL( 291 );       #MAXIMUM TOTAL NUMBER OF AREAS EXCEEDED.  #
      STDYES;                                                           010740
  ARNEXTON:                                                             010750
#**********************************************************************#010760
#                ***  A R N E X T O N  ***  (AREA NAME)                #010770
#   SETS THE NEXT ON BIT IN THE DIRECTORY WORKING BUFFER AT DPTR-1.    #010810
#   RETURNS TO STDNO.                                                  #010820
#**********************************************************************#010830
      SCAREANEXTON[DPTR-1] = TRUE;
      STDNO;                                                            010850
  ARONCALLBA:   #   #                                                   000440
#**********************************************************************#000160
#                  ***  A R O N C A L L B A ***                        #000260
#   SETS BEFORE/AFTER BIT IF IN PRESENT OR PAST SYNTAX.  RETURN STDNO. #000270
#**********************************************************************#000280
      SCAREAONBFAF[DPTR] = SCAREAONBFAF[DPTR] LOR CURP2;                000450
      STDNO;                                                            000470
  ARONCALLUPRT: 
#**********************************************************************#
#                ***  A R O N C A L L U P R T  ***                     #
#   SETS THE UPDATE/RETRIEVAL BITS IN THE DIRECTORY WORK BUFFER.       #
#   RETURNS TO STDNO.                                                  #
#**********************************************************************#
      SCARONUPRTOP[DPTR] = SCARONUPRTOP[DPTR] LXR CURP1;
      STDNO;
  ARONLISTPTR:                                                          010860
#**********************************************************************#010870
#                ***  A R O N L I S T P T R  ***  (AREA ENTRY)         #010880
#   SETS A PTR TO THE ON ENTRY IN THE DIRECTOR WORKING BUFFER.         #010890
#                                                                      #010900
#   SETS THE ON POINTER (ONPTR) TO THE DIRECTORY POINTER (DPTR) AND    #010910
#   SETS THE CALL LIST POINTER AT APTR TO THE VALUE OF ONPTR.          #000220
#**********************************************************************#010930
      ONPTR = DPTR;          # SET CALL AND SUB-ENTRY POINTERS TO THE  #
      SEPTR = DPTR;          # FIRST WORD OF THE CALL ENTRIES.         #
      SCHARCALLPTR[APTR] = DPTR - APTR;                                 000190
      STDNO;                                                            010970
  ARONOPTION:                                                           010980
#**********************************************************************#010990
#                ***  A R O N O P T I O N  ***  (AREA ENTRY)           #011000
#   SETS THE ON OPTION IN THE AREA ENTRY IN THE DIRECTORY WORKING      #011010
#   BUFFER IF THE "AREA IS TEMPORARY" CLAUSE IS NOT USED.              #000180
#                                                                      #011030
#**********************************************************************#011070
      SCAREAONOPT[DPTR] = SCAREAONOPT[DPTR] LOR CURP1;                  011100
      STDYES;                                                           011110
  ARONPROC:                                                             011120
#**********************************************************************#011220
#                ***  A R O N P R O C  ***  (AREA ENTRY)               #011230
#   THE DATA-BASE-PROCEDURE-NAME SPECIFIED IN THE ON CLAUSE IS STORED  #011240
#   INTO THE DIRECTORY WORKING BUFFER.                                 #011250
#                                                                      #011260
#   CHECK IF THE DBP NAME IS A VALID DBP NAME (NOT GREATER THAN 7 CHAR-#011270
#   ACTERS). IF VALID STORE DBP NAME INTO THE DIRECTORY WORKING BUFFER #011280
#   AT DPTR. RETURNS TO STDYES. IF DBP NAME WAS NOT VALID, RETURN TO   #011290
#   STDNO, AFTER STORING THE FIRST 7 CHARACTERS OF THE PROC NAME       #000210
#**********************************************************************#011310
      DBPBUILD;                                                         000300
       IF CURLENG GR 7 THEN                                             000230
                                       # CHECK FOR VALID ON PROC NAME. #000240
        BEGIN                                                           000250
          C<0,7>SCAREAONNAME[DPTR] = C<0,7>CURWORD[0];                  000260
                                       # STORE TRUNCATED PROC NAME     #000270
          STDNO;                                                        000290
        END                                                             000300
      C<0,CURLENG>SCAREAONNAME[DPTR] = C<0,CURLENG>CURWORD[0];          000310
      STDYES;                                                           000330
  ARPUT:                                                                011890
#**********************************************************************#000410
#                  ***  A R P U T  ***                                 #000340
#   STORES THE NEXT 6RM WORD ADDRESS INTO THE SYMBOL TABLE ENTRY FOR   #000350
#   THIS AREA NAME.  USING DPTR-1 AS THE LENGTH ISSUE A 6RM WRITE TO   #000360
#   THE DIRECTORY. INCREMENT THE 6RM WORD ADDRESS BY THE LENGTH. STDNO #000370
#**********************************************************************#000380
      SCAREAENTRYL[APTR] = DPTR - APTR;     # RELATIVE DIF OF ADDRESSES#000420
      SCAREASYMADD [APTR] = SYMENTRY; 
      IF DPTR GR MAXRECBUF THEN 
        MAXRECBUF = DPTR;              #SAVE MAX BUFFER USE FOR FL CALC#
      DIRECTBUILD;                                                      011910
      SYMBOLBUILD;                                                      011920
      IF FATALERR EQ 0 THEN                                              DL3A006
      BEGIN                                                              DL3A006
      #****************************************************************#
      # CHECKSUM THE AREA ENTRY WHICH HAS JUST BEEN WRITTEN TO THE     #
      # DIRECTORY, AFTER FIRST ERASING WORD ADDRESS FIELDS.            #
      #****************************************************************#
      SCAREADCNTLA[APTR] = 0;          #ERASE WORD ADDRESS             #
      SCARNXTAREA[APTR] = 0;           #ERASE WORD ADDRESS             #
      SCAREASYMADD[APTR] = 0;          #ERASE WORD ADDRESS             #
      SCAREACSTR[APTR] = 0;            #ERASE CONSTRAINT WORD ADDRESS#
      SCAREAORD[APTR] = 0;         #ERASE AREA ORDINAL# 
      CHECKSUM[0] = 0;                 #SET UP NEW BASE                #
      CKSPTR = SCARNAMEPTR[APTR]; 
      CKSNAME[0] = " ";                #SET BLANK FILL                 #
                                  #PUT AREA NAME IN CHECKSUM RECORD    #
      C<0,SCHAREANAMEC[APTR]>CKSNAME[0] = 
      C<0,SCHAREANAMEC[APTR]> SCHAREANAM30[CKSPTR]; 
                                  #CHECKSUM AREA ENTRY                 #
      CHECKSUM[0] = CKSUM(CHECKSUM[0],LOC(SCWORKBUF), 
                      SCAREAENTRYL[APTR]);
      FOR I = 0 STEP 1 UNTIL DPTR DO             #CLEAR BUFFER FOR     #
        SCBUFWORD[I] = 0;                        #NEXT ENTRY           #
      CKSWA = ((TOTALAREAS -1) * CKSRECLEN)+1;   #COMPUTE WA           #
      SCWRCKS(CKSREC,CKSWA);      #WRITE CHECKSUM REC TO SCRATCH FILE  #
      END                                                                DL3A006
      IF TOTALAREAS EQ 1 THEN                                           001030
        SCCWFRSTAREA[SCCWPTR] = PRIORPTR; 
        ELSE
          BEGIN         # IF NOT FIRST AREA, SET NEXT AREA POINTER #
          DDLRDSC( SCWORKBUF, 2, AREAPTR ); 
          SCARNXTAREA [0] = PRIORPTR; 
          DDLRTSC( SCWORKBUF, 2, AREAPTR ); 
          SCBUFWORD [0] = 0;
          SCBUFWORD [1] = 0;
          END 
      AREAPTR = PRIORPTR; 
      STDNO;                                                            000250
  ARTESTRTRN:                                                           012050
#**********************************************************************#012060
#                ***  A R T E S T R T R N  ***                         #012070
#   CHECKS IF ANY AREA CLAUSES WERE SPECIFIED.                         #012080
#                                                                      #012090
#   IF SO, RETURNS TO STDYES, ELSE RETURNS TO STDNO.                   #012100
#**********************************************************************#012110
      I = SCBUFWORD[APTR] LOR SCBUFWORD[APTR + 1];                      000490
      IF I EQ 0 THEN                                                    012130
          STDNO;                                                        012140
      STDYES;                                                           012150
  BLANK: # #                                                            000410
#**********************************************************************#000420
#                   ***  B L A N K  ***                                #000430
#   A SECTION OF THE PICTURE ROUTINE: SEARCHES THRU LEADING BLANKS     #000440
#   UNTIL A NON-BLANK CHARACTER IS FOUND, THEN GOES TO NEX1CHAR, IF NO #000450
#   NON-BLANKS ARE FOUND GO TO ERR16(DIAGNOSTIC 315 ISSUED THEN STDNO).#000460
#**********************************************************************#000470
      CHARPTR = 1;                                                      000190
      FOR L = 0 STEP 1 UNTIL CURLENG DO                                 000200
        BEGIN                                                           000210
          IF C<CHARPTR,1>CURWORD[WRDPTR] NQ O"55" THEN                  000220
            GOTO NEX1CHAR;                                              000230
          CHARPTR = CHARPTR + 1;                                        000240
          IF CHARPTR GR 9 THEN                                          000250
            BEGIN                                                       000260
              CHARPTR = 0;                                              000270
              WRDPTR = WRDPTR + 1;                                      000280
            END                                                         000290
        END                                                             000300
      GOTO ERR16;                                                       000310
  CHECKDBN:                                                             012380
#**********************************************************************#012390
#                ***  C H E C K D B N  ***  (DATA SUB-ENTRY)           #012400
#   HASHES THE DATA BASE NAME IN THE CHECK CLAUSE. IF NOT PREVIOUSLY   #012410
#   DEFINED, THE ASSOCIATED ITEMS OF THE ITEM ENTRY IN SYMBOL TABLE    #012420
#   ARE SATISFIED.                                                     #012430
#                                                                      #012440
#   SETS THE REQUIRED ENTRY CONDITIONS FOR HASH ROUTINE (HASHIT).      #012450
#   CALLS HASHIT. WHEN RETURNED FROM THE HASH ROUTINE, A CHECK         #012460
#   IS MADE TO SEE IF THE DATA BASE NAME WAS PREVIOUSLY DEFINED (REF-  #012470
#   STATUS, 1=PREIOUSLY DEFINED). IF REFSTATUS EQUALS 1, RETURN TO     #012480
#   STDNO, ELSE STORE THE LOCATION OF WHERE THE RECORD (RECPTR) IS DE- #012490
#   FINED IN THE RECORD POINTER FIELD OF THE ITEM ENTRY IN THE SYMBOL  #012500
#   TABLE. SET THE DATA BASE NAME FLAG AND THE CHECK DATA BASE NAME    #012510
#   FLAG IN THE ITEM ENTRY OF THE SYMBOL TABLE. STORE THE LENGTH IN    #012520
#   WORDS OF THE DATA BASE NAME IN TO THE DIRECTORY WORKING BUFFER.    #012530
#   RETURN TO STDYES.                                                  #012540
#**********************************************************************#012550
 # NO ACTION FOR DDL 2.0                             #
      STDYES;                                                           012620
  CHECKDBP:                                                             012740
#**********************************************************************#012750
#                ***  C H E C K D B P  ***  (DATA SUB-ENTRY)           #012760
#   STORES THE DATA BASE PROCDURE NAME SPECIFIED IN THE CHECK CLAUSE   #012770
#   INTO THE DIRECTORY WORKING BUFFER.                                 #012780
#                                                                      #012790
#   CHECKS IF THE LENGTH OF THE DBP IS GREATER THAN 7 CHARACTERS. IF SO#012800
#   IT RETURNS TO STDNO, ELSE STORES THE NAME INTO THE DIRECTORY WORK- #012810
#   ING BUFFER AT DPTR. STORES THE OFFSET WORD LOCATION OF THE DBP INTO#012820
#   THE DIRECTORY WORKING BUFFER AT CHECK HEADER POINTER (CKPTR).      #012830
#                                                                      #012840
#**********************************************************************#012850
      DBPBUILD;                                                         000410
      SCITMCKDBP[CKPTR] = TRUE;                                         002220
      TOTITMPROC = TOTITMPROC + 1;     # TO COMPUTE THE MAX NO. OF DBP #000820
                                     # CALLED WITHIN ANY ONE RECORD  #  000830
      IF CURLENG GR 7 
        THEN
        BEGIN 
        B<0,42>SCITMCKPROC [CKPTR] = B<0,42>CURWORD [0];
        STDNO;       # ERROR IF PROC NAME GR 7 CHARACTERS # 
        END 
      C<0,CURLENG>SCITMCKPROC [CKPTR] = C<0,CURLENG>CURWORD [0];
      SCITEMDBPFLG[IPTR] = TRUE;
      STDYES;                                                           012930
  CHECKLIT1:                                                            012940
#**********************************************************************#012950
#                ***  C H E C K L I T 1  ***  (DATA SUB-ENTRY)         #012960
#   CHECKS THE TYPE OF LITERAL SPECIFIED IN THE CHECK CLAUSE           #012970
#   AGAINST THE ITEM TYPE SPECIFIED IN THE TYPE CLAUSE. CONVERTS       #012980
#   THE LITERAL IF POSSIBLE AND STORES THE CONVERTED RESULT INTO       #012990
#   THE DIRECTORY WORKING BUFFER.                                      #013000
#                                                                      #013010
#   IF THE CONVERSION WAS NOT POSSIBLE, IT RETURNED TO STDNO,          #013020
#   ELSE IT HAD RETURNED TO STDYES.                                    #013030
#**********************************************************************#013040
      J = SCITEMCLASS [IPTR]; 
      FLAG = FALSE;     # INITIALIZE DIAGNOSTIC FLAG  # 
      IF J LQ 1 THEN   # FOR ALPHA OR ALPHANUMERIC ITEM # 
        BEGIN          # MUST HAVE NON-NUMERIC LITERAL. # 
          IF CURTYPE NQ 103 THEN
            FLAG = TRUE;  # RETURN WILL BE TO STDNO.    # 
          ELSE
            BEGIN 
              IF CURLENG GR SCITEMSIZE[IPTR] THEN  # IF LENGTH OF LIT. #
                FLAG = TRUE; # GREATER THAN TARGET ITEM, SET FLAG. #
              ELSE
              BEGIN 
              IF J EQ 1 THEN      # IF ITEM ALPHABETIC,                #
                BEGIN 
                  K = 0;          # CHECK TO SEE THAT LITERAL CONTAINS #
                  N = 0;          # ALL ALPHABETIC CHARACTERS OR BLANK.#
                  FOR I = 1 STEP 1 UNTIL CURLENG DO # IF NOT RETURN   # 
                    BEGIN 
                      FOR M = M WHILE K GR 9 DO    # WILL BE TO STDNO. #
                        BEGIN 
                          K = 0;
                          N = N + 1;
                        END 
                      IF C<K>CURWORD[N] GR O"32" AND
                                    (C<K>CURWORD[N] NQ O"55") THEN
                        BEGIN 
                          FLAG = TRUE;
                          I = CURLENG;
                        END 
                      ELSE
                        BEGIN 
                          K = K + 1;
                          TEST; 
                        END 
                    END 
                END 
              K = CURLENG;
              FOR I = 0 STEP 1 UNTIL CURLENW-1 DO 
                BEGIN    # BEGIN OF FOR-LOOP #
                  LITWRD = CURWORD[I];
                  CURWORD[I] = "          ";
                  IF K GR ((I+1)*10) THEN 
                    BEGIN 
                      CURWORD[I] = LITWRD;
                      TEST; 
                    END 
                  ELSE
                    BEGIN 
                      K = 10 - ((CURLENW*10)-CURLENG);
                      C<0,K>CURWORD[I] = C<0,K>LITWRD;
                    END 
                 END   # END OF FOR-LOOP #
               END
             END
         END
      ELSE
        BEGIN 
          IF CURTYPE EQ 103 THEN  # IF TARGET ITEM NUMERIC AND LITERAL# 
            FLAG = TRUE;     # NON-NUMERIC, SET FLAG.              #
          ELSE
          BEGIN 
          CONVERTCKLIT;      # CONVERT LITERAL. # 
          IF ERRCODE NQ 0 THEN
            STDNO;
          END 
        END 
      IF FLAG THEN
        BEGIN 
          ERRCODE = 1;
          STDNO;
        END 
       STDYES;
  CHECKLIT2:                                                            013050
#**********************************************************************#013060
#                ***  C H E C K L I T 2  ***  (DATA SUB-ENTRY)         #013070
#  THE LITERAL IS STORED IN THE EXHIBIT CHECK LITERAL AREA.  THE    # 
#  CONVERTED LITERAL IS STORED IN THE CHECK LITERAL AREA.  LITERAL  # 
#  LENGTHS ARE ALSO STORED IN THE ITEM ENTRY.  A COUNTER OF THE     # 
#  NUMBER OF LITERALS IS INCREMENTED, AS ARE POINTERS TO THE TWO    # 
#  STORAGE AREAS.   IF THE SCHEMA WORK BUFFER IS FILLED, DDL IS     # 
#  ABORTED WITH DIAGNOSTIC 233.                                     # 
#   IF THE SECOND LITERAL WAS GREATER THAN THE FIRST, IT RETURNS       #013120
#   TO STDYES, ELSE IT RETURNS TO STDNO.                               #013130
#**********************************************************************#013140
      K = SCITEMSIZE [IPTR];
      IF SCITEMCLASS [IPTR] LQ 1  AND  K GR CURLENG 
        THEN K = CURLENG; 
      IF M EQ 0 
        THEN SCITMCKLIT1 [L] = K; 
      IF M EQ 1 
        THEN SCITMCKLIT2 [L] = K; 
      IF M EQ 2 
        THEN
        BEGIN 
        SCITMCKLIT3 [L] =K; 
        L = L + 1;
        M = - 1;
        END 
      M = M + 1;
      IF SCITEMCLASS [IPTR]  LQ 1 
        THEN
        BEGIN 
        FOR I = 0  STEP 1  UNTIL CURLENW - 1  DO
          BEGIN 
          SCITMCKLIT [CKLITPTR] = CURWORD [I];
          CKLITPTR = CKLITPTR + 1;
          IF CKLITPTR GR EXCKSTART
            THEN GOTO CHECKLITABT;
          END 
        END 
      ELSE BEGIN
        K = SCITEMSIZE [IPTR];
        J = ( K - 1 ) / 10; 
        FOR I = 0  STEP 1 UNTIL J DO
          BEGIN 
          SCITMCKLIT [CKLITPTR] = NAME [I]; 
          CKLITPTR = CKLITPTR + 1;
          IF CKLITPTR GR EXCKSTART
            THEN GOTO CHECKLITABT;
          END 
        END 
#**********************************************************************#
#  THE FOLLOWING CODE CHECKS TO SEE IF THE LITERALS IN THE CHECK VALUE #
#  CLAUSE ARE IN ASCENDING ORDER. IF SO RETURN IS TO STDYES,ELSE STDNO #
#**********************************************************************#
      I = 0;
      IF ERRCODE EQ 0 THEN
        BEGIN 
          IF SCITEMCLASS[IPTR] GR 1 THEN
          BEGIN 
          IF LITCTR NQ 0 THEN 
            BEGIN 
              IF SCITEMTYPE[IPTR] THEN
                BEGIN 
                  IF SCITEMCLASS[IPTR] EQ 10 THEN 
                    IF LITCHKINT[0] GQ LITCNVINT[0] THEN
                      STDNO;
                    ELSE
                      GOTO SKPCHK;
                  ELSE
                  IF LITCHKTYP[I] LS LITCONV[I] THEN
                    GOTO SKPCHK;
                  IF LITCHKTYP[I] EQ LITCONV[I] 
                                  AND (SCITEMCLASS[IPTR] EQ 14) THEN
                    BEGIN 
                      I = I + 1;
                      IF LITCHKTYP[I] GQ LITCONV[I] THEN
                        STDNO;
                    END 
                   STDNO; 
                END 
              ELSE
                BEGIN 
                  J = SCITEMSIZE[IPTR] - (((SCITEMSIZE[IPTR]-1)/10)*10);
                  J = J - 1;
                  K = C<J,1>LITCHKPIC[(SCITEMSIZE[IPTR]-1)/10];#EXT.SOP#
                  J = C<J,1>NAME[(SCITEMSIZE[IPTR]-1)/10];#EXTRACT SOP #
                  IF K LS O"33" OR (K EQ O"66") THEN #CHECK IF FIRST   #
                    BEGIN                #LITERAL -VE.IF SO,CHECK IF   #
                      IF J LS O"33" OR (J EQ O"66") THEN #SECOND LIT.  #
                        BEGIN         #ALSO -VE---IF TRUE THEN     #
                          FOR I = 0 STEP 1 UNTIL 3 DO #SWAP LITERALS  # 
                            LITCHKPIC[I] == NAME[I]; #AND BRANCH OUT TO#
                        END                          #COMPARE.         #
                      ELSE         #IF SECOND LITERAL NOT -VE THEN IT  #
                        GOTO SKPCHK;  #IS OF HIGHER VALUE, HENCE SKIP  #
                    END               #COMPARE ROUTINE.                #
                  ELSE
                    IF J LS O"33" OR (J EQ O"66") THEN #IF FIRST LIT.  #
                      STDNO; #IS +VE, AND SECOND LIT. -VE,RETURN STDNO.#
                    FOR I = 0 STEP 1 UNTIL 3 DO  #CHECK FOR ASCENDING  #
                      BEGIN                      # ORDER.              #
                        IF LITCHKPIC[I] GR NAME[I] THEN 
                          BEGIN 
                          STDNO;
                          END 
                        IF LITCHKPIC[I] EQ NAME[I] THEN 
                          BEGIN 
                            IF ((SCITEMSIZE[IPTR]-1)/10) GR I THEN
                              TEST; 
                            ELSE STDNO; 
                          END 
                        ELSE GOTO SKPCHK; 
                      END 
                END 
            END 
          END 
        END 
 SKPCHK:    #   # 
      SCITMCKEXLNW[EXCKPTR] = CURLENW;
      SCITMCKEXLNC [EXCKPTR] = CURLENG; 
      IF EXCKPTR NQ EXCKSTART 
        THEN SCITMCKEXNXL [LASTEXLIT] = EXCKPTR - LASTEXLIT;
      LASTEXLIT = EXCKPTR;
      EXCKPTR = EXCKPTR + 1;
      FOR I = 0  STEP 1  UNTIL CURLENW - 1  DO
        BEGIN 
        SCITMCKEXLIT [EXCKPTR] = CURWORD [I]; 
        EXCKPTR = EXCKPTR + 1;
        IF EXCKPTR GR LGSCHBF 
          THEN GOTO CHECKLITABT;
        END 
      FOR I = 0 STEP 1 UNTIL 3 DO 
        LITCHKPIC[I] = NAME[I]; 
      LITCTR = LITCTR + 1;
      STDYES;                                                           000600
CHECKLITABT:      # ABORT DDL IF BUFFER OVERFLOW ON SCHEMA WORK BUFFER #
      DIAGDL (233); 
      GOTO ABORT; 
  CHECKISPIC:                                                           013150
#**********************************************************************#013160
#                ***  C H E C K I S P I C  ***  (DATA SUB-ENTRY)       #013170
#   SETS IN FLAG IN THE DIRECTORY WORKING BUFFER THAT INDICATES THAT   #013180
#   PICTURE WAS SPECIFIED IN THE CHECK CLAUSE.                         #013190
#                                                                      #013200
#  RETURNS TO STDNO IF PICTURE ALREADY SPECIFIED, ELSE STDYES.   #
#**********************************************************************#013220
      IF SCITMCKPIC [CKPTR] 
        THEN STDNO; 
      SCITMCKPIC[CKPTR] = TRUE;        # SET PICTURE FLAG (DIR)        #000620
      STDYES; 
  CHECKRTRN:                                                            013250
#**********************************************************************#013260
#                ***  C H E C K R T R N  ***  (DATA SUB-ENTRY)         #013270
#   CHECKS IF THE CHECK CLAUSE WAS SPECIFIED.                          #013280
#                                                                      #013290
#  IF SPECIFIED, LITERALS STORED LOWER IN THE SCHEMA WORK BUFFER #
#  ARE MOVED UP TO BE CONTIGUOUS.  POINTERS ARE SET TO THE       #
#  LITERAL STORAGE LOCATIONS.  DPTR IS ADJUSTED.  RETURN IS TO   #
#  STDYES.    RETURN TO STDNO IF CHECK NOT SPECIFIED.            #
#**********************************************************************#013310
      IF SYMICHECKDF[TEMPTR] THEN                                       013320
        BEGIN 
          IF NOT SCITMCKVALUE[CKPTR] THEN 
            BEGIN 
              DPTR = DPTR + 1;
              IF NOT SCITMCKPIC[CKPTR] AND NOT SCITMCKDBP[CKPTR] THEN 
                STDNO;
                CHKBUFOVF;
              STDYES; 
            END 
        IF M NQ 0    THEN L = L + 1;
        SCITMCKLITP [DPTR + 1] = L - DPTR;
        SCITMCKNLIT [DPTR + 1] = LITCTR;
        FOR I = CKLITSTART  STEP 1  UNTIL CKLITPTR - 1  DO
          BEGIN 
          SCITMCKLIT [L] = SCITMCKLIT [I];
          SCITMCKLIT [I] = 0; 
          L = L + 1;
          END 
        SCITMCKEXPTR [IPTR] = L - IPTR; 
        FOR I = EXCKSTART  STEP 1  UNTIL EXCKPTR - 1  DO
          BEGIN 
          SCITMCKLIT [L] = SCITMCKLIT [I];
          SCITMCKLIT [I] = 0; 
          L = L + 1;
          END 
        DPTR = L; 
      CHKBUFOVF;
        STDYES; 
        END 
      STDNO;                                                            013340
  CHECKSPEC:                                                            013350
#**********************************************************************#013360
#                ***  C H E C K S P E C  ***  (DATA SUB-ENTRY)         #013370
#   SETS A FLAG IN THE ITEM ENTRY OF THE SYMBOL TABLE TO INDICATE THAT #013380
#   THE CHECK CLAUSE WAS SPECIFIED.                                    #013390
#                                                                      #013400
#   SET CHECK HEADER POINTER (CKPTR) TO THE DIRECTORY WORKING BUFFER   #013410
#   POINTER (DPTR). STORES THE OFFSET WORD LOCATION OF THE CHECK HEADER#013420
#   (CKPTR) INTO THE CHECK LIST POINTER AT IPTR + 3. INCREMENTS DPTR   #013430
#   TO THE NEXT WORD OF THE DIRECTORY WORKING BUFFER. RETURNS TO STDNO.#013440
#   IF CHECK WAS ALREADY SPECIFIED, ELSE TO STDYES.                  #
#**********************************************************************#013450
      CKPTR = DPTR;                                                     013;60
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      IF SCITEMCHECKS [IPTR] NQ 0 
        THEN STDNO; 
      SCITEMCHECKS[IPTR] = DPTR - IPTR;          # STORE OFFSET POINTER#000640
      SYMICHECKDF[TEMPTR] = TRUE;  # SET CHECK FLAG.                   #013490
      SCRECDBPCKFG[RPTR] = TRUE;                                        000390
      STDYES; 
CHECKTHRU:     #  # 
#*********************************************************************# 
# ************       C H E C K T H R U       *************************# 
#  THIS ROUTINE SETS THE RANGE BIT FOR THE LITERAL JUST STORED.  THE  # 
#  THRU BIT IS ALSO SET FOR THE CHECK EXHIBIT WORD.  EXIT STDNO.      # 
#*********************************************************************# 
      IF M EQ 0 
        THEN SCITMCKRNG3 [L - 1] = TRUE;
      IF M EQ 1 
        THEN SCITMCKRNG1 [L] = TRUE;
      IF M EQ 2 
        THEN SCITMCKRNG2 [L] = TRUE;
      SCITMCKEXTHR [EXCKPTR] = TRUE;
      STDNO;
#*****************************************************************# 
#             ***  C H K D C T L   ***                            # 
#  AFTER  -DATA-  , CHECK THAT NEXT WORD IS  -CONTROL-  .         # 
#  IF IT IS, EXIT TO STDYES.  IF NOT, EXIT TO STDNO.              # 
CHKDCTL:  
      IF NEXLENG EQ 7  AND  B<0,42>NEXWORD EQ O"03171624221714" 
        THEN STDYES;
      STDNO;
  
CHKCLR: 
#**********************************************************************#
# CLEAR -CHECK SUB-ENTRY FOUND- FLAG                                   #
#**********************************************************************#
      CHKFLG = FALSE; 
      STDNO;
  
CHKCHK: 
#**********************************************************************#
#   IF -CHECK SUB-ENTRY FOUND- FLAG IS TRUE, THEN RETURN VIA STDYES,   #
#     ELSE RETURN VIA STDNO.                                           #
#**********************************************************************#
      IF CHKFLG 
      THEN
        BEGIN 
        STDYES; 
        END 
      ELSE
        BEGIN 
        STDNO;
        END 
  
CHKSET: 
#**********************************************************************#
#   SET -CHECK SUB-ENTRY FOUND- FLAG                                   #
#**********************************************************************#
      CHKFLG = TRUE;
      STDNO;
  
CHKUNQPROC:   #  #
#**************************************************************#
# STDNO IF DATABASE PROCEDURE WAS SPECIFIED ONCE ALREADY.      #
# OTHERWISE STDYES                 (CHECK CLAUSE, ITEM SUBENTRY)# 
#***************************************************************# 
      IF SCITMCKPROC [CKPTR]  NQ 0
        THEN STDNO; 
      STDYES; 
  CKPIC:   #   #
#**********************************************************************#000680
#                 ***  C K P I C   ***                                 #000610
#   SETS SYMBOL ITEM TYPE BIT, ZEROES OUT ITEM CLASS AND RESETS        #
#   NUMERIC KEYWORD FLAG. CHECKS TO SEE IF PICTURE WAS SPECIFIED,      #
#   IF SO, RESETS ITEM ENTRY BECAUSE TYPE OVERRIDES PICTURE AND        #
#   RETURNS TO STDNO, ELSE RETURNS TO STDYES.                          #
#**********************************************************************#000690
      TPFLAG = 1; 
      SYMITYPEDF[TEMPTR] = TRUE;                                        000800
      SCITEMTYPE[IPTR] = TRUE;     # SET ITEM TYPE FLAG                #
      CLASS = 0;                   # ZERO ITEM CLASS VALUE             #
                                   # RESET TYPE KEYWORD FLAGS          #
      CHARFLAG = FALSE;            # CHARACTER                         #
      CPLXFLAG = FALSE;            # COMPLEX                           #
      DECFLAG = FALSE;             # DECIMAL                           #
      FIXFLAG = FALSE;             # FIXED                             #
      FLOTFLAG = FALSE;            # FLOAT                             #
      REALFLAG = FALSE;            # REAL                              #
      IF SCITMPICLITP [IPTR] NQ 0  THEN 
        BEGIN                                                           000670
          B<0,48>SCBUFWORD[IPTR+1] = 0; 
          B<0,18>SCBUFWORD[IPTR+2] = 0; 
          STDNO;
        END 
      STDYES; 
  CODEALWAYS:                                                           013510
#**********************************************************************#013520
#                ***  C O D E A L W A Y S  ***  (DATA SUB-ENTRY)       #013530
#   SETS THE ALWAYS FLAG IN THE DIRECTORY WORKING BUFFER FOR THE       #013540
#   ENCODING/DECODING CLAUSE.                                          #013550
#                                                                      #013560
#   RETURNS TO STDNO.                                                  #013570
#**********************************************************************#013580
      SCITEMALWAYS[DPTR] = TRUE;                                        013590
      STDNO;                                                            013600
  CODEDBP:                                                              013610
#**********************************************************************#013620
#                ***  C O D E D B P  ***  (DATA SUB-ENTRY)             #013630
#   STORES THE DATA BASE PROCEDURE NAME SPECIFIED IN THE ENCODING/DE-  #013640
#   CODING CLAUSE INTO THE DIRECTORY WORKING-BUFFER.                   #013650
#                                                                      #013660
#   RETURNS TO STDNO IF THE DATA BASE PROCEDURE NAME IS GREATER THAN   #013670
#   7 CHARACTERS. ELSE STORES THE NAME WITH TRAILING ZEROS INTO THE    #013680
#   DIRECTORY WORKING BUFFER AT DPTR. INCREMENTS DPTR TO THE NEXT WORD.#013690
#   RETURNS TO STDYES.                                                 #013700
#**********************************************************************#013710
      TOTITMPROC = TOTITMPROC + 1;   # TO COMPUTE MAX NO. DBP PROCS    #000850
      SCRECDBPCKFG[RPTR] = TRUE;                                        000270
      SCITEMDBPFLG[IPTR] = TRUE;
      IF CURLENG GR 7 THEN                                              013720
        BEGIN                                                           000710
          C<0,7>SCITEMCODER[DPTR] = C<0,7>CURWORD[0];                   000660
          DPTR = DPTR + 1;                                              000730
          CHKBUFOVF;
          STDNO;                                                        000740
        END                                                             000750
      C<0,CURLENG>SCITEMCODER[DPTR] = C<0,CURLENG>CURWORD[0];           013740
      DBPBUILD; 
      DPTR = DPTR + 1;                                                  013750
      CHKBUFOVF;
      STDYES;                                                           013760
  CODEOPT:                                                              013770
#**********************************************************************#013780
#                ***  C O D E O P T  ***  (DATA SUB-ENTRY)             #013790
#   INDICATES THE ENCODING/DECODING OPTION IN THE DIRECTORY WORKING    #013800
#   BUFFER AND THE SYMBOL TABLE. SETS THE NEXT BIT IN THE DIRECTORY    #013810
#   WORKING BUFFER IF THE ENCODING/DECODING CLAUSE IS REPEATED.        #013820
#                                                                      #013830
#   INCREMENTS COUNTER EACH TIME CALLED. IF THE COUNTER IS GREATER THAN#013840
#   ONE. A CHECK IS MADE TO SEE IF HE SAME OPTION WAS SPECIFIED. IF THE#013850
#   SAME, IT RETURNS TO STDNO, ELSE SETS THE NEXT BIT, AND STORES THE  #013860
#   DATA BASE PROCEDURE NAME, IN THE DIRECTORY WORKING BUFFER. SETS THE#013870
#   ENCODING/DECODING BIT IN THE SYMBOL TABLE. RETURNS TO STDNO.       #013880
#**********************************************************************#013890
      ENCFLAG = ENCFLAG + 1;                                            013900
      IF ENCFLAG GR 1 THEN                                              013910
        BEGIN                                                           013920
          SCITEMCNEXT[DPTR - 1] = TRUE;                                 000740
        END                                                             013940
       ELSE                                                             013950
        BEGIN                                                           013960
          SCITMENCDPTR[IPTR] = DPTR - IPTR;                             000770
          SYMIENCDECDF[TEMPTR] = TRUE;                                  013980
        END                                                             013990
      SCITEMENCODE[DPTR] = CURP1;                                       014000
      STDNO;                                                            014010
  DINIT:                                                                014020
#**********************************************************************#014030
#                ***  D I N I T  ***  (DATA SUB-ENTRY)                 #014040
#   INITIALIZES POINTERS.                                              #014050
#                                                                      #014060
#   RETURNS TO STDNO.                                                  #014070
#**********************************************************************#014080
      SCITEMDBPFLG[IPTR] = FALSE;    # PRESUME FALSE, LET DBP OR VALUE #
                                     # CLAUSE SET TRUE IF CALLED       #
      SCRECDITMPTR[RPTR] = DPTR;                                        000220
      IPTR = DPTR;                                                      000150
      DPTR = DPTR + ITEMFIXW;    # ADD LENGTH OF FIXED ITEM ENTRY.     #
      CHKBUFOVF;
      STDNO;                                                            014130
  DPUTITEM:                                                             014540
#**********************************************************************#000780
#                   ***  D P U T I T E M  ***                          #000680
#   CALCULATES ITEM ENTRY LENGTH AND STORES IT IN THE DIRECTORY WORK   #
#   BUFFER. SETS NEXT POINTER OF PRIOR ITEM TO IPTR-PRIPTR.BUILD DIR-  #
#   ECTORY AND SYMBOL TABLE. RETURNS TO STDYES.                        #
#**********************************************************************#000790
      ORDINALCTR = ORDINALCTR + 1;                                      000500
      SCITMORDNUM[IPTR] = ORDINALCTR;                                   000510
      SCITMENTRYLG[IPTR] = DPTR - IPTR;                                 000520
      SCITEMPRIORP [ IPTR ] = NXIPTR - PRIORPTR;
      PRIORPTR = NXIPTR;                                                014560
      PPTR = IPTR;
      NXIPTR = NXIPTR + (DPTR - IPTR);                                  014570
      IF (DPTR - IPTR) GR MAXITMENTLEN THEN 
        DIAGDL( 285 );       #MAX ITEM ENTRY LENGTH EXCEEDED.          #
      SCITEMNXTPTR[IPTR] = DPTR - IPTR;   # POINTS TO NEXT ITEM        #000320
      IPTR = DPTR;                                                      014590
      SYMBOLBUILD;                                                      014610
      DPTR = DPTR + ITEMFIXW; 
      CHKBUFOVF;
      STDYES;                                                           014620
  GETANAMELOC:                                                          015160
#**********************************************************************#015170
#                ***  G E T A N A M E L O C  ***  (RECORD SUB-ENTRY)   #015180
#   INCREMENTS THE AREA NAME COUNTER (ANAMECOUNT). IF THE AREA NAME    #015220
#   WAS DEFINED (REFSTATUS=1) THE LOCATION (SYMPTR) PASSED BACK BY     #015230
#   THE HASH ROUTINE (HASHIT) IS STORED INTO THE DIRECTORY WORK BUFFER #
#   FOR THE RECORD ENTRY. RETURN IS TO STDYES. IF THE AREA NAME WAS    #
#   NOT DEFINED, RETURN IS TO STDNO.                                   #
#**********************************************************************#015270
      IF REFSTATUS EQ 0 THEN                                            000930
          STDNO;                                                        015300
      SAVARORD = SYMARORDWK[2];       #SAVE AREA ORDINAL# 
      # STORES THE LOCATION OF THE ENTRY IN THE SCHEMA              #   000790
      SCRWITHINA1[RPTR] = SYMWRDADDRWK[1];
      STDYES;                                                           015340
  HASHITDA:                                                             015490
#**********************************************************************#015500
#                ***  H A S H I T D A  ***  (AREA ENTRY)               #015510
#   CREATES A SYMBOL TABLE ENTRY FOR AN AREA NAME BEING DEFINED.       #015520
#                                                                      #015530
#   RETURNS TO STDNO.                                                  #015540
#**********************************************************************#015550
      NAMETYPE = AREA$NAME;  # DEF TO4.                                #015560
      REFDEF = DEFINED;      # DEF TO 1.                               #015570
      GOTO HASHITREQ;                                                   015580
  HASHITDI:                                                             015640
#**********************************************************************#015650
#                ***  H A S H I T D I  ***  (DATA SUB-ENTRY)           #015660
#         CREATES A SYMBOL TABLE ENTRY FOR AN ITEM NAME BEING DEFINED. #015670
#                                                                      #015680
#   RETURNS TO STDNO.                                                  #015690
#**********************************************************************#015700
      NAMETYPE = ITEM$NAME;                                             015710
      REFDEF = DEFINED;                                                 015720
      CURWORDADDR = NEXTPTR + IPTR; 
      GOTO HASHREQ1;
  HASHITDR:                                                             015750
#**********************************************************************#015760
#                ***  H A S H I T D R  ***  (RECORD SUB-ENTRY)         #015770
#   CREATES A SYMBOL TABLE ENTRY FOR A RECORD NAME BEING DEFINED.      #015780
#                                                                      #015790
#   RETURNS TO STDNO.                                                  #015800
#**********************************************************************#015810
      NAMETYPE = RECORD$NAME;   # DEF TO 2. SAVE NAME TYPE.            #015820
      REFDEF = DEFINED;  # DEF TO 1. SET DEFINED INDICATOR.            #015830
      GOTO HASHITREQ;                                                   015840
  HASHITRA:                                                             015850
#**********************************************************************#015860
#                ***  H A S H I T R A  ***  (AREA ENTRY)               #015870
#   SEARCHES FOR THE SYMBOL TABLE LOCATION OF AN AREA NAME BEING       #015880
#   REFERENCED.                                                        #015890
#                                                                      #015900
#   RETURNS TO STDNO.                                                  #015910
#**********************************************************************#015920
      NAMETYPE = AREA$NAME;                                             015930
      REFDEF = REFERENCED;                                              015940
      GOTO HASHITREQ;                                                   015950
  HASHITRI:  # #                                                        000125
#**********************************************************************#000850
#                 ***  H A S H I T R I   ***                           #000880
#   CREATES A SYMBOL TABLE ENTRY FOR AN ITEM BEING REFERENCED.  THEN   #000890
# THEN CALL HASHIT DIRECTLY BECAUSE NAME MAY BE QUALIFIED. EXIT STDNO. #
#**********************************************************************#000910
      NAMETYPE = ITEM$NAME;                                             000130
      REFDEF = REFERENCED;                                              000140
      CURWORDADDR = NEXTPTR + IPTR; 
      HASHIT; 
      STDNO;
  HASHITRR:                                                             015960
#**********************************************************************#015970
#                ***  H A S H I T R R  ***  (RECORD SUB-ENTRY)         #015980
#   SEARCHES FOR THE SYMBOL TABLE LOCATION OF A RECORD NAME BEING      #015990
#   REFERENCED.                                                        #016000
#                                                                      #016010
#   RETURNS TO STDNO.                                                  #016020
#**********************************************************************#016030
      NAMETYPE = RECORD$NAME;                                           016040
      REFDEF = REFERENCED;                                              016050
      FOR I=0 STEP 1 UNTIL CURLENW-1 DO # STORE NAME FOR HASH ROUTINE  #000930
        NAME[I] = CURWORD[I];                                           016070
      NAMELENC = CURLENG;                                               016080
      NAMELENW = CURLENW;                                               016090
      HASHIT;                                                           016100
      SYMSLOCSYMDF[TEMPTR] = SYMPTR;                                    016110
      STDNO;                                                            016120
  HASHITREQ:                                                            016280
#**********************************************************************#003050
#                 ***  H A S H I T R E Q  ***                          #001080
#   SETS PRELIMINARY ITEMS BEFORE GOING TO HASHIT.  COPIES  CURWORD    #001090
#   TO NAME.  RETURNS TO STDNO.                                     #   001100
#**********************************************************************#001110
      CURWORDADDR = NEXTPTR;
 HASHREQ1:    # ENTRY FROM HASHITDI  #
      NAMELENC = CURLENG;                                               016300
      NAMELENW = CURLENW;                                               016310
      FOR I=0 STEP 1 UNTIL CURLENW-1 DO                                 016320
        NAME[I] = CURWORD[I];                                           016330
      HASHIT;                                                           016340
      STDNO;                                                            016350
  ICHECKBA:   #   #                                                     000730
#**********************************************************************#000920
#               ***  I C H E C K B A  ***                              #001130
#   CHECKS ITEM ON CLAUSE BEFORE/AFTER BIT, IF ON STDYES, OFF STDNO.   #001140
#**********************************************************************#001150
      IF SCITEMONBFAF[ONPTR] EQ 0 THEN                                  000740
        STDNO;                                                          000750
      STDYES;                                                           000760
  INCRDPTR:                                                             016360
#**********************************************************************#016370
#                ***  I N C R D P T R  ***                             #016380
#   INCREMENTS DPTR TO POINT TO THE NEXT WORD OF THE DIRECTORY WORKING #016390
#   BUFFER.                                                            #016400
#                                                                      #016410
#   SETS THE NEXT ON FLAG IN THE ON ENTRY IN THE DIRECTORY WORKING    # 
#   BUFFER.                                                           # 
#   RETURNS TO STDNO.                                                  #016420
#**********************************************************************#016430
      DPTR = DPTR + 1;                                                  016440
      CHKBUFOVF;
      SCITEMNEXTON[ONPTR] = TRUE; 
      STDNO;                                                            016450
  INCRDPTRA:  #   # 
#**********************************************************************#
#                 *** I N C R D P T R A ***                            #
#   CHECK OPEN/CLOSE AND UPDATE/RETRIEVAL OPTIONS AND SET APPROPRIATE  #
#   DEFAULT BITS.                                                      #
#   INCREMENTS DPTR TO POINT TO THE NEXT WORD OF THE DIRECTORY WORKING #
#   BUFFER.                                                            #
#**********************************************************************#
      IF NOT SCARCALLOPN[DPTR] AND NOT SCARCALLCLS[DPTR] THEN  # IF    #
        BEGIN  # OPEN AND CLOSE OPTIONS NOT EXPLICITLY SPECIFIED,      #
        SCARCALLOPN[DPTR] = TRUE;      # SET OPEN FLAG. # 
        SCARCALLCLS[DPTR] = TRUE;      # SET CLOSE FLAG. #
        END 
      IF SCARONUPRTOP[DPTR] EQ 0 THEN 
        BEGIN                # NO UPDATE/RETRIEVAL OPTIONS SPECIFIED.  #
        IF SCARCALLOPN[DPTR] THEN 
          SCARONUPRTOP[DPTR] = O"77";  # SET DEFAULT UPD/RETR BITS.    #
        END 
      DPTR = DPTR + 1;
      CHKBUFOVF;
      STDNO;
 LOADDCT: 
# **************************************************************# 
#               ***   L O A D D C T   ***                       # 
# LOAD DATA CONTROL OVERLAY . . . ( 1 , 2 )                     # 
# **************************************************************# 
      LOADOVL ( BASE1X, 1, 2 ); 
  
  
   NOLEV: 
#**********************************************************************#
#  SETS LFLAG TO 0 AND DEFAULT LEVEL NO. TO A 01 AND RETURNS TO STDYES #
#**********************************************************************#
      LFLAG = 0;
      ITEMP = 1;
                   # RETURN IF NEXT SOURCE WORD IS AREA,DATA OR RECORD #
      IF NEXLENG EQ 4 AND (C<0,4>NEXWORD EQ "AREA" OR 
                          C<0,4>NEXWORD EQ "DATA") OR 
         NEXLENG EQ 6 AND C<0,6>NEXWORD EQ "RECORD" THEN
        STDNO;
      STDYES; 
  NUMTYPE:  
#**********************************************************************#
#                ***   N U M T Y P E   ***                             #
#   COMPARES CURP1, WHICH INDICATES WHICH KEYWORD WAS SPECIFIED, WITH  #
#   ITS PREDECESSORS, IF NOT VALID, RETURN TO STDNO. IF THE SYNTAX IS  #
#   CORRECT, SET THE DATA CLASS AND SIZE VARIABLES TO THE APPROPRIATE  #
#   VALUE. RETURN IS TO STDYES.                                        #
#**********************************************************************#
      IF CHARFLAG                  # ERROR IF CHARACTER NUMERIC        #
      THEN
        STDNO;
                                   #--------------COMPLEX--------------#
      IF CURP1 EQ COMPLEX          # IF KEYWORD IS COMPLEX             #
      THEN
        BEGIN 
        IF CPLXFLAG                # IF DUPLICATE KEYWORD              #
          OR FIXFLAG               #   OR FIXED COMPLEX                #
            OR FLOTFLAG            #     OR FLOAT COMPLEX              #
              OR REALFLAG          #       OR REAL COMPLEX             #
        THEN
          STDNO;                   # ISSUE DIAGNOSTIC ON RETURN        #
                                   # STORE COMPLEX ITEM INFORMATION    #
        CLASS = 15;                # DATA CLASS                        #
        SCITEMSIZE[IPTR] = 20;     # SIZE - COMPLEX = 2 WORDS          #
        CPLXFLAG = TRUE;           # SET COMPLEX KEYWORD FLAG          #
        STDYES;                    # RETURN                            #
        END 
                                   #--------------DECIMAL--------------#
      IF CURP1 EQ DECIMAL          # IF KEYWORD IS DECIMAL             #
      THEN
        BEGIN 
        IF DECFLAG                 # IF DUPLICATE KEYWORD              #
        THEN
          STDNO;                   # ISSUE DIAGNOSTIC ON RETURN        #
  
        IF NOT (CPLXFLAG           # IF NO OTHER TYPE OPTION SPECIFIED #
          OR FLOTFLAG              # STORE FIXED DATA INFORMATION      #
            OR REALFLAG)
        THEN
          BEGIN 
          CLASS = 10;              # DATA CLASS                        #
          SCITEMSIZE[IPTR] = 10;   # SIZE - FIXED = 1 WORD             #
          END 
        DECFLAG = TRUE;            # SET DECIMAL KEYWORD FLAG          #
        STDYES;                    # RETURN                            #
        END 
                                   #---------------FIXED---------------#
      IF CURP1 EQ FIXED            # IF KEYWORD IS FIXED               #
      THEN
        BEGIN 
        IF FIXFLAG                 # IF DUPLICATE KEYWORD              #
          OR CPLXFLAG              #   OR COMPLEX FIXED                #
            OR FLOTFLAG            #     OR FLOAT FIXED                #
        THEN
          STDNO;                   # ISSUE DIAGNOSTIC UPON RETURN      #
  
        IF NOT (DECFLAG            # IF NO OTHER TYPE OPTION SPECIFIED #
          OR REALFLAG)             # STORE FIXED DATA INFORMATION      #
        THEN
          BEGIN 
          CLASS = 10;              # DATA CLASS                        #
          SCITEMSIZE[IPTR] = 10;   # SIZE - FIXED = 1 WORD             #
          END 
        FIXFLAG = TRUE;            # SET FIXED KEYWORD FLAG            #
        STDYES;                    # RETURN                            #
        END 
                                   #---------------FLOAT---------------#
      IF CURP1 EQ FLOAT            # IF KEYWORD IS FLOAT               #
      THEN
        BEGIN 
        IF FLOTFLAG                # IF DUPLICATE KEYWORD              #
          OR CPLXFLAG              #   OR COMPLEX FLOAT                #
            OR FIXFLAG             #     OR FIXED FLOAT                #
        THEN
          STDNO;                   # ISSUE DIAGNOSTIC UPON RETURN      #
                                   # STORE FLOAT DATA INFORMATION      #
        CLASS = 13;                # DATA CLASS                        #
        SCITEMSIZE[IPTR] = 10;     # SIZE - FLOAT = 1 WORD             #
        FLOTFLAG = TRUE;           # SET FLOAT KEYWORD FLAG            #
        STDYES;                    # RETURN                            #
        END 
                                   #---------------REAL----------------#
      IF CURP1 EQ REAL             # IF KEYWORD IS REAL                #
      THEN
        BEGIN 
        IF REALFLAG                # IF DUPLICATE KEYWORD              #
          OR CPLXFLAG              # OR COMPLEX REAL                   #
        THEN
          STDNO;                   # ISSUE DIAGNOSTIC UPON RETURN      #
  
        IF NOT (FLOTFLAG           # IF NO OTHER OPTION SPECIFIED      #
          OR FIXFLAG               # STORE FIXED DATA INFORMATION      #
            OR DECFLAG) 
        THEN
          BEGIN 
          CLASS = 10;              # DATA CLASS                        #
          SCITEMSIZE[IPTR] = 10;   # SIZE - FIXED = 1 WORD             #
          END 
        REALFLAG = TRUE;           # SET REAL KEYWORD FLAG             #
        STDYES;                    # RETURN                            #
        END 
  
      STDNO;                       # ERROR IF KEYWORD IS CHARACTER     #
  OCCURSINT:                                                            017920
#**********************************************************************#017930
#                ***  O C C U R S I N T  ***  (DATA SUB-ENTRY)         #017940
#   CONVERTS THE INTEGER VALUE SPECIFIED IN THE OCCURS CLAUSE, AND IF  #017950
#   ITS GREATER THAN ZERO. STORES IT IN THE DIRECTORY WORKING BUFFER.  #017960
#                                                                      #017970
#   SETS THE DIM/OCCURS FLAG IN THE ITEM ENTRY HEADER (IPTR+2) AND SETS#017980
#   THE OCCURS FLAG IN THE ITEM ENTRY IN THE SYMBOL WORKING BUFFER.    #017990
#   RETURNS TO STDNO.                                                  #018000
#**********************************************************************#018010
      DTEMP = C<0,10>CURWORD[0];
      DISPDECTOBIN;                                                     018030
      IF ITEMP LS 1 THEN   # CHECK IF NUMBER OF OCCURENCES IS LESS     #018040
                           # THAN ZERO.                                #018050
          STDNO;                                                        018060
      SCITMINTVAL [IPTR] = ITEMP; 
      SCITMDIMOCC[IPTR] = FALSE;                                        000990
      SYMIOCCURSDF[TEMPTR] = TRUE;                                      018090
      STDYES;                                                           018110
  OCCURSNAME:                                                           018120
#**********************************************************************#018130
#                ***  O C C U R S N A M E  ***  (DATA SUB-ENTRY)       #018140
#   SETS THE OCCURS FLAGS IN THE DIRECTORY AND SYMBOL WORKING BUFFERS  #018150
#   IF THE DATA-BASE-IDENTIFIER SPECIFIED IN THE OCCURS CLAUSE WAS     #018160
#   PREVIOUSLY DEFINED.                                                #018170
#                                                                      #018180
#   RETURNS TO STDYES. IF DATA-BASE-IDENTIFIER WAS NOT PREVIOUSLY      #018190
#   DEFINED, IT RETURNS TO STDNO.                                      #018200
#**********************************************************************#018210
      IF REFSTATUS EQ 0 THEN                                            018230
          STDNO;                                                        018240
      SCITMDIMOCC[IPTR] = TRUE;                                         000960
      SYMIOCCURSDF[TEMPTR] = TRUE;                                      018260
      IF VGRPFLAG GQ 0 THEN 
        VGRPFLAG = SCITEMLEVEL[IPTR]; # SET FLAG TO LEVEL OF VAR DIM GR#
      STDYES;                                                           018270
  ONINIT:  # O N I N I T  #                                             003790
#**********************************************************************#018280
#                ***  O N I N I T  ***  (DATA SUB-ENTRY)               #018290
#   SETS THE ON FLAGS IN BOTH THE DDIRECTORY AND SYMBOL WORKING BUFFERS#018300
#                                                                      #018310
#   INCREMENTS THE ON COUNTER (ONCOUNT) AND IF THE ON COUNTER IS       #018320
#   GREATER THAN ONE, SETS THE NEXT ON FLAG IN THE ON ENTRY IN THE     #018330
#   DIRECTORY WORKING BUFFER.                                          #018340
#   RETURNS TO STDNO.                                                  #018350
#**********************************************************************#018360
      IF NOT SYMIONDF [TEMPTR]
        THEN
        BEGIN 
        SYMIONDF [TEMPTR] = TRUE; 
        SCITEMONPTR [IPTR] = DPTR - IPTR; 
        END 
      ONPTR = DPTR;                                                     018400
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      ONCOUNT = ONCOUNT + 1;                                            018410
      STDNO;                                                            018460
  ONITEMBA:   # #                                                       000500
#**********************************************************************#003080
#               ***  O N I T E M B A  ***                              #001230
#   SETS BEFORE OR AFTER BIT ONCE WE HAVE FOUND THE KEYWORD.           #001240
#**********************************************************************#001250
      SCITEMONBFAF[ONPTR] = SCITEMONBFAF[ONPTR] LOR CURP2;              000510
      STDNO;                                                            000520
  ONITEMEND:                                                            001040
#**********************************************************************#018470
#                ***  O N I T E M E N D  ***  (DATA SUB-ENTRY)         #018480
#   CHECKS IF THE DIRECTORY WORKING BUFFER POINTER HAS TO BE INCREMENT #018490
#   ED.                                                                #018500
#                                                                      #018510
#   INITIALIZES THE ON COUNTER (ONCOUNT) TO ZERO. RETURNS TO STDNO.    #018520
#**********************************************************************#018530
      ONCOUNT = 0;                                                      018550
      DPTR = DPTR + 1;
      CHKBUFOVF;
      STDNO;                                                            018570
  ONITEMDFLT:   #  #                                                    018580
#**********************************************************************#018590
#                ***  O N I T E M F L T  ***  (DATA SUB-ENTRY)         #018600
#   SETS ALL OF THE ON OPTIONS IN THE ON HEADER IN THE DIRECTORY       #018610
#   WORKING BUFFER.                                                    #018620
#                                                                      #018630
#   RETURNS TO STDNO.                                                  #018640
#**********************************************************************#018650
      IF SCITEMONOPTS[ONPTR] EQ 0 THEN                                  000420
        SCITEMONOPTS[ONPTR] = 7;        # ALL ARE SET BY DEFAULT       #000430
                                        # IF NONE WERE SET PREVIOUSLY  #000440
      STDNO;                                                            018670
  ONITEMDBP:                                                            018680
#**********************************************************************#018690
#                ***  O N I T E M D B P  ***  (DATA SUB-ENTRY)         #018700
#   STORES THE DATA-BASE-PROCEDURE NAME SPECIFIED IN THE ON CLAUSE INTO#018710
#   THE DIRECTORY WORKING BUFFER IF THE DATA-BASE-PROCEDURE NAME IS    #018720
#   VALID                                                              #018730
#                                                                      #018740
#   RETURNS TO STDYES. IF THE DATA-BASE-PROCEDURE NAME IS NOT A VALID  #018750
#   NAME THEN IT RETURNS TO STDNO.                                     #018760
#**********************************************************************#018770
      TOTITMPROC = TOTITMPROC + 1;                                      000870
      SCRECDBPCKFG[RPTR] = TRUE;                                        000310
      SCITEMDBPFLG[IPTR] = TRUE;
      DBPBUILD;                                                         000430
      IF CURLENG GR 7 THEN                                              018780
        BEGIN                                                           001050
          C<0,7>SCITEMONCALL[ONPTR] = C<0,7>CURWORD[0];                 001060
          STDNO;                                                        001070
        END                                                             001080
      C<0,CURLENG>SCITEMONCALL[ONPTR] = C<0,CURLENG>CURWORD[0];         018800
      STDYES;                                                           018810
  ONITEMOPT:                                                            018820
#**********************************************************************#018830
#                ***  O N I T E M O P T  ***  (DATA SUB-ENTRY)         #018840
#   SETS THE OPTIONS SPECIFIED IN THE ON CLAUSE INTO THE DIRECTORY     #018850
#   WORKING BUFFER.                                                    #018860
#                                                                      #018870
#**********************************************************************#018880
      SCITEMONOPTS[ONPTR] = SCITEMONOPTS[ONPTR] LOR CURP2;              018890
      STDNO;                                                            018900
  PICTURE:                                                              019960
#**********************************************************************#001060
#   THIS CRACKS THE PICTURES AND SETS THE TABLES.  WHEN COMPLETED  IF  #001070
#   PICTURE IS GOOD, GO TO EXIT AND STDYES, IF ERROR ENCOUNTERED IT    #001080
#   ENDS AND ROUTINE GOES TO DIAGNOS.                                  #001090
#**********************************************************************#001100
      L = 0;                                                            000220
      TPFLAG = 1; 
          DTEMP = "          "; 
      SCITMPICLEN[IPTR] = CURLENW;   # LENGTH IN WORDS OF PICTURE LIT  #000350
      SCITMPICLITP[IPTR] = DPTR -IPTR;  # OFFSET PTR TO PICTURE LIT  #  000360
      FOR I = 0 STEP 1 UNTIL CURLENW-1 DO                               000240
        SCBUFWORD[DPTR + I] = CURWORD[I];                               000380
                            # STORES PICTURE LITERAL FOR EXHIBITS USE # 000385
      DPTR = DPTR + CURLENW;
      CHKBUFOVF;
      SYMIPICDF[TEMPTR] = TRUE;                                         019970
      P<STATETABLE> = LOC(STATETRANS);                                  019990
      GOTO NEX1CHAR;                                                    020000
  STATE1:                                                               020010
      STATE = 6;                                                        020020
      GOTO NEXCHAR;                                                     020030
  STATE2:                                                               020040
      STATE = 12;                                                       020050
      GOTO NEXCHAR;                                                     020060
  STATE3:                                                               020070
      STATE = 18;                                                       020080
      GOTO NEXCHAR;                                                     020090
  STATE4:                                                               020100
      STATE = 24;                                                       020110
      GOTO NEXCHAR;                                                     020120
  STATE5:                                                               020130
      STATE = 30;                                                       020140
      GOTO NEXCHAR;                                                     020150
  STATE6:                                                               020160
      STATE = 36;                                                       020170
      GOTO NEXCHAR;                                                     020180
  STATE7:                                                               020190
      STATE = 42;                                                       020200
      GOTO NEXCHAR;                                                     020210
  STATE8:                                                               020220
      STATE = 48;                                                       020230
      GOTO NEXCHAR;                                                     020240
  STATE9:                                                               020250
      STATE = 54;                                                       020260
      GOTO NEXCHAR;                                                     020270
  TABLE30B:                                                             020280
      STATE = 30;                                                       020290
      GOTO CONT5;                                                       020300
  TABLE6B:                                                              020310
      STATE = 6;                                                        020320
      GOTO CONT5;                                                       020330
  TABLEB:                                                               020340
      STATE = 0;                                                        020350
  CONT5:                                                                020360
      GOTO NEXCHAR;                                                     020380
  STATE4V:                                                              020390
      STATE = 24;                                                       020400
  CONT2:                                                                020410
      PICLENG = PICLENG -1;                                             020420
      PTLOC= PICLENG;                                                   020430
      SCITEMACTLPT[IPTR] = FALSE;      # ASSUMED                       #001110
      GOTO NEXCHAR;                                                     020450
  STATE4D:                                                              020460
      SCITEMACTLPT[IPTR] = TRUE;           #   ACTUAL      #            001130
      STATE = 24;                                                       020480
      PTLOC = PICLENG;
      GOTO NEXCHAR;                                                     020500
  STATES:                                                               020510
      IF SIGNIND EQ 1 THEN                                              020520
          GOTO ERR19;                                                   000250
      SCITEMSIGN[IPTR] = TRUE;      # SEPERATE SIGN SPECIFIED # 
      DIAGDL(322);                                                      001170
      GOTO NEX2CHAR;                                                    020580
  STATE3T:                                                              020590
      IF SIGNIND EQ 1 THEN                                              000680
          GOTO ERR19;                                                   000270
      SOPFLAG = TRUE; 
      SCITEMSIGN[IPTR] = FALSE;     # SIGN OVERPUNCH SPECIFIED #
      STATE = 18;                                                       020610
      GOTO NEX2CHAR;                                                    020620
  STATED:                                                               020630
      STATE = 0;                                                        020640
      GOTO NEX1CHAR;                                                    020650
  REPITION:                                                             020660
          DTEMP = "          "; 
      ITEMP = 0;                                                        000290
      I = 0;                                                            000620
  REPTCONT:   #    #                                                    000630
      INCRCHARPTR;
      CTEMP = C<CHARPTR,1>CURWORD[WRDPTR];                              020730
      IF CTEMP LS O"33" OR CTEMP GR O"44" THEN                          020740
        BEGIN                                                           020750
          IF CTEMP EQ O"52" THEN                                        020760
            BEGIN                                                       020770
              DISPDECTOBIN;                                             020780
              PICLENG = PICLENG + ITEMP - 2;                            020790
              GOTO NEXCHAR;                                             020800
            END                                                         020810
          GOTO ERR20;                                                   000290
        END                                                             020840
      C<I,1>DTEMP = CTEMP;                                              020850
      I = I + 1;                                                        000550
      GOTO REPTCONT;                                                    000600
  STATE9P:                                                              020880
      STATE = 54;                                                       020890
      SCITEMPTLEFT[IPTR] = TRUE;  # P'S ARE THE LEFTMOST CHARACTERS    #000670
      GOTO CONT1;                                                       020900
  STATE4P:                                                              020910
      STATE = 24;                                                       020920
      RIGHT = 1;                                                        000790
  CONT1:                                                                020930
      SCITEMACTLPT[IPTR] = FALSE;      # SCALING POSITION              #001260
      PTLOC = PICLENG;                                                  020950
      FOR I=0 STEP 1 UNTIL 30 DO                                        020960
        BEGIN                                                           020970
        INCRCHARPTR;
      IF C<CHARPTR,1>CURWORD[WRDPTR] EQ O"51" THEN                      003490
        BEGIN                                                           003500
          DTEMP = "          "; 
          ITEMP = 0;                                                    003520
          I=0;                                                          003530
                                                                        001270
  REPEAT1:                                                              001280
            INCRCHARPTR;
            CTEMP = C<CHARPTR,1>CURWORD[WRDPTR];                        003610
            IF CTEMP LS O"33" OR CTEMP GR O"44" THEN                    003620
              BEGIN                                                     003630
                IF CTEMP EQ O"52" THEN                                  003640
                  BEGIN                                                 003650
                    DISPDECTOBIN;                                       003660
                    L = ITEMP;                                          003680
                    INCRCHARPTR;
                    GOTO STOREPLOC;                                     003690
                  END                                                   003700
                GOTO ERR20;                                             000310
              END                                                       003730
            C<I,1>DTEMP = CTEMP;                                        003740
            I = I + 1;                                                  003750
            GOTO REPEAT1;                                               003760
          END                                                           003770
          L = L + 1;                                                    000200
          IF C<CHARPTR,1>CURWORD[WRDPTR] NQ O"20" THEN                  021050
            BEGIN                                                       021060
              GOTO STOREPLOC;                                           021070
            END                                                         021080
        END                                                             021090
      GOTO NEX1CHAR;                                                    021100
    STOREPLOC:                                                          021110
      IF STATE EQ 24 THEN                                               021170
        BEGIN                                                           021180
          IF C<CHARPTR,1>CURWORD[WRDPTR] NQ O"55" AND 
            C<CHARPTR,1>CURWORD[WRDPTR] NQ 0  THEN
            BEGIN 
              IF C<CHARPTR,1>CURWORD [WRDPTR] EQ O"23"  THEN
                BEGIN 
                  GOTO CKSIGN;                                          000400
                END                                                     000410
              IF C<CHARPTR,1>CURWORD[WRDPTR] EQ O"24" THEN   # T #
                BEGIN 
                  GOTO ERR26; 
                END 
              IF C<CHARPTR,1>CURWORD[WRDPTR] EQ O"26" THEN              000340
                BEGIN                         #  V  #                   000350
                  PTLOC = PICLENG;                                      000360
                  SCITEMACTLPT[IPTR] = FALSE; #ASSUMED DECIMAL POINT   #001280
                  INCRCHARPTR;
                  IF C<CHARPTR,1>CURWORD [WRDPTR] EQ O"55"
                    OR C<CHARPTR,1>CURWORD [WRDPTR] EQ 0
                    THEN
                    GOTO FIXPTD;                                        000450
                  IF C<CHARPTR,1>CURWORD[WRDPTR] EQ O"23" THEN          000460
                    GOTO CKSIGN;                                        000470
                  GOTO ERR18;                                           000480
                END                                                     000490
              GOTO ERR16;                                               000420
            END                                                         000430
      GOTO FIXPTD;                                                      000630
      END                                                               003390
      IF STATE EQ 54 THEN                                               003400
        BEGIN                                                           003410
          IF C<CHARPTR,1>CURWORD[WRDPTR] EQ O"55" THEN                  003420
            GOTO ERR16;                                                 003430
        END                                                             003440
      GOTO NEX1CHAR;
  STATE2P:                                                              021260
      STATE = 6;                                                        021270
      GOTO CONT1;                                                       021280
  STATE1V:                                                              021290
      STATE = 6;                                                        021300
      GOTO CONT2;                                                       021310
  STATE3K:                                                              021320
      STATE = 18;                                                       021330
      GOTO CONT3;                                                       021340
  STATE3E:                                                              021350
      STATE = 18;                                                       021360
      GOTO CONT4;                                                       021370
  CKSIGN:                                                               021380
      IF SIGNIND EQ 1 THEN                                              021390
        GOTO ERR19;                                                     000330
      PICLENG = PICLENG + 1;                                            021450
      INCRCHARPTR;
      IF C<CHARPTR,1>CURWORD[WRDPTR] NQ O"55"  AND
         C<CHARPTR,1>CURWORD[WRDPTR] NQ 0    THEN 
        GOTO ERR21;                                                     000350
      SLOC = PICLENG;                                                   021560
      SCITEMSIGN[IPTR] = TRUE;      # SEPERATE SIGN PUNCH SPECIFIED # 
      DIAGDL(322);                                                      001310
      GOTO EXIT;                                                        000330
  CKTSIGN:                                                              021590
      IF SIGNIND EQ 1 THEN                                              021600
        GOTO ERR19;                                                     000370
      SOPFLAG = TRUE; 
      SCITEMSIGN[IPTR] = FALSE;     # OVERPUNCH FOUND  #
      GOTO NEX2CHAR;                                                    021660
  STATE6K:                                                              021670
      STATE = 36;                                                       021680
  CONT3:                                                                021690
      DIAGDL(324);
      GOTO EXITEND; 
  STATE6E:                                                              021750
      STATE = 36;                                                       021760
  CONT4:                                                                021770
      DIAGDL(324);
      GOTO EXITEND; 
  FLTSIGN:                                                              021810
      STATE = 48;                                                       021830
      GOTO NEXCHAR;                                                     021840
  STATE7F:                                                              021850
      STATE = 42;                                                       021860
      EXPCNT = EXPCNT + 1;                                              021870
      GOTO NEXCHAR;                                                     021880
  STATEF:                                                               021890
      EXPCNT = EXPCNT + 1;                                              021900
      GOTO NEXCHAR;                                                     021910
                                                                        000140
  NEX2CHAR:                                                             000150
      SIGNIND = 1;                                                      021930
      SCITEMSIGNFG[IPTR] = TRUE;                                        000650
      SLOC = PICLENG;                                                   021940
  NEXCHAR:                                                              021950
      IF C<CHARPTR,1>CURWORD[WRDPTR] EQ O"44" THEN
        BEGIN 
          IF SOPFLAG THEN 
            GOTO ERR26; 
        END 
      PICLENG = PICLENG + 1;                                            021970
      INCRCHARPTR;
  NEX1CHAR:                                                             022030
      GOTO JMPVECTOR[B<STATE,6>STATETBLE[C<CHARPTR,1>CURWORD[WRDPTR]]]; 022040
  ALPHANUM:                                                             022050
      IF PICLENG GR 65535 THEN                                          000170
        DIAGDL(300);                                                    000180
      CLASS = 0;                                                        001030
      GOTO EXIT;                                                        022080
  ALPHA:                                                                022090
      IF PICLENG GR 65535 THEN                                          000200
        DIAGDL(300);                                                    000210
      CLASS = 1;                                                        001050
      GOTO EXIT;                                                        022120
  INTEGERD:                                                             022130
      IF SCITEMSIGN[IPTR] THEN     # IS SEPARATE SIGN SPECIFIED # 
        BEGIN                                                           000130
          IF PICLENG - 1 GR 18 THEN                                     000140
            BEGIN                                                       000150
              DIAGDL(300);                                              000160
            END                                                         000170
        END                                                             000180
       ELSE                                                             000190
        BEGIN                                                           000200
          IF PICLENG GR 18 THEN                                         000210
            BEGIN                                                       000220
              DIAGDL(300);                                              000230
            END                                                         000240
        END                                                             000245
      CLASS = 3;                                                        001070
      GOTO EXIT;                                                        022160
  FIXPTD:                                                               022170
      I = 0;
      IF SCITEMSIGN[IPTR] THEN     #IS SEPARATE SIGN SPECIFIED #
        I = 1;                                                          000250
          IF SCITEMACTLPT[IPTR]   THEN   # ACTUAL DECIMAL POINT     #   001450
        I = I + 1;                                                      001270
      IF (PICLENG - I + L) GR 30 OR ((PICLENG - I) GR 18) THEN
        BEGIN 
        DIAGDL(300);
        END 
      CLASS = 4;
      GOTO EXIT1;                                                       022200
  FLTPTD:                                                               022210
      I = 0;                                                            000450
      IF SCITEMSIGN[IPTR] THEN      # ACTUAL SIGN PUNCHED ? # 
        I = 1;                                                          000270
      IF SCITEMACTLPT[IPTR]   THEN                                      001530
        I = I + 1;                                                      000290
      IF PICLENG - I GR 18 THEN                                         000310
        BEGIN 
        DIAGDL(300);                                                    000320
        END 
      CLASS = 4;                                                        022220
      GOTO EXIT;                                                        022240
  INTEGERB:                                                             022250
      CLASS = 10;                                                       022260
      GOTO EXIT;                                                        022280
  FIXPTB:                                                               022290
      CLASS = 8;                                                        022300
      GOTO EXIT1;                                                       022320
  FLTPTB:                                                               022330
      CLASS = 9;                                                        022340
      GOTO EXIT;                                                        022360
  FIXPTPR:                                                              022370
      I = 0;
      IF SCITEMSIGN[IPTR] THEN
        I = 1;
      IF (PICLENG - I + 1) GR 30 THEN 
        DIAGDL(300);
      CLASS = 4;                                                        001110
      PTLOC = PICLENG;                                                  022390
      GOTO EXIT1;                                                       022410
  FIXPTPRB:                                                             022420
      CLASS = 8;                                                        022430
      PTLOC = PICLENG;                                                  022440
      GOTO EXIT1;                                                       022460
  DTRTYPE:  # #                                                         000160
      I = C<CHARPTR,1>CURWORD[WRDPTR];                                  000170
      IF I EQ "A" THEN                                                  000180
        GOTO ALPHA;                                                     000190
      IF I EQ "X" THEN                                                  000200
        GOTO ALPHANUM;                                                  000210
      IF I EQ "9" THEN                                                  000220
        GOTO INTEGERD;                                                  000230
      GOTO ERR16;                                                       000240
  DIAGNOS:  #      * * *   D I A G N O S   * * *      #                 000390
      DIAGDL(I);
      K = 7;  # TO INDICATE THAT PIC WENT TO DIAGNOS  #                 000620
      GOTO EXIT;
  EXIT1:                                                                022470
      IF RIGHT EQ 0 THEN                                                000690
        BEGIN                                                           000700
          IF L NQ 0 THEN
            SCITEMPTLOC[IPTR] = PICLENG + L;
          ELSE
            SCITEMPTLOC[IPTR] = PICLENG - (PTLOC+1);
          IF SCITEMPTLOC[IPTR] NQ 0 THEN                                000720
            SCITEMPTLEFT[IPTR] = TRUE;   # P'S ARE NOT TO THE RIGHT    #000730
                                         # AND LOCATION IS NOT ZERO    #000740
        END                                                             000750
      ELSE                                                              000760
        SCITEMPTLOC[IPTR] = L;
  EXIT:                                                                 022490
      IF SIGNIND EQ 1 THEN                                              022500
        BEGIN                                                           022510
          SCITEMSLOC[IPTR] = PICLENG - (SLOC + 1);                      001590
        END                                                             022530
      IF PICLENG GR MAXITEMSIZ THEN 
        DIAGDL( 286 );
      SCITEMSIZE[IPTR] = PICLENG;                                       001610
      SCITEMCLASS[IPTR] = CLASS;                                        000850
      IF K EQ 7 THEN                                                    000670
        GOTO EXITEND;                                                   000680
      I = (WRDPTR * 10) + CHARPTR + 1;                                  000130
      IF CURLENG GR I THEN                                              000140
       BEGIN                                                            000145
     #  SEARCHING FOR IMBEDDED BLANKS, ISSUE DIAGNOSTIC IF FOUND #      000160
          FOR L=I STEP 1 UNTIL CURLENG DO                               000170
            BEGIN                                                       000180
              IF C<CHARPTR,1>CURWORD[WRDPTR] NQ O"55" THEN              000190
                BEGIN                                                   000195
                  DIAGDL(317);                                          000200
                  I = 0;                                                000205
                  GOTO EXITEND;                                         000699
                END                                                     000212
              INCRCHARPTR;
            END                                                         000280
       END                                                              000285
  EXITEND:                                                              000640
      K = 0;                                                            000340
      RIGHT = 0;                                                        000830
      STATE = 0;                                                        022620
      CHARPTR = 0;                                                      022630
      PICLENG = 0;                                                      022640
      SIGNIND = 0;                                                      022650
      SOPFLAG = FALSE;
      WRDPTR = 0;                                                       022660
      CTEMP = 0;                                                        022670
      PTLOC = 0;                                                        022680
      SLOC = 0;                                                         022690
      EXPCNT = 0;                                                       022700
      CLASS = 0;                                                        022710
      I = 0;                                                            022720
      STDYES;                                                           022730
  ERR1: # # 
      I = 300;
      GOTO DIAGNOS; 
  ERR2:  # #
      I = 301;
      GOTO DIAGNOS; 
  ERR3: # # 
      I = 302;
      GOTO DIAGNOS; 
  ERR4: # # 
      I = 303;
      GOTO DIAGNOS; 
  ERR5:  # #
      I = 304;
      GOTO DIAGNOS; 
  ERR6: # # 
      I = 305;
      GOTO DIAGNOS; 
  ERR7: # # 
      I = 306;
      GOTO DIAGNOS; 
  ERR8: # # 
      I = 307;
      GOTO DIAGNOS; 
  ERR9: # # 
      I = 308;
      GOTO DIAGNOS; 
  ERR10: # #
      I = 309;
      GOTO DIAGNOS; 
  ERR11: # #
      I = 310;
      GOTO DIAGNOS; 
  ERR12: # #
      I = 311;
      GOTO DIAGNOS; 
  ERR13: # #
      I = 312;
      GOTO DIAGNOS; 
  ERR14: # #
      I = 313;
      GOTO DIAGNOS; 
  ERR15: # #
      I = 314;
      GOTO DIAGNOS; 
  ERR16: # #
      I = 315;
      GOTO DIAGNOS; 
  ERR17: # #
      I = 316;
      GOTO DIAGNOS; 
  ERR18:  #  E R R O R 3 1 7  #                                         000640
      I = 317;                                                          000650
      GOTO DIAGNOS;                                                     000660
  ERR19:  #   #                                                         000150
      I = 318;                                                          000160
      GOTO DIAGNOS;                                                     000170
  ERR20:  #  #                                                          000180
      I = 319;                                                          000190
      GOTO DIAGNOS;                                                     000200
  ERR21: #  #                                                           000210
      I = 320;                                                          000220
      GOTO DIAGNOS;                                                     000230
  ERR26:   #   #
      I = 326;
      GOTO DIAGNOS; 
  
      PROC INCRCHARPTR; 
# THIS PROC INCREMENTS CHARACTER AND WORD POINTER BY 1 FOR PICTURE #
      BEGIN 
      CHARPTR = CHARPTR + 1;
      IF CHARPTR GR 9 
        THEN
        BEGIN 
          WRDPTR = WRDPTR + 1;
          CHARPTR = 0;
        END 
      RETURN; 
      END 
  
  PICTYPCHECK:                                                          000450
#**********************************************************************#000460
#                 ***   P I C T Y P C H E C K   ***                    #
#   CHECKS TO SEE IF A TYPE CLAUSE WAS SPECIFIED PREVIOUSLY FOR THIS   #
#   ITEM, IF SO, RETURN TO STDNO TO ISSUE DIAG 138 -PICTURE OVERRIDDEN-#
#   RETURNS TO STDYES.                                                 #
#**********************************************************************#000490
      IF SCITEMTYPE[IPTR] 
        THEN STDNO; 
      STDYES;                                                           000520
QUALDEFAULT:  #  #
# ********************************************************# 
# SET DEFAULT QUALIFIER FOR DBI IN -OCCURS DBI TIMES-     # 
# TO CURRENT RECORD NAME.  RETURN TO STDNO.               # 
#*********************************************************# 
      NAMEQUAL = 1; 
      QUALNAMELENW = SCRNAMELENW [RPTR];
      QUALNAMELENC = SCRNAMELENC [RPTR];
      FOR I = 0  STEP 1  UNTIL QUALNAMELENW - 1  DO 
        QUALNAME[I] = SCRECORDNAME[3 + I];
      STDNO;
  RCHECKBA:   # #                                                       000830
#**********************************************************************#003100
#   CHECKS BEFORE/AFTER BIT OF RECORD ON CALL, IF SET STDYES,ELSE STDNO#000410
#                   ***   R C H E C K B A   ***                        #002030
#   CHECKS BEFORE/AFTER BIT FOR RECORD ON CALL, IF THERE IS RETURN     #002040
#   IS TO STDYES, IF NOT STDNO.                                        #002050
#**********************************************************************#000420
      IF SCRECONBFAF[DPTR] EQ 0 THEN                                    001670
        STDNO;                                                          000850
      STDYES;                                                           000860
  RECNAMEQUAL:                                                          023730
#**********************************************************************#023740
#                ***  R E C N A M E Q U A L  ***(GLOBAL TO ALL ENTRIES)#023750
#   SATISFIES THE ENTRY CONDITIONS REQUIRED BY THE HASH ROUTINE        #003120
#   (HASHIT) FOR A QUALIFIED NAME.                                     #003130
#                                                                      #023780
#   RETURNS TO STDNO.                                                  #023790
#**********************************************************************#023800
      NAMEQUAL = 1;          # SET NAME FLAG.                          #023810
      FOR I=0 STEP 1 UNTIL CURLENW-1 DO  # STORE NAME FOR HASHIT.      #023820
          QUALNAME[I] = CURWORD[I];                                     023830
      QUALNAMELENW = CURLENW;   # STORE LENGTH IN WORDS.               #023840
      QUALNAMELENC = CURLENG;   # STORE LENGTH IN CHARACTERS.          #023850
      STDNO;                                                            023860
  RESPNAME:                                                             023970
#**********************************************************************#023980
#                ***  R E S P N A M E  (DATA SUB-ENTRY)                #023990
#   STORES THE DATA-BASE-PROCEDURE NAME SPECIFIED IN THE ACTUAL/VIRTUAL#024000
#   RESULT CLAUSE INTO THE RESULT HEADER ENTRY IN THE DIRECTORY WORKING#024010
#   BUFFER, IF THE DATA-BASE-PROCEDURE NAME IS VALID.                  #024020
#                                                                      #024030
#   SETS THE RESULT FLAG AND EITHER THE ACTUAL OR VIRTUAL FLAG (DEPENDS#024040
#   ON THE CONTENTS OF ACTVIR, WHICH IS SET BY SAVEAV) IN THE ITEM     #024050
#   ENTRY IN THE SYMBOL WORKING BUFFER. STORE THE WORD LOCATION OF THE #024060
#   RESULT HEADER (DPTR) IN THE DIRECTORY WORKING BUFFER INTO THE ITEM #024070
#   HEADER (IPTR+3) IN THE DIRECTORY WORKING BUFFER. RETURNS TO STDYES.#024080
#   IF THE DATA-BASE-PROCEDURE NAME IS INVALID, IT RETURNS TO STDNO.   #024090
#**********************************************************************#024100
      IF CURLENG GR 7 THEN  # CHECK IF DBP NAME IS VALID.              #024110
        BEGIN                                                           001690
          CURLENG = 7;                                                  001700
          J = 4;                                                        001710
        END                                                             001720
      SCRECDBPCKFG[RPTR] = TRUE;                                        000710
      SCITMATVTP[IPTR] = DPTR - IPTR; 
      SCITEMDBPFLG[IPTR] = TRUE;     # DBP OR VALUE CLAUSE CALLED      #
      SCITMRESSCRF[IPTR] = FALSE;                                       000450
      C<0,CURLENG>SCITEMRESULT[DPTR] = C<0,CURLENG>CURWORD[0];          024140
      DBPBUILD;                                                         000390
      SYMIRESDF[TEMPTR] = TRUE;                                         024150
      IF ACTVIR EQ 0 THEN                                               024160
        SYMIACTUALDF[TEMPTR] = TRUE;                                    024170
       ELSE                                                             024180
        BEGIN                                                           024190
          SYMIVRTUALDF[TEMPTR] = TRUE;                                  024200
        END                                                             024230
      TOTITMPROC = TOTITMPROC + 1;                                      000680
      DPTR = DPTR + 1;                                                  024240
      CHKBUFOVF;
      IF J EQ 4 THEN                                                    001750
        STDNO;                                                          001760
      STDYES;                                                           024250
  RINIT:                                                                024660
#**********************************************************************#024670
#                ***  R I N I T  ***  (RECORD SUB-ENTRY)               #024680
#   ZEROS OUT THE DIRECTORY WORKING BUFFER AND INITIALIZES POINTERS.   #024690
#                                                                      #024700
#   RETURNS TO STDNO.                                                  #024710
#**********************************************************************#024720
      FOR I = 0 STEP 1 UNTIL 99 DO
        DOMGRP[I] = 0;
      FOR I = 0 STEP 1 UNTIL DPTR DO
        SCBUFWORD[I] = 0;    #ZERO OUT DIRECTORY WORKING BUFFER#
      RPTR = 0;              # INITIALIZE R POINTER.                   #024760
      DPTR = RECDFIXW;       # INITIALIZES DIRECTORY POINTER FOR RECORD#
      SAVELEVEL = 1;
      PRIORTYP = 0; 
      L1 = 0; 
      LFLAG = 1;
      NXIPTR = NEXTPTR;                                                 024820
      ORDINALCTR = 0;                                                   000560
      STDNO;                                                            024830
  RNAME: #    R N A M E   #                                             001200
#**********************************************************************#024840
#                ***  R N A M E  ***  (RECORD SUB-ENTRY)               #024850
#   STORES THE RECORD NAME SPECIFIED IN THE RECORD CLAUSE AND ITS      #024860
#   LENGTH IN CHARATESR AND WORDS INTO THE RECORD ENTRY HEADER IN THE  #024870
#   DIRECTORY WORKING BUFFER IF THE RECORD NAME WAS NOT PREVIOUSLY     #024880
#   DEFINED.                                                           #024890
#                                                                      #024900
#   RETURNS TO STDYES. IF THE RECORD NAME WAS PREVIOUSLY DEFINED, IT   #024910
#   RETURNS TO STDNO.                                                  #024920
#**********************************************************************#024930
      RECORDERR = FATALERR;        # STORE FATALERR IN TEMP FOR        #
                                   # LATER COMPARISION IN RPUT         #
      RECSIZE = 0;                 # RESET RECSIZE FOR                 #
                                   # LATER COMPARISION                 #
      IF DUPDEFINE EQ 1 THEN  # CHECK IF PREVIOUSLY DEFINED.           #024950
          STDNO;                                                        000830
      C<0,CURLENG>SCRECNAM30[DPTR] = C<0,CURLENG>CURWRD30[0]; 
      SCRECNAMEPTR[RPTR] = DPTR;   # OFFSET POINTER TO RECORD NAME.    #
      DPTR = DPTR + CURLENW;                                            000360
      CHKBUFOVF;
      SCRNAMELENC[RPTR] = CURLENG;                                      001800
                             # STORE THE LENGTH IN CHARACTERS INTO     #001810
                             # THE WORKING STORAGE BUFFER.             #025050
      SCRNAMELENW[RPTR] = CURLENW;                                      001830
                             # STORE THE LENGTH IN WORDS INTO          #001840
                             # WORKING STORAGE BUFFER.                 #025070
      SCRECDATATYP[RPTR] = 7;                                           001860
      PRIORPTR = NEXTPTR;                                               025100
      RECPTR = NEXTPTR; 
      VGRPFLAG = 0; 
      RECORDITEMS = 0;       # KEEPS TRACK OF THE NO. OF ITEMS/RECORD  #000620
      TOTALRECORDS = TOTALRECORDS + 1;  # NO. OF RECORDS IN SCHEMA     #000630
      IF TOTALRECORDS EQ MAXRECDS + 1 THEN
        DIAGDL( 290 );       #MAX TOTAL NUMBER OF RECORDS EXCEEDED.    #
      STDYES;                                                           025110
  RONCALLEND:                                                           025120
#**********************************************************************#025140
#                ***  R O N C A L L E N D  *** (RECORD SUB-ENTRY)      #025150
#   INITIALIZES THE ON COUNTER (ONCOUNT) TO ZERO.                      #025160
#                                                                      #025170
#   RETURNS TO STDNO.                                                  #025180
#**********************************************************************#025190
      ONCOUNT = 0;                                                      001170
      STDNO;                                                            025200
  RONCALLINIT:                                                          025210
#**********************************************************************#025220
#                ***  R O N C A L L I N I T  ***  (RECORD SUB-ENTRY)   #025230
#   IF IT IS THE SECOND TIME RONCALLINIT IS CALLED FOR THE SAME RECORD #025240
#   NAME, IT SETS THE NEXT ON FLAG IN THE ON ENTRY IN THE DIRECTORY    #025250
#   WORKING BUFFER. ELSE IT INITIALIZES THE ON POINTER (ONPTR) AND     #025260
#   STORES THE WORD LOCATION OF THE ON ENTRY IN THE DIRECTORY WORKING  #025270
#   BUFFER INTO THE RECORD ENTRY HEADER (RPTR) IN THE DIRECTORY WORKING#025280
#   BUFFER.                                                            #025290
#                                                                      #025300
#   RETURNS TO STDNO.                                                  #025310
#**********************************************************************#025320
      ONCOUNT = ONCOUNT + 1;                                            025330
      IF ONCOUNT GR 1 THEN                                              025340
        BEGIN                                                           025350
          SCRECNEXTON [DPTR - 1] = TRUE;
          STDNO;                                                        025370
        END                                                             025380
      ONPTR = DPTR;                                                     025390
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      SCRECONLIST[RPTR] = DPTR - RPTR;    # OFFSET TO RECORD CALL LIST #000460
      STDNO;                                                            025410
  RONCALLBA:  #  #                                                      000300
#**********************************************************************#001220
#               ***  R O N C A L L B A  ***                            #001230
#**********************************************************************#001240
      SCRECONBFAF[DPTR] = SCRECONBFAF[DPTR] LOR CURP2;                  000310
      STDNO;                                                            000330
  RONCALLOPT:                                                           025420
#**********************************************************************#025430
#                ***  R O N C A L L O P T  ***  (RECORD SUB-ENTRY)     #025440
#   STORES THE OPTIONS SPECIFIED IN THE ON CLAUSE INTO THE ON ENTRY IN #025450
#   THE DIRECTORY WORKING BUFFER.                                      #025460
#                                                                      #025470
#   RETURNS TO STDNO.                                                  #025480
#**********************************************************************#025490
      SCRECONCALOP[DPTR] = SCRECONCALOP[DPTR] LOR CURP1;                025500
      STDNO;                                                            025510
  RPUT:                                                                 025980
#**********************************************************************#001260
#  COMPLETE RECORD ENTRY AND WRITE IT TO SCHEMA.  CHECK FOR    #
#  ERROR CONDITION OF LAST ITEM IN RECORD BEING A GROUP.  IF   #
#  SO, DO NOT CALL DLSIZE AND EXIT TO STDNO.  ELSE EXIT STDYES.#
#**************************************************************#
      SCITEMNXTPTR [PRIORPTR - NXIPTR + IPTR] = 0;
      IF TOTALRECORDS EQ 1 THEN           # STORE ADDRESS OF FIRST     #
        SCCWFRSTRECA[SCCWPTR] = RECPTR;   # RECORD ENTRY.              #
      FLAG = TRUE;
      IF SCITEMSIZE [PRIORPTR - NXIPTR + IPTR] EQ 0 
        AND ORDINALCTR NQ 0 
        THEN FLAG = FALSE;
      IPTR = 0;                                                         025990
      DPTR = DPTR - ITEMFIXW; 
      CHKBUFOVF;
      IF MAXITEMS LS RECORDITEMS THEN                                   000580
        MAXITEMS = RECORDITEMS;                                         000590
      IF MAXPROCS LS TOTITMPROC THEN                                    000600
        MAXPROCS = TOTITMPROC;                                          000610
      SCRECENTLEN[RPTR] = DPTR;                                         000190
      SCRNUMITEMS[RPTR] = RECORDITEMS;  # NO. OF ITEMS IN THIS RECORD  #000200
      RECENTADDR = LOC(SCWORKBUF);
      IF ORDINALCTR NQ 0 AND FLAG AND VGRPFLAG GQ 0 
      THEN
      BEGIN 
        FOR I = 0 STEP 1 UNTIL 99 DO
          DOMGRP[I] = 0;
        IF FATALERR LQ RECORDERR
        THEN
          BEGIN                    # IF NO ERROR IN RECORD THEN        #
          RECORDERR = FATALERR;    # CALL DLSIZE TO COMPUTE RECORD SIZE#
          FATALERR = 0;            # FATALERR MUST BE ZERO FOR DLSIZE  #
          DLSIZE;                  # TO EXECUTE                        #
          FATALERR = RECORDERR;    # RESTORE OLD VALUE OF FATALERR     #
          END 
      END 
      IF RECSIZE GR MAXRECSIZ THEN
        DIAGDL( 287 );       # RECORD SIZE GREATER THAN THE MAXIMUM.   #
      SCRECLENGTH[0] = RECSIZE; 
      IF SCRECLENGTH [0] GR MAXRECSIZE
        THEN MAXRECSIZE = SCRECLENGTH [0];
      IF DPTR GR MAXRECBUF THEN 
        MAXRECBUF = DPTR;              #SAVE MAX BUFFER USE FOR FL CALC#
      IF DPTR GR MAXRECENTLEN THEN
        DIAGDL( 284 );       #MAXIMUM RECORD ENTRY LENGTH EXCEEDED.    #
      DIRECTBUILD;                                                      026020
      SYMBOLBUILD;                                                      000280
      IF FATALERR EQ 0 THEN                                              DL3A006
      BEGIN                                                              DL3A006
      #****************************************************************#
      # CHECKSUM THE RECORD ENTRY JUST WRITTEN TO THE DIRECTORY,       #
      # INCLUDING ASSOCIATED ITEM ENTRIES, USING AREA CHECKSUM AS BASE.#
      # PRIOR TO CKSUM CALL, ERASE WORD ADDRESS FIELDS.                #
      #****************************************************************#
      SCRWITHINA1[RPTR] = 0;           #ERASE WORD ADDRESS             #
      IPTR = SCRECDITMPTR[RPTR];                 #POINT TO FIRST ITEM  #
      FOR I = 0 STEP 1 UNTIL SCRNUMITEMS[RPTR]-1 DO   #ITEM LOOP       #
      BEGIN 
        SCITEMRECA[IPTR] = 0;                    #ERASE REC WORD ADDR  #
        IPTR = IPTR + SCITMENTRYLG[IPTR];        #INDEX TO NEXT ITEM   #
      END 
      CKSWA = ((SAVARORD-1) * CKSRECLEN)+1;      #COMPUTE CKSREC WA    #
      SCRDCKS(CKSREC,CKSWA);                     #READ AREA CHECKSUM   #
                                       #CHECKSUM RECORD AND ITEMS      #
      CHECKSUM[0] = CKSUM(CHECKSUM[0],LOC(SCWORKBUF),SCRECENTLEN[RPTR]);
      FOR I = 0 STEP 1 UNTIL DPTR DO             #CLEAR BUFFER FOR     #
        SCBUFWORD[I] = 0;                        #NEXT ENTRY           #
      SCWRCKS(CKSREC,CKSWA);                     #REWRITE NEW BASE     #
      END                                                                DL3A006
      IF FLAG   THEN STDYES;
      STDNO;
  RTESTNAME:                                                            026050
#**********************************************************************#001280
#         ***  R T E S T N A M E   ***  (RECORD ENTRY)                 #026060
#   CHECKS IF A RECORD NAME WAS SPECIFIED FOR THIS RECORD SUB-ENTRY.   #026070
#   IF THE LENGTH FIELD IS 0,NO RECORD NAME WAS SPECIFIED.             #026080
#                                                                      #026090
#   IF RECORD NAME WAS NOT SPECIFIED, RETURN IS TO STDNO, ELSE STDYES. #026100
#**********************************************************************#001300
      IF SCRWITHINA1[RPTR] EQ 0 THEN
        STDNO;                                                          000750
      STDYES;                                                           000760
  SAVEAV:                                                               026220
#**********************************************************************#026230
#                ***  S A V E A V  ***  (DATA SUB-ENTRY)               #026240
#   SAVES (ACTVIR) THE ACTUAL OR VIRTUAL INDICATOR AND CHECKS IF EITHER#026250
#   THE ACTUAL OR VIRTUAL FLAG IS SET IN THE ITEM ENTRY IN THE SYMBOL  #026260
#   WORKING BUFFER.                                                    #026270
#                                                                      #026280
#   IF THE ACTUAL OR VIRTUAL FLAG IS SET IN THE SYMBOL WORKING BUFFER, #026290
#   IT RETURNS TO STDNO,ELSE IT RETURNS TO STDYES.                     #026300
#**********************************************************************#001940
      ACTVIR = CURP1;                                                   026310
      IF CURP1 EQ 1 THEN                                                000380
        BEGIN                                                           000610
          SCITMAVRESLT[DPTR] = TRUE;                                    000620
          SCRECAVVR[RPTR] = TRUE;                                       000630
        END                                                             000640
      ELSE                                                              000650
        BEGIN                                                           000660
          SCRECAVAR[RPTR] = TRUE;                                       000670
          SCITMCARFLAG[IPTR] = TRUE;    # CONTAINS A ACTUAL RES CLAUSE #000680
        END                                                             000690
      IF SYMIACTVIRDF[TEMPTR] GR 0 THEN                                 026320
        STDNO;                                                          026330
      STDYES;                                                           026340
  SAVNAME:                                                              026350
      FOR I=0 STEP 1 UNTIL 3 DO                                         026360
        NAME[I] = 0;                                                    026370
      FOR I=0 STEP 1 UNTIL CURLENW-1 DO                                 026380
        NAME[I] = CURWORD[I];  # STORE NAME FOR HASHIT.                #026390
      NAMELENC = CURLENG;    # SAVE LENGTH IN CHARACTERS.              #026400
      NAMELENW = CURLENW;    # SAVE LENGTH IN WORDS.                   #026410
      REFDEF = REFERENCED;   # SET FLAG TO REFERENCE.                  #026420
      CURWORDADDR = DPTR + DIRPTR; # SAVE WORD ADDR WHERE NAME IS DEFNE#026430
      STDNO;                                                            026440
  SCACSETB: 
#**********************************************************************#
#                ***  S C A C S E T B  ***                             #
#   ALLOCATES HALF OF SCHEMA WORK BUFFER FOR STORAGE OF ACCESS-        #
#   CONTROL LITERALS OR/AND DBPS. THE BOTTOM HALF REPRESENTS           #
#   THE BUFFER. LOCATION OF THE START OF THE BUFFER IS STORED AND      #
#   RETURNS TO STDNO.                                                  #
#**********************************************************************#
       I = (LGSCHBF - DPTR) / 2;   # SIZE OF LITERAL/DBP BUFFER.       #
       ACLITSTRT = DPTR + I;       # FIRST WORD ADDRESS OF BUFFER      #
       ACLITPTR = ACLITSTRT;
       M = 3;                      # POSITION,IN A WORD,OF THE LITERAL/#
                                   # DBP HEADER.                       #
       LITCTR = 0;                 # INITIALIZE LITERAL/DBP COUNTER.   #
       STDNO; 
  SCACLIT:  
#**********************************************************************#
#                ***  S C A C L I T  ***                               #
#   CHECKS LITERAL LENGTH. IF LENGTH GREATER THAN 30 CHARACTERS, ISSUES#
#   A DIAGNOSTIC AND TRUNCATES LENGTH. SETS TYPE OF LOCK TO TYPE       #
#   LITERAL. RETURN IS TO STDNO.                                       #
#**********************************************************************#
      IF CURLENG GR 30 THEN 
        BEGIN                # MAXIMUM LITERAL LENGTH EXCEEDED. # 
        DIAGDL(268);
        CURLENG = 30; 
        CURLENW = 3;
        END 
  
#   STORE LOCK TYPE  #
      B<M*12,3>SCHEMALOCKWD[DPTR] = 1; # LOCK TYPE = LITERAL #
      STDNO;
  SCACLOCKS:  
#**********************************************************************#
#                ***  S C A C L O C K S  ***                           #
#   STORES LITERAL IN LITERAL/DBP BUFFER.                              #
#   CHECKS FOR LITERAL/DBP BUFFER OVERFLOW. IF BUFFER OVERFLOW, ABORTS.#
#   STORES LITERAL HEADER( LITERAL LENGTH IN WORDS AND CHARACTERS) IN  #
#   ACCESS-CONTROL ENTRY. RETURN IS TO STDNO.                          #
#**********************************************************************#
  
#   STORE LITERAL IN BUFFER # 
      FOR I = 0 STEP 1 UNTIL CURLENW-1 DO 
        SCHLOCKNAME[ACLITPTR+I] = C<0,10>CURWORD[I];
  
      I = (CURLENW * 10) - CURLENG;  # NO OF CHARS TO BE BLANK-FILLED. #
  
#   BLANK FILL LITERAL #
      IF B<M*12,3>SCHEMALOCKWD[DPTR] EQ 1 AND I NQ 0 THEN 
          C<10-I,I>SCHLOCKNAME[ACLITPTR+CURLENW-1] = " "; 
  
      ACLITPTR = ACLITPTR + CURLENW;   # NEXT AVAILABLE WORD #
      LITCTR = LITCTR + 1;             # INCREMENT LITERAL/DBP COUNT #
      IF ACLITPTR GR LGSCHBF THEN 
        GOTO CHECKLITABT;          # LITERAL/DBP BUFFER OVERFLOW #
  
#   STORE LITERAL HEADER #
      DEF LTY #3#; # NO OF BITS IN LITERAL/DBP LOCK TYPE FIELD #
      DEF LWD #3#; # NO OF BITS IN LITERAL/DBP WORD LENGTH FIELD #
      DEF LCH #6#; # NO OF BITS IN LITERAL/DBP CHARACTER LENGTH FIELD # 
      B<M*12+LTY,LWD>SCHEMALOCKWD[DPTR] = CURLENW; # LITERAL/DBP LENG  #
      B<M*12+LTY+LWD,LCH>SCHEMALOCKWD[DPTR] = CURLENG; # IN WDS AND CHS#
  
#   INCREMENT COUNTER TO NEXT LITERAL/DBP HEADER POSITION IN A WORD # 
      M = M + 1;
      IF M GQ 5 THEN         # 5 LITERAL/DBP HEADERS PER WORD # 
        BEGIN 
        DPTR = DPTR + 1;
        M = 0;
        END 
  
      STDNO;
  SCACPROC: 
#**********************************************************************#
#                ***  S C A C P R O C  **                              #
#   CHECKS DATA-BASE-PROCEDURE NAME LENGTH. IF NAME GREATER THAN 7     #
#   CHARACTERS, ISSUES A DIAGNOSTIC AND TRUNCATES LENGTH.              #
#   ADDS DBP NAME TO DBP LIST. STORES LOCK TYPE TO DBP TYPE            #
#   RETURNS TO STDNO.                                                  #
#**********************************************************************#
      DBPBUILD;              # ADD DBP TO DBP LIST #
      IF CURLENG GR 7 THEN
        BEGIN                # MAXIMUM DBP NAME LENGTH EXCEEDED  #
        DIAGDL(269);
        CURLENG = 7;
        CURLENW = 1;
        END 
      B<M*12,3>SCHEMALOCKWD[DPTR] = 2;  # LOCK TYPE = DBP # 
      STDNO;
  SCACSTOR: 
#**********************************************************************#
#                ***  S C A C S T O R  ***                             #
#     STORE END OF LOCK LIST TYPE IN HEADER DESCRIPTOR.                #
#     MOVE LITERALS/DBPS FROM BUFFER TO THEIR APPROPRIATE POSITIONS    #
#     IN THE SCHEMA DIRECTORY BUFFER.                                  #
#     STORE OFFSET POINTER IN ACCESS-CONTROL HEADER TO THE START OF    #
#     LITERALS/DBPS. RETURN IS TO STDNO.                               #
#**********************************************************************#
      B<M*12,3>SCHEMALOCKWD[DPTR] = 6;   # LOCK TYPE = END OF LOCK LIST#
      DPTR = DPTR + 1;
      SCHPRVALPTR[SCACCPTR] = DPTR - SCACCPTR;  # OFFSET POINTER TO    #
                                   # START OF LITERAL/DBP LIST.        #
#   MOVE LITERALS/DBPS TO THEIR APPROPRIATE POSITIONS # 
      FOR I = ACLITSTRT STEP 1 UNTIL ACLITPTR-1 DO
        BEGIN 
        SCHLOCKNAME[DPTR] = SCHLOCKNAME[I]; 
        DPTR = DPTR + 1;
        END 
      STDNO;
  SCACNEXT: 
#**********************************************************************#
#                ***  S C A C N E X T  ***                             #
#   STORES THE OFFSET POINTER TO THE CURRENT ACCESS-CONTROL ENTRY IN   #
#   THE PREVIOUS ACCESS-CONTROL ENTRY.                                 #
#   SETS THE ACCESS-CONTROL HEADER POINTER.                            #
#   RETURNS TO STDNO.                                                  #
#**********************************************************************#
      SCHNXPRIVPTR[SCACCPTR] = DPTR - SCACCPTR;  # OFFSET POINTER # 
      SCACCPTR = DPTR;       # ACCESS-CONTROL HEADER POINTER #
      SEPTR = DPTR;          # SET SUB-ENTRY POINTER #
      STDNO;
  SCNAME:                                                               026600
#**********************************************************************#026610
#                ***  S C N A M E  ***   ( SCHEMA ENTRY)               #026620
#   STORES THE SCHEMA NAME (CONTAINED IN CURWORD) INTO THE DIRECTORY   #026630
#   WORKING BUFFER ALONG WITH LENGTH IN CHARACTERS AND LENGTH IN WORDS.#026640
#                                                                      #026650
#   RETURNS TO STDNO.                                                  #026660
#**********************************************************************#001400
      DPTR = 2;    # SET TO THE FIRST POSSIBLE VARIABLE SCHEMA WORD #   000410
      SCPTR = 0;   # SET TO THE FIRST WORD OF THE SCHEMA ENTRY      #   000420
      IF SCLFN EQ 0            # SET DEFAULT SCHEMA NAME  # 
        THEN B<0,42>SCLFN = B<0,42>CURWORD [0]; 
      SCHOPEN;
      SCOPCKS;               # OPEN CHECKSUM SCRATCH FILE              #
      J = CURLENW - 1;                                                  000429
      FOR I = 0 STEP 1 UNTIL J DO                                       000430
        BEGIN                                                           026690
          SCHEMANAME[SCPTR + I] = C<0,10>CURWORD[I];
          SCCWSCHNAME[I] = C<0,10>CURWORD[I]; 
        END                                                             026740
      IF CURLENG GR 10 THEN 
        K = 10; 
      ELSE
        K = CURLENG;
      C<0,K>HDR[0] = C<0,K>CURWORD[0];   # PAGE HEADER #
      DPTR = DPTR + J;
      SCHNAMELENG[SCPTR] = CURLENW;  # STORE THE LENGTH (IN WORDS) OF  #026750
                             # CURWORD INTO THE WORKING STORAGE BUFFER.#026760
      SCHNAMLENGC[SCPTR] = CURLENG;  # STORE THE LENGTH (IN CHARS) OF  #026770
                             # CURWORD INTO THE WORKING STORAGE BUFFER.#026780
      SCCWSCHDRPTR[SCCWPTR] = CTLWDLENG; # OFFSET TO SCHEMA HEADER  # 
      STDNO;                                                            026800
  SCPUT:                                                                027810
#**********************************************************************#027820
#                ***  S C P U T  ***   (SCHEMA ENTRY)                  #027830
#   STORES THE CONTENTS OF THE DIRECTORY WORKING BUFFER INTO THE       #027840
#   DIRECTORY ARRAY.                                                   #027850
#                                                                      #027860
#   BLANK FILLS THE PRIVACY BUFFER AND INITIALIZES THE PRIVACY BUFFER  #027870
#   POINTER (PRPTR) TO ZERO. RETURNS TO STDNO.                         #027880
#**********************************************************************#027890
      DIRECTBUILD;           # STORES THE CONTENTS OF THE WORKING      #027910
                             # STORAGE BUFFER INTO THE DIRECTORY.      #027920
      FOR I = 0 STEP 1 UNTIL DPTR DO             #CLEAR BUFFER FOR     #
        SCBUFWORD[I] = 0;                        #NEXT ENTRY           #
      STDNO;                                                            027930
  SETCHAR:                                                              001140
#**********************************************************************#001150
#                 ***   S E T C H A R   ***                            #
#   SETS CLASS TO ZERO TO DENOTE CHARACTER. FLAGS THE FACT THAT TYPE   #
#   CHARACTER SPECIFIED.                                               #
#   RETURN IS TO STDNO.                                                #
#**********************************************************************#001170
  
      SCITEMSIZE[IPTR] = 1;        # SET DEFAULT SIZE                  #
      CLASS = 0;                                                        001180
      CHARFLAG = TRUE;
      STDNO;                                                            001190
  SETSERT:  
#**********************************************************************#
#                ***  S E T S E R T  ***                               #
#   SETS UP THE CALL TO THE ROUTINE THAT COMPUTES THE MAXIMUM SUB-     #
#   ENTRY LENGTH.                                                      #
#**********************************************************************#
      SUBENTLG(SEPTR);
      STDNO;
  SETVALUE:                                                             002020
#**********************************************************************#002030
#                     * * *     S E T V A L U E     * * *              #002040
#   IN THE CHECK CLAUSE SETS THE VALUE BIT FOR CHECK VALUE AND RETURNS #002050
#  TO STDYES IF VALUE NOT PREVIOUSLY SET,  ELSE TO STDNO.         # 
#**********************************************************************#002070
      IF SCITMCKVALUE[CKPTR] THEN 
        BEGIN                # DUPLICATE ENTRY - ERROR #
        DIAGDL( 232 );
        STDNO;
        END 
      IF SCITEMCLASS[IPTR] EQ 15 THEN 
        BEGIN                # COMPLEX DATA ITEM - CHECK VALUE OPTION  #
        DIAGDL( 226 );       # NOT ALLOWED.                            #
        STDNO;
        END 
      M = 1;
      L = DPTR + 1; 
      I = ( LGSCHBF - DPTR )  / 3;
      CKLITSTART = DPTR + I;
      CKLITPTR = CKLITSTART;
      EXCKSTART = CKLITPTR + I; 
      EXCKPTR = EXCKSTART;
      LASTEXLIT = EXCKSTART;
      LITCTR = 0; 
      SCITMCKVALUE[CKPTR] = TRUE;                                       002080
      SCITEMDBPFLG[IPTR] = TRUE;
      FOR I = 0 STEP 1 UNTIL 3 DO 
        LITCHKINT[I] = 0; 
      STDYES; 
   STORDCHARL:                                                          001930
#**********************************************************************#001940
#                      * * *     S T O R D C H A R L     * * *         #001950
#   STORES THE NUMBER OF CHARACTERS SPECIFIED AND THEN RETURNS TO STDNO#001960
#**********************************************************************#001970
      DTEMP = C<0,10>CURWORD[0];
      DISPDECTOBIN; 
      SCITEMSIZE [IPTR] = ITEMP;
      SCITMINT3[IPTR] = C<0,CURLENG>CURWORD[0]; 
      STDNO;                                                            001990
  STODNAME:                                                             031630
#**********************************************************************#002440
      IF DUPDEFINE EQ 1 THEN
       STDNO; 
      C<0,CURLENG>SCITMNAM30[DPTR] = C<0,CURLENG>CURWRD30[0]; 
      SCITMNAMEPTR[IPTR] = DPTR - IPTR;  # OFFSET POINTER TO ITEM NAME.#
      DPTR = DPTR + CURLENW;                                            000240
      CHKBUFOVF;
      SCITMNAMLENC[IPTR] = CURLENG;                                     000250
      SCITMNAMLENW[IPTR] = CURLENW;                                     000260
      SYMIRECPTRDF[TEMPTR] = RECPTR;
      SCITEMRECA [IPTR] = RECPTR; 
      TOTALITEMS = TOTALITEMS + 1;                                      000650
      IF TOTALITEMS EQ MAXITMS + 1 THEN 
        DIAGDL( 289 );       #MAX TOTAL NUMBER OF ITEMS EXCEEDED.      #
      RECORDITEMS = RECORDITEMS + 1;                                    000660
      IF RECORDITEMS EQ MAXRITEMS + 1 THEN
        DIAGDL(293);         # MAXIMUM ITEM/RECORD COUNT EXCEEDED.     #
      STDYES; 
  STORINT:                                                              001340
#**********************************************************************#001350
#                  * * *     S T O R I N T     * * *                   #001370
#   AFTER LOCATING FIXED OF FLOAT THEN INTEGER-1 WE INTERROGATE THE    #001380
#   INTEGER AND IF THE NUMBER IS INVALID ISSUE DIAGNOSTIC 323 AND      #001390
#   RETURNS TO STDNO.  IF THE INTEGER IS VALID, EITHER A 10 OR 20      #001400
#   IS STORED IN SCITEMSIZE TO SHOW THAT THE LENGTH IS EITHER 1 OR     #001410
#   2 WORDS, DEPENDING ON THE CLASS TYPE.                              #
#**********************************************************************#
      DTEMP = C<0,10>CURWORD[0];
      DISPDECTOBIN;          # CONVERT INTEGER-1 FROM DISPLAY DECIMAL  #
                             # TO BINARY.                              #
      IF CLASS EQ 13 THEN 
        BEGIN                # TYPE FLOAT # 
        IF ITEMP LQ 0 OR ITEMP GR 29 THEN 
          STDNO;             # INTEGER OUT OF RANGE # 
        IF ITEMP GR 14 AND ITEMP LQ 29 THEN 
          BEGIN              # DOUBLE PRECISION # 
          CLASS = 14; 
          SCITEMSIZE[IPTR] = 20;
          END 
        END 
      ELSE                   # TYPE FIXED # 
        IF ITEMP GR 0 AND ITEMP LQ 18 THEN
          CLASS = 10; 
        ELSE                 # INVALID INTEGER FOR TYPE FIXED # 
          STDNO;
      SCITMINT1[IPTR] = C<0,CURLENG>CURWORD[0]; 
      STDYES; 
  STORINTP:                                                             001720
#**********************************************************************#001730
#                     * * *    S T O R I N T P     * * *               #001740
#   HAVE A TYPE FIXED AND INTEGER-2.  THIS INTEGER TELLS US THE DECIMAL#001750
#   POINT POSITION.  IF INTEGER-2 IS NEGATIVE, THE DECIMAL POSITION IS #001760
#   TO TH RIGHT OF THE INPUT NUMBER.  IF THE NUMBER IS GREATER THAN 0  #001770
#   WE SET SCITEMPTLEFT[IPTR] TO TRUE AND SET SCITEMPTLOC TO INT-2 AND #001780
#**********************************************************************#001800
      IF CURTYPE NQ 107 THEN
        STDNO;               # ERROR IF NOT INTEGER # 
      IF CLASS EQ 13 OR CLASS EQ 14 THEN
        STDNO;   # ERROR IF INTEGER-2 SPECIFIED FOR TYPE FLOAT ITEMS #
      DTEMP = " ";
      DTEMP = C<0,CURLENG>CURWORD[0]; 
      SCITEMPTLEFT[IPTR] = TRUE;   # SET DEFAULT FLAG FOR DEC. PT. #
      IF C<0,1>CURWORD[0] EQ O"46" THEN 
        BEGIN                # NEGATIVE INTEGER-2 # 
        DTEMP = C<1,CURLENG-1>CURWORD[0]; 
        SCITEMPTLEFT[IPTR] = FALSE; 
        END 
      SCITMINT2[IPTR] = DTEMP;     # STORE DISPLAY CODE INTEGER-2 # 
      DISPDECTOBIN; 
      SCITEMPTLOC [IPTR] = ITEMP; 
      STDYES; 
  STORONPROC:                                                           031770
#**********************************************************************#002480
      DBPBUILD;                                                         000370
      IF CURLENG GR 7 THEN                                              031780
        BEGIN                                                           002080
          B<0,42>SCRECONPROCN [DPTR] = B<0,42>CURWORD [0];
          STDNO;                                                        002100
        END                                                             002110
      C<0,CURLENG>SCRECONPROCN [DPTR] = C<0,CURLENG>CURWORD [0];
      STDYES;                                                           031820
  TSTAGGREG:                                                            032260
#**********************************************************************#002600
# TESTS TO SEE IF SUBJECT ITEM IS NOT A REPEATING GROUP OR A VECTOR    #
# COMPONENT OF A REPEATING GROUP. IF IT IS RETURN IS TO STDNO.         #
# ELSE STDYES.                                                         #
#**********************************************************************#
      IF SYMIOCCURSDF[TEMPTR] THEN                                      032270
        STDNO;                                                          032280
      I = L1; 
 L6:  #   # 
      IF DOMGRP[I] EQ 0 THEN
        STDYES; 
      IF LVNUM GR SCITEMLEVEL[DOMGRP[I]] THEN 
        STDNO;
      I = I - 1;
      GOTO L6;
      STDYES;                                                           032290
  TSTCODEPIC:                                                           033070
#**********************************************************************#002720
      STDYES;  # HAVE TO REWORK FOR GROUP ENTRY BEFORE THIS OUT #       000350
      IF NOT SYMITYPEDF[TEMPTR] AND                                     033090
        NOT SYMIPICDF[TEMPTR] THEN                                      033100
          STDNO;                                                        033110
      STDYES;                                                           033120
  TSTCODERSLT:                                                          033130
#**********************************************************************#002740
#   CHECKS THE ACTUAL AND VIRTUAL BITS FOR RESULT CLAUSE AND IF        #000250
#   BOTH ARE SET RETURNS TO STDNO, AND IF NOT RETURNS TO STDYES.     #  000260
#**********************************************************************#000270
      IF SYMIACTUALDF[TEMPTR] AND                                       000280
        SYMIVRTUALDF[TEMPTR] THEN                                       033150
          STDNO;                                                        033160
      STDYES;                                                           033170
  TSTDUPNOTALL:                                                         033270
#**********************************************************************#002800
      IF SYMRCALCWK[TEMPTR] AND                                         033280
        NOT SYMRDUPNOTWK[TEMPTR] THEN                                   033290
          STDNO;                                                        033300
       STDYES;                                                          033310
 TSTITEM:   # # 
#*******************************************************************# 
#                       T S T I T E M                               # 
# CHECK THAT ONE OF THE CLAUSES TYPE, PICTURE, OR OCCURS WAS        # 
# SPECIFIED.  STDNO IF NONE OF THEM, ELSE STDYES.                   # 
#*******************************************************************# 
      IF SCITEMTYPE [IPTR]  OR  ( SCITMINTVAL [IPTR] NQ 0 )  OR 
          SCITMDIMOCC [IPTR]  OR  ( SCITMPICLITP [IPTR] NQ 0 )
        THEN STDYES;
      STDNO;
#*******************************************************************# 
 TSTOCCDBI1:                #CHECKS TO SEE IF DEPENDING ON ITEM IS AN  #
      I = SYMRECPTRWK[1] - NEXTPTR; #ELEMENTARY ITEM.ALSO CHECKS TO SEE#
      IF SCITEMCLASS[I] EQ 0 OR SCITEMCLASS[I] EQ 1 THEN  #NO DECIMAL  #
        STDNO;                               #POINT OR SIGN SPECIFIED  #
      IF SCITEMPTLOC[I] GR 0 OR SCITEMSIGNFG[I] THEN  #AND THAT IT IS  #
        STDNO;                               #AN INTEGER ITEM. IF SO   #
      IF SCITMINTVAL[I] GR 0 OR SCITMDIMOCC[I] THEN #RETURN IS TO STD  #
        STDNO;                             #YES. ELSE RETURN IS STDNO. #
      I = SCITMCKEXPTR[I] + I;
      L = 0;
 MAXLOOP:   # SEARCHES THROUGH THE CHECK EXHIBIT AREA FOR THE LAST #
            # LITERAL AND CONVERTS THAT TO BINARY, AND STORES THAT #
            # AS THE MAX. VALUE FOR A REPT. GROUP OF VARIABLE      #
            # DIMENSION.                                           #
      IF SCITMCKEXNXL[I] NQ 0 THEN
        BEGIN 
          I = I + SCITMCKEXNXL[I];
          GOTO MAXLOOP; 
        END 
      ELSE
        BEGIN 
          FOR J = 1 STEP 1 UNTIL SCITMCKEXLNW[I] DO 
            BEGIN 
              C<L,10>DTEMP = C<0,10>SCITMCKEXLIT[I+J];
              L = L + 10; 
            END 
        END 
      DISPDECTOBIN; 
      SCITMINTVAL[IPTR] = ITEMP;
          SCITMDEPORDL [IPTR] = SCITMORDNUM [SYMRECPTRWK [1] - NEXTPTR];
       STDYES;
 TSTOCCDBI2:                 # CHECKS TO SEE IF CHECK VALUE CLAUSE HAS #
      I = SYMRECPTRWK[1];    # BEEN SPECIFIED FOR THE DEPENDING ON ITEM#
      I = I - NEXTPTR;    #IF NOT RETURN IS TO STDNO.                #
                          #ELSE RETURN IS TO STDYES.                 #
      IF SCITEMCHECKS[I] GR 0 THEN
        BEGIN 
          IF SCITMCKVALUE[I+SCITEMCHECKS[I]] THEN 
            BEGIN 
              IF ITEMP LQ 0 THEN   # IF MAX. VALUE FOR DEPENDING ON  #
                DIAGDL(259);       # ITEM IS NOT GREATER THAN 0, THEN # 
              STDYES;              # ISSUE DIAGNOSTIC. ELSE RETURN    # 
            END                    # STDYES.                          # 
        END 
        STDNO;
 TSTOCCDBI3:                 # CHECKS TO SEE IF DEPENDING ON ITEM IS   #
      I = SYMRECPTRWK[1] - NEXTPTR; 
                             # A PART OF A REPEATING GROUP OF VARIABLE #
      OCCURSTEST;            # DIMENSION. IF SO RETURN IS TO STDNO.    #
      IF K EQ 1 THEN              # ELSE RETURN IS TO STDYES.          #
        STDNO;
       STDYES;
 TSTOCCDBI4:                 # CHECKS TO SEE IF DEPENDING ON ITEM IS   #
      I = SYMRECPTRWK[1] - NEXTPTR; # DEFINED AS A VIRTUAL RESULT  #
      IF SCITMATVTP[I] GR 0 THEN    # IF SO RETURN IS TO STDNO.    #
        BEGIN                       # ELSE RETURN IS TO STDYES #
          IF SCITMAVRESLT[I+SCITMATVTP[I]] THEN 
            STDNO;
        END 
        STDYES; 
 TSTOCCDBI5:                 # CHECKS TO SEE IF SUBJECT ITEM IS A PART #
      I = PPTR;          # OF A REPEATING GROUP OF VARIABLE DIMEN- #
      IF SCITMDIMOCC[I] THEN
        BEGIN 
          OCCURSTEST;        # SION. IF SO RETURN IS TO STDNO. ELSE   # 
          IF K EQ 1 THEN     # RETURN IS TO STDYES.                   # 
            STDNO;
        END 
           STDYES;
  TSTOCCURS1:                                                           034460
      IF SCITMDIMOCC[PPTR] OR (SCITMINTVAL[PPTR] GR 0) THEN 
        BEGIN 
          IF SCITMATVTP[PPTR] GR 0 THEN 
            STDNO;
        END 
        STDYES; 
   TSTLEVEL:  
#**********************************************************************#
#  CHECKS FOR VALID LEVEL NUMBERS AND, IF NOT , SETS DIAGNOSTIC FLAG, # 
#  DFLAG. IT THEN GOES TO ROUTINE TSTPDOM WHERE THE DOMINANT POINTERS # 
#  ARE SET. RETURN IS TO STDYES IF DFLAG IS NOT SET,OTHERWISE, STDNO  # 
#**********************************************************************#
      IF TPFLAG EQ 0 THEN 
        BEGIN 
          ENTTYPE = 3;
        END 
      IF LFLAG EQ 0 THEN
        BEGIN 
          IF ENTTYPE EQ 3 THEN
            DFLAG = 1;
        END 
 L2:      LFLAG = 1;
      IF LVNUM GR SAVELEVEL THEN
        BEGIN 
          IF PRIORTYP NQ 3 THEN 
            BEGIN 
              IF ORDINALCTR NQ 0 THEN 
                BEGIN 
                  DFLAG = 1;
                END 
            END 
          IF ENTTYPE EQ 3 THEN
            BEGIN 
 L3:         L1 = L1 + 1; 
              DOMGRP[L1] = IPTR;
            END 
            GOTO TSTPDOM; 
        END 
      IF PRIORTYP EQ 3 THEN 
        BEGIN 
          DFLAG = 1;
        END 
      IF LVNUM LS SAVELEVEL THEN
        BEGIN 
          IF DOMGRP[1] EQ 0 OR SCITEMLEVEL[DOMGRP[1]] GR LVNUM THEN 
            BEGIN 
              DFLAG = 1;
            END 
        END 
      IF ENTTYPE EQ 3 THEN
        GOTO L3;
  TSTPDOM:  
      I = L1; 
 L4:  IF DOMGRP[I] EQ 0 THEN
        BEGIN 
          SCITMDOMORD[IPTR] = 0;
          SCITRLDOMPTR[IPTR] = 0; 
          GOTO LEVELEXIT; 
        END 
      IF LVNUM GR SCITEMLEVEL[DOMGRP[I]] THEN 
        BEGIN 
          SCITMDOMORD[IPTR] = IPTR - DOMGRP[I]; 
          SCITRLDOMPTR[IPTR] = SCITMDOMORD[IPTR]; 
          IF ENTTYPE EQ 3 THEN  # CHECK TO SEE IF REPEATING  #
            BEGIN 
              J = IPTR;         # GROUPS ARE NOT NESTED MORE #
              K = 0;            # THAN THREE LEVELS DEEP.    #
              FOR I = I WHILE SCITMDOMORD[J] GR 0 DO  # IF SO # 
                BEGIN           # ISSUE DIAGNOSTIC.          #
                  J = J - SCITMDOMORD[J]; 
                  K = K + 1;
                END 
              IF K GQ 3 THEN
                DIAGDL(258);
            END 
          GOTO LEVELEXIT; 
        END 
      I = I - 1;
      GOTO L4;
  LEVELEXIT:  
      PRIORTYP = ENTTYPE; 
      SAVELEVEL = LVNUM;
      IF DFLAG EQ 1 THEN
        STDNO;
      STDYES; 
  TSTRONOPT:                                                            036300
#*************************************************************# 
      IF SCRECONCALOP[DPTR] EQ 0 THEN  # IF NO USER FUNCTION SPECIFIED,#
        SCRECONCALOP[DPTR] = O"174";   # SET ALL FLAGS(DEFAULT COND.)  #
      DPTR = DPTR + 1;                                                  002950
      CHKBUFOVF;
      STDNO;                                                            036330
  TSTUNIQUEDBN:                                                         036480
#*************************************************************# 
      IF SYMIDIRECTWK[TEMPTR] AND                                       036490
         SYMIDBNWK[TEMPTR] THEN                                         036500
          STDNO;                                                        036510
      STDYES;                                                           036520
  TSTVALIDOCC:   #   #
#**********************************************************************#
      IF NOT SYMITYPEDF[TEMPTR] AND NOT SYMIPICDF[TEMPTR] AND 
             SYMIOCCURSDF[TEMPTR] THEN
        BEGIN 
          IF SYMIENCDECDF[TEMPTR] THEN
            DIAGDL( 260 );
          IF SYMIONDF[TEMPTR] THEN
            DIAGDL( 261 );
          IF SYMICHECKDF[TEMPTR] THEN 
            DIAGDL( 262 );
        END 
      STDYES; 
  TSTVIRTRES: 
#**********************************************************************#
      IF SYMIVRTUALDF[TEMPTR] AND 
          ( SYMIENCDECDF[TEMPTR] OR SYMIONDF[TEMPTR] ) THEN 
        STDNO;
      STDYES; 
  TYPEEND:                                                              000820
#**********************************************************************#000830
#                 ***   T Y P E E N D   ***                            #
#   CHECK TO SEE IF A TYPE OPTION HAS BEEN SPECIFIED, IF NOT, RETURNS  #
#   TO STDNO. IF A TYPE OPTION HAS BEEN SPECIFIED STORES THE CLASS.    #
#   RETURN IS TO STDYES.           #
#**********************************************************************#000850
      IF CLASS EQ 0                # IF NO OPTION SPECIFIED            #
        AND NOT CHARFLAG
      THEN
        STDNO;                     # RETURN TO ISSUE DIAGNOSTIC        #
      SCITEMCLASS[IPTR] = CLASS;                                        000860
      STDYES; 
 VALIDAR:  #  # 
#*********************************************************# 
#                V A L I D A R                            # 
# RETURN TO STDNO IF AREA NAME CONTAINS SPECIAL CHARACTERS# 
           # WITHIN THE FIRST 7 CHARACTERS                           #
# OR IF FIRST CHARACTER IS NOT ALPHABETIC.  ELSE STDYES.  # 
#*********************************************************# 
      IF B<0,6>CURWORD [0] GR O"32" 
        THEN STDNO; 
      IF CURLENG GR 30 THEN 
        STDNO;
      J = CURLENG;
      IF CURLENG GR 7 
        THEN J = 7; 
      J = (J - 1) * 6;
      FOR I = 6  STEP 6 UNTIL J  DO 
        IF B<I,6>CURWORD [0] GR O"44" 
          THEN STDNO; 
      STDYES; 
  VALIDINT:                                                             037460
#**********************************************************************#003230
#  CONVERTS DECIMAL LEVEL TO BINARY.                                   #
#  CHECKS FOR VALID LEVEL NUMBER, THAT IS 0 < LEVEL NUMBER < 100.      #
#  IF NOT, SETS DIAGNOSTIC FLAG AND DEFAULTS LEVEL TO 01.              #
#  STORES LEVEL NUMBER IN DIRECTORY WORK BUFFER. RETURN IS TO STDNO.   #
#**********************************************************************#
      DFLAG = 0;
      TPFLAG = 0; 
      ENTTYPE = 0;
      IF LFLAG NQ 0 THEN
        BEGIN 
          DTEMP = C<0,10>CURWORD[0];
          DISPDECTOBIN; 
        END 
      IF ITEMP LQ 0 OR ITEMP GQ 100 THEN
        BEGIN 
          DFLAG = 1;
          ITEMP = 1;
        END 
      IF ITEMP LQ VGRPFLAG THEN 
        BEGIN 
          VGRPFLAG = -2;     # SET FLAG TO INDICATE ERROR. #
          DIAGDL(122);
        END 
        SCITEMLEVEL[IPTR] = ITEMP;
        SYMILEVELDF[TEMPTR] = ITEMP;
        LVNUM = ITEMP;
        STDNO;
  VALUENOT:                                                             002120
#**********************************************************************#002130
#                   * * *     V A L U E N O T     * * *                #002140
#   SETS VALUE NOT FLAG IN CHECK CLAUSE AND RETURNS TO STDNO.          #
#**********************************************************************#002160
      SCITMCKNOT[CKPTR] = TRUE;                                         002170
      STDNO;                                                            002180
      PROC OCCURSTEST;
#****************************************************************J*****#
      BEGIN 
        K = 0;
 DBILOOP:  #   #
      IF SCITMDOMORD[I] NQ 0 THEN 
          BEGIN 
          I = I - SCITMDOMORD[I]; 
            IF SCITMDIMOCC[I] THEN
              BEGIN 
                K = 1;
                RETURN; 
              END 
              GOTO DBILOOP; 
          END 
      END 
  PROC DIRECTBUILD;                                                     038060
#**********************************************************************#003390
    BEGIN                                                               038070
      I = DPTR;                                                         038080
      DDLRTSC(SCWORKBUF,I,NEXTPTR); 
      PRIORPTR = NEXTPTR;                                               038100
      NEXTPTR = NEXTPTR + DPTR;                                         038110
      RETURN;                                                           038120
    END                                                                 038130
      PROC CHKBUFOVF;     # CHECKS TO SEE IF THERE IS A BUFFER #
                          # OVERFLOW ON THE SCHEMA WORK BUFFER #
                          # IF SO DDL IS ABORTED.              #
      BEGIN 
        IF DPTR GR (LGSCHBF-30) THEN
          BEGIN 
            DIAGDL(325);
      DDLSU = MAXFL;                        #SET FL FOR ABORT CONDITION#
      CLSEOUT;
      CLSESC; 
          ABRT1;
          END 
         ELSE 
           RETURN;
       END
#*******************************************************************# 
  
  
  
  
                                                                        003430
        END                                                             041090
  TERM;                                                                 045130
