DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
180
Batch/DTSBU541.cob
Normal file
180
Batch/DTSBU541.cob
Normal file
@ -0,0 +1,180 @@
|
||||
00001 IDENTIFICATION DIVISION. 12/13/98
|
||||
00002 PROGRAM-ID. DTSBU541. DTSBU541
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003
|
||||
00004 DATE-WRITTEN. JANUARY 1991. CL**2
|
||||
00005 DATE-COMPILED. CL**2
|
||||
00006 SKIP3 CL**2
|
||||
00007 ***** CL**2
|
||||
00008 * CL**2
|
||||
00009 * FUNCTION: MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED CL**3
|
||||
00010 * OR WRITTEN OFF AMOUNT IN A QUARTER (MQTR) CL**3
|
||||
00011 * RECORD. CL**3
|
||||
00012 * CL**3
|
||||
00013 * CL**2
|
||||
00014 * MODIFICATION LOG: CL**2
|
||||
00015 * CL**2
|
||||
00016 * 01/26/92 INITIAL DEVELOPMENT. CL**2
|
||||
00017 * WORK ORDER: PROGRAMMER: TCL CL**2
|
||||
00018 * CL**2
|
||||
00019 * 12/13/1998 REVIEWED AND MODIFIED FOR DC. CL**3
|
||||
00020 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH CL**3
|
||||
00021 * CL**3
|
||||
00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
||||
00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**3
|
||||
00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**3
|
||||
00025 * CL**2
|
||||
00026 * CL**2
|
||||
00027 * DESCRIPTION: CL**2
|
||||
00028 * CL**2
|
||||
00029 * MODIFY THE ACCOUNTING AMOUNT DEFINED BY MQTR-REC, CL**2
|
||||
00030 * L541-ACCT-SUB, AND L541-CAT-IND BY L541-AMT. CL**2
|
||||
00031 * CL**2
|
||||
00032 * MAINTAIN THE BALANCE DUE, MQTR LEVEL AMOUNTS CL**2
|
||||
00033 * AND MPRF-BALANCE-DUE-AMT. CALL DTSBU549 TO CL**3
|
||||
00034 * DO JOURNALING AND BATCH DETAIL LISTING. CL**2
|
||||
00035 * CL**2
|
||||
00036 * CL**2
|
||||
00037 * NOTE: DTSBU541 DOES NOT DO ANY MASTER FILE I/O. CL**3
|
||||
00038 * IF YOU FEEL A NEED TO INSERT MASTER FILE I/O CL**2
|
||||
00039 * INTO DTSBU541, THEN YOU ARE PROBABLY MAKING CL**3
|
||||
00040 * A MISTAKE. CL**2
|
||||
00041 * CL**2
|
||||
00042 * CL**2
|
||||
00043 * MASTER FILE RECORDS READ: CL**2
|
||||
00044 * CL**2
|
||||
00045 * NONE CL**2
|
||||
00046 * CL**2
|
||||
00047 * CL**2
|
||||
00048 * MASTER FILE RECORDS UPDATED: CL**2
|
||||
00049 * CL**2
|
||||
00050 * NONE CL**2
|
||||
00051 * CL**2
|
||||
00052 * CL**2
|
||||
00053 * REPORT RECORDS WRITTEN: CL**2
|
||||
00054 * CL**2
|
||||
00055 * NONE. CL**2
|
||||
00056 * CL**2
|
||||
00057 * CL**2
|
||||
00058 * MODULES CALLED: CL**2
|
||||
00059 * CL**2
|
||||
00060 * DTSBU549 JOURNALING/BATCH DETAIL LISTING. CL**3
|
||||
00061 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. CL**3
|
||||
00062 * CL**2
|
||||
00063 * CL**2
|
||||
00064 ***** CL**2
|
||||
00065 SKIP3 CL**2
|
||||
00066 ENVIRONMENT DIVISION. CL**2
|
||||
00067 EJECT CL**2
|
||||
00068 DATA DIVISION. CL**2
|
||||
00069 SKIP3 CL**2
|
||||
00070 WORKING-STORAGE SECTION. CL**2
|
||||
000705 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU541 12/13/98'. CL**2
|
||||
00071 SKIP3 CL**2
|
||||
00072 01 WRK-AREA. CL**2
|
||||
00073 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +541. CL**2
|
||||
00074 CL**3
|
||||
00075 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. CL**2
|
||||
00076 EJECT CL**2
|
||||
00077 01 L549-LINK-AREA. CL**2
|
||||
00078 ++INCLUDE DTSIL549 CL**3
|
||||
00079 EJECT CL**2
|
||||
00080 01 CACT-LITERALS. CL**2
|
||||
00081 ++INCLUDE DTSICACT CL**3
|
||||
00082 EJECT CL**2
|
||||
00083 LINKAGE SECTION. CL**2
|
||||
00084 SKIP3 CL**2
|
||||
00085 01 L541-LINK-AREA. CL**2
|
||||
00086 ++INCLUDE DTSIL541 CL**3
|
||||
00087 EJECT CL**2
|
||||
00088 01 MPRF-REC. CL**2
|
||||
00089 ++INCLUDE DTSIMPRF CL**3
|
||||
00090 EJECT CL**2
|
||||
00091 01 MQTR-REC. CL**2
|
||||
00092 ++INCLUDE DTSIMQTR CL**3
|
||||
00093 EJECT CL**2
|
||||
00094 PROCEDURE DIVISION USING L541-LINK-AREA CL**2
|
||||
00095 MPRF-REC CL**2
|
||||
00096 MQTR-REC. CL**2
|
||||
00097 CL**3
|
||||
00098 CL**3
|
||||
00099 IF FIRST-TIME-IND = 'Y' CL**2
|
||||
00100 PERFORM I0000-INITIATE THRU I0000-EXIT CL**2
|
||||
00101 MOVE 'N' TO FIRST-TIME-IND. CL**2
|
||||
00102 CL**3
|
||||
00103 CL**3
|
||||
00104 IF L541-AMT NOT = 0 CL**2
|
||||
00105 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**2
|
||||
00106 CL**3
|
||||
00107 CL**3
|
||||
00108 GOBACK. CL**2
|
||||
00109 EJECT CL**2
|
||||
00110 I0000-INITIATE. CL**2
|
||||
00111 I0000-EXIT. CL**2
|
||||
00112 EXIT. CL**2
|
||||
00113 EJECT CL**2
|
||||
00114 P0000-PROCESS. CL**2
|
||||
00115 MOVE MQTR-YRQ TO L549-DELTA-YRQ. CL**2
|
||||
00116 CL**3
|
||||
00117 MOVE MQTR-ACCT-IND (L541-ACCT-SUB) TO L549-DELTA-ACCT-IND. CL**2
|
||||
00118 CL**3
|
||||
00119 IF L541-CAT-IND = CACT-CAT-CHARGED CL**2
|
||||
00120 ADD L541-AMT TO MQTR-CHARGED-AMT (L541-ACCT-SUB) CL**2
|
||||
00121 ADD L541-AMT TO MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
||||
00122 MPRF-TOT-BALANCE-AMT CL**2
|
||||
00123 MOVE CACT-CAT-CHARGED TO L549-DELTA-CAT-IND CL**2
|
||||
00124 IF MQTR-CHARGED-AMT (L541-ACCT-SUB) < +0 CL**2
|
||||
00125 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
||||
00126 ELSE CL**2
|
||||
00127 NEXT SENTENCE CL**2
|
||||
00128 ELSE CL**2
|
||||
00129 IF L541-CAT-IND = CACT-CAT-WAIVED CL**3
|
||||
00130 ADD L541-AMT TO MQTR-WAIVED-AMT (L541-ACCT-SUB) CL**3
|
||||
00131 SUBTRACT L541-AMT FROM MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
||||
00132 MPRF-TOT-BALANCE-AMT CL**2
|
||||
00133 MOVE CACT-CAT-WAIVED TO L549-DELTA-CAT-IND CL**3
|
||||
00134 IF MQTR-WAIVED-AMT (L541-ACCT-SUB) < +0 CL**3
|
||||
00135 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
||||
00136 ELSE CL**2
|
||||
00137 NEXT SENTENCE CL**2
|
||||
00138 ELSE CL**2
|
||||
00139 IF L541-CAT-IND = CACT-CAT-WRITTEN-OFF CL**3
|
||||
00140 ADD L541-AMT TO MQTR-WRITTEN-OFF-AMT (L541-ACCT-SUB) CL**3
|
||||
00141 SUBTRACT L541-AMT FROM MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
||||
00142 MPRF-TOT-BALANCE-AMT CL**2
|
||||
00143 MOVE CACT-CAT-WRITTEN-OFF TO L549-DELTA-CAT-IND CL**3
|
||||
00144 IF MQTR-WRITTEN-OFF-AMT (L541-ACCT-SUB) < +0 CL**3
|
||||
00145 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
||||
00146 ELSE CL**2
|
||||
00147 NEXT SENTENCE CL**2
|
||||
00148 ELSE CL**2
|
||||
00149 IF L541-CAT-IND = CACT-CAT-TOLER CL**2
|
||||
00150 ADD L541-AMT TO MQTR-TOLER-AMT (L541-ACCT-SUB) CL**2
|
||||
00151 SUBTRACT L541-AMT FROM MQTR-BALANCE-AMT (L541-ACCT-SUB) CL**2
|
||||
00152 MPRF-TOT-BALANCE-AMT CL**2
|
||||
00153 MOVE CACT-CAT-TOLER TO L549-DELTA-CAT-IND CL**2
|
||||
00154 IF MQTR-TOLER-AMT (L541-ACCT-SUB) < +0 CL**2
|
||||
00155 PERFORM S999-ABEND THRU S999-EXIT CL**2
|
||||
00156 ELSE CL**2
|
||||
00157 NEXT SENTENCE CL**2
|
||||
00158 ELSE CL**2
|
||||
00159 PERFORM S999-ABEND THRU S999-EXIT. CL**2
|
||||
00160 CL**3
|
||||
00161 MOVE L541-AMT TO L549-DELTA-AMT. CL**2
|
||||
00162 CL**3
|
||||
00163 PERFORM S549-MJRN-TABLE THRU S549-EXIT. CL**2
|
||||
00164 P0000-EXIT. CL**2
|
||||
00165 EXIT. CL**2
|
||||
00166 EJECT CL**2
|
||||
00167 S549-MJRN-TABLE. CL**2
|
||||
00168 SET L549-DELTA-88 TO TRUE. CL**2
|
||||
00169 CL**3
|
||||
00170 MOVE L541-TRN-DOC-NO TO L549-TRN-DOC-NO. CL**2
|
||||
00171 CL**3
|
||||
00172 CALL 'DTSBU549' USING L549-LINK-AREA. CL**3
|
||||
00173 S549-EXIT. CL**2
|
||||
00174 EXIT. CL**2
|
||||
00175 SKIP3 CL**2
|
||||
00176 S999-ABEND. CL**2
|
||||
00177 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**3
|
||||
00178 S999-EXIT. CL**2
|
||||
00179 EXIT. CL**2
|
||||
Reference in New Issue
Block a user