Retro1.org codex

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