DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
56
Batch/DTSBU999.cob
Normal file
56
Batch/DTSBU999.cob
Normal file
@ -0,0 +1,56 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/05/98
|
||||
00002 PROGRAM-ID. DTSBU999. DTSBU999
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV002
|
||||
00004 DATE-WRITTEN. OCTOBER 1991. DTSBU999
|
||||
00005 DATE-COMPILED. DTSBU999
|
||||
00006 SKIP3 DTSBU999
|
||||
00007 ***** DTSBU999
|
||||
00008 * DTSBU999
|
||||
00009 * FUNCTION: ABEND PROCESSOR. DTSBU999
|
||||
00010 * DTSBU999
|
||||
00011 * DTSBU999
|
||||
00012 * MODIFICATION LOG: DTSBU999
|
||||
00013 * DTSBU999
|
||||
00014 * 08/05/98 INITIAL DEVELOPMENT. MODIFIED FROM MACBU999. CL**2
|
||||
00015 * WORK ORDER: PROGRAMMER: ZL1. CL**2
|
||||
00016 * DTSBU999
|
||||
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU999
|
||||
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU999
|
||||
00019 * WORK ORDER: PROGRAMMER: XXX DTSBU999
|
||||
00020 * DTSBU999
|
||||
00021 * DTSBU999
|
||||
00022 * DESCRIPTION: DTSBU999
|
||||
00023 * DTSBU999
|
||||
00024 ***** DTSBU999
|
||||
00025 SKIP3 DTSBU999
|
||||
00026 ENVIRONMENT DIVISION. DTSBU999
|
||||
00027 SKIP3 DTSBU999
|
||||
00028 DATA DIVISION. DTSBU999
|
||||
00029 SKIP3 DTSBU999
|
||||
00030 WORKING-STORAGE SECTION. DTSBU999
|
||||
000305 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU999 08/05/98'. DTSBU999
|
||||
00031 SKIP3 DTSBU999
|
||||
00032 01 WRK-AREA. DTSBU999
|
||||
00033 05 WRK-ABEND-CODE PIC S9(04) COMP. DTSBU999
|
||||
00034 EJECT DTSBU999
|
||||
00035 LINKAGE SECTION. DTSBU999
|
||||
00036 SKIP3 DTSBU999
|
||||
00037 01 ABEND-CODE PIC S9(04) COMP. DTSBU999
|
||||
00038 EJECT DTSBU999
|
||||
00039 PROCEDURE DIVISION USING ABEND-CODE. DTSBU999
|
||||
00040 SKIP2 DTSBU999
|
||||
00041 DISPLAY '*** UI TAX SYSTEM ABEND. ABEND CODE = ' DTSBU999
|
||||
00042 ABEND-CODE. DTSBU999
|
||||
00043 DTSBU999
|
||||
00044 MOVE ABEND-CODE TO WRK-ABEND-CODE. DTSBU999
|
||||
00045 DTSBU999
|
||||
00046 IF (WRK-ABEND-CODE > 0) DTSBU999
|
||||
00047 AND DTSBU999
|
||||
00048 (WRK-ABEND-CODE < 4096) DTSBU999
|
||||
00049 NEXT SENTENCE DTSBU999
|
||||
00050 ELSE DTSBU999
|
||||
00051 MOVE 999 TO WRK-ABEND-CODE. DTSBU999
|
||||
00052 DTSBU999
|
||||
00053 CALL 'ILBOABN0' USING WRK-ABEND-CODE. DTSBU999
|
||||
00054 SKIP2 DTSBU999
|
||||
00055 GOBACK. DTSBU999
|
||||
Reference in New Issue
Block a user