*DECK PAGEH 
USETEXT DNTEXT
USETEXT RPTEXT
PROC PAGEH;  #CYR24#
          BEGIN 
  
          #PAGE HEADING ROUTINE#
          #X# 
          #THIS ROUTINE#
          #- PERFORMS THE ANALYSIS REQUIRED BY THE RULES IN#
          #6.13.5.7 TABLE 2  PH GROUP PRESENTATION RULE TABLE#
          #- IF POSSIBLE-  #
          #   .ADDS AN ENTRY TO REPORT-GROUPS-TABLE (RGTLINK)#
          #   .BUILDS                                        #
          #      -PHRGTABLE (PHRGLINK)                       #
          #      -PHLNTABLE (PHLNLINK)                       #
          #      -PHPLTABLE (PHPLTABLE)                      #
          #- SETS FLAGS                                      #
          #   .PHRHANALAARG                                  #
          #   .PHRHLOWLIMAN                                  #
          #   .BUILTPHTABLS                                  #
          #  FOR AFTER-ALL-REPORT-GROUPS-RT                  #
          ITEM
                 PHDIAGNO     I,
                 PHLINEREF    I,
                 INTPLTINDEX  I,
                 INTVALUE     I,
                 LASTABS      I,
                 RELINT       I,
                 RGDNATPTR    I,
                 AUXINDEX     I,
                 LLN          I,
                 FPLP         I,
                 BASEPHLNTABL I,
                 BASEPHPLTABL I,
                 BASEPHRGTABL I,
                 SAUXINDEX    I,
                 INTINDEX     I,
                 USEDENTRYBIT I,
                 NEXTENTRYAUX I;
          DEF    M75          #75#; 
          DEF    M76          #76#; 
          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 PNAT1 
*CALL TABLNAMES 
  
  
  
  
          CONTROL EJECT;
          #$S  ********************************#
          #INTERNAL PROCEDURE NO. 1#
  
PROC RTPHDIAG;
          BEGIN 
  
          #PARAMETERS = PHDIAGNO# 
          #PHLINEREF# 
  
          ANALONLYRGRP = 1; 
          CALLDDIAG(PHLINEREF,PHDIAGNO);
          END #RTPHDIAG#
          CONTROL EJECT;
  
  
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;
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EPTRACE("PAGEH  ")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          BUILTPHTABLS = 0; 
          IF IPAGECLAUSPC  EQ 0 
          THEN
  
          #IF PAGE CLAUSE IS NOT DESCRIBED  IN RD ENTRY, THEN A#
          #PAGE HEADING REPORT GROUP MAY NOT BE DEFINED. #
          #(CONDITION ALREADY DIAGNOSED IN TYPECLAUSERT) #
  
          GOTO ENDPHRT; 
          IF RDOCURDSWTCH EQ 0
          THEN
              GOTO ENDPHRT; 
          #FUTILE TO ATTEMPT ANALYSIS AS THERE# 
          #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 2 -PAGE HEADING GROUP PRESENTATION RULE TABLE#
          #*****# 
          IF SEQOFLN EQ NULL$LN 
          THEN
              GOTO PHBLDTABLES; 
          IF SEQOFLN EQ AR
          THEN
              BEGIN 
              INTPLTINDEX = RWGET(RALINENUMPLT,RP$AUXPTR(INDX1STLN)); 
              INT1CONVERT;
              #CONVERT 1ST ABSOLUTE LN INTEGER# 
              PHFPLP =  INTVALUE; 
              #THEN -#
              #IN ORDER THAT DO ANALYSIS OF RULE 1,PART A IN# 
              #AFTER-ALL-REPORT-GROUPS-RT, SET# 
              PHRHANALAARG = 1; 
              PHDIAGLINREF = DNATPOINTER; 
  
              #RULE 1B ANALYSIS#
  
              INTPLTINDEX = 
                  #FROM RD-CODE-ENTRY.# 
                  RWGET(HEADINGPLT,RP$AUXPTR(CURRDDNAT)); 
              INT1CONVERT;
              IF PHFPLP  LS INTVALUE
                  #HEADING# 
              THEN
                  BEGIN 
                  PHDIAGNO = M75  ; 
                  PHLINEREF =  INDX1STLN; 
                  RTPHDIAG; 
  
                  #DIAGNOSTIC (M75  )#
                  #FIRST PRINT LINE POSITION  OF PH VIOLATES UPPER# 
                  #LIMIT RULE OF TABLE 2 - PH PRESENTATION RULES.#
                  END 
  
              #RULE 2 ANALYSIS# 
  
              #COMPUTE LLN (LASTLINENUMB)#
              LASTABS = 0;
              #PLT-PTR# 
              RELINT = 0; 
              #INTEGER VALUE# 
              FOR RGDNATPTR = (INDX1STLN + 1) STEP 1 UNTIL LASTRGDNAT DO
                  BEGIN 
                  AUXINDEX = RP$AUXPTR(RGDNATPTR);
                  IF RWGET(RALINENUMPLT,AUXINDEX)  NQ  0
                  THEN
                      BEGIN 
                      IF RWGET(RAKINDLINENO,AUXINDEX)   EQ ABSOLUTE 
                      THEN
                          LASTABS = RWGET(RALINENUMPLT,AUXINDEX); 
                      ELSE
                          BEGIN 
                          #IF RELATIVE# 
                          INTPLTINDEX = RWGET(RALINENUMPLT,AUXINDEX); 
                          INT1CONVERT;
                          RELINT = RELINT +  INTVALUE;
                          END 
                      END 
                  END 
              IF LASTABS EQ 0 
              THEN
                  LLN = PHFPLP + RELINT;
              ELSE
                  BEGIN 
                  INTPLTINDEX = LASTABS;
                  INT1CONVERT;
                  LLN = INTVALUE  + RELINT; 
                  END 
  
              #COMPUTE  LOWER -LIMIT# 
              INTPLTINDEX = 
                  #FROM RD-CODE-ENTRY.# 
                  RWGET(F1STDTAILPLT,RP$AUXPTR(CURRDDNAT)); 
              INT1CONVERT;
              IF LLN GR (INTVALUE - 1)
                  #FIRST-DETAIL - 1#
              THEN
                  BEGIN 
ERM76:  
                  PHDIAGNO = M76  ; 
                  PHLINEREF = DNATPOINTER;
                  RTPHDIAG; 
  
                  #DIAGNOSTIC (M76  )#
                  #FIRST-DETAIL - 1 IS THE LAST LINE ON WHICH PH# 
                  #PRINT LINE CAN BE PRESENTED# 
  
                  GOTO ENDPHRT; 
                  END 
              GOTO PHBLDTABLES; 
              END 
  
          #ELSE IF SEQOFLN = R# 
  
          #NOTE - (FOR RULE 1 )#
          #THIS ANALYSIS AT FIRST LOOKED COMPLEX, BUT AFTER#
          #STUDY IT MELTED TO  NOTHING . ALL NECESSARY ANALYSIS#
          #CAN BE DONE IN THIS PAGE-HEADING ROUTINE - NO NEED TO# 
          #DO ANYTHING IN AFTER-ALL-REPORT-GROUPS-RT WHEN REPORT-#
          #HEADING INFO. WOULD BE AVAILABLE, BECAUSE# 
          #BY DEFINITION OF FPLP, THE UPPER LIMIT RULE CAN NEVER# 
          #BE BROKEN. (3A. AND 3B. CAN NEVER -BY DEFINITION-# 
          #VIOLATE RULE 1 -  SO NO NEED TO CALCULATE OR DO# 
          #COMPARATIVE ANALYSIS OF THEM.)#
          #X# 
          #X# 
          #THEREFORE WILL START WITH ANALYSIS OF# 
          #RULE 2. LOWER LIMIT RULE#
  
          INTPLTINDEX = RWGET(RALINENUMPLT,RP$AUXPTR(INDX1STLN)); 
          INT1CONVERT;
          FPLP = INTVALUE;
          INTPLTINDEX = 
              #FROM RD-CODE-ENTRY.# 
              RWGET(HEADINGPLT,RP$AUXPTR(CURRDDNAT)); 
          INT1CONVERT;
          FPLP = FPLP + (INTVALUE - 1); 
  
          #COMPUTE LAST LINE NUMBER (LLN) USING FPLP AS A BASE (WHICH#
          #IS  AT LEAST = HEADING)# 
  
          LLN = FPLP; 
          FOR RGDNATPTR = (INDX1STLN + 1) STEP 1 UNTIL LASTRGDNAT DO
              BEGIN 
              AUXINDEX = RP$AUXPTR(RGDNATPTR);
              IF RWGET(RALINENUMPLT,AUXINDEX) NQ 0
              THEN
                  BEGIN 
                  INTPLTINDEX = RWGET(RALINENUMPLT,AUXINDEX); 
                  INT1CONVERT;
                  LLN = LLN + INTVALUE; 
                  END 
              END 
          INTPLTINDEX = 
              #FROM RD-CODE-ENTRY.# 
              RWGET(F1STDTAILPLT,RP$AUXPTR(CURRDDNAT)); 
          INT1CONVERT;
          PHLOWERLIMIT = INTVALUE - 1;
          #FOR AARG CHECK#
          IF LLN GR (INTVALUE - 1)
              #LOWER LIMIT# 
          THEN
              GOTO ERM76  ; 
          #(KNOW THAT IN THIS CASE, IF# 
          #RH WAS PRESENTED ON SAME PAGE LOWER LIMIT WILL LIKEWISE# 
          #BE EXCEEDED AS RH CAN"T BE PRESENTED ON A LINE < HEADING#
          #ANYWAY.OTHERWISE WILL NEED TO TEST THE LOWER LIMIT RULE WHEN#
          #FPLP = RHFINALLCSET + INTEGER OF FIRST#
          #LINE NUMBER CLAUSE#
          #WITHIN THE AARG ROUTINE.)# 
  
          #ELSE HAVE TO SET UP FOR A LOWER LIMIT CHECK IN AARG# 
  
          PHDIAGLINREF = DNATPOINTER; 
          PHRHLOWLIMAN = 1; 
          PHSUMRELLINE = 0; 
          FOR RGDNATPTR = INDX1STLN  STEP 1 UNTIL LASTRGDNAT DO 
              BEGIN 
              AUXINDEX = RP$AUXPTR(RGDNATPTR);
              IF RWGET(RALINENUMPLT,AUXINDEX) NQ 0
              THEN
                  BEGIN 
                  INTPLTINDEX = RWGET(RALINENUMPLT,AUXINDEX); 
                  INT1CONVERT;
                  PHSUMRELLINE = PHSUMRELLINE + INTVALUE; 
                  END 
              END 
PHBLDTABLES:  
  
          #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 ENDPHRT; 
          BUILTPHTABLS = 1; 
          #***********************************************************# 
          #* NOTE -#
          #*  IT APPEARS THAT PRINT-LINE  TABLES FOR THE VARIOUS REPORT#
          #*  GROUPS COULD BE BUILT BY A COMMON RT.                    #
          #*  AFTER INITIAL CHECKOUT THIS CHANGE SHOULD BE IMPLEMENTED.#
          #*  IE.- FROM INDIVIDUAL TABLE BUILDING CODE TO A COMMON RT. #
          #*****************************# 
          #BUILD  PHPL TABLE# 
  
          IF SEQOFLN EQ NULL$LN 
          THEN
              #WILL NOT BUILD  PHPLLINK#
              #NOR   PHLNLINK#
              GOTO BPHRGTABLE;
          BASEPHPLTABL = NEXTPHPLPTR; 
          USEDENTRYBIT = 0; 
          GETNEXT(PHPLLINK);
          #WILL HAVE TO HAVE ENTRY(S) 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$DNATPH  #CURRPHPLPTR#,0); 
              IF RWGET(RAPRINTABLEB,AUXINDEX) EQ 0
              THEN
                  GOTO PHPL2; 
              #ELSE PUT PRINTABLE ITEM INTO PHPLLINK# 
              USEDENTRYBIT = 1; 
              RWSET1(ALLVALUE$PH  #CURRPHPLPTR#,0); 
              RWSET1(SISOURCE$PH  #CURRPHPLPTR#,0); 
              RWSET1(PL$DNATPH  #CURRPHPLPTR#,RGDNATPTR); 
              RWSET1(PL$PH$DELIM  #CURRPHPLPTR#,0); 
              IF RWGET(RASOURCEBIT,AUXINDEX) EQ 1 
              THEN
                  BEGIN 
                  RWSET1(ITEMTYPEPH  #CURRPHPLPTR#,1);
                  SAUXINDEX = 1 + AUXINDEX; 
                  IF RWGET(RASRCESIBIT,SAUXINDEX) EQ 1
                  THEN
                      BEGIN 
                      RWSET1(SISOURCE$PH  #CURRPHPLPTR#,1); 
                      RWSET1(PI$SOURCEPH  #CURRPHPLPTR#,SAUXINDEX); 
                      SAUBCHANGE(SAUXINDEX);
                      GOTO PHPL2; 
                      END 
                  $TEMP$ = RWGET(RASRCEIDNAT,SAUXINDEX);
                  RWSET1(PI$SOURCEPH  #CURRPHPLPTR#,$TEMP$);
                  GOTO PHPL2; 
                  END 
  
              #ELSE IF HAVE VALUE CLAUSE# 
  
              RWSET1(ITEMTYPEPH  #CURRPHPLPTR#,0);
              $TEMP$ = RWGET(RAVALULITPLT,1 + AUXINDEX);
              RWSET1(PI$SOURCEPH  #CURRPHPLPTR#,$TEMP$);
              IF RWGET(RAVALUALLIND,1 + AUXINDEX) EQ 1
              THEN
                  RWSET1(ALLVALUE$PH  #CURRPHPLPTR#,1); 
PHPL2:  
              IF RGDNATPTR EQ LASTRGDNAT
              THEN
                  BEGIN 
                  RWSET1(PL$PH$DELIM  #CURRPHPLPTR#,ENDREPORTGRP);
                  GOTO ENDPHPLDO; 
                  END 
  
              #ELSE CHECK IF NEXT ENTRY HAS A LINE NUMBER#
  
              NEXTENTRYAUX = RP$AUXPTR(RGDNATPTR + 1);
              IF RWGET(RA1LINENOPLT,NEXTENTRYAUX) EQ 0
              THEN
                  GOTO PHPL$EL; 
              RWSET1(PL$PH$DELIM  #CURRPHPLPTR#,ENDPRINTLINE);
              USEDENTRYBIT = 1; 
PHPL$EL:  
              IF USEDENTRYBIT EQ 0
              THEN
                  GOTO ENDPHPLDO; 
              USEDENTRYBIT = 0; 
              GETNEXT(PHPLLINK);
ENDPHPLDO:  
              END 
          #*****************************# 
          #BUILD PHLNLINK#
  
          BASEPHLNTABL = NEXTPHLNPTR; 
          FOR RGDNATPTR = INDX1STLN STEP 1 UNTIL LASTRGDNAT DO
              BEGIN 
              AUXINDEX = RP$AUXPTR(RGDNATPTR);
              IF RWGET(RALINENUMPLT,AUXINDEX) NQ  0 
              THEN
                  BEGIN 
                  GETNEXT(PHLNLINK);
                  $TEMP$ = RWGET(RALINENUMPLT,AUXINDEX);
                  RWSET1(LNINT$PLTPH  #CURRPHLNPTR#,$TEMP$);
                  IF RWGET(RAKINDLINENO,AUXINDEX) EQ ABSOLUTE 
                  THEN
                      RWSET1(KIND$LNINTPH  #CURRPHLNPTR#,ABSOLUTE); 
                  ELSE
                      RWSET1(KIND$LNINTPH  #CURRPHLNPTR#,RELATEVE); 
                  END 
              END 
          #***************************# 
          #BUILD PHRGLINK#
  
BPHRGTABLE: 
          BASEPHRGTABL = NEXTPHRGPTR; 
          GETNEXT(PHRGLINK);
          RWSET1(RG$NAMEPH  #CURRPHRGPTR#,DNATPOINTER); 
          RWSET1(TYPEOFRGPH  #CURRPHRGPTR#,PH); 
          IF SEQOFLN EQ NULL$LN 
          THEN
              BEGIN 
              RWSET1(PHLN$BASE  #CURRPHRGPTR#,0); 
              RWSET1(PHPL$BASE  #CURRPHRGPTR#,0); 
              GOTO  PHRGSENTRY; 
              END 
          RWSET1(PHLN$BASE  #CURRPHRGPTR#,BASEPHLNTABL);
          RWSET1(PHPL$BASE  #CURRPHRGPTR#,BASEPHPLTABL);
          RWSET1(PLT$ERRORMES  #CURRPHRGPTR#,0);
          RWSET1(RHPH$OVERLAP  #CURRPHRGPTR#,0);
  
          #PLT-PTR-TO-ERROR-MES  AND  RHPH-OVERLAP-BIT# 
          #WILL BE FILLED IN BY AFTER-ALL-REPORT-GROUPS-RT# 
          #IF SEQOFLN = AR, AND FURTHER ANALYSIS SHOWS# 
          #THERE TO BE A POSSIBLE CONFLICT BETWEEN RH AND PH# 
  
PHRGSENTRY: 
          #**************************************#
          #BUILD RGTLINK ENTRY# 
  
          GETNEXT(RGTLINK); 
          RWSET1(RGEOTDELIM  #CURRRPTGRPTR#,0); 
          RWSET1(RGTYPEOFRG  #CURRRPTGRPTR#,PH);
          RWSET1(RGBASERGTABL  #CURRRPTGRPTR#,BASEPHRGTABL);
          GENRGPNAT;
          RWSET1(RGPARANAME1  #CURRRPTGRPTR#,LASTPNATINDX); 
          GENRGPNAT;
          SET(PN$PERFLAST,PNAT$,LASTPNATINDX,1);
          RWSET1(RGPARANAME2  #CURRRPTGRPTR#,LASTPNATINDX); 
ENDPHRT:  
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EXTRACE("PAGEH  ")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          END #PAGEH# 
          TERM
