TAFLOG
       IDENTIFICATION DIVISION. 
       PROGRAM-ID. TAFLOG.
       AUTHOR. R L ERICKSON - DATA MANAGEMENT CONSULTING SERVICES.
      *        T E SCHULL - 2/27/87.
      * 
      *  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
      * 
      *  THIS PROGRAM PRODUCES A FORMATTED LISTING OF ALL THE 
      *  INFORMATION CONTAINED IN THE TAF SYSTEM JOURNAL FILE *JOUR0* 
      *  ON A FILE CALLED *JOURNAL*.  TO EXECUTE THIS PROGRAM, *JOUR0*
      *  MUST BE A LOCAL FILE.
      * 
      *  THE OUTPUT ON FILE *JOURNAL* IS FORMATTED ACCORDING TO THE 
      *  FOLLOWING HEADERS. 
      * 
      *   SEQ - TRANSACTION SEQUENCE INDICATOR IN OCTAL.
      * 
      *   ORG - ORIGIN INDICATOR IN OCTAL.
      * 
      *   CNT - LENGTH OF JOURNAL MESSAGE IN CHARACTERS (ROUNDED UP TO
      *         A WORD BOUNDARY). 
      * 
      *   TASK - NAME OF TASK.
      * 
      *   TIME - HH.MM.SS IN DECIMAL. 
      * 
      *   USER - USER NAME ASSOCIATED WITH THE TRANSACTION, IF TASK 
      *          ORIGIN.
      * 
      *   JOURNAL MESSAGE - MESSAGE JOURNALIZED BY TAF. 
      * 
      *   DATE - YY/MM/DD  (DATE WHEN TAF WAS BROUGHT UP) IN DECIMAL. 
      * 
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION. 
       SOURCE-COMPUTER. CYBER-170.
       OBJECT-COMPUTER. CYBER-170.
       SPECIAL-NAMES. 
           "TERMINAL" IS SCREEN 
           .
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT RPT-FILE
             ASSIGN TO JOURNAL
               USE "RT=Z" 
               .
       DATA DIVISION. 
       FILE SECTION.
       FD  RPT-FILE 
           LABEL RECORDS ARE OMITTED. 
       01  RPT-RECORD              PIC X(136).
      * 
       WORKING-STORAGE SECTION. 
       01  LOG-RECORD.
      * 
      *  THE LOG RECORD HEADER IS 30 CHARACTERS LONG. 
      * 
           05  LOG-HEADER.
  
               07  WORD-ONE.
  
                   10  FILLER          PIC X(07). 
                   10  LOG-TRAILER-CHARACTER-COUNT
                           COMP-4  PIC 9(05). 
  
               07  WORD-TRANEX REDEFINES WORD-ONE.
                   10  TRANEX          PIC X(07). 
                   10  FILLER          PIC X(03). 
  
               07  WORD-TWO.
                   10  TAF-TASK-NAME   PIC X(07). 
                   10  TAF-TIME.
                       15  TAF-HR      PIC X(01). 
                       15  TAF-MN      PIC X(01). 
                       15  TAF-SC      PIC X(01). 
  
               07  WORD-DATE REDEFINES WORD-TWO.
                   10  FILLER          PIC X(04). 
                   10  TAF-YR          PIC X(01). 
                   10  TAF-MT          PIC X(01). 
                   10  TAF-DY          PIC X(01). 
                   10  FILLER          PIC X(03). 
  
               07  WORD-THREE.
                   10  TAF-USERNAME    PIC X(07). 
                   10  FILLER          PIC X(03). 
  
      * 
      * END OF LOG RECORD HEADER
      * 
  
      * 
      * LOG TRAILER DEFINITION FOLLOWS
      * 
           05  LOG-TRAILER         PIC X(01)  OCCURS 0 TO 65535 TIMES 
                       DEPENDING ON LOG-TRAILER-CHARACTER-COUNT.
      * 
       01  PRINT-A-LINE.
           03  PRINT-HEADER.
               05  FILLER              PIC X(01) VALUE " ". 
               05  P-TAF-SEQ           PIC X(08). 
               05  FILLER              PIC X(01). 
               05  P-TAF-ORG           PIC X(02). 
               05  FILLER              PIC X(01). 
               05  P-CHAR-COUNT        PIC ZZZZ9. 
               05  FILLER              PIC X(01). 
               05  P-TASK-NAME         PIC X(07). 
               05  FILLER              PIC X(01). 
               05  P-TAF-HR            PIC 9(02). 
               05  P-POINT-1           PIC X(01) VALUE ".". 
               05  P-TAF-MN            PIC 9(02). 
               05  P-POINT-2           PIC X(01) VALUE ".". 
               05  P-TAF-SC            PIC 9(02). 
               05  FILLER              PIC X(01). 
               05  P-TAF-USERNAME      PIC X(07). 
               05  FILLER              PIC X(01). 
           03  P-LOG-TRAILER. 
               05  P-LOG               PIC X(01) OCCURS 90. 
      * 
       01  PRINT-DATE.
           05  FILLER              PIC X(15) VALUE " --------------". 
           05  FILLER              PIC X(15) VALUE "---------------". 
           05  FILLER              PIC X(14) VALUE "------------- ".
           05  FILLER              PIC X(07) VALUE "DATE - ". 
           05  P-TAF-YR            PIC 9(02). 
           05  FILLER              PIC X(01) VALUE "/". 
           05  P-TAF-MT            PIC 9(02). 
           05  FILLER              PIC X(01) VALUE "/". 
           05  P-TAF-DY            PIC 9(02). 
           05  FILLER              PIC X(15) VALUE " --------------". 
           05  FILLER              PIC X(15) VALUE "---------------". 
           05  FILLER              PIC X(15) VALUE "---------------". 
           05  FILLER              PIC X(15) VALUE "---------------". 
           05  FILLER              PIC X(12) VALUE "------------".
      * 
       01  RPT-HDG-1. 
           05  FILLER              PIC X(09) VALUE "1 SEQ". 
           05  FILLER              PIC X(06) VALUE "ORG". 
           05  FILLER              PIC X(05) VALUE "CNT". 
           05  FILLER              PIC X(08) VALUE "TASK".
           05  FILLER              PIC X(08) VALUE "TIME".
           05  FILLER              PIC X(08) VALUE "USER".
           05  FILLER              PIC X(15) VALUE "JOURNAL MESSAGE". 
           05  FILLER              PIC X(29) VALUE " ". 
           05  FILLER              PIC X(09) VALUE "(RECORDS".
           05  REC-FROM            PIC Z(05). 
           05  FILLER              PIC X(02) VALUE " -".
           05  REC-TO              PIC Z(05). 
           05  FILLER              PIC X(10) VALUE ")     PAGE".
           05  PAGE-CNT            PIC Z(04). 
       01  RPT-HDG-2               PIC X(10) VALUE SPACES.
       01  DET-COUNT COMP-1        PIC 9(10) VALUE 20.
       01  REC-COUNT               PIC 9(10) VALUE 0. 
       01  CNT-FROM                PIC 9(06) VALUE 1. 
       01  CNT-TO                  PIC 9(06) VALUE 20.
       01  CNT-PAGE                PIC 9(05) VALUE 0. 
       01  SUB1 COMP-1             PIC 9(10). 
       01  PER-PAGE                PIC 9(10) VALUE 58.
       01  COMP-1-WORD  COMP-1     PIC 9(10) VALUE 0. 
       01  COMP-1-WORD-R REDEFINES COMP-1-WORD. 
           05  FILLER              PIC X(09). 
           05  ONE-CHARACTER       PIC X(01). 
       01  LINE-LENGTH             PIC 9(10) VALUE 90.
       01  YEAR-OFFSET             PIC 9(02) VALUE 70.
       01  CHAR-COUNT              PIC 9(10). 
       01  BLANK-LINE              PIC X(132).
       01  POINT                   PIC X(01) VALUE ".". 
       01  ZERO-COUNT              PIC 9(10) VALUE 0. 
       01  NBR-WORDS  COMP-1       PIC 9(10) VALUE 0. 
       01  W-TAF-SEQ. 
           05  FILLER              PIC X(02). 
           05  TAF-SEQ             PIC X(08). 
      * 
      * TAF-ORG CONTAINS ONE OF THE FOLLOWING:  
      * 
      *  0  TASK ORIGIN (JOURNAL REQUEST).
      *  1  TRANSACTION SUBSYSTEM ORIGIN (INPUT). 
      *  2  DATA MANAGER ORIGIN.
      *  3  TRANSACTION SUBSYSTEM RECOVERY/STATISTICAL DATA.
      *  4  END OF TRANSACTION INDICATOR. 
      *  5  INCOMPLETE BLOCK OF TERMINAL INPUT DATA.
      *  6  TERMINAL INPUT FOR AN INTERACTIVE TASK. 
      *  7  ILLEGAL INTERCONTROL POINT TRANSFER.
      * 10  ON LINE LIBTASK UPDATE (TT OPTION). 
      * 11  CDCS DETECTED ERROR (ERROR MESSAGE FOLLOWS HEADER). 
      * 12  *MSG* REQUEST WITH ZERO FUNCTION CODE.  NORMAL FORTRAN
      *     MESSAGES ARE LOGGED WITH THIS FUNCTION CODE.
      * 
       01  W-TAF-ORG. 
           05  FILLER              PIC X(08). 
           05  TAF-ORG             PIC X(02). 
      * 
      * ERR-STATUS WILL CONTAIN ONE OF THE FOLLOWING: 
      * 
      *  -3  CIO ERROR ENCOUNTERED
      *  -2  EOI ENCOUNTERED
      *  -1  EOF ENCOUNTERED
      *   0  NO ERROR ENCOUNTERED 
      *   1  EOR ENCOUNTERED
      *   2  ZERO LENGTH RECORD ENCOUNTERED 
      * 
       01  ERR-STATUS COMP-1       PIC S9(10) VALUE 0.
      * 
       PROCEDURE DIVISION.
  
  
      ***  MAIN PROGRAM.
  
  
       DO-IT. 
           MOVE PER-PAGE           TO  DET-COUNT CNT-TO.
           OPEN OUTPUT RPT-FILE.
      * 
       READ-FIRST.
           ENTER COMPASS "READFR" 
             USING
               LOG-RECORD 
               NBR-WORDS
               ERR-STATUS 
               W-TAF-SEQ
               W-TAF-ORG
               .
           PERFORM ERROR-CHECKING.
           GO TO PROCESS-ONE. 
      * 
       READ-ONE.
           ENTER COMPASS "READNR" 
             USING
               LOG-RECORD 
               NBR-WORDS
               ERR-STATUS 
               W-TAF-SEQ
               W-TAF-ORG
               .
           PERFORM ERROR-CHECKING.
      * 
       PROCESS-ONE. 
           ADD 1 TO REC-COUNT.
           COMPUTE LOG-TRAILER-CHARACTER-COUNT =
               (LOG-TRAILER-CHARACTER-COUNT * 10).
           SUBTRACT 30 FROM LOG-TRAILER-CHARACTER-COUNT.
           ADD 1 TO ZERO-COUNT. 
           PERFORM PRINT-DETAIL.
           GO TO READ-ONE.
      * 
       CIO-ERROR. 
           DISPLAY "CIO ERROR DETECTED" UPON SCREEN.
           GO TO END-OF-JOB.
      * 
       END-OF-JOB.
           CLOSE RPT-FILE.
           DISPLAY "RECORDS READ =" REC-COUNT UPON SCREEN.
           DISPLAY "AFTER IMAGES PROCESSED    =" ZERO-COUNT UPON SCREEN.
           DISPLAY "OUTPUT ON FILE *JOURNAL*.". 
           STOP RUN.
  
  
      ***  SUBROUTINES. 
  
  
       ERROR-CHECKING.
           IF (ERR-STATUS EQUAL -1) OR (ERR-STATUS EQUAL 1) 
               OR (ERR-STATUS EQUAL 2)
               GO TO READ-ONE.
           IF ERR-STATUS EQUAL -2 
               GO TO END-OF-JOB.
           IF ERR-STATUS EQUAL -3 
               GO TO CIO-ERROR. 
      * END OF PROCEDURE ERROR-CHECKING.
  
  
       INSPECT-LOG-TRAILER. 
           INSPECT P-TASK-NAME    REPLACING ALL ":" BY " ". 
           INSPECT P-TAF-USERNAME REPLACING ALL ":" BY " ". 
           INSPECT P-LOG-TRAILER  REPLACING ALL ":" BY " ". 
      * END OF PROCEDURE INSPECT-LOG-TRAILER. 
  
  
       PRINT-DETAIL.
           ADD 1 TO DET-COUNT.
           IF DET-COUNT GREATER THAN PER-PAGE 
               MOVE 1              TO  DET-COUNT
               ADD 1 TO CNT-PAGE
               MOVE CNT-PAGE       TO  PAGE-CNT 
               MOVE CNT-FROM       TO  REC-FROM 
               MOVE CNT-TO         TO  REC-TO 
               WRITE RPT-RECORD FROM RPT-HDG-1
               WRITE RPT-RECORD FROM RPT-HDG-2
               ADD PER-PAGE TO CNT-FROM 
               ADD PER-PAGE TO CNT-TO 
               WRITE RPT-RECORD FROM RPT-HDG-2
               .
           MOVE TAF-SEQ            TO  P-TAF-SEQ. 
           MOVE TAF-ORG            TO  P-TAF-ORG. 
           MOVE LOG-TRAILER-CHARACTER-COUNT 
                                   TO  P-CHAR-COUNT.
           MOVE TAF-TASK-NAME      TO  P-TASK-NAME. 
           MOVE TAF-HR             TO  ONE-CHARACTER. 
           MOVE COMP-1-WORD        TO  P-TAF-HR.
           MOVE TAF-MN             TO  ONE-CHARACTER. 
           MOVE COMP-1-WORD        TO  P-TAF-MN.
           MOVE TAF-SC             TO  ONE-CHARACTER. 
           MOVE COMP-1-WORD        TO  P-TAF-SC.
           MOVE TAF-USERNAME       TO  P-TAF-USERNAME.
           MOVE 1                  TO  SUB1.
           MOVE SPACES             TO  P-LOG-TRAILER. 
           PERFORM WRITE-RECORD 
               UNTIL (SUB1 > LOG-TRAILER-CHARACTER-COUNT) 
                     OR (TRANEX = "*TRANEX"). 
           IF (TRANEX = "*TRANEX")
              MOVE TAF-DY TO ONE-CHARACTER
              MOVE COMP-1-WORD TO P-TAF-DY
              MOVE TAF-MT TO ONE-CHARACTER
              MOVE COMP-1-WORD TO P-TAF-MT
              MOVE TAF-YR TO ONE-CHARACTER
              MOVE COMP-1-WORD TO P-TAF-YR
              ADD YEAR-OFFSET TO P-TAF-YR 
              WRITE RPT-RECORD FROM PRINT-DATE
           ELSE IF (LOG-TRAILER-CHARACTER-COUNT = 0)
                   PERFORM WRITE-LINE.
           MOVE POINT TO P-POINT-1. 
           MOVE POINT TO P-POINT-2. 
      * END OF PROCEDURE PRINT-DETAIL.
  
  
       TRANSFER.
           MOVE LOG-TRAILER (SUB1) TO P-LOG (CHAR-COUNT). 
           ADD 1 TO CHAR-COUNT. 
           ADD 1 TO SUB1. 
      * END OF PROCEDURE TRANSFER.
  
  
       WRITE-LINE.
           PERFORM INSPECT-LOG-TRAILER. 
           WRITE RPT-RECORD FROM PRINT-A-LINE.
           MOVE BLANK-LINE TO PRINT-A-LINE. 
      * END OF PROCEDURE WRITE-LINE.
  
  
       WRITE-RECORD.
           MOVE 1 TO CHAR-COUNT.
           PERFORM TRANSFER UNTIL (CHAR-COUNT > LINE-LENGTH) OR 
               (SUB1 > LOG-TRAILER-CHARACTER-COUNT).
           PERFORM WRITE-LINE.
      * END OF PROCEDURE WRITE-RECORD.
  
  
      * END OF PROGRAM TAFLOG.
*WEOR 
          IDENT  READJ
          TITLE  READJ - READ TAF JOURNAL FILE. 
          ENTRY  READFR 
          ENTRY  READNR 
          SST 
          SYSCOM B1 
*COMMENT  TAFLOG - READ TAF JOURNAL FILE. 
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
***       READJ - READ TAF JOURNAL FILE.
* 
*         *READJ* READS ENTRIES (RECORDS) FROM THE TAF JOURNAL FILE ONE 
*         AT A TIME.  *READJ* CAN BE CALLED BY COBOL OR FORTRAN 
*         PROGRAMS.  *READJ* WILL READ PAST EOR AND EOF ON THE JOURNAL
*         FILE.  THE TAF JOURNAL FILE MUST BE A LOCAL FILE WITH THE 
*         NAME *JOUR0*.  THE ENTRY POINTS IN *READJ* ARE *READFR* 
*         AND *READNR*.  ENTRY POINT *READFR* IS USED TO READ THE FIRST 
*         RECORD FROM THE JOURNAL FILE.  ALL SUBSEQUENT RECORDS ARE 
*         READ BY CALLING *READNR*.  THERE MUST BE ONLY ONE CALL
*         (FIRST) TO *READFR* IN ANY PROGRAM READING THE JOURNAL FILE.
*         THE CALLS TO *READFR* AND *READNR* ARE EXACTLY THE SAME.
* 
*         FORTRAN CALL TO *READFR* IS:  
* 
*         CALL READFR(IREC,LEN,ISTAT,SEQ,ORG) 
* 
*         COBOL CALL TO *READFR* IS:  
* 
*         ENTER COMPASS "READFR" USING IREC, LEN, ISTAT, SEQ, ORG.
* 
*         FORTRAN CALL TO *READNR* IS:  
* 
*         CALL READNR(IREC,LEN,ISTAT,SEQ,ORG) 
* 
*         COBOL CALL TO *READNR* IS:  
* 
*         ENTER COMPASS "READNR" USING IREC, LEN, ISTAT, SEQ, ORG.
* 
*         THE PARAMETERS ARE AS FOLLOWS:  
* 
*         IREC   = FWA OF THE WORKING BUFFER WHERE THE FIRST
*                  OR NEXT RECORD WILL BE READ. THIS BUFFER 
*                  MUST BE LARGE ENOUGH TO HOLD THE LARGEST 
*                  RECORD ON THE JOURNAL FILE.
* 
*         LEN    = THIS IS AN INTEGER VARIBLE FOR FORTRAN AND 
*                  COMP-1 FOR COBOL5. 
*                  THE LENGTH OF RECORD READ IN WORDS IS
*                  RETURNED TO THE CALLER. THIS IS MEANINGFUL 
*                  ONLY WHEN ISTAT IS 0.
* 
*         ISTAT  = THIS IS AN INTEGER VARIABLE FOR FORTRAN AND
*                  COMP-1 FOR COBOL5. 
*                  THE STATUS OF THE REQUEST IS RETURNED TO THE USER
*                  IN THIS PARAMETER AFTER COMPLETION OF THE REQUEST. 
*                  -3 = CIO ERROR ON READ.
*                  -2 = EOI READ. 
*                  -1 = EOF READ. 
*                   0 = NORMAL TERMINATION. 
*                   1 = EOR READ. 
*                   2 = ZERO LENGTH RECORD READ.
* 
*         SEQ    = THIS IS A CHARACTER VARIABLE FOR FORTRAN AND COBOL5. 
*                  THE TAF SEQUENCE INDICATOR IS RETURNED TO THE
*                  CALLER AS A DISPLAY CODED OCTAL VALUE. 
* 
*         ORG    = THIS IS A CHARACTER VARIABLE FOR FORTRAN AND COBOL5. 
*                  THE TAF ORIGIN INDICATOR IS RETURNED TO THE CALLER 
*                  AS A DISPLAY CODED OCTAL VALUE.
* 
*         TO READ PAST EOR/EOF ON JOURNAL FILE THE CALLER SHOULD IGNORE 
*         EOR/EOF STATUS.  THE FILE MAY BE READ UNTIL EOI IS REACHED OR 
*         UNTIL A CIO ERROR IS ENCOUNTERED. 
          SPACE  4,10 
*CALL     COMCMAC 
          SPACE  4,10 
 JBUFL    EQU    6401D       JOURNAL FILE BUFFER LENGTH 
          SPACE  4,10 
 J        BSS    0           JOURNAL FILE FET 
 JOUR0    FILEB  JBUF,JBUFL 
 FWA      BSS    1           FWA OF USER BUFFER 
 NWORDS   BSS    1           ADDRESS FOR NUMBER OF WORDS TRANSFERRED
 STATUS   BSS    1           ADDRESS OF STATUS WORD 
 SEQADR   BSS    1           ADDRESS OF TAF SEQUENCE INDICATOR
 ORGADR   BSS    1           ADDRESS OF TAF ORIGIN
 READFR   SPACE  4,10 
**        READFR - READ FIRST RECORD. 
  
  
 READFR   SUBR               ENTRY/EXIT 
          SB1    1
          RJ     PRS         PRESET 
          REWIND J
          READ   J           READ FIRST X PRU-S 
          RJ     RNX         READ FIRST RECORD
          EQ     READFRX     RETURN 
 READNR   SPACE  4,10 
**        READNR - READ NEXT RECORD.
  
  
 READNR   SUBR               ENTRY/EXIT 
          SB1    1
          RJ     PRS         PRESET 
          RJ     RNX         READ NEXT RECORD 
          EQ     READNRX     RETURN 
          TITLE  SUBROUTINES. 
 PRS      SPACE  4,10 
**        PRS - PRESET. 
* 
*         EXIT   (FWA) = FIRST WORD OF USER BUFFER. 
*                (NWORDS) = SECOND PARAMETER ADDRESS. 
*                (STATUS) = STATUS WORD ADDRESS.
*                (SEQADR) = TAF SEQUENCE INDICATOR WORD ADDRESS.
*                (ORGADR) = TAF ORIGIN WORD ADDRESS.
  
  
 PRS      SUBR               ENTRY/EXIT 
          SX6    X1 
          SA6    FWA         SAVE FWA OF USER BUFFER
          SA2    A1+B1
          SX7    X2 
          SA7    NWORDS      SAVE SECOND PARAMETER ADDRESS
          SA2    A2+B1
          SX7    X2 
          SA7    STATUS      SAVE STATUS WORD ADDRESS 
          MX6    0
          SA6    X7          ZERO OUT ERROR STATUS
          SA2    A2+B1
          SX7    X2 
          SA7    SEQADR      SAVE TAF SEQUENCE INDICATOR WORD ADDRESS 
          SA6    X7          ZERO OUT TAF SEQUENCE INDICATOR
          SA2    A2+B1
          SX7    X2 
          SA7    ORGADR      SAVE TAF ORIGIN WORD ADDRESS 
          SA6    X7          ZERO OUT TAF ORIGIN
          EQ     PRSX        RETURN 
 RNX      SPACE  4,10 
**        RNX - READ NEXT RECORD. 
* 
*         USES   X - 0, 1, 2, 6, 7. 
*                A - 1, 2, 6, 7.
*                B - 6, 7.
* 
*         CALLS  COD. 
* 
*         MACROS READO, READW.
  
  
 RNX      SUBR               ENTRY/EXIT 
          READO  J           READ HEADER WORD 
          NZ     X1,RNX4     IF EOR/EOF 
          BX0    X6          SAVE (X6)
          SA2    RNXA 
          BX2    X6-X2       CHECK FOR LABEL RECORD 
          NZ     X2,RNX1     IF NOT LABEL RECORD
          SB7    2           NUMBER OF WORDS TO TRANSFER
          SX7    3           LENGTH OF RECORD IN WORDS
          EQ     RNX2        PROCESS LABEL RECORD 
  
 RNX1     MX1    24 
          BX1    X1*X6       GET TAF SEQUENCE INDICATOR 
          LX1    -36
          MX2    1
          LX2    -30
          BX1    X1+X2       ASSURE THAT LEADING ZEROES ARE CONVERTED 
          RJ     COD         CONVERT OCTAL TO DISPLAY CODE
          BX6    X4 
          SA2    SEQADR 
          SA6    X2          RETURN TAF SEQUENCE INDICATOR TO CALLER
          MX1    6
          LX1    -24
          BX1    X1*X0       GET TAF ORIGIN 
          LX1    -30
          MX2    1
          LX2    -30
          BX1    X1+X2       ASSURE THAT LEADING ZEROES ARE CONVERTED 
          RJ     COD         CONVERT OCTAL TO DISPLAY CODE
          BX6    X4 
          SA2    ORGADR 
          SA6    X2          RETURN TAF ORIGIN TO CALLER
          SB7    X0-1        NUMBER OF WORDS TO TRANSFER
          SX7    X0 
 RNX2     SA2    NWORDS 
          SA7    X2          RETURN WORD COUNT TO CALLER
          SA1    FWA         FWA OF USER BUFFER 
          BX6    X0          RESTORE (X6) 
          ZR     B7,RNX3     IF ONLY 1 WORD RECORD
          NG     B7,RNX5     IF ZERO LENGTH RECORD
          SA6    X1          RETURN FIRST WORD OF RECORD
          SX1    X1+B1
          READW  J,X1,B7     READ REST OF RECORD
          NZ     X1,RNX4     IF EOR/EOF 
          MX6    0           SET ERROR FLAG TO ZERO 
          EQ     RNX6        COMPLETE REQUEST 
  
 RNX3     SA6    X1          RETURN 1 WORD TO USER BUFFER 
          MX6    0
          EQ     RNX6        COMPLETE REQUEST 
  
  
*         PROCESS EOR/EOF.
  
 RNX4     SX6    X1          EOR/EOF/EOI
          SA1    J           CLEAR EOR/EOF STATUS FOR NEXT READ 
          SX0    30B
          BX7    -X0*X1 
          SA7    A1          CLEAR EOR/EOF STATUS 
          EQ     RNX6        COMPLETE REQUEST 
  
*         PROCESS ZERO-LENGTH RECORD. 
  
 RNX5     SX6    2           ZERO LENGTH RECORD 
          EQ     RNX6        COMPLETE REQUEST 
  
*         RETURN STATUS TO CALLER.
  
 RNX6     SA1    STATUS 
          SA6    X1          RETURN STATUS TO CALLER
          EQ     RNXX        RETURN TO CALLER 
  
 RNXA     DATA   C/*TRANEX*/
          SPACE 4,10
*CALL     COMCCOD 
          SPACE  4,10 
 JBUF     BSSZ   JBUFL
          END 
