00001 IDENTIFICATION DIVISION. 05/28/13 00002 PROGRAM-ID. DTSBE615. DTSBE615 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. MARCH 2013. DTSBE615 00005 DATE-COMPILED. DTSBE615 00006 SKIP3 DTSBE615 00007 ***** DTSBE615 00008 * DTSBE615 00009 * FUNCTION: FIELD ASSIGNMENTS FOR DELINQUENCY DTSBE615 00010 * DTSBE615 00011 * DTSBE615 00012 * MODIFICATION LOG: DTSBE615 00013 * DTSBE615 00014 * 03/15/2013 INITIAL DEVELOPMENT DTSBE615 00015 * WORK ORDER: SPEC 061 PROGRAMMER: ZL1 DTSBE615 00016 * DTSBE615 00017 * DTSBE615 00018 * 04/05/2013 MODIFY PROGRAM TO PERFORM FIELD ASSIGNMENT ON DTSBE615 00019 * EMPLOYERS WHO OWE MORE THAN 100.00 DOLLARS DTSBE615 00020 * WORK ORDER: SPEC 061 PROGRAMMER: ZL1 DTSBE615 00021 * DTSBE615 00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE615 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE615 00024 * WORK ORDER: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE615 00025 * DTSBE615 00026 * DTSBE615 00027 * DESCRIPTION: DTSBE615 00028 * DTSBE615 00029 * THIS PROGRAM IS INCLUDED IN THE MONTH-END PROCESS, BUT ONLY DTSBE615 00030 * PRODUCES A LISTING IN MARCH, JUNE, SEPTEMBER AND DECEMBER. DTSBE615 00031 * THE MONTH-END PROCESSING RUNS AFTER THE DAILY UPDATE ON THE DTSBE615 00032 * LAST WORK DAY OF EACH MONTH. THE CURRENT RUN DATE WILL BE DTSBE615 00033 * THE FIRST WORK DAY OF THE NEW MONTH. THE PROGRAM LOOKS FOR DTSBE615 00034 * A BALANCE DUE IN THE SECOND QUARTER PREVIOUS TO THE CURRENT DTSBE615 00035 * QUARTER. FOR EXAMPLE, WHEN IT RUNS IN SEPTEMBER, IT LOOKS FODTSBE615 00036 * A BALANCE DUE FROM THE FIRST QUARTER. THE FIRST QUARTER DTSBE615 00037 * REPORTS WERE DUE BY APRIL 30. IF THERE IS STILL A BALANCE DUDTSBE615 00038 * BY SEPTEMBER 1, THE RECEIVABLE IS MORE THAN 120 DAYS OLD, ANDDTSBE615 00039 * NEEDS TO BECOME A FIELD ASSIGNMENT. DTSBE615 00040 * DTSBE615 00041 * INITIATION: DTSBE615 00042 * DTSBE615 00043 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE615 00044 * DTSBE615 00045 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE615 00046 * DTSBE615 00047 * CHECK AND DEFAULT PARAMETERS. DTSBE615 00048 * DTSBE615 00049 * DTSBE615 00050 * PROCESSING: DTSBE615 00051 * DTSBE615 00052 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (435R1). DTSBE615 00053 * DTSBE615 00054 * DTSBE615 00055 * TERMINATION: DTSBE615 00056 * DTSBE615 00057 * DTSBE615 00058 * DTSBE615 00059 * RECORDS READ: DTSBE615 00060 * DTSBE615 00061 * MASTER: DTSBE615 00062 * DTSBE615 00063 * MHDR DTSBE615 00064 * MQTR DTSBE615 00065 * MFAS DTSBE615 00066 * DTSBE615 00067 * ALTERNATE INDEX: DTSBE615 00068 * DTSBE615 00069 * NONE. DTSBE615 00070 * DTSBE615 00071 * DTSBE615 00072 * REFERENCE: DTSBE615 00073 * DTSBE615 00074 * FFAT. DTSBE615 00075 * DTSBE615 00076 * DTSBE615 00077 * RECORDS UPDATED: DTSBE615 00078 * DTSBE615 00079 * MHDR. DTSBE615 00080 * DTSBE615 00081 * DTSBE615 00082 * REPORT RECORDS WRITTEN: DTSBE615 00083 * DTSBE615 00084 * R602 ASSIGNMENTS FOR DELINQUENCY DTSBE615 00085 * DTSBE615 00086 * DTSBE615 00087 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE615 00088 * DTSBE615 00089 * NONE. DTSBE615 00090 * DTSBE615 00091 * DTSBE615 00092 * MODULES CALLED: DTSBE615 00093 * DTSBE615 00094 * DTSBU001 DATE CONVERSION/EDIT. DTSBE615 00095 * DTSBU910 MASTER FILE I/O. DTSBE615 00096 * DTSBU931 REFERENCE FILE I/O. DTSBE615 00097 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE615 00098 * DTSBE615 00099 ***** DTSBE615 00100 SKIP3 DTSBE615 00101 ENVIRONMENT DIVISION. DTSBE615 00102 SKIP3 DTSBE615 00103 DATA DIVISION. DTSBE615 00104 SKIP3 DTSBE615 00105 WORKING-STORAGE SECTION. DTSBE615 001055 77 PAN-VALET PICTURE X(24) VALUE '003DTSBE615 05/28/13'. DTSBE615 00106 77 PAN-VALET PICTURE X(24) VALUE '002DTSBE615 05/28/13'. DTSBE615 00107 77 PAN-VALET PICTURE X(24) VALUE '001DTSBE615 05/28/13'. DTSBE615 00108 77 PAN-VALET PICTURE X(24) VALUE '029DTSBE615 05/20/13'. DTSBE615 00109 77 PAN-VALET PICTURE X(24) VALUE '019DTSBE615 03/28/05'. DTSBE615 00110 SKIP3 DTSBE615 00111 01 WRK-AREA. DTSBE615 00112 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +615.DTSBE615 00113 DTSBE615 00114 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE615'.DTSBE615 00115 DTSBE615 00116 DTSBE615 00117 05 GENERATE-ASSIGNMENTS-IND PIC X(01). DTSBE615 00118 88 GENERATE-ASSIGNMENTS-YES-88 VALUE 'Y'. DTSBE615 00119 88 GENERATE-ASSIGNMENTS-NO-88 VALUE 'N'. DTSBE615 00120 DTSBE615 00121 05 ABEND-MSG PIC X(60). DTSBE615 00122 DTSBE615 00123 DTSBE615 00124 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBE615 00125 DTSBE615 00126 DTSBE615 00127 05 WRK-PARM-SUBJECT-YRQ PIC S9(05) COMP-3. DTSBE615 00128 DTSBE615 00129 05 WRK-ASSIGN-NO PIC S9(09) COMP-3. DTSBE615 00130 05 WRK-EMP-CNT PIC S9(07) COMP-3. DTSBE615 00131 DTSBE615 00132 05 WRK-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBE615 00133 05 WRK-FINAL-ACTION-DATE PIC S9(09) COMP-3. DTSBE615 00134 05 WRK-EVENT-TXT PIC X(50) VALUE DTSBE615 00135 'FIELD ASSIGNMENT CREATED FOR DELINQUENCY '. DTSBE615 00136 EJECT DTSBE615 00137 01 R615-REC. DTSBE615 00138 ++INCLUDE DTSIR615 DTSBE615 00139 EJECT DTSBE615 00140 01 L001-LINK-AREA. DTSBE615 00141 ++INCLUDE DTSIL001 DTSBE615 00142 EJECT DTSBE615 00143 01 L004-LINK-AREA. DTSBE615 00144 ++INCLUDE DTSIL004 DTSBE615 00145 EJECT DTSBE615 00146 01 L005-LINK-AREA. DTSBE615 00147 ++INCLUDE DTSIL005 DTSBE615 00148 EJECT DTSBE615 00149 01 L061-LINK-AREA. DTSBE615 00150 ++INCLUDE DTSIL061 DTSBE615 00151 EJECT DTSBE615 00152 01 L410-LINK-AREA. DTSBE615 00153 ++INCLUDE DTSIL410 DTSBE615 00154 SKIP3 DTSBE615 00155 01 L910-LINK-AREA. DTSBE615 00156 ++INCLUDE DTSIL910 DTSBE615 00157 SKIP3 DTSBE615 00158 01 MSKL-REC. DTSBE615 00159 ++INCLUDE DTSIMSKL DTSBE615 00160 SKIP3 DTSBE615 00161 01 MHDR-REC. DTSBE615 00162 ++INCLUDE DTSIMHDR DTSBE615 00163 SKIP3 DTSBE615 00164 01 MQTR-REC. DTSBE615 00165 ++INCLUDE DTSIMQTR DTSBE615 00166 SKIP3 DTSBE615 00167 01 MFAS-REC. DTSBE615 00168 ++INCLUDE DTSIMFAS DTSBE615 00169 SKIP3 DTSBE615 00170 01 MEVL-REC. DTSBE615 00171 ++INCLUDE DTSIMEVL DTSBE615 00172 SKIP3 DTSBE615 00173 EJECT DTSBE615 00174 01 L931-LINK-AREA. DTSBE615 00175 ++INCLUDE DTSIL931 DTSBE615 00176 SKIP3 DTSBE615 00177 01 FSKL-REC. DTSBE615 00178 ++INCLUDE DTSIFSKL DTSBE615 00179 SKIP3 DTSBE615 00180 01 FFAT-REC. DTSBE615 00181 ++INCLUDE DTSIFFAT DTSBE615 00182 SKIP3 DTSBE615 00183 01 FQTR-REC. DTSBE615 00184 ++INCLUDE DTSIFQTR DTSBE615 00185 SKIP3 DTSBE615 00186 LINKAGE SECTION. DTSBE615 00187 SKIP3 DTSBE615 00188 01 LECM-LINK-AREA. DTSBE615 00189 ++INCLUDE DTSILECM DTSBE615 00190 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE615 00191 15 LECM-PARM-SUBJECT-YRQ PIC X(03). DTSBE615 00192 15 FILLER PIC X(77). DTSBE615 00193 EJECT DTSBE615 00194 EJECT DTSBE615 00195 01 MPRF-LINK-REC. DTSBE615 00196 ++INCLUDE DTSIMPRF DTSBE615 00197 EJECT DTSBE615 00198 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE615 00199 MPRF-LINK-REC. DTSBE615 00200 DTSBE615 00201 DTSBE615 00202 IF LECM-PROCESS-88 DTSBE615 00203 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE615 00204 ELSE DTSBE615 00205 IF LECM-INITIALIZE-88 DTSBE615 00206 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE615 00207 ELSE DTSBE615 00208 IF LECM-TERMINATE-88 DTSBE615 00209 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE615 00210 ELSE DTSBE615 00211 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE615 00212 TO ABEND-MSG DTSBE615 00213 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00214 DTSBE615 00215 DTSBE615 00216 GOBACK. DTSBE615 00217 EJECT DTSBE615 00218 I0000-INITIALIZE. DTSBE615 00219 DTSBE615 00220 MOVE LECM-TRACE-IND TO L910-TRACE-IND DTSBE615 00221 L931-TRACE-IND. DTSBE615 00222 DTSBE615 00223 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE615 00224 L931-MOD-NAME. DTSBE615 00225 DTSBE615 00226 DTSBE615 00227 MOVE LENGTH OF R615-REC TO R615-LENGTH. DTSBE615 00228 DTSBE615 00229 MOVE '615' TO R615-REC-TYPE. DTSBE615 00230 MOVE +0 TO WRK-EMP-CNT. DTSBE615 00231 DTSBE615 00232 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE615 00233 DTSBE615 00234 DTSBE615 00235 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE615 00236 DTSBE615 00237 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. DTSBE615 00238 DTSBE615 00239 I0000-EXIT. DTSBE615 00240 EXIT. DTSBE615 00241 SKIP3 DTSBE615 00242 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE615 00243 PERFORM I1100-PARM-YRQ THRU I1100-EXIT. DTSBE615 00244 PERFORM I1200-FQTR-YRQ THRU I1200-EXIT. DTSBE615 00245 PERFORM I3000-LAST-ASSIGN-NUM THRU I3000-EXIT. DTSBE615 00246 DTSBE615 00247 I1000-EXIT. DTSBE615 00248 EXIT. DTSBE615 00249 DTSBE615 00250 I1100-PARM-YRQ. DTSBE615 00251 IF LECM-PARM-SUBJECT-YRQ = SPACES DTSBE615 00252 MOVE LECM-LAST-UC30-DEL-MAIL-YRQ TO WRK-PARM-SUBJECT-YRQ DTSBE615 00253 ELSE DTSBE615 00254 MOVE LECM-PARM-SUBJECT-YRQ TO L004-QTR-3 DTSBE615 00255 PERFORM S004-FROM-3 THRU S004-EXIT DTSBE615 00256 IF L004-INVALID-QTR DTSBE615 00257 MOVE 'INVALID LECM-PARM-SUBJECT-YRQ ENCOUNTERED' DTSBE615 00258 TO ABEND-MSG DTSBE615 00259 PERFORM S999-ABEND THRU S999-EXIT DTSBE615 00260 ELSE DTSBE615 00261 MOVE L004-QTR-5-9 TO WRK-PARM-SUBJECT-YRQ DTSBE615 00262 END-IF DTSBE615 00263 END-IF. DTSBE615 00264 DTSBE615 00265 DTSBE615 00266 IF WRK-PARM-SUBJECT-YRQ > LECM-LAST-UC30-DEL-MAIL-YRQ DTSBE615 00267 MOVE DTSBE615 00268 'PARM-SUBJECT-YRQ NOT COMPATIBLE WITH LAST-UC30-DEL-MAIL-YRQ'DTSBE615 00269 TO ABEND-MSG DTSBE615 00270 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00271 DTSBE615 00272 DISPLAY 'SUBJECT QUARTER: ' WRK-PARM-SUBJECT-YRQ. DTSBE615 00273 DTSBE615 00274 I1100-EXIT. DTSBE615 00275 EXIT. DTSBE615 00276 DTSBE615 00277 I1200-FQTR-YRQ. DTSBE615 00278 MOVE LOW-VALUES TO FQTR-KEY-AREA. DTSBE615 00279 DTSBE615 00280 SET FQTR-QTR-88 TO TRUE. DTSBE615 00281 DTSBE615 00282 MOVE WRK-PARM-SUBJECT-YRQ TO FQTR-YRQ. DTSBE615 00283 DTSBE615 00284 MOVE FQTR-KEY-AREA TO FSKL-KEY-AREA. DTSBE615 00285 DTSBE615 00286 PERFORM S931-READ THRU S931-EXIT. DTSBE615 00287 DTSBE615 00288 IF L931-NO-REC-88 DTSBE615 00289 MOVE 'FQTR RECORD FOR SUBJECT YRQ NOT FOUND' DTSBE615 00290 TO ABEND-MSG DTSBE615 00291 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00292 DTSBE615 00293 DTSBE615 00294 MOVE FSKL-REC TO FQTR-REC. DTSBE615 00295 DTSBE615 00296 DTSBE615 00297 IF FQTR-UC30-FIRST-DEL-DATE = +0 DTSBE615 00298 MOVE 'FQTR-UC30-FIRST-DEL-DATE NOT FOUND' DTSBE615 00299 TO ABEND-MSG DTSBE615 00300 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00301 DTSBE615 00302 MOVE LECM-CURR-RUN-DATE TO L001-FED-8-DATE-9 DTSBE615 00303 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE615 00304 SUBTRACT +11 FROM L001-JUL-ABS-DAY DTSBE615 00305 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE615 00306 MOVE L001-FED-8-DATE-9 DTSBE615 00307 TO WRK-FINAL-ACTION-DATE DTSBE615 00308 DTSBE615 00309 IF WRK-FINAL-ACTION-DATE > DTSBE615 00310 FQTR-UC30-FIRST-DEL-DATE DTSBE615 00311 NEXT SENTENCE DTSBE615 00312 ELSE DTSBE615 00313 MOVE '11 DAYS HAS NOT PASSED SINCE 1ST DELQ CANNOT RUN' DTSBE615 00314 TO ABEND-MSG DTSBE615 00315 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00316 DTSBE615 00317 I1200-EXIT. DTSBE615 00318 EXIT. DTSBE615 00319 DTSBE615 00320 I3000-LAST-ASSIGN-NUM. DTSBE615 00321 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE615 00322 MOVE +0 TO MHDR-EMP-NO. DTSBE615 00323 SET MHDR-HDR-88 TO TRUE. DTSBE615 00324 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE615 00325 DTSBE615 00326 PERFORM S910-READ THRU S910-EXIT. DTSBE615 00327 DTSBE615 00328 IF L910-NO-REC-88 DTSBE615 00329 MOVE 'MHDR RECORD NOT FOUND (I0000)' DTSBE615 00330 TO ABEND-MSG DTSBE615 00331 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00332 DTSBE615 00333 MOVE MSKL-REC TO MHDR-REC. DTSBE615 00334 DTSBE615 00335 MOVE MHDR-LAST-USED-ASSIGN-NO TO WRK-ASSIGN-NO. DTSBE615 00336 DISPLAY ' LAST USED ASSIGN NO ' WRK-ASSIGN-NO. DTSBE615 00337 DTSBE615 00338 I3000-EXIT. DTSBE615 00339 EXIT. DTSBE615 00340 DTSBE615 00341 P0000-PROCESS. DTSBE615 00342 SET GENERATE-ASSIGNMENTS-NO-88 TO TRUE. DTSBE615 00343 DTSBE615 00344 IF MPRF-CLASS-SUB-88 DTSBE615 00345 SET L410-MODE-INPUT-YRQ-88 TO TRUE DTSBE615 00346 MOVE MPRF-EMP-NO TO L410-EMP-NO DTSBE615 00347 MOVE WRK-PARM-SUBJECT-YRQ TO L410-YRQ DTSBE615 00348 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBE615 00349 DTSBE615 00350 IF L410-ANN-SCHED-88 DTSBE615 00351 GO TO P0000-EXIT. DTSBE615 00352 DTSBE615 00353 IF MPRF-RETURN-MAIL-YES-88 DTSBE615 00354 GO TO P0000-EXIT. DTSBE615 00355 DTSBE615 00356 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE615 00357 DTSBE615 00358 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE615 00359 DTSBE615 00360 SET MQTR-QTR-88 TO TRUE. DTSBE615 00361 DTSBE615 00362 MOVE WRK-PARM-SUBJECT-YRQ TO MQTR-YRQ. DTSBE615 00363 DTSBE615 00364 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE615 00365 DTSBE615 00366 PERFORM S910-READ THRU S910-EXIT. DTSBE615 00367 DTSBE615 00368 IF L910-NO-REC-88 DTSBE615 00369 GO TO P0000-EXIT. DTSBE615 00370 DTSBE615 00371 MOVE MSKL-REC TO MQTR-REC. DTSBE615 00372 DTSBE615 00373 IF MQTR-RPT-NOT-PURSUED-88 DTSBE615 00374 PERFORM P2000-AMT-PAID THRU P2000-EXIT DTSBE615 00375 ELSE DTSBE615 00376 SET GENERATE-ASSIGNMENTS-YES-88 TO TRUE. DTSBE615 00377 DTSBE615 00378 IF MQTR-MISS-LETTER-SENT-88 DTSBE615 00379 SET GENERATE-ASSIGNMENTS-YES-88 TO TRUE DTSBE615 00380 ELSE DTSBE615 00381 PERFORM P2000-AMT-PAID THRU P2000-EXIT. DTSBE615 00382 DTSBE615 00383 IF GENERATE-ASSIGNMENTS-YES-88 DTSBE615 00384 PERFORM P3000-FIELD-ASSIGN THRU P3000-EXIT DTSBE615 00385 PERFORM P4000-GENERATE-R615 THRU P4000-EXIT DTSBE615 00386 END-IF. DTSBE615 00387 P0000-EXIT. DTSBE615 00388 EXIT. DTSBE615 00389 EJECT DTSBE615 00390 DTSBE615 00391 P2000-AMT-PAID. DTSBE615 00392 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE615 00393 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 100.00 DTSBE615 00394 SET GENERATE-ASSIGNMENTS-YES-88 TO TRUE DTSBE615 00395 DISPLAY ' EMP NO ' MQTR-EMP-NO ' BAL OWED ' DTSBE615 00396 MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE615 00397 END-IF DTSBE615 00398 END-IF. DTSBE615 00399 DTSBE615 00400 * IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE615 00401 * IF MQTR-CHARGED-AMT (MQTR-ACCT-IDX) = ZEROS DTSBE615 00402 * GO TO P2000-EXIT DTSBE615 00403 * ELSE DTSBE615 00404 * COMPUTE WRK-CHARGED-AMT = DTSBE615 00405 * MQTR-CHARGED-AMT (MQTR-ACCT-IDX) *.5 DTSBE615 00406 * IF MQTR-PAID-AMT (MQTR-ACCT-IDX) < WRK-CHARGED-AMT DTSBE615 00407 * SET GENERATE-ASSIGNMENTS-YES-88 TO TRUE DTSBE615 00408 * DISPLAY ' 50% CHG AMT ' WRK-CHARGED-AMT ' PAID AMT ' DTSBE615 00409 * MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSBE615 00410 * END-IF DTSBE615 00411 * END-IF DTSBE615 00412 * END-IF. DTSBE615 00413 DTSBE615 00414 P2000-EXIT. DTSBE615 00415 EXIT. DTSBE615 00416 EJECT DTSBE615 00417 DTSBE615 00418 P3000-FIELD-ASSIGN. DTSBE615 00419 MOVE LOW-VALUES TO MFAS-REC. DTSBE615 00420 DTSBE615 00421 MOVE MPRF-EMP-NO TO MFAS-EMP-NO. DTSBE615 00422 DTSBE615 00423 SET MFAS-FAS-88 TO TRUE. DTSBE615 00424 DTSBE615 00425 ADD +1 TO WRK-ASSIGN-NO. DTSBE615 00426 DTSBE615 00427 ADD +1 TO WRK-EMP-CNT. DTSBE615 00428 DTSBE615 00429 MOVE WRK-ASSIGN-NO TO MFAS-ASSIGN-NO. DTSBE615 00430 DTSBE615 00431 MOVE +0 TO MFAS-PURGE-DATE. DTSBE615 00432 DTSBE615 00433 SET MFAS-STATUS-ACTIVE-88 TO TRUE. DTSBE615 00434 DTSBE615 00435 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBE615 00436 DTSBE615 00437 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE615 00438 DTSBE615 00439 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE615 00440 DTSBE615 00441 MOVE L061-FLD-REP-ID TO MFAS-FLD-REP-ID. DTSBE615 00442 DTSBE615 00443 MOVE WRK-PARM-SUBJECT-YRQ TO MFAS-START-YRQ MFAS-END-YRQ. DTSBE615 00444 DTSBE615 00445 MOVE '14' TO MFAS-ASSIGN-TYPE. DTSBE615 00446 DTSBE615 00447 SET MFAS-ATTACHMENTS-NO-88 TO TRUE. DTSBE615 00448 DTSBE615 00449 SET MFAS-NON-AUDIT-88 TO TRUE. DTSBE615 00450 DTSBE615 00451 SET MFAS-ACCOUNTING-DESK-NO-88 TO TRUE. DTSBE615 00452 DTSBE615 00453 MOVE LECM-CURR-MAIL-DATE TO MFAS-START-DATE. DTSBE615 00454 DTSBE615 00455 MOVE +0 TO MFAS-DUE-DATE DTSBE615 00456 MFAS-COMPLETED-DATE DTSBE615 00457 MFAS-PROCESSED-DATE DTSBE615 00458 MFAS-TAX-DOWNLOAD-DATE DTSBE615 00459 MFAS-WAGE-DOWNLOAD-DATE. DTSBE615 00460 DTSBE615 00461 MOVE 'SYSTEM' TO MFAS-SOURCE-OP-ID. DTSBE615 00462 DTSBE615 00463 MOVE ZERO TO MFAS-CLAIMANT-SSN. DTSBE615 00464 DTSBE615 00465 MOVE SPACES TO MFAS-CLAIMANT-NAME. DTSBE615 00466 DTSBE615 00467 MOVE ZERO TO MFAS-RELATED-EMP-NO. DTSBE615 00468 DTSBE615 00469 MOVE MPRF-SIC-CD TO MFAS-SIC-CD. DTSBE615 00470 DTSBE615 00471 MOVE MPRF-NAICS-CD TO MFAS-NAICS-CD. DTSBE615 00472 DTSBE615 00473 MOVE MPRF-OWN-CD TO MFAS-OWN-CD. DTSBE615 00474 DTSBE615 00475 SET MFAS-EMP-NON-AUDIT-88 TO TRUE. DTSBE615 00476 DTSBE615 00477 MOVE +0 TO MFAS-SEL-CNT. DTSBE615 00478 DTSBE615 00479 SET MFAS-NOT-CONVERTED-88 TO TRUE. DTSBE615 00480 DTSBE615 00481 MOVE LECM-CURR-RUN-DATE TO MFAS-ESTB-DATE DTSBE615 00482 MFAS-CHNG-DATE. DTSBE615 00483 DTSBE615 00484 MOVE +1 TO MFAS-TEXT-CNT. DTSBE615 00485 DTSBE615 00486 MOVE DTSBE615 00487 'FIELD ASSIGNMENT CREATED: FOR DELINQUENCY ' DTSBE615 00488 TO MFAS-TEXT (1). DTSBE615 00489 DTSBE615 00490 MOVE MFAS-REC TO MSKL-REC. DTSBE615 00491 DTSBE615 00492 PERFORM S910-WRITE THRU S910-EXIT. DTSBE615 00493 DTSBE615 00494 * DISPLAY ' ASSIGN # ' WRK-ASSIGN-NO DTSBE615 00495 SET MPRF-MFAS-EXISTS-88 TO TRUE. DTSBE615 00496 DTSBE615 00497 PERFORM P3100-WRITE-MEVL THRU P3100-EXIT. DTSBE615 00498 DTSBE615 00499 P3000-EXIT. DTSBE615 00500 EXIT. DTSBE615 00501 DTSBE615 00502 P3100-WRITE-MEVL. DTSBE615 00503 MOVE LOW-VALUE TO MEVL-REC. DTSBE615 00504 DTSBE615 00505 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE615 00506 DTSBE615 00507 SET MEVL-EVL-88 TO TRUE. DTSBE615 00508 DTSBE615 00509 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE615 00510 DTSBE615 00511 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE615 00512 DTSBE615 00513 SET L005-FROM-ABSTIME TO TRUE. DTSBE615 00514 DTSBE615 00515 PERFORM S005-CONVERT-TIME THRU S005-EXIT. DTSBE615 00516 DTSBE615 00517 MOVE L005-DATE TO MEVL-DATE. DTSBE615 00518 DTSBE615 00519 MOVE L005-TIME TO MEVL-TIME. DTSBE615 00520 DTSBE615 00521 MOVE +0 TO MEVL-PURGE-DATE. DTSBE615 00522 DTSBE615 00523 MOVE WRK-EVENT-TXT TO MEVL-TEXT. DTSBE615 00524 DTSBE615 00525 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE615 00526 DTSBE615 00527 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE615 00528 DTSBE615 00529 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE615 00530 MEVL-CHNG-DATE. DTSBE615 00531 DTSBE615 00532 MOVE MEVL-REC TO MSKL-REC. DTSBE615 00533 DTSBE615 00534 PERFORM S910-WRITE THRU S910-EXIT. DTSBE615 00535 DTSBE615 00536 P3100-EXIT. DTSBE615 00537 EXIT. DTSBE615 00538 DTSBE615 00539 P4000-GENERATE-R615. DTSBE615 00540 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE615 00541 DTSBE615 00542 MOVE L061-FLD-REP-ID TO R615-FIELD-REP-ID. DTSBE615 00543 DTSBE615 00544 MOVE MPRF-FLD-ZIP-ST TO R615-FLD-ZIP. DTSBE615 00545 DTSBE615 00546 MOVE MPRF-EMP-NO TO R615-EMP-NO. DTSBE615 00547 DTSBE615 00548 MOVE WRK-ASSIGN-NO TO R615-ASSIGN-NO. DTSBE615 00549 DTSBE615 00550 MOVE MPRF-PRIMARY-NAME TO R615-PRIMARY-NAME. DTSBE615 00551 MOVE MPRF-SIC-CD TO R615-SIC-CD. DTSBE615 00552 DTSBE615 00553 MOVE MPRF-NAICS-CD TO R615-NAICS-CD. DTSBE615 00554 DTSBE615 00555 MOVE MPRF-OWN-CD TO R615-OWN-CD. DTSBE615 00556 DTSBE615 00557 MOVE WRK-PARM-SUBJECT-YRQ TO R615-ASSIGN-YRQ DTSBE615 00558 DTSBE615 00559 PERFORM S946-WRITE-R615 THRU S946-EXIT. DTSBE615 00560 P4000-EXIT. DTSBE615 00561 EXIT. DTSBE615 00562 T0000-TERMINATE. DTSBE615 00563 DISPLAY 'FIELD ASSIGNMENTS GENERATED ' WRK-EMP-CNT DTSBE615 00564 DISPLAY 'LAST ASSIGN # USED ' WRK-ASSIGN-NO. DTSBE615 00565 PERFORM T1000-UPDATE-HDR THRU T1000-EXIT. DTSBE615 00566 DTSBE615 00567 T0000-EXIT. DTSBE615 00568 EXIT. DTSBE615 00569 DTSBE615 00570 T1000-UPDATE-HDR. DTSBE615 00571 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE615 00572 MOVE +0 TO MHDR-EMP-NO. DTSBE615 00573 SET MHDR-HDR-88 TO TRUE. DTSBE615 00574 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE615 00575 DTSBE615 00576 PERFORM S910-READ THRU S910-EXIT. DTSBE615 00577 DTSBE615 00578 IF L910-NO-REC-88 DTSBE615 00579 MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSBE615 00580 TO ABEND-MSG DTSBE615 00581 PERFORM S999-ABEND THRU S999-EXIT. DTSBE615 00582 DTSBE615 00583 MOVE MSKL-REC TO MHDR-REC. DTSBE615 00584 DTSBE615 00585 MOVE WRK-ASSIGN-NO TO MHDR-LAST-USED-ASSIGN-NO. DTSBE615 00586 DTSBE615 00587 MOVE LECM-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSBE615 00588 DTSBE615 00589 MOVE MHDR-REC TO MSKL-REC. DTSBE615 00590 DTSBE615 00591 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE615 00592 DTSBE615 00593 T1000-EXIT. DTSBE615 00594 EXIT. DTSBE615 00595 EJECT DTSBE615 00596 S001-FROM-FED-8. DTSBE615 00597 SET L001-FROM-FED-8 TO TRUE. DTSBE615 00598 GO TO S001-DATE. DTSBE615 00599 DTSBE615 00600 S001-FROM-CAL-6. DTSBE615 00601 SET L001-FROM-CAL-6 TO TRUE. DTSBE615 00602 GO TO S001-DATE. DTSBE615 00603 DTSBE615 00604 S001-FROM-ABS-DAY. DTSBE615 00605 SET L001-FROM-ABS-DAY TO TRUE. DTSBE615 00606 GO TO S001-DATE. DTSBE615 00607 DTSBE615 00608 S001-DATE. DTSBE615 00609 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE615 00610 S001-EXIT. DTSBE615 00611 EXIT. DTSBE615 00612 SKIP3 DTSBE615 00613 DTSBE615 00614 S004-FROM-5. DTSBE615 00615 SET L004-FROM-5 TO TRUE. DTSBE615 00616 GO TO S004-YRQ. DTSBE615 00617 DTSBE615 00618 S004-FROM-3. DTSBE615 00619 SET L004-FROM-3 TO TRUE. DTSBE615 00620 GO TO S004-YRQ. DTSBE615 00621 DTSBE615 00622 S004-FROM-DATE. DTSBE615 00623 SET L004-FROM-DATE TO TRUE. DTSBE615 00624 GO TO S004-YRQ. DTSBE615 00625 DTSBE615 00626 S004-FROM-ABS. DTSBE615 00627 SET L004-FROM-ABS TO TRUE. DTSBE615 00628 GO TO S004-YRQ. DTSBE615 00629 DTSBE615 00630 S004-YRQ. DTSBE615 00631 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE615 00632 S004-EXIT. DTSBE615 00633 EXIT. DTSBE615 00634 SKIP3 DTSBE615 00635 S005-CONVERT-TIME. DTSBE615 00636 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE615 00637 S005-EXIT. EXIT. DTSBE615 00638 SKIP3 DTSBE615 00639 DTSBE615 00640 S061-DETERMINE-FLD-REP. DTSBE615 00641 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBE615 00642 DTSBE615 00643 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE615 00644 DTSBE615 00645 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE615 00646 S061-EXIT. DTSBE615 00647 EXIT. DTSBE615 00648 SKIP3 DTSBE615 00649 S910-READ. DTSBE615 00650 SET L910-READ-88 TO TRUE. DTSBE615 00651 GO TO S910-MSTR-IO. DTSBE615 00652 DTSBE615 00653 S910-START-BROWSE. DTSBE615 00654 SET L910-START-BROWSE-88 TO TRUE. DTSBE615 00655 GO TO S910-MSTR-IO. DTSBE615 00656 DTSBE615 00657 S910-READ-NEXT. DTSBE615 00658 SET L910-READ-NEXT-88 TO TRUE. DTSBE615 00659 GO TO S910-MSTR-IO. DTSBE615 00660 DTSBE615 00661 S910-WRITE. DTSBE615 00662 SET L910-WRITE-88 TO TRUE. DTSBE615 00663 GO TO S910-MSTR-IO. DTSBE615 00664 DTSBE615 00665 S910-REWRITE. DTSBE615 00666 SET L910-REWRITE-88 TO TRUE. DTSBE615 00667 GO TO S910-MSTR-IO. DTSBE615 00668 DTSBE615 00669 S910-MSTR-IO. DTSBE615 00670 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE615 00671 MSKL-REC. DTSBE615 00672 S910-EXIT. DTSBE615 00673 EXIT. DTSBE615 00674 SKIP3 DTSBE615 00675 S931-READ. DTSBE615 00676 SET L931-READ-88 TO TRUE. DTSBE615 00677 GO TO S931-REF-I. DTSBE615 00678 DTSBE615 00679 S931-START-BROWSE. DTSBE615 00680 SET L931-START-BROWSE-88 TO TRUE. DTSBE615 00681 GO TO S931-REF-I. DTSBE615 00682 DTSBE615 00683 S931-READ-NEXT. DTSBE615 00684 SET L931-READ-NEXT-88 TO TRUE. DTSBE615 00685 GO TO S931-REF-I. DTSBE615 00686 DTSBE615 00687 S931-REF-I. DTSBE615 00688 CALL 'DTSBU931' USING L931-LINK-AREA DTSBE615 00689 FSKL-REC. DTSBE615 00690 S931-EXIT. DTSBE615 00691 EXIT. DTSBE615 00692 DTSBE615 00693 S410-FILE-SCHED. DTSBE615 00694 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE615 00695 S410-EXIT. DTSBE615 00696 EXIT. DTSBE615 00697 SKIP3 DTSBE615 00698 S946-WRITE-R615. DTSBE615 00699 CALL 'DTSBU946' USING R615-REC. DTSBE615 00700 GO TO S946-EXIT. DTSBE615 00701 DTSBE615 00702 S946-EXIT. DTSBE615 00703 EXIT. DTSBE615 00704 SKIP3 DTSBE615 00705 S999-ABEND. DTSBE615 00706 DISPLAY '*** DTSBE615 ABENDING. ' DTSBE615 00707 ABEND-MSG. DTSBE615 00708 DTSBE615 00709 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE615 00710 S999-EXIT. DTSBE615 00711 EXIT. DTSBE615