*DECK  FMPRT
      PROC  FM$PRT (P$FDB, RECORD, RECSIZE); # OUTPUT PAGINATION       #
        ITEM
          P$FDB   U,
          RECORD  U,
          RECSIZE U;
      BEGIN 
#CALL FMCOM                                                            #
CONTROL NOLIST; 
*CALL FMCOM 
CONTROL LIST; 
  
      XREF PROC  PUT; 
      XREF PROC  FM$ERR;
      XREF FUNC  FM$CV5D  C(5); 
      XREF FUNC  FM$MIN  I; 
      XREF FUNC  FM$MOD  I; 
      XREF FUNC  XWRITE  R; 
      ITEM  EJECT  C(137)      = "1"; 
      ITEM  BLANK$LINE  C(137) = " "; 
      ITEM  COUNT  C(6);
  
        ARRAY  TITLCONV S(1); 
          ITEM
            PARM$CONV   C(0, 0,8) = ["(X*****)"], 
            TITL$COUNT  C(0,12,5);
  
        ARRAY  TITLELINE S(13); 
          ITEM
            TITLETEXT  C(0, 0,115) = [" "], 
            TITLEPAGE  C(11,30, 5) = [" PAGE"], 
            TITLENUM   C(12, 0, 6) = ["     0"],
            TITLEXX    U(12,36,24) = [ 0 ]; 
  
        DEF  TITLETEXTMAX  # 115 #; 
        DEF  TITLELINESIZ  # 126 #; 
        DEF  TTLLINESIZ  # "00126" #; 
  
        ARRAY  DUMPHEAD S(14);
          ITEM
            DUMPCC    C(0, 0,137) = ["0RECORD ******    ****** CHARS"], 
            DUMP$REC  C(0,48,  6),
            DUMP$CNT  C(1,48,  6),
            DUMPXX    U(13,42,18) = [ 0 ];
  
        ARRAY  DUMPLINE S(14);
          ITEM
            DUMPLC    C(0, 0,  1) = [" "],
            DUMPTEXT  C(0, 6,136) = [" "],
            DUMPXY    U(13,42,18) = [ 0 ];
  
        STATUS  ERR 
          TTL$1,
          LAST$ERROR; 
  
        ARRAY  ERR$MSG  [0: 4] S(1);
          ITEM  ERR$MSG$TEXT  C(0,0,10) = [ 
  
# TTL$1          #
      "UNRECOVERA", "BLE ERROR ", "WRITING TI", "TLE      :", 
# LAST$MSG       #
      "******** :" ]; 
CONTROL EJECT;
      PROC  ERROR (TYPE);    # ERROR HANDLER                           #
        ITEM  TYPE S:ERR; 
      BEGIN 
        FM$ERR (0, 0, ERR$MSG, TYPE, FALSE);  # NON-FATAL ERROR        #
        $PAG =FALSE;         # TURN OFF PAGINATION                     #
      END;  # ERROR # 
CONTROL EJECT;
 #
* *   FMPRT - FORMAT RECORD FOR PRINTING
* *   M.T. KAUFMAN
* 1DC FMPRT 
* 
* DC  FUNCTION
* 
*     APPENDS LINE-SPACING INFORMATION TO RECORD, OR REFORMATS IT FOR 
*     DUMPING.  KEEPS TRACK OF LINES AND PAGES, PRINTING HEADERS AT THE 
*     START OF EACH NEW PAGE. 
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS ARE THE FDB FOR AN OUTPUT FILE AND THE CURRENT 
*     (QUALIFIED, REFORMATTED) RECORD IMAGE.
* 
* DC  EXIT CONDITIONS 
* 
*     NONE. 
* 
* DC  ERROR CONDITIONS
* 
*     NONE. 
* 
* DC  INTERNAL PROCEDURES 
* 
*     TITLE       - CHECK LINE COUNT.  START NEW PAGE IF NEEDED 
* 
 #
CONTROL EJECT;
      PROC  TITLE;
          BEGIN 
                BEGIN 
                  IF  TOPSIZE NQ 0  THEN    # TOP MARGIN               #
                    BEGIN 
                      IF  $IBM
                        THEN
                          BEGIN 
                            TITL$COUNT = "00001"; 
                            P<WSA> = WSA$;
                            IF  XWRITE (WSA, EJECT, TITLCONV) NQ 0
                              THEN  ERROR(ERR"TTL$1");
                            FOR  I = 2  TO TOPSIZE  DO
                              BEGIN 
                                IF XWRITE (WSA,BLANK$LINE,TITLCONV) NQ 0
                                  THEN  ERROR(ERR"TTL$1");
                              END 
                          END 
                        ELSE
                          BEGIN 
                            PUT (FDB, EJECT, 1);
                            FOR  I = 2 TO TOPSIZE  DO 
                              PUT (FDB, BLANK$LINE, 1); 
                          END 
                      CURPGL = TOPSIZE; 
                    END;
  
                  IF  TTL$ NQ 0  THEN     # TITLE ITSELF               #
                    BEGIN 
                      P<STRING> = TTL$; 
                      IF  TOPSIZE EQ 0  THEN
                        C<0>STRING$TEXT = "1";
                      J = MIN(TITLETEXTMAX, RESIDUAL(STRING$PTR)/6);
                      TITLETEXT = " ";
                      TITLENUM  = "     0"; 
                      C<0,J>TITLETEXT = C<0,J>STRING$TEXT;
                      PAGENO = PAGENO + 1;
                      J = PAGENO; 
                      FOR  I = 5 STEP -1 WHILE I GQ 0 AND J NQ 0  DO
                        BEGIN 
                          C<I>TITLENUM = O"33" + MOD(J,10); 
                          J = J/10; 
                        END 
                      IF  $IBM
                        THEN
                          BEGIN 
                            TITL$COUNT = FM$CV5D(MIN(TITLELINESIZ,IRL));
                            P<WSA> = WSA$;
                            IF  XWRITE (WSA, TITLELINE, TITLCONV) NQ 0
                              THEN  ERROR(ERR"TTL$1");
                            TITL$COUNT = "00001"; 
                            IF  XWRITE (WSA, BLANK$LINE, TITLCONV) NQ 0 
                              THEN  ERROR(ERR"TTL$1");
                          END 
                        ELSE
                          BEGIN 
                            PUT (FDB, TITLELINE, MIN(TITLELINESIZ,IRL));
                            PUT (FDB, BLANK$LINE, 1); 
                          END 
                      CURPGL = CURPGL + 2;
                    END;
                END 
          END # TITLE # 
CONTROL EJECT;
# MAIN PAGINATION ROUTINE                                              #
  
        P<FDB> = P$FDB;      # SET UP FDB                              #
        IF  PAGFMT NQ "D"  THEN  IF  CURPGL EQ 0  THEN  TITLE;
  
        IF  PAGFMT EQ "1" OR PAGFMT EQ "2"  THEN
          BEGIN 
            K = ADDRESS(RECORD);
            J = (RESIDUAL(RECORD) + 59) / 60; # WORDS IN RECORD        #
            FOR  I = J-1 DOWNTO 0  DO 
              BEGIN          #  SLIDE RECORD DOWN ONE CHARACTER        #
                B<0,6>UMEMORY[K+I+1] = B<54,6>UMEMORY[K+I]; 
                UMEMORY[K+I] = B<0,54>UMEMORY[K+I]; 
              END 
            RESIDUAL(RECORD) = RESIDUAL(RECORD) + 6;
            RECSIZE = RECSIZE+1;
            IF  PAGFMT EQ "1" 
              THEN
                BEGIN 
                  C<0>CMEMORY[K] = " "; 
                  CURPGL = CURPGL + 1;
                  IF  CURPGL GQ PGL  THEN  CURPGL = 0;
                END 
              ELSE
                BEGIN 
                  C<0>CMEMORY[K] = "0"; 
                  CURPGL = CURPGL + 2;
                  IF  CURPGL+2 GR PGL  THEN CURPGL = 0; 
                END 
          END 
  
        ELSEIF  PAGFMT EQ "D"  THEN 
          BEGIN 
            K = 2 + ((RECSIZE + 99) / 100); 
            IF  CURPGL+K GR PGL  THEN  CURPGL = 0;
            IF  CURPGL EQ 0  THEN  TITLE; 
              CURPGL = CURPGL + K;
            DUMP$REC = " "; 
            DUMP$CNT = "     0";
            J = RECNO;
            FOR  I = 5 STEP -1 WHILE (I GQ 0 AND J NQ 0) OR I EQ 5  DO
              BEGIN 
                C<I>COUNT = O"33" + MOD(J,10);
                J = J/10; 
              END 
            C<0,5-I>DUMP$REC = C<I+1,5-I>COUNT; 
            J = RECSIZE;  L = J;
            FOR  I = 5 STEP -1  WHILE  I GQ 0 AND J NQ 0  DO
              BEGIN 
                C<I>DUMP$CNT = O"33" + MOD(J,10); 
                J = J/10; 
              END 
            PUT (FDB, DUMPHEAD, 30);
  
            P<TEXT> = ADDRESS(RECORD);  I = USED(RECORD)/6; 
            WHYLE  L GR 0  DO 
              BEGIN 
                DUMPTEXT = " "; 
                K = MIN (L, 100); 
                C<0,K>DUMPTEXT = C<I,K>TXT$ITM; 
                PUT (FDB, DUMPLINE, K+1); 
                P<TEXT> = P<TEXT> + 10; 
                L = L - 100;
              END 
          END 
  
      END  # FM$TTL # 
      TERM
