DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
291
Batch/DTSBU103.cob
Normal file
291
Batch/DTSBU103.cob
Normal file
@ -0,0 +1,291 @@
|
||||
00001 IDENTIFICATION DIVISION. 06/29/02
|
||||
00002 PROGRAM-ID. DTSBU103. DTSBU103
|
||||
00003 AUTHOR. TRW. LV001
|
||||
00004 DATE-WRITTEN. FEBRUARY 2002. DTSBU103
|
||||
00005 DATE-COMPILED. DTSBU103
|
||||
00006 SKIP3 DTSBU103
|
||||
00007 ***** DTSBU103
|
||||
00008 * DTSBU103
|
||||
00009 * FUNCTION: LATE PAYMENT PENALTY CHARGE/WAIVER CALCULATION DTSBU103
|
||||
00010 * >> FOR ANNUAL REPORTS << DTSBU103
|
||||
00011 * DTSBU103
|
||||
00012 * MODIFICATION LOG: DTSBU103
|
||||
00013 * DTSBU103
|
||||
00014 * 11/14/1998 MODIFIED FROM DTSBU102 DTSBU103
|
||||
00015 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBU103
|
||||
00016 * DTSBU103
|
||||
00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU103
|
||||
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU103
|
||||
00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU103
|
||||
00020 * DTSBU103
|
||||
00021 * DTSBU103
|
||||
00022 * DESCRIPTION: DTSBU103
|
||||
00023 * DTSBU103
|
||||
00024 * COMPUTES LATE PAYMENT PENALTY CHARGED (PER SECTION 3.1.3.4 DTSBU103
|
||||
00025 * OF THE REQUIREMENTS DOCUMENT AND COMPUTES LATE PAYMENT DTSBU103
|
||||
00026 * PENALTY WAIVED (PER SECTION 3.1.4.3 OF THE REQUIREMENTS DTSBU103
|
||||
00027 * DOCUMENT. DTSBU103
|
||||
00028 * DTSBU103
|
||||
00029 ***** DTSBU103
|
||||
00030 SKIP3 DTSBU103
|
||||
00031 ENVIRONMENT DIVISION. DTSBU103
|
||||
00032 EJECT DTSBU103
|
||||
00033 DATA DIVISION. DTSBU103
|
||||
00034 SKIP3 DTSBU103
|
||||
00035 WORKING-STORAGE SECTION. DTSBU103
|
||||
000355 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU103 06/29/02'. DTSBU103
|
||||
00036 DTSBU103
|
||||
00037 01 WRK-AREA. DTSBU103
|
||||
00038 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +103.DTSBU103
|
||||
00039 DTSBU103
|
||||
00040 05 WRK-PEN-PCT PIC S9(01)V9(03) COMP-3 DTSBU103
|
||||
00041 VALUE +0.010. DTSBU103
|
||||
00042 DTSBU103
|
||||
00043 05 WRK-FIXED-PEN PIC S9(03)V9(02) COMP-3 DTSBU103
|
||||
00044 VALUE +100.00. DTSBU103
|
||||
00045 DTSBU103
|
||||
00046 05 WRK-LATE-ORIG-RPT-IND PIC X(01). DTSBU103
|
||||
00047 88 WRK-LATE-ORIG-RPT-YES-88 VALUE 'Y'. DTSBU103
|
||||
00048 88 WRK-LATE-ORIG-RPT-NO-88 VALUE 'N'. DTSBU103
|
||||
00049 DTSBU103
|
||||
00050 05 WRK-INIT-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBU103
|
||||
00051 88 WRK-INIT-COMPLETE-YES-88 VALUE 'Y'. DTSBU103
|
||||
00052 88 WRK-INIT-COMPLETE-NO-88 VALUE 'N'. DTSBU103
|
||||
00053 DTSBU103
|
||||
00054 05 PEN-CALC-TYPE-IND PIC X(01). DTSBU103
|
||||
00055 88 PEN-CALC-FROM-PCT-88 VALUE '0'. DTSBU103
|
||||
00056 88 PEN-CALC-FIXED-AMT-88 VALUE '1'. DTSBU103
|
||||
00057 88 PEN-CALC-TYPE-VALID-88 VALUE '0' '1'. DTSBU103
|
||||
00058 DTSBU103
|
||||
00059 05 WRK-BASE-AMT PIC S9(09)V9(02) COMP-3. DTSBU103
|
||||
00060 DTSBU103
|
||||
00061 05 WRK-TOT-PEN-AMT PIC S9(09)V9(02) COMP-3. DTSBU103
|
||||
00062 DTSBU103
|
||||
00063 EJECT DTSBU103
|
||||
00064 LINKAGE SECTION. DTSBU103
|
||||
00065 SKIP3 DTSBU103
|
||||
00066 01 L103-LINK-AREA. DTSBU103
|
||||
00067 ++INCLUDE DTSIL103 DTSBU103
|
||||
00068 EJECT DTSBU103
|
||||
00069 PROCEDURE DIVISION USING L103-LINK-AREA. DTSBU103
|
||||
00070 DTSBU103-MAINLINE. DTSBU103
|
||||
00071 DTSBU103
|
||||
00072 IF NOT L103-OPTION-VALID-88 DTSBU103
|
||||
00073 DISPLAY '*** DTSBU103 ABENDING: INVALID OPTION ' DTSBU103
|
||||
00074 L103-OPTION DTSBU103
|
||||
00075 PERFORM S999-ABEND THRU S999-EXIT. DTSBU103
|
||||
00076 DTSBU103
|
||||
00077 MOVE +0 TO L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
||||
00078 L103-LATE-PEN-WAIVE-CHNG. DTSBU103
|
||||
00079 DTSBU103
|
||||
00080 IF L103-INITIALIZATION-88 DTSBU103
|
||||
00081 PERFORM I0000-INIT THRU I0000-EXIT DTSBU103
|
||||
00082 GO TO DTSBU103-MAINLINE-EXIT. DTSBU103
|
||||
00083 DTSBU103
|
||||
00084 IF WRK-INIT-COMPLETE-NO-88 DTSBU103
|
||||
00085 OR NOT PEN-CALC-TYPE-VALID-88 DTSBU103
|
||||
00086 DISPLAY '*** DTSBU103 ABENDING: INIT NOT COMPLETE' DTSBU103
|
||||
00087 PERFORM S999-ABEND THRU S999-EXIT. DTSBU103
|
||||
00088 DTSBU103
|
||||
00089 IF L103-LIABLE-QTR-CNT = ZERO DTSBU103
|
||||
00090 DISPLAY '*** DTSBU103: QTR CNT = ZERO' DTSBU103
|
||||
00091 GO TO DTSBU103-MAINLINE-EXIT. DTSBU103
|
||||
00092 DTSBU103
|
||||
00093 PERFORM P1000-PEN-CHARGE THRU P1000-EXIT. DTSBU103
|
||||
00094 DTSBU103
|
||||
00095 DTSBU103
|
||||
00096 PERFORM P2000-WAIVE THRU P2000-EXIT. DTSBU103
|
||||
00097 DTSBU103
|
||||
00098 DTSBU103
|
||||
00099 DTSBU103-MAINLINE-EXIT. DTSBU103
|
||||
00100 GOBACK. DTSBU103
|
||||
00101 EJECT DTSBU103
|
||||
00102 I0000-INIT. DTSBU103
|
||||
00103 SET WRK-INIT-COMPLETE-YES-88 TO TRUE. DTSBU103
|
||||
00104 DTSBU103
|
||||
00105 IF L103-OR-RECEIVED-DATE > L103-RPT-DUE-DATE DTSBU103
|
||||
00106 SET WRK-LATE-ORIG-RPT-YES-88 TO TRUE DTSBU103
|
||||
00107 ELSE DTSBU103
|
||||
00108 SET WRK-LATE-ORIG-RPT-NO-88 TO TRUE DTSBU103
|
||||
00109 END-IF. DTSBU103
|
||||
00110 DTSBU103
|
||||
00111 *& DTSBU103
|
||||
00112 * DISPLAY 'DTSBU103 INIT' DTSBU103
|
||||
00113 * ' RCVD ' L103-OR-RECEIVED-DATE DTSBU103
|
||||
00114 * ' DUE ' L103-RPT-DUE-DATE DTSBU103
|
||||
00115 * IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
||||
00116 * DISPLAY ' LATE REPORT' DTSBU103
|
||||
00117 * ELSE DTSBU103
|
||||
00118 * DISPLAY ' TIMELY REPORT'. DTSBU103
|
||||
00119 *& DTSBU103
|
||||
00120 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
||||
00121 IF (L103-INIT-TOT-CHG * WRK-PEN-PCT) > WRK-FIXED-PEN DTSBU103
|
||||
00122 SET PEN-CALC-FROM-PCT-88 TO TRUE DTSBU103
|
||||
00123 ELSE DTSBU103
|
||||
00124 SET PEN-CALC-FIXED-AMT-88 TO TRUE DTSBU103
|
||||
00125 END-IF DTSBU103
|
||||
00126 ELSE DTSBU103
|
||||
00127 COMPUTE WRK-TOT-PEN-AMT = DTSBU103
|
||||
00128 (L103-INIT-TOT-BAL * WRK-PEN-PCT) DTSBU103
|
||||
00129 IF WRK-TOT-PEN-AMT > WRK-FIXED-PEN DTSBU103
|
||||
00130 SET PEN-CALC-FROM-PCT-88 TO TRUE DTSBU103
|
||||
00131 ELSE DTSBU103
|
||||
00132 SET PEN-CALC-FIXED-AMT-88 TO TRUE DTSBU103
|
||||
00133 END-IF DTSBU103
|
||||
00134 END-IF. DTSBU103
|
||||
00135 DTSBU103
|
||||
00136 MOVE ZERO TO WRK-TOT-PEN-AMT. DTSBU103
|
||||
00137 *& DTSBU103
|
||||
00138 * DISPLAY 'DTSBU103 INIT '. DTSBU103
|
||||
00139 * DISPLAY ' TOT CHG ' L103-INIT-TOT-CHG. DTSBU103
|
||||
00140 * IF PEN-CALC-FROM-PCT-88 DTSBU103
|
||||
00141 * DISPLAY ' CALC FROM PERCENT' DTSBU103
|
||||
00142 * ELSE DTSBU103
|
||||
00143 * DISPLAY ' FIXED PENALTY'. DTSBU103
|
||||
00144 *& DTSBU103
|
||||
00145 I0000-EXIT. DTSBU103
|
||||
00146 EXIT. DTSBU103
|
||||
00147 DTSBU103
|
||||
00148 P1000-PEN-CHARGE. DTSBU103
|
||||
00149 IF L103-PEN-CHARGE-MANUAL-88 DTSBU103
|
||||
00150 GO TO P1000-EXIT. DTSBU103
|
||||
00151 DTSBU103
|
||||
00152 *& DTSBU103
|
||||
00153 DISPLAY 'DTSBU103 L103 LAST PEN YRQ ' DTSBU103
|
||||
00154 L103-LAST-PEN-ASSESSED-YRQ DTSBU103
|
||||
00155 ' YRQ ' L103-MQTR-YRQ. DTSBU103
|
||||
00156 *& DTSBU103
|
||||
00157 IF L103-LAST-PEN-ASSESSED-YRQ = ZERO DTSBU103
|
||||
00158 GO TO P1000-EXIT DTSBU103
|
||||
00159 ELSE DTSBU103
|
||||
00160 IF L103-MQTR-YRQ > L103-LAST-PEN-ASSESSED-YRQ DTSBU103
|
||||
00161 GO TO P1000-EXIT. DTSBU103
|
||||
00162 DTSBU103
|
||||
00163 IF L103-LATE-PEN-CHARGED-AMT > +0 DTSBU103
|
||||
00164 GO TO P1000-EXIT. DTSBU103
|
||||
00165 DTSBU103
|
||||
00166 SET WRK-LATE-ORIG-RPT-NO-88 TO TRUE. DTSBU103
|
||||
00167 MOVE ZERO TO WRK-BASE-AMT. DTSBU103
|
||||
00168 DTSBU103
|
||||
00169 IF L103-PEN-ASSESSMENT-RUN-88 DTSBU103
|
||||
00170 OR L103-ORIGINAL-RPT-88 DTSBU103
|
||||
00171 PERFORM P1100-CHK-LATE-ORIG-RPT THRU P1100-EXIT DTSBU103
|
||||
00172 PERFORM P1200-CALC-ORIG-BASE-AMT THRU P1200-EXIT DTSBU103
|
||||
00173 ELSE DTSBU103
|
||||
00174 IF L103-NSF-PAY-REVERSAL-88 DTSBU103
|
||||
00175 PERFORM P1300-CALC-NSF-BASE-AMT THRU P1300-EXIT DTSBU103
|
||||
00176 ELSE DTSBU103
|
||||
00177 IF L103-ESTIMATED-RPT-88 DTSBU103
|
||||
00178 MOVE L103-TAX-CHARGED-AMT TO WRK-BASE-AMT DTSBU103
|
||||
00179 END-IF DTSBU103
|
||||
00180 END-IF DTSBU103
|
||||
00181 END-IF. DTSBU103
|
||||
00182 DTSBU103
|
||||
00183 PERFORM S1000-COMPUTE-PENALTY THRU S1000-EXIT. DTSBU103
|
||||
00184 DTSBU103
|
||||
00185 P1000-EXIT. DTSBU103
|
||||
00186 EXIT. DTSBU103
|
||||
00187 DTSBU103
|
||||
00188 P1100-CHK-LATE-ORIG-RPT. DTSBU103
|
||||
00189 IF L103-OR-RECEIVED-DATE > L103-RPT-DUE-DATE DTSBU103
|
||||
00190 SET WRK-LATE-ORIG-RPT-YES-88 TO TRUE DTSBU103
|
||||
00191 END-IF. DTSBU103
|
||||
00192 DTSBU103
|
||||
00193 P1100-EXIT. DTSBU103
|
||||
00194 EXIT. DTSBU103
|
||||
00195 DTSBU103
|
||||
00196 P1200-CALC-ORIG-BASE-AMT. DTSBU103
|
||||
00197 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
||||
00198 MOVE L103-TAX-CHARGED-AMT TO WRK-BASE-AMT DTSBU103
|
||||
00199 ELSE DTSBU103
|
||||
00200 MOVE L103-TAX-BALANCE-AMT TO WRK-BASE-AMT DTSBU103
|
||||
00201 END-IF. DTSBU103
|
||||
00202 DTSBU103
|
||||
00203 P1200-EXIT. DTSBU103
|
||||
00204 EXIT. DTSBU103
|
||||
00205 DTSBU103
|
||||
00206 P1300-CALC-NSF-BASE-AMT. DTSBU103
|
||||
00207 MOVE L103-TAX-BALANCE-AMT TO WRK-BASE-AMT. DTSBU103
|
||||
00208 DTSBU103
|
||||
00209 P1300-EXIT. DTSBU103
|
||||
00210 EXIT. DTSBU103
|
||||
00211 DTSBU103
|
||||
00212 EJECT DTSBU103
|
||||
00213 P2000-WAIVE. DTSBU103
|
||||
00214 IF L103-LATE-PEN-CHARGE-CHNG > +0 DTSBU103
|
||||
00215 NEXT SENTENCE DTSBU103
|
||||
00216 ELSE DTSBU103
|
||||
00217 GO TO P2000-EXIT. DTSBU103
|
||||
00218 DTSBU103
|
||||
00219 IF L103-WAIVE-LATE-PEN-YES-88 DTSBU103
|
||||
00220 MOVE L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
||||
00221 TO L103-LATE-PEN-WAIVE-CHNG DTSBU103
|
||||
00222 GO TO P2000-EXIT. DTSBU103
|
||||
00223 DTSBU103
|
||||
00224 IF (L103-PEN-ASSESSMENT-RUN-88) DTSBU103
|
||||
00225 OR DTSBU103
|
||||
00226 (L103-ORIGINAL-RPT-88) DTSBU103
|
||||
00227 IF (L103-OR-RECEIVED-DATE < L103-WAIVE-PEN-START-DATE) DTSBU103
|
||||
00228 OR DTSBU103
|
||||
00229 (L103-OR-RECEIVED-DATE > L103-WAIVE-PEN-END-DATE) DTSBU103
|
||||
00230 OR DTSBU103
|
||||
00231 (L103-OR-RECEIVED-DATE = +0) DTSBU103
|
||||
00232 NEXT SENTENCE DTSBU103
|
||||
00233 ELSE DTSBU103
|
||||
00234 MOVE L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
||||
00235 TO L103-LATE-PEN-WAIVE-CHNG. DTSBU103
|
||||
00236 P2000-EXIT. DTSBU103
|
||||
00237 EXIT. DTSBU103
|
||||
00238 EJECT DTSBU103
|
||||
00239 S1000-COMPUTE-PENALTY. DTSBU103
|
||||
00240 *& DTSBU103
|
||||
00241 DISPLAY 'DTSBU103 S1000 1 BAL ' L103-TAX-BALANCE-AMT DTSBU103
|
||||
00242 ' PEN BAL ' WRK-TOT-PEN-AMT DTSBU103
|
||||
00243 ' LAST QTR ' L103-LAST-LIABLE-YRQ DTSBU103
|
||||
00244 ' QTR CNT ' L103-LIABLE-QTR-CNT. DTSBU103
|
||||
00245 *& DTSBU103
|
||||
00246 IF WRK-LATE-ORIG-RPT-YES-88 DTSBU103
|
||||
00247 NEXT SENTENCE DTSBU103
|
||||
00248 ELSE DTSBU103
|
||||
00249 IF L103-TAX-BALANCE-AMT NOT > ZERO DTSBU103
|
||||
00250 GO TO S1000-EXIT DTSBU103
|
||||
00251 END-IF DTSBU103
|
||||
00252 END-IF. DTSBU103
|
||||
00253 DTSBU103
|
||||
00254 IF PEN-CALC-FIXED-AMT-88 DTSBU103
|
||||
00255 IF L103-MQTR-YRQ > L103-LAST-LIABLE-YRQ DTSBU103
|
||||
00256 GO TO S1000-EXIT. DTSBU103
|
||||
00257 DTSBU103
|
||||
00258 IF PEN-CALC-FROM-PCT-88 DTSBU103
|
||||
00259 COMPUTE L103-LATE-PEN-CHARGE-CHNG ROUNDED DTSBU103
|
||||
00260 = WRK-BASE-AMT * WRK-PEN-PCT DTSBU103
|
||||
00261 ELSE DTSBU103
|
||||
00262 COMPUTE L103-LATE-PEN-CHARGE-CHNG = DTSBU103
|
||||
00263 (1 / L103-LIABLE-QTR-CNT) * WRK-FIXED-PEN. DTSBU103
|
||||
00264 DTSBU103
|
||||
00265 *& DTSBU103
|
||||
00266 DISPLAY 'DTSBU103 S1000 2 ' L103-MQTR-YRQ DTSBU103
|
||||
00267 ' PENALTY ' L103-LATE-PEN-CHARGE-CHNG. DTSBU103
|
||||
00268 *& DTSBU103
|
||||
00269 ADD L103-LATE-PEN-CHARGE-CHNG TO WRK-TOT-PEN-AMT. DTSBU103
|
||||
00270 DTSBU103
|
||||
00271 IF PEN-CALC-FIXED-AMT-88 DTSBU103
|
||||
00272 IF L103-MQTR-YRQ = L103-LAST-LIABLE-YRQ DTSBU103
|
||||
00273 IF WRK-TOT-PEN-AMT < WRK-FIXED-PEN DTSBU103
|
||||
00274 COMPUTE L103-LATE-PEN-CHARGE-CHNG = DTSBU103
|
||||
00275 L103-LATE-PEN-CHARGE-CHNG + DTSBU103
|
||||
00276 (WRK-FIXED-PEN - WRK-TOT-PEN-AMT) DTSBU103
|
||||
00277 ADD L103-LATE-PEN-CHARGE-CHNG DTSBU103
|
||||
00278 TO WRK-TOT-PEN-AMT. DTSBU103
|
||||
00279 DTSBU103
|
||||
00280 *& DTSBU103
|
||||
00281 DISPLAY 'DTSBU103 S1000 3' L103-MQTR-YRQ DTSBU103
|
||||
00282 ' CORRECTED PENALTY ' L103-LATE-PEN-CHARGE-CHNG. DTSBU103
|
||||
00283 *& DTSBU103
|
||||
00284 S1000-EXIT. DTSBU103
|
||||
00285 EXIT. DTSBU103
|
||||
00286 EJECT DTSBU103
|
||||
00287 S999-ABEND. DTSBU103
|
||||
00288 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU103
|
||||
00289 S999-EXIT. DTSBU103
|
||||
00290 EXIT. DTSBU103
|
||||
Reference in New Issue
Block a user