DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
100
Batch/DTSBD340.cob
Normal file
100
Batch/DTSBD340.cob
Normal file
@ -0,0 +1,100 @@
|
||||
00001 IDENTIFICATION DIVISION. 11/11/02
|
||||
00002 PROGRAM-ID. DTSBD340. DTSBD340
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005
|
||||
00004 DATE-WRITTEN. JANUARY 1991. DTSBD340
|
||||
00005 DATE-COMPILED. DTSBD340
|
||||
00006 SKIP3 DTSBD340
|
||||
00007 ***** DTSBD340
|
||||
00008 * DTSBD340
|
||||
00009 * FUNCTION: RATING PROCESSING DRIVER. DTSBD340
|
||||
00010 * DTSBD340
|
||||
00011 * DTSBD340
|
||||
00012 * MODIFICATION LOG: DTSBD340
|
||||
00013 * DTSBD340
|
||||
00014 * 01/24/92 INITIAL DEVELOPMENT. DTSBD340
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DTSBD340
|
||||
00016 * DTSBD340
|
||||
00017 * 01/16/1998 REVIEWED AND MODIFIED FOR DC. DTSBD340
|
||||
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD340
|
||||
00019 * DTSBD340
|
||||
00020 * 08/20/2002 MODIFIED TO CALL DTSBD343 WHEN T006-FINAL-RATE DTSBD340
|
||||
00021 * IF TRUE. DTSBD340
|
||||
00022 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD340
|
||||
00023 * DTSBD340
|
||||
00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD340
|
||||
00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD340
|
||||
00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD340
|
||||
00027 * DTSBD340
|
||||
00028 * DTSBD340
|
||||
00029 * DESCRIPTION: DTSBD340
|
||||
00030 * DTSBD340
|
||||
00031 * EXAMINES T006-TRN-CD AND CALLS THE APPROPRIATE DTSBD340
|
||||
00032 * RATING PROCESSING MODULE. DTSBD340
|
||||
00033 * DTSBD340
|
||||
00034 ***** DTSBD340
|
||||
00035 SKIP3 DTSBD340
|
||||
00036 ENVIRONMENT DIVISION. DTSBD340
|
||||
00037 EJECT DTSBD340
|
||||
00038 DATA DIVISION. DTSBD340
|
||||
00039 SKIP3 DTSBD340
|
||||
00040 WORKING-STORAGE SECTION. DTSBD340
|
||||
000405 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD340 11/11/02'. DTSBD340
|
||||
00041 SKIP3 DTSBD340
|
||||
00042 01 WRK-AREA. DTSBD340
|
||||
00043 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +340.DTSBD340
|
||||
00044 EJECT DTSBD340
|
||||
00045 01 MSG-TABLE. DTSBD340
|
||||
00046 05 MSG1-INVALID-TRN-CD. DTSBD340
|
||||
00047 10 MSG1-ID PIC X(11) VALUE 'DTSBD340905'. DTSBD340
|
||||
00048 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID TRN CD'. DTSBD340
|
||||
00049 10 MSG1-LONG-TEXT. DTSBD340
|
||||
00050 15 FILLER PIC X(30) DTSBD340
|
||||
00051 VALUE 'TRANSACTION FAILED - TRANSACTI'. DTSBD340
|
||||
00052 15 FILLER PIC X(30) DTSBD340
|
||||
00053 VALUE 'ON CODE NOT VALID '. DTSBD340
|
||||
00054 EJECT DTSBD340
|
||||
00055 LINKAGE SECTION. DTSBD340
|
||||
00056 SKIP3 DTSBD340
|
||||
00057 01 LBCM-LINK-AREA. DTSBD340
|
||||
00058 ++INCLUDE DTSILBCM DTSBD340
|
||||
00059 EJECT DTSBD340
|
||||
00060 01 MPRF-REC. DTSBD340
|
||||
00061 ++INCLUDE DTSIMPRF DTSBD340
|
||||
00062 EJECT DTSBD340
|
||||
00063 01 T006-REC. DTSBD340
|
||||
00064 ++INCLUDE DTSIT006 DTSBD340
|
||||
00065 EJECT DTSBD340
|
||||
00066 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD340
|
||||
00067 MPRF-REC DTSBD340
|
||||
00068 T006-REC. DTSBD340
|
||||
00069 DTSBD340
|
||||
00070 DTSBD340
|
||||
00071 EVALUATE TRUE DTSBD340
|
||||
00072 DTSBD340
|
||||
00073 WHEN T006-UIRTE-EXIST-CHK DTSBD340
|
||||
00074 CALL 'DTSBD341' USING LBCM-LINK-AREA DTSBD340
|
||||
00075 MPRF-REC DTSBD340
|
||||
00076 T006-REC DTSBD340
|
||||
00077 DTSBD340
|
||||
00078 WHEN T006-UIRTE-NOTICE DTSBD340
|
||||
00079 CALL 'DTSBD343' USING LBCM-LINK-AREA DTSBD340
|
||||
00080 MPRF-REC DTSBD340
|
||||
00081 T006-REC DTSBD340
|
||||
00082 DTSBD340
|
||||
00083 WHEN T006-FINAL-RATE DTSBD340
|
||||
00084 CALL 'DTSBD343' USING LBCM-LINK-AREA DTSBD340
|
||||
00085 MPRF-REC DTSBD340
|
||||
00086 T006-REC DTSBD340
|
||||
00087 DTSBD340
|
||||
00088 WHEN OTHER DTSBD340
|
||||
00089 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD340
|
||||
00090 MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA DTSBD340
|
||||
00091 END-EVALUATE. DTSBD340
|
||||
00092 DTSBD340
|
||||
00093 DTSBD340
|
||||
00094 GOBACK. DTSBD340
|
||||
00095 EJECT DTSBD340
|
||||
00096 S999-ABEND. DTSBD340
|
||||
00097 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD340
|
||||
00098 S999-EXIT. DTSBD340
|
||||
00099 EXIT. DTSBD340
|
||||
Reference in New Issue
Block a user