*DECK CBSTBCK 
USETEXT TSBP2CM 
      PROC CBSTBCK((SSITMADD)); 
      BEGIN 
#**********************************************************************#
#                                                                      #
# THIS PROC IS CALLED BY CBCKREC TO SET MAPPING BLOCKS IN COBOL SUB-   #
#SCHEMA IN ORDER TO IMPROVE CDCS RECORD MAPPING PERFORMANCE.           #
#        ENTRY CONDITION: SSITMADD IS THE FIRST SUBSCHEMA ITEM ENTRY   #
#IN THE RECORD.                                                        #
#        EXIT CONDITION: MAPPING BLOCKS HAVE BEEN SET IN THE RECORD    #
#        DESCRIPTION: THE ALGORITHSM IS TO IDENTIFY SOME ITEMS IN      #
#SUBSCHEMA THAT HAVE THE CORRESPONDING EXISTENCE OF ITEMS IN SCHEMA AND#
#CAN TRANSFER THEM AS A BLOCK DURING CDCS RECORD MAPPING.              #
# THE TABLE IITAB IS BUILT WHEN EXAMIMMING EACH SUBSCHEMA ITEM IN THE  #
#RECORD  WITH THE SCHEMA ITEM TO SEE WHETHER SUBSCHEMA ITEM IS         #
#BELONGING TO THE CURRENT BLOCK OR NOT, IF NOT, EXAMINE EACH ENTRY     #
#ALREADY SET IN IITAB AND                                              #
#RESET IITAB AND START TO BUILD IITAB AGAIN. IF THE SS ITEM CAN BE     #
#GROUPED INTO THE EXISTING BLOCK, EITHER BUILD A NEW ENTRY IN IITAB OR #
#ADD THE SIZE OF THE SS ITEM TO THE LAST ENTRY IN IITAB AND UPDATE THE #
#NECESSARY ENTRIES IN IITAB.                                           #
# SINCE A MAXIMUM OF 3 DIMENSIONS IS ALLOWED IN COBOL SUBSCHEMA, 7     #
#ENTRIES WITH 2 WORDS PER ENTRY ARE ENOUGH FOR IITAB. THE LEVELS IN    #
#IITAB ARE ALWAYS IN INCREASE ORDER.                                   #
# WHEN  EOR HAS REACHED FOR SS ITEM,COMBINE THE FIRST TWO ENTRIES IN   #
#IITAB IF THEY HAVE THE SAME LEVEL NUMBERS THEN CALL SETBLOCK TO SET   #
#THE LAST BLOCK IN RECORD. THE CONTROL IS THEN RETURNED TO THE CALLING #
#PROC CBCKREC.                                                         #
#                                                                      #
#**********************************************************************#
      DEF LVL66 #62#; 
      DEF LVL88 #64#; 
      XREF PROC SNATCHO;
      XREF FUNC CBSCITM;     #RETURN SC ITM ADD WHEN GIVING SS ITM ADD #
      ITEM SSITMADD;         #SS ITM ENTRY IN RECORD                   #
      ITEM SCITMADD;         #SC ITM ENTRY IN RECORD                   #
      ITEM IITINDX;          #INDEX FOR ARRAY IITAB                    #
      ITEM SCCURTSZ;         #CURRENT SC ITEM SIZE                     #
      ITEM SSCURTSZ;         #CURRENT SS ITEM SIZE                     #
      ITEM SCLITMEP;         #LAST SC ITEM ENDING POSITION             #
      ITEM SSLITMEP;         #LAST SS ITEM ENDING POSITION             #
      ITEM SCITMNXT B;       #SET, GET NEXT SC ITM THRU SC NEXT POINTER#
                             #NOT SET, CALL CBSCITM                    #
      ITEM ENDOFRECORD B;    #END OF RECORD INDICATOR                  #
      ITEM SSITMSIZE;        #SS ITEM SIZE ACTUALLY OCCUPYING SPACE    #
      ITEM LVLINDX;          #ARRAY INDEX                              #
      ITEM I; 
      ITEM J; 
      ITEM K; 
      ITEM L; 
      ITEM M; 
      ITEM N; 
      ITEM II;
      ITEM SPFLAG B;         #TRUE MEANS CHECK OR DB PROC EXISTS.      #
      ITEM SCITMADDR;        #TEMP CELL FOR SCHEMA ITEM ADDRESS.       #
      ARRAY LEVELOCC[1:3];
        ITEM LVLOC U(0,0,60);#LEVELS FOR OCCURENCE ITEMS               #
      ARRAY TYPEARRAY [0:7];
        BEGIN 
        ITEM VECTOR B(0,0,1) = [0,0,0,0,1,1,0,1];  #TYPE =  4, 5, OR 7.#
        ITEM REPTGRP B(0,59,1) = [0,0,1,1,0,0,1,0];  #TYPE = 2, 3, 6.  #
        END 
      ARRAY IITAB[0:6]S(2); 
        BEGIN 
        ITEM IITLEVEL U(0,0,6);     #SS ITEM LEVEL                     #
        ITEM IITSSADR U(0,6,18);    #SS ITEM WORD ADDRESS              #
        ITEM IITSCADR U(0,24,18);   #SC ITEM ADDRESS, REL TO RECORD    #
        ITEM IITOCC U(0,42,18);     #NBR OF SS ITEM OCCURENCE          #
        ITEM IITSIZE U(1,0,18);     #SS ITEM OCCUPPING SIZE            #
        ITEM IITACCSIZE U(1,18,18); #BLOCK SIZE                        #
        ITEM IITSSITMADD U(1,36,18);#BEGINNING BLOCK ENTRY             #
        ITEM IITWD0 U(0,0,60);
        ITEM IITWD1 U(1,0,60);
        END 
  
  
# PROGRAM STARTS HERE                                                  #
  
  
# PRESET IITAB AND CELLS                                               #
      FOR I=0 STEP 1 UNTIL 6 DO 
        BEGIN 
        IITWD0[I]=0;
        IITWD1[I]=0;
        IF I GR 0 AND I LS 4 THEN LVLOC[I]=0; 
        END 
      SCITMNXT=FALSE; 
      ENDOFRECORD=FALSE;
      IITINDX=0;
      SCLITMEP=0; 
      SSLITMEP=0; 
      LVLINDX=0;
      FOR M=0 WHILE NOT ENDOFRECORD DO
        BEGIN 
        IF SBITMNEWGRP[SSITMADD] THEN #SS ITEM IS NEW GROUP            #
          BEGIN 
          SSNEWGRP; 
          TEST; 
  
          END 
        SCITMADDR = SBITMSCPTR[SSITMADD];  # STORE SCHEMA ADDRESS.     #
        IF SCITMADDR LQ 0 THEN
          SPFLAG = FALSE;    #NO SCHEMA ITEM EXISTS. #
        ELSE
          SPFLAG = SCITEMDBPFLG[SCITMADDR]; # DBP FLAG FROM SCHEMA     #
        IF NOT SBITMIDNTICL[SSITMADD]  #ITEMS NOT IDENTICAL REPRESENT. #
          OR SPFLAG THEN     #CHECK OR DB PROC SPECIFIED.  #
          BEGIN                            #SET                        #
  
            IF SBITMNEXTP[SSITMADD] EQ 0
            THEN
              BEGIN 
              ENDOFRECORD = TRUE; 
              SBEOR;         #END OF RECORD REACHED, SET THE LAST BLOCK#
              TEST; 
  
              END 
            IF SBITMRNRDPTR[SSITMADD] NQ 0 THEN #REDEFINES OR RENAMES  #
              BEGIN 
              IF SBITMLEVEL[SSITMADD] NQ LVL66 THEN 
                SKPREDF;     #SKIP HIGHER LEVEL OF REDEFINES ITEMS     #
              ELSE
                SSITMADD=SSITMADD+SBITMNEXTP[SSITMADD]; 
                             #GET NEXT SS ITEM                         #
              END 
            ELSE
              BEGIN 
              IF SBITMLEVEL[SSITMADD] NQ LVL88 THEN 
                BEGIN 
                IF SBITMLEVEL[SSITMADD] LS IITLEVEL[IITINDX] THEN 
                  COMBNTB;   #COMBINE ENTIES IN IITAB                  #
                SETBLOCK;    #SET POSSIBLE BLOCK FROM IITAB            #
                IF REPTGRP[SBITMTYPE[SSITMADD]] THEN #SS ITEM REPEATING#
                  BEGIN                              #GROUP            #
                  LVLINDX=LVLINDX+1; #ADVANCE INDEX                    #
                  LVLOC[LVLINDX]=SBITMLEVEL[SSITMADD]; #STORE LEVEL FOR#
                  END        #OUTSTANDING OCCURS                       #
                END 
              SSITMADD=SSITMADD+SBITMNEXTP[SSITMADD]; 
              END 
          END 
        ELSE
          BEGIN 
          GTSCITM;           #GET SC ITEM ENTRY                        #
          IF SBITMLEVEL[SSITMADD] LS IITLEVEL[IITINDX] THEN 
            COMBNTB;         #COMBINE ENTRIES IN IITAB                 #
          SCITMNXT=TRUE;
          IF SBITMALIASLW[SSITMADD] NQ 0 THEN 
# COMPARE ALIAS NAME WITH SC NAME                                      #
            BEGIN 
            IF C<0,SBITMALIASLW[SSITMADD]*10>SBITMALIAS30 
        [SSITMADD+SBITMALIASP[SSITMADD]] NQ 
        C<0,SCITMNAMLENW[SCITMADD]*10>SCITMNAM30
          [SCITMADD+SCITMNAMEPTR[SCITMADD]] THEN
              BEGIN 
              SETBLOCK; 
              TEST; 
  
              END 
            END 
            ELSE
# COMPARE SS NAME WITH SC NAME                                         #
          IF C<0,SBITMNELENW[SSITMADD]*10>SBITMNAME30[SSITMADD+ 
            SBITMNAMEPTR[SSITMADD]] NQ
          C<0,SCITMNAMLENW[SCITMADD]*10>SCITMNAM30[SCITMADD+
            SCITMNAMEPTR[SCITMADD]] THEN
                BEGIN 
                SETBLOCK; 
                TEST; 
  
                END 
          IF NOT REPTGRP[SBITMTYPE[SSITMADD]] THEN #SS NOT A REPEATING #
                                                   #GROUP              #
            BEGIN 
            CITEMSZ;         #GET CURRENT SS AND SC ITEM SIZES         #
            IF SCCURTSZ NQ SSCURTSZ THEN #CURRENT SS AND SC SIZES NOT  #
                                         #EQUAL                        #
              BEGIN 
              SETBLOCK; 
              TEST; 
  
              END 
            IF IITLEVEL[0] NQ 0 AND IITOCC[IITINDX] EQ 0 THEN 
                             #COMBINE SS ITEM TO CURRENT IITAB ENTRY   #
              BEGIN 
              IITACCSIZE[IITINDX]=IITACCSIZE[IITINDX]+SSITMSIZE;
              IITSSADR[IITINDX]=SSITMADD; 
              IITSCADR[IITINDX]=SCITMADD; 
              END 
            ELSE
              NEWTBENTY;
            END 
          ELSE
            NEWTBENTY;
  
          IF SBITMNEXTP[SSITMADD] EQ 0
          THEN               #END OF RECORD REACHED                    #
            BEGIN 
            ENDOFRECORD = TRUE; 
            SBEOR;           #SET THE LAST BLOCK                       #
            END 
          ELSE
            BEGIN 
            SSITMADD=SSITMADD+SBITMNEXTP[SSITMADD]; #GET NEXT SS ITEM  #
            END 
          END 
        END 
      RETURN; 
  
  
  
  
# THIS FUNC IS TO CALCULATE BEGINNING POSITION FOR CURRENT SC ITEM     #
      FUNC SCITMLG(SCADD);
      BEGIN 
      ITEM SCADD;            #SC ITEM ENTRY                            #
      ITEM SCITLG;           #BEGINNING POSITION FOR REPEATING DOMINANT#
      SCITLG=0;              #INITIALIZE                               #
      J=SCADD;               #SC ITEM ENTRY                            #
      N=J-SCITEMPRIORP[J];   #PRIOR SC ITEM ENTRY                      #
# FIND BEGINNING WORD POSITION FOR THE SC REPEATING DOMINANT GROUP     #
      FOR L =0 WHILE SCITMDOMORD[J] NQ 0 DO  # SC ITEM SUBORDINATE TO A#
                                           #REPEATING GROUP            #
        BEGIN 
        FOR K=0 WHILE SCITMDOMORD[J] NQ SCITMORDNUM[N] DO 
          N=N-SCITEMPRIORP[N]; #GET REPEATING DOMINANT ENTRY           #
          SCITLG=SCITLG+SCITEMPBWP[N]*10+SCITEMBBP[N]/6;
                             #BEGIN WORD POSITION FOR THE DOMINANT     #
        J=N;                 #CHECK DOMINANT GROUP SUBORDINATE TO A    #
        N=J-SCITEMPRIORP[J]; #REPEATING GROUP                          #
        END 
      SCITMLG=SCITLG+SCITEMPBWP[SCADD]*10+SCITEMBBP[SCADD]/6; 
                             #BEGINNING POSITION FOR SC ITEM           #
      END 
  
  
# THIS FUNC IS TO CALCULATE BEGINNING POSITION FOR CURRENT SS ITEM     #
      FUNC SSITMLG(SSADD);
      BEGIN 
      ITEM SSADD;            #SS ITEM ENTRY                            #
      ITEM SSITLG;           #BEGINNING POSITION FOR REPEATING DOMINANT#
      SSITLG=0;              #INITIALIZE                               #
      J=SSADD;               #SS ITEM ENTRY                            #
      N=J-SBITMPRIORP[J];    #PRIOR SS ITEM ENTRY                      #
# FIND BEGINNING WORD POSITION FOR THE SS REPEATING DOMINANT GROUP     #
      FOR L = 0 WHILE SBITMDOMORD[J] NQ 0 DO  #SS ITEM SUBORDINATE TO A#
                                           #REPEATING GROUP            #
        BEGIN 
        FOR K=0 WHILE SBITMDOMORD[J] NQ SBITMORDINAL[N] DO
          N=N-SBITMPRIORP[N]; #GET REPEATING DOMINANT ENTRY            #
        SSITLG=SSITLG+SBITMBWP[N]*10+SBITMBBP[N]/6; 
                             #BEGIN WORD POSITION FOR THE DOMINANT     #
        J=N;                 #CHECK DOMINANT GROUP SUBORDINATE TO A    #
        N=J-SBITMPRIORP[J];  #REPEATING GROUP                          #
        END 
      SSITMLG=SSITLG+SBITMBWP[SSADD]*10+SBITMBBP[SSADD]/6;
                             #BEGINNING POSITION FOR SS ITEM           #
      END 
  
  
# THIS PROC IS CALLED WHEN THE SS ITEM IS A NEW GROUP ITEM. IT WILL    #
#COMBINE ENTRIES IN IITAB IF POSSIBLE AND GET NEXT SS ITEM LEVEL AND   #
#STORE IT IN CURRENT ENTRY IN IITAB.                                   #
#IF THERE IS NO NEED TO COMBINE ENTRIES IN IITAB, THEN RETURN.         #
      PROC SSNEWGRP;
      BEGIN 
        COMBNTB;             #COMBINE ENTRIES IN IITAB                 #
        SSITMADD=SSITMADD+SBITMNEXTP[SSITMADD];#GET NEXT SS ITEM ENTRY #
        IF IITLEVEL[0] NQ 0 AND IITOCC[IITINDX] EQ 0 THEN 
                             #IITAB NOT EMPTY AND CURRENT ENTRY IN IITA#
                             #B WITH NO OCCURS                         #
          IITLEVEL[IITINDX]=SBITMLEVEL[SSITMADD]; #STORE NEXT SS LEVEL #
                                                  #IN CURRENT ITTAB    #
        END 
  
  
# THIS PROC IS CALLED TO SKIP HIGHER LEVELS OF REDEFINES SS ITEMS      #
      PROC SKPREDF; 
      BEGIN 
      ITEM LEVEL; 
        LEVEL=0;
        FOR I=0 WHILE SBITMLEVEL[SSITMADD] GR LEVEL DO
          BEGIN 
          IF LEVEL EQ 0 THEN
            LEVEL=SBITMLEVEL[SSITMADD];  #LEVEL OF REDEFINES ITEM. #
          IF SBITMNEXTP[SSITMADD] NQ 0 THEN 
            SSITMADD=SSITMADD+SBITMNEXTP[SSITMADD]; #GET NEXT SS ITEM  #
          ELSE
            BEGIN 
            ENDOFRECORD=TRUE;#SET END OF RECORD FLAG                   #
            SBEOR;           #END OF RECORD REACHED,SET BLOCKS FROM    #
                             #IITAB                                    #
          LEVEL = SBITMLEVEL[SSITMADD];    # FORCE EXIT FROM LOOP # 
            END 
          END 
      END 
  
  
# WHEN BLOCK STARTS CALL CBSCITM TO GET SC ITEM ADDRESS, OTHERWISE GET #
#NEXT SC ITEM FROM SC NEXT ITEM POINTER.                               #
      PROC GTSCITM; 
      BEGIN 
        IF NOT SCITMNXT THEN
          BEGIN 
          SCITMADD=SBITMSCPTR[SSITMADD];
          SCITMNXT=TRUE;
          END 
        ELSE
          SCITMADD=SCITMADD+SCITEMNXTPTR[SCITMADD]; 
      END 
  
  
# THIS PROC IS CALLED WHEN SS ITEM LEVEL LESS THAN CURRENT LEVEL IN    #
#IITAB. SEARCH IITAB TO FIND AN ENTRY IN IITAB SO THAT SS ITEM LEVEL   #
#IS GQ IITLEVEL[I] AND LQ IITLEVEL[I+1]. COMBINE THE ENTRIES WHICH HAVE#
#THE SAME LEVELS IN IITAB. ZERO OUT THE REMAINNING ENTRIES IN IITAB AND#
#RESET INDEX FOR IITAB.                                                #
      PROC COMBNTB; 
      BEGIN 
      IF IITLEVEL[0] EQ 0 THEN #IITAB EMPTY                            #
        RETURN; 
  
      FOR I=0 STEP 1 UNTIL IITINDX DO 
        BEGIN 
        IF IITLEVEL[I] EQ 0 THEN #NEED NOT TO COMBINE ENTRIES IN IITAB #
          RETURN; 
  
        IF SBITMLEVEL[SSITMADD] LQ IITLEVEL[I] OR   #SEARCH IITAB      #
                                                    #FIND RIGHT ENTRY  #
                                                    #FOR SS ITEM       #
        ENDOFRECORD THEN     #END OF RECORD REACHED                    #
          BEGIN 
          IF IITLEVEL[I] EQ IITLEVEL[I+1] THEN #COMBINE THE 2 ENTRIES  #
            IITACCSIZE[I]=IITACCSIZE[I]+IITACCSIZE[I+1];
          IITLEVEL[I]=SBITMLEVEL[SSITMADD];#UPDATE IITAB LEVEL NBR     #
          IITSSADR[I]=IITSSADR[IITINDX]; # UPDATE SS ADDRESS           #
          IITSCADR[I]=IITSCADR[IITINDX]; # UPDATE SC ADDRESS           #
          IITOCC[I]=0;       #LEVEL I CAN BE CONSIDERED AS ELEMENTARY  #
          FOR J=I+1 STEP 1 UNTIL IITINDX DO #ZERO OUT THE REMAINING    #
                                            #IITAB ENTRIES             #
            BEGIN 
            IITWD0[J]=0;
            IITWD1[J]=0;
            END 
          IITINDX=I;         #RESET IITAB INDEX AND FORCE LOOP END     #
# IF THERE ARE OUTSTANDING OCCURS IN THE ARRAY LEVELOCC, SS ITEM       #
#BELONGS TO THE CURRENT BLOCK IF SS ITEM LEVEL NBR IS HIGHER THAN THE  #
#LEVEL NBRS IN LEVELOCC. OTHERWISE SET BLOCKS FROM ENTRIES ALREADY SET #
#IN IITAB AND RESET IITAB AND LEVELOCC.                                #
          IF LVLINDX NQ 0 THEN
            BEGIN 
            FOR K=1 STEP 1 UNTIL LVLINDX DO 
              BEGIN 
              IF SBITMLEVEL[SSITMADD] LQ LEVEL[K] THEN
                BEGIN 
                SETBLOCK; 
                FOR N=K STEP 1 UNTIL LVLINDX DO 
                  LVLOC[N]=0; 
                LVLINDX=K-1; #RESET INDEX                              #
                RETURN; 
  
                END 
              END 
            END 
          IF SBITMLEVEL[SSITMADD] LS IITLEVEL[IITINDX] THEN 
            IITLEVEL[IITINDX]=SBITMLEVEL[SSITMADD]; 
# ADJUST LAST SS AND SC ENDING POSITIONS                               #
          SSLITMEP=SSITMLG(IITSSITMADD[IITINDX])+IITACCSIZE[IITINDX]; 
          SCITMADDR=SBITMSCPTR[IITSSITMADD[IITINDX]]; 
          SCLITMEP=SCITMLG(SCITMADDR) + IITACCSIZE[IITINDX];
          END 
        END 
      END 
  
  
# THIS PROC IS TO CALCULATE THE CURRENT SC AND SS ITEM SIZES.          #
# CURRENT SC ITEM SIZE = CURRENT SC ITEM ENDING POSITION - PRIOR SC    #
#ITEM ENDING POSITION.                                                 #
# CURRENT SS ITEM SIZE = CURRENT SS ITEM ENDING POSITION - PRIOR SS    #
#ITEM ENDING POSITION.                                                 #
      PROC CITEMSZ; 
      BEGIN 
      ITEM SCBPLG;           #BEGINNING POSITION FOR CURRENT SC ITEM   #
      ITEM SSBPLG;           #BEGINNING POSITION FOR CURRENT SS ITEM   #
      SCBPLG=0;              #INITIALIZE# 
      SSBPLG=0;              #INITIALIZE# 
      SCBPLG=SCITMLG(SCITMADD); #BEGINNING POSITION OF SC ITEM         #
      SSBPLG=SSITMLG(SSITMADD); #BEGINNING POSITION OF SS ITEM         #
      IF VECTOR[SBITMTYPE[SSITMADD]] THEN #SS ITEM VECTOR              #
        BEGIN 
        J=SCITEMSIZE[SCITMADD]* SCITMINTVAL[SCITMADD];
        N=SBITMUSESIZE[SSITMADD]* SBITMHIBNDS[SSITMADD+SBITMOCCURP
        [SSITMADD]];
        END 
      ELSE
        BEGIN                #SS ITEM ELEMENTARY                       #
        J=SCITEMSIZE[SCITMADD]; 
        N=SBITMUSESIZE[SSITMADD]; 
        END 
      SCBPLG=SCBPLG+J;       #ENDING POSITION FOR CURRENT SC ITEM      #
      SSBPLG=SSBPLG+N;       #ENDING POSITION FOR CURRENT SS ITEM      #
      IF SCLITMEP EQ 0 AND SSLITMEP EQ 0 THEN #WHEN STARTS A NEW BLOCK #
        BEGIN                                 #GET LAST SC AND SS ITEMS#
        SCLITMEP=SCITMLG(SCITMADD);           #ENDING POSITION         #
        SSLITMEP=SSITMLG(SSITMADD); 
        END 
      SCCURTSZ=SCBPLG-SCLITMEP; #CURRENT SC ITEM SIZE                  #
      SSCURTSZ=SSBPLG-SSLITMEP; #CURRENT SS ITEM SIZE                  #
      SCLITMEP=SCBPLG;       #SAVE CURRENT SC ENDING POSITION          #
      SSLITMEP=SSBPLG;       #SAVE CURRENT SS ENDING POSITION          #
      SSITMSIZE=SSCURTSZ;    #ACTUAL  CURRENT SS ITEM SIZE             #
      RETURN; 
      END 
  
  
# THIS PROC IS CALLED WHEN CURRENT SS ITEM BREAKS THEN CONTINUATION OF #
#THE BLOCK. SET BLOCK IF THERE IS ANY AND RESET TABLE AND CELLS.       #
      PROC  SETBLOCK; 
      BEGIN 
      FOR I=0 STEP 1 UNTIL IITINDX DO #SET MAPPING BLOCKS              #
        BEGIN 
        IF IITOCC[I] EQ 0 AND IITACCSIZE[I] GR IITSIZE[I] THEN
          BEGIN 
          J = IITSSITMADD[I];      # MAPPING WORD ADDRESS # 
          IF SBITMNEXTP[IITSSADR[I]] EQ 0 THEN
          SBITMNXSSWA[J] = 0; 
          ELSE
            SBITMNXSSWA[J] = IITSSADR[I] + SBITMNEXTP[IITSSADR[I]]; 
      IF SCITEMNXTPTR[IITSCADR[I]] EQ 0 THEN
            SBITMNXSCPTR[J] = 0;
          ELSE
            SBITMNXSCPTR[J] = IITSCADR[I] + SCITEMNXTPTR[IITSCADR[I]];
          SBITMBLOCKSZ[J]=IITACCSIZE[I];
          END 
        ELSE
# STORE IN ARRAY LEVELOCC THE LEVELS OF SS ITEMS THAT CONTAIN OUT-     #
#STANDING OCCURS, SO THAT ANY LOWER LEVEL OF SS ITEM THAT MAY FOLLOW   #
#CAN NOT BE GROUPED INTO THE BLOCK BEING BUILT.                        #
        IF IITOCC[I] NQ 0 THEN
          BEGIN 
          LVLINDX=LVLINDX+1; #INCREMENT TAB INDEX                      #
          LVLOC[LVLINDX]=IITLEVEL[I]; 
          END 
        END 
# RESET TABLE AND CELLS                                                #
      FOR I=0 STEP 1 UNTIL IITINDX DO 
        BEGIN 
        IITWD0[I]=0;
        IITWD1[I]=0;
        END 
      IITINDX=0;
      SCITMNXT=FALSE; 
      SCLITMEP=0; 
      SSLITMEP=0; 
      END 
  
  
# THIS PROC IS CALLED WHEN END OF RECORD HAS BEEN REACHED. SET BLOCKS  #
#FROM ENTRIES IN IITAB.                                                #
      PROC SBEOR; 
      BEGIN 
      COMBNTB;               #COMBINE ENTRIES IN IITAB AND SET UP THE  #
      SETBLOCK;              #LAST BLOCK OF THE RECORD                 #
      RETURN; 
  
      END 
  
  
# THIS PROC IS TO BUILD A NEW ENTRY IN IITAB FOR SS ITEM WHICH IS      #
#BELONGING TO THE BLOCK WHEN THE SS ITEM IS A REPEATING GROUP OR WHEN  #
#SS ITEM LEVEL GQ CURRENT IITLEVEL AND CURRENT IITOCC NQ 0.            #
      PROC NEWTBENTY; 
      BEGIN 
      IF IITLEVEL[0] NQ 0 THEN #IITAB NOT EMPTY#
        IITINDX=IITINDX+1;   #ADVANCE INDEX                            #
# BUILD A NEW ENTRY IN IITAB                                           #
      IITLEVEL[IITINDX]=SBITMLEVEL[SSITMADD]; 
      IITSSADR[IITINDX]=SSITMADD; 
      IITSCADR[IITINDX]=SCITMADD; 
      IITSSITMADD[IITINDX]=SSITMADD;
      IF REPTGRP[SBITMTYPE[SSITMADD]] THEN #SS A REPEATING GROUP     #
        BEGIN 
        SSITMSIZE=SBITMUSESIZE[SSITMADD]; 
        IITOCC[IITINDX ]=SBITMHIBNDS[SSITMADD+SBITMOCCURP[SSITMADD]]; 
        IITACCSIZE[IITINDX]=SSITMSIZE*IITOCC[IITINDX];
        END 
      ELSE
# CONSIDER VECTOR  AS ELEMENTARY. SET NBR OF OCCURENCE TO ZERO AND     #
#SET USESIZE FOR SS ITEM AS USESIZE * NBR OF OCCURENCE                 #
        IF VECTOR[SBITMTYPE[SSITMADD]] THEN #SS A VECTOR               #
          BEGIN 
          SSITMSIZE=SBITMUSESIZE[SSITMADD]; 
          I=SSITMADD+SBITMOCCURP[SSITMADD]; #OCC WORD ADD              #
          IITACCSIZE[IITINDX]=SSITMSIZE*SBITMHIBNDS[I]; 
          END 
        ELSE
          BEGIN 
          IITSIZE[IITINDX]=SSITMSIZE; 
          IITACCSIZE[IITINDX]=SSITMSIZE;
          END 
      END 
      END 
      TERM; 
