*DECK QDLSIZE                                                           000170
      PRGM DL30302;                # THIS IS 3,2 OVERLAY               # DL3A030
                                                                         D2A130 
                                                                         D2A130 
      BEGIN                                                              D2A130 
                                                                         D2A130 
      DEF  ACTUAL    #   6#;       # FILE ORGANIZATION IS AK           #
      DEF  COMP      #   2#; # USAGE IS COMPUTATIONAL                  # D2A130 
      DEF  COMP1     #   9#; # USAGE IS COMPUTATIONAL-1                # D2A130 
      DEF  COMP2     #   4#; # USAGE IS COMPUTATIONAL-2                # DL3A043
      DEF  DISPLAY   #   1#; # USAGE IS DISPLAY                        # D2A130 
      DEF  DNTBASE   #FIRSTWORD#;  # FIRST WORD ADDRESS OF DNT         # DL3A052
      DEF  DOWNBOT   #   DDLMEM#;  # LAST WORD ADDRESS OF LOAD         # DL3A052
      DEF  ENDOFAREA #   7#;       # ITEM TYPE IS END OF AREA          #
      DEF  F         #   1#; # RECORD TYPE IS FIXED                    # DL3A051
      DEF  FITLENGTH #  35#;       # LENGTH OF FILE INFORMATION TABLE  #
      DEF  GROUP     #   0#;       # ITEM TYPE IS GROUP ITEM           #
      DEF  INTEGER   #   3#; # USAGE IS INTEGER                        # DL3A043
      DEF  MIXED     #   8#;       # USAGE IS MIXED GROUP              #
      DEF  RECORD    #   0#;       # DATA TYPE IS RECORD               #
      DEF  T         #   5#; # RECORD TYPE IS TRAILER COUNT            # DL3A051
                                                                         D2A130 
      CONTROL NOLIST;              # TURN OFF LISTING OF COMDDIAG      # D2A130 
*CALL COMDDIAG - DIAGNOSTIC MESSAGES                                     D2A130 
                                                                         D2A130 
      CONTROL LIST;                                                      D2A130 
                                                                         D2A130 
       DEF   SAK #6#; 
      DEF  SEQ #0#; 
  
  
      XREF PROC ABRT4;             # ABORT RUN                         #
      XREF PROC DDLPRNT;
      XREF PROC DIAGS;             # DIAGNOSTIC ROUTINE                #
      XREF PROC HASH; 
      XREF PROC QUDRTN2;
      XREF ITEM DDLCOMP;           # DDL COMPILATION MODE              #
      XREF ITEM DDLMEM;            # CM USED BY THIS COMPILATION       #
      XREF ITEM DIAGNOS;           # DIAGNOSTIC NUMBER                 #
      XREF ITEM ENDCOMP;           # FATAL ERROR FLAG                  #
      XREF ITEM ENDDNT; 
      XREF ITEM FIRSTWORD;         # FIRST WORD ADDRESS OF DNT         #
      XREF ITEM HASHTBL;
      XREF ITEM HRSLT;
       BASED ARRAY ENDOFMEMTABL[0]; 
         BEGIN
           ITEM EOMTWORD U(0,0,60); 
           ITEM EOMTYPE  U(0,0,6);
          ITEM EOMTDUP U(0,6,1);
          ITEM EOMTDUPARE U(0,7,2); 
           ITEM EOMTNEXT U(0,36,6); 
           ITEM EOMTDNTPTR  U(0,42,18); 
         END
       BASED ARRAY DATANAMETABL[0]; 
        BEGIN 
          ITEM DNTWORD       U(0,0,60); 
          ITEM DNTSYNLINK   U(0,6,18);
          ITEM DNTNEXT      U(0,24,18); 
          ITEM DNTPRIOR     U(0,42,18); 
             ITEM ARNAMELEN    U(0,0,6)   ; 
             ITEM ARNAME1      C(0,6,9)   ; 
             ITEM ARNAME       C(0,0,10)  ; 
          ITEM ARFITPTR     U(0,42,18); 
             ITEM ARCOLLATE    C(0,0,10)  ; 
             ITEM RDITEMTYPE   U(0,0,3)  ; # HASH LINK DESCRIPTOR#
             ITEM RDDATATYPE   U(0,3,3)  ;
             ITEM RDSYNLINK    U(0,6,18) ;
             ITEM RDDOMPTR     U(0,24,18);
             ITEM RDSAMENAME   U(0,42,18);
             ITEM RDLEVEL      U(0,0,6)  ; #NEXT / PRIOR POINTERS # 
             ITEM RDWORDADJUST U(0,6,1);
          ITEM RDNAMEPTR    U(0,7,8); 
             ITEM RDNEXT       U(0,24,18);
             ITEM RDPRIOR      U(0,42,18);
             ITEM RDOCCURSR    U(0,0,1)  ; # ATTRIBUTES # 
             ITEM RDOCCURS     U(0,1,1)  ;
             ITEM RDPOINTAORV  U(0,2,1)  ;
             ITEM RDPOINTLORR  U(0,3,1)  ;
             ITEM RDPOINTCOUNT U(0,4,5)  ;
             ITEM RDUSAGE      U(0,9,4)  ;
             ITEM RDCLASS      U(0,13,4) ;
           ITEM RDKEYITEM   U(0,17,1);
            ITEM RDRECSIZE   U(0,18,18);         # RECORD USE SIZE     #
            ITEM RDSIZE      U(0,18,12);         # PICTURE SIZE        # D2A164 
            ITEM RDNUMINSRTS U(0,30,6);          # NUMBER OF INSERTS   # D2A164 
           ITEM RD1USESIZE U(0,27,9);                                   000160
           ITEM RD1PICSIZE U(0,18,9);                                   000170
               ITEM RDPICSIZE   U(0,18,7);                              000220
              ITEM RDPICXSIZE U(0,25,6);
              ITEM RDEDPTR  U(0,15,4);
               ITEM RDUSESIZE   U(0,31,5);                              000230
             ITEM RDPOSITION   U(0,36,18);
             ITEM RDBFP        U(0,54,6) ;
             ITEM RDDEPEND     U(0,0,1)  ;  # SUBSCRIPT RANGE # 
             ITEM RDINTEGER3   U(0,1,1)  ;
          ITEM RDALTKEYITM U(0,2,1);
          ITEM RDALTKEYDUP U(0,3,1);
         ITEM RDALTAREDUP U(0,4,1); 
             ITEM RDVALUE3     U(0,6,18) ;
             ITEM RDVALUE4     U(0,24,18);
             ITEM RDDEPOBJECT  U(0,42,18);
         ITEM RDNAME       U(0,0,60); 
             ITEM RDONCALLPROC C(0,0,7);
             ITEM RDONCALLOPTN U(0,58,1); 
             ITEM RDCALLDATAN  U(0,59,1); 
             ITEM RDONCALLDN2  U(0,24,18);
             ITEM RDONCALLDN1  U(0,42,18);
             ITEM RDNAMELENC U(0,19,5);                                 000880
             ITEM RDADJLEN U(0,6,1);   # INDICATES SUBJECT ENTRY NAME  #
                                       # LENGTH IN CHARACTERS IS A MULT#
                                       # ABLE OF TEN.                  #
             ITEM RDSIGN   U(0,30,30);
        END 
       ARRAY AAA [0:49];
                                        BEGIN 
           ITEM POSN  U(0,0,30);
           ITEM AAT U(0,0,60);
           ITEM ACCUM U(0,30,30); 
                                        END 
       ITEM INCR U; 
           ITEM I U,DLVL U; 
      BASED ARRAY FIT[0]  S(FITLENGTH); 
*CALL FITCOM
       BASED ARRAY TABL[0]; 
         BEGIN
           ITEM HASH512 U;
         END
                                                                         DL3A052
      ARRAY [0:2];                 # CONTAINS CURRENT DATA-NAME        # DL3A052
           ITEM TEMP U(0,0,60); 
       ITEM  IX U    ,MX; 
       ITEM KX; 
           ITEM NZ;                                                     001010
       ITEM  LVL; 
       ITEM  PLVL;
       ITEM  SIZE;
       ITEM BSIZE U;
       ITEM DNT U;
           ITEM PRECSIZE;            # PREVIOUS RECORD SIZE            #
      ITEM TFITMNR;                # TEMPORARY MNR #                     DL3A051
            ITEM ADJLEN;                                                000930
          ARRAY ERRBUF [4];                                             000840
            ITEM ERRWORD U(0,0,60) = [O"55554747474747474755"];         000850
          ITEM SAVELEN U;                                               000860
       CONTROL EJECT; 
  
#**********************************************************************#
#                                                                      #
#       E X E C U T A B L E   C O D E   F O R   Q D L S I Z E          #
#                                                                      #
#**********************************************************************#
  
  
      P<DATANAMETABL> = DNTBASE - 1;
      DNT = ENDDNT; 
      LVL = 1;
  
# 
           SET WORD ADJUST BITS 
# 
  
      FOR IX = 1 WHILE IX LS DNT DO 
           BEGIN
           IF RDITEMTYPE[IX] EQ ENDOFAREA 
           THEN IX = IX + 1;                  # NEXT AREA              #
           IF RDDATATYPE[IX] NQ RECORD
              AND RDUSAGE[IX+2] GQ INTEGER    # NON NUMERIC ITEMS      #
              AND RDUSAGE[IX+2] NQ MIXED
           THEN 
             BEGIN
             RDWORDADJUST[IX+1] = 1;
  
#            IF THE PRIOR ITEM IS ALSO THE DOMINATE ITEM               #
#            THEN SET ITS WORD ADJUST BIT.                             #
  
             MX = IX; 
             FOR I = 0
             WHILE RDPRIOR[MX+1] EQ RDDOMPTR[MX]
             DO 
               BEGIN
               MX = MX - RDDOMPTR[MX];
               RDWORDADJUST[MX+1] = 1;
               END
             END
           IX = IX + RDNEXT[IX+1];
           END
      FOR I = 0 STEP 1 UNTIL 49 DO
        AAT[I] = 0; 
           IX=1;
       START: 
           IF IX GQ DNT THEN GOTO RECCHK; 
           IF RDITEMTYPE [IX] EQ 2 THEN GOTO  BUMPIX;    #AREA.NAME#
           IF RDDATATYPE[IX] EQ 5 OR RDDATATYPE[IX] EQ 0
               THEN GOTO  NXTITM; 
       BUMPIX:  
           PRECSIZE = 0;           # RESET RECORD SIZE                 #
                                   # AT THE BEGINNING OF AN AREA       #
           IX=IX+RDNEXT[IX+1];
           IF IX LS DNT THEN GOTO  START; 
           GOTO RECCHK; 
       INITREC: 
           LVL=RDLEVEL[IX+1]; 
       LVLCHK:  
           IF LVL LS PLVL THEN GOTO  LVLLST;
           IF LVL GR PLVL THEN
               POSN[LVL]=POSN[PLVL];
           IF RDITEMTYPE[IX] EQ 0 THEN
               BSIZE=0;     ELSE
      IF RDCLASS[IX+2] LQ 5 AND                  # ALPHA-NUMERIC EDITED# D2A164 
         RDCLASS[IX+2] NQ 4 AND                  # LOGICAL             # D2A164A
         RDCLASS[IX+2] NQ 2                      # NUMERIC             # D2A164 
      THEN BSIZE = RDSIZE[IX+2] - RDNUMINSRTS[IX+2];                     D2A164 
      ELSE IF RDEDPTR[IX+2] NQ 0                                         D2A164 
           THEN BSIZE = RDPICXSIZE[IX+2];                                D2A164 
           ELSE BSIZE = RDPICSIZE[IX+2];                                 D2A164 
           IF RDWORDADJUST[IX+1] EQ 0 THEN        #TEST FOR WORD ADJST# 
               GOTO  NOADJST; 
           IF RDUSAGE[IX+2] EQ 3 OR               #INTEGER# 
              RDUSAGE[IX+2] EQ 6 OR               #LOGICAL# 
              RDUSAGE[IX+2] EQ 4 OR               # COMP-2 SINGLE PREC #
              RDUSAGE[IX+2] EQ 9  THEN  BEGIN     # COMP-1 SINGLE PREC #
                BSIZE=10; 
                GOTO  ADJUST;           END 
           IF RDUSAGE[IX+2] EQ 5 OR               #COMP-1 DOUBLE PREC#
              RDUSAGE[IX+2] EQ 7 THEN   BEGIN     #COMPLEX# 
                BSIZE=20; 
                GOTO ADJUST;            END 
      IF RDWORDADJUST[IX+1] EQ 0
      THEN
           GOTO NOADJST;
  
       ADJUST:                                    #BUMP TO EVEN WRD ADR#
           INCR=POSN[LVL]-(POSN[LVL]/10)*10;
           IF INCR NQ 0 THEN INCR=10-INCR;
           FOR I=1 STEP 1 UNTIL LVL-1 DO
               ACCUM[I]=ACCUM[I]+INCR;
           POSN[LVL]=POSN[LVL]+INCR;
       NOADJST: 
           IF RDOCCURSR[IX+2] NQ 0 THEN           #SIZE TIMES NO OF OCC#
           IF DDLCOMP NQ 7 THEN                                         000210
            BEGIN                                                       000215
             SIZE = BSIZE * RDVALUE4[IX+4];                             000220
            END                                                         000227
            ELSE                                                        000230
               SIZE=BSIZE*RDVALUE4[IX+3]; 
           ELSE SIZE=BSIZE; 
           FOR I=1 STEP 1 UNTIL LVL-1 DO
               ACCUM[I]=ACCUM[I]+SIZE;
           IF LVL EQ PLVL THEN GOTO LVLEQL; 
           MX=IX-RDDOMPTR[IX];
           DLVL=RDLEVEL[MX+1];          #GET DOMINANT LEVEL NO# 
           POSN[LVL]=POSN[DLVL];
           RDPOSITION[IX+2]=POSN[DLVL]/10;
           RDBFP[IX+2]=POSN[DLVL]-(POSN[DLVL]/10)*10; 
           IF RDITEMTYPE[IX] EQ 0 THEN  #TEST FOR GROUP ITEM# 
           GOTO  NXTITM;
                                                                         D2A164 
NOGROUP:                               # ITEM IS ELEMENTARY            # D2A164 
                                                                         D2A164 
      POSN[LVL] = POSN[LVL] + SIZE;                                      D2A164 
      IF RDUSAGE[IX+2] GR 1             # DISPLAY                      # D2A164A
      THEN RDUSESIZE[IX+2] = BSIZE;                                      D2A164 
      GOTO NXTITM;                     # PROCEED TO NEXT ITEM          # D2A164 
                                                                         D2A164 
       LVLEQL:  
           RDPOSITION[IX+2]=POSN[LVL]/10; 
           RDBFP[IX+2]=POSN[LVL]-(POSN[LVL]/10)*10; 
           IF RDITEMTYPE[IX] NQ 0 THEN GOTO NOGROUP;
           ACCUM[LVL]=0;
           GOTO NXTITM; 
       LVLLST:  
           IF PLVL EQ 1 THEN            BEGIN 
               AAT[1]=0;
               AAT[0]=0;
               GOTO  START;             END 
           MX=KX-RDDOMPTR[KX];
           DLVL=RDLEVEL[MX+1];
           FOR I=DLVL+1 STEP 1 UNTIL PLVL DO
               AAT[I]=0;
           SIZE=0;
           IF RDOCCURSR[MX+2] NQ 0 THEN #CHECK FOR OCCURS ON DOMINANT#
                                 BEGIN
               IF RDWORDADJUST[MX+1] NQ 0 THEN
                                           BEGIN
                   INCR=ACCUM[DLVL]-(ACCUM[DLVL]/10)*10;
                   IF INCR NQ 0 THEN INCR=10-INCR;
                   FOR I=1 STEP 1 UNTIL DLVL DO 
                       ACCUM[I]=ACCUM[I]+INCR;
                                           END
           IF DDLCOMP NQ 7 THEN                                         000250
            BEGIN                                                       000255
              SIZE = ACCUM[DLVL] * (RDVALUE4[MX+4] - 1);                000260
            END                                                         000267
            ELSE                                                        000270
               SIZE=ACCUM[DLVL]*(RDVALUE4[MX+3]-1); 
           FOR I=1 STEP 1 UNTIL DLVL DO                                 000350
                   ACCUM[I]=ACCUM[I]+SIZE;
                                 END
      IF RDDATATYPE[MX] EQ 0                     # IF RECORD           #
         OR RDITEMTYPE[MX] EQ 0                  # OR GROUP            #
      THEN RDRECSIZE[MX+2] = ACCUM[DLVL]; 
      ELSE RDSIZE[MX+2] = ACCUM[DLVL];
      IF RDDATATYPE[MX] EQ 0
      THEN BEGIN
           IF PRECSIZE NQ 0        # CHECK RECORD LENGTH WITHIN AREA   #
                AND PRECSIZE NQ RDRECSIZE[MX+2] 
                AND RDNAME[MX+4] NQ "AKEY-FIELD" # CHECK FOR KEY-FIELD #
           THEN BEGIN 
                DIAGNOS = D146;    # RECORD SIZE NOT EQUAL THROUGOUT   #
                                   # THE AREA, LARGEST ONE USED FOR MRL#
                I = MX;            # POINTER TO DNT, TO PICK UP RDNAME #
                NMXPRINT;          # PRINT RECORD NAME                 #
                DIAGS;
                END 
           ELSE PRECSIZE = RDRECSIZE[MX+2];   # STORE CURRENT RDSIZE   #
           END
         POSN[DLVL]=POSN[DLVL]+ACCUM[DLVL]; 
           POSN[LVL] = ACCUM[1];      # BWP FOR CURRENT LEVEL NUMBER   #
           PLVL=DLVL; 
           KX=MX; 
           GOTO  LVLCHK;
       NXTITM:  
           PLVL=LVL;
           KX=IX; 
           IX=IX+RDNEXT[IX+1];
           IF IX LS DNT THEN GOTO  NXT1;
           LVL=0; 
           GOTO  LVLCHK;
       NXT1:  
           IF RDITEMTYPE[IX] EQ 7 THEN IX=IX+1; 
           IF RDITEMTYPE[IX] EQ 2 OR
             RDDATATYPE[IX] EQ 0 THEN 
               BEGIN
                 LVL=0; 
                 GOTO LVLCHK; 
               END
               GOTO   INITREC;
       RECCHK:  
           IX=1;
           SIZE=0;
       CHKREC:  
           IF RDITEMTYPE[IX] EQ 2 THEN       #CHECK FOR AREA# 
             BEGIN
               P<FIT>=LOC(DNTWORD[IX])+8; 
               FITWORD[0] = ARNAME[IX+2];    # SAVE CURRENT AREA NAME  #
           FOR I=0 STEP 1 UNTIL ARNAMELEN[IX+2]-1 DO
               BEGIN                                                     DL3A051
               TEMP[I]=ARNAME[IX+I+2];
               END                                                       DL3A051
               GOTO NXTIX;
             END
           IF RDITEMTYPE[IX] EQ 7 THEN       #CHECK FOR END OF AREA#
             BEGIN
           IF FITMRL[0] EQ 0 THEN 
               FITMRL[0]=SIZE;
           ELSE 
      IF SIZE NQ FITMRL                                                  DL3A052
      THEN BEGIN                                                         DL3A052
          NMPRINT;
                   DIAGNOS = 109; 
                   DIAGS; 
                   FITMRL[0]=SIZE;
           IF FITRT EQ T                                                 DL3A051
              OR FITRT EQ F                                              DL3A051
           THEN FITMNR = SIZE;                                           DL3A051
                 END
           ELSE 
           IF FITMRL[0] GR FITMBL[0]
                AND FITMBL[0] NQ 0
           THEN BEGIN 
                NMPRINT;
                DIAGNOS = D119;  # RECORD SIZE GREATER THAN BLOCK SIZE #
                DIAGS;
                FITMBL[0] = FITMRL[0];
                END 
           IF (FITRT EQ T          # IF RT NOT TRAILER                 # DL3A051
               OR FITRT EQ F)      # OR NOT FIXED                      # DL3A051
              AND FITMNR EQ 0      # AND MNR NOT SPECIFIED             # DL3A051
           THEN FITMNR = SIZE;                                           DL3A051
  
           SIZE=0;
           IX=IX+1; 
           GOTO CHKREC; 
             END
      IF RDDATATYPE[IX] EQ 0           # RECORD                        #
         AND RDRECSIZE[IX+2] GR SIZE
      THEN SIZE = RDRECSIZE[IX+2];
  
       NXTIX: 
           IX=IX+RDNEXT[IX+1];
           IF IX LQ DNT THEN GOTO CHKREC; 
          GOTO DLEOMT;
          PROC NMPRINT; 
           BEGIN
           SAVELEN = B<0,6> TEMP[0];
           B<0,6> TEMP[0] = O"55";
         FOR I=0 STEP 1 UNTIL SAVELEN - 1 DO                            000150
           ERRWORD[I+1] = TEMP[I];                                      000160
         SAVELEN = (SAVELEN + 1) * 10;                                  000170
         DDLPRNT(ERRBUF,SAVELEN);                                       000180
           B<0,6> TEMP[0] = B<54,6> SAVELEN;
           END
       PROC NMXPRINT;                                                   000380
         BEGIN                                                          000390
           ITEM J;                                                      000400
           SAVELEN = B<0,6>DNTWORD[I+4];                                000410
           FOR J=0 STEP 1 UNTIL SAVELEN - 1 DO                          000420
             ERRWORD[J+1] = DNTWORD[I+J+4];                             000430
           B<0,6>ERRWORD[1] = O"55";                                    000440
           SAVELEN = (SAVELEN+1) * 10;                                  000450
           DDLPRNT(ERRBUF,SAVELEN);                                     000460
          END                                                           000470
          DLEOMT: 
           DEF  DCHARCOUNT  #4#;                                        002080
       ITEM  IZ,JZ,KZ;
       ITEM MZ; 
          ITEM LZ;
       P<TABL>=LOC(HASHTBL);
       P<DATANAMETABL>=DNTBASE-1; 
       P<ENDOFMEMTABL>=DOWNBOT; 
           IZ=0;
       EOMTSTRT:  
      IF EOMTYPE[IZ] EQ 0              # EOMTYPE IS EMPTY, ALL DONE    #
      THEN BEGIN
           IF ENDCOMP NQ 0
           THEN ABRT4;                 # ABORTS ON E-TYPE ERROR        #
           QUDRTN2;                    # LOAD AND EXECUTE QDLBLD2      #
           END
                                                                         D2A130 
      FOR I = 0 STEP 1 UNTIL 2 DO                                        DL3A052
              TEMP[I] = 0;                                              000690
           FOR I=0 STEP 1 UNTIL EOMTYPE[IZ-1]-1 DO
               TEMP[I]=EOMTWORD[IZ-1-I];
           JZ=EOMTDNTPTR[IZ]; 
           HASH(LOC(TEMP[0]));
           KZ=HASH512[HRSLT]; 
           LZ=JZ; 
           DIAGNOS=178; 
           IF KZ EQ 0 THEN GOTO NOSUCH; 
       NXTSYN:  
           MZ=KZ+RDNAMEPTR[KZ+1]; 
           IX = B<0,6>TEMP[0] - 1;
           FOR I=0 STEP 1 UNTIL IX DO 
           IF RDNAME[MZ+I] NQ TEMP[I] THEN
             BEGIN
               IF RDSYNLINK[KZ] EQ 0 THEN GOTO NOSUCH;
               KZ=RDSYNLINK[KZ];
               GOTO NXTSYN; 
             END
      IF RDDATATYPE[KZ] EQ 0 THEN #KEY IS RECORD NAME OR DEPENDING     #
                                  #ON ITEM                             #
         GOTO NOSUCH; 
           IF EOMTYPE[IZ]  EQ  O"15" THEN GOTO  RECCONT;
           IF EOMTYPE[IZ]  EQ  O"3"  THEN GOTO  DEPON;
           IF EOMTYPE[IZ]  EQ  O"13" THEN GOTO  LOCKEY; 
      IF EOMTYPE[IZ] EQ O"14" THEN GOTO LOCKEY; 
       BUMPIZ:  
           IF EOMTNEXT[IZ] EQ 0 THEN RETURN;
           IZ=IZ-EOMTNEXT[IZ];
           GOTO  EOMTSTRT;
       RECCONT: 
           P<FIT>=LOC(DNTWORD[JZ])+8; 
           LZ=RDDOMPTR[JZ];                      #GET NEXT AREA LOC#
       REC1:  
           IF KZ LQ JZ OR KZ GQ LZ THEN          #TEST FOR WITHIN AREA# 
             BEGIN
               DIAGNOS=179; 
               IF RDSAMENAME[KZ] EQ 0 THEN GOTO NOSUCH; 
               KZ=RDSAMENAME[KZ]; 
               GOTO REC1; 
             END
           FITLL[0]=RDUSESIZE[KZ+2];
           FITLP[0]=RDPOSITION[KZ+2]*10+RDBFP[KZ+2];
           GOTO  BUMPIZ;
       DEPON: 
           LZ=LZ-RDDOMPTR[LZ];                 #FIND AREA DESCR#
           IF RDITEMTYPE[LZ] NQ 2 THEN
           BEGIN                                                        000910
             IF RDDATATYPE[LZ] EQ 0 THEN                                000920
               BEGIN                                                    000930
                 NZ = LZ;                                               000940
               END                                                      000950
              GOTO DEPON;                                               000960
           END                                                          000970
           P<FIT>=LOC(DNTWORD[LZ])+8; 
       DEP1:  
           IF KZ GQ JZ OR KZ LQ NZ THEN                                 000990
             BEGIN
               DIAGNOS=177; 
               IF RDSAMENAME[KZ] EQ 0 THEN GOTO NOSUCH; 
               KZ=RDSAMENAME[KZ]; 
               GOTO DEP1; 
             END
           ADJLEN = 0;                                                  000855
           FOR I = KZ STEP RDNEXT[I+1] UNTIL JZ - RDPRIOR[JZ+1] DO      000860
               ADJLEN = ADJLEN + RDADJLEN[I+3];                         000880
            RDDEPOBJECT[JZ+4] = JZ - (KZ+ADJLEN);                       000910
           RDDEPOBJECT[JZ+3] = KZ - (LZ+RDNEXT[LZ+1]);                  000360
           IF FITTL[0] NQ 0 THEN
            BEGIN 
             IF RDUSAGE[JZ+2] GR 1 THEN 
               BEGIN
              IF RDUSESIZE[JZ+2] NQ FITTL[0] * RDVALUE4[JZ+4] THEN      000120
                   BEGIN
              I = JZ + 1;                                               000490
              NMXPRINT;                                                 000500
              DIAGNOS = 194;                                            000510
                     DIAGS; 
                   END
                END 
               ELSE 
                BEGIN 
          IF RDRECSIZE[JZ+2] NQ FITTL[0] * RDVALUE4[JZ+4] 
          THEN BEGIN
              I = JZ + 1;                                               000310
              NMXPRINT;                                                 000320
              DIAGNOS = 194;                                            000330
                      DIAGS;
                    END 
                END 
              IF FITHL[0] NQ RDPOSITION[JZ+2]*10+RDBFP[JZ+2] THEN 
                BEGIN 
              I = JZ + 1;                                               000560
              NMXPRINT;                                                 000565
              DIAGNOS = 195;                                            000570
                  DIAGS;
                 END
           I = RDPOSITION[KZ+2] * 10 + RDBFP[KZ+2]; # LEFT JUSTIFIED CP#
           IF (NOT FITC1[0]        # IF USAGE NOT COMP-1               #
                AND FITCP[0] NQ I)
              OR (FITC1[0]         # IS USAGE IS COMP-1                #
                AND FITCP[0] NQ I + RDUSESIZE[KZ+2] - FITCL[0]) 
                                   # RIGHT JUSTIFIED CHAR POSITION     #
           THEN 
           IF  FITCP[0] NQ I       # IF CHAR POS IS LEFT JUSTIFIED     #
           THEN BEGIN 
              I = KZ;                                                   000590
              NMXPRINT;                                                 000595
              DIAGNOS = 193;                                            000600
                  DIAGS;
                END 
              IF RDUSAGE[KZ+2] GR 1 THEN
                BEGIN 
           IF  FITCL[0] NQ RDPICXSIZE[KZ+2]  # IF CL NQ (NO INSERT) PIC#
           THEN 
                    BEGIN 
              I = KZ;                                                   000620
              NMXPRINT;                                                 000630
              DIAGNOS = 192;                                            000640
                      DIAGS;
                    END 
                   END
                       ELSE 
                      IF FITCL[0] NQ RDSIZE[KZ+2] THEN
                        BEGIN 
              I = KZ;                                                   000660
              NMXPRINT;                                                 000670
              DIAGNOS = 192;                                            000680
                          DIAGS;
                        END 
            END 
             ELSE 
              BEGIN 
                FITHL[0] = RDPOSITION[JZ+2]*10+RDBFP[JZ+2]; 
          IF RDITEMTYPE[JZ] EQ 0 THEN                                   000120
            BEGIN                                                       000130
          FITTL[0] = RDRECSIZE[JZ+2] / RDVALUE4[JZ+4];
              GOTO SETTL;                                               000150
            END                                                         000155
                IF RDUSAGE[JZ+2] GR 1 THEN
                  BEGIN 
                    FITTL[0] = RDUSESIZE[JZ+2]; 
                  END 
                ELSE
                  BEGIN 
                    FITTL[0] = RDSIZE[JZ+2];
                  END 
                                                                         D2A130 
SETTL:                             # SET TRAILER INFO                  # D2A130 
                                                                         D2A130 
           IF  RDUSAGE[KZ+2] EQ DISPLAY OR                               D2A130 
               RDUSAGE[KZ+2] EQ COMP1 OR                                 D2A130 
               RDUSAGE[KZ+2] EQ COMP                                     D2A130 
           THEN BEGIN                                                    D2A130 
                IF  RDUSAGE[KZ+2] EQ DISPLAY                             D2A130 
                THEN BEGIN
                     IF RDITEMTYPE[KZ] EQ 0 
                     THEN FITCL[0] = RDRECSIZE[KZ+2]; 
                     ELSE FITCL[0] = RDSIZE[KZ+2];
                     END
                ELSE FITCL[0] = RDUSESIZE[KZ+2];                         D2A130 
                IF  RDUSAGE[KZ+2] EQ COMP                                D2A130 
                THEN FITSB[0] = RDSIGN[KZ+3] NQ 0;                       D2A130 
                FITCP[0] = RDPOSITION[KZ+2] *10 + RDBFP[KZ+2];           D2A130A
                IF  RDUSAGE[KZ+2] EQ COMP1                               D2A130 
                THEN BEGIN                                               D2A130 
                     FITCL[0] = RDPICXSIZE[KZ+2];   # DEFINED PIC SIZE #
                     FITC1[0] = TRUE;                                    D2A130 
                     FITCP[0] = FITCP[0] + RDUSESIZE[KZ+2] - FITCL[0];
                                   # RIGHT JUSTIFIED CHAR POSITION     #
                     END                                                 D2A130 
                IF  FITCL[0] LS 1 OR FITCL[0] GR 6                       D2A130 
                THEN BEGIN                                               D2A130 
                     NMPRINT;      # PRINT DATA NAME                   # D2A130 
                     DIAGNOS = D135;   # DATA NAME HAS WRONG SIZE      # D2A130 
                     DIAGS;                                              D2A130 
                     END                                                 D2A130 
                END                                                      D2A130 
           ELSE BEGIN                                                    D2A130 
                NMPRINT;           # PRINT DATA NAME                   # D2A130 
                DIAGNOS = D139;    # DATA-NAME HAS WRONG USAGE         # D2A130 
                DIAGS;                                                   D2A130 
                END                                                      D2A130 
           END                                                           D2A130 
                                                                         D2A130 
          IF FITRT[0] EQ DCHARCOUNT THEN                                002020
            BEGIN                                                       002030
              NMPRINT;                                                  000700
              DIAGNOS =189;                                             002040
              DIAGS;                                                    002050
            END                                                         002060
          GOTO BUMPIZ;
       LOCKEY:  
           P<FIT>=LOC(DNTWORD[JZ])+8; 
           LZ=RDDOMPTR[JZ];                      #GET NEXT AREA LOC#
       LOC1:  
           IF KZ LQ JZ OR KZ GQ LZ THEN          #TEST FOR WITHIN AREA# 
             BEGIN
               DIAGNOS=180; 
               IF RDSAMENAME[KZ] EQ 0 THEN GOTO NOSUCH; 
               KZ=RDSAMENAME[KZ]; 
               GOTO LOC1; 
               END                                                      000720
      IF EOMTYPE [IZ] EQ O"13"
        THEN
        BEGIN 
      IF FITFO [0] EQ SEQ 
        THEN FITKA [0] = 0; 
      ELSE
        BEGIN 
          IF FITFO [0] EQ SAK   THEN
            BEGIN            # DIAGNOSE NON-INTEGER KEY FOR AK FILE    #
            IF RDUSAGE [KZ + 2] NQ 3  THEN
              BEGIN 
              NMPRINT;
              DIAGNOS = 201;
              DIAGS;
              END 
            END 
          IF FITKL[0] NQ 0 THEN 
            BEGIN 
              IF RDUSAGE[KZ+2] GR 1 THEN
                BEGIN 
                  IF FITKL[0] NQ RDUSESIZE[KZ+2] THEN 
                  BEGIN                                                 000740
                    NMPRINT;                                            000750
                    DIAGNOS = 196;
                    DIAGS;
                  END 
                END 
              ELSE
                IF FITKL[0] NQ RDSIZE[KZ+2] THEN
                  BEGIN 
                    NMPRINT;                                            000770
                    DIAGNOS = 196;
                    DIAGS;
                  END 
            IF FITRKP[0] NQ RDBFP[KZ+2] THEN
              BEGIN 
                    NMPRINT;                                            000790
                DIAGNOS = 197;
                DIAGS;
              END 
            IF  FITRKW[0] NQ RDPOSITION[KZ+2] THEN
              BEGIN 
                    NMPRINT;                                            000810
                DIAGNOS = 198;
                DIAGS;
              END 
             END
           IF RDITEMTYPE[KZ] EQ 0           # IF GROUP ITEM            #
           THEN FITKL = RDRECSIZE[KZ+2];
           ELSE BEGIN 
                IF  RDUSAGE[KZ+2] GR DISPLAY                             DL3A043
                THEN FITKL[0] = RDUSESIZE[KZ+2];      # KEY LENGTH     # DL3A043
                ELSE FITKL[0] = RDSIZE[KZ+2];                            DL3A043
                IF  FITFO[0] EQ ACTUAL           # ACTUAL ORGANIZATION #
                THEN BEGIN                                               DL3A043
                     FITKL[0] = 6 * RDPICXSIZE[KZ+2]; # SIZE IN BITS   # DL3A043
                     IF  FITKL[0] EQ 0 OR   # PIC SIZE NOT SPECIFIED   # DL3A043
                         FITKL[0] GR 48     # PIC SIZE TOO BIG         # DL3A043
                     THEN FITKL[0] = 48;    # DEFAULTS TO 48 BITS      # DL3A043
                IF  FITORG[0]                    # ACTUAL NEW          #
                THEN BEGIN
                     FITKL[0] = FITKL[0] / 6;    # SET KL IN CHAR      #
                     FITKP[0] = 10 - FITKL[0];   # SET KEY POSITION    #
                     FITRKP[0] = FITKP[0];  # SET THE RKP=KP FOR AK NEW#
                     END
                     END                                                 DL3A043
                END 
                FITMKL[0] = 0;                   # NO MAJOR KEY LENGTH # DL3A043
                IF  NOT(FITFO[0] EQ ACTUAL AND FITORG[0]) 
                                            # DO NOT SET RKP FOR AK NEW#
                THEN FITRKP[0] = RDBFP[KZ+2]; 
                FITRKW[0] = RDPOSITION[KZ+2];    # BWP                 # DL3A043
                FITKA[0] = 0;                    # NO KEY ADDRESS      # DL3A043
                IF  RDUSAGE[KZ+2] EQ INTEGER                             DL3A043
                    OR RDUSAGE[KZ+2] EQ COMP1                            DL3A043
                    OR RDUSAGE[KZ+2] EQ COMP2                            DL3A043
                THEN FITKT = 2;                  # INTEGER KEY         # DL3A043
                ELSE FITKT = 1;                  # SYMBOLIC KEY        # DL3A043
        END 
        END 
                                                                        000170
        #      THIS ROUTINE SERCHES ALL OF THE KEY ITEMS WITIIN       # 000180
        #      AN AREA HAVING POSSIBLY MORE THAN ONE RECORD           # 000190
    #          DESCRIPTION WITH THE SAME NAME                   #       000200
    #          IT TERMINATES THE SEARCH WHEN EITHER IT IS AT    #       000210
    #          THE END OF THE SAME NAME CHAIN OR WHEN IT IS      #      000220
         #     PAST THE END OF THE AREA                    #            000230
                                                                        000240
         SETKEYFLAG:                                                    000250
      IF EOMTYPE[IZ] EQ O"13" THEN
        BEGIN 
        RDKEYITEM[KZ+2] = 1;
        RDALTKEYDUP[KZ+3] = 0;     #ASSURE ALT-DUP/MAJ-KEY FLAG CLEAR. #
        END 
       ELSE 
        BEGIN 
          RDALTKEYITM[KZ+3] = 1;
          RDALTKEYDUP[KZ+3] = EOMTDUP[IZ];
          RDALTAREDUP[KZ+3] = EOMTDUPARE[IZ]; 
          IF FITDKI[0] THEN 
            BEGIN 
              DIAGNOS = 170;
              DIAGS;
            END 
          IF FITFO [0] EQ SEQ  THEN 
            BEGIN            # DIAGNOSE SEQNTL FILE WITH ALTERN KEY    #
            NMPRINT;
            DIAGNOS = 200;
            DIAGS;
            END 
        END 
      SIZE = 0;                                                          DL3A051
      IF FITRT NQ T                                                      DL3A051
         AND FITRT NQ F                                                  DL3A051
      THEN BEGIN                                                         DL3A051
           IF RDCLASS [KZ+2] EQ 2                                        DL3A051
           THEN SIZE = RDUSESIZE[KZ+2];                                  DL3A051
           ELSE BEGIN 
                IF RDITEMTYPE[KZ] EQ 0
                THEN SIZE = RDRECSIZE[KZ+2];
                ELSE SIZE = RDSIZE[KZ+2]; 
                END 
           IF RDOCCURS[KZ+2] EQ 1                                        DL3A051
           THEN SIZE = SIZE * RDVALUE4[KZ+4];                            DL3A051
           IF RDOCCURS[KZ+2] EQ 1                                        DL3A051
           THEN BEGIN                                                    DL3A051
                I = KZ - RDDOMPTR[KZ];                                   DL3A051
                SIZE = RDSIZE[I+2];                                      DL3A051
                END                                                      DL3A051
           TFITMNR = RDPOSITION[KZ+2] * 10 + RDBFP[KZ+2] + SIZE;         DL3A051
           IF FITMNR LS TFITMNR                                          DL3A051
              AND FITMNR NQ 0                                            DL3A051
           THEN BEGIN                                                    DL3A051
                DIAGNOS = D037;                                          DL3A051
                TEMP[0] = FITWORD[0];       # CURRENT AREA NAME        #
                NMPRINT;                                                 DL3A051
                DIAGS;                                                   DL3A051
                FITMNR = TFITMNR;                                        DL3A051
                END                                                      DL3A051
           END                                                           DL3A051
      MAJORKEY;              #CHECK FOR MAJOR KEYS SUBORD TO THIS KEY. #
             IF RDSAMENAME[KZ] EQ 0 THEN                                000270
               GOTO BUMPIZ;                                             000280
             KZ = RDSAMENAME[KZ];                                       000290
             IF KZ LQ JZ OR KZ GQ LZ THEN                               000300
             GOTO BUMPIZ;                                               000310
             GOTO SETKEYFLAG;                                           000320
       NOSUCH:  
          NMPRINT;
           DIAGS; 
           GOTO BUMPIZ; 
                                                                         DL3A052
      CONTROL EJECT;                                                     DL3A052
                                                                         DL3A052
                                                                         DL3A052
      PROC MAJORKEY;
      BEGIN 
#  SCANS DNT ENTRIES, BEGINNING AT THE KEY ITEM JUST IDENTIFIED, AND   #
#  FLAGS MAJOR KEYS.                                                   #
#  AN ITEM IS CONSIDERED TO BE A MAJOR KEY IF                          #
#      1)  IT IS IMMEDIATELY SUBORDINATE TO A KEY ITEM (I.E. HAS HIGHER#
#          LEVEL NUMBER AND THERE IS NO INTERVENING ITEM WITH THIS OR  #
#          HIGHER LEVEL NUMBER.                                        #
#      2)  ITS SIZE IS LESS THAN THAT OF THE KEY ITEM                  #
#      3)  IT IS NOT A -FILLER- ITEM.                                  #
#  THE DNT FLAG RDALTKEYDUP = 1 NOW INDICATES DUPLICATES OPTION ON     #
#  ALTERNATE KEYS IF RDALTKEYITM = 1, AND INDICATES MAJOR KEY IF       #
#  RDALTKEYITM = 0.                                                    #
  
      ITEM II;               #LOOP VARIABLE.  SCRATCH.# 
      ITEM ITEMSIZE;         #SIZE OF CURRENT ITEM. # 
      ITEM KEYSIZE;          #SIZE OF KEY ITEM. # 
      ITEM KZI;              #LOCAL SUBSCRIPT. #
      ITEM LEVEL;            #FOR LEVEL NUMBER OF ITEMS. #
  
      LEVEL = RDLEVEL[KZ+1]; #LEVEL NBR OF THE KEY ITEM. #
      KZI = KZ + RDNEXT[KZ+1];     #SUBSCRIPT FOR FIRST ENTRY AFTER KEY#
      IF RDCLASS[KZ+2] EQ 2                                              DL3A052
      THEN KEYSIZE = RDUSESIZE[KZ+2];                                    DL3A052
      ELSE BEGIN
           IF RDITEMTYPE[KZ] EQ 0 
           THEN KEYSIZE = RDRECSIZE[KZ+2];
           ELSE KEYSIZE = RDSIZE[KZ+2] - RDNUMINSRTS[KZ+2]; 
           END
      FOR II = 0 WHILE (RDITEMTYPE[KZI] EQ 0     # GROUP ITEM          # DL3A052
                        OR RDITEMTYPE[KZI] EQ 1) # ELEMENTARY ITEM     # DL3A052
                       AND RDDATATYPE[KZI] EQ 1  # NOT A FILLER ITEM   # DL3A052
                       AND RDLEVEL[KZI+1] GR LEVEL  # HIGHER LEVEL     # DL3A052
                       AND KZI LS ENDDNT  DO     # STILL IN THE DNT    # DL3A052
          BEGIN                                                          DL3A052
          LEVEL = RDLEVEL[KZI+1];      # LEVEL OF CURRENT ITEM         # DL3A052
          IF RDUSAGE[KZI+2] EQ 2                                         DL3A052
          THEN ITEMSIZE = RDUSESIZE[KZI+2];                              DL3A052
          ELSE BEGIN
                IF RDITEMTYPE[KZI] EQ 0 
                THEN ITEMSIZE = RDRECSIZE[KZI+2]; 
                ELSE ITEMSIZE = RDSIZE[KZI+2] - RDNUMINSRTS[KZI+2]; 
                END 
          IF ITEMSIZE LQ KEYSIZE
          THEN RDALTKEYDUP[KZI+3] = 1;           # MAJOR KEY           # DL3A052
          KZI = KZI + RDNEXT[KZI+1];             # NEXT ITEM           # DL3A052
          END                                                            DL3A052
      RETURN; 
  
      END #OF PROC MAJORKEY. #
       END
       TERM;
