-ADD COBV9PRT,PSWD=40EF,ARC,SEQ=/1,6,100,100/
-DESC COBOL-LE COMPILER PRINTER EXIT
-PGMR STEVE RYDER, JSR SYSTEMS
-LANG COB
001000 IDENTIFICATION DIVISION.
001100 PROGRAM-ID.     COBV9PRT.
001200*AUTHOR.         STEVE RYDER JSR SYSTEMS.
001300 DATE-WRITTEN.   JANUARY 27, 1998.
001400 DATE-COMPILED.
001410*MODIFICATION HISTORY.
001420*---
001430*---
001440*---
001450*---
001460*---
001470*---
001480*---1998/11/30  MOVE EXIT-PAGE LEFT TWO BYTES.
001490*---
001500*REMARKS.
001600*    COMPILER PRINT EXIT FOR COBOL/VSE COMPILER.
001610*  ALL = PRINT ALL LINES, SAME AS NOT USING EXIT.
001615*  NOP = NO PRINT AT ALL.
001620*  ERR = PRINT LINE BEFORE AND AFTER ANY ERROR LINES.
001630*  *** = (DEFAULT), PRINT JUST PROGRAM PART.  SINCE DMAP AND XREF
001640*        DATA IS LISTED WITH PROGRAM, SUPPRESS.
001650*-----------------------------------------------------------------
001700*
001800 ENVIRONMENT DIVISION.
001900 CONFIGURATION SECTION.
002000 SPECIAL-NAMES.
002100     C01 IS TOP-OF-FORM.
002200 INPUT-OUTPUT SECTION.
002300 FILE-CONTROL.
002400     SELECT  PRINT-FILE
002500*        ASSIGN TO  SYS008-PRINT.
002510         FILE STATUS IS PRINT-STATUS
002520         ASSIGN TO  UT-S-PRINT.
002600 DATA DIVISION.
002700 FILE    SECTION.
002800 FD  PRINT-FILE
002900     LABEL RECORDS ARE   STANDARD
003000     RECORDING MODE IS   F
003100     RECORD CONTAINS 133 CHARACTERS
003200     BLOCK CONTAINS  1   RECORDS
003300     DATA RECORD IS  PRINT-REC.
003400 01  PRINT-REC.
003500     05  PRINT-CC.
003600         10  FILLER              PIC X(01).
003700     05  PRINT-LINE              PIC X(132).
003800 WORKING-STORAGE SECTION.
003900 01  MY-PROGRAM-ID               PIC X(08) VALUE 'COBV9PRT'.
004000 01  SYSSNAP-ID                  PIC X(08) VALUE 'SYSSNAP '.
004100 01  SYSSNAP-4                   PIC S9(4) BINARY VALUE +4.
004200 01  SYSSNAP-100                 PIC S9(4) BINARY VALUE +100.
004210 01  PRINT-STATUS                PIC X(02) VALUE '00'.
004220 01  ENTRY-COUNT                 PIC 9(06) VALUE ZERO.
004300 01  EXIT-OPEN-PARM.
004400     05  OPEN-STRING-LENGTH      PIC S9(4) COMP.
004500     05  OPEN-STRING             PIC X(03).
004600*        CAN BE UP TO 64 BYTES, WE LOOK ONLY AT FIRST 3.
004700 01  SAVE-LINES                  VALUE SPACES.
004800     05  SAVE-LINE               PIC X(133) OCCURS 5 TIMES.
004900 01  STATUS-FLAGS.
005000     05  PRINT-NEXT              PIC S9(04) BINARY VALUE ZERO.
005100     05  PRINT-FLAG              PIC X(01) VALUE '0'.
005200         88  PRINT-YES           VALUE '1' '3'.
005300 LINKAGE SECTION.
005400 01  EXIT-TYPE                   PIC S9(4) COMP.
005500 01  EXIT-OPERATION              PIC S9(4) COMP.
005600 01  EXIT-RETURNCODE             PIC S9(5) COMP.
005700 01  EXIT-WORKAREA.
005800     05  INPUT-SLOT              PIC S9(5) COMP.
005900     05  LIBEXIT-SLOT            PIC S9(5) COMP.
006000     05  SYSLST-SLOT             PIC S9(5) COMP.
006100     05  RESERVED-SLOT           PIC S9(5) COMP.
006200 01  EXIT-DATALENGTH             PIC S9(5) COMP.
006300 01  EXIT-DATAAREA.
006400     05  EXIT-CC                 PIC X(01).
006500     05  EXIT-1-8.
006600         10  EXIT-1-2            PIC X(02).
006700         10  FILLER              PIC X(06).
006800*****05  FILLER                  PIC X(105).1998/11/30
006900*****05  EXIT-PAGE               PIC X(18). MOVE PAGE LEFT 2 BYTES
006910     05  FILLER                  PIC X(103).
006920     05  EXIT-PAGE               PIC X(08).
006930     05  FILLER                  PIC X(12).
007000 01  EXIT-LIBRARY                PIC X(08).
007100 01  EXIT-SYSTEXT                PIC X(08).
007200 01  EXIT-CBLLIBRARY             PIC X(30).
007300 01  EXIT-CBLTEXT                PIC X(30).
007500 PROCEDURE DIVISION USING
007600     EXIT-TYPE
007700     EXIT-OPERATION
007800     EXIT-RETURNCODE
007900     EXIT-WORKAREA
008000     EXIT-DATALENGTH
008100     EXIT-DATAAREA
008200     EXIT-LIBRARY
008300     EXIT-SYSTEXT
008400     EXIT-CBLLIBRARY
008500     EXIT-CBLTEXT.
008600 0000-COBV9PRT.
008700*    DISPLAY 'COBV9PRT--ENTERING TYPE=' EXIT-TYPE
008800*                              ' OPRN=' EXIT-OPERATION
008810     ADD 1 TO ENTRY-COUNT
008900     IF  EXIT-TYPE = 3
009000         PERFORM 1000-HANDLE-PRINT
009100     ELSE
009200         DISPLAY 'COBV9PRT--INVALID EXIT-TYPE=' EXIT-TYPE
009300         MOVE 16 TO EXIT-RETURNCODE
009400     .
009500     GOBACK
009600     .
009700 1000-HANDLE-PRINT.
009800     IF  EXIT-OPERATION = 0
009900*        DISPLAY 'COBV9PRT--OPENING OUTPUT'
010000*        CALL SYSSNAP-ID USING SYSSNAP-100  EXIT-DATAAREA
010100         MOVE EXIT-DATAAREA    TO EXIT-OPEN-PARM
010200         IF  OPEN-STRING-LENGTH < 3
010300             MOVE '***' TO OPEN-STRING
010400         END-IF
010500         OPEN OUTPUT  PRINT-FILE
010510         IF  PRINT-STATUS NOT = '00'
010520             DISPLAY 'COBV9PRT--OPEN STATUS=' PRINT-STATUS
010530         END-IF
010600         MOVE 00 TO EXIT-RETURNCODE
010700     ELSE
010800     IF  EXIT-OPERATION = 1
010900*        DISPLAY 'COBV9PRT--CLOSING PRINT'
011000         CLOSE       PRINT-FILE
011100         MOVE 00 TO EXIT-RETURNCODE
011200     ELSE
011300     IF  EXIT-OPERATION = 3
011410*        DISPLAY 'COBV9PRT--PRINT FLAG: ' PRINT-FLAG ':'
011420*                EXIT-CC ':' EXIT-1-8 ':' EXIT-PAGE '!'
011430*                ENTRY-COUNT
011500         PERFORM 9100-PRINT
011600     ELSE
011700         DISPLAY 'COBV9PRT--INVALID EXIT-OPRN=' EXIT-OPERATION
011800     .
011900 9100-PRINT.
012000     MOVE 0 TO EXIT-RETURNCODE
012100*    CALL SYSSNAP-ID USING SYSSNAP-100  EXIT-DATAAREA
012200     IF  OPEN-STRING = 'NOP'
012300         NEXT SENTENCE
012400     ELSE
012500     IF  OPEN-STRING = 'ALL'
012600         PERFORM 9150-PRINT-AS-IS
012700     ELSE
012800     IF  OPEN-STRING = 'ERR'
012900         PERFORM 9120-CHECK-ERR
013000     ELSE
013100         PERFORM 9110-CHECK
013200     .
013300 9110-CHECK.
013400     IF  PRINT-FLAG = '0'
013500*        IF  EXIT-1-8 = 'PP 5686-'
013510         IF  EXIT-1-8 = 'PP 5648-'
013600*        AND EXIT-PAGE = '    2   '
013610         AND EXIT-PAGE = '    2   '
013700             MOVE '1' TO PRINT-FLAG
013800         END-IF
013900     ELSE
014000     IF  PRINT-FLAG = '1'
014100         IF  EXIT-1-2 = '*/'
014200             MOVE '2' TO PRINT-FLAG
014300         END-IF
014400     ELSE
014500     IF  PRINT-FLAG = '2'
014600         IF  EXIT-1-8 = '* Statis'
014700*------------------------ABOVE MUST BE MIXED CASE!!!!!!
014800             MOVE '3' TO PRINT-FLAG
014900         END-IF
015000     .
015100     IF  PRINT-YES
015200         PERFORM 9150-PRINT-AS-IS
015300     .
015400 9120-CHECK-ERR.
015500     IF  PRINT-FLAG = '0'
015600*        IF  EXIT-1-8 = 'PP 5686-'
015610         IF  EXIT-1-8 = 'PP 5648-'
015700*        AND EXIT-PAGE = '    2   '
015710         AND EXIT-PAGE = '    2   '
015800             MOVE '1' TO PRINT-FLAG
015900         END-IF
016000     ELSE
016100     IF  PRINT-FLAG = '1'
016200         IF  EXIT-1-2 = '*/'
016300             MOVE '2' TO PRINT-FLAG
016400         END-IF
016500     .
016600     IF  PRINT-YES
016700         IF  EXIT-1-2 = SPACES
016710         AND PRINT-NEXT = ZERO
016800             MOVE SAVE-LINE (2) TO SAVE-LINE (1)
016900             MOVE SAVE-LINE (3) TO SAVE-LINE (2)
017000             MOVE SAVE-LINE (4) TO SAVE-LINE (3)
017100             MOVE SAVE-LINE (5) TO SAVE-LINE (4)
017200             MOVE EXIT-DATAAREA TO SAVE-LINE (5)
017300         ELSE
017400         IF  EXIT-1-2 = '=='
017500             MOVE 3 TO PRINT-NEXT
017600             IF  SAVE-LINE (1) NOT = SPACES
017700                 WRITE PRINT-REC FROM SAVE-LINE (1) AFTER 1
017800             END-IF
017900             IF  SAVE-LINE (2) NOT = SPACES
018000                 WRITE PRINT-REC FROM SAVE-LINE (2) AFTER 1
018100             END-IF
018200             IF  SAVE-LINE (3) NOT = SPACES
018300                 WRITE PRINT-REC FROM SAVE-LINE (3) AFTER 1
018400             END-IF
018500             IF  SAVE-LINE (4) NOT = SPACES
018600                 WRITE PRINT-REC FROM SAVE-LINE (4) AFTER 1
018700             END-IF
018800             IF  SAVE-LINE (1) NOT = SPACES
018900                 WRITE PRINT-REC FROM SAVE-LINE (5) AFTER 1
019000             END-IF
019100             MOVE SPACES TO SAVE-LINES
019200     .
019300     IF  PRINT-YES
019400     AND PRINT-NEXT > 0
019500         WRITE PRINT-REC FROM EXIT-DATAAREA AFTER 1
019600         SUBTRACT 1 FROM PRINT-NEXT
019700     .
019800 9150-PRINT-AS-IS.
019900     MOVE EXIT-DATAAREA TO PRINT-REC
020000     IF  PRINT-CC = ' '
020100         WRITE PRINT-REC AFTER 1
020200     ELSE
020300     IF  PRINT-CC = '1'
020400         WRITE PRINT-REC AFTER TOP-OF-FORM
020500     ELSE
020600     IF  PRINT-CC = '0'
020700         WRITE PRINT-REC AFTER 2
020800     ELSE
020900     IF  PRINT-CC = '-'
021000         WRITE PRINT-REC AFTER 3
021100     ELSE
021200         WRITE PRINT-REC AFTER 1
021300     .
021400 END PROGRAM COBV9PRT.
-END
