DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
672
Batch/DTSBD343.cob
Normal file
672
Batch/DTSBD343.cob
Normal file
@ -0,0 +1,672 @@
|
||||
00001 IDENTIFICATION DIVISION. 11/11/02
|
||||
00002 PROGRAM-ID. DTSBD343. DTSBD343
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV008
|
||||
00004 DATE-WRITTEN. JANUARY 1991. DTSBD343
|
||||
00005 DATE-COMPILED. DTSBD343
|
||||
00006 SKIP3 DTSBD343
|
||||
00007 ***** DTSBD343
|
||||
00008 * DTSBD343
|
||||
00009 * FUNCTION: RATE NOTICE GENERATION. DTSBD343
|
||||
00010 * DTSBD343
|
||||
00011 * DTSBD343
|
||||
00012 * MODIFICATION LOG: DTSBD343
|
||||
00013 * DTSBD343
|
||||
00014 * 01/09/92 INITIAL DEVELOPMENT. DTSBD343
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DTSBD343
|
||||
00016 * DTSBD343
|
||||
00017 * 01/25/1999 REVIEWED AND MODIFIED FOR DC. DTSBD343
|
||||
00018 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD343
|
||||
00019 * DTSBD343
|
||||
00020 * 08/20/2002 MODIFIED TO FINALIZE ESTIMATED RATE AND PRINT DTSBD343
|
||||
00021 * RATE NOTICE WHEN T006-FINAL-RATE IS TRUE. DTSBD343
|
||||
00022 * PROGRAM WILL PRINT ERROR REPORT IF DTSBD343
|
||||
00023 * T006-FINAL-RATE IS NOT TRUE AND RATE IS DTSBD343
|
||||
00024 * ESTIMATED. DTSBD343
|
||||
00025 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD343
|
||||
00026 * DTSBD343
|
||||
00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD343
|
||||
00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD343
|
||||
00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD343
|
||||
00030 * DTSBD343
|
||||
00031 * DTSBD343
|
||||
00032 * DESCRIPTION: DTSBD343
|
||||
00033 * DTSBD343
|
||||
00034 * IF, FOR A GIVEN EMP-NO AND START-YRQ, DTSBD343 IS CALLED DTSBD343
|
||||
00035 * MORE THAN ONCE, THEN BYPASS PROCESSING ON ALL CALLS OTHER DTSBD343
|
||||
00036 * THAN THE FIRST. YOU MAY ASSUME THE TRANSACTIONS WILL DTSBD343
|
||||
00037 * ARRIVE IN T006-START-YRQ WITHIN T006-EMP-NO SEQUENCE. DTSBD343
|
||||
00038 * DTSBD343
|
||||
00039 * T006-START-YRQ IS THE START-YRQ OF THE RATE FOR WHICH DTSBD343
|
||||
00040 * A RATE NOTICE IS TO BE PRINTED. IGNORE T006-END-YRQ. DTSBD343
|
||||
00041 * DTSBD343
|
||||
00042 * IF NO MRTE RECORD EXISTS FOR A SPECIFIED T006-START-YRQ, DTSBD343
|
||||
00043 * THEN INDICATE THE TRANSACTION HAS FAILED. DTSBD343
|
||||
00044 * DTSBD343
|
||||
00045 * IF MRTE-RATE-TYPE-ESTIM-88, THEN INDICATE THE DTSBD343
|
||||
00046 * TRANSACTION HAS FAILED. DTSBD343
|
||||
00047 * DTSBD343
|
||||
00048 * IF MRTE-NOTICE-MAIL-DATE = 0, THEN INDICATE THE DTSBD343
|
||||
00049 * TRANSACTION HAS FAILED. DTSBD343
|
||||
00050 * DTSBD343
|
||||
00051 * READ THE MRCT RECORD CORRESPONDING TO T006-START-YRQ. DTSBD343
|
||||
00052 * READ THE FCYR RECORD FOR THE YEAR INCLUDING DTSBD343
|
||||
00053 * T006-START-YRQ. DTSBD343
|
||||
00054 * DTSBD343
|
||||
00055 * IF (THE MRCT RECORD DOES NOT EXIST) OR (THE MRCT DTSBD343
|
||||
00056 * RECORD DOES NOT SUPPORT THE RATE IN THE MRTE DTSBD343
|
||||
00057 * RECORD (AS DETERMINED BY A CALL TO DTSBU054)) OR DTSBD343
|
||||
00058 * (THE FCYR RECORD DOES NOT EXIST); DTSBD343
|
||||
00059 * DTSBD343
|
||||
00060 * INDICATE THE TRANSACTION HAS FAILED DTSBD343
|
||||
00061 * DTSBD343
|
||||
00062 * ELSE DTSBD343
|
||||
00063 * DTSBD343
|
||||
00064 * GENERATE A R503 RECORD DTSBD343
|
||||
00065 * IF L054-UI-PEN-RATE-YES-88 DTSBD343
|
||||
00066 * GENERATE A R504 RECORD. DTSBD343
|
||||
00067 * DTSBD343
|
||||
00068 * DTSBD343
|
||||
00069 * PLEASE SEE PRINTED OUTPUTS DESCRIPTIONS AND LAYOUTS DTSBD343
|
||||
00070 * FOR FURTHER INFORMATION. DTSBD343
|
||||
00071 * DTSBD343
|
||||
00072 * DTSBD343
|
||||
00073 * MASTER FILE RECORDS READ: DTSBD343
|
||||
00074 * DTSBD343
|
||||
00075 * MRCT DTSBD343
|
||||
00076 * MRTE DTSBD343
|
||||
00077 * DTSBD343
|
||||
00078 * DTSBD343
|
||||
00079 * REFERENCE FILE RECORDS READ: DTSBD343
|
||||
00080 * DTSBD343
|
||||
00081 * NONE. DTSBD343
|
||||
00082 * DTSBD343
|
||||
00083 * DTSBD343
|
||||
00084 * MASTER FILE RECORDS UPDATED: DTSBD343
|
||||
00085 * DTSBD343
|
||||
00086 * NONE. DTSBD343
|
||||
00087 * DTSBD343
|
||||
00088 * DTSBD343
|
||||
00089 * REPORT RECORDS WRITTEN: DTSBD343
|
||||
00090 * DTSBD343
|
||||
00091 * R503 RATE NOTICE. DTSBD343
|
||||
00092 * R504 PENALTY RATE LETTER. DTSBD343
|
||||
00093 * DTSBD343
|
||||
00094 * DTSBD343
|
||||
00095 * MODULES CALLED: DTSBD343
|
||||
00096 * DTSBD343
|
||||
00097 * DTSBU001 DATE EDIT/CONVERSION. DTSBD343
|
||||
00098 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBD343
|
||||
00099 * DTSBU054 RATE DETERMINATION FROM RCT RECORD. DTSBD343
|
||||
00100 * DTSBU111 LOOKUP ADDRESS. DTSBD343
|
||||
00101 * DTSBU112 FORMAT ADDRESS. DTSBD343
|
||||
00102 * DTSBU910 MASTER FILE I/O. DTSBD343
|
||||
00103 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD343
|
||||
00104 * DTSBD343
|
||||
00105 * DTSBD343
|
||||
00106 ***** DTSBD343
|
||||
00107 SKIP3 DTSBD343
|
||||
00108 ENVIRONMENT DIVISION. DTSBD343
|
||||
00109 EJECT DTSBD343
|
||||
00110 DATA DIVISION. DTSBD343
|
||||
00111 SKIP3 DTSBD343
|
||||
00112 WORKING-STORAGE SECTION. DTSBD343
|
||||
001125 77 PAN-VALET PICTURE X(24) VALUE '008DTSBD343 11/11/02'. DTSBD343
|
||||
00113 SKIP3 DTSBD343
|
||||
00114 01 WRK-AREA. DTSBD343
|
||||
00115 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +343.DTSBD343
|
||||
00116 DTSBD343
|
||||
00117 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD343'.DTSBD343
|
||||
00118 DTSBD343
|
||||
00119 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD343
|
||||
00120 DTSBD343
|
||||
00121 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSBD343
|
||||
00122 DTSBD343
|
||||
00123 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSBD343
|
||||
00124 SKIP3 DTSBD343
|
||||
00125 01 MSG-TABLE. DTSBD343
|
||||
00126 05 MSG1-NO-MRTE-REC. DTSBD343
|
||||
00127 10 MSG1-ID PIC X(11) VALUE 'DTSBD343511'. DTSBD343
|
||||
00128 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'NO MRTE RECORD'. DTSBD343
|
||||
00129 10 MSG1-LONG-TEXT. DTSBD343
|
||||
00130 15 FILLER PIC X(30) DTSBD343
|
||||
00131 VALUE 'TRANSACTION FAILED - RATE RECO'. DTSBD343
|
||||
00132 15 FILLER PIC X(30) DTSBD343
|
||||
00133 VALUE 'RD NOT FOUND '. DTSBD343
|
||||
00134 DTSBD343
|
||||
00135 05 MSG2-NO-MRCT-REC. DTSBD343
|
||||
00136 10 MSG2-ID PIC X(11) VALUE 'DTSBD343512'. DTSBD343
|
||||
00137 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'NO MRCT RECORD'. DTSBD343
|
||||
00138 10 MSG2-LONG-TEXT. DTSBD343
|
||||
00139 15 FILLER PIC X(30) DTSBD343
|
||||
00140 VALUE 'TRANSACTION FAILED - RATE EXPE'. DTSBD343
|
||||
00141 15 FILLER PIC X(30) DTSBD343
|
||||
00142 VALUE 'RIENCE CUTOFF RECORD NOT FOUND'. DTSBD343
|
||||
00143 DTSBD343
|
||||
00144 *****05 MSG3-NO-FCYR-REC. DTSBD343
|
||||
00145 *********10 MSG3-ID PIC X(11) VALUE 'DTSBD343513'. DTSBD343
|
||||
00146 *********10 MSG3-SHORT-TEXT PIC X(20) VALUE 'NO FCYR RECORD'. DTSBD343
|
||||
00147 *********10 MSG3-LONG-TEXT. DTSBD343
|
||||
00148 *************15 FILLER PIC X(30) DTSBD343
|
||||
00149 *******************VALUE 'TRANSACTION FAILED - REFERENCE'. DTSBD343
|
||||
00150 *************15 FILLER PIC X(30) DTSBD343
|
||||
00151 *******************VALUE 'CALENDAR YEAR RECORD NOT FOUND'. DTSBD343
|
||||
00152 DTSBD343
|
||||
00153 05 MSG4-INVALID-MRCT-REC. DTSBD343
|
||||
00154 10 MSG4-ID PIC X(11) VALUE 'DTSBD343514'. DTSBD343
|
||||
00155 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'RATE ERROR '. DTSBD343
|
||||
00156 10 MSG4-LONG-TEXT. DTSBD343
|
||||
00157 15 FILLER PIC X(30) DTSBD343
|
||||
00158 VALUE 'TRANSACTION FAILED - RATE EXPE'. DTSBD343
|
||||
00159 15 FILLER PIC X(30) DTSBD343
|
||||
00160 VALUE 'RIENCE DOES NOT SUPPORT RATE '. DTSBD343
|
||||
00161 DTSBD343
|
||||
00162 05 MSG5-NO-NOTICE-DATE. DTSBD343
|
||||
00163 10 MSG5-ID PIC X(11) VALUE 'DTSBD343515'. DTSBD343
|
||||
00164 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'RATE ERROR '. DTSBD343
|
||||
00165 10 MSG5-LONG-TEXT. DTSBD343
|
||||
00166 15 FILLER PIC X(30) DTSBD343
|
||||
00167 VALUE 'TRANSACTION FAILED - NOTICE DA'. DTSBD343
|
||||
00168 15 FILLER PIC X(30) DTSBD343
|
||||
00169 VALUE 'TE DOES NOT EXIST '. DTSBD343
|
||||
00170 DTSBD343
|
||||
00171 05 MSG6-ESTIMATED-RATE. DTSBD343
|
||||
00172 10 MSG6-ID PIC X(11) VALUE 'DTSBD343516'. DTSBD343
|
||||
00173 10 MSG6-SHORT-TEXT PIC X(20) VALUE 'RATE ERROR '. DTSBD343
|
||||
00174 10 MSG6-LONG-TEXT. DTSBD343
|
||||
00175 15 FILLER PIC X(30) DTSBD343
|
||||
00176 VALUE 'TRANSACTION FAILED - CANNOT PR'. DTSBD343
|
||||
00177 15 FILLER PIC X(30) DTSBD343
|
||||
00178 VALUE 'INT NOTICE FOR ESTIMATED RATE.'. DTSBD343
|
||||
00179 EJECT DTSBD343
|
||||
00180 01 L001-LINK-AREA. DTSBD343
|
||||
00181 ++INCLUDE DTSIL001 DTSBD343
|
||||
00182 EJECT DTSBD343
|
||||
00183 01 L004-LINK-AREA. DTSBD343
|
||||
00184 ++INCLUDE DTSIL004 DTSBD343
|
||||
00185 EJECT DTSBD343
|
||||
00186 01 L006-LINK-AREA. DTSBD343
|
||||
00187 ++INCLUDE DTSIL006 DTSBD343
|
||||
00188 EJECT DTSBD343
|
||||
00189 01 L054-LINK-AREA. DTSBD343
|
||||
00190 ++INCLUDE DTSIL054 DTSBD343
|
||||
00191 EJECT DTSBD343
|
||||
00192 01 L055-LINK-AREA. DTSBD343
|
||||
00193 ++INCLUDE DTSIL055 DTSBD343
|
||||
00194 EJECT DTSBD343
|
||||
00195 01 L111-LINK-AREA. DTSBD343
|
||||
00196 ++INCLUDE DTSIL111 DTSBD343
|
||||
00197 EJECT DTSBD343
|
||||
00198 01 L112-LINK-AREA. DTSBD343
|
||||
00199 ++INCLUDE DTSIL112 DTSBD343
|
||||
00200 EJECT DTSBD343
|
||||
00201 01 L910-LINK-AREA. DTSBD343
|
||||
00202 ++INCLUDE DTSIL910 DTSBD343
|
||||
00203 EJECT DTSBD343
|
||||
00204 01 MSKL-REC. DTSBD343
|
||||
00205 ++INCLUDE DTSIMSKL DTSBD343
|
||||
00206 EJECT DTSBD343
|
||||
00207 01 MRCT-REC. DTSBD343
|
||||
00208 ++INCLUDE DTSIMRCT DTSBD343
|
||||
00209 EJECT DTSBD343
|
||||
00210 01 MRTE-REC. DTSBD343
|
||||
00211 ++INCLUDE DTSIMRTE DTSBD343
|
||||
00212 EJECT DTSBD343
|
||||
00213 *01 L931-LINK-AREA. DTSBD343
|
||||
00214 ***INCLUDE DTSIL931 DTSBD343
|
||||
00215 EJECT DTSBD343
|
||||
00216 *01 FSKL-REC. DTSBD343
|
||||
00217 ***INCLUDE DTSIFSKL DTSBD343
|
||||
00218 EJECT DTSBD343
|
||||
00219 *01 FCYR-REC. DTSBD343
|
||||
00220 ***INCLUDE DTSIFCYR DTSBD343
|
||||
00221 EJECT DTSBD343
|
||||
00222 01 R503-REC. DTSBD343
|
||||
00223 ++INCLUDE DTSIR503 DTSBD343
|
||||
00224 EJECT DTSBD343
|
||||
00225 01 R504-REC. DTSBD343
|
||||
00226 ++INCLUDE DTSIR504 DTSBD343
|
||||
00227 EJECT DTSBD343
|
||||
00228 01 MMAX-LITERALS. DTSBD343
|
||||
00229 ++INCLUDE DTSIMMAX DTSBD343
|
||||
00230 EJECT DTSBD343
|
||||
00231 LINKAGE SECTION. DTSBD343
|
||||
00232 SKIP3 DTSBD343
|
||||
00233 01 LBCM-LINK-AREA. DTSBD343
|
||||
00234 ++INCLUDE DTSILBCM DTSBD343
|
||||
00235 EJECT DTSBD343
|
||||
00236 01 MPRF-REC. DTSBD343
|
||||
00237 ++INCLUDE DTSIMPRF DTSBD343
|
||||
00238 EJECT DTSBD343
|
||||
00239 01 T006-REC. DTSBD343
|
||||
00240 ++INCLUDE DTSIT006 DTSBD343
|
||||
00241 EJECT DTSBD343
|
||||
00242 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD343
|
||||
00243 MPRF-REC DTSBD343
|
||||
00244 T006-REC. DTSBD343
|
||||
00245 DTSBD343
|
||||
00246 DTSBD343
|
||||
00247 IF FIRST-TIME-IND = 'Y' DTSBD343
|
||||
00248 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBD343
|
||||
00249 MOVE 'N' TO FIRST-TIME-IND. DTSBD343
|
||||
00250 DTSBD343
|
||||
00251 DTSBD343
|
||||
00252 IF (MPRF-EMP-NO = WRK-EMP-NO) DTSBD343
|
||||
00253 AND DTSBD343
|
||||
00254 (T006-START-YRQ = WRK-START-YRQ) DTSBD343
|
||||
00255 NEXT SENTENCE DTSBD343
|
||||
00256 ELSE DTSBD343
|
||||
00257 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD343
|
||||
00258 MOVE T006-START-YRQ TO WRK-START-YRQ DTSBD343
|
||||
00259 MOVE MPRF-EMP-NO TO WRK-EMP-NO. DTSBD343
|
||||
00260 DTSBD343
|
||||
00261 DTSBD343
|
||||
00262 GOBACK. DTSBD343
|
||||
00263 EJECT DTSBD343
|
||||
00264 I0000-INITIATE. DTSBD343
|
||||
00265 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD343
|
||||
00266 ****************************L931-TRACE-IND. DTSBD343
|
||||
00267 DTSBD343
|
||||
00268 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBD343
|
||||
00269 ****************************L931-MOD-NAME. DTSBD343
|
||||
00270 DTSBD343
|
||||
00271 MOVE +0 TO WRK-EMP-NO DTSBD343
|
||||
00272 WRK-START-YRQ. DTSBD343
|
||||
00273 DTSBD343
|
||||
00274 MOVE LENGTH OF R503-REC TO R503-LENGTH. DTSBD343
|
||||
00275 DTSBD343
|
||||
00276 MOVE LENGTH OF R504-REC TO R504-LENGTH. DTSBD343
|
||||
00277 I0000-EXIT. DTSBD343
|
||||
00278 EXIT. DTSBD343
|
||||
00279 EJECT DTSBD343
|
||||
00280 P0000-PROCESS. DTSBD343
|
||||
00281 IF MPRF-CLASS-RATED-88 DTSBD343
|
||||
00282 NEXT SENTENCE DTSBD343
|
||||
00283 ELSE DTSBD343
|
||||
00284 GO TO P0000-EXIT. DTSBD343
|
||||
00285 DTSBD343
|
||||
00286 DTSBD343
|
||||
00287 MOVE LOW-VALUES TO MRTE-KEY-AREA. DTSBD343
|
||||
00288 DTSBD343
|
||||
00289 MOVE MPRF-EMP-NO TO MRTE-EMP-NO. DTSBD343
|
||||
00290 DTSBD343
|
||||
00291 SET MRTE-RTE-88 TO TRUE. DTSBD343
|
||||
00292 DTSBD343
|
||||
00293 MOVE T006-START-YRQ TO MRTE-EFF-YRQ. DTSBD343
|
||||
00294 DTSBD343
|
||||
00295 MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA. DTSBD343
|
||||
00296 DTSBD343
|
||||
00297 PERFORM S910-READ THRU S910-EXIT. DTSBD343
|
||||
00298 DTSBD343
|
||||
00299 IF L910-NO-REC-88 DTSBD343
|
||||
00300 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00301 MOVE MSG1-NO-MRTE-REC TO LBCM-TRN-MSG-AREA DTSBD343
|
||||
00302 GO TO P0000-EXIT. DTSBD343
|
||||
00303 DTSBD343
|
||||
00304 DTSBD343
|
||||
00305 MOVE MSKL-REC TO MRTE-REC. DTSBD343
|
||||
00306 DTSBD343
|
||||
00307 DTSBD343
|
||||
00308 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD343
|
||||
00309 IF T006-FINAL-RATE DTSBD343
|
||||
00310 PERFORM P2000-UPDATE-MRTE THRU P2000-EXIT DTSBD343
|
||||
00311 ELSE DTSBD343
|
||||
00312 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00313 MOVE MSG6-ESTIMATED-RATE TO LBCM-TRN-MSG-AREA DTSBD343
|
||||
00314 GO TO P0000-EXIT. DTSBD343
|
||||
00315 DTSBD343
|
||||
00316 IF MRTE-NOTICE-DATE = 0 DTSBD343
|
||||
00317 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00318 MOVE MSG5-NO-NOTICE-DATE TO LBCM-TRN-MSG-AREA DTSBD343
|
||||
00319 GO TO P0000-EXIT. DTSBD343
|
||||
00320 DTSBD343
|
||||
00321 DTSBD343
|
||||
00322 MOVE LOW-VALUES TO MRCT-KEY-AREA. DTSBD343
|
||||
00323 DTSBD343
|
||||
00324 MOVE MPRF-EMP-NO TO MRCT-EMP-NO. DTSBD343
|
||||
00325 DTSBD343
|
||||
00326 SET MRCT-RCT-88 TO TRUE. DTSBD343
|
||||
00327 DTSBD343
|
||||
00328 MOVE T006-START-YRQ TO MRCT-EFF-YRQ. DTSBD343
|
||||
00329 DTSBD343
|
||||
00330 MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA. DTSBD343
|
||||
00331 DTSBD343
|
||||
00332 PERFORM S910-READ THRU S910-EXIT. DTSBD343
|
||||
00333 DTSBD343
|
||||
00334 IF L910-NO-REC-88 DTSBD343
|
||||
00335 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00336 MOVE MSG2-NO-MRCT-REC TO LBCM-TRN-MSG-AREA DTSBD343
|
||||
00337 GO TO P0000-EXIT. DTSBD343
|
||||
00338 DTSBD343
|
||||
00339 DTSBD343
|
||||
00340 MOVE MSKL-REC TO MRCT-REC. DTSBD343
|
||||
00341 DTSBD343
|
||||
00342 DTSBD343
|
||||
00343 *****MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBD343
|
||||
00344 DTSBD343
|
||||
00345 *****SET FCYR-CYR-88 TO TRUE. DTSBD343
|
||||
00346 DTSBD343
|
||||
00347 *****MOVE T006-START-YRQ TO L004-QTR-5-9. DTSBD343
|
||||
00348 DTSBD343
|
||||
00349 *****MOVE L004-QTR-5-YR TO FCYR-YR. DTSBD343
|
||||
00350 DTSBD343
|
||||
00351 *****MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBD343
|
||||
00352 DTSBD343
|
||||
00353 *****PERFORM S931-READ THRU S931-EXIT. DTSBD343
|
||||
00354 DTSBD343
|
||||
00355 *****IF L931-NO-REC-88 DTSBD343
|
||||
00356 ********SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00357 ********MOVE MSG3-NO-FCYR-REC TO LBCM-TRN-MSG-AREA DTSBD343
|
||||
00358 ********GO TO P0000-EXIT. DTSBD343
|
||||
00359 DTSBD343
|
||||
00360 DTSBD343
|
||||
00361 *****MOVE FSKL-REC TO FCYR-REC. DTSBD343
|
||||
00362 DTSBD343
|
||||
00363 DTSBD343
|
||||
00364 IF MRTE-RATE-TYPE-ESTIM-88 DTSBD343
|
||||
00365 OR MRTE-RATE-TYPE-FINAL-88 DTSBD343
|
||||
00366 SET L054-ESTIMATED-RATE-YES-88 TO TRUE DTSBD343
|
||||
00367 ELSE DTSBD343
|
||||
00368 SET L054-ESTIMATED-RATE-NO-88 TO TRUE. DTSBD343
|
||||
00369 DTSBD343
|
||||
00370 PERFORM S054-RATE-LOOKUP-YES THRU S054-EXIT. DTSBD343
|
||||
00371 DTSBD343
|
||||
00372 DTSBD343
|
||||
00373 PERFORM P1000-CHECK-CONSISTENCY THRU P1000-EXIT. DTSBD343
|
||||
00374 DTSBD343
|
||||
00375 DTSBD343
|
||||
00376 IF LBCM-TRN-NOT-OK-88 DTSBD343
|
||||
00377 MOVE MSG4-INVALID-MRCT-REC TO LBCM-TRN-MSG-AREA DTSBD343
|
||||
00378 GO TO P0000-EXIT. DTSBD343
|
||||
00379 DTSBD343
|
||||
00380 DTSBD343
|
||||
00381 MOVE MRTE-EFF-YRQ TO L006-YRQ. DTSBD343
|
||||
00382 DTSBD343
|
||||
00383 PERFORM S006-FROM-QTR THRU S006-EXIT. DTSBD343
|
||||
00384 DTSBD343
|
||||
00385 DTSBD343
|
||||
00386 MOVE MRTE-EFF-YRQ TO L055-EFF-YRQ. DTSBD343
|
||||
00387 DTSBD343
|
||||
00388 PERFORM S055-FROM-EFF-YRQ THRU S055-EXIT. DTSBD343
|
||||
00389 DTSBD343
|
||||
00390 DTSBD343
|
||||
00391 PERFORM S111-LOOKUP-UI-TAX-MAILING THRU S111-EXIT. DTSBD343
|
||||
00392 DTSBD343
|
||||
00393 IF L111-ADDR-FOUND-88 DTSBD343
|
||||
00394 PERFORM S112-FORMAT-TAD-ADDR THRU S112-EXIT DTSBD343
|
||||
00395 ELSE DTSBD343
|
||||
00396 MOVE SPACES TO L112-ZIP DTSBD343
|
||||
00397 L112-ADVANCED-BARCODE DTSBD343
|
||||
00398 MOVE ALL '?' TO L112-MAILING-ADDRESS. DTSBD343
|
||||
00399 DTSBD343
|
||||
00400 DTSBD343
|
||||
00401 IF L054-UI-PEN-RATE-YES-88 DTSBD343
|
||||
00402 SET R503-UI-PEN-RATE-YES-88 TO TRUE DTSBD343
|
||||
00403 ELSE DTSBD343
|
||||
00404 SET R503-UI-PEN-RATE-NO-88 TO TRUE. DTSBD343
|
||||
00405 DTSBD343
|
||||
00406 MOVE LOW-VALUES TO R503-SORT-VAR-AREA. DTSBD343
|
||||
00407 DTSBD343
|
||||
00408 MOVE MPRF-EMP-NO TO R503-DLY-EMP-NO. DTSBD343
|
||||
00409 DTSBD343
|
||||
00410 MOVE MRTE-EFF-YRQ TO R503-DLY-EFF-YRQ. DTSBD343
|
||||
00411 DTSBD343
|
||||
00412 IF L054-CLASSIFIED-88 DTSBD343
|
||||
00413 SET R503-CLASSIFIED-88 TO TRUE DTSBD343
|
||||
00414 ELSE DTSBD343
|
||||
00415 SET R503-NONCLASSIFIED-88 TO TRUE. DTSBD343
|
||||
00416 DTSBD343
|
||||
00417 MOVE MPRF-EMP-NO TO R503-EMP-NO. DTSBD343
|
||||
00418 DTSBD343
|
||||
00419 MOVE MRTE-EFF-YRQ TO R503-EFF-YRQ. DTSBD343
|
||||
00420 DTSBD343
|
||||
00421 MOVE L006-RTE-YR-DISP TO R503-RATE-YEAR. DTSBD343
|
||||
00422 DTSBD343
|
||||
00423 MOVE MRTE-NOTICE-DATE TO R503-NOTICE-DATE. DTSBD343
|
||||
00424 DTSBD343
|
||||
00425 IF R503-UI-PEN-RATE-YES-88 DTSBD343
|
||||
00426 MOVE R503-NOTICE-DATE TO L001-FED-8-DATE-9 DTSBD343
|
||||
00427 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD343
|
||||
00428 ADD +30 TO L001-JUL-ABS-DAY DTSBD343
|
||||
00429 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBD343
|
||||
00430 MOVE L001-FED-8-DATE-9 TO R503-PENALTY-DEADLINE-DATE DTSBD343
|
||||
00431 ELSE DTSBD343
|
||||
00432 MOVE +0 TO R503-PENALTY-DEADLINE-DATE. DTSBD343
|
||||
00433 DTSBD343
|
||||
00434 MOVE L112-MAILING-ADDRESS TO R503-FMT-ADDR. DTSBD343
|
||||
00435 DTSBD343
|
||||
00436 MOVE L112-ZIP TO R503-ZIP. DTSBD343
|
||||
00437 DTSBD343
|
||||
00438 MOVE L112-ADVANCED-BARCODE TO R503-ADVANCED-BARCODE. DTSBD343
|
||||
00439 DTSBD343
|
||||
00440 MOVE L054-UI-CALC-RATE TO R503-CALC-RATE. DTSBD343
|
||||
00441 DTSBD343
|
||||
00442 MOVE L054-UI-PEN-RATE TO R503-PEN-RATE. DTSBD343
|
||||
00443 DTSBD343
|
||||
00444 IF R503-UI-PEN-RATE-YES-88 DTSBD343
|
||||
00445 MOVE L054-UI-PEN-RATE TO R503-UI-RATE DTSBD343
|
||||
00446 ELSE DTSBD343
|
||||
00447 MOVE L054-UI-CALC-RATE TO R503-UI-RATE. DTSBD343
|
||||
00448 DTSBD343
|
||||
00449 MOVE L055-CURRENT-RESERVE-THRU-DATE DTSBD343
|
||||
00450 TO R503-CURRENT-RESERVE-THRU-DATE. DTSBD343
|
||||
00451 DTSBD343
|
||||
00452 MOVE L054-AVG-TAX-WAGE TO R503-AVG-TAX-WAGE. DTSBD343
|
||||
00453 DTSBD343
|
||||
00454 MOVE L054-RATIO TO R503-RESERVE-RATIO. DTSBD343
|
||||
00455 DTSBD343
|
||||
00456 MOVE MRCT-PRIOR-RESERVE-AMT TO R503-PRIOR-RESERVE-AMT. DTSBD343
|
||||
00457 DTSBD343
|
||||
00458 MOVE MRCT-TRUST-FUND-INTEREST-AMT DTSBD343
|
||||
00459 TO R503-TRUST-FUND-INTEREST-AMT. DTSBD343
|
||||
00460 DTSBD343
|
||||
00461 MOVE MRCT-UI-TAX-PAID-AMT DTSBD343
|
||||
00462 TO R503-UI-TAX-PAID-AMT. DTSBD343
|
||||
00463 DTSBD343
|
||||
00464 MOVE MRCT-BENEFITS-CHARGED-AMT TO R503-BENEFITS-CHARGED-AMT. DTSBD343
|
||||
00465 DTSBD343
|
||||
00466 MOVE L054-CURRENT-RESERVE-AMT TO R503-CURRENT-RESERVE-AMT. DTSBD343
|
||||
00467 DTSBD343
|
||||
00468 PERFORM S946-WRITE-R503 THRU S946-EXIT. DTSBD343
|
||||
00469 DTSBD343
|
||||
00470 DTSBD343
|
||||
00471 IF R503-UI-PEN-RATE-YES-88 DTSBD343
|
||||
00472 NEXT SENTENCE DTSBD343
|
||||
00473 ELSE DTSBD343
|
||||
00474 GO TO P0000-EXIT. DTSBD343
|
||||
00475 DTSBD343
|
||||
00476 DTSBD343
|
||||
00477 MOVE LOW-VALUES TO R504-SORT-VAR-AREA. DTSBD343
|
||||
00478 DTSBD343
|
||||
00479 MOVE MPRF-EMP-NO TO R504-DLY-EMP-NO. DTSBD343
|
||||
00480 DTSBD343
|
||||
00481 MOVE MRCT-EFF-YRQ TO R504-DLY-EFF-YRQ. DTSBD343
|
||||
00482 DTSBD343
|
||||
00483 MOVE MPRF-EMP-NO TO R504-EMP-NO. DTSBD343
|
||||
00484 DTSBD343
|
||||
00485 MOVE MRCT-EFF-YRQ TO R504-EFF-YRQ. DTSBD343
|
||||
00486 DTSBD343
|
||||
00487 MOVE R503-RATE-YEAR TO R504-RATE-YEAR. DTSBD343
|
||||
00488 DTSBD343
|
||||
00489 MOVE R503-NOTICE-DATE TO R504-NOTICE-DATE. DTSBD343
|
||||
00490 DTSBD343
|
||||
00491 MOVE R503-PENALTY-DEADLINE-DATE DTSBD343
|
||||
00492 TO R504-PENALTY-DEADLINE-DATE. DTSBD343
|
||||
00493 DTSBD343
|
||||
00494 MOVE L112-MAILING-ADDRESS TO R504-FMT-ADDR. DTSBD343
|
||||
00495 DTSBD343
|
||||
00496 MOVE L112-ZIP TO R504-ZIP. DTSBD343
|
||||
00497 DTSBD343
|
||||
00498 MOVE L112-ADVANCED-BARCODE TO R504-ADVANCED-BARCODE. DTSBD343
|
||||
00499 DTSBD343
|
||||
00500 MOVE R503-CALC-RATE TO R504-CALC-RATE. DTSBD343
|
||||
00501 DTSBD343
|
||||
00502 MOVE R503-PEN-RATE TO R504-PEN-RATE. DTSBD343
|
||||
00503 DTSBD343
|
||||
00504 PERFORM S946-WRITE-R504 THRU S946-EXIT. DTSBD343
|
||||
00505 P0000-EXIT. DTSBD343
|
||||
00506 EXIT. DTSBD343
|
||||
00507 EJECT DTSBD343
|
||||
00508 P1000-CHECK-CONSISTENCY. DTSBD343
|
||||
00509 IF L054-OK-88 DTSBD343
|
||||
00510 NEXT SENTENCE DTSBD343
|
||||
00511 ELSE DTSBD343
|
||||
00512 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00513 GO TO P1000-EXIT. DTSBD343
|
||||
00514 DTSBD343
|
||||
00515 IF L054-UI-PEN-RATE-NO-88 OR L054-UI-PEN-RATE-INEFF-88 DTSBD343
|
||||
00516 IF L054-UI-CALC-RATE = MRTE-UI-RATE DTSBD343
|
||||
00517 NEXT SENTENCE DTSBD343
|
||||
00518 ELSE DTSBD343
|
||||
00519 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00520 GO TO P1000-EXIT DTSBD343
|
||||
00521 ELSE DTSBD343
|
||||
00522 IF L054-UI-PEN-RATE-YES-88 DTSBD343
|
||||
00523 IF L054-UI-PEN-RATE = MRTE-UI-RATE DTSBD343
|
||||
00524 NEXT SENTENCE DTSBD343
|
||||
00525 ELSE DTSBD343
|
||||
00526 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00527 GO TO P1000-EXIT DTSBD343
|
||||
00528 ELSE DTSBD343
|
||||
00529 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD343
|
||||
00530 GO TO P1000-EXIT. DTSBD343
|
||||
00531 P1000-EXIT. DTSBD343
|
||||
00532 EXIT. DTSBD343
|
||||
00533 DTSBD343
|
||||
00534 P2000-UPDATE-MRTE. DTSBD343
|
||||
00535 SET MRTE-RATE-TYPE-FINAL-88 TO TRUE. DTSBD343
|
||||
00536 MOVE LBCM-CURR-MAIL-DATE TO MRTE-NOTICE-DATE. DTSBD343
|
||||
00537 DTSBD343
|
||||
00538 MOVE MRTE-REC TO MSKL-REC. DTSBD343
|
||||
00539 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD343
|
||||
00540 DTSBD343
|
||||
00541 P2000-EXIT. DTSBD343
|
||||
00542 EXIT. DTSBD343
|
||||
00543 EJECT DTSBD343
|
||||
00544 S001-FROM-FED-8. DTSBD343
|
||||
00545 SET L001-FROM-FED-8 TO TRUE. DTSBD343
|
||||
00546 GO TO S001-DATE. DTSBD343
|
||||
00547 DTSBD343
|
||||
00548 S001-FROM-ABS-DAY. DTSBD343
|
||||
00549 SET L001-FROM-ABS-DAY TO TRUE. DTSBD343
|
||||
00550 GO TO S001-DATE. DTSBD343
|
||||
00551 DTSBD343
|
||||
00552 S001-DATE. DTSBD343
|
||||
00553 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD343
|
||||
00554 S001-EXIT. DTSBD343
|
||||
00555 EXIT. DTSBD343
|
||||
00556 SKIP3 DTSBD343
|
||||
00557 S004-FROM-5. DTSBD343
|
||||
00558 SET L004-FROM-5 TO TRUE. DTSBD343
|
||||
00559 GO TO S004-QTR. DTSBD343
|
||||
00560 DTSBD343
|
||||
00561 S004-QTR. DTSBD343
|
||||
00562 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD343
|
||||
00563 S004-EXIT. DTSBD343
|
||||
00564 EXIT. DTSBD343
|
||||
00565 SKIP3 DTSBD343
|
||||
00566 S006-FROM-QTR. DTSBD343
|
||||
00567 SET L006-FROM-QTR TO TRUE. DTSBD343
|
||||
00568 GO TO S006-RATING-YEAR. DTSBD343
|
||||
00569 DTSBD343
|
||||
00570 S006-RATING-YEAR. DTSBD343
|
||||
00571 CALL 'DTSBU006' USING L006-LINK-AREA. DTSBD343
|
||||
00572 S006-EXIT. DTSBD343
|
||||
00573 EXIT. DTSBD343
|
||||
00574 SKIP3 DTSBD343
|
||||
00575 S054-RATE-LOOKUP-YES. DTSBD343
|
||||
00576 SET L054-RATE-LOOKUP-YES-88 TO TRUE. DTSBD343
|
||||
00577 GO TO S054-RATE-DETER. DTSBD343
|
||||
00578 DTSBD343
|
||||
00579 S054-RATE-DETER. DTSBD343
|
||||
00580 CALL 'DTSBU054' USING L054-LINK-AREA DTSBD343
|
||||
00581 MRCT-REC. DTSBD343
|
||||
00582 S054-EXIT. DTSBD343
|
||||
00583 EXIT. DTSBD343
|
||||
00584 SKIP3 DTSBD343
|
||||
00585 S055-FROM-EFF-YRQ. DTSBD343
|
||||
00586 SET L055-FROM-EFF-YRQ-88 TO TRUE. DTSBD343
|
||||
00587 GO TO S055-EXP-PERIOD-DATES. DTSBD343
|
||||
00588 DTSBD343
|
||||
00589 S055-EXP-PERIOD-DATES. DTSBD343
|
||||
00590 CALL 'DTSBU055' USING L055-LINK-AREA. DTSBD343
|
||||
00591 S055-EXIT. DTSBD343
|
||||
00592 EXIT. DTSBD343
|
||||
00593 SKIP3 DTSBD343
|
||||
00594 S111-LOOKUP-UI-TAX-MAILING. DTSBD343
|
||||
00595 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBD343
|
||||
00596 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD343
|
||||
00597 SET L111-ID-NO-TAD-MAIL-88 TO TRUE. DTSBD343
|
||||
00598 GO TO S111-LOOKUP-ADDRESS. DTSBD343
|
||||
00599 DTSBD343
|
||||
00600 S111-LOOKUP-ADDRESS. DTSBD343
|
||||
00601 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD343
|
||||
00602 S111-EXIT. DTSBD343
|
||||
00603 EXIT. DTSBD343
|
||||
00604 SKIP3 DTSBD343
|
||||
00605 S112-FORMAT-TAD-ADDR. DTSBD343
|
||||
00606 SET L112-TAD-ADDR-88 TO TRUE. DTSBD343
|
||||
00607 SET L112-ANCHOR-LAST-88 TO TRUE. DTSBD343
|
||||
00608 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBD343
|
||||
00609 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA. DTSBD343
|
||||
00610 GO TO S112-FORMAT-ADDRESS. DTSBD343
|
||||
00611 DTSBD343
|
||||
00612 S112-FORMAT-ADDRESS. DTSBD343
|
||||
00613 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD343
|
||||
00614 S112-EXIT. DTSBD343
|
||||
00615 EXIT. DTSBD343
|
||||
00616 SKIP3 DTSBD343
|
||||
00617 S910-READ. DTSBD343
|
||||
00618 SET L910-READ-88 TO TRUE. DTSBD343
|
||||
00619 GO TO S910-MSTR-IO. DTSBD343
|
||||
00620 DTSBD343
|
||||
00621 S910-START-BROWSE. DTSBD343
|
||||
00622 SET L910-START-BROWSE-88 TO TRUE. DTSBD343
|
||||
00623 GO TO S910-MSTR-IO. DTSBD343
|
||||
00624 DTSBD343
|
||||
00625 S910-READ-NEXT. DTSBD343
|
||||
00626 SET L910-READ-NEXT-88 TO TRUE. DTSBD343
|
||||
00627 GO TO S910-MSTR-IO. DTSBD343
|
||||
00628 DTSBD343
|
||||
00629 S910-REWRITE. DTSBD343
|
||||
00630 SET L910-REWRITE-88 TO TRUE. DTSBD343
|
||||
00631 GO TO S910-MSTR-IO. DTSBD343
|
||||
00632 DTSBD343
|
||||
00633 S910-MSTR-IO. DTSBD343
|
||||
00634 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD343
|
||||
00635 MSKL-REC. DTSBD343
|
||||
00636 S910-EXIT. DTSBD343
|
||||
00637 EXIT. DTSBD343
|
||||
00638 SKIP3 DTSBD343
|
||||
00639 *S931-READ. DTSBD343
|
||||
00640 *****SET L931-READ-88 TO TRUE. DTSBD343
|
||||
00641 *****GO TO S931-REF-I. DTSBD343
|
||||
00642 DTSBD343
|
||||
00643 *S931-START-BROWSE. DTSBD343
|
||||
00644 *****SET L931-START-BROWSE-88 TO TRUE. DTSBD343
|
||||
00645 *****GO TO S931-REF-I. DTSBD343
|
||||
00646 DTSBD343
|
||||
00647 *S931-READ-NEXT. DTSBD343
|
||||
00648 *****SET L931-READ-NEXT-88 TO TRUE. DTSBD343
|
||||
00649 *****GO TO S931-REF-I. DTSBD343
|
||||
00650 DTSBD343
|
||||
00651 *S931-REF-I. DTSBD343
|
||||
00652 *****CALL 'DTSBU931' USING L931-LINK-AREA DTSBD343
|
||||
00653 ***************************FSKL-REC. DTSBD343
|
||||
00654 *S931-EXIT. DTSBD343
|
||||
00655 *****EXIT. DTSBD343
|
||||
00656 SKIP3 DTSBD343
|
||||
00657 S946-WRITE-R503. DTSBD343
|
||||
00658 CALL 'DTSBU946' USING R503-REC. DTSBD343
|
||||
00659 GO TO S946-EXIT. DTSBD343
|
||||
00660 DTSBD343
|
||||
00661 S946-WRITE-R504. DTSBD343
|
||||
00662 CALL 'DTSBU946' USING R504-REC. DTSBD343
|
||||
00663 GO TO S946-EXIT. DTSBD343
|
||||
00664 DTSBD343
|
||||
00665 S946-EXIT. DTSBD343
|
||||
00666 EXIT. DTSBD343
|
||||
00667 SKIP3 DTSBD343
|
||||
00668 S999-ABEND. DTSBD343
|
||||
00669 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD343
|
||||
00670 S999-EXIT. DTSBD343
|
||||
00671 EXIT. DTSBD343
|
||||
Reference in New Issue
Block a user