RFORM 
PROC RPCEJCT ((FETP),(LINES));
# TITLE RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT.                  # 
      BEGIN  # RPCEJCT #
  
# 
**    RPCEJCT - CONDITIONALLY ISSUES A PAGE EJECT.
* 
*     COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
* 
*     *RPCEJCT* ISSUES A PAGE EJECT IF THE NUMBER OF
*     LINES REMAINING ON THE PAGE IS LESS THAN THE NUMBER 
*     OF LINES TO BE CHECKED. 
* 
*     PROC RPCEJCT((FETP),(LINES))
* 
*     ENTRY   (FETP) = FWA OF *FET*.
*             (LINES) = NUMBER OF LINES TO BE CHECKED.
# 
  
      ITEM FETP       I;             # *FET* LOCATION # 
      ITEM LINES      I;             # NUMBER OF LINES TO BE CHECKED #
  
# 
****  PROC RPCEJCT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC RPEJECT;                # ISSUES PAGE EJECT #
        PROC RPSRCH;                 # SEARCHES PRINT TABLE # 
        END 
  
# 
****  PROC RPCEJCT - XREF LIST END. 
# 
  
      DEF LISTCON #0#;               # TURN COMDECK LISTING OFF # 
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
  
                                               CONTROL EJECT; 
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
      RPSRCH(FETP);                  # SEARCH PRINT TABLE # 
  
# 
*     IF THE NUMBER OF LINES REMAINING ON THE PAGE IS 
*     LESS THAN THE NUMBER OF LINES TO BE CHECKED, ISSUE
*     A PAGE EJECT. 
# 
  
      IF (PRTLINELIM[ORD] - PRTLINE[ORD] + 1) GQ LINES
      THEN
        BEGIN 
        RETURN; 
        END 
  
      RPEJECT(FETP);
      RETURN; 
      END  # RPCEJCT #
  
    TERM
PROC RPCLOSE((FETP)); 
# TITLE RPCLOSE - CLOSES A REPORT FILE.                               # 
  
      BEGIN  # RPCLOSE #
  
# 
**    RPCLOSE - CLOSES A REPORT FILE. 
* 
*     THIS PROCEDURE WRITES THE MESSAGE *REPORT 
*     COMPLETE* ON THE REPORT FILE, CLEARS THE
*     *FET* ADDRESS IN THE PRINT TABLE ENTRY, AND 
*     CALLS *WRITER* TO CLOSE THE REPORT FILE.
* 
*     PROC RPCLOSE((FETP)). 
* 
*     ENTRY    (FETP) - ADDRESS OF REPORT FILE *FET*. 
*                       = *NULLFILE*, NO REPORT PROCESSING DONE.
*                         (VALUE DEFINED IN *COMUOUT*)
*                       = OTHER, ADDRESS OF *FET*.
* 
*     EXIT     REPORT FILE IS CLOSED.  A PAGE EJECT IS ISSUED AND 
*              *REPORT COMPLETE* IS PRINTED.
* 
*     NOTES    *RPCLOSE* CALLS *WRITER* TO WRITE AN 
*              END-OF-RECORD ON THE REPORT FILE, AND
*              CLEARS THE VALUE OF *FETP* FROM THE PRINT
*              TABLE ENTRY TO INDICATE THAT THE ENTRY 
*              IS NOW EMPTY.
# 
  
      ITEM FETP       U;             # ADDRESS OF REPORT FILE *FET* # 
  
# 
****  PROC RPCLOSE - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC RPLINEX;                # PRINTS A REPORT LINE # 
        PROC RPSRCH;                 # SEARCHES THE PRINT TABLE # 
        PROC WRITER;                 # WRITES *EOR* ON REPORT FILE #
        END 
  
# 
****  PROC RPCLOSE - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # CONTROLS LISTING OF COMDECKS # 
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
CONTROL EJECT;
  
# 
*     NO PROCESSING IS DONE IF NO REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
# 
*     PRINT COMPLETION MESSAGE AND CLEAR THE PRINT TABLE. 
# 
  
      RPSRCH(FETP);                  # SEARCH PRINT TABLE # 
      RPLINEX(FETP,"1**REPORT COMPLETE**",0,20,0);
      P<RPFET> = FETP;
      WRITER(RPFET[0],RCL);          # WRITE END-OF-RECORD #
  
      PRTFETP[ORD] = EMPTY;          # CLEAR *FET* ADDRESS FROM TABLE # 
      RETURN; 
      END  # RPCLOSE #
  
    TERM
PROC RPEJECT((FETP)); 
# TITLE RPEJECT - STARTS A NEW REPORT PAGE.                           # 
  
      BEGIN  # RPEJECT #
  
# 
**    RPEJECT - STARTS NEW REPORT PAGE. 
* 
*     THIS PROCEDURE ADVANCES THE REPORT FILE 
*     TO A NEW PAGE, SETS THE CURRENT LINE NUMBER 
*     EQUAL TO ONE, AND PRINTS THE PAGE HEADING.
* 
*     PROC RPEJECT((FETP)). 
* 
*     ENTRY    (FETP) - ADDRESS OF THE REPORT FILE *FET*. 
*                       = *NULLFILE*, NO REPORT PROCESSING DONE.
*                         (VALUE DEFINED IN *COMUOUT*)
*                       = OTHER, ADDRESS OF *FET*.
* 
*     EXIT     NEW PAGE HEADING IS COMPLETED. 
* 
*     NOTES    *RPEJECT* SETS UP THE PAGE HEADER LINE 
*              WITH DATE, TIME, PAGE NUMBER, AND
*              CARRIAGE CONTROL CHARACTER.  AFTER 
*              PRINTING THIS LINE, THE LINE BUFFER
*              IS BLANK-FILLED AND *XPRC* IS CALLED 
*              TO EXECUTE THE HEADER PROCEDURE.  THE
*              REPORT FILE MUST HAVE ALREADY BEEN OPENED
*              BY CALLING *RPOPEN*. 
# 
  
      ITEM FETP       U;             # ADDRESS OF REPORT FILE *FET* # 
  
# 
****  PROC RPEJECT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC RPSRCH;                 # SEARCHES THE PRINT TABLE # 
        PROC WRITEH;                 # WRITES LINE ON REPORT FILE # 
        FUNC XCDD C(10);             # CONVERTS INTEGER TO DISPLAY #
        PROC XPRC;                   # EXECUTES A PROCEDURE # 
        END 
  
# 
****  PROC RPEJECT - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # CONTROLS LISTING OF COMDECKS # 
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
      ITEM PAGENUM    C(10);         # PAGE NUMBER IN DISPLAY CODE #
CONTROL EJECT;
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
  
# 
*     UPDATE PAGE AND LINE COUNTS.
# 
  
      RPSRCH(FETP);                  # SEARCH PRINT TABLE FOR *FETP* #
  
      PRTPAGE[ORD] = PRTPAGE[ORD] + 1;
      PRTLINE[ORD] = 1; 
      PAGENUM = XCDD(PRTPAGE[ORD]);  # PAGE NUMBER IN DISPLAY CODE #
  
# 
*     SET UP AND PRINT THE PAGE HEADER LINE.
# 
  
      LIN$CNTRL[ORD] = PRCEJ;        # CAUSE PAGE EJECT # 
      LIN$HEAD[ORD] = PRTHEADT[ORD];  # CURRENT MESSAGE # 
      LIN$DATE[ORD] = PRTDATE[ORD];  # CURRENT DATE # 
      LIN$TIME[ORD] = PRTTIME[ORD];  # CURRENT TIME # 
      LIN$PAGE[ORD] = "PAGE"; 
      LIN$PAGENM[ORD] = C<4,6>PAGENUM;  # PAGE NUMBER # 
      P<RPFET> = FETP;
      WRITEH(RPFET[0],LINEBUFF[ORD],LINELEN);  # PRINT LINE # 
      PRTLINE[ORD] = PRTLINE[ORD] + 1;  # INCREMENT LINE COUNTER #
  
      LIN$BUF[ORD] = SPACES;         # BLANK FILL *LINEBUFF* #
  
# 
*     EXECUTE SPECIFIED HEADER PROCEDURE. 
# 
  
      XPRC(PRTHEADP[ORD],FETP,BLANK); 
      RETURN; 
      END  # RPEJECT #
  
    TERM
PROC RPHEAD((FETP),(MESG),(COL),(LEN)); 
# TITLE RPHEAD - SETS UP HEADER PRINT FIELD.                          # 
  
      BEGIN  # RPHEAD # 
  
# 
**    RPHEAD - SETS UP HEADER PRINT FIELD.
* 
*     *RPHEAD* SETS UP AN OPTIONAL HEADER PRINT FIELD IN THE
*     FIRST ONE HUNDRED CHARACTERS OF THE HEADER PAGE LINE. 
* 
*     PROC RPHEAD((FETP),(MESG),(COL),(LEN))
* 
*     ENTRY   (FETP) - ADDRESS OF *FET* FOR REPORT FILE.
*             (MESG)  - HEADER MESSAGE. 
*             (COL)  - STARTING COLUMN. 
*             (LEN)  - CHARACTER LENGTH OF FIELD. 
* 
*     EXIT    HEADER PRINT FIELD IS SET UP. 
* 
*     NOTES   THE SPECIFIED MESSAGE WILL BE PRINTED ON EVERY
*             SUBSEQUENT PAGE HEADING UNTIL CHANGED OR CLEARED
*             BY ANOTHER CALL TO *RPHEAD*.  THE MAXIMUM NUMBER
*             OF CHARACTERS ALLOWED FOR THE HEADER FIELD IS 
*             ONE HUNDRED.
*             (*COL* + *LEN* -1) MUST BE LESS THAN OR EQUAL 
*             TO ONE HUNDRED. 
# 
  
      ITEM FETP       U;             # ADDRESS OF REPORT FILE FET # 
      ITEM MESG       C(100);        # HEADER MESSAGE # 
      ITEM COL        U;             # STARTING COLUMN FOR FIELD #
      ITEM LEN        U;             # LENGTH OF PRINT FIELD #
  
# 
****  PROC RPHEAD - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC RPSRCH;                 # SEARCHES PRINT TABLE # 
        END 
  
# 
****  PROC RPHEAD - XREF LIST END.
# 
  
      DEF LISTCON  #0#;              # TURN LISTING OFF # 
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
  
                                               CONTROL EJECT; 
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
# 
*     SET UP PRINT FIELD. 
# 
  
      RPSRCH(FETP);                  # FIND PRINT TABLE ENTRY # 
      C<COL-1,LEN>PRTHEADT[ORD] = C<0,LEN>MESG; 
      END  # RPHEAD # 
  
    TERM
PROC RPLINE((FETP),FIELD,(COL),(LEN),(FLAG)); 
  
# TITLE RPLINE - CALLS *RPLINEX* TO PRINT A LINE.                     # 
  
      BEGIN  # RPLINE # 
  
# 
**    RPLINE - CALLS *RPLINEX* TO PRINT A LINE. 
* 
*     THIS PROCEDURE CHECKS THE CURRENT LINE NUMBER AND CALLS 
*     *RPEJECT* IF THE LINE LIMIT IS EXCEEDED.  IT THEN CALLS 
*     *RPLINEX* TO SET UP PRINT FIELD *FIELD* IN THE LINE BUFFER. 
*     THE LINE IS EITHER PRINTED OR SAVED, DEPENDING ON THE VALUE 
*     OF *FLAG* SPECIFIED.
* 
*     PROC RPLINE((FETP),FIELD,(COL),(LEN),(FLAG)). 
* 
*     ENTRY   (FETP)  - ADDRESS OF *FET* FOR REPORT FILE. 
*                       = *NULLFILE*, NO REPORT PROCESSING IS DONE. 
*                         (VALUE DEFINED IN *COMUOUT*)
*                       = OTHER, ADDRESS OF *FET*.
*             (FIELD) - STRING TO BE PRINTED. 
*             (COL)   - STARTING COLUMN FOR *FIELD*.
*             (LEN)   - CHARACTER LENGTH OF *FIELD*.
*             (FLAG)  - INDICATES CONTINUATION OF LINE. 
*                       (VALUES DEFINED IN *COMUOUT*) 
*                       = *END$LN*, CONTENTS OF BUFFER ARE PRINTED. 
*                       = *CONT$LN*, CONTENTS OF BUFFER ARE SAVED.
* 
*     EXIT    LINE IS PRINTED OR CONTENTS OF BUFFER ARE SAVED 
*             UNTIL NEXT CALL TO *RPLINE*.  THE MAXIMUM FIELD 
*             SIZE IS 138 CHARACTERS. 
# 
  
      ITEM FETP       U;             # ADDRESS OF REPORT FILE *FET* # 
  
      ARRAY FIELD [0:0] S(14);       # ARRAY CONTAINING PRINT FIELD # 
        BEGIN 
        ITEM FIELDPR    C(00,00,138);  # PRINT STRING # 
        END 
  
      ITEM COL        U;             # STARTING COLUMN OF FIELD # 
      ITEM LEN        U;             # LENGTH OF PRINT FIELD #
      ITEM FLAG       U;             # INDICATES LINE CONTINUATION #
  
  
  
# 
****  PROC RPLINE - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC RPEJECT;                # STARTS NEW REPORT PAGE # 
        PROC RPLINEX;                # PRINTS LINE ON REPORT FILE # 
        PROC RPSRCH;                 # SEARCHES PRINT TABLE # 
        END 
  
# 
****  PROC RPLINE - XREF LIST END.
# 
  
      DEF LISTCON   #0#;             # CONTROLS LISTING OF COMDECKS # 
  
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
CONTROL EJECT;
  
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
# 
*     CHECK LINE COUNT AND PRINT REPORT LINE. 
# 
  
      RPSRCH(FETP);                  # SEARCH FOR MATCHING *FETP* # 
  
      IF PRTLINE[ORD] GR PRTLINELIM[ORD]
      THEN                           # NEW PAGE NEEDED #
        BEGIN 
        RPEJECT(FETP);
        END 
  
      RPLINEX(FETP,FIELD,COL,LEN,FLAG); 
  
  
  
      RETURN; 
      END  # RPLINE # 
  
    TERM
PROC RPLINEX((FETP),FIELD,(COL),(LEN),(FLAG));
# TITLE RPLINEX - PRINTS A REPORT LINE.                               # 
  
      BEGIN  # RPLINEX #
  
# 
**    RPLINEX - PRINTS A LINE ON THE REPORT FILE. 
* 
*     *RPLINEX* SETS UP PRINT FIELD *FIELD* IN A LINE BUFFER. 
*     THE CONTENTS OF THE BUFFER ARE EITHER PRINTED OR SAVED, DEPENDING 
*     ON THE VALUE OF *FLAG*.  MORE THAN ONE FIELD PER PRINT
*     LINE CAN BE SPECIFIED BY MAKING MORE THAN ONE CALL TO 
*     *RPLINEX*.
* 
*     PROC RPLINEX((FETP),FIELD,(COL),(LEN),(FLAG)).
* 
*     ENTRY   (FETP)  - ADDRESS OF *FET* FOR REPORT FILE. 
*                       = *NULLFILE*, NO REPORT PROCESSING IS DONE. 
*                         (VALUE DEFINED IN *COMUOUT*)
*                       = OTHER, ADDRESS OF *FET*.
*             (FIELD) - STRING TO BE PRINTED. 
*             (COL)   - STARTING COLUMN FOR *FIELD*.
*             (LEN)   - CHARACTER LENGTH OF *FIELD*.
*             (FLAG)  - INDICATES CONTINUATION OF LINE. 
*                       (VALUES DEFINED IN *COMUOUT*) 
*                       = *END$LN*, CONTENTS OF BUFFER ARE PRINTED. 
*                       = *CONT$LN*, CONTENTS OF BUFFER ARE SAVED.
* 
*     EXIT    LINE IS PRINTED OR CONTENTS OF BUFFER ARE SAVED 
*             UNTIL NEXT CALL TO *RPLINEX*.  THE LINE COUNTER IS
*             INCREMENTED AS NEEDED.
# 
  
      ITEM FETP       U;             # ADDRESS OF REPORT FILE *FET* # 
  
  
      ARRAY FIELD [0:0] S(14);       # ARRAY CONTAINING PRINT FIELD # 
        BEGIN 
        ITEM FIELDPR    C(00,00,138);  # PRINT STRING # 
        END 
  
      ITEM COL        U;             # STARTING COLUMN OF FIELD # 
      ITEM LEN        U;             # LENGTH OF PRINT FIELD #
      ITEM FLAG       U;             # INDICATES LINE CONTINUATION #
  
# 
****  PROC RPLINEX - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC RPSRCH;                 # SEARCHES PRINT TABLE # 
        PROC WRITEH;                 # WRITES LINE ON REPORT FILE # 
        END 
  
# 
****  PROC RPLINEX - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # CONTROLS LISTING OF COMDECKS # 
  
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
  
CONTROL EJECT;
  
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
  
# 
*     THE CHARACTER STRING *FIELD* IS PLACED IN THE 
*     APPROPRIATE LOCATION IN *LINEBUFF*.  IF THE VALUE 
*     OF *FLAG* IS *CONT$LN*, THE CONTENTS OF *LINEBUFF*
*     ARE SAVED.  OTHERWISE A LINE IS PRINTED.
# 
  
      RPSRCH(FETP);                  # FIND PRINT TABLE ENTRY # 
      P<RPFET> = FETP;
  
      IF FIELDPR[0] NQ EMPTY         # IF *FIELD* CONTAINS STRING # 
      THEN
        BEGIN 
        C<COL,LEN>LIN$BUF[ORD] = FIELDPR[0];  # SET UP PRINT FIELD #
        END 
  
      IF FLAG EQ CONT$LN             # IF LINE CONTINUED #
      THEN
        BEGIN 
        RETURN;                      # SAVE CONTENTS OF *LINEBUFF* #
        END 
  
# 
*     WRITE PRINT LINE. 
# 
  
      WRITEH(RPFET[0],LINEBUFF[ORD],LINELEN); 
      IF LIN$CNTRL[ORD] EQ PRDBL
      THEN                           # DOUBLE SPACE DONE #
        BEGIN 
        PRTLINE[ORD] = PRTLINE[ORD] + 2;  # INCREMENT LINE COUNT #
        END 
  
      ELSE                           # SINGLE SPACE ASSUMED # 
        BEGIN 
        PRTLINE[ORD] = PRTLINE[ORD] + 1;  # INCREMENT BY ONE #
        END 
  
      LIN$BUF[ORD] = SPACES;         # BLANK FILL *LINEBUFF* #
      RETURN; 
  
      END  # RPLINEX #
  
    TERM
PROC RPOPEN((NAME),(FETP),HEADPROC);
# TITLE RPOPEN - OPENS A REPORT FILE.                                 # 
  
      BEGIN  # RPOPEN # 
  
# 
**    RPOPEN - OPENS A REPORT FILE. 
* 
*     THIS PROCEDURE SETS UP THE PRINT TABLE
*     FOR A REPORT FILE AND CALLS *RPEJECT* 
*     TO START THE FIRST PAGE.
* 
*     PROC RPOPEN((NAME),(FETP),HEADPROC).
* 
*     ENTRY   (NAME)     - NAME OF REPORT FILE. 
*             (FETP)     - REPORT FILE *FET* OPTION.
*                          = *NULLFILE*, NO REPORT PROCESSING IS DONE.
*                            (VALUE DEFINED IN *COMUOUT*) 
*                          = OTHER, ADDRESS OF REPORT FILE *FET*. 
*             (HEADPROC) - HEADER PROCEDURE OPTION. 
*                          = *DEFLT$HDR*, DEFAULT PAGE HEADER USED. 
*                            (VALUE DEFINED IN *COMUOUT*) 
*                          = NAME OF USER-SUPPLIED PROCEDURE TO 
*                          BE EXECUTED AFTER EACH PAGE EJECT. 
* 
*     EXIT    REPORT FILE OPENED OR PRINT TABLE FULL. 
* 
*     NOTES   *RPOPEN* INITIALIZES A PRINT TABLE ENTRY FOR
*             THE REPORT FILE SPECIFIED.  UP TO *PRTABENT* REPORT 
*             FILES MAY BE OPEN SIMULTANEOUSLY.  AFTER EACH 
*             PAGE EJECT, A LINE IS PRINTED CONTAINING THE
*             THE CURRENT DATE, TIME, AND PAGE NUMBER.
*             FOLLOWING THIS THE USER SUPPLIED HEADER PROCEDURE 
*             IS EXECUTED.
*             TO AVOID RECURSIVE CALLS, THE HEADER PROCEDURE MUST 
*             NOT CALL *RPLINE* OR *RPSPACE*.  INSTEAD *RPLINEX*
*             SHOULD BE USED.  TO PRINT A BLANK LINE, CALL: 
*                 RPLINEX(FETP,0,0,0,0).
# 
  
      ITEM NAME       C(7);          # NAME OF THE REPORT FILE #
      ITEM FETP       U;             # ADDRESS OF REPORT FILE *FET* # 
      FPRC HEADPROC;                 # USER-SUPPLIED HEADER PROCEDURE # 
  
# 
****  PROC RPOPEN - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC CLOCK;                  # GETS CURRENT TIME #
        PROC DATE;                   # GETS CURRENT DATE #
        PROC RPEJECT;                # STARTS NEW REPORT PAGE # 
        PROC RPLINEX;                # PRINTS A LINE #
        PROC RPSRCH;                 # SEARCHES THE PRINT TABLE # 
        PROC ZSETFET;                # INITIALIZES A *FET* #
        END 
  
# 
****  PROC RPOPEN - XREF LIST END.
# 
  
      DEF LISTCON #0#;               # CONTROLS LISTING OF COMDECKS # 
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
  
  
  
      ITEM DTEMP      C(10);         # TEMPORARY LOCATION FOR DATE #
      ITEM TTEMP      C(10);         # TEMPORARY LOCATION FOR TIME #
      ITEM PRBUFP     U;             # ADDRESS OF *CIO* BUFFER #
  
      BASED 
      ARRAY HEADWORD [0:0] S(1);     # USED TO TEST *HEADPROC* #
        BEGIN 
        ITEM HEADNAME   U(00,00,60);  # NAME OF HEADER PROCEDURE #
        END 
  
CONTROL EJECT;
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
  
# 
*     SEARCH FOR AN EMPTY ENTRY IN THE PRINT TABLE. 
# 
  
      RPSRCH(EMPTY);                 # SEARCH TABLE FOR EMPTY ENTRY # 
  
      DATE(DTEMP);                   # GET CURRENT DATE # 
      CLOCK(TTEMP);                  # GET CURRENT TIME # 
  
# 
*     INITIALIZE PRINT TABLE FIELDS.
# 
  
      PRBUFP = LOC(PRBUF[ORD]);      # ADDRESS OF *CIO* BUFFER #
      PRTLFN[ORD] = NAME; 
      PRTLINE[ORD] = MAXLINE; 
      PRTHEADT[ORD] = " ";
      PRTFETP[ORD] = FETP;
      PRTPAGE[ORD] = 0; 
      PRTLINELIM[ORD] = PRDEFLIM; 
      PRTDATE[ORD] = DTEMP; 
      PRTTIME[ORD] = TTEMP; 
  
# 
*     SAVE ADDRESS OF THE HEADER PROCEDURE. 
# 
  
      P<HEADWORD> = LOC(HEADPROC);
      IF HEADNAME[0] EQ DEFLT$HDR 
      THEN                           # DEFAULT HEADER CHOSEN #
        BEGIN 
        PRTHEADP[ORD] = LOC(RPLINEX);  # GET ADDRESS OF *RPLINEX* # 
        END 
  
      ELSE                           # HEADER PROVIDED #
        BEGIN 
        PRTHEADP[ORD] = LOC(HEADPROC);  # GET HEADER ADDRESS #
        END 
  
# 
*     INITIALIZE *FET* AND START FIRST PAGE.
# 
  
      ZSETFET(FETP,NAME,PRBUFP,PRBUFL,SFETL); 
  
      LIN$BUF[ORD] = SPACES;         # BLANK FILL *LINEBUFF* #
      RETURN; 
  
      END  # RPOPEN # 
  
    TERM
PROC RPSPACE((FETP),(SPTYP),(NUM)); 
# TITLE RPSPACE - DOES REPORT SPACING.                                # 
  
      BEGIN  # RPSPACE #
  
# 
**    RPSPACE - DOES REPORT SPACING.
* 
*     THIS PROCEDURE DOES VARIOUS TYPES OF REPORT 
*     PROCESSING, DEPENDING ON THE VALUE OF *SPTYP* 
*     SPECIFIED.
* 
*     PROC RPSPACE((FETP),(SPTYP),(NUM)). 
* 
*     ENTRY     (FETP)  - ADDRESS OF REPORT FILE *FET*. 
*               (SPTYP) - STATUS ITEM INDICATING PROCESSING.
*                         (VALUES DEFINED IN *COMUOUT*) 
*                         = *LIMIT*, CHANGE PAGE LINE LIMIT TO *NUM*. 
*                         = *LINE*, ADVANCE TO LINE *NUM*.
*                         = *SPACE*, PRINT *NUM* BLANK LINES. 
*               (NUM)   - NUMBER USED IN ACCORDANCE WITH THE
*                         VALUE OF *SPTYP*. 
* 
*     EXIT      REPORT SPACING IS COMPLETE. 
* 
*     ERRORS    LINE LIMIT EXCEEDS MAXIMUM. 
* 
*     MESSAGES  * MAXIMUM LINE COUNT TAKEN AS LIMIT.*.
# 
  
      ITEM FETP       U;             # ADDRESS OF *FET* # 
      ITEM NUM        I;             # NUMBER OF SPACES, LINE NUMBER, 
                                       OR NEW LINE LIMIT #
  
# 
****  PROC RPSPACE - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC MESSAGE;                # DISPLAYS DAYFILE MESSAGE # 
        PROC RPSRCH;                 # SEARCHES THE PRINT TABLE # 
        PROC RPLINEX;                # PRINTS A LINE ON REPORT FILE # 
        PROC RPEJECT;                # STARTS NEW REPORT PAGE # 
        END 
  
# 
****  PROC RPSPACE - XREF LIST END. 
# 
  
      DEF LISTCON   #0#;             # CONTROLS LISTING OF COMDECKS # 
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
      ITEM I          I;             # INDUCTION VARIABLE # 
      ITEM LINESLEFT  U;             # LINES LEFT ON PAGE # 
      ITEM SPTYP      S:SP;          # TYPE OF SPACING SPECIFIED #
  
      SWITCH LABTYP:SP               # SWITCH CONTROLLING PROCESSING #
            LIMITYP:LIMIT,           # CHANGE PAGE LINE LIMIT # 
            LINETYP:LINE,            # ADVANCE TO ABSOLUTE LINE # 
           SPACETYP:SPACE;           # PRINT BLANK LINES #
  
CONTROL EJECT;
  
  
  
# 
*     NO PROCESSING IS DONE IF A NULL REPORT FILE IS INDICATED. 
# 
  
      IF FETP EQ NULLFILE 
      THEN
        BEGIN 
        RETURN; 
        END 
  
  
# 
*     FIND PRINT TABLE ENTRY AND PROCESS REQUEST. 
# 
  
      RPSRCH(FETP); 
      GOTO LABTYP[SPTYP];            # DO APPROPRIATE PROCESSING #
  
LIMITYP:                             # CHANGE LINE LIMIT TO *NUM* # 
      IF NUM LS MAXLC 
      THEN                           # LIMIT REQUESTED IS PERMISSABLE # 
        BEGIN 
        PRTLINELIM[ORD] = NUM;
        END 
  
      ELSE                           # EXCESSIVE LIMIT REQUESTED #
        BEGIN 
        PRTLINELIM[ORD] = MAXLC;     # MAXIMUM LINE LIMIT USED #
        MSGITEM[0] = " MAXIMUM LINE COUNT TAKEN AS LIMIT." ;
        MESSAGE(MSGITEM[0],UDFL1);
        END 
  
      RETURN; 
  
LINETYP:                             # SKIP TO LINE NUMBER #
      IF NUM LQ PRTLINE[ORD]
      THEN                           # LINE IS ON NEXT PAGE # 
        BEGIN 
        RPEJECT(FETP);               # EJECT TO NEW PAGE #
        END 
  
      NUM = NUM - PRTLINE[ORD]; 
      SLOWFOR I = 1 STEP 1 UNTIL NUM
      DO
        BEGIN 
        RPLINEX(FETP,BLANK);         # PRINT BLANK LINE # 
        END 
  
      RETURN; 
  
SPACETYP:                            # SKIP SPECIFIED NUMBER OF LINES # 
      IF PRTLINE[ORD] GR PRTLINELIM[ORD]
      THEN
        BEGIN 
        RPEJECT(FETP);               # EJECT TO NEW PAGE #
        END 
  
      LINESLEFT = (PRTLINELIM[ORD] - PRTLINE[ORD]) + 1; 
      IF NUM GQ LINESLEFT 
      THEN                           # PAGE EJECT NECESSARY # 
        BEGIN 
        NUM = NUM - LINESLEFT;
        RPEJECT(FETP);
        END 
  
      SLOWFOR I = 1 STEP 1 UNTIL NUM
      DO                             # PRINT *NUM* BLANK LINES #
        BEGIN 
        RPLINEX(FETP,BLANK);         # PRINT *NUM* BLANK LINES #
        END 
  
  
      RETURN; 
      END  # RPSPACE #
  
    TERM
PROC RPSRCH((FETP));
  
# TITLE RPSRCH - SEARCHES THE PRINT TABLE.                            # 
  
      BEGIN  # RPSRCH # 
  
# 
**    RPSRCH - SEARCHES THE PRINT TABLE FOR AN ENTRY WITH A 
*              MATCHING *FETP*. 
* 
*     *RPSRCH* SEARCHES THE PRINT TABLE FOR EITHER AN EMPTY 
*     ENTRY, OR THE ENTRY FOR A FILE ALREADY OPENED BY
*     *RPOPEN*. 
* 
*     PROC RPSRCH((FETP)).
* 
*     ENTRY    (FETP) - THE *FET* ADDRESS FOR REPORT FILE.
*                       = *EMPTY*, SEARCH FOR EMPTY ENTRY.
*                         (VALUE DEFINED IN *COMUFMT*)
*                       = OTHER, ADDRESS OF *FET*.
* 
*     EXIT     (ORD)  - ITEM IN COMMON CONTAINING THE ORDINAL 
*                       OF THE PRINT TABLE ENTRY FOUND. 
*              IF THE PRINT TABLE IS FULL, OR A MATCHING
*              ENTRY IS NOT FOUND, PROCESSING IS ABORTED. 
* 
*     MESSAGES   * PRINT TABLE ENTRY NOT FOUND.*
*                * PRINT TABLE FULL.* 
# 
  
  
      ITEM FETP       U;             # ADDRESS OF REPORT FILE *FET* # 
  
  
# 
****  PROC RPSRCH - XREF LIST BEGIN.
# 
  
      XREF
        BEGIN 
        PROC ABORT;                  # ABORTS PROCESSING #
        PROC MESSAGE;                # DISPLAYS DAYFILE MESSAGE # 
        END 
  
# 
****  PROC RPSRCH - XREF LIST END.
# 
  
      DEF LISTCON   #0#;             # CONTROLS LISTING OF COMDECKS # 
  
*CALL COMAMSS 
*CALL COMUFMT 
*CALL COMUOUT 
  
  
CONTROL EJECT;
  
# 
*     FIND PRINT TABLE ENTRY WITH AN EMPTY OR MATCHING *FETP*.
# 
  
      ORD = 1;
      REPEAT WHILE PRTFETP[ORD] NQ FETP AND ORD LQ PRTABENT 
      DO
        BEGIN 
        ORD = ORD + 1;
        END 
  
      IF ORD GR PRTABENT             # MATCHING ENTRY NOT FOUND # 
      THEN
        BEGIN 
        IF FETP EQ EMPTY             # CALLED BY *RPOPEN* # 
        THEN
          BEGIN 
          MSGITEM[0] = " PRINT TABLE FULL." ; 
          END 
  
        ELSE
          BEGIN 
          MSGITEM[0] = " PRINT TABLE ENTRY NOT FOUND." ;
          END 
  
        MESSAGE(MSGITEM[0],UDFL1);
        ABORT;                       # ISSUE MESSAGE AND ABORT #
        END 
  
      RETURN; 
      END  # RPSRCH # 
  
    TERM
