*DECK BGIMAGE 
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TFIT
USETEXT TSBASIC 
PROC BGIMAGE; 
    #PROCEDURE CALLED BY INSERT TO PRESET THE RECORD BUFFER WITH A
          BACKGROUND OF BLANKS, ZEROS AND NULL-VALUES AS APPROPRIATE.#
BEGIN 
     BASED ARRAY BGHEAD; #ARRAY WITH 1 ENTRY FOR EVERY RECORD DESCRIPTIO
                         THAT CONTAINS 1 OR MORE NON-DISPLAY ITEMS.#
                         #BGHEAD HAS UP TO 15 ENTRIES OVERLAYING THE
                         SUBSCHEMA FDB IN THE USE TABLE. IF NEEDED, 
                         OVERFLOW TABLES ARE ACQUIRED AND LINKED.#
     BEGIN
          ITEM BGDIRWA   U(0, 0,30);  #DIRECTORY WORD ADDRESS OF
                                       RECORD DESCRIPTION#
          ITEM BGTABADD  U(0,30,30);  #ADDRESS OF TABLE DESCRIBING
                                       NON-DISPLAY ITEMS IN RECORD# 
          ITEM BGHWORD   U(0, 0,60);  #LAST ENTRY WHEN ALL 0, 
                                       PTR TO OVERFLOW WHEN BGDIRWA=0#
     END
      BASED ARRAY BGROUND S(2);    # BACKGROUND TABLE WITH ONE ENTRY   #
                                   # FOR EVERY NON-DISPLAY ITEM OR     #
                                   # GROUP OF CONTIGUOUS NON-OCCURRING #
                                   # ITEMS OF THE SAME TYPE            #
      BEGIN 
        ITEM BGTYPE   U(00,00,06); # TYPE OF 0 OR NULL-VALUE           #
        ITEM BGSIZE   U(00,06,12); # ITEM SIZE IN CHARACTERS           #
        ITEM BGOCCUR  U(00,18,12); # NUM OF OCCURRENCES IF OCCURRING   #
        ITEM BGSTEP   U(00,30,18); # DISTANCE IN CHAR BETWEEN ITEM     #
                                   # ORIGIN AND ITS DOMINANT ITEM IF   #
                                   # WITHIN OCCURRING GROUP            #
        ITEM BGRCTYPE U(00,48,06); # ENTRY TYPE                        #
        ITEM BGLEVEL  U(00,54,06); # ENTRY LEVEL                       #
        ITEM BGGRSIZE U(01,00,18); # TOTAL GROUP SIZE IN CHARACTERS    #
        ITEM BGSTARTW U(01,18,18); # STARTING WORD POSITION OF ITEM    #
                                   # WITHIN RECORD                     #
        ITEM BGSTARTC U(01,36,04); # STARTING CHAR POSITION IN WORD    #
        ITEM BGTWORD  U(00,00,60); # LAST WHEN = 0,  OR                #
                                   # POINTER TO OVERFLOW IF BGSIZE = 0 #
     END
     BASED ARRAY RECORD; ITEM IRECORD U(0,0,60),  CRECORD C(0,0,10);
  
      DEF CASE #GOTO#;       # FOR EASE OF READING IN ZEROTYPE SWITCH  #
  
  
      ITEM NUMOFOCC;  # NUMBER OF OCCURENCES OF THE ITEM IN THE RECORD #
      ITEM NUMCHARS;  # USED IN STOREIMAGE AS NUMBER OF CHARACTERS     #
                      # FOR PARTIAL WORD FILL.                         #
      ITEM OCCURENCE; # LOOP INDEX COUNTING EACH OCCURENCE. ALSO USED  #
                      # AS SCRATCH WHILE LOCATING BGHEAD.              #
      ITEM SIZE;      # REMAINING SIZE OF ITEM TO BE PRESET. ALSO      #
                      # DUMMY INDEX IN BGHEAD SEARCH LOOP              #
      ITEM ZEROS;     # SET TO THE PROPER BACKGROUND TYPE FOR EACH ITEM#
      ITEM M;         # INDEX INTO RECORD POINTING TO THE WORD WE ARE  #
                      # TO PRESET. ALSO USED AS A SCRATCH LOOP INDEX   #
                      # WHILE INITIALIZING THE RECORD AND FINDING      #
                      # BGHEAD.                                        #
      ITEM STARTC;    # ITEM TO HOLD THE PRESENT STARTING CHARACTER    #
                      # POSITION IN WORD M OF THE RECORD.              #
      XREF ITEM CMM$PRS I;         # CMM$ALF PRESETS TO THIS VALUE     #
      XREF ITEM RECNAM I;          # RECORD DIRECTORY WORD ADDRESS     #
  
      XREF PROC CMOVE;             # MOVE CHARACTER STRING             #
      XREF PROC DIAG;              # WRITE ERROR MESSAGE               #
      XREF PROC MOVE;              # MOVE FULL WORDS                   #
  
  
  
  
  
  
      #**************  E X E C U T A B L E    C O D E  ****************#
  
#----------------------------------------------------------------------#
#     BGIMAGE                                                          #
#                                                                      #
#     COPY BACKGROUND IMAGE TO WSA                                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      P<AREA$TABLE> = AREALOC;
      P<FIT> = LOC(AT$AFITPOS); 
      P<RECORD> = FITWSA; 
      P<BGROUND> = AT$BGIMAGE;
      MOVE (BGROUND, (AT$MRL + 9) / 10, RECORD);
      RETURN; 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     BGFILL                                                           #
#                                                                      #
#     COPY BACKGROUND IMAGE TO WSA STARTING AT FIRST CHARACTER AFTER   #
#     FITRL                                                            #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC BGFILL; 
      PROC BGFILL;
      BEGIN 
      P<AREA$TABLE> = AREALOC;
      P<FIT> = LOC(AT$AFITPOS); 
      P<RECORD> = FITWSA; 
      P<BGROUND> = AT$BGIMAGE;
      IF AT$MRL GR FITRL
      THEN
        BEGIN 
        CMOVE (BGROUND, FITRL, AT$MRL - FITRL, RECORD, FITRL);
        END 
      RETURN; 
      END 
  
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     BGINIT                                                           #
#                                                                      #
#     PREPARE BACKGROUND IMAGE IN CM WHOSE ADDRESS IN STORED IN        #
#     AT$BGIMAGE                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC BGINIT; 
      PROC BGINIT;
      BEGIN 
      P<AREA$TABLE> = AREALOC;
      P<FIT> = LOC(AT$AFITPOS);                                          BGIMAGE
  
      M = (AT$MRL + 9) / 10;
      CMM$PRS = O"55555555555555555555";    # VALUE TO PRESET          #
      P<RECORD> = CMM$ALF(M, 0, 0);  # ALLOCATE BACKGROUND IMAGE       #
      AT$BGIMAGE = P<RECORD>; 
      OCCURENCE = RECNAM;          # GET RECORD DIRECTORY WORD ADDRESS #
      IF OCCURENCE EQ 0 THEN OCCURENCE = AT$RECWA;
                                       # DEFAULT IS FIRST RECORD  # 
      P<BGHEAD> = AT$BGSTRNG[0];   # LOCATE HEADLIST OF BACKGROUND     #
                                   # TABLES.                           #
      FOR SIZE = 0 DO       # INFINITE LOOP IS TERMINATED BY A RETURN # 
        BEGIN 
        FOR M = 0 STEP 1 UNTIL 14 DO
          BEGIN 
          IF BGHWORD[M] EQ 0 THEN RETURN;  # END OF LIST...DISPLAY #
                                           # ITEMS ONLY.           #
          IF BGDIRWA[M] EQ OCCURENCE THEN 
            BEGIN 
            P<BGROUND> = BGTABADD[M];  # POINT TO BGROUND TABLE        #
            BUILDER;               # BUILD MODEL RECORD                #
            RETURN; 
            END 
          END    # END OF M-LOOP #
        P<BGHEAD> = BGHWORD[14];  # CHECK OVERFLOW IF NOT FOUND  #
        END     # END OF INFINITE LOOP #
      CONTROL EJECT;
CONTROL EJECT;
      PROC BUILDER; 
      BEGIN 
  
#**********************************************************************#
#                 P R  O C   B U I L D E R                             #
#                                                                      #
#     PURPOSE                                                          #
#                                                                      #
#     THIS PROCEDURE BUILDS THE BACKGROUND IMAGE STORING               #
#     THE APPROPRIATE ZEROS OR NULL VALUES.                            #
#                                                                      #
#     CALLING PARAMETERS                                               #
#                                                                      #
#     NONE                                                             #
#                                                                      #
#     ENTRY CONDITIONS                                                 #
#                                                                      #
#     THE SPACE FOR THE SAMPLE RECORD HAS BEEN ALLOCATED IN            #
#     BGINIT, WITH THE ADDRESS STORED IN AT$BGIMAGE .                  #
#     THE POINTER TO THE BGTABLE IS SET IN BGINIT.                     #
#     BGTABLE DESCRIBING THE RECORD WAS BUILD IN BGTABLE.              #
#                                                                      #
#     EXIT CONIDITONS                                                  #
#                                                                      #
#     THE BACKGROUND IMAGE IS BUILD FOR USE BY BGIMAGE                 #
#     AND BGFILL.                                                      #
#                                                                      #
#     PROCESSING                                                       #
#                                                                      #
#     ELEMENTARY ITEMS ARE PRESET TO THE CORRECT TYPE OF ZEROS.        #
#     WHEN A REPEATING GROUP IS RECOGNIZED, A LEVEL PROCEDURE IS       #
#     CALLED TO PROCESS ALL ENTRIES IN THAT LEVEL.  A MAXIMUM          #
#     OF THREE LEVELS IS PERMITTED.                                    #
#                                                                      #
#     INTERNAL PROCEDURES                                              #
#                                                                      #
#     ELEMENTS - STORES IMAGES                                         #
#     INCR     - INCREMENTS ENTRY NUMBER                               #
#     LEVELONE - PROCESS LEVEL 1 ENTRIES                               #
#     LEVELTWO - PROCESS LEVEL 2 ENTRIES                               #
#     LEVELTHREE - PROCESS LEVEL 3 ENTRIES                             #
#     STORER  - SAVE LEVEL INFORMATION                                 #
#                                                                      #
#     LOCAL ITEMS                                                      #
#                                                                      #
  
      ITEM BSTEP1      I;          # DISTANCE BETWEEN OCCURS, LEVEL 1  #
      ITEM BSTEP2      I;          # DISTANCE BETWEEN OCCURS, LEVEL 2  #
      ITEM BSTEP3      I;          # DISTANCE BETWEEN OCCURS, LEVEL 3  #
      ITEM CURRENT     I;          # LEVEL INDEX                       #
      ITEM DUMMY       I;          # DUMMY LOOP VARIABLE               #
      ITEM EOT         B;          # END OF TABLE FLAG                 #
      ITEM FINIS       B;          # FINISH FLAG                       #
      ITEM ENTRI       I;          # BGTABLE INDEX                     #
      ITEM LOOPER      I;          # DUMMY LOOP VARIABLE               #
      ITEM MAXONE      I;          # NO. OF OCCURS AT LEVEL ONE        #
      ITEM MAXTWO      I;          # NO. OF OCCURS AT LEVEL TWO        #
      ITEM MAXTHREE    I;          # NO. OF OCCURS AT LEVEL THREE      #
      ITEM NUMONE      I;          # COUNTER FOR LEVEL 1 PROC          #
      ITEM NUMTWO      I;          # COUNTER FOR LEVEL 2 PROC          #
      ITEM NUMTHREE    I;          # COUNTER FOR LEVEL 3 PROC          #
      ITEM SAVELEVEL   I;          # PREVIOUS LEVEL                    #
  
#     LOCAL ARRAYS                                                     #
  
      ARRAY SAVERS [0:2]  S(1);    # LEVEL INFORMATION                 #
        BEGIN 
        ITEM LEVEL    U(00,00,06); # LEVEL NUMBER                      #
        ITEM OCCURS   U(00,06,06); # NUMBER OF OCCURENCES              #
        ITEM STARTER  U(00,18,06); # START ENTRY INDEX                 #
        ITEM BGPTR    U(00,24,18); # BGTABLE POINTER                   #
        ITEM GRSTEP   U(00,42,18); # SIZE OF OCCURENCE                 #
        ITEM SAVWORD  U(00,00,60); # WHOLE WORD                        #
        END 
  
CONTROL EJECT;
  
      #****************************************************************#
      #                    PROC ELEMENTS                               #
      #                                                                #
      #  THIS PROCEDURE DOES THE ACTUAL STORING OF IMAGES.             #
      #  THE OCCURRENCE NUMBER IS PASSED WITH THE CALL SO THAT         #
      #  THE PROPER LOCATION FOR STORAGE CAN BE CALCULATED.            #
      #  THE PARAMETER BSTEP PASSES THE STARTING ADDRESS OF EACH       #
      #  OCCURENCE WITHIN THE REPEATING GROUPS.  THIS VALUE IS         #
      #  CALCULATED IN THE VARIOUS LEVEL PROCS AND IS THE DISTANCE     #
      #  BETWEEN THE START OF A REPEATING GROUP AND THE START  OF      #
      #  THE PRESENT VALUE TO BE STORED.                               #! 
      #                                                                #
      #****************************************************************#
  
      PROC ELEMENTS (NUM,BSTEP);
      BEGIN 
  
      ITEM BSTEP       I;          # DISTANCE BETWEEN OCCURENCES       #
      ITEM NUM         I;          # OCCURENCE NUMBER                  #
      SWITCH ZEROTYPE NEXT,COMP,INTEGER,COMP1,COMP2,
                      COMP1DOUBLE,COMPLEX,LOGICAL;
  
      FINIS = FALSE;
      FOR DUMMY = 0 
        WHILE NOT FINIS 
      DO
        BEGIN 
        IF BGOCCUR[ENTRI] EQ 0     # FIND OUT HOW MANY TIMES WE        #
        THEN                       # ARE TO PRESET THIS ITEM           #
          BEGIN 
          NUMOFOCC = 1; 
          END 
        ELSE
          BEGIN 
          NUMOFOCC = BGOCCUR[ENTRI];
          END 
  
  
        CASE ZEROTYPE[ BGTYPE[ENTRI] ];  # GET THE RIGHT VALUE         #
  
COMP:         ZEROS = O"33333333333333333333";
              GOTO STOREIMAGE;
  
COMP1:  
INTEGER:  
LOGICAL:  
COMP1DOUBLE:  ZEROS = 0;
              GOTO STOREIMAGE;
  
COMP2:  
COMPLEX:     ZEROS = O"20000000000000000000"; 
             GOTO STOREIMAGE; 
  
NEXT:        GOTO STOREIMAGE; 
  
STOREIMAGE: 
        IF BGTYPE[ENTRI] NQ 0      # IF CHARACTER, SKIP STORE          #
        THEN
          BEGIN 
          FOR OCCURENCE = 0 STEP 1
            UNTIL NUMOFOCC - 1
          DO
            BEGIN 
            SIZE = BGSIZE[ENTRI]; 
            STARTC = BGSTARTC[ENTRI] + OCCURENCE * SIZE + BSTEP;
                                   # FIND WORD TO START IN             #
            M = (BGSTARTW[ENTRI] + STARTC / 10);
            STARTC = STARTC - (STARTC/10 ) * 10;  # START CHARACTER    #
  
                                   # FIRST THE PARTIAL WORDS           #
            IF STARTC GR 0
            THEN
              BEGIN 
              IF SIZE GR (10 - STARTC)  # IF IT WONT FIT IN THIS WORD  #
              THEN
                BEGIN 
                NUMCHARS = 10 - STARTC; 
                END 
              ELSE
                BEGIN 
                NUMCHARS = SIZE;
                END 
  
              C<STARTC,NUMCHARS>IRECORD[M] = C<0,NUMCHARS>ZEROS;
              M = M + 1;
              SIZE = SIZE - NUMCHARS; 
              END 
  
                                   # NOW DO THE WHOLE WORDS....        #
  
            FOR SIZE = SIZE WHILE SIZE GQ 10
            DO
              BEGIN 
              IRECORD[M] = ZEROS; 
              M = M + 1;
              SIZE = SIZE - 10; 
              END 
  
                                   # LASTLY, WHATEVER IS LEFT OVER ....#
  
            IF SIZE GR 0
            THEN
              BEGIN 
              C<0,SIZE>IRECORD[M] = C<0,SIZE>ZEROS; 
              END 
            END 
          END 
                                   # ALL THROUGH WITH THIS PRESET      #
  
                                   # SEE IF THERE IS MORE AT SAME LEVEL#
  
          SAVELEVEL = BGLEVEL[ENTRI]; 
          INCR;                    # GET NEXT ENTRY                    #
          IF BGLEVEL[ENTRI] NQ SAVELEVEL  # IF NOT SAME LEVEL          #
            OR (BGRCTYPE[ENTRI] NQ 1       # OR NOT ELEMENTARY         #
              AND BGRCTYPE[ENTRI] NQ 4      # OR NOT VECTOR            #
              AND BGRCTYPE[ENTRI] NQ 5)     # OR REPEATING VECTOR      #
            OR BGTWORD[ENTRI] EQ 0  # OR END OF TABLE                  #
          THEN
            BEGIN 
            FINIS = TRUE;          # FINISHED WITH THIS PASS           #
            END 
  
        END                        # END DUMMY LOOP                    #
  
      RETURN; 
      END                        # END PROC ELEMENTS                 #
CONTROL EJECT;
  
      #****************************************************************#
      #                    PROC INCR                                   #
      #                                                                #
      #  PROCEDURE TO ADD TO ENTRY NUMBER MOVING TO NEXT               #
      #  BLOCK IF NECESSARY.                                           #
      #                                                                #
      #****************************************************************#
  
      PROC INCR;
      BEGIN 
  
      ENTRI = ENTRI + 1;
      IF ENTRI EQ 14               # IF AT END OF BLOCK                #
        AND BGTWORD[14] NQ 0       # AND THERE IS POINTER TO NEXT      #
      THEN
        BEGIN 
        P<BGROUND> = BGTWORD[14];  # GET NEW BLOCK                     #
        ENTRI = 0;                 # SET TO START OF BLOCK             #
        END 
  
      RETURN; 
      END                          # END PROC INCR                     #
  
CONTROL EJECT;
  
      #****************************************************************#
      #                 PROC LEVELONE                                  #
      #                                                                #
      # PROCEDURE TO PROCESS FIRST LEVEL GROUPS.                       #
      #                                                                #
      #****************************************************************#
  
PROC LEVELONE;
      BEGIN 
  
      STORER;                      # SAVE INFO ABOUT THIS LEVEL        #
      MAXONE = OCCURS[CURRENT];    # LOOP LIMIT                        #
      NUMONE = 0;                  # SET LOOP COUNTER                  #
      FOR DUMMY = 0 
        WHILE NUMONE LS MAXONE
      DO
        BEGIN 
                                   # CALCULATE THE DISTANCE BETWEEN    #
                                   # THIS OCCURENCE AND THE LAST ONE   #
                                   # FOR THIS LEVEL                    #
        BSTEP1 = NUMONE * GRSTEP[CURRENT];
        IF BGRCTYPE[ENTRI] EQ 1      # IF ELEMENTARY ITEM              #
          OR BGRCTYPE[ENTRI] EQ 4  # OR VECTOR                         #
          OR BGRCTYPE[ENTRI] EQ 5  # OR REPEATING VECTOR               #
        THEN
          BEGIN 
          ELEMENTS(NUMONE,BSTEP1); # GO PRESET FIELDS                 # 
          END 
        ELSE                       # MUST BE GROUP ENTRY               #
          BEGIN 
          LEVELTWO;                # PROCESS NEXT LEVEL                #
          END 
  
                                   # SEE IF THERE IS MORE ON THIS LEVEL#
        IF BGLEVEL[ENTRI] LQ LEVEL[CURRENT] 
          OR BGTWORD[ENTRI] EQ 0   # OR THIS IS END OF TABLE           #
        THEN
          BEGIN 
          NUMONE = NUMONE + 1;
          IF NUMONE LS MAXONE 
          THEN
            BEGIN 
            P<BGROUND> = BGPTR[CURRENT];  # RESET POINTER FOR START    #
            ENTRI = STARTER[CURRENT];     # BACK TO START OF THIS LEVEL#
            END 
          END 
        END 
  
      CURRENT = CURRENT - 1;
  
      RETURN; 
      END                          # END PROC LEVELONE                 #
  
CONTROL EJECT;
  
      #****************************************************************#
      #                    PROC LEVELTWO                               #
      #                                                                #
      # PROCEDURE TO PROCESS SECOND LEVEL ENTRIES                      #
      #                                                                #
      #****************************************************************#
  
      PROC LEVELTWO;
      BEGIN 
  
      STORER;                      # SAVE LEVEL INFO                   #
  
      MAXTWO = OCCURS[CURRENT];    # SET LOOP LIMIT                    #
      NUMTWO = 0;                  # INITIALIZE OCCURENCE COUNTER      #
      FOR DUMMY = 0 
        WHILE NUMTWO LS MAXTWO
      DO
        BEGIN 
                                   # CALCULATE DISTANCE BETWEEN THIS   #
                                   # OCCURENCE AND LAST ONE            #
        BSTEP2 = BSTEP1 + (NUMTWO * GRSTEP[CURRENT]); 
        IF BGRCTYPE[ENTRI] EQ 1     # IF ELEMENTARY ITEM               #
          OR BGRCTYPE[ENTRI] EQ 4   # OR VECTOR                        #
          OR BGRCTYPE[ENTRI] EQ 5   # REPEATING VECTOR                 #
        THEN
          BEGIN 
          ELEMENTS(NUMTWO,BSTEP2); # GO PRESET FIELDS                  #
          END 
        ELSE                       # GROUP MEANS NEXT LEVEL            #
          BEGIN 
          LEVELTHREE; 
          END 
  
                                   # SEE IF NEXT ITEM SAME LEVEL       #
        IF BGLEVEL[ENTRI] LQ LEVEL[CURRENT] 
          OR BGTWORD[ENTRI] EQ 0   # OR END OF TABLE                   #
        THEN
          BEGIN 
          NUMTWO = NUMTWO + 1;
          IF NUMTWO LS MAXTWO      # MORE TO DO                        #
          THEN
            BEGIN 
            P<BGROUND> = BGPTR[CURRENT];  # SET BLOCK POINTER          #
            ENTRI = STARTER[CURRENT];  # AND BACK TO LEVEL START       #
            END 
          END 
        END 
  
      CURRENT = CURRENT - 1;
  
      RETURN; 
      END                          # END PROC LEVELTWO                 #
  
CONTROL EJECT;
  
      #****************************************************************#
      #                  PROC LEVELTHREE                               #
      #                                                                #
      # PROCEDURE TO PROCESS THIRD LEVEL ENTRIES                       #
      #                                                                #
      #****************************************************************#
  
      PROC LEVELTHREE;
      BEGIN 
  
      STORER;                      # SET LEVEL INFO                    #
  
      MAXTHREE = OCCURS[CURRENT]; 
      NUMTHREE = 0;                # INITIALIZE OCCURENCE COUNTER      #
      FOR DUMMY = 0 
        WHILE NUMTHREE LS MAXTHREE
      DO
        BEGIN 
        BSTEP3 = BSTEP2 + (NUMTHREE * GRSTEP[CURRENT]); 
        IF BGRCTYPE[ENTRI] EQ 1    # ELEMENTARY ITEM                   #
          OR BGRCTYPE[ENTRI] EQ 4  # VECTOR                            #
          OR BGRCTYPE[ENTRI] EQ 5  # REPEATING VECTOR                  #
        THEN
          BEGIN 
          ELEMENTS(NUMTHREE,BSTEP3);  # PRESET FIELDS                  #
          END 
        ELSE
          BEGIN 
          DIAG(423);               # 3 LEVELS IS LIMIT                 #
          INCR;                    # KEEP GOING WITH NEXT              #
          END 
  
        IF BGLEVEL[ENTRI] LQ LEVEL[CURRENT] 
          OR BGTWORD[ENTRI] EQ 0   # OR END OF TABLE                   #
        THEN
          BEGIN 
          NUMTHREE = NUMTHREE + 1;
          IF NUMTHREE LS MAXTHREE 
          THEN
            BEGIN 
            P<BGROUND> = BGPTR[CURRENT];  # BLOCK FOR START            #
            ENTRI = STARTER[CURRENT]; 
            END 
          END 
        END 
  
      CURRENT = CURRENT - 1;
  
      RETURN; 
      END                          # END PROC LEVELTHREE               #
  
CONTROL EJECT;
  
      #****************************************************************#
      #                PROC STORER                                     #
      #                                                                #
      # PROCEDURE TO STORE LEVEL INFORMATION                           #
      #                                                                #
      #****************************************************************#
  
      PROC STORER;
      BEGIN 
  
      CURRENT = CURRENT + 1;
      LEVEL[CURRENT] = BGLEVEL[ENTRI];   # SAVE LEVEL                  #
      OCCURS[CURRENT] = BGOCCUR[ENTRI];  # SAVE NUMBER OF OCCURS       #
      GRSTEP[CURRENT] = BGSTEP[ENTRI];    # SIZE OF ONE OCCURENCE      #
      INCR;                              # INCREMENT ENTRY NUMBER      #
      STARTER[CURRENT] = ENTRI;          # START LOCATION FOR LOOP     #
      BGPTR[CURRENT] = P<BGROUND>;       # AND BLOCK LOCATION          #
      RETURN; 
      END                                # END PROC STORER             #
  
CONTROL EJECT;
  
      #****************************************************************#
      #  M A I N L I N E   C O D E   O F   P R O C   B U I L D E R     #
      #                                                                #
      #****************************************************************#
  
                                   # INITIALIZATION                    #
      CURRENT = -1; 
      FOR DUMMY = 0 STEP 1 UNTIL 2
      DO
        BEGIN 
        SAVWORD[DUMMY] = 0;        # CLEAR SAVER ARRAY                 #
        END 
      ENTRI = 0;
  
                                   # GO THRU ENTIRE BGTABLE            #
      FOR LOOPER = 0
        WHILE BGTWORD[ENTRI] NQ 0 
      DO
        BEGIN 
        IF BGRCTYPE[ENTRI] EQ 0    # JUST PLAIN GROUP                  #
          AND BGOCCUR[ENTRI] EQ 0 
        THEN
          BEGIN 
          INCR;                    # IGNORE AND GET NEXT               #
          END 
        ELSE
          BEGIN 
          IF BGRCTYPE[ENTRI] EQ 1     # IF ELEMENTARY ITEM             #
            OR BGRCTYPE[ENTRI] EQ 4   # OR VECTOR                      #
            OR BGRCTYPE[ENTRI] EQ 5   # OR REPEATING VECTOR            #
          THEN
            BEGIN 
            ELEMENTS(0,0);         # PRESET FIELDS                     #
            END 
          ELSE
            BEGIN 
            LEVELONE;              # SUB LEVEL PROCESSING              #
            END 
          END 
        END 
  
      RETURN; 
      END                          # END PROC BUILDER                  #
  
      END 
      END 
      TERM
