IDENTIFICATION DIVISION. PROGRAM-ID. UTL587. AUTHOR. Barry L. Wallis. INSTALLATION. Fleetwood Enterprises, Inc. DATE-WRITTEN. 24-Jul-85. ******************************************************************************* * PROGRAM FUNCTIONS: * This subprogram should be called whenever an interactive program needs * to abnormally terminate. Use of this program with SYS$INPUT assigned * to anything but a terminal is unsupported and may result in the * program aborting. Please note, this program will NEVER return to the * calling program. * * PROGRAM OPTIONS: * * PROGRAM MODIFICATIONS: * * AUTHOR Barry Wallis. * DATE 12-Jun-86 * VERSION 1-B * * PROGRAM CHANGES: * * Add entry point UTL587A for programs which wish to perform error * processing and have control returned to it. * ****************************************************************************** DATA DIVISION. LINKAGE SECTION. 01 PASSED-PROG-ID PIC X(9). 01 PASSED-SCOPE-ERROR-NO COMP PIC S9(5). COPY "SCOPE-SCREEN-IMAGE" IN "LIB:SCPLIB.TLB". COPY "ABNORMAL-TERMINATION-RECORD" IN "LIB:UTLLIB.TLB". ******************************************************************************** PROCEDURE DIVISION USING ABNORMAL-TERMINATION-RECORD, PASSED-SCOPE-ERROR-NO, SCOPE-SCREEN-IMAGE, PASSED-PROG-ID. MAIN SECTION. 010-MAIN-ROUTINE. CALL "UTL587X" USING ABNORMAL-TERMINATION-RECORD, PASSED-SCOPE-ERROR-NO, SCOPE-SCREEN-IMAGE, PASSED-PROG-ID. * * The following STOP RUN means execution will NEVER return to the * calling program! * STOP RUN. END PROGRAM UTL587. / IDENTIFICATION DIVISION. PROGRAM-ID. UTL587A. ******************************************************************************** DATA DIVISION. LINKAGE SECTION. 01 PASSED-PROG-ID PIC X(9). 01 PASSED-SCOPE-ERROR-NO COMP PIC S9(5). COPY "SCOPE-SCREEN-IMAGE" IN "LIB:SCPLIB.TLB". COPY "ABNORMAL-TERMINATION-RECORD" IN "LIB:UTLLIB.TLB". ******************************************************************************** PROCEDURE DIVISION USING ABNORMAL-TERMINATION-RECORD, PASSED-SCOPE-ERROR-NO, SCOPE-SCREEN-IMAGE, PASSED-PROG-ID. MAIN SECTION. 020-MAIN-ROUTINE. CALL "UTL587X" USING ABNORMAL-TERMINATION-RECORD, PASSED-SCOPE-ERROR-NO, SCOPE-SCREEN-IMAGE, PASSED-PROG-ID. EXIT PROGRAM. END PROGRAM UTL587A. / IDENTIFICATION DIVISION. PROGRAM-ID. UTL587X. ENVIRONMENT DIVISION. CONFIGURATION SECTION. SOURCE-COMPUTER. VAX-11. OBJECT-COMPUTER. VAX-11. SPECIAL-NAMES. C01 IS TOP-OF-PAGE. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT PRINT-FILE ASSIGN TO DISK. SELECT PRINT-QUEUE ASSIGN TO DISK. / DATA DIVISION. FILE SECTION. FD PRINT-FILE VALUE OF ID IS PRINT-FILE-ID. 01 PRINT-FILE-RECORD PIC X(132). FD PRINT-QUEUE VALUE OF ID IS PRINT-QUEUE-ID. 01 PRINT-QUEUE-RECORD PIC X(132). / WORKING-STORAGE SECTION. 01 PROG-ID PIC X(9) VALUE "UTL587-1B". COPY "SCOPE-STATUS-RECORD" IN "LIB:SCPLIB.TLB". COPY "FORM-UTL587SCR" IN "LIB:UTLLIB.TLB". 01 CONSTANTS. 05 CLEAR-SCREEN COMP PIC S9(9) VALUE 1. 05 DISABLE-FUNCTION COMP PIC S9(9) VALUE 0. 05 ENABLE-FUNCTION COMP PIC S9(9) VALUE 1. 05 FIRST-FIELD-NO COMP PIC S9(9) VALUE 1. 05 FRM-FILENAME PIC X(9) VALUE "UTL587SCR". 05 MAX-LINES-PER-SCREEN COMP PIC S9(9) VALUE 24. 05 OPTIMIZE-TTY-IO COMP PIC S9(9) VALUE 3. 05 DONT-OUTPUT-SCREEN-IMAGE COMP PIC S9(9) VALUE 1. 05 SET-UP-BUFFERS PIC X(1) VALUE "*". 01 DISPLAY-SCOPE-ERROR-NO PIC -(4)9(1). 01 FILE-IDS. 05 PRINT-FILE-ID PIC X(11) VALUE "FATAL.ERROR". 05 PRINT-QUEUE-ID PIC X(21) VALUE "SYS$PRINT:FATAL.ERROR". 01 SEPARATOR-LINE PIC X(132) VALUE ALL "-". 01 X COMP PIC S9(9). / LINKAGE SECTION. 01 PASSED-PROG-ID PIC X(9). 01 PASSED-SCOPE-ERROR-NO COMP PIC S9(5). COPY "SCOPE-SCREEN-IMAGE" IN "LIB:SCPLIB.TLB". COPY "ABNORMAL-TERMINATION-RECORD" IN "LIB:UTLLIB.TLB". / PROCEDURE DIVISION USING ABNORMAL-TERMINATION-RECORD, PASSED-SCOPE-ERROR-NO, SCOPE-SCREEN-IMAGE, PASSED-PROG-ID. ****************************************************************************** INITIALIZATION SECTION. ****************************************************************************** 090-INITIALIZATION. CALL "SCPRT" USING BY DESCRIPTOR CLEAR-SCREEN. * We ignore any errors from the "reset terminal" call. * MOVE SPACES TO SCOPE-TERMINAL-NAME. MOVE SET-UP-BUFFERS TO SCOPE-BUFFER-NAME. MOVE ZERO TO SCOPE-BACKTAB-LIMIT. MOVE FRM-FILENAME TO SCOPE-FORM-NAME. CALL "SCPIN" USING BY DESCRIPTOR SCOPE-STATUS-RECORD. PERFORM 800-CHECK-SCOPE-RETURN-STATUS THRU 800-EXIT. IF SCOPE-ERROR GO TO 900-CLOSING END-IF. CALL "SCPCF" USING BY DESCRIPTOR DONT-OUTPUT-SCREEN-IMAGE, ENABLE-FUNCTION. PERFORM 800-CHECK-SCOPE-RETURN-STATUS THRU 800-EXIT. IF SCOPE-ERROR GO TO 900-CLOSING END-IF. OPEN OUTPUT PRINT-FILE. OPEN OUTPUT PRINT-QUEUE. GO TO 100-MAIN. / ****************************************************************************** MAIN SECTION. ****************************************************************************** 100-MAIN. PERFORM 200-DISPLAY-SCREEN THRU 200-EXIT. * * Write the screen image passed by the user. PERFORM 250-WRITE-SCOPE-SCREEN-IMAGE THRU 250-EXIT. * PERFORM 300-GET-CONFIRMATION THRU 300-EXIT. * * Get our own screen image and write it. CALL "SCPSS" USING BY DESCRIPTOR SCOPE-SCREEN-IMAGE. PERFORM 800-CHECK-SCOPE-RETURN-STATUS THRU 800-EXIT. IF NOT SCOPE-ERROR PERFORM 250-WRITE-SCOPE-SCREEN-IMAGE THRU 250-EXIT END-IF. * GO TO 900-CLOSING. / ****************************************************************************** SUBROUTINE SECTION. ****************************************************************************** 200-DISPLAY-SCREEN. * * Display the abnormal termination screen. * NOTE The screen will not be displayed until we do a read from it if * SCOPE's screen optimization is on. * MOVE PROG-ID TO SCR-PROG-ID. * MOVE PASSED-PROG-ID TO SCR-PASSED-PROG-ID. MOVE PASSED-SCOPE-ERROR-NO TO SCR-SCOPE-ERROR-NO. * MOVE AT-COBOL-FILE-STATUS TO SCR-COBOL-FILE-STATUS. MOVE AT-RMS-STS TO SCR-RMS-STS. MOVE AT-RMS-STV TO SCR-RMS-STV. MOVE AT-RMS-FILENAME TO SCR-RMS-FILENAME. MOVE AT-OUTPUT-LINE(1) TO SCR-OUTPUT-LINE-1. MOVE AT-OUTPUT-LINE(2) TO SCR-OUTPUT-LINE-2. MOVE AT-OUTPUT-LINE(3) TO SCR-OUTPUT-LINE-3. MOVE AT-OUTPUT-LINE(4) TO SCR-OUTPUT-LINE-4. MOVE AT-OUTPUT-LINE(5) TO SCR-OUTPUT-LINE-5. MOVE AT-OUTPUT-LINE(6) TO SCR-OUTPUT-LINE-6. MOVE AT-OUTPUT-LINE(7) TO SCR-OUTPUT-LINE-7. MOVE AT-OUTPUT-LINE(8) TO SCR-OUTPUT-LINE-8. MOVE AT-OUTPUT-LINE(9) TO SCR-OUTPUT-LINE-9. MOVE AT-OUTPUT-LINE(10) TO SCR-OUTPUT-LINE-10. MOVE AT-OUTPUT-LINE(11) TO SCR-OUTPUT-LINE-11. MOVE AT-OUTPUT-LINE(12) TO SCR-OUTPUT-LINE-12. * MOVE SPACES TO SCR-INPUT-FIELD. * MOVE FIRST-FIELD-NO TO SCOPE-NEXT-FIELD. MOVE FNO-SCR-MAX-FIELD-NUMBER TO SCOPE-END-FIELD. CALL "SCPWR" USING BY DESCRIPTOR FORM-SCR. PERFORM 800-CHECK-SCOPE-RETURN-STATUS THRU 800-EXIT. IF SCOPE-ERROR GO TO 900-CLOSING END-IF. 200-EXIT. EXIT. / 250-WRITE-SCOPE-SCREEN-IMAGE. * * Write the contents of SCOPE-SCREEN-IMAGE to the print queue and a file. * PERFORM WITH TEST BEFORE VARYING X FROM 1 BY 1 UNTIL X > MAX-LINES-PER-SCREEN WRITE PRINT-FILE-RECORD FROM SCOPE-IMAGE(X) WRITE PRINT-QUEUE-RECORD FROM SCOPE-IMAGE(X) END-PERFORM. WRITE PRINT-FILE-RECORD FROM SEPARATOR-LINE. WRITE PRINT-QUEUE-RECORD FROM SEPARATOR-LINE. 250-EXIT. EXIT. 300-GET-CONFIRMATION. * * Keep reading the screen until the user types PF1-M. * PERFORM WITH TEST AFTER UNTIL SCOPE-USER-ESCAPE AND SCOPE-MENU MOVE SPACES TO SCR-INPUT-FIELD MOVE FNO-SCR-INPUT-FIELD TO SCOPE-NEXT-FIELD CALL "SCPRF" USING BY DESCRIPTOR FORM-SCR PERFORM 800-CHECK-SCOPE-RETURN-STATUS THRU 800-EXIT IF SCOPE-ERROR GO TO 900-CLOSING END-IF END-PERFORM. 300-EXIT. EXIT. 800-CHECK-SCOPE-RETURN-STATUS. * * We handle all SCOPE errors in a single place. * IF SCOPE-ERROR MOVE SCOPE-ERROR-NO TO DISPLAY-SCOPE-ERROR-NO DISPLAY ">>> Fatal SCOPE error (", DISPLAY-SCOPE-ERROR-NO, ") <<<" END-IF. 800-EXIT. EXIT. / ****************************************************************************** CLOSING SECTION. ****************************************************************************** 900-CLOSING. * * Erase the screen and close the files. * IF NOT SCOPE-ERROR CALL "SCPRT" USING BY DESCRIPTOR CLEAR-SCREEN PERFORM 800-CHECK-SCOPE-RETURN-STATUS THRU 800-EXIT END-IF. * CLOSE PRINT-FILE. CLOSE PRINT-QUEUE.