*DECK DA3 
USETEXT CCTTEXT 
USETEXT DNTEXT
PROC DA3; 
BEGIN 
#CALL DACOMDK FOR GLOBAL DEFS AND DECLARATIONS# 
CONTROL NOLIST; 
*CALL DACOMDK 
CONTROL LIST; 
#DECLARE ALL PART 1, 2 AND 4 AS XREFS FOR PART3#
XREF
*CALL DAPT1 
XREF
*CALL DAPT2 
XREF
*CALL DAPT4 
#DECLARE ALL@PART 3 AS XDEFS# 
XDEF
*CALL DAPT3 
PROC OCCUR$PROC;
BEGIN #A# 
# 
OCCURS PROCESSOR. 
THE PROCESSOR PERFORMS SEVERAL FUNCTIONS FOR ITEMS HAVING AN
OCCURS CLAUSE.
  A. (NO LONGER APPLICABLE) 
  B. FOR ALL INDEX ITEMS IT SETS UP THOSE FIELDS WHICH INDICATE THE 
    FIRST AND LAST ITEMS THAT ARE INDEXABLE.
  C. IF A DEPENDING CLAUSE IS PRESENT (AND THE CURRENT ITEM IS
    A GROUP) GROUP ATTRIBUTES ARE SET UP FOR FUTURE USE 
    IF THE CURRENT ITEM IS NOT A GROUP THEN A NEW AUX TABLE ENTRY 
    (THAT PRESERVES THE DEPENDING ON NAME AND DNAT$PTR) IS "HUNG" 
    ONTO THE FIRST ENTRY IN THE DNAT    THIS IS A KLUDGE AS 
    IT IS ASSUMED THAT THE FIRST ENTRY IS FOR THE TALLY COUNTER.
    ALSO A NEW AUXT ENTRY IS CREATED WHICH IS HUNG ONTO EACH
    SUPERIOR GROUP ITEM. THE NEW ENTRY CONTAINS THE DNAT POINTER
    OF THE CURRENT ITEM (AS THE OCCURRING ITEM) AND ALSO TO THE 
    DEPENDING ON ITEM.
  D. IF THE CURRENT ITEM IS KEYED, THEN BASIC SYNTAX CHECKING IS
    DONE AND THE TWO STACKS THAT HOLD DNAT PTRS FOR KEY ITEMS AND 
    OCCURRING ITEMS ARE UPDATED.
NOTE. IF THERE IS NOT AN OCCURS CLAUSE IN THE CURRENT ITEM BUT
  THE ITEM IS SUBORDINATE TO A GROUP ITEM THAT DOES CONTAIN AN
  OCCURS CLAUSE, THEN A NEW AUXT ENTRY THAT REFLECTS THE SITUATION
  IS CREATED AND HUNG ON THE CURRENT ITEM.
# 
#LOCAL VARIABLES# 
ITEM LAUX$PTR; #PTR TO AUX TABLE ENTRIES# 
ITEM LDNAT$PTR; #PTR TO DNAT ENTRIES# 
ITEM LDNAT$LII; #DNAT PTR TO LAST ITEM INDEXABLE# 
ITEM LGRP$ST$PTR; #PTR TO PTR STACK#
##
ENTRY$(22,"OCCUR$PROC");
SETFIELD(DN$SDEPTH,DNAT$,DNAT$PTR,SUB$DEPTH); #SET SUBSCRIPT DEPTH# 
IF GETQUICK(DN$OCCURS,DNAT$,DNAT$PTR) EQ 0
    THEN #NO OCCURS CLAUSE PRESENT# 
  BEGIN #B# 
                             TRACK$(22,2202); 
  NO$OCCURS:  
  IF DEPEND$FLAG EQ 1 
    AND 
    GETQUICK(DN$DEP,DNAT$,DNAT$PTR) EQ 0
    THEN #SUPERIOR GRP HAS DEPENDING ON CLAUSE# 
    BEGIN #C# 
                             TRACK$(22,2203); 
    LAUX$PTR=ATT$NEW$AUXT(DNAT$PTR); #MAKE NEW ENT HUNG ON CURRENT# 
                           VALUE$(22,"LAUX$PTR=",LAUX$PTR); 
    #SET UP NEWLY ADDED ENTRY#
    SETFIELD(AX$TTYPE,AUX$,LAUX$PTR,VAROCCUR); #TYPE VARIABLE OCCURS# 
    SETFIELD(AX$SUBSLVL,AUX$,LAUX$PTR,1); #SUSCRIPT LVL 1#
#***********CHECK ABOVE LINE WITH PHIL ******************#
    SETFIELD(AX$DEPNAM,AUX$,LAUX$PTR,DEPEND$NAME); #DNAT OF GRP ITM#
    SETFIELD(AX$MINOCCNO,AUX$,LAUX$PTR,MIN$OCCURS); #MIN NO OF OCCS#
    SETFIELD(DN$DEP,DNAT$,DNAT$PTR,1); #FORCE DEPENDING#
    END #C# 
  END #B# 
  ELSE #OCCURS CLAUSE PRESENT#
  BEGIN #D# 
                             TRACK$(22,2204); 
  IF SUB$DEPTH GR 2 
  THEN BEGIN
       # MORE THAN THREE LEVELS OF SUBSCRIPTS # 
       # IS NON-STANDARD COBOL #
       ERROR(MSG5,D$ERROR); 
       END
    SUB$DEPTH=SUB$DEPTH+1; #GO DOWN 1 LEVEL OF SUBSCRIPTING#
                        VALUE$(22,"SUBDEPTH=",SUB$DEPTH); 
    SETFIELD(DN$SDEPTH,DNAT$,DNAT$PTR,SUB$DEPTH); #UPDATE DNAT# 
    IF GETQUICK(DN$INDEXED,DNAT$,DNAT$PTR) EQ 1 
      THEN #ITEM IS INDEXED#
      BEGIN #F# 
                             TRACK$(22,2206); 
      LDNAT$LII=DNAT$PTR+1; #SET TO FIRST INDEX ITEM# 
                        VALUE$(22,"LDNAT$LII=",LDNAT$LII);
      FOR LDNAT$PTR=DNAT$PTR+1 STEP 1 WHILE #-> 1ST INDX ITM# 
      CURR$ITM$LVL LS GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR)
      OR
      GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ 88
        OR
        GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ INDXLEVL
      DO #FOR ALL SUBORD ITMS IN GRP (INCL 88 AND INDX)#
        BEGIN #FB#
                             TRACK$(22,2256); 
                           VALUE$(22,"LDNAT$PTR=",LDNAT$PTR); 
      LDNAT$LII=LDNAT$PTR; #SET TO CURR ITM IN CASE ITS LAST# 
                        VALUE$(22,"LDNAT$LII=",LDNAT$LII);
        END #FB#
      FOR LDNAT$PTR=DNAT$PTR+1 STEP 1 WHILE #-> 1ST INDX ITM# 
  
        GETQUICK(DN$LEVEL,DNAT$,LDNAT$PTR) EQ INDXLEVL
        DO #FOR ALL INDEX ITEMS#
        BEGIN #G# 
                             TRACK$(22,2207); 
                           VALUE$(22,"LDNAT$PTR=",LDNAT$PTR); 
        SETFIELD(DN$FIRIDX,DNAT$,LDNAT$PTR,DNAT$PTR); #SET 1ST  INDXD#
        SETFIELD(DN$LASIDX,DNAT$,LDNAT$PTR,LDNAT$LII); #LAST INDXD# 
        SETFIELD(DN$IDXDEP,DNAT$,LDNAT$PTR,SUB$DEPTH); #SUBSCR DEPTH# 
        END #G# 
      END #F# 
  
    IF GETQUICK(DN$DEP,DNAT$,DNAT$PTR) EQ 1 
      THEN #DEPENDING ON CLAUSE PRESENT#
      BEGIN #FA#
                             TRACK$(22,2255); 
      IF SUB$DEPTH NQ 1 
        THEN #DEPENDING ON IS ILLEGAL#
        BEGIN #GA#
                             TRACK$(22,2260); 
        ERROR(MSG57,D$ERROR); 
        #A VARIABLE LENGTH GROUP CANNOT BE SUBORDINATE TO ANOTHER 
        OCCURRING ITEM. THE DEPENDING ON OPTION IS IGNORED# 
        SETFIELD(DN$DEP,DNAT$,DNAT$PTR,0); #REMOVE DEPENDING# 
        END #GA#
        ELSE #SUBSCRIPT DEPTH IS 1# 
        BEGIN #H# 
                             TRACK$(22,2208); 
        LAUX$PTR=SRCH$AUXT(DNAT$PTR,VAROCCUR); #FIND VAROCC AUXENT# 
                           VALUE$(22,"LAUX$PTR=",LAUX$PTR); 
        LDNAT$PTR=GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR); #GET PTR TO DEPNAM#
                           VALUE$(22,"LDNAT$PTR=",LDNAT$PTR); 
        IF ELEMENTARY EQ 0
          THEN #CURRENT ITEM IS GROUP#
          BEGIN #I# #EXTRACT GROUP ATTRIBUTES#
                             TRACK$(22,2209); 
          DEPEND$PTR=DNAT$PTR; #ITM WITH DEP CLAUSE#
                       VALUE$(22,"DEPNDPTR=",DEPEND$PTR); 
          DEPEND$NAME=LDNAT$PTR; #ITM NAMED IN DEP CLAUSE#
                        VALUE$(22,"DEPNDNM=",DEPEND$NAME);
          MIN$OCCURS=GETQUICK(AX$MINOCCNO,AUX$,LAUX$PTR); #MIN OCC NO#
                        VALUE$(22,"MINOCCRS=",MIN$OCCURS);
          END #I# 
          ELSE #CURRENT ITEM IS ELEMENTARY# 
         IF LDNAT$PTR EQ DNAT$PTR 
            THEN #CLAUSE IS "A OCCURS DEP ON A" # 
            ERROR(MSG44,D$ERROR); 
            #THE AREA DESCRIBED BY THE DATA ITEM REFERENCEDIN 
            A DEPENDING ON CLAUSE MAY NOT OVERLAP  THE AREA 
            DESCRIBED BY THE DATA ENTRY WHICH CONTAINS THE
            DEPENDING ON PHRASE#
          #CREATE NEW AUXTABLE ENTRY WITH DETAILS 
          OF DEPENDING ON CLAUSE. THIS ENTRY IS 
          "HUNG" ONTO THE FIRST ENTRY OF THE DNAT 
          WHICH WILL ALWAYS BE THE TALLY ITEM#
       LAUX$PTR = ATT$NEW$AUXT(1);
                         VALUE$(22,"LAUX$PTR=",LAUX$PTR); 
          SETFIELD(AX$TTYPE,AUX$,LAUX$PTR,DEPENDCHN); #SET TYPE#
          SETFIELD(AX$OCCNAM,AUX$,LAUX$PTR,DNAT$PTR); #OCC"ING ITM# 
          SETFIELD(AX$DEPNAM,AUX$,LAUX$PTR,LDNAT$PTR); #DEP ON ITEM#
          #THE CURRENT VALUE OF GRP$ST$PTR POINTS TO AN ENTRY 
          IN GRP$ST CONTAINING A DNAT PTR TO THE LAST 
          ENCOUNTERED GROUP ITEM.#
          FOR LGRP$ST$PTR=GRP$ST$PTR
            STEP -1 #GO UP THE GROUP NEST#
            WHILE LGRP$ST$PTR GR 0 #FOR ALL GRPS# 
            DO
            BEGIN #J# 
                           TRACK$(22,2210); 
                    VALUE$(22,"LGRPSTPTR=",LGRP$ST$PTR);
            #SET CURRENT GRP ITEM TO TYPE VARIABLE GROUP# 
            SETFIELD(DN$TYPE,DNAT$,GRP$ST[LGRP$ST$PTR],VARGROUP); 
            #PICKUP AUXT PTR FOR CURRENT GRP ITEM#
            LAUX$PTR=GETQUICK(DN$AUXREF,DNAT$,
                             GRP$ST[LGRP$ST$PTR]);
                         VALUE$(22,"LAUX$PTR=",LAUX$PTR); 
            #SET AUXT PTR IN DNAT TO POINT TO END OF AUXT#
            CCTAUXTLEN=CCTAUXTLEN+1; #INCR FOR NEXT ENT#
                    VALUE$(22,"CCTAUXTLN=",CCTAUXTLEN); 
            SETFIELD(DN$AUXREF,DNAT$, 
                      GRP$ST[LGRP$ST$PTR],CCTAUXTLEN);
            #SET NEW ENTRY TO POINT TO ORIGINAL 1ST ENTRY#
            SETFIELD(AX$TNEXTPTR,AUX$,CCTAUXTLEN,LAUX$PTR); 
            #SET TYPE TO SUBORDINATE OCURS DEPENDING# 
            SETFIELD(AX$TTYPE,AUX$,CCTAUXTLEN,SUBOCCDEP); 
            #SET PTR TO ITEM THAT OCCURS# 
            SETFIELD(AX$OCCNAM,AUX$,CCTAUXTLEN,DNAT$PTR); 
            #SET PTR TO DEPENDING ON ITEM#
            SETFIELD(AX$DEPNAM,AUX$,CCTAUXTLEN,LDNAT$PTR);
            END #J# 
           IF SECTION EQ FDSECTN
            THEN #SET VRECLEN BIT#
             BEGIN
              TRACK$(22,2299);
          SETFIELD(FN$VRECLEN,FNAT$,FNAT$PTR,1); #VAR REC LEN#
             END
        END #H# 
      END #FA#
    IF GETQUICK(DN$KEYED,DNAT$,DNAT$PTR) EQ 1 
      THEN #CURRENT ITEM IS KEYED#
      BEGIN #K# 
                             TRACK$(22,2211); 
      IF ELEMENTARY EQ 1
        THEN #ITEM IS ELEMENTARY# 
        BEGIN #L# 
                             TRACK$(22,2212); 
        #CHECK THAT ITEM IS ALSO NAMED AS KEY#
        LAUX$PTR=SRCH$AUXT(DNAT$PTR,KEYNAME); #FIND KEYNAME AUXENT# 
                           VALUE$(22,"LAUX$PTR=",LAUX$PTR); 
        FOR ZERO = 0 WHILE LAUX$PTR NQ 0
          DO #FOR ALL ENTRIES IN AUXT CHAIN#
          BEGIN #M# 
                             TRACK$(22,2213); 
          IF GETQUICK(AX$KEYNAM,AUX$,LAUX$PTR) NQ DNAT$PTR
            THEN #ITEM IS NOT ITS OWN KEY#
            ERROR(MSG7,D$ERROR);
            #A DATA ITEM REFERENCED IN A "KEY IS " PHRASE 
            MUST BE CONTAINED WITHIN THE GROUP DEFINED
            BY THE ENTRY CONTAINING THE KEY IS PHRASE#
            #HMMM... A STRANGE CASE MY DEAR WATSON# 
            ELSE #ITEM IS SELF KEYING#
            BEGIN #N# 
                             TRACK$(22,2214); 
            IF GETQUICK(AX$HIERCNT,AUX$,LAUX$PTR) NQ 1
              THEN #CURRENT KEY NOT 1ST SPECIFIED#
              ERROR(MSG35,D$ERROR); 
              #WHEN THE OCCURING ITEM IS A KEY ITEM 
              IT MUST BE THE FIRST KEY ITEM#
              ELSE #CURRENT KEY IS FIRST SPECIFIED# 
              IF GETQUICK(DN$KEY,DNAT$,DNAT$PTR) EQ 0 
                THEN #KEY AS YET UNUSED#
                BEGIN #O# 
                             TRACK$(22,2215); 
                #SET FLAG TO SAY KEY NOW USED#
                SETFIELD(DN$KEY,DNAT$,DNAT$PTR,1);
                #CHANGE AUXENT TYPE TO KEY GRP NAME#
                SETFIELD(AX$TTYPE,AUX$,LAUX$PTR,KEYGRNAM);
                END #O# 
                ELSE #KEY ALREADY USED# 
                ERROR(MSG55,D$ERROR); 
                #THIS ITEM IS A KEY FOR TWO OR
                MORE OCCURING ITEMS#
            END #N# 
            LAUX$PTR=C$SRCH$AUXT(LAUX$PTR,KEYNAME); #FIND NEXT KEY# 
                           VALUE$(22,"LAUX$PTR=",LAUX$PTR); 
            END #M# 
        END #L# 
        ELSE #ITEM IS GROUP#
        BEGIN #P# 
                             TRACK$(22,2216); 
        KEY$PTR[SUB$DEPTH]=DNAT$PTR; #SAVE CURRENT ITEM IN KEY STACK# 
                VALUE$(22,"SUBDEPTH=",SUB$DEPTH); 
                VALUE$(22,"KEYPTR=",KEY$PTR[SUB$DEPTH]);
        OCCUR$NAME[SUB$DEPTH]=DNAT$PTR; #SAVE IN OCCURRING STACK ALSO#
                VALUE$(22,"SUBDEPTH=",SUB$DEPTH); 
                VALUE$(22,"OCCURNM=",OCCUR$NAME[SUB$DEPTH]);
        END #P# 
      END #K# 
  END #D# 
EXIT$(22,"OCCUR$PROC"); 
END #A# 
NEWPAGE;
PROC PIC$PROC;
BEGIN #AA#
# 
PICTURE PROCESSOR.
THIS PROCESSOR PERFORMS BASIC SYNTACTIC CHECKING ON THE 
CURRENT ITEM AND THE VALIDITY OF THE PICTURE CLAUSE.
* 
ON ENTRY, IT IS ASSUMED THAT :  
  *DNAT$PTR POINTS TO THE CURRENT ITEM IN THE DNAT
  *ELEMENTARY =1 IF THE CURENT ITEM IS ELEMENTARY (0 = GROUP) 
# 
ENTRY$(23,"PIC$PROC");
IF GETQUICK(DN$TERMPER,DNAT$,DNAT$PTR) EQ 0 
  AND 
  SECTION NQ FDSECTN
  THEN #NO TERMINAL PERIOD# 
  ERROR(MSG51,T$ERROR); 
  #A TERMINAL PERIOD IS REQUIRED FOR THIS DATA ENTRY# 
IF GETQUICK(DN$PICTURE,DNAT$,DNAT$PTR) EQ 0 
  THEN #NO PICTURE CLAUSE PRESENT#
  BEGIN #A# 
  IF ELEMENTARY EQ 1
    AND 
    GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ INDEXUSE 
    AND 
    GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) NQ COMP2USE 
    THEN #ITEM IS ELEM"TY AND NOT INDEX NOR COMP2#
    BEGIN #B# 
                             TRACK$(23,2302); 
    ERROR(MSG10,D$ERROR); 
    #A PICTURE CLAUSE IS REQUIRED FOR THIS ELEMENTARY ITEM
    # 
    SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,0); #CLEAR ITEM LEN#
    SETFIELD(DN$TYPE,  DNAT$,  DNAT$PTR,  ERRTYPE);  #SET ERROR#
    END #B# 
  END #A# 
  ELSE #PICTURE CLAUSE PRESENT# 
  BEGIN #C# 
                             TRACK$(23,2303); 
  IF ELEMENTARY EQ 0
    THEN #ITEM IS A GROUP#
    ERROR(MSG11,D$ERROR); 
    #A PICTURE CLAUSE IS ONLY ALLOWED WITH AN ELEMENTARY ITEM#
    ELSE #ITEM IS ELEMENTARY# 
    BEGIN #D# 
                             TRACK$(23,2304); 
    IF GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) EQ INDEXUSE
      OR
      GETQUICK(DN$USAGE,DNAT$,DNAT$PTR) EQ COMP2USE 
      THEN #ITEM IS USAGE INDEX, COMP1 OR COMP2#
      ERROR(MSG12,D$ERROR); 
      #WHEN THE USAGE IS INDEX OR COMP2 
      A PICTURE IS NOT ALLOWED# 
    END #D# 
  END #C# 
EXIT$(23,"PIC$PROC"); 
END #AA#
NEWPAGE;
PROC REDEF$PROC;
BEGIN #A# 
# 
REDEFINES PROCESSOR.
THIS PROCESSOR PERFORMS THE FOLLOWING ACTIONS IF THE CURRENT
ITEM HAS A REDEFINES CLAUSE : 
  A. CHECKS IF THE CURRENT ITEM IS IN THE FD OR CD SECTION
    (WHICH IS ILLEGAL). 
  B. CHECKS IF THE ORIGINAL ITEM (OF WHICH THE CURRENT ITEM IS
    A REDEFINITION) IS ITSELF A REDEFINITION OF ANOTHER ITEM
    (I.E. CURRENT REDEFINES B REDEFINES A). IF THIS IS THE CASE 
    THE AUX TABLE ENTRIES ARE CHANGED TO MAKE IT APPEAR AS
    THOUGH THE CURRENT ITEM REDEFINES A. "A" IS THEN TREATED
    AS THE ORIGINAL ITEM. 
  C. CHECKS IF THE ORIGINAL ITEM HAS AN OCCURS CLAUSE AND IF SO 
    THE REDEFINES CLAUSE IN THE CURRENT ITEM IS TURNED OFF. 
  D. CHECKS THAT NO STORAGE HAS BEEN ALLOCATED SINCE THE DEFINITION 
    OF THE ORIGINAL ITEM WAS PROCESSED. 
  E. CHECKS THAT THE REDEFINED ITEM OR ITS SUBORDINATES HAS NO GOT
    A "DEPENDING ON" CLAUSE.
  F. CHECKS THAT THE CURRENT ITEM AND THE ORIGINAL ITEM ARE 
    BOTH AT THE SAME LEVEL. 
* 
ON ENTRY IT IS ASSUMED THAT : 
  * DNAT$PTR POINTS TO THE CURRENT ENTRY IN THE DNAT
  * CURR$ITM$LVL CONTAINS THE LEVEL NUMBER OF THE CURRENT ITEM
  * SECTION CONTAINS THE CURRENT SECTION CODE 
  * NAB77/NAB (WHICH IS USED DEPENDS UPON CURR$ITM$LVL) CONTAINS
    THE NEXT AVAILABLE BYTE AFTER THE ORIGINAL ITEM. NOTE THAT
    THE CURRENT ITEM"S LENGTH HAS NOT BEEN ADDED TO NAB(77).
  * RDEF$ST$PTR CONTAINS A POINTER (USED TO ACCESS BOTH 
    RDEF$DNAT$ST [CONTAINS DNAT PTRS OF REDEFINING ITEMS] 
    AND RDEF$NAB$ST [CONTAINS BASE BYTE OF ORIGINAL ITEMS]) 
# 
#LOCAL VARIABLES# 
ITEM LAUX$PTR, LAUX$PTR2; #USED TO ACCESS THE RDEFD ITEM AUXENT#
ITEM LDNAT$ORIG; #DNAT PTR TO THE ORIGINAL (RDEFD) ITEM#
ITEM LOIL; #ORIGINAL ITEM"S LENGTH# 
ITEM LDNAT$SCAN; #USED TO SCAN DNAT ENTRIES#
ITEM SAVEDLINENO;   # SAVED LINE NO FOR FIPS DIAGNOSTICS               #
##
ENTRY$(24,"REDEF$PROC");
IF GETQUICK(DN$RDEF,DNAT$,DNAT$PTR) EQ 1
  THEN #REDEFINES CLAUSE PRESENT# 
  BEGIN #B# 
                             TRACK$(24,2402); 
  IF GETQUICK(DN$EXTERNAL,DNAT$,DNAT$PTR) EQ 1
    THEN
    BEGIN 
    ERROR(MSG22,D$ERROR); 
    #THE EXTERNAL CLAUSE AND THE REDEFINES CLAUSE MUST NOT
    BE SPECIFIED IN THE SAME DATA DESCRIPTION ENTRY.# 
    SETFIELD(DN$RDEF,DNAT$,DNAT$PTR,0); 
    GOTO END$REDEFINE;
    END 
  IF CURR$ITM$LVL EQ 1
    AND 
    (SECTION EQ FDSECTN OR SECTION EQ CDSECTN)
    THEN #ITEM IS LVL 1  IN FD OR CD SECTION# 
    BEGIN #C# 
                             TRACK$(24,2403); 
    ERROR(MSG15,D$ERROR); 
    #A REDEFINES CLAUSE IS NOT ALLOWED WITH A LEVEL 01
    ITEM IN THE FILE OR COMMUNICATION SECTION#
    SETFIELD(DN$RDEF,DNAT$,DNAT$PTR,0); #CLR REDEF FLAG#
    GOTO END$REDEFINE;
    END #C# 
  LAUX$PTR=SRCH$AUXT(DNAT$PTR,RDEFNAME); #GET AUXENT FOR RDFD ITM#
                           VALUE$(24,"LAUX$PTR=",LAUX$PTR); 
  LDNAT$ORIG=GETQUICK(AX$RDEFNAM,AUX$,LAUX$PTR); #GET DNAT RDFD ITM#
                          VALUE$(24,"LDNATORIG=",LDNAT$ORIG); 
  IF GETQUICK(DN$EXTERNAL,DNAT$,LDNAT$ORIG) EQ 1
    THEN
    BEGIN 
    SETFIELD(DN$EXTERNAL,DNAT$,DNAT$PTR,1); 
    END 
  IF GETQUICK(DN$RDEF,DNAT$,LDNAT$ORIG) EQ 1
    THEN #REDEFINED ITEM IS ITSELF A REDEFINITION#
    BEGIN #D# 
                             TRACK$(24,2404); 
    ERROR(MSG53,J$ERROR); 
    #A REDEFINES CLAUSE THAT NAMES AN ITEM THAT CONTAINS
    A REDEFINES CLAUSE IS NON-STANDARD# 
    #PICKUP DNAT$PTR TO "REAL" ORIGINAL ITEM# 
    LAUX$PTR2=SRCH$AUXT(LDNAT$ORIG,RDEFNAME); 
                    VALUE$(24,"LAUX$PTR2=",LAUX$PTR2);
    LDNAT$ORIG=GETQUICK(AX$RDEFNAM,AUX$,LAUX$PTR2); 
                          VALUE$(24,"LDNATORIG=",LDNAT$ORIG); 
    #CHANGE AUX ENTS SO THAT CURRENT ITEM RDEFS REAL ORIGINAL#
    TGET=GETQUICK(AX$RDEFNAM,AUX$,LAUX$PTR2); 
    SETFIELD(AX$RDEFNAM,AUX$,LAUX$PTR,TGET);
    END #D# 
  IF GETQUICK(DN$OCCURS,DNAT$,LDNAT$ORIG) EQ 1
    THEN
    BEGIN #B# 
                             TRACK$(24,2402); 
    ERROR(MSG17,D$ERROR); 
    #THIS DATA NAME HAS A REDEFINES CLAUSE WHICH NAMES AN 
    ITEM WITH AN OCCURS CLAUSE. THE REDEFINES CLAUSE WILL 
    BE IGNORED# 
    SETFIELD(DN$RDEF,DNAT$,DNAT$PTR,0); #CLR RDEF FLAG# 
    GOTO END$REDEFINE;
    END #E# 
  IF CURR$ITM$LVL EQ 77 
    THEN #THIS ITEM IS A LEVEL 77#
    BEGIN #F# 
                             TRACK$(24,2406); 
    IF NAB NQ ( GETQUICK(DN$LONGOFF,DNAT$,LDNAT$ORIG) 
             + GETQUICK(DN$ITMLEN,DNAT$,LDNAT$ORIG) ) 
    AND 
    SECTION NQ LKSECTN
      THEN #STORAGE HAS BEEN ALLOCATED BETWEEN RDEF AND ORIG# 
      BEGIN 
      ERROR(MSG18,D$ERROR); 
      #AN ENTRY CONTAINING A REDEFINES CLAUSE MUST IMMEDIATELY
      FOLLOW THE DESCRIPTION OF THE AREA BEING REDEFINED
      WITH NO INTERVENING ENTRIES THAT DEFINE NEW STORAGE#
      SETFIELD(DN$RDEF,DNAT$,DNAT$PTR,0); #DISABLE REDEF# 
      GOTO END$REDEFINE;
      END 
      ELSE #REDEFINES IMMEDIATELY FOLLOWS ORIGINAL# 
      IF GETQUICK(DN$SYNCRGHT,DNAT$,DNAT$PTR) EQ 0
      THEN #CURRENT ITEM IS SYNC LEFT#
      BEGIN #G# 
                             TRACK$(24,2407); 
      IF GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR) 
        NQ
        GETQUICK(DN$ITMLEN,DNAT$,LDNAT$ORIG)
        THEN #RDEF UNEQUAL LENGTH OF ORIG#
        BEGIN #GA#
                             TRACK$(24,2460); 
        ERROR(MSG52,J$ERROR); 
        #THE REDEFINING DATA MUST SPECIFY THE SAME NUMBER OF
        CHARACTER POSITIONS AS THE DATA ITEM BEING REDEFINED
        HOWEVER, IN THIS COMPILER, THE REDEFINING DATA NEED 
        NOT SPECIFY A STORAGE AREA OF THE SAME SIZE AS THE
        REDEFINED DATA# 
        IF GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR) 
          GR
          GETQUICK(DN$ITMLEN,DNAT$,LDNAT$ORIG)
          THEN #RDEF LONGER THAN ORIG#
          BEGIN #GE#
        NAB=NAB 
         -GETQUICK(DN$ITMLEN,DNAT$,LDNAT$ORIG)
         +GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR); 
                           VALUE$(24,"NAB=",NAB); 
          END #GE#
       END #GA# 
      END #G# 
    #SET CURRENT ITEM FROM ORIGINAL#
    TGET=GETQUICK(DN$LONGOFF,DNAT$,LDNAT$ORIG); 
    SETFIELD(DN$LONGOFF,DNAT$,DNAT$PTR,TGET); 
    GOTO REDEF$SYNCHK;
    END #F# 
  IF SECTION NQ FDSECTN 
    THEN #NOT CURRENTLY IN FD SECTION#
    BEGIN #GC#
                             TRACK$(24,2462); 
    O$ADDR=GETQUICK(DN$LONGOFF,DNAT$,LDNAT$ORIG); 
                        VALUE$(24,"0$ADDR=",O$ADDR);
    END #GC#
    ELSE #CURRENTLY IN FD SECTION#
    BEGIN #GD#
    O$ADDR=GETQUICK(DN$BYTEOFFS,DNAT$,LDNAT$ORIG);
                        VALUE$(24,"0$ADDR=",O$ADDR);
    END #GD#
  #O$ADDR NOW CONTAINS BASE BYTE OF ORIGINAL ITEM#
  RDEF$ST$PTR=RDEF$ST$PTR+1; #STEP DOWN REDEFINES STACKS# 
  RDEF$DNAT$ST[RDEF$ST$PTR]=DNAT$PTR; #SAVE CURRENT ITM DNAT# 
                VALUE$(24,"RDEFSTPTR=",RDEF$ST$PTR);
                VALUE$(24,"RDEFDNAT=",RDEF$DNAT$ST[RDEF$ST$PTR]); 
  RDEF$NAB$ST[RDEF$ST$PTR]=NAB; #SAVE CURRENT ITM BASE BYTE#
                VALUE$(24,"RDEFNAB=",NAB);
  LOIL=NAB-O$ADDR; #COMPUTE ORIGINAL ITEM LENGTH# 
                     VALUE$(24,"LOIL=",LOIL); 
  NAB=O$ADDR; #RESET NAB TO BASE OF ORIGINAL ITEM#
                       VALUE$(24,"NAB=",NAB); 
NAB=NAB+SYNC$BYTES; #SYNC NAB IF CURR ITM IS SYNC#
               VALUE$(24,"NAB=",NAB); 
SYNC$BYTES=0; #RESET# 
    IF DNAT$PTR LQ LDNAT$ORIG 
    THEN BEGIN
         # CRAZY - THE REDEFINITION DOES NOT FOLLOW THE ORIGINAL #
         ERROR(MSG18,D$ERROR);
         SETFIELD(DN$RDEF,DNAT$,DNAT$PTR,0);
         END
    ELSE BEGIN
  #SCAN FROM ENTRY AFTER ORIGINAL UP TO ONE BEFORE CURRENT# 
  FOR LDNAT$SCAN=LDNAT$ORIG+1 STEP 1 UNTIL (DNAT$PTR-1) DO
    BEGIN #H# 
                             TRACK$(24,2408); 
    IF CURR$ITM$LVL GR GETQUICK(DN$LEVEL,DNAT$,LDNAT$SCAN)
      OR
      (CURR$ITM$LVL EQ GETQUICK(DN$LEVEL,DNAT$,LDNAT$SCAN)
        AND 
      GETQUICK(DN$RDEF,DNAT$,LDNAT$SCAN) EQ 0 ) 
      AND 
      SECTION NQ LKSECTN
      THEN #SCAN ITEM IS EITHER AT LOWER LEVEL THAN 
          CURRENT, OR IS AT SAME LEVEL AND IS NOT A REDEFINITION# 
      BEGIN #I# 
                             TRACK$(24,2409); 
                   VALUE$(24,"LDNATSCN=",LDNAT$SCAN); 
      ERROR(MSG18,D$ERROR); 
      #AN ENTRY CONTAINING A REDEFINES CLAUSE MUST IMMEDIATELY
      FOLLOW THE DESCRIPTION OF THE AREA BEING REDEFINED WITH NO
      INTERVENING ENTRIES THAT DEFINE NEW STORAGE#
      LDNAT$SCAN=DNAT$PTR; #FORCE IMMEDIATE EXIT FROM "FOR" LOOP# 
      SETFIELD(DN$RDEF,DNAT$,DNAT$PTR,0);  #DISABLE RDEF# 
      END #I# 
    END #H# 
         END
  IF GETQUICK(DN$DEP,DNAT$,LDNAT$ORIG) EQ 1 
    THEN #CURRENT ITEM HAS DEPENDING ON CLAUSE# 
    ERROR(MSG42,D$ERROR); 
    #AN ENTRY WHICH CONTAINS OR HAS A SUBORDINATE ENTRY WHICH 
    CONTAINS A DEPENDING ON PHRASE MAY NOT BE THE OBJECT
    OF A REDEFINES CLAUSE#
  IF GETQUICK(DN$TYPE,DNAT$,LDNAT$ORIG) EQ VARGROUP 
    THEN #ORIGINAL ITEM HAS SUBORD DEPENDING ON#
    ERROR(MSG42,D$ERROR); 
    #SEE ABOVE FOR DEFINITION OF MSG 42#
REDEF$SYNCHK: 
  IF CURR$ITM$LVL NQ GETQUICK(DN$LEVEL,DNAT$,LDNAT$ORIG)
    THEN #RDEF AND ORIG NOT AT SAME LEVEL#
    ERROR(MSG13,D$ERROR); 
    #A DATA ITEM MUST HAVE THE SAME LEVEL NUMBER
    AS THE ITEM IT REDEFINES# 
    IF CCTFIPSLEVEL LS 3
    THEN BEGIN
         FOR LDNAT$SCAN = DNAT$PTR + 1
         STEP 1 
         WHILE LDNAT$SCAN LQ CCTDNATLEN 
         DO BEGIN 
            IF GETQUICK(DN$LEVEL,DNAT$,LDNAT$SCAN) LQ CURR$ITM$LVL
            THEN BEGIN
                 LDNAT$SCAN = CCTDNATLEN + 1; 
                 TEST LDNAT$SCAN; 
                 END
            IF GETQUICK(DN$LEVEL,DNAT$,LDNAT$SCAN) LQ 49
               AND GETQUICK(DN$RDEF,DNAT$,LDNAT$SCAN) EQ 1
            THEN BEGIN
                 SAVEDLINENO = LINE$NO; 
                 LINE$NO = GETQUICK(DN$LINE,DNAT$,LDNAT$SCAN);
                 ERROR(MSG200,T$ERROR); 
                 LINE$NO = SAVEDLINENO; 
                 LDNAT$SCAN = CCTDNATLEN + 1; 
                 TEST LDNAT$SCAN; 
                 END
            END 
         END
  END #B# 
END$REDEFINE: 
EXIT$(24,"REDEF$PROC"); 
END #A# 
NEWPAGE;
PROC SIGN$PROC; 
BEGIN #A# 
# 
SIGN PROCESSOR
THIS PROCESSOR MAKES SYNTACTIC CHECKS RELATED TO THE SIGN CLAUSE
IN THE CURRENT ITEM (OR SUPERIOR GROUP ITEM) ISSUING THE
APPROPRIATE ERROR MESSAGES. 
NOTE THAT A GROUP ITEM HAVING A SIGN CLAUSE PASSES THAT ONTO
SUBORDINATE ITEMS.
* 
ON ENTRY IT IS ASSUMED THAT 
  * DNAT$PTR POINTS TO THE CURRENT ENTRY IN THE DNAT
  * THE FOLLOWING FIELDS ARE SET TO REFLECT SUPERIOR GROUP
    ITEM ATTRIBUTES 
    * SIGN$FLAG =1 IF SIGN CLAUSE PRESENT 
    * SIGN$PTR CONTAINS DNAT PTR OF SUPERIOR GROUP ITEM 
      WITH SIGN CLAUSE IF ANY 
    * NO$SIGND$PIC =1 IF SIGN CLAUSE PRESENT, SET TO 0
      WHEN A PIC CONTAINING "S" IS FOUND
  * ELEMENTARY =1 IF CURRENT ITEM IS ELEMENTARY (0= GROUP)
# 
#LOCAL VARIABLES# 
ITEM LDN$TYPE; #CONTAINS DN$TYPE OF CURRENT ITEM# 
ITEM LDN$USAGE; #CONTAINS DN$USAGE OF CURRENT ITEM# 
# 
# 
ENTRY$(25,"SIGN$PROC"); 
LDN$TYPE=GETQUICK(DN$TYPE,DNAT$,DNAT$PTR); #SET LCL VARIABLES#
                      VALUE$(25,"LDN$TYPE=",LDN$TYPE);
LDN$USAGE=GETQUICK(DN$USAGE,DNAT$,DNAT$PTR);
                      VALUE$(25,"LDN$USAGE=",LDN$USAGE);
IF GETQUICK(DN$SIGNBIT,DNAT$,DNAT$PTR) EQ 0 
  THEN #NO SIGN CLAUSE PRESENT FOR CURRENT ITEM#
  BEGIN #B# 
                             TRACK$(25,2502); 
  IF SIGN$FLAG EQ 0 
    THEN #NO SUPERIOR GRP ITEM WITH SIGN CLAUSE#
    BEGIN #C# 
                             TRACK$(25,2503); 
    IF GETQUICK(DN$PICSIGN,DNAT$,DNAT$PTR) EQ 1 
      THEN #CHAR "S" FOUND IN PIC CLAUSE# 
      BEGIN #D# 
                             TRACK$(25,2504); 
      SETFIELD(DN$SIGNBIT,DNAT$,DNAT$PTR,1); #FORCE SET SIGN CL#
      IF LDN$TYPE EQ NUMERIC
        THEN #TYPE IS NUMERIC#
        BEGIN #E# #SET DNAT FIELDS FROM CCT#
                             TRACK$(25,2505); 
        IF CCTSIGNLEAD[0] 
          THEN #CCT BIT INDICATES LEAD SIGN#
          SETFIELD(DN$LSIGN,DNAT$,DNAT$PTR,1); #LEADING CHAR# 
        IF CCTSIGNSEPAR[0]
          THEN #CCT BIT INDICATES SEPARATE SIGN#
          SETFIELD(DN$SCHAR,DNAT$,DNAT$PTR,1); #SEPRT SIGN# 
        END #E# 
      END #D# 
      ELSE #NO CHAR "S" IN PIC CLAUSE#
      BEGIN #F# 
                             TRACK$(25,2506); 
      IF LDN$TYPE EQ SHORTFLOAT 
        OR
        LDN$TYPE EQ LONGFLOAT 
        OR
        LDN$TYPE EQ EXTFLOAT
        THEN #TYPE IS ONE FORM OF FLOATING POINT# 
        SETFIELD(DN$SIGNBIT,DNAT$,DNAT$PTR,1); #FORCE SIGN# 
      END #F# 
    END #C# 
    ELSE #SUPERIOR GRP ITEM WITH SIGN CLAUSE# 
    BEGIN #G# 
                             TRACK$(25,2507); 
    IF ELEMENTARY EQ 1
      AND 
      GETQUICK(DN$PICSIGN,DNAT$,DNAT$PTR) EQ 1
      AND 
      LDN$TYPE EQ NUMERIC 
      THEN #CURRENT ITEM IS NUMERIC SIGNED PICTURE : ALL"S OK#
      BEGIN #GA#
                             TRACK$(25,2560); 
      NO$SIGND$PIC=0; #INDICATE NO ERROR# 
                         VALUE$(25,"NOSIGNPC=",NO$SIGND$PIC); 
      #SET CURRENT ITEM"S SIGN ATTRIBUTES FROM SUPERIOR GRP ITM#
    TGET=GETQUICK(DN$SIGNGRP,DNAT$,SIGN$PTR); 
    SETFIELD(DN$SIGNGRP,DNAT$,DNAT$PTR,TGET); 
    END #GA#
    END #G# 
  IF GETQUICK(DN$SCHAR,DNAT$,DNAT$PTR) EQ 1 
    AND 
(LDN$USAGE EQ DISPUSE 
  OR
LDN$USAGE EQ COMPUSE) 
    THEN #SIGN IS SEPARATE DISPLAY CHAR#
    BEGIN #GB#
                              TRACK$(25,2561);
    TGET=GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR); #INCR LEN BY 1#
    TGET=TGET+1;
    SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,TGET);
    END #GB#
  END #B# 
  ELSE #SIGN CLAUSE PRESENT FOR CURRENT ITEM# 
  BEGIN #BA#
  IF LDN$USAGE NQ DISPUSE 
    AND 
    LDN$USAGE NQ NULL 
    THEN #SIGN CLAUSE PRESENT WITH USAGE DISPLAY OR NULL# 
    ERROR(MSG4,D$ERROR);
    #THE SIGN CLAUSE MAY ONLY BE USED WITH A DATA ITEM WHOSE USAGE
    IS DISPLAY# 
    ELSE #IF USAGE IS VALID#
    IF LDN$TYPE NQ NUMERICEDIT
      AND 
      LDN$TYPE NQ NUMERIC 
      AND 
      LDN$TYPE NQ GROUP 
      AND 
      LDN$TYPE NQ VARGROUP
      AND 
      LDN$TYPE NQ EXTFLOAT
      THEN #TYPE IS A VALUE THAT MAY NOT HAVE A SIGN CLAUSE#
      ERROR(MSG39,D$ERROR); 
      #THE SIGN CLAUSE MAY ONLY BE USED FOR NUMERIC OR
      NUMERIC EDITTED DATA ITEMS# 
    IF SIGN$FLAG EQ 1 
      THEN #THERE IS SUPERIOR GRP ITM WITH SIGN#
      BEGIN #H# 
                             TRACK$(25,2508); 
      IF GETQUICK(DN$SIGNGRP,DNAT$,DNAT$PTR) NQ 
      GETQUICK(DN$SIGNGRP,DNAT$,SIGN$PTR) 
        THEN #CONFLICT BETWEEN GRP AND SUBORDINATE ITMS#
        ERROR(MSG2,D$ERROR);
        #CONFLICTS HAVE BEEN DETECTED BETWEEN GROUP AND 
        SUBORDINATE ITEMS#
      END #H# 
    IF ELEMENTARY EQ 1
      THEN #CURRENT ITEM IS ELEMENTARY# 
      BEGIN #I# 
                             TRACK$(25,2509); 
      IF GETQUICK(DN$PICSIGN,DNAT$,DNAT$PTR) EQ 0 
        THEN #THERE IS NO "S" IN PIC CLAUSE#
        ERROR(MSG3,D$ERROR);
        #THE PICTURE STRING SPECIFIED FOR A SIGNED
        DATA ITEM MUST BE SIGNED# 
        ELSE # "S" IN PIC CLAUSE# 
        IF LDN$TYPE EQ NUMERIC
          THEN #NO ERROR# 
         BEGIN #IA# 
                             TRACK$(25,2565); 
          NO$SIGND$PIC=0; 
                         VALUE$(25,"NOSIGNPC=",NO$SIGND$PIC); 
        END #IA#
      IF GETQUICK(DN$SCHAR,DNAT$,DNAT$PTR) EQ 1 
        AND 
        LDN$USAGE EQ DISPUSE
        THEN #ITEM IS USAGE DISPLAY WITH SEPARATE SIGN# 
        #SO INCREMENT LENGTH BY 1#
        SETFIELD(DN$ITMLEN,DNAT$,DNAT$PTR,
          (GETQUICK(DN$ITMLEN,DNAT$,DNAT$PTR)+1));
      END #I# 
    ELSE #CURRENT ITEM IS GROUP#
    BEGIN #J# 
                             TRACK$(25,2510); 
    IF SIGN$FLAG EQ 0 
      THEN #NO SUPERIOR GROUP WITH SIGN CLAUSE# 
      BEGIN #K# #SO SET GROUP ATTRIBUTES FOR SUBORDS# 
                             TRACK$(25,2511); 
      SIGN$PTR=DNAT$PTR; #PTR TO CURRENT ITEM#
                       VALUE$(25,"SIGNPTR=",SIGN$PTR);
      SIGN$FLAG=1; #INDICATE SUPERIOR SIGN# 
                          VALUE$(25,"SIGNFLAG=",SIGN$FLAG); 
      NO$SIGND$PIC=1;  #WILL BE CLEARED WHEN ALL FOUND OK#
                         VALUE$(25,"NOSIGNPC=",NO$SIGND$PIC); 
      END #K# 
    END #J# 
  END #BA#
IF SECTION EQ FDSECTN 
  AND 
  FNAT$PTR GR 0 
  AND 
   (GETQUICK(FN$CODEPTR,FNAT$,FNAT$PTR) NQ 0 OR 
    GETQUICK(FN$RECMODE,FNAT$,FNAT$PTR) EQ DECMODE) 
  AND 
  GETQUICK(DN$SIGNBIT,DNAT$,DNAT$PTR) NQ 0
  AND 
  GETQUICK(DN$SCHAR,DNAT$,DNAT$PTR) EQ 0
  THEN #SIGN CHAR NOT SEPARATE IN CODESET FILE# 
  BEGIN 
  ERROR(MSG116,D$ERROR);
  END 
  #IF THE CODESET CLAUSE IS SPECIFIED ALL ITEMS, IF SIGNED
  MUST HAVE A SEPARATE SIGN#
EXIT$(25,"SIGN$PROC");
END #A# 
NEWPAGE;
PROC SUM$FILE;
BEGIN #AA#
# 
SUM FILE PROCESSOR
* 
THIS PROCESSOR IS CALLED WHEN THE LAST ITEM OF THE LAST RECORD
OF AN FD HAS BEEN PROCESSED.
* 
ON ENTRY THE FOLLOWING POINTERS ARE ASSUMED TO BE SET UP :  
  DNAT = FD$PTR  POINTS TO THE DNAT ENTRY FOR THE FD OF FILE
        DNAT$PTR  POINTS TO THE LAST ITEM OF LAST RECORD OF FILE
  FNAT = FNAT$PTR  POINTS TO FNAT ENTRY FOR FILE
* 
THE OVERALL PROCESSING IS : 
  A.CHECK VALIDITY OF KEYS WITH RESPECT TO FILE ORGANISATION, 
    KEY TYPE AND KEY POSITION.
  B. CHECK MAXIMUM AND MINIMUM RECORD LENGTHS WITH RESPECT
     TO "RECORD CONTAINS" CLAUSE IF PRESENT.
# 
#LOCAL VARIABLES# 
ITEM KEYFLAG;  #1 IF PRIME KEY ERROR, 0 OTHERWISE#
ITEM LRELKPTR; #DNAT PTR TO RELATIVE KEY ITEM#
ITEM LRELKLVL; #RELATIVE KEY LEVEL# 
ITEM LRELKTYPE;  #RELATIVE KEY DATA TYPE# 
ITEM LINDXKPTR; #DNAT PTR TO INDEX KEY ITEM#
ITEM LINDXKLVL; #INDEX KEY LEVEL# 
ITEM LINDXKTYPE; #INDEX KEY TYPE# 
ITEM LKEYBYTEOFFS; #KEY BYTE OFFSET#
                    VALUE$(26,"LKYBYTOFS=",LKEYBYTEOFFS); 
ITEM LKEYSIZE;  #KEY BYTE LENGTH# 
ITEM LAUX$PTR;  #AUX PTRS USED TO SCAN KEY ITEM CHAIN#
ITEM LAUX$PTR2; 
ITEM LALTKPTR; #DNAT PTRS USED TO VALIDATE ALT KEYS#
ITEM LALTKPTR2; 
ITEM LRECDPTR;  #PTR TO LVL 01 RECORD ITEM# 
ITEM LBLCTPTR; #DNAT PTR TO BLOCK COUNT ITEM# 
ITEM LWAKPTR; #WORD ADDRESS KEY PTR#
ITEM LRCONTPTR; #POINTER TO RECORD CONTAINS DEP ON ITEM#
ITEM LRMSIZE; #REAL MINIMUM RECORD SIZE (AS OPPOSED TO THAT SPEC"D)#
ITEM LDN2; # DNAT PTR TO ALT KEY DN2 #
ITEM LDNTYPE; 
ITEM LODOOFFSET I;  #OFFSET OF ODO ITEM#
ITEM LODONMOFFSET I;  #OFFSET OF ODO DEP ON ITEM# 
ITEM LODOOCCLEN I;  #OCC LENGTH OF ODO ITEM#
ITEM LODONMLEN I;  #LENGTH OF ODO DEP ON ITEM#
ITEM LRECLEN I;  #RECORD LENGTH OF REC DESCR# 
ITEM LTEMP I;  # TEMP # 
ITEM LRECNB I;  #REC NBR BEING PROCESSED# 
ITEM LODOPTR I;  #PONTER TO ODO DNAT# 
ITEM LODONMPTR I;  #POINTER TO ODO NAME DNAT# 
# 
# 
ENTRY$(26,"SUM$FILE");
IF FNAT$PTR LQ 0 THEN GOTO SUMFILEXIT;  #NO FNATS EXIT# 
  #SET LINE NUMBER TO THAT OF FD STATEMENT# 
LINE$NO = GETQUICK(DN$LINE,DNAT$,FD$PTR); 
                        VALUE$(26,"LINE$NO=",LINE$NO);
SETFIELD(FN$RECCOUNT,FNAT$,FNAT$PTR,NUMRECS); 
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ SEQUENTIAL #CHK ORG IS SEQ# 
  THEN #ORGANISATION IS SEQUENTIAL# 
  BEGIN #A# 
  IF GETQUICK(FN$RELKPTR,FNAT$,FNAT$PTR) NQ 0 
    OR
    GETQUICK(FN$RECPTR,FNAT$,FNAT$PTR) NQ 0 
    OR
    GETQUICK(FN$ALTKPTR,FNAT$,FNAT$PTR) NQ 0
    THEN #RELATIVE OR NORMAL OR ALTERNATE KEY PRESENT#
    BEGIN 
    ERROR$F(MSG91,D$ERROR); 
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #SEQUENTIAL FILES MUST NOT HAVE RELATIVE OR RECORD
    KEYS NAMED IN THE FILE CONTROL PARAGRAPH# 
  END #A# 
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ RELATIVE
  THEN # ORGANISATION IS RELATIVE#
  BEGIN #B# 
                             TRACK$(26,2602); 
  IF GETQUICK(FN$RECPTR,FNAT$,FNAT$PTR) NQ 0
    THEN #RECORD KEY PHRASE PRESENT#
    BEGIN 
    ERROR$F(MSG95,D$ERROR); 
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #RELATIVE FILES CANNOT HAVE RECORD KEYS#
  LRELKPTR=GETQUICK(FN$RELKPTR,FNAT$,FNAT$PTR); #DNAT OF REL KEY ITM# 
                      VALUE$(26,"LRELKPTR=",LRELKPTR);
  IF LRELKPTR NQ 0
    THEN #RELATIVE KEY ITEM PRESENT#
    BEGIN#C#
    #CHECK RELATIVE KEY NOT CONTAINED IN RECORD#
    IF LRELKPTR GR FD$PTR AND LRELKPTR LQ DNAT$PTR
      THEN #KEY IS BETWEEN FD AND LAST ITEM#
      BEGIN 
      ERROR$F(MSG69,D$ERROR); 
      SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
      END 
      #THE RELATIVE KEY FOR A FILE MAY NOT BE DEFINED 
      WITHIN A RECORD OF THAT FILE# 
    LRELKLVL=GETQUICK(DN$LEVEL,DNAT$,LRELKPTR); #GET REL KEY LEVEL# 
                      VALUE$(26,"LRELKLVL=",LRELKLVL);
    LRELKTYPE=GETQUICK(DN$TYPE,DNAT$,LRELKPTR); #GET REL KEY TYPE#
                      VALUE$(26,"RELKTYPE=",LRELKTYPE); 
    #CHECK IF REL KEY IS VALID DATA ITEM# 
    IF LRELKLVL LQ 50 OR LRELKLVL EQ 77 
      THEN #KEY LEVEL INDICATES VALID DATA ITEM#
      CHKUSINT(LRELKPTR,MSG70); #CHECK ITEM IS UNSIGNED INTEGER#
    END #C# 
    ELSE #NO RELATIVE KEY ITEM PRESENT# 
  IF GETQUICK(FN$ACCESS,FNAT$,FNAT$PTR) NQ SEQACCESS
      THEN #ACCESS MODE NOT SEQUENTIAL# 
      BEGIN 
      ERROR$F(MSG71,D$ERROR); 
      SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
      END 
      #A RELATIVE FILE MUST HAVE A RELATIVE KEY NAME# 
      #SPECIFIED WHEN THE ACCESS MODE IS NOT SEQUENTIAL#
  END #B# 
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ INDEXED 
  OR
  GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ DIRECT 
  OR
  GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ ACTUAL$KEY 
  THEN #ORGANISATION IS INDEXED DIRECT OR ACTUAL KEY# 
  BEGIN #E# 
                             TRACK$(26,2605); 
  IF GETQUICK(FN$RELKPTR,FNAT$,FNAT$PTR) NQ 0 
    THEN # RELATIVE KEY PRESENT#
    BEGIN 
    ERROR$F(MSG94,D$ERROR); 
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #INDEXED, DIRECT OR ACTUAL KEY FILES CANNOT HAVE RELATIVE KEYS# 
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ DIRECT
  AND 
  GETQUICK(FN$DBLCT,FNAT$,FNAT$PTR) EQ 1
  AND 
  GETQUICK(FN$DBLCTPTR,FNAT$,FNAT$PTR) NQ 0 
  THEN #ORG IS DIRECT AND NON LITERAL BLK CNT SPECIFIED#
  BEGIN #EA#
  LBLCTPTR=GETQUICK(FN$DBLCTPTR,FNAT$,FNAT$PTR);
  CHKUSINT(LBLCTPTR,MSG122); #CHK UNSIGNED INTEGER# 
  END #EA#
  LINDXKPTR=GETQUICK(FN$RECPTR,FNAT$,FNAT$PTR); #GET DNAT TO INDX ITM#
                      VALUE$(26,"LINDXKPTR=",LINDXKPTR);
  
  IF LINDXKPTR EQ 0 
    THEN #NO INDEX KEY PRESENT# 
    BEGIN 
    ERROR$F(MSG72,D$ERROR); 
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #INDEXED, DIRECT OR ACTUAL KEY FILES MUST HAVE A RECORD 
    KEY SPECIFIED#
    ELSE #INDEX KEY PRESENT#
    BEGIN #F# 
                             TRACK$(26,2606); 
    KEYFLAG = 0;             #INDICATES NO PRIME KEY ERROR# 
    IF GETQUICK(DN$LEVEL,DNAT$,LINDXKPTR) GQ 50 
       AND
       GETQUICK(DN$LEVEL,DNAT$,LINDXKPTR) NQ 77 
      THEN  #KEY ITEM MUST BE LEVEL 1 THRU 49 OR 77#
      BEGIN 
      ERROR(MSG137,D$ERROR);
      KEYFLAG = 1;
      END 
    IF LINDXKPTR LQ FD$PTR
       OR 
       LINDXKPTR GR DNAT$PTR
      THEN  #NON-IMBEDDED KEY#
      ERROR(MSG73,J$ERROR); 
    IF KEYFLAG NQ 0 
      THEN  #PRIME KEY ERROR# 
      BEGIN 
      SETFIELD(FN$RKEYERR,FNAT$,FNAT$PTR,1);  #SET KEY ERROR FLAG#
      SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1);  #ABORT THIS FNAT# 
      END 
      ELSE #INDEX ITEM IS VALID DATA ITEM#
      BEGIN #I# 
                             TRACK$(26,2609); 
      CHKKEYVAL(LINDXKPTR); #CHK KEY VALID# 
      IF GETQUICK(DN$SDEPTH,DNAT$,LINDXKPTR) NQ 0 
      THEN
        IF GETQUICK(FN$SSCHEMA,FNAT$,FNAT$PTR) EQ 1 
        THEN
          BEGIN 
            LAUX$PTR=GETQUICK(DN$AUXREF,DNAT$,LINDXKPTR); 
            SRCHLOOP: 
            IF LAUX$PTR NQ 0
            THEN
              BEGIN 
                IF GETQUICK(AX$TTYPE,AUX$,LAUX$PTR) NQ MAXOCCUR 
                AND GETQUICK(AX$SUBSLVL,AUX$,LAUX$PTR) NQ 
                GETQUICK(DN$SDEPTH,DNAT$,LINDXKPTR) 
                THEN
                  BEGIN 
                    LAUX$PTR=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$PTR); 
                    GOTO SRCHLOOP;
                  END 
                ELSE
                  BEGIN 
                    IF GETQUICK(AX$MAXOCCNO,AUX$,LAUX$PTR) NQ 1 
                    THEN
                      BEGIN 
                        ERROR$F(MSG76,D$ERROR); 
                        SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1);
                      END 
                  END 
              END 
            ELSE
              BEGIN 
                ERROR$F(MSG76,D$ERROR); 
                SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1);
              END 
          END 
        ELSE
          BEGIN 
            ERROR$F(MSG76,D$ERROR); 
            SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1);
          END 
       # RECORD KEY IDENTIFIERS CANNOT BE SUBSCRIPTED # 
       # UNLESS THEY COME FROM A SUBSCHEMA AND OCCUR ONLY 1 TIME #
      #PICKUP BYTE OFFSET OF KEY# 
      LKEYBYTEOFFS=GETQUICK(DN$BYTEOFFS,DNAT$,LINDXKPTR); 
                    VALUE$(26,"LKYBYTOFS=",LKEYBYTEOFFS); 
      LKEYSIZE=GETQUICK(DN$ITMLEN,DNAT$,LINDXKPTR); 
      END #I# 
    LAUX$PTR=GETQUICK(FN$ALTKPTR,FNAT$,FNAT$PTR); #GET 1ST ALT KEY# 
                           VALUE$(26,"LAUX$PTR=",LAUX$PTR); 
    FOR ZERO = 0 WHILE LAUX$PTR NQ 0 DO 
    BEGIN #J# #VALIDATE ALT KEY DNAT ENTRIES# 
                             TRACK$(26,2610); 
    LDNTYPE = GETQUICK(AX$TTYPE,AUX$,LAUX$PTR); 
    IF LDNTYPE EQ AUXALTKEYDN2
    THEN BEGIN
         # CONSIDER THE FOLLOWING TWO PHRASES # 
         # OMITTED WHEN DN2 CONTAINS CHARACTER FROM LITERAL # 
         # USE WHEN DN2 CONTAINS CHARACTER FROM LITERAL # 
         # DN2 MUST BE ONE CHAR ALPHANUMERIC #
         # DN2 MUST BE IN A RECORD OF THE FILE #
         LDN2 = GETQUICK(AX$AKDN2DNAT,AUX$,LAUX$PTR); 
         IF GETQUICK(DN$TYPE,DNAT$,LDN2) NQ ALPHNUM 
         OR GETQUICK(DN$ITMLEN,DNAT$,LDN2) NQ 1 
         OR LDN2 LQ FD$PTR
         OR LDN2 GR DNAT$PTR
         THEN BEGIN 
              ERROR$F(MSG142,D$ERROR);
              END 
        END 
    IF LDNTYPE EQ ALTKEYNAME
    THEN BEGIN
    LALTKPTR=GETQUICK(AX$ALTKEY,AUX$,LAUX$PTR); #GET DNAT OF KEY ITM# 
                     VALUE$(26,"LALTKPTR=",LALTKPTR); 
    IF LALTKPTR LQ FD$PTR 
      OR
      LALTKPTR GR DNAT$PTR
      THEN #ALT KEY ITEM IS NOT WITHIN RECORD#
      BEGIN #K# 
                             TRACK$(26,2611); 
      SETFIELD(AX$ALTKEYERR,AUX$,LAUX$PTR,1); #SET KEY ERROR FLAG#
      ERROR$F(MSG75,D$ERROR); 
      SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    #AN ALTERNATE KEY FOR AN INDEXED, DIRECT OR ACTUAL KEY FILE 
    MUST BE A DATA ITEM WITHIN A RECORD OF THAT FILE# 
      END #K# 
    IF GETQUICK(DN$LEVEL,DNAT$,LALTKPTR) GR 50
      THEN #KEY IS INVALID DATA ITEM# 
      BEGIN #L# 
                             TRACK$(26,2612); 
      SETFIELD(AX$ALTKEYERR,AUX$,LAUX$PTR,1); #SET KEY ERROR FLAG#
      ERROR$F(MSG75,D$ERROR); 
      SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
      #SEE ABOVE FOR DEFINITION OF MSG 75#
      END #L# 
      ELSE #KEY IS VALID DATA ITEM# 
      BEGIN #M# 
                             TRACK$(26,2613); 
      CHKKEYVAL(LALTKPTR); #CHK KEY VALID#
       IF GETQUICK(DN$SDEPTH,DNAT$,LALTKPTR) GR 1 
         THEN  #KEY RESIDES WITHIN MORE THAN 1 OCCURS GROUP#
        BEGIN 
        ERROR$F(MSG97,D$ERROR); 
        SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
        END 
      IF GETQUICK(FN$RKEYERR,FNAT$,FNAT$PTR) EQ 0 
        THEN #KEY ERROR FLAG NOT SET# 
        BEGIN #N# 
                             TRACK$(26,2614); 
        #CHECK IF ALTKEY STARTS IN SAME POSN AS MAIN KEY# 
        IF GETQUICK(DN$BYTEOFFS,DNAT$,LALTKPTR) EQ LKEYBYTEOFFS 
        AND LINDXKPTR LQ DNAT$PTR  # PRIME KEY MUST BE EMBEDDED FOR CKS#
          THEN #BOTH BYTE OFFSETS ARE THE SAME# 
          BEGIN #O# 
                             TRACK$(26,2615); 
          ERROR$F(MSG77,J$ERROR); 
          IF GETQUICK(DN$ITMLEN,DNAT$,LALTKPTR) EQ LKEYSIZE 
            THEN  #2 KEYS COINCIDE# 
            BEGIN 
            ERROR$F(MSG138,D$ERROR);
            SETFIELD(AX$ALTKEYERR,AUX$,LAUX$PTR,1);  #SET KEY ERR FLAG# 
            SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1);  #ABORT THIS FNAT# 
            #NO 2 KEYS MAY COINCIDE#
            END 
          END #O# 
        END #N# 
      END #M# 
    END 
    LAUX$PTR=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$PTR); #GET NXT IN CHAIN#
                           VALUE$(26,"LAUX$PTR=",LAUX$PTR); 
    END #J# 
    #NOW CHECK THAT WITHIN ALT KEYS NO ALTKEY STARTS
    IN SAME CHARACTER POSITION AS ANOTHER#
    LAUX$PTR=GETQUICK(FN$ALTKPTR,FNAT$,FNAT$PTR); #RESET BACK TO 1ST# 
                           VALUE$(26,"LAUX$PTR=",LAUX$PTR); 
    FOR ZERO = 0 WHILE LAUX$PTR NQ 0 DO 
    BEGIN #P# 
    IF GETQUICK(AX$TTYPE,AUX$,LAUX$PTR) EQ ALTKEYNAME 
    THEN BEGIN
                             TRACK$(26,2616); 
    LALTKPTR=GETQUICK(AX$ALTKEY,AUX$,LAUX$PTR); #GET DNAT OF 1ST KEY# 
                     VALUE$(26,"LALTKPTR=",LALTKPTR); 
    LKEYBYTEOFFS=GETQUICK(DN$BYTEOFFS,DNAT$,LALTKPTR); #GET BYTE OFFSET#
                    VALUE$(26,"LKYBYTOFS=",LKEYBYTEOFFS); 
    LAUX$PTR2=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$PTR); #GET DNAT OF NXT KEY#
                    VALUE$(26,"LAUX$PTR2=",LAUX$PTR2);
      FOR ZERO = 0 WHILE LAUX$PTR2 NQ 0 DO
      BEGIN #Q# 
      IF GETQUICK(AX$TTYPE,AUX$,LAUX$PTR2) EQ ALTKEYNAME
      THEN BEGIN
                             TRACK$(26,2617); 
      LALTKPTR2=GETQUICK(AX$ALTKEY,AUX$,LAUX$PTR2); #DNAT OF NXT KEY# 
                     VALUE$(26,"LALTKPTR2=",LALTKPTR2); 
      IF GETQUICK(DN$BYTEOFFS,DNAT$,LALTKPTR) 
        EQ
        GETQUICK(DN$BYTEOFFS,DNAT$,LALTKPTR2) 
        THEN #BOTH BYTE OFFSETS ARE THE SAME# 
        BEGIN #R# 
                             TRACK$(26,2618); 
          ERROR$F(MSG77,J$ERROR); 
          IF GETQUICK(DN$ITMLEN,DNAT$,LALTKPTR) 
            EQ GETQUICK(DN$ITMLEN,DNAT$,LALTKPTR2)
            THEN  #2 KEYS COINCIDE# 
            BEGIN 
            ERROR$F(MSG138,D$ERROR);
            SETFIELD(AX$ALTKEYERR,AUX$,LAUX$PTR2,1);  #SET KEY ERR FLAG#
            SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1);  #ABORT THIS FNAT# 
            #NO 2 KEYS MAY COINCIDE#
            END 
        END #R# 
      END 
      LAUX$PTR2=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$PTR2); #MV TO NXT ITM# 
                    VALUE$(26,"LAUX$PTR2=",LAUX$PTR2);
      END #Q# 
    END 
    LAUX$PTR=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$PTR); #MOVE FIRST PTR#
                           VALUE$(26,"LAUX$PTR=",LAUX$PTR); 
    END #P# 
    END #F# 
  END #E# 
IF GETQUICK(FN$ORG,FNAT$,FNAT$PTR) EQ WORD$ADDR 
  THEN #ORG IS WORD ADDRESSABLE#
  BEGIN #RA#
                                           TRACK$(26,2675); 
  IF GETQUICK(FN$RELKPTR,FNAT$,FNAT$PTR) NQ 0 
    OR
    GETQUICK(FN$RECPTR,FNAT$,FNAT$PTR) NQ 0 
    THEN #RELATIVE OR RECORD KEY PRESENT# 
    BEGIN 
    ERROR$F(MSG107,D$ERROR);
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #WORD ADDRESS FILES CANNOT HAVE RELATIVE OR RECORD KEYS#
  LWAKPTR=GETQUICK(FN$WAKPTR,FNAT$,FNAT$PTR); 
  IF LWAKPTR EQ 0 
    THEN #NO WORD ADDRESS KEY#
    BEGIN 
    ERROR$F(MSG108,D$ERROR);
    SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
    END 
    #WORD ADDRESS FILES MUST HAVE A WORD ADDRESS KEY# 
    ELSE #WORD ADDRESS KEY PRESENT# 
    BEGIN #RB#
    IF GETQUICK(DN$SDEPTH,DNAT$,LWAKPTR) GR 0 
      THEN #WORD ADDRESS KEY IS SUBSCRIPTED#
      BEGIN 
      ERROR$F(MSG109,D$ERROR);
      SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
      END 
      #WORD ADDRESS KEYS CANNOT BE SUBSCRIPTED# 
      CHKUSINT(LWAKPTR,MSG110); #CHECK KEY IS UNSIGNED INTEGER# 
    END #RB#
  END #RA#
#CHECK PRESENCE OF "RECORD CONTAINS CLAUSE" AND CHECK 
VALIDITY OF MAX AND MIN RECORD LENGTHS# 
IF MIN$REC$LEN NQ MAX$REC$LEN 
  THEN #RECORDS MUST BE IN EFFECT VARIABLE LENGTH#
  BEGIN 
  TRACK$(26,2699);
  SETFIELD(FN$VRECLEN,FNAT$,FNAT$PTR,1); #SET VLEN FLAG#
  END 
IF GETQUICK(FN$VARTYPE,FNAT$,FNAT$PTR) EQ 0 
  AND 
  GETQUICK(FN$VRECLEN,FNAT$,FNAT$PTR) EQ 1 #VARLEN OR VGRP# 
  THEN #VARTYPE NOT YET SET#
  BEGIN #RC#
  IF DEPONCOUNT EQ 0
    THEN #TYPE IS MULTI LEN#
    SETFIELD(FN$VARTYPE,FNAT$,FNAT$PTR,FNML); 
    ELSE #TYPE IS VGRP (SINGLE OR MULTIPLE)#
    IF NUMRECS GR 1 
      THEN #MORE THAN 1 RECORD IN THIS FD#
      BEGIN 
      SETFIELD(FN$VARTYPE,FNAT$,FNAT$PTR,FNVGMS); 
      LRECDPTR=GETQUICK(FN$DNATPTR,FNAT$,FNAT$PTR); 
      LODOOFFSET = 0; 
      LRECLEN = 0;
      FOR LRECNB = 1 STEP 1 UNTIL NUMRECS DO
        BEGIN  # CHECK EACH RECORD FOR ODO WITH SAME FORMAT # 
        LTEMP=0;
        FOR LRECDPTR = LRECDPTR   WHILE LTEMP NQ 1
          DO BEGIN  # FIND A REC DESC ENTRY # 
          LRECDPTR = LRECDPTR + 1;
          LTEMP=GETQUICK(DN$LEVEL,DNAT$,LRECDPTR);
          END 
        IF GETQUICK(DN$TYPE,DNAT$,LRECDPTR) NQ VARGROUP 
        THEN
          GOTO ISVGMS;  # EXIT - NOT VARIABLE GROUP # 
        LTEMP = GETQUICK(DN$ITMLEN,DNAT$,LRECDPTR); 
        IF LRECLEN EQ 0 
        THEN  # FIRST TIME - SAVE CURRENT LEN # 
          LRECLEN = LTEMP;
        ELSE
          IF LRECLEN NQ LTEMP 
          THEN
            GOTO ISVGMS;  # EXIT - LENGTHS NOT SAME # 
        LAUX$PTR=SRCH$AUXT(LRECDPTR,SUBOCCDEP);  #FIND ODO INFO#
        LODOPTR=GETQUICK(AX$OCCNAM,AUX$,LAUX$PTR);  #ODO ITEM#
        LODONMPTR=GETQUICK(AX$DEPNAM,AUX$,LAUX$PTR);  #ODO NAME ITEM# 
        IF GETQUICK(DN$MAJMSEC,DNAT$,LODONMPTR) NQ FDMSEC 
        OR GETQUICK(DN$SUBMSEC,DNAT$,LODONMPTR) NQ FNAT$PTR 
        THEN
          GOTO ISVGMS;  # EXIT - ODO DEP ON ITEM NOT IN FILE REC #
        LTEMP=GETQUICK(DN$BYTEOFFS,DNAT$,LODOPTR);
        IF LODOOFFSET EQ 0
        THEN
          BEGIN 
          LODOOFFSET = LTEMP; 
          LODONMOFFSET = GETQUICK(DN$BYTEOFFS,DNAT$,LODONMPTR); 
          LODONMLEN=GETQUICK(DN$ITMLEN,DNAT$,LODONMPTR);
          LODOOCCLEN=GETQUICK(DN$ITMLEN,DNAT$,LODOPTR); 
          END 
        ELSE
          BEGIN 
          IF LODOOFFSET NQ LTEMP
          OR LODONMOFFSET NQ GETQUICK(DN$BYTEOFFS,DNAT$,LODONMPTR)
          OR LODONMLEN NQ GETQUICK(DN$ITMLEN,DNAT$,LODONMPTR) 
          OR LODOOCCLEN NQ GETQUICK(DN$ITMLEN,DNAT$,LODOPTR)
          THEN
            GOTO ISVGMS;  # EXIT - ALL SPECS NOT SAME # 
          END 
        END 
      SETFIELD(FN$VARTYPE,FNAT$,FNAT$PTR,FNVGSS);  #VAR GRP SINGLE SPEC#
 ISVGMS:   # HERE IF VGMS - MULTIPLE SPECS #
      END 
      ELSE #ONLY 1 RECORD IN THIS FILE# 
    SETFIELD(FN$VARTYPE,FNAT$,FNAT$PTR,FNVGSS); 
  END #RC#
          VALUE$(26,"FN$VT=",GETQUICK(FN$VARTYPE,FNAT$,FNAT$PTR));
IF GETQUICK(DN$RECCONT,DNAT$,FD$PTR) EQ 1 
  THEN #RECORD CONTAINS CLAUSE PRESENT# 
  BEGIN #S# 
    IF GETQUICK(FN$RCTMIN,FNAT$,FNAT$PTR) EQ 0
    THEN  # VARYING PHRASE MIN NOT SPECIFIED, SET TO MIN RECORD SIZE   #
        BEGIN 
        SETFIELD(FN$RCTMIN,FNAT$,FNAT$PTR,MIN$REC$LEN); 
        END 
    IF GETQUICK(FN$RCTMAX,FNAT$,FNAT$PTR) EQ 0
    THEN  # VARYING PHRASE MAX NOT SPECIFIED, SET TO MAX RECORD SIZE   #
        BEGIN 
        SETFIELD(FN$RCTMAX,FNAT$,FNAT$PTR,MAX$REC$LEN); 
        END 
    LRCONTPTR=GETQUICK(FN$RCDEPPTR,FNAT$,FNAT$PTR); 
    IF LRCONTPTR NQ 0 
      THEN #RECORD CONTAINS DEPENDING UPON CLAUSE PRESENT#
      BEGIN #TB#
                                       TRACK$(26,2685); 
      CHKUSINT(LRCONTPTR,MSG111); #CHK UNSIGNED INTEGER#
      IF LRCONTPTR GR FD$PTR
        AND 
        LRCONTPTR LQ DNAT$PTR 
        THEN #DEPENDED UPON ITM IN CURRENT RECORD#
        BEGIN #TC#
                                        TRACK$(26,2690);
        LDNTYPE = GETQUICK(DN$TYPE,DNAT$,LRCONTPTR);
        IF LDNTYPE NQ COMP
          AND LDNTYPE NQ COMP1
          AND LDNTYPE NQ COMP4
          THEN  # ITEM NOT DISPLAY, COMP-1 OR COMP-4 #
          BEGIN 
          ERROR(MSG112,D$ERROR);
          SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
          END 
          #THE ITEM UPON WHICH SIZE DEPENDS MUST BE DISPLAY 
          OR COMP-1#
        IF GETQUICK(DN$NUMLEN,DNAT$,LRCONTPTR) GR 6 
          THEN #ITEM LENGTH LARGER THAN 6#
          BEGIN 
          ERROR(MSG113,D$ERROR);
          SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
          END 
          #THE ITEM UPON WHICH THE SIZE DEPENDS MUST BE 
          6 DIGITS OR LESS# 
        IF GETQUICK(FN$RCTMIN,FNAT$,FNAT$PTR) LS MIN$REC$LEN
          THEN #SET REAL MIN RECORD SIZE TO THAT IN REC CONTAINS# 
          LRMSIZE=GETQUICK(FN$RCTMIN,FNAT$,FNAT$PTR); 
          ELSE #MIN REC FOUND IS SMALLER THAN THAT SPECIFIED# 
          LRMSIZE=MIN$REC$LEN;
        IF (GETQUICK(DN$BYTEOFFS,DNAT$,LRCONTPTR) + 
          GETQUICK(DN$ITMLEN,DNAT$,LRCONTPTR))
          GR LRMSIZE
          THEN #REC SIZE TOO SMALL FOR DEPENDED UPON ITM# 
          BEGIN 
          ERROR(MSG114,D$ERROR);
          SETFIELD(FN$ABORT,FNAT$,FNAT$PTR,1); #ABORT THIS FNAT#
          END 
          #THE ITEM UPON WHICH THE SIZE DEPENDS (IF IT IS WITHIN
          THE RECORD) MUST BE CONTAINED WITHIN THE MINIMUM RECSIZE# 
        END #TC#
      END #TB#
  END #S# 
SETFIELD(FN$ACCUMMAX,FNAT$,FNAT$PTR,MAX$REC$LEN); #UPDT LEN IN FNAT#
SETFIELD(FN$ACCUMMIN,FNAT$,FNAT$PTR,MIN$REC$LEN); 
IF GETQUICK(DN$DATREC,DNAT$,FD$PTR) EQ 1
  THEN #DATA RECORDS CLAUSE PRESENT#
  BEGIN #U# 
                             TRACK$(26,2621); 
  LAUX$PTR=GETQUICK(FN$DRECPTR,FNAT$,FNAT$PTR); #GET 1ST 01#
                           VALUE$(26,"LAUX$PTR=",LAUX$PTR); 
  FOR ZERO = 0 WHILE LAUX$PTR NQ 0 DO 
    BEGIN #V# 
                             TRACK$(26,2622); 
    #CHECK DATA RECORD IS LEVEL 01# 
    LRECDPTR=GETQUICK(AX$DATARCNAM,AUX$,LAUX$PTR); #GET DNAT OF RECD# 
                      VALUE$(26,"LRECDPTR=",LRECDPTR);
    IF GETQUICK(DN$LEVEL,DNAT$,LRECDPTR) NQ 1 
      THEN #ITEM IS NOT DECLARED AT LEVEL 1#
      ERROR(MSG90,T$ERROR); 
      #THE ITEMS NAMED IN A DATA RECORDS CLAUSE MUST BE DEFINED 
      AS LEVEL 1 ENTRIES WITHIN THE ASSOCIATED FILE#
    LAUX$PTR=GETQUICK(AX$TNEXTPTR,AUX$,LAUX$PTR); #GO TO NXT ENT# 
                           VALUE$(26,"LAUX$PTR=",LAUX$PTR); 
    END #V# 
  END #U# 
SUMFILEXIT: 
EXIT$(26,"SUM$FILE"); 
END #AA#
END #DA PART 3# 
TERM
