home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
cobol
/
library
/
assist
/
abend2.cbl
next >
Wrap
Text File
|
1993-12-08
|
9KB
|
241 lines
000100$SET ANS85 NOOSVS MF
000110
000200 IDENTIFICATION DIVISION.
000300 PROGRAM-ID. ABEND.
000400 AUTHOR. GEORGE HARRIS.
000410
000500********************** ABEND2.CBL ***********************************
000510** copyright 1993 George F. Harris
000520**
000600** THIS PROGRAM WILL IDENTIFY FILE STATUS CODE MESSAGES, INCLUDING
000610** IBM 370/390 AND VAX.
000620**
000630** BINARY REDEFINITION OF FILE STATUS NOT SUPPORTED.
002500********************************************************************
002600 ENVIRONMENT DIVISION.
002610 CONFIGURATION SECTION.
002700**********************
002800* special names section CRT Status identifies exact usage of
002900* -cursor position a function key and th number of the
003000* - crt status key used.
003100**********************
003110 SPECIAL-NAMES.
003120 cursor is cursor-position
003130 crt status is key-status.
003140 FILE-CONTROL.
003160****************************
003206* FILE STATUS RETURN CODES
003207****************************
003208 SELECT STATFILE ASSIGN TO "FSTAT2.DAT"
003210 ORGANIZATION IS INDEXED
003220 RECORD KEY IS IND-KEY
003230 ACCESS IS DYNAMIC
003240 FILE STATUS IS IND-STATUS.
003300 DATA DIVISION.
003310 FILE SECTION.
003394 FD STATFILE
003395 DATA RECORD IS IND-REC.
003396 01 IND-REC.
003397 05 STAT-DEFINE PIC X(72).
003398 05 PIC X.
003399 05 IND-KEY PIC X(4).
003401 WORKING-STORAGE SECTION.
003405*******************
003406* KEYS
003407*******************
003408 01 TEMP-STATUS-KEY.
003409 05 TEMP-KEY-1 PIC X(2) VALUE SPACES.
003410 05 TEMP-KEY-2 PIC XX VALUE "00".
003435 01 WS-STATUS.
003436 05 FIRST-WS PIC X.
003437 05 SECOND-WS PIC X.
003438 01 IND-STATUS.
003439 05 FST-IND PIC X.
003440 05 SND-IND PIC X.
003441 01 WORK-FILES.
003470 05 CHAIN-STATUS PIC X(4) VALUE SPACES.
003490 05 ERR-MSG-1 PIC X(72) VALUE SPACES.
003500 05 ERR-MSG-2 PIC X(72) VALUE SPACES.
003600*************************
003700* CURSOR POSITION FIELDS allows positioning of cursor
003800*************************
003810 01 cursor-position.
003820 05 cursor-row pic 99 value zeros.
003830 05 cursor-column pic 99 value zeros.
003840*********************************************************************
003850** CRT STATUS KEYS
003860*********************************************************************
003870************************
003880* fields used to get a CALL X"AF" USING get-single-char
003890* single character with key-status
003891* call x"af" using Allows a single key from the keyboard
003892* command Holds action until key is pressed
003893************************
003894 01 Get-single-char pic 9(2) comp-x value 26.
003895 01 key-status.
003896 05 key-type pic x.
003897 05 key-code-1 pic 9(2) comp-x.
003898 05 key-code-2 pic 9(2) comp-x.
003899**********************************************************************
003900** The following fields are used with the call x"af" function to
003901** enable or disable various function and user keys
003902**********************************************************************
003903************************
003904* fields used to enable/
003905* disable adis messages, CALL X"AF" USING set-bit-pairs
003906* indicators and displays parameter-block
003907* using call x"af" command
003908************************
003909 01 set-bit-pairs pic 9(2) comp-x value 1.
003910 01 parameter-block.
003911 05 bit-pair-setting pic 9(2) comp-x.
003912 05 filler pic x value "2".
003913 05 bit-pair-number pic 9(2) comp-x.
003914 05 filler pic 9(2) comp-x value 1.
003915************************
003916* fields used to enable/
003917* disable function keys, CALL X"AF" USING set-bit-pairs-1
003918* using call x"af" command user-key-control
003919************************
003920 01 set-bit-pairs-1 pic 9(2) comp-x value 1.
003921 01 user-key-control.
003922 05 user-key-setting pic 9(2) comp-x.
003923 05 filler pic x value "1".
003924 05 first-user-key pic 9(2) comp-x.
003925 05 number-of-keys pic 9(2) comp-x.
003926**************************
003927* changes the key mapping CALL X"AF' USING set-map-byte
003928* from within the program ADIS-key-mapping
003929* using call x"af" using
003930* command
003931**************************
003932 01 set-map-byte pic 9(2) comp-x.
003933 01 adis-key-mapping.
003934 05 adis-mapping-byte pic 9(2) comp-x.
003935 05 adis-key-number pic 9(2) comp-x.
003936**********************************************************************
003937** SCREEN DISPLAY
003938**********************************************************************
003939 SCREEN SECTION.
003940 01 menu-screen.
003944 05 line 2 col 27 value "FILE STATUS RETURN CODES".
003948 05 line 6 col 11 value
003949 "ENTER FILE STATUS RETURN CODE AND PRESS THE F2 FUNCTION KEY"
003950- .
003951 05 line 8 col 11 value
003952 "FILE STATUS CODE:" HIGHLIGHT.
003953 05 line 8 col 30 pic X(2) to TEMP-KEY-1.
003954 05 line 14 col 2 value "STATUS MESSAGE FOR FILE STATUS".
003955 05 line 14 col 33 pic X(2) from TEMP-KEY-1 reverse-video.
003956 05 line 14 col 36 value "IS:".
003957 05 line 16 col 2 pic x(72) from err-msg-1 highlight.
003958 05 line 17 col 2 pic x(72) from err-msg-2.
003965 05 line 24 col 1 value
003966 " F1= MAIN HELP F2= FILE STATUS CODES
003967- " F10= RETURN TO DOS".
003968 01 BLANK-SCREEN.
003969 PROCEDURE DIVISION.
003970 000-main.
003971 MOVE SPACES TO TEMP-KEY-1.
003972 PERFORM 010-ENABLE.
003973 PERFORM 100-GET-SCREEN.
003974 010-ENABLE.
003975************************
003976*ENABLES FUNCITON KEYS
003977*F-1 THROUGH F-10
003978************************
003979 MOVE 1 TO USER-KEY-SETTING.
003980 MOVE 1 TO FIRST-USER-KEY.
003981 MOVE 10 TO NUMBER-OF-KEYS.
003982 CALL X"AF" USING SET-BIT-PAIRS-1
003983 USER-KEY-CONTROL.
003984 100-GET-SCREEN.
003985***********************
003986* sets color of screen
003987***********************
003988 DISPLAY " " AT 0101
003989 upon CRT
003990 erase
003991 with
003992 foreground-color is 7
003993 background-color is 1.
003994*************************
003995* displays main screen
003996*************************
004010 MOVE 8 TO CURSOR-ROW.
004100 MOVE 35 TO CURSOR-POSITION.
004301 DISPLAY MENU-SCREEN.
004311 ACCEPT MENU-SCREEN.
004330************************
004340* Sets up function keys
004350************************
004360 IF KEY-CODE-1 = 1
004361 IF ERR-MSG-1 = SPACES
004362 CHAIN "SOC7.EXE "
004363 ELSE
004367 CHAIN "DETAIL1A.EXE " USING CHAIN-STATUS
004369 ELSE
004370 IF KEY-CODE-1 = 2
004373 MOVE SPACES TO ERR-MSG-1
004380 PERFORM 300-FILE-STATUS
004390 ELSE
004391 IF KEY-CODE-1 = 3
004392 MOVE "INVALID KEY" TO ERR-MSG-1
004393 PERFORM 100-GET-SCREEN
004396 ELSE
004397 IF KEY-CODE-1 = 4
004398 MOVE "INVALID KEY" TO ERR-MSG-1
004399 PERFORM 100-GET-SCREEN
004400 ELSE
004401 IF KEY-CODE-1 = 5
004402 MOVE "INVALID KEY" TO ERR-MSG-1
004403 PERFORM 100-GET-SCREEN
004404 ELSE
004405 IF KEY-CODE-1 = 6
004406 MOVE "INVALID KEY" TO ERR-MSG-1
004407 PERFORM 100-GET-SCREEN
004411 ELSE
004412 IF KEY-CODE-1 = 7
004413 MOVE "INVALID KEY" TO ERR-MSG-1
004414 PERFORM 100-GET-SCREEN
004416 ELSE
004417 IF KEY-CODE-1 = 8
004418 MOVE "INVALID KEY" TO ERR-MSG-1
004419 PERFORM 100-GET-SCREEN
004421 ELSE
004422 IF KEY-CODE-1 = 9
004423 MOVE "INVALID KEY" TO ERR-MSG-1
004424 PERFORM 100-GET-SCREEN
004426 ELSE
004427 IF KEY-CODE-1 = 10
004428 DISPLAY " " AT 0101
004429 upon CRT
004430 erase
004431 with
004432 foreground-color is 7
004433 background-color is 1
004435 PERFORM 999-ENDER.
004438 300-FILE-STATUS.
004439 MOVE TEMP-STATUS-KEY TO CHAIN-STATUS.
004451 PERFORM 350-STATUS.
004452 350-STATUS.
004453 OPEN I-O STATFILE.
004454 IF IND-STATUS NOT = "00"
004455 MOVE IND-STATUS TO ERR-MSG-1
004456 PERFORM 100-GET-SCREEN
004457 ELSE
004459 PERFORM 375-READ-IT.
004460 375-READ-IT.
004463 MOVE TEMP-STATUS-KEY TO IND-KEY.
004465 READ STATFILE.
004466 IF IND-STATUS NOT = "00"
004467 MOVE "NOT A VALID CODE" TO ERR-MSG-1
004468 CLOSE STATFILE
004469 PERFORM 100-GET-SCREEN
004470 ELSE
004471 MOVE STAT-DEFINE TO ERR-MSG-1
004472 CLOSE STATFILE
004473 PERFORM 100-GET-SCREEN.
004520 999-ENDER.
004600 STOP RUN.