*DECK PAGE
USETEXT TCLFN 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TEMLST
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TREPORT 
USETEXT TRPTLST 
  PROC PAGE (RPTLPTR);
   BEGIN
      BASED ARRAY RPTPAGE[1:MXHDWPL,1:MAXLINE,1:NUMPRPG] S; 
        ITEM RPAGE; 
      BASED ARRAY FET;;            # ADDRESS OF FET USED BY RPTFIT     #
      BASED ARRAY PAGEBUF [1:MXHDWPL,1:MAXLINE]  S; 
        BEGIN 
        ITEM PAGEWD;
        END 
          BASED ARRAY BASTEMP;
            ITEM BTEMP; 
      ARRAY TIRELINE[0:MAXWPL]; 
          ITEM TRLINE C(0,0,10);
      ITEM ONDIAG B=0;   # SET IF 2 DETAIL FORMATS AND ONCE  FLAG # 
      ITEM OVERLAPFLAG B; 
      ITEM DIAGFLG B=0;  # SET IF FIELD OVERLAP IN PAGE BUILD # 
      ITEM  NCHAR, BCHAR; 
     ITEM PAGEMPTY B=1;      # TRUE IF PAGE BUFFER EMPTY, ELSE FALSE #
      ITEM CLOSEFLG B=0;     # TRUE IF ENTRY THRU PAGECLOSE # 
      ITEM FROMCH, NUMCHAR, TOWD, TOCH; 
      ITEM RPTLPTR; 
      ITEM I, J, TEMP, LOCRPT, LININDX; 
      ITEM K, L, M, N,
           P, Q, R, 
           PAGCALL = 0,    # ZERO IF PAGE NEVER CALLED #
           PTOT;  #TOTAL NUMBER OF CHARS MOVED IN MOVSECT#              000280
          XDEF ITEM LASTLN; #FARTHEST LINE USED IN PAGE#                000290
      ITEM XCOLSAV=1,LPSAV=1;                                           000410
      ITEM XLINSAV = 0;  # SAVE BIGGEST VALUE OF XLINE FOR PAGE # 
      BASED ARRAY ARR; ITEM ARRI I (0,24,12);                           000415
          BASED ARRAY LINENUB; ITEM LINENUBR I(0,0,60); 
 # VARIABLES USED FOR VERTICAL SECTIONS # 
      ITEM NOTDETLN,    # LAST NON-DETAIL LINE PRINTED #
           LASTDETLN,   # LAST DETAIL LINE PRINTED #
           DTLCTR,     # COUNTER OF NUMBER OF DETAILS TO MOVE # 
           DETRPTLS;    # REPORTLIST INDEX OF LAST DETAIL # 
      ARRAY SAVLINE [0:MAXWPL]; 
        ITEM SVLIN I(0,0,60), 
              SAVCHAR U(0,8,4), 
              SAVLENG I(0,12,12), 
             SAVADDR I(0,42,18),     SAVLINBR I(0,24,18); 
 # VARIABLES USED FOR MULTIPLE PRINT PAGES, NOT REQUIRED OTHERWISE #
      BASED ARRAY RPFET [2:20]  S(5); 
         ITEM RPFNM I (0,0,42),     RPSTAT I (0,42,18), 
              RPFIRST I (1,42,18),  RPIN   I (2,0,60),
              RPOUT   I (3,0,60),   RPLIMIT I (4,42,18);
      ITEM CIOCL  U;                                                     PAGE 
      ITEM  PAGEWID,     # SAVE COLUMNS * IMAGES HERE # 
            PRTPG;       # SAVE NBR OF PRINTER PAGES / REPT PAGE #
      XREF ITEM DUMMY;             # DUMMY FOR LOOP CONTROL VARIABLE   #
      XREF ITEM BFAFIND S:BFAFTYP;   # INDEX INTO BFAFTYP AND STSTYPE  #
      XREF ITEM EVMVIND S:EVMVTYP;   # INDEX INTO EVMVTYP AND EVMVLIT  #
      XREF FUNC BINDEC C(10);      # BINARY TO DECIMAL....IN CONVERT   #
      XREF PROC CMOVE;
      XREF PROC FORMLINE; 
          XREF PROC DIAG;                                               001550
      XREF FUNC INCRDIS;                                                000260
          XREF PROC REWND;         # REWIND FILES BY CRM               #
          XREF PROC WRITEH;        # WRITE A CODED LINE IN -H- FORMAT  #
          XREF PROC WRITEW;        # TRANSFER WORDS FROM A BUFFER      #
      SWITCH TDP  P520,P530,P540; 
          XREF PROC EXCEVA; ITEM B1; XREF PROC MOVEXET; 
          XREF ITEM MVFL B; 
          XREF ITEM RA0;
          XREF PROC ENDREP; 
          ITEM PGCT = 0;
      ITEM IX I;                   # TEMP ITEM FOR USE WITH DIAGNOSTICS#
  
  
#----------------------------------------------------------------------#
          P<REPORTLIST> = AREPORTLIST;
      PAGCALL = 2;
P100: IF NOT PAGEMPTY THEN GOTO P200; 
          # INITIALIZE PAGE BUFFER TO BLANKS, PLUS ZERO BYTE AT EOL # 
      FOR K=1 STEP 1  UNTIL NUMPRPG  DO  BEGIN
        P<PAGEBUF> = LOC(RPAGE[1,1,K]); 
      FOR I=1 STEP 1 UNTIL MAXLINE  DO
        FOR J = 1  STEP 1  UNTIL MXHDWPL  DO
          PAGEWD [J,I] = BLK; 
        END 
      XLINE = 0;
      LPLINE = 0; 
      LASTLN = 0; 
      NOTDETLN = 0;  LASTDETLN = 0;  DTLCTR = 0;
      XCOLUMN = 1;
         XLINSAV = 0; 
      PAGEMPTY = FALSE; 
          # GENERATE TITLE LINES #
      J = TITLAST[1]; 
      I = TITFIRST[1];
      TITCURRENT[1] = I;
      IF I EQ 0  THEN GOTO P200;
          IF EVAT AND TITEVBEF[1] NQ 0 THEN 
          BEGIN M = TITEVBEF[1];
                EVMVIND = S"EVALBEF";       # INDEX FOR "EVAL-BEFRE"   #
                BFAFIND = S"TITLE1";        # INDEX FOR "TITLE"        #
                EXCEVA(M);
          END 
          ELSE EVAT = TRUE; 
          IF MVFL AND TITMVBEF[1] NQ 0 THEN 
          BEGIN M = TITMVBEF[1] ; 
                EVMVIND = S"MOVEBEF";        # INDEX FOR "MOVE-BEFRE"  #
                BFAFIND = S"TITLE1";         # INDEX FOR "TITLE"       #
                MOVEXET(M); 
          END 
              ELSE MVFL = TRUE; 
 P110:  P<BASTEMP> = LOC(TIRELINE); 
      LININDX = LINENUMBER[I];
      FORMLINE(I, BASTEMP);                                              PAGE 
      M = LOC(TIRELINE);
      MOVLIN;                                                            PAGE 
      I = TITCURRENT[1];
      IF  I LQ J  THEN GOTO P110; 
          IF TITEVAFT[1] NQ 0 THEN
          BEGIN B1 = TITEVAFT[1]; 
                EVMVIND = S"EVALAFT";        # INDEX FOR "EVAL-AFTER"  #
                BFAFIND = S"TITLE1";         # INDEX FOR "TITLE"       #
                EXCEVA(B1); 
          END 
          IF TITMVAFT[1] NQ 0 THEN
          BEGIN B1 = TITMVAFT[1]; 
                EVMVIND = S"MOVEAFT";         # INDEX FOR "MOVE-AFTER" #
                BFAFIND = S"TITLE1";          # INDEX FOR "TITLE"      #
                MOVEXET(B1);
              END 
      XLINE = LININDX;
      LPLINE = XLINE; 
      IF NOTDETLN LS XLINE         # INCREMENT IF LINE BEING WRITTEN > #
                                   # THAN LAST DETAIL LINE             #
      THEN
        BEGIN 
        NOTDETLN = XLINE; 
        END 
# MOVE LINE FROM FORMATDLINE INTO PAGE BUFFER # 
 #  JUMP IF PAGECLOSE ASKED FOR THIS INITIALIZATION  #
P200:   IF PAGCALL EQ 0   THEN GOTO P500; 
      LOCRPT = RPTLPTR; 
   # TAKE CARE OF LINE NUMBER N, WHERE N IS DATA ITEM # 
          IF LINEN[LOCRPT] THEN BEGIN 
           P<LINENUB> = LINENBN[LOCRPT];
              LININDX = LINENUBR[0];
          IF LININDX LQ 0          # IF LINE NO. NEGATIVE              #
            OR LININDX GR PSLINE   # OR IF N TOO BIG                   #
          THEN
            BEGIN 
            WHATSTEP (LOCRPT, IX); # IX WILL CONTAIN NAME AND LEVEL NO #
            DIAG (288, IX);        # DIAGNOSE BAD -AT LINE N- VALUE    #
            RETURN; 
            END 
                        END 
          ELSE
      LININDX = LINENUMBER [LOCRPT];
      P<ARR> = HEADPOINTER[LOCRPT]; 
      IF CALLTYPE[LOCRPT] EQ 1  THEN GOTO P300; 
 # CHECK IF DETAILS NEED TO BE RE-ARRANGED FOR VERTICAL SECTNS #
   # AND IF FIELD COMPARISONS MUST BE DONE FOR -ONCE- ON DETAILS #
      IF DTLCTR NQ 0                                                     PAGE 
      THEN                                                               PAGE 
        BEGIN                                                            PAGE 
        IF PSHORVER EQ 1                                                 PAGE 
        THEN                                                             PAGE 
          BEGIN                                                          PAGE 
          VERTMOV;                                                       PAGE 
          END                                                            PAGE 
                                                                         PAGE 
        IF ONCEFLG                                                       PAGE 
        THEN                                                             PAGE 
          BEGIN                                                          PAGE 
          CHKONCE;                                                       PAGE 
          END                                                            PAGE 
      END                                                                PAGE 
      IF BEYOND[LOCRPT] THEN  BEGIN 
        #TAKE CARE OF DIRECTIVE WHICH ONLY SPECIFIES ONE LINE # 
        # OR FIRST TIME THROUGH, FOR OTHER DIRECTIVES # 
         IF ARRI[0] EQ LOCRPT  THEN  BEGIN
           IF XLINE LS LASTLN  THEN XLINE = LASTLN; 
           XLINSAV = XLINE;  END
        ELSE XLINE = XLINSAV; 
        LININDX = LININDX + XLINE;  #XLINE IS POINT FROM WHICH BEYOND # 
                                    # IS COUNTED #
        END 
      XLINE = LININDX;
      IF LININDX GR PSLINE         # IF BEYOND PAGE LENGTH             #
      THEN
        BEGIN 
        IF PAGCALL EQ 2            # IF PAGECLOSE HAS NOT BEEN CALLED  #
        THEN
          BEGIN 
          GOTO P500;               # CLOSE PAGE, THEN TRY HEADING AGAIN#
          END 
                                   # PAGECLOSE HAS ALREADY BEEN CALLED #
                                   # AND HEADING STILL WONT FIT        #
        WHATSTEP (LOCRPT, IX);     # IX WILL CONTAIN NAME AND LEVEL NO #
        DIAG (616, IX);            # (IX) EXTENDS BEYOND PAGE LENGTH   #
        RETURN; 
        END 
      M = LOC(FORMATDLINE); 
      MOVLIN;                                                            PAGE 
      IF LININDX GR NOTDETLN  THEN  NOTDETLN = LININDX; 
      GOTO P480;
 P300:   # MOVE DETAIL LINE, TAKING ACCOUNT OF SECTIONS # 
      IF XLINE LS NOTDETLN         # MAKE CERTAIN DETAIL BEGINS AFTER  #
                                   # LAST NON-DETAIL LINE              #
      THEN
        BEGIN 
        XLINE = NOTDETLN; 
        END 
      IF ARRI[0] EQ LOCRPT  THEN BEGIN   # UPDATE VERT SECT COUNTERS #
      IF (DTLCTR NQ 0)  AND  (DETRPTLS NQ LOCRPT)  AND  ONCEFLG 
        THEN ONDIAG = TRUE; 
        DETRPTLS = LOCRPT;
        DTLCTR = DTLCTR + 1;   END
      IF BEYOND[LOCRPT]  THEN BEGIN 
        IF LININDX NQ 0  THEN LININDX = LININDX + LPLINE; 
        ELSE BEGIN            # TAKE CARE OF DETAIL AT LINE 0 BEYOND #
          LININDX = XLINE;
          XCOLUMN = XCOLSAV;   END
      END 
      IF LININDX NQ XLINE  THEN BEGIN 
   # THIS DETAIL GOES ON A DIFFERENT LINE THAN THE LAST ONE # 
        IF ARRI[0] EQ LOCRPT  THEN BEGIN                                000435
   # THIS DETAIL ENTRY SPECIFIES ONLY ONE LINE #
        LININDX = LININDX - LPLINE + XLINE; 
        LPLINE = XLINE; 
        XLINE = LININDX;
      LASTDETLN = LININDX;
        XCOLUMN = 1;   END
   # IF DETAIL SPECIFIES MORE THAN ONE LINE, BACK UP ONE SECTION #
   # AND DO NOT UPDATE LPLINE  #
        ELSE IF XCOLUMN NQ 1  THEN                                      000445
          XCOLUMN = XCOLUMN - SECTWID;                                  000450
          ELSE BEGIN   XCOLUMN = XCOLSAV;                               000455
        IF NOT BEYOND [LOCRPT]  THEN
          BEGIN 
          LPSAV = LPLINE; 
          END 
          LININDX = LININDX - LPLINE + LPSAV;                           000460
          LPLINE = LPSAV;  END                                          000465
        END                                                             000475
   # GO PRINT PAGE IF PAST LAST LINE IN PAGE #
   # (SHOULD NEVER DO THIS BECAUSE XEQREP CHECKS) # 
      IF LININDX GR PSLINE  THEN GOTO P500; 
      M = LOC(FORMATDLINE); 
      XCOLSAV = XCOLUMN;                                                000495
      IF LININDX GR XLINSAV  THEN XLINSAV = LININDX;                    000500
      LPSAV = LPLINE;        # SAVE VALUES FOR DETAIL CONTINUATN #      000505
      MOVSECT;                                                           PAGE 
      IF (XCOLUMN+SECTWID-1) LQ PSCOLUMN  THEN GOTO P490; 
   # SKIP LINE COUNTER UPDATES IF LAST SECTION IN LINE NOT FILLED # 
          IF XLINSAV GR XLINE THEN XLINE = XLINSAV; 
      XLINSAV = 0;                                                      000511
 P480:  # # 
      IF LPLINE LS XLINE           # INCREMENT LAST IF NEW LINE >      #
                                   # PREVIOUS LAST LINE                #
      THEN
        BEGIN 
        LPLINE = XLINE; 
        END 
      XCOLUMN = 1;
 P490:   # RETURN FROM PAGE # 
      IF LININDX GR LASTLN  THEN  LASTLN = LININDX; 
      RETURN; 
  
      CONTROL EJECT;
   # THIS PROC PUTS IN RECAP, DATE, PAGE-NUMBER, AND TIME # 
   # AND PRINTS OUT THE PAGE #
      ENTRY PROC PAGECLOSE; 
          P<REPORTLIST> = AREPORTLIST;
          CLOSEFLG = TRUE;
 #  GO SET UP BUFFER IF PAGE WAS NEVER CALLED  #
      IF PAGCALL EQ 0   THEN GOTO P100; 
P500: 
      PAGCALL = 3;                 # PAGECLOSE HAS BEEN CALLED         #
 # CHECK IF DETAILS NEED TO BE REARRANGED FOR VERTICAL SECTIONS # 
   # AND IF FIELD COMPARISONS MUST BE DONE FOR -ONCE- ON DETAILS #
      IF DTLCTR NQ 0                                                     PAGE 
      THEN                                                               PAGE 
        BEGIN                                                            PAGE 
        IF PSHORVER EQ 1                                                 PAGE 
        THEN                                                             PAGE 
          BEGIN                                                          PAGE 
          VERTMOV;                                                       PAGE 
          END                                                            PAGE 
                                                                         PAGE 
        IF ONCEFLG                                                       PAGE 
        THEN                                                             PAGE 
          BEGIN                                                          PAGE 
          CHKONCE;                                                       PAGE 
          END                                                            PAGE 
      END                                                                PAGE 
                                                                         PAGE 
          # GENERATE RECAP LINES #
      I = RECFIRST[1];
      J = RECLAST[1]; 
      RECCURRENT[1] = I;
      IF I EQ 0                    # IF NO RECAP                       #
      THEN
        BEGIN 
        GOTO P515;
        END 
      IF XLINE LS LASTLN
      THEN
        BEGIN 
        XLINE = LASTLN; 
        END 
      XLINSAV = XLINE;
          IF RCPEVBEF[1] NQ 0 THEN
          BEGIN B1 = RCPEVBEF[1]; 
                EVMVIND = S"EVALBEF";        # INDEX FOR "EVAL-BEFRE"  #
                BFAFIND = S"RECAP1";         # INDEX FOR "RECAP"       #
                EXCEVA(B1); 
          END 
          IF RCPMVBEF[1] NQ 0 THEN
          BEGIN B1 = RCPMVBEF[1]; 
                EVMVIND = S"MOVEBEF";         # INDEX FOR "MOVE-BEFRE" #
                BFAFIND = S"RECAP1";          # INDEX FOR "RECAP"      #
                MOVEXET(B1);
              END 
 P510:  P<BASTEMP> = LOC(TIRELINE); 
      LININDX = LINENUMBER[I];
      IF  BEYOND[I]  THEN LININDX = LININDX + XLINE;
      FORMLINE(I, BASTEMP);                                              PAGE 
      M = LOC(TIRELINE);
      IF LININDX GR PSLINE         # IF BEYOND PAGE LENGTH             #
      THEN
        BEGIN 
        DIAG (616, "RECAP");       # RECAP EXTENDS BEYOND PAGE LENGTH  #
        GOTO P512;
        END 
      MOVLIN;                                                            PAGE 
      I = RECCURRENT[1];
      IF  I LQ J  THEN GOTO P510; 
      LPLINE = LININDX; 
      XLINE = LININDX;
P512: 
          IF RCPEVAFT[1] NQ 0 THEN
          BEGIN B1 = RCPEVAFT[1]; 
                EVMVIND = S"EVALAFT";        # INDEX FOR "EVAL-AFTER"  #
                BFAFIND = S"RECAP1";         # INDEX FOR "RECAP"       #
                EXCEVA(B1); 
      END 
          IF RCPMVAFT[1] NQ 0 THEN
          BEGIN B1= RCPMVAFT[1];
                EVMVIND = S"MOVEAFT";         # INDEX FOR "MOVE-AFTER" #
                BFAFIND = S"RECAP1";          # INDEX FOR "RECAP"      #
                MOVEXET(B1);
              END 
          # MOVE TIMES INTO PAGE BUFFER # 
P515: 
      IF PSFLG EQ 1                # IF TEXT PREFACE OR SUMMARY        #
      THEN
        BEGIN 
        GOTO P600;                 # GO TO WRITE OUT PAGE BUFFER       #
        END 
      J = TIMLAST[1]; 
      I = TIMFIRST[1];
      IF I EQ 0  THEN GOTO P520;                                        000160
      P<BASTEMP> = LOC(TIME); 
      TEMP = 0; 
      GOTO TDPMOVE; 
 P520:                                                                  000180
          # MOVE DATES INTO PAGE BUFFER # 
      J = DATLAST[1]; 
      I = DATFIRST[1];
      IF I EQ 0  THEN GOTO P530;
      P<BASTEMP> = LOC(DATE); 
      TEMP = 1; 
      GOTO TDPMOVE; 
   P530:  
          # MOVE PAGE NUMBERS INTO PAGE BUFFER #
      J = PGNLAST[1]; 
      I = PGNFIRST[1];
      IF I EQ 0  THEN GOTO P540;
      P<BASTEMP> = LOC(PAGENUM);
      TEMP = 2; 
      GOTO TDPMOVE; 
 P540:                                                                  000240
  # TAKE CARE OF IMAGES, IF NECESSARY # 
      IF PSIMAGE EQ 1  THEN GOTO P600;
      SECTWID = PSCOLUMN; 
      FOR LININDX = 1  STEP 1  UNTIL LASTLN  DO BEGIN 
        XCOLUMN = PSCOLUMN + 1; 
        FOR N = 2  STEP 1  UNTIL PSIMAGE  DO BEGIN
        J = 1 +  (PSCOLUMN - 1) / MAXHDWC;
        FOR I = 1  STEP 1  UNTIL J  DO BEGIN
          SECTWID = PSCOLUMN; 
          IF SECTWID GR MAXHDWC  THEN  BEGIN
            SECTWID = MAXHDWC;
            IF I EQ J  THEN  SECTWID = PSCOLUMN - (J-1) * MAXHDWC;
            END 
          M = LOC ( RPAGE [1, LININDX, I] );
          MOVSECT;                                                       PAGE 
          END 
        END 
        END 
      SECTWID = PSCOLUMN / PSSECTION; 
P600: 
#                                                                      #
#                      ADD PAGE EJECT CHARACTER                        #
#                                                                      #
      FOR K=1 STEP 1
        UNTIL NUMPRPG 
      DO
        BEGIN 
        C<0,1>RPAGE[1,1,K] = "1";  # PUT PAGE EJECT CHAR IN EACH PAGE  #
        END 
  
        IF PSFLG NQ 1              # IF NOT PREFACE OR SUMMARY         #
        THEN
          BEGIN 
          PAGENUM = INCRDIS(PAGENUM,"0000000001"); # INCREMENT PAGE NO #
          END 
#                                                                      #
#                       WRITE OUT PAGE BUFFER                          #
#                                                                      #
      FOR K = 1  STEP 1  UNTIL NUMPRPG  DO  BEGIN 
 # STOPIF HAVE WRITTEN OUT ENOUGH PAGES FOR REPORT PAGEWIDTH #
      IF K GR PRTPG  THEN  GOTO P610; 
      IF PRINTSQ NQ 0  AND  K NQ 1  THEN  BEGIN 
 # PRINTER PAGES 2 FF GO TO DIFFERENT FILES IF PRINTSQ NOT 0 #
      RPSTAT [K] = O"24"; 
      RPOUT [K] = LOC (RPAGE[1, 1, K]); 
      RPIN [K] = LOC ( RPAGE[1, LASTLN, K] ) + MXHDWPL; 
      REQCIO;                                                            PAGE 
        END 
      ELSE BEGIN
        P<PAGEBUF> = LOC(RPAGE[1,1,K]); 
          RPTFITES[0] = 0;
   # WRITE ONLY AS MANY LINES AS CONTAIN DATA # 
      P<FET> = LOC(RPTFIT);                                              CHANGES
      FOR I=1 STEP 1 UNTIL LASTLN DO
        BEGIN 
        WRITEH(FET,PAGEBUF[1,I],MXHDWPL);  # WRITE EACH REPORT LINE    #
        END 
      END 
      END 
 P610:   # AFTER PAGE IS WRITTEN, RE-INITIALIZE POINTERS AND LEAVE #
          IF PRWFG NQ 0 AND PGCT NQ 0 THEN ENDREP;
          PGCT = PGCT + 1;
      XLINE = 0;
      XLINSAV = 0;
      LASTLN = 0; 
      LPLINE = 0; 
      NOTDETLN = 0;   LASTDETLN = 0;   DTLCTR = 0;
      PAGEMPTY = TRUE;
     IF NOT CLOSEFLG  THEN GOTO P100; 
      CLOSEFLG = FALSE; 
      RETURN; 
  
# THIS LABEL ADDS DATE/TIME/PAGE TO THE REPORT PAGE.  IF IT CROSSES    #
# REPORT PAGES THEN CARE MUST BE TAKEN TO ADD THE REST TO THE NEXT     #
# REPORT PAGE.                                                         #
#     M = COLUMN NUMBER WITHIN THE REPORT BUFFER/REPORT PAGE.          #
#     K = PHYSICAL PAGE NUMBER FOR REPORT.                             #
 TDPMOVE:  LININDX = LINENUMBER[I]; 
      TOCH = TOCHAR[I]; 
      TOWD = TOADDRESS[I];
TDP10:  NUMCHAR = 10; 
      FROMCH = 0; 
      M = TOWD*10 + TOCH; 
      K = (M + MAXHDWC - 1)/MAXHDWC;
      IF (M + 9)  GR  K*MAXHDWC  THEN 
        NUMCHAR = K*MAXHDWC - M + 1;
      M = M - (K - 1)*MAXHDWC;
      TOWD = M / 10;
      TOCH = M -  TOWD * 10;
      TOWD = TOWD + 1;
TDP30:  P<PAGEBUF> = LOC(RPAGE[TOWD,LININDX,K]);
      FOR DUMMY = 0 STEP 1
      UNTIL NUMCHAR - 1 
      DO
        BEGIN 
        TOWD = (TOCH + DUMMY)/10 + 1;  # WHICH WORD 1 OR 2             #
        IF C<TOCH+DUMMY-((TOWD-1)*10),1>PAGEWD[TOWD,1] NQ " " 
        THEN
          BEGIN 
          OVERLAPFLAG = TRUE;      # OVERLAPPING FIELDS HAS OCCURED    #
          END 
        END 
      CMOVE(BASTEMP, FROMCH, NUMCHAR, PAGEBUF, TOCH);                    PAGE 
      IF LININDX GR LASTLN  THEN LASTLN = LININDX;
      IF (NUMCHAR EQ 10  OR  FROMCH NQ 0)  THEN GOTO TDP40; 
      TOCH = 1; 
      FROMCH = NUMCHAR; 
      NUMCHAR = 10 - NUMCHAR; 
      K = K + 1;
      TOWD = 1; 
      GOTO TDP30; 
 TDP40:  # CHECK IF ANOTHER ENTRY IN REPORTLIST # 
      I = I+1;
      IF I LQ J  THEN GOTO TDPMOVE; 
      GOTO TDP[TEMP];    # LEAVE IF NOT # 
  
      CONTROL EJECT;
 # THIS PROC IS CALLED TO RE-ARRANG SECTIONS WHICH HAVE BEEN STORED AS# 
 # HORIZONTAL SECTIONS SO THAT THEY ARE NOW STORED AS VERTICAL SECTNS#
  PROC VERTMOV; 
BEGIN 
      ARRAY DTLBIT [0:MAXSECTS];  ITEM DLBIT; 
 # IF MAXLINE IS GR 60, SIZE OF DTLBIT MUST BE INCREASED #
      ITEM LINTOPAG B,   # TRUEIF MOVE IS FROM TIRELINE OR SAVLINE TO # 
                         # PAGE BUFFER, FALSE IF VICE VERSA # 
          DLINE,         #LINE OF DETAIL BEING MOVED #
          DSECTION,      # SECTION OF DETAIL BEING MOVED #
          LINBEYN,       # NO. OF LINES BEYOND FOR DETAIL ENTRY # 
          TLINUSE,       # FLAG TO TELL IF MOVE FROM TIRELINE (1 OR 2) #
                         # OR FROM SAVLINE (3 OR 4) # 
          NEWD,          # DETAIL BEING MOVED OUT OF PAGE BUFFER #
          OLDD,          # DETAIL BEING MOVED INTO PAGE BUFFER #
          NEWSECT,       # SECTION OF NEWD #
          NEWLIN,        # LINE OF NEWD (STARTING FROM 0) # 
          TOTLINES,      # NUMBER OF LINES INTO WHICH DETAILS WERE STORE
                         STORED, NOT COUNTING LINES BEYOND #
          NEWBIT B,      # FLAG SET TO TRUE IF MUST GET A NEW DETL LOOP#
          ID, JD; 
 # INITIALIZE VARIABLES.  SEND DIAGNOSTICS IF WRONG CONDITIONS #
      B<0,1>DLBIT[0] = 1; 
          LINBEYN = LINENUMBER[DETRPTLS]; 
      IF DTLCTR GR 60*MAXSECTS  THEN  BEGIN    DIAG (611);
         DTLCTR = 60*MAXSECTS;   END
      TOTLINES = (LASTDETLN - NOTDETLN) / LINBEYN;
      OLDD = 1;     # BEGIN BY MOVING 2D DETAIL#
 VT10:         # MOVE FIRST DETAIL OF STRING #
      NEWBIT = FALSE; 
      TLINUSE = 4;       # MOVE IT INTO SAVLINE ARRAY # 
      DLINE = OLDD / PSSECTION; 
      DSECTION = OLDD -  DLINE * PSSECTION; 
      LINTOPAG = FALSE; 
      VMOVSECT;                                                          PAGE 
      TLINUSE = 2;
 VT30:   NEWSECT = OLDD / TOTLINES; #COMPUTE NEWD POSITION# 
      NEWLIN = OLDD - NEWSECT * TOTLINES; 
      NEWD = NEWLIN * PSSECTION + NEWSECT; #COMPUTE NEWD NUMBER#
      IF NEWD GQ DTLCTR THEN GOTO VT50; 
      ID = NEWD / 60; 
      JD = NEWD - 60 * ID;
      IF B<JD,1>DLBIT[ID] EQ 1  THEN GOTO VT50; 
 # IF DETAIL EXISTS AND HAS NOT ALREADY BEEN MOVED, # 
 # MOVE IT OUT TO A LINE BUFFER # 
      LINTOPAG = FALSE; 
      DLINE = NEWLIN; 
      DSECTION = NEWSECT; 
      VMOVSECT;                                                          PAGE 
      GOTO VT60;
 # SET NEWBIT FLAG IF DETAIL ALREADYMOVED OR NONEXISTENT #
 VT50:  NEWBIT = TRUE;
      IF TLINUSE EQ 4  THEN TLINUSE = 1;
         ELSE TLINUSE = TLINUSE + 1;
 VT60:   # MOVE SAVED DETAIL, FROM OLDD POSITN, TO NEW POSITN # 
      DLINE = NEWLIN; 
      DSECTION = NEWSECT; 
      LINTOPAG = TRUE;
      VMOVSECT;                                                          PAGE 
 # SET BIT TO SHOW OLDD WAS MOVED # 
      ID = OLDD / 60; 
      JD = OLDD - 60 * ID;
      B<JD,1>DLBIT[ID] = 1; 
 # IF NEWD WAS ALREADY MOVED, GO SEARCH FOR UNMOVED DETAIL #
      IF NEWBIT  THEN GOTO VT200; 
 # ELSE GO TO NEXT DETAIL IN LOOP # 
      OLDD = NEWD;
      GOTO VT30;
 # SEARCH DTLBIT ARRAY FOR UNSET BIT, WHICH STANDS FOR #
 # AN UNMOVED DETAIL ENTRY #
 VT200:   FOR ID = 0  STEP 1  UNTIL MAXSECTS  DO
           FOR JD = 0  STEP 1 UNTIL 59  DO
             IF B<JD,1> DLBIT[ID] EQ 0  THEN BEGIN
                  OLDD = 60 * ID + JD;
                  IF OLDD LS DTLCTR  THEN GOTO VT10;
                  GOTO VT220;   END 
 VT220:   # ALL DETAILS MOVED, RETURN FROM PROC # 
 # MOVE BLANKS INTO EMPTY POSITIONS # 
      FOR ID = 0  STEP 1 UNTIL (SECTWID + 9) / 10   DO
        SVLIN [ID] = BLK; 
      FOR ID = DTLCTR  STEP 1  UNTIL (PSSECTION * TOTLINES  - 1)  DO
        BEGIN  DSECTION = ID / TOTLINES;
          DLINE = ID -  DSECTION * TOTLINES;
          LINTOPAG = TRUE;
          TLINUSE = 3;
          VMOVSECT;                                                      PAGE 
        END 
      DTLCTR = 0; 
      FOR ID = 0  STEP 1  UNTIL MAXSECTS  DO
        DLBIT[ID] = 0;
      RETURN; 
   PROC VMOVSECT; 
 BEGIN
 # THIS PROC MOVES A SECTION (SECTWID COLUMNS) TO OR FROM A LINE BUFFER#
 # IF LINTOPAG IS TRUE, THE MOVE IS FROM THE LINE BUFFER TO THE PAGE #
 # BUFFER.  IF LINTOPAG IS FALSE, MOVE FROM THE PAGE BUFFER TO THE #
 # LINE BUFFER.  IF TLINUSE IS 1 OR 2, THE MOVE REFERENCES TIRELINE # 
 # IF TLINUSE IS 3 OR 4, THE MOVE REFERENCES SAVLINE.  TLINUSE IS # 
 # INCREMENTED, AND SET BACK TO 1 IF IT EXCEEDS THE VALUE 4. #
 # DLINE IS THE LINE NUMBER OF THE PAGE POSITION, RELATIVE TO # 
 # NOTDETLN AND NOT CONSIDERING LINES BEYOND.  DSECTION IS THE #
 # SECTION NUMBER OF THE PAGE POSITION.  BOTH DLINE AND DSECTION #
 # ARE COUNTED FROM ZERO. # 
      BASED ARRAY VFROM;; 
      BASED ARRAY VTO;; 
      ITEM VCOLUMN, VL, VP, VTOT, VK, VR, VQ, VTOCH, VFRCH, VM; 
 # TEST TLINUSE TO SEE WHICH LINE BUFFER TO REFERENCE # 
      VM = LOC(TIRELINE); 
      IF TLINUSE GQ 3  THEN VM = LOC(SAVLINE);
      TLINUSE = TLINUSE + 1;
      IF TLINUSE GR 4  THEN TLINUSE = 1;
      VCOLUMN = SECTWID * DSECTION  + 1;
      VL = 1; 
      VP = SECTWID; 
      VTOT = 0; 
      DLINE = (DLINE + 1) * LINBEYN  +  NOTDETLN; 
 VMOV10:  VK = 1 +  VCOLUMN / MAXHDWC;
      IF (VCOLUMN + VP) GR  VK * MAXHDWC  THEN
        VP = VK * MAXHDWC  - VCOLUMN + 1; 
      VTOT = VTOT + VP; 
      VQ = VCOLUMN - (VK - 1) * MAXHDWC;
      VR = VQ / 10; 
      VQ = VQ  - VR * 10; 
      IF LINTOPAG  THEN BEGIN 
        P<VFROM> = VM;
        P<VTO> = LOC (RPAGE [VR+1, DLINE, VK] );
        VFRCH = VL; 
        VTOCH = VQ;     END 
      ELSE BEGIN
        P<VTO> = VM;
        P<VFROM> = LOC (RPAGE [VR+1, DLINE, VK] );
        VFRCH = VQ; 
        VTOCH = VL;    END
      CMOVE(VFROM, VFRCH, VP, VTO, VTOCH);                               PAGE 
      VCOLUMN = VCOLUMN + VP; 
      VL = VP / 10; 
      VM = VM + VL; 
      VL = VP -  VL * 10  + 1;
      VP = SECTWID - VTOT;
      IF VTOT GQ SECTWID  THEN   RETURN;
      GOTO VMOV10;
 END
 END
  # END OF PROC VERTMOV # 
      CONTROL EJECT;
 # THIS PROC IS CALLED IF ONCEFLG IS SET.  USING THE REPORTLIST ENTRY # 
 # FOR THE LAST DETAIL PRINTED, ANY FIELDS FOR WHICH THE ONCE BIT IS  # 
 # SET ARE COMPARED AGAINST THE SAME FIELD IN THE DETAIL LINE ABOVE.  # 
 # IF THE TWO FIELDS ARE IDENTICAL, THE FIELD IN THE LOWER LINE IS    # 
 # BLANKED OUT.  IT IS ASSUMED THAT ALL FIELDS ARE -AT LINE INTEGER  #
 # BEYOND-.  THE ARRAY SAVLINE IS USED TO SAVE PARAMETERS FOR COMPARISN#
 # OF FIELDS.  MXLINBEY IS THE NUMBER OF LINES BETWEEN  DETAIL ENTRIES #
       PROC CHKONCE;    BEGIN 
      ITEM CURRDETLN,      # CURRENT DETAIL LINE #
           MXLINBEY,       # NO. OF LINES BETWEEN DETAILS # 
           CURRLIN,    # CURRENT LINE IN COMPARE ROUTINE #
           LINABOV;    #PREVIOUS LINE IN COMPARE ROUTINE #
      BASED ARRAY DETHDR; 
         ITEM  DETFIRST I(0,24,12),    DETLAST I(0,36,12),
               DETLNBEY I(0,17,7);
 # #
      P<DETHDR> = HEADPOINTER [DETRPTLS]; 
      MXLINBEY = DETLNBEY [0];
      CURRDETLN = NOTDETLN + (DTLCTR-1) * MXLINBEY; 
          DTLCTR = 0; 
      L = DETFIRST [0]; 
      N = DETLAST [0];
      FOR J=0                      # USE SAVLINE[0] THROUGHOUT         #
      WHILE CURRDETLN GR NOTDETLN  # CHECK EACH LINE OF THE PAGE       #
      DO
        BEGIN 
        IF (CURRDETLN + MXLINBEY) GR PSLINE  # IF THE DETAIL WOULD     #
                                             # EXTEND PAST PAGE SIZE   #
        THEN
          BEGIN 
          CURRDETLN = CURRDETLN - MXLINBEY;  # COMPARE NEXT LINE       #
          TEST J;                  # AVOID *ONCE* PROCESSING OUTSIDE   #
                                   # OF THE PAGE BUFFER.               #
  
          END 
  
 # SET UP SAVLINE ARRAY AS TABLE OF FIELDS TO COMPARE # 
      FOR I = L  STEP 1 UNTIL N  DO BEGIN 
        IF ONCE [I]  THEN BEGIN 
          SAVPARAM;                                                      PAGE 
          ONCECPR;                 # CHECK FOR IDENTICAL FIELDS        #
          END 
        END                        # I LOOP                            #
      CURRDETLN = CURRDETLN - MXLINBEY;  # COMPARE NEXT LINE           #
      END                          # J LOOP                            #
      RETURN; 
                                                                         PAGE 
                                                                         PAGE 
                                                                         PAGE 
                                                                         PAGE 
#----------------------------------------------------------------------# PAGE 
                                                                         PAGE 
 # THIS  LITTLE PROC PICKS UP  INFORMATION FROM THE REPORTLIST ENTRY #
 # AT INDEX I AND STORES IT INTO SAVLINE AT INDEX J                  #
      PROC SAVPARAM;    BEGIN 
      SAVCHAR [J] = TOCHAR [I];         SAVLENG [J] = CHARLENGTH [I]; 
      SAVADDR [J] = TOADDRESS [I];      SAVLINBR [J] = LINENUMBER [I];
      RETURN;      END
                                                                         PAGE 
                                                                         PAGE 
                                                                         PAGE 
                                                                         PAGE 
#----------------------------------------------------------------------# PAGE 
                                                                         PAGE 
 # THIS PROC PERFORMS COMPARISON BETWEEN 2 DETAIL LINE FIELDS. #
 # IF IDENTICAL, THE FIELD IS BLANKED OUT IN THE LOWER DETAIL  #
 # LINE.    J IS AN INDEX INTO THE SAVLINE ARRAY, WHERE THE    #
 # LINE POSITION, STARTING WORD AND CHAR AND CHAR FIELD LENGTH #
 # ARE STORED.  MXLINBEY IS THE NBR OF LINES BETWEEN THE TWO   #
 # FIELDS.  CURRDETLN MUST POINT TO THE ZERO LINE OF THE LOWER #
 # DETAIL (IN EFFECT, THE LAST LINE OF THE PREVIOUS DETAIL).   #
  PROC ONCECPR;      BEGIN
      ITEM ONBLFLG B; 
 # #
      PTOT = 0;    ONBLFLG = FALSE; 
      CURRLIN = CURRDETLN + SAVLINBR [J]; 
      LINABOV = CURRLIN - MXLINBEY; 
 ONCPR05:    FROMCH = SAVADDR [J] * 10  +  SAVCHAR [J]; 
      NUMCHAR = SAVLENG [J];
ONCPR10:   K = 1 + (FROMCH+1) / MAXHDWC;
      IF (FROMCH + NUMCHAR + 1)  GR  K * MAXHDWC   THEN 
         NUMCHAR = K * MAXHDWC  -  FROMCH;
      PTOT = PTOT + NUMCHAR;
      TOCH = FROMCH - (K-1) * MAXHDWC;
      TOWD = 1  +  TOCH / 10; 
      TOCH = TOCH  -  (TOWD - 1) * 10;
 ONCPR20:   M = 10 - TOCH;
      IF M GR NUMCHAR  THEN  M =NUMCHAR;
      IF ONBLFLG  THEN
         C<TOCH,M> RPAGE [TOWD, CURRLIN, K] = BLK;
      ELSE
         IF C<TOCH,M> RPAGE [TOWD, CURRLIN, K]  NQ
            C<TOCH,M> RPAGE [TOWD, LINABOV, K]  THEN GOTO CPRRETURN;
      NUMCHAR = NUMCHAR - M;
      TOCH = 0;   TOWD = TOWD + 1;
      IF  NUMCHAR NQ 0  THEN  GOTO ONCPR20; 
      IF PTOT GQ SAVLENG [J]  THEN  GOTO ONBLK; 
      FROMCH = FROMCH + NUMCHAR;
      NUMCHAR = SAVLENG [J]  -  PTOT; 
      GOTO ONCPR10; 
 ONBLK:     # BLANK-FILL LOWER LINE IF FIELDS IDENTICAL # 
      IF  NOT ONBLFLG  THEN BEGIN 
        ONBLFLG = TRUE; 
        GOTO ONCPR05;   END 
 CPRRETURN:   RETURN; 
 END
END 
      CONTROL EJECT;
# THIS PROC MOVES A FULL LINE INTO THE PRINT BUFFER # 
# M MUST POINT TO LOCATION OF LINE #
# (PSCOLUMN) CHARACTERS ARE MOVED # 
  PROC MOVLIN;
  BEGIN 
      L = 1;
      N = 0;
      NUMCHAR = MAXHDWC;
      FOR K=1 STEP 1 UNTIL NUMPRPG  DO BEGIN
      N = N + MAXHDWC;
      IF N GR PSCOLUMN  THEN
        NUMCHAR = PSCOLUMN - (K-1)*MAXHDWC; 
      R = 0;
      NCHAR = NUMCHAR;
      BCHAR = 1;
      PMOVE;                                                             PAGE 
      IF N GQ PSCOLUMN  THEN GOTO MOVLN10;
        L = L + MAXHDWC - (MXHDWPL-1)*10; 
        M = M + MXHDWPL - 1;
        END 
 MOVLN10: 
      IF LININDX GR LASTLN  THEN LASTLN = LININDX;
 # TAKE CARE OF CARRIAGE CONTROL FOR MULTIPLE PRINTER PAGES # 
      IF K NQ 1  THEN 
        FOR R = 2  STEP 1  UNTIL K  DO
          C<0,1> RPAGE [1, LININDX, R] = C<0,1> RPAGE [1, LININDX, 1];
      RETURN; 
  END 
# THIS PROC MOVES SECTWID COLUMNS INTO THE PRINT BUFFER AT XCOLUMN #
# M MUST POINT TO LOCATION OF INFORMATION TO BE MOVED # 
  PROC MOVSECT; 
  BEGIN 
      L = 1;
      P = SECTWID;
      PTOT = 0; 
 MSEC10: K = 1 + XCOLUMN/MAXHDWC; 
      IF (XCOLUMN+P) GR K*MAXHDWC  THEN 
        P = K*MAXHDWC - XCOLUMN + 1;
      PTOT = PTOT + P;
      Q = XCOLUMN - (K - 1) * MAXHDWC;
      R = Q/10; 
      Q = Q - R*10; 
      NCHAR = P;
      BCHAR = Q;
      PMOVE;                                                             PAGE 
      XCOLUMN = XCOLUMN + P;
      L = P / 10; 
      M = M + L;
      L = P -  L * 10  + 1; 
      P = SECTWID - PTOT; 
      IF PTOT LS SECTWID  THEN  GOTO MSEC10;
 # TAKE CARE OF CARRIAGE CONTROL FOR MULTIPLE PRINTER PAGES # 
      IF K NQ 1  THEN 
        FOR R = 2  STEP 1  UNTIL K  DO
          C<0,1> RPAGE [1, LININDX, R] = C<0,1> RPAGE [1, LININDX, 1];
      RETURN; 
  END 
      PROC PMOVE; 
 # THIS PROC PERFORMS A CHARACTER BY CHARACTER MOVE OF THE DATA # 
 # IN THE LINE POINTED TO BY M (WORD POSITION) AND L (CHAR POSITN) #
 # TO THE LINE IN THE PAGE POINTED TO BY RPAGE [R+1, LININDX, K] #
 # NCHAR IS THE NUMBER OF CHARACTERS TO BE MOVED, AND BEGCHAR IS #
 # THE CHARACTER POSITION IN THE WORD IN RPAGE.  THE ITEM LOCRPT #
 # MUST POINT TO THE CURRENT REPORTLIST ENTRY. #
 # AT LEAST ONE CHARACTER IS ALWAYS MOVED. #
 #  # 
 BEGIN
      ITEM  IX, KX, JX, LX; 
      P<BASTEMP> = LOC( RPAGE[R+1 , LININDX , K] ); 
      P<PAGEBUF> = M; 
      IX = CALLTYPE [LOCRPT]; 
 # CHECK IF LINE IS DETAIL, FOOTING, OR RECAP # 
 # OR HEADING       # 
      IF (IX NQ 4) AND (IX LS 6)  THEN GOTO PM10; 
 # IF NOT, CALL CMOVE AND RETURN #
      CMOVE(PAGEBUF, L, NCHAR, BASTEMP, BCHAR);                          PAGE 
 PMRETURN:          # *****  RETURN  ***** #
      RETURN; 
 # IF SO, BEGIN CHECKING CHARACTERS . . . # 
# MOVE TO PAGE BUFFER ONLY IF CURRENT CHARACTER IN PAGE IS BLANK #
 # AND CHARACTER TO BE MOVED INTO PAGE IS NOT BLANK # 
 PM10:  LX = L;       #CHAR POSITN IN PAGE BUFFER # 
      KX = BCHAR;       # WORD POSITN OF NEW DATA # 
      JX = 1;            #WORD POSITN IN PAGE BUFFER #
      IX = 0;            #WORD POSITION OF NEW DATA # 
 PM20:  IF C<LX,1> PAGEWD [JX,1]  NQ  " "  THEN BEGIN 
          IF C<KX,1> BTEMP[IX]  EQ  " " THEN
            C<KX,1> BTEMP[IX] = C<LX,1> PAGEWD[JX,1]; 
 # ERROR IF BOTH NEW DATA AND OLD DATA ARE NOT BLANK #
          ELSE                                                          000240
          IF C<KX,1> BTEMP[IX]  NQ  C<LX,1> PAGEWD[JX,1] THEN 
            BEGIN 
            C<KX,1> BTEMP[IX] = "*" ; 
            DIAGFLG = TRUE; 
            END 
      END 
      NCHAR = NCHAR - 1;        # TEST IF ALL CHARS MOVED # 
      IF NCHAR LQ 0  THEN GOTO PM30;
      LX = LX +1; 
      IF LX GQ 10  THEN BEGIN 
        LX = 0;  JX = JX + 1;    END
      KX = KX + 1;
      IF KX GQ 10  THEN BEGIN 
        KX = 0;  IX = IX + 1;    END
      GOTO PM20;
 # METHOD OF DIAGNOSING ERRORS MUST BE CHANGED LATER #
   PM30: # #                                                            001500
      GOTO PMRETURN;
 END
      CONTROL EJECT;
      XDEF PROC PGINIT; 
      PROC PGINIT(GROUPID); 
      BEGIN 
      ITEM GROUPID;                # CMM GROUP ID FOR REPORT MEMORY    #
 # THIS PROC PERFORMS INITIALIZATION TASKS FOR PAGE.  IT IS    #
 # CALLED AT THE BEGINNING OF REPORT EXECUTION.  ITS PRIMARY   #
 # TASK IS TO SET UP FETS, NEEDED IF THE PAGE-SIZE IS GREATER  #
 # THAN ONE PRINTER PAGE, AND PRINTSQ IS NOT ZERO.             #
 # RESET FLAG DIAGNOSING OVERLAPPING HEADING FIELDS # 
                                   # ALLOCATE REPORT BUFFER            #
      P<RPTPAGE> = CMM$ALF(MXHDWPL*MAXLINE*NUMPRPG, 0, GROUPID);
      OVERLAPFLAG = FALSE;
      IF PSSECTION EQ 1  THEN PSHORVER = 0; 
      PAGEWID = PSCOLUMN * PSIMAGE; 
 # CALCULATE NBR OF PRINTER PAGES REQUIRED FOR ONE REPT PAGE  # 
      PRTPG = (PAGEWID + MAXHDWC - 1)  / MAXHDWC; 
      IF PRTPG EQ 1  OR  PRINTSQ EQ 0  THEN RETURN; 
 # SET UP NAMES FOR FILES FOR EXTRA PAGES # 
      TEMP = "ZZZZZQ3   ";
      M = B<36,6> TEMP; 
      IF PRTPG GR 7  THEN  PRTPG = 7; 
      P<RPFET> = CMM$ALF(PRTPG*5-5,0,0);
      FOR K = 2  STEP 1  UNTIL PRTPG  DO BEGIN
        M =  M + 1; 
      B<36,6> TEMP = M; 
        RPFNM [K] = B<0,42> TEMP; 
       RPFIRST [K] = LOC (RPAGE [1, 1, K] );
        RPLIMIT [K] = LOC ( RPAGE [MXHDWPL, MAXLINE, K] ) + 2;
        RPIN [K] = LOC ( RPAGE [1, 1, K] ); 
        RPOUT [K] = LOC (RPAGE [1, 1, K]);
        RPSTAT [K] = 1; 
      END 
      IF PRTPG GR 1  THEN BEGIN 
 # REWIND FILES FOR MULTIPLE PRINT PAGES #
      FOR K = 2  STEP 1 UNTIL PRTPG  DO BEGIN 
      RPSTAT[K] = O"50";
      REQCIO;                                                            PAGE 
      END 
      END 
       RETURN;
    END 
      CONTROL EJECT;
 # THIS PROC WRITES OUT A PAGE WHICH SAYS - END OF REPORT -  #
 # IT IS CALLED AT THE COMPLETION OF REPORT PROCESSING #
  ENTRY PROC PGEND;  BEGIN
      ARRAY ENDREPORT [1:3];
        ITEM ENDLN C(0,0,10) = [ " **  END O", "F REPORT  ",
                                 "        **" ];
      FOR K = 0  STEP 1  UNTIL MAXWPL DO
        TRLINE [K] = BLK; 
 # CENTER END-OF-REPORT  IN PAGE LINE # 
      IF PSCOLUMN GR MAXHDWC  THEN  L = MAXHDWC;
        ELSE L = PSCOLUMN;
      IF L LS 21  THEN  L = 0;
        ELSE L = (L - 21) / 20; 
      P<FIT> = LOC(RPTFIT);                                              CHANGES
      B<0,42>TEMP = FITLFN;                                              CHANGES
      FOR K = 36 STEP  -6  UNTIL 6  DO
        IF B<K,6> TEMP NQ 0  THEN GOTO PGENA; 
 PGENA:  K = K + 6; 
      B<0,K> ENDLN [3] = B<0,K> TEMP; 
      FOR K = 1  STEP 1  UNTIL 3  DO       # PUT IN REPORT NAME#
       TRLINE [K + L - 1]  =  ENDLN [K];
      L = (L + 3) * 10; 
      B<0,6> TRLINE [0] = O"34";          # PUT IN PAGE EJECT # 
      RPTFITES [0] = 0; 
      P<PAGEBUF> = LOC (TIRELINE[0] );
      P<FET> = LOC(RPTFIT);                                              CHANGES
      WRITEH(FET,PAGEBUF,MXHDWPL); # WRITE LINE TO REPORT              #
  # GIVE WARNING DIAGNOSTICS IF ERROR CONDITIONS #
      IF OVERLAPFLAG THEN DIAG (228 ) ; 
      IF DIAGFLG                                                         PAGE 
      THEN                                                               PAGE 
        BEGIN                                                            PAGE 
        DIAG(603);                                                       PAGE 
        END                                                              PAGE 
                                                                         PAGE 
      IF ONDIAG                                                          PAGE 
      THEN                                                               PAGE 
        BEGIN                                                            PAGE 
        DIAG(612);                                                       PAGE 
        END                                                              PAGE 
                                                                         PAGE 
      ONDIAG = FALSE;    DIAGFLG = FALSE; 
      OVERLAPFLAG = FALSE;
 # IF FILES HAVE BEEN WRITTEN FOR MULTIPLE PRINTER PAGES,       # 
 # READ EACH FILE IN AND PRINT IT ON REPORT FILE                # 
      IF PRINTSQ EQ 0 OR PRTPG LQ 1  THEN RETURN; 
 # REWIND FILES FOR MULTIPLE PRINT PAGES #
      FOR K = 2  STEP 1 UNTIL PRTPG  DO BEGIN 
      REQCIO;                                                            PAGE 
      REWND(RPFET[K], RA0);        # REWIND THIS SCRATCH FET           #
      END 
      FOR K = 2  STEP 1  UNTIL PRTPG  DO BEGIN
        TEMP = RPFIRST [K]; 
 PE30:  RPIN [K] = TEMP;
      RPOUT [K] = TEMP; 
      RPSTAT [K] = O"10"; 
      REQCIO;                                                            PAGE 
      P<PAGEBUF> = LOC ( RPAGE [1, 1, K] ); 
      I = RPIN[K] - RPOUT[K]; 
      IF I EQ 0  THEN GOTO PE80;
      RPTFITES [0] = 0; 
      P<FET> = LOC(RPTFIT);                                              CHANGES
      WRITEW(FET,PAGEBUF,I);       # WRITE BUFFERFUL TO REPORT FILE    #
      GOTO PE30;
 PE80:  IF ( (RPSTAT[K] LAN O"37000" ) NQ O"1000" ) 
           THEN GOTO PE30;
 # IF END OF FILE, PRINT OUT END-OF-REPORT LINE # 
      P<PAGEBUF> = LOC (TIRELINE[0]); 
      RPTFITES[0] = 0;
      P<FET> = LOC(RPTFIT);                                              CHANGES
      WRITEH(FET,PAGEBUF,L);
  # RETURN ZZZZZQN FILES #
      RPIN [K] = TEMP;  RPOUT [K] = TEMP; 
      RPSTAT[K] = O"174"; 
      REQCIO;                                                            PAGE 
        END 
      CMM$FRF(LOC(RPFET));
      RETURN; 
  END 
 # THIS PROC PUTS THE RPFET ADDRESS IN CIOCL AND PUTS CIOCL IN RA+1.   #
 # RETURN WHEN COMPLETE BIT IS SET IN RPFET STATUS.  K = RPFET INDEX.  #
      PROC REQCIO;   BEGIN
      P<BASTEMP> = 0; 
      CIOCL = $CIOP$ + P<RPFET> + (K - 2)*5;                             PAGE 
 RQC1:  IF BTEMP[1]  NQ  0 THEN GOTO RQC1;
      BTEMP[1] = CIOCL; 
 RQC2:   IF ( RPSTAT[K] LAN 1 ) EQ 0  THEN GOTO RQC2; 
      RETURN; 
      END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     W H A T S T E P                                                  #
#                                                                      #
# THIS PROC FORMATS THE NAME AND LEVEL OF A REPORT DIRECTIVE FOR USE   #
# IN A DIAGNOSTIC MESSAGE. -STEPLOC- IS THE INDEX INTO REPORTLIST FOR  #
# THE REPORT ENTRY, AND -STEPNAME- WILL HOLD THE LEFT-JUSTIFIED NAME   #
# AND LEVEL NUMBER.                                                    #
#----------------------------------------------------------------------#
  
      XDEF PROC WHATSTEP; 
      PROC WHATSTEP(STEPLOC, STEPNAME); 
      BEGIN 
      STATUS TYPE ERROR,           # 0 SHOULD NOT OCCUR                #
                  DETAIL,          # 1                                 #
                  HEADING,         # 2          THESE DESCRIBE THE     #
                  FOOTING,         # 3          POSSIBLE VALUES OF     #
                  TITLE,           # 4          -CALLTYPE-, AN ITEM    #
                  RECAP,           # 5          IN -REPORTLIST-.       #
                  DATE,            # 6                                 #
                  TIME,            # 7                                 #
                  PAGE$NUMBER;     # 8                                 #
      ITEM STEPLOC;                # INDEX INTO REPORTLIST FOR REPORT  #
                                   # ENTRY TO BE IDENTIFIED.           #
      ITEM STEPNAME C(10);         # WILL HOLD THE FORMATTED NAME OF   #
                                   # THE IDENTIFIED REPORTLIST ENTRY.  #
      ARRAY ATYPENAMES[1:8];
        BEGIN 
        ITEM TYPENAME C(0,0,8) = [ "DETAIL-",    # 1                   #
                                   "HEADING-",   # 2                   #
                                   "FOOTING-",   # 3                   #
                                   "TITLE",      # 4                   #
                                   "RECAP",      # 5                   #
                                   "DATE",       # 6                   #
                                   "TIME",       # 7                   #
                                   "PAGE-NO" ];  # 8                   #
  
        ITEM TYPENL I(0,48,12) = [ 7,        # 1 - DETAIL-             #
                                   8,        # 2 - HEADING-            #
                                   8,        # 3 - FOOTING-            #
                                   5,        # 4 - TITLE               #
                                   5,        # 5 - RECAP               #
                                   4,        # 6 - DATE                #
                                   4,        # 7 - TIME                #
                                   7 ];      # 8 - PAGE-NO             #
        END 
  
      I = CALLTYPE[STEPLOC];       # TEMP STORAGE OF THE VALUE         #
      STEPNAME = TYPENAME[I];      # CHOOSE A NAME FOR THE DIAGNOSTIC  #
      IF I GQ TYPE"DETAIL"
        AND I LQ TYPE"FOOTING"     # THIS DIRECTIVE HAS A LEVEL NUMBER #
      THEN
        BEGIN 
        I = TYPENL[I];             # NAME LENGTH OF NAME TO BE OUTPUT  #
                                   # INSERT DISPLAY CODE LEVEL NUMBER  #
        C<I,2> STEPNAME = BINDEC(LEVEL[STEPLOC], 2);
        IF C<I,2> STEPNAME EQ "00"
        THEN
          BEGIN 
          I = I - 1;
          C<I,3> STEPNAME = "   ";
          END 
        END 
  
      RETURN; 
      END 
  
  
  
   END
   TERM 
