*DECK PAGEF 
USETEXT DNTEXT
USETEXT RPTEXT
PROC PAGEF; 
          BEGIN 
  
          #PAGE FOOTING ROUTINE#
          #X# 
          #THIS ROUTINE#
          #- PERFORMS THE ANALYSIS REQUIRED BY THE RULES IN#
          #  6.13.5.9 TABLE 4 PF GROUP PRESENTATION RULES TABLE.# 
          #- IF POSSIBLE-#
          #   . ADDS AN ENTRY TO REPORT-GROUPS-TABLE (RGTLINK)# 
          #   . BUILDS# 
          #      -PFRGTABLE (PFRGLINK)# 
          #      -PFLNTABLE (PFLNLINK)# 
          #      -PFPLTABLE (PFPLLINK)# 
  
          ITEM
                 PFDIAGNO     I,
                 PFLINEREF    I,
                 INTPLTINDEX  I,
                 INTVALUE     I,
                 INTINDEX     I,
                 NEWPLTINDEX  I,
                 NLENGTH      I,
                 FPLPINT      I,
                 SUMREL       I,
                 LASTABS      I,
                 LNINDEX      I,
                 RLNINDEX     I,
                 LASTLINENUMB I,
                 AUXINDEX     I,
                 PLINTEGER    I,
                 BASEPFPLTABL I,
                 BASEPFLNTABL I,
                 BASEPFRGTABL I,
                 SAUXINDEX    I,
                 NEXTENTRYAUX I,
                 LSTABSPLTPTR I,
                 LASTINT      I,
                 INTEGERVALUE I,
                 USEDENTRYBIT I,
                 RGDNATPTR    I;
          DEF    M77         #77#;
          DEF    M78         #78#;
          DEF    M79         #79#;
          DEF    M80         #80#;
  
          DEF    INT1CONVERT   #INTVALUE = PLTCNVRT(INTPLTINDEX)#;
  
  
          ITEM   $TEMP$,
                $DUMMY$;
  
          XREF    PROC          SAUBCHANGE; 
          XREF   PROC         INTERCEPT;
          XREF   FUNC         PLTCNVRT I; 
          XREF   PROC         RWSET    ;
          XREF   PROC         RWSET1   ;
          XREF   PROC         GETNEXT  ;
          XREF   FUNC         RP$AUXPTR;
          XREF   FUNC         RWGET    ;
          XREF   FUNC         RWGET1   ;
  
          DEF    GET          #GETFIELD#; 
          DEF    SET          #SETFIELD#; 
          DEF    GETQ         #GETQUICK#; 
  
*CALL RPCOMM
*CALL GETSET
*CALL PLT1
*CALL PLTVALS 
*CALL PNAT1 
*CALL TABLNAMES 
  
  
  
          CONTROL EJECT;
  
          #INTERNAL PROCEDURE NO. 1  $S#
  
PROC RTPFDIAG;
          BEGIN 
  
          #PARAMETERS = PFDIAGNO# 
          #PFLINEREF# 
  
          ANALONLYRGRP = 1; 
          CALLDDIAG(PFLINEREF,PFDIAGNO);
          END #RTPFDIAG#
          CONTROL EJECT;
  
  
          #INTERNAL PROCEDURE NO. 3#
  
PROC CONST$NEWPLT;
          BEGIN 
          #THIS RT. CONSTRUCTS A NEW PLT ENTRY FOR/CONTAINING#
          #WHATEVER INTEGER IS CONTAINED IN INTEGERVALUE# 
          #ON ENTRANCE.IT LEAVES THE PLT INDEX OF THE NEW PLT ENTRY IN# 
          #NEWPLTINDEX  ON EXIT.# 
          ITEM VALUE; 
          ITEM LENGTH;
          ITEM REMAINS; 
          ITEM OUTDEX;
          ITEM C10       C(10); 
          ITEM CHARTEMP  C(10); 
          VALUE = INTEGERVALUE; 
          IF VALUE EQ 0 
          THEN
              BEGIN 
              LENGTH = 1; 
              C<0,1> CHARTEMP = "0";
              END 
          ELSE
              BEGIN 
              OUTDEX = 10;
              FOR LENGTH = 0 STEP 1 WHILE VALUE NQ 0 DO 
                  BEGIN 
                  OUTDEX = OUTDEX - 1;
                  REMAINS = VALUE / 10; 
                  C<OUTDEX,1> C10 = VALUE - 10 * REMAINS + O"33"; 
                  VALUE = REMAINS;
                  END 
              C<0,LENGTH> CHARTEMP = C<OUTDEX,LENGTH> C10;
              END 
          #INTEGER IS CONVERTED TO CHARACTER (LEFT JUSTIFIED)#
          SET(PL$LENGTH,PLT$,RPPLTOFFSET,LENGTH); 
          SET(PL$TYPE,PLT$,RPPLTOFFSET,PLTUNSGNILIT); 
          SET(PL$LINE,PLT$,RPPLTOFFSET,0);
          SET(PL$COLUMN,PLT$,RPPLTOFFSET,0);
          SETPLST(RPPLTOFFSET,LOC(CHARTEMP)); 
          NEWPLTINDEX = RPPLTOFFSET;
          RPPLTOFFSET = RPPLTOFFSET + 1;
          END #CONST$NEWPLT#
          CONTROL EJECT;
  
          #INTERNAL  PROCEDURE NO. 4# 
  
PROC GENRGPNAT; 
          BEGIN 
          #GEN A NEW PARAGRAPH NAME#
          LASTPNATINDX = LASTPNATINDX + 1;
          SET(PN$PREVSECTN,PNAT$,LASTPNATINDX,RPDUMSECTION);
          #SEE"ONCE-ONLY"SECTION# 
          #NOT A SOURCE STATEMENT ITEM# 
          END #GENRGPNAT# 
          CONTROL EJECT;
  
          #INTERNAL PROCEDURE NO. 5#
  
PROC PF3ALLN21; 
          BEGIN 
  
          #THIS PROCEDURE HANDLES RULES 3A, 1, 2  OF# 
          #TABLE 4- PAGE FOOTING PRESENTATION RULES.# 
  
          #RULE 3A (FPLP)#
          INTPLTINDEX = RWGET(RALINENUMPLT,RP$AUXPTR(INDX1STLN)); 
          INT1CONVERT;
          FPLPINT = INTVALUE; 
  
          #RULE 1 (UPPER LIMIT)#
          INTPLTINDEX = RWGET(FOOTINGPLT,RP$AUXPTR(CURRDDNAT) +1);
          INT1CONVERT;
          #CONVERT  FOOTING#
          IF FPLPINT GQ (INTVALUE + 1)
          THEN
              GOTO PFCOMPUTELLN;
  
          #DIAGNOSTIC (M77  )#
          #FIRST LINE NUMBER ON WHICH PF REPORT GROUP CAN BE PRESENTED# 
          #IS 1 GREATER THAN INTEGER OF FOOTING PHRASE# 
  
          PFDIAGNO  = M77  ;
          PFLINEREF = INDX1STLN;
          RTPFDIAG; 
PFCOMPUTELLN: 
          #COMPUTE LASTLINENUMB, IE.- LINE NUMBER ON WHICH# 
          #FINAL PRINT LINE IS PRESENTED# 
  
          SUMREL = 0; 
          LASTABS = 0;
          FOR LNINDEX = (INDX1STLN + 1)  STEP 1 UNTIL LASTRGDNAT DO 
              BEGIN 
              IF RWGET(RALINENUMPLT,RP$AUXPTR(LNINDEX)) 
                  NQ  0 
              THEN
                  BEGIN 
                  IF RWGET(RAKINDLINENO,RP$AUXPTR(LNINDEX)) EQ ABSOLUTE 
                  THEN
                      LASTABS = LNINDEX;
                  ELSE
                      GOTO FO8NDRELATIV;
                  END 
              END 
          #IF FOUND ONLY ABSOLUTE LINE NUMBERS OR-# 
          #IF FOUND NO NEW LINE NUMBER SPEC"S#
          GOTO CLN2;
FO8NDRELATIV: 
          FOR RLNINDEX = LNINDEX STEP 1 UNTIL LASTRGDNAT DO 
              BEGIN 
              #WILL ASSUME ANY LN ENCOUNTERED TO BE RELATIVE# 
              IF RWGET(RALINENUMPLT,RP$AUXPTR(RLNINDEX))
                  NQ 0
              THEN
                  BEGIN 
                  INTPLTINDEX = RWGET(RALINENUMPLT,RP$AUXPTR(RLNINDEX));
                  INT1CONVERT;
                  SUMREL = SUMREL  + INTVALUE;
                  END 
              END 
CLN2: 
          IF LASTABS EQ 0 
          THEN
              BEGIN 
              LASTLINENUMB =  FPLPINT  +  SUMREL; 
              GOTO PFRULE2; 
              END 
  
          #ELSE-# 
          INTPLTINDEX = RWGET(RALINENUMPLT,RP$AUXPTR(LASTABS)); 
          INT1CONVERT;
          LASTLINENUMB = INTVALUE  + SUMREL;
  
          #RULE 2 (LOWER LIMIT)#
PFRULE2:  
          AUXINDEX = (RP$AUXPTR(CURRDDNAT) + 1);
          INTPLTINDEX = RWGET(PAGELIMITPLT,AUXINDEX); 
          INT1CONVERT;
          PLINTEGER = INTVALUE; 
          #(USED IN RULE 4A + 4B)#
          IF LASTLINENUMB  GR INTVALUE
              #PAGE LIMIT#
          THEN
              BEGIN 
  
              #DIAGNOSTIC (M78  )#
              #LINE SPECIFICATIONS FOR THIS PF REPORT GROUP CAUSE FINAL#
              #PRINT LINE TO EXCEED  PAGE LIMIT.# 
              PFDIAGNO  = M78  ;
              PFLINEREF = DNATPOINTER;
              RTPFDIAG; 
              END 
          END #PF3ALLN21# 
          CONTROL EJECT;
  
          #INTERNAL PROCEDURE NO. 6#
  
PROC PF4A;
          BEGIN 
  
          #THIS PROCEDURE HANDLES RULE 4A OF TABLE 4-#
          #PF PRESENTATION RULES.  (NEXT GROUP ABSOLUTE).#
          IF SVNGINTEGER GR  LASTLINENUMB 
              AND 
              SVNGINTEGER  LQ PLINTEGER 
              #PAGE LIMIT#
          THEN
              GOTO ENDPF4A; 
  
          #DIAGNOSTIC (M79  )#
          #NEXT GROUP INTEGER IN THIS PF REPORT GROUP MUST BE > FINAL#
          #LINE OF THE REPORT GROUP AND < PAGE LIMIT INTEGER.#
          PFDIAGNO  = M79  ;
          PFLINEREF = DNATPOINTER;
          RTPFDIAG; 
ENDPF4A:  
          END #PF4A#
          CONTROL EJECT;
  
          #INTERNAL PROCEDURE NO. 7#
  
PROC PF4B;
          BEGIN 
  
          #THIS PROCEDURE HANDLES RULE 4B OF TABLE 4 -# 
          #PF PRESENTATION RULES. (NEXT GROUP RELATIVE)#
  
          IF (SVNGINTEGER  + LASTLINENUMB)
              GR PLINTEGER
          THEN
              BEGIN 
  
              #DIAGNOSTIC (M80  )#
              #SUM OF NEXT GROUP INTEGER AND NUMBER OF FINAL PRINT LINE#
              #OF THIS PF REPORT GRP MUST NOT BE > PAGE LIMIT INTEGER.# 
              PFDIAGNO  = M80  ;
              PFLINEREF = DNATPOINTER;
              RTPFDIAG; 
              END 
          END #PF4B#
          CONTROL EJECT;
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EPTRACE("PAGEF  ")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          IF IPAGECLAUSPC EQ 0
          THEN
              GOTO ENDPFRT; 
          #AS DIAGNOSED IN TYPECLAUSERT,# 
          #IF PAGE CLAUSE IS NOT IN RD-ENTRY, A PAGE FOOTING# 
          #REPORT GROUP MAY NOT BE DEFINED# 
  
          IF RDOCURDSWTCH EQ 0
          THEN
              GOTO ENDPFRT; 
          #FUTILE TO ATTEMPT ANALYSIS OF# 
          #PRESENTATION RULES AS IS NO VALID CURRDDNAT# 
  
          IF SEQOFLN EQ NPR 
          THEN
              #IS AN ALREADY DIAGNOSED ERROR BUT WILL SET IT = AR#
              #TO ATTEMPT MORE POSSIBLY-HELPFUL ANALYSIS# 
              SEQOFLN  = AR;
  
          #BASED ON TABLE 4 -PAGE FOOTING GROUP PRESENTATION RULE TABLE#
  
          IF IPAGECLAUSPC EQ 1
          THEN
              BEGIN 
              IF SEQOFLN EQ NULL$LN 
              THEN
                  GOTO PFBLDTABLES; 
              IF SEQOFLN  NQ  AR
              THEN
                  GOTO ENDPFRT; 
              #AS DIAGNOSED IN LINENUMBERT,#
              #FIRST LINE NUMBER IN A PF REPORT GROUP MUST BE AN# 
              #ABSOLUTE  LN.# 
              IF SEQOFLN  EQ  AR
              THEN
                  BEGIN 
                  SWITCH PFNXTGRTYPE PFBLDTABLES,PF1CASE,PF2CASE, 
                                     PF3CASE,PF4CASE; 
                  GOTO PFNXTGRTYPE[TNEXTGROUP]; 
PF1CASE:  
                  #NG = ABSOLUTE# 
                      BEGIN 
                      PF3ALLN21;
                      PF4A; 
                      PFFINALLCSET = SVNGINTEGER; 
                      #FOR RF PRESENTATION RULES# 
                      GOTO PFBLDTABLES; 
                      END 
PF2CASE:  
                  #NG = RELATIVE# 
                      BEGIN 
                      PF3ALLN21;
                      PF4B; 
                      PFFINALLCSET = SVNGINTEGER + LASTLINENUMB;
                      GOTO PFBLDTABLES; 
                      END 
PF3CASE:  
                  #NG = NEXT PAGE#
                      GOTO ENDPFRT; 
                  #CAN"T HAVE NG = NP  ALREADY DIAGNOSED# 
PF4CASE:  
                  #NG = NULL# 
                      BEGIN 
                      PF3ALLN21;
                      PFFINALLCSET = LASTLINENUMB;
                      GOTO PFBLDTABLES; 
                      END 
                  END 
              END 
          #***************************************# 
  
PFBLDTABLES:  
  
          #DETERMINE IF IT IS POSSIBLE OR WORTHWHILE TO BUILD#
          #ANY TABLES FOR THIS REPORT GROUP OR REPORT#
  
          IF ANALONLYREPT EQ 1
              OR
              ANALONLYRGRP  EQ 1
          THEN
              GOTO ENDPFRT; 
          #**                           *#
          #BUILD PFPLLINK#
  
          IF SEQOFLN  EQ NULL$LN
          THEN
              GOTO BPFRGTABLE;
              #WILL NOT BUILD PFPLLINK# 
              #NOR       PFLNLINK#
          BASEPFPLTABL = NEXTPFPLPTR; 
          USEDENTRYBIT  =  0; 
          GETNEXT(PFPLLINK);
          #WILL HAVE TO HAVE ENTRY FOR DELIMITERS EVEN IF ARE#
          #NO PRINTABLE ITEMS - SO THAT CAN PRINT A LINE OF#
          #BLANKS#
  
          IF INDX1STLN LS FIRSTF3OR4DE
          THEN
              $TEMP$ = FIRSTF3OR4DE;
          ELSE
              $TEMP$ = INDX1STLN; 
          FOR RGDNATPTR = $TEMP$ STEP 1 UNTIL LASTRGDNAT DO 
              BEGIN 
              AUXINDEX = RP$AUXPTR(RGDNATPTR);
              RWSET1(PL$DNATPF  #CURRPFPLPTR#,0); 
              IF RWGET(RAPRINTABLEB,AUXINDEX) EQ 0
              THEN
                  GOTO PFPL2; 
              #ELSE PUT PRINTABLE ITEM INTO PFPLLINK# 
              USEDENTRYBIT = 1; 
              RWSET1(ALLVALUE$PF  #CURRPFPLPTR#,0); 
              RWSET1(SISOURCE$PF  #CURRPFPLPTR#,0); 
              RWSET1(PL$DNATPF  #CURRPFPLPTR#,RGDNATPTR); 
              RWSET1(PL$PF$DELIM  #CURRPFPLPTR#,0); 
              IF RWGET(RASOURCEBIT,AUXINDEX) EQ 1 
              THEN
                  BEGIN 
                  RWSET1(ITEMTYPEPF  #CURRPFPLPTR#,1);
                  SAUXINDEX = 1 + AUXINDEX; 
                  IF RWGET(RASRCESIBIT,SAUXINDEX) EQ 1
                  THEN
                      BEGIN 
                      RWSET1(SISOURCE$PF  #CURRPFPLPTR#,1); 
                      RWSET1(PI$SOURCEPF  #CURRPFPLPTR#,SAUXINDEX); 
                      SAUBCHANGE(SAUXINDEX);
                      GOTO PFPL2; 
                      END 
                  $TEMP$ = RWGET(RASRCEIDNAT,SAUXINDEX);
                  RWSET1(PI$SOURCEPF  #CURRPFPLPTR#,$TEMP$);
                  GOTO PFPL2; 
                  END 
  
              #ELSE IF HAVE VALUE CLAUSE# 
  
              RWSET1(ITEMTYPEPF  #CURRPFPLPTR#,0);
              $TEMP$ = RWGET(RAVALULITPLT,1 + AUXINDEX);
              RWSET1(PI$SOURCEPF  #CURRPFPLPTR#,$TEMP$);
              IF RWGET(RAVALUALLIND,1 + AUXINDEX) EQ 1
              THEN
                  RWSET1(ALLVALUE$PF  #CURRPFPLPTR#,1); 
PFPL2:  
              IF RGDNATPTR EQ LASTRGDNAT
              THEN
                  BEGIN 
                  RWSET1(PL$PF$DELIM  #CURRPFPLPTR#,ENDREPORTGRP);
                  GOTO ENDPFPLDO; 
                  END 
  
              #ELSE CHECK IF NEXT ENTRY HAS A LINE NUMBER#
  
              NEXTENTRYAUX = RP$AUXPTR(RGDNATPTR + 1);
              IF RWGET(RA1LINENOPLT,NEXTENTRYAUX) EQ 0
              THEN
                  GOTO PFPL$EL; 
              RWSET1(PL$PF$DELIM  #CURRPFPLPTR#,ENDPRINTLINE);
              USEDENTRYBIT = 1; 
PFPL$EL:  
              IF USEDENTRYBIT EQ 0
              THEN
                  GOTO ENDPFPLDO; 
              USEDENTRYBIT = 0; 
              GETNEXT(PFPLLINK);
ENDPFPLDO:  
              END 
          #*************************************# 
          #BUILD PFLNLINK#
  
          BASEPFLNTABL = NEXTPFLNPTR; 
          LSTABSPLTPTR = 0; 
          LASTINT = 0;
          FOR RGDNATPTR = INDX1STLN STEP 1 UNTIL LASTRGDNAT DO
              BEGIN 
              AUXINDEX= RP$AUXPTR(RGDNATPTR); 
              IF RWGET(RA1LINENOPLT,AUXINDEX) 
                  NQ 0
              THEN
                  BEGIN 
                  GETNEXT(PFLNLINK);
                  IF RWGET(RA1KINDLINNO,AUXINDEX) EQ ABSOLUTE 
                  THEN
                      BEGIN 
                      $TEMP$ = RWGET(RALINENUMPLT,AUXINDEX);
                      RWSET1(ABSOLUT$LNPF  #CURRPFLNPTR#,$TEMP$); 
                      LSTABSPLTPTR = RWGET(RALINENUMPLT,AUXINDEX);
                      GOTO ENDPFLNDO; 
                      END 
  
                  #IF RELATIVE# 
                  IF LSTABSPLTPTR EQ  0 
                  THEN
                      GOTO CONV1REL;
                  INTPLTINDEX = LSTABSPLTPTR; 
                  INT1CONVERT;
                  LASTINT = INTVALUE; 
                  LSTABSPLTPTR = 0; 
CONV1REL: 
                  INTPLTINDEX = RWGET(RALINENUMPLT,AUXINDEX); 
                  INT1CONVERT;
                  LASTINT = LASTINT + INTVALUE; 
                  INTEGERVALUE = LASTINT; 
                  CONST$NEWPLT; 
                  RWSET1(ABSOLUT$LNPF  #CURRPFLNPTR#,NEWPLTINDEX);
                  END 
ENDPFLNDO:  
              END 
          #**************************************#
          #BUILD PFRGLINK#
  
BPFRGTABLE: 
          BASEPFRGTABL = NEXTPFRGPTR; 
          GETNEXT(PFRGLINK);
          RWSET1(RG$NAMEPF  #CURRPFRGPTR#,DNATPOINTER); 
          RWSET1(TYPEOFRGPF  #CURRPFRGPTR#,PF); 
          IF SEQOFLN EQ NULL$LN 
          THEN
              BEGIN 
              RWSET1(PFLN$BASE  #CURRPFRGPTR#,0); 
              RWSET1(PFPL$BASE  #CURRPFRGPTR#,0); 
              RWSET1(PFNXTGRUPIND  #CURRPFRGPTR#,0);
              RWSET1(PFNGINTPLTPT  #CURRPFRGPTR#,0);
              GOTO PFBRGSTABLE; 
              END 
          RWSET1(PFLN$BASE  #CURRPFRGPTR#,BASEPFLNTABL);
          RWSET1(PFPL$BASE  #CURRPFRGPTR#,BASEPFPLTABL);
  
          #SET UP NEXT GROUP# 
  
          RWSET1(PFNXTGRUPIND  #CURRPFRGPTR#,0);
          IF TNEXTGROUP EQ A
          THEN
              BEGIN 
              RWSET1(PFNXTGRUPIND  #CURRPFRGPTR#,AR); 
              $TEMP$ = RWGET(RANGINTPLT,RP$AUXPTR(DNATPOINTER)+ 1); 
              RWSET1(PFNGINTPLTPT  #CURRPFRGPTR#,$TEMP$); 
              END 
          IF TNEXTGROUP EQ R
          THEN
              BEGIN 
              INTEGERVALUE = LASTLINENUMB + SVNGINTEGER;
              CONST$NEWPLT; 
              RWSET1(PFNGINTPLTPT  #CURRPFRGPTR#,NEWPLTINDEX);
              RWSET1(PFNXTGRUPIND  #CURRPFRGPTR#,AR); 
              END 
          #********************************************#
          #BUILD RGTLINK ENTRY# 
  
PFBRGSTABLE:  
          GETNEXT(RGTLINK); 
          RWSET1(RGEOTDELIM  #CURRRPTGRPTR#,0); 
          RWSET1(RGTYPEOFRG  #CURRRPTGRPTR#,PF);
          RWSET1(RGBASERGTABL  #CURRRPTGRPTR#,BASEPFRGTABL);
          #GEN NEW PARAGRAPH NAMES# 
          GENRGPNAT;
          RWSET1(RGPARANAME1  #CURRRPTGRPTR#,LASTPNATINDX); 
          GENRGPNAT;
          SET(PN$PERFLAST,PNAT$,LASTPNATINDX,1);
          RWSET1(RGPARANAME2  #CURRRPTGRPTR#,LASTPNATINDX); 
ENDPFRT:  
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EXTRACE("PAGEF  ")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          END #PAGEF# 
          TERM
