DUTAS re-platformed to Raincode - Initial Source Code

This commit is contained in:
Neeraj Kumar
2025-07-21 07:44:09 -04:00
commit ca3572c5df
2773 changed files with 798221 additions and 0 deletions

100
Batch/DTSBD340.cob Normal file
View 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