00001 IDENTIFICATION DIVISION. 05/07/13 00002 PROGRAM-ID. DTSBE722. DTSBE722 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV022 00004 MODIFIED BY TRW/BDM OCT. 1998. DTSBE722 00005 DATE-WRITTEN. SEPTEMBER 1994. DTSBE722 00006 DATE-COMPILED. DTSBE722 00007 SKIP3 DTSBE722 00008 ***** DTSBE722 00009 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE722 00010 * DTSBE722 WHICH UPDATES DTSIR722 DTSBE722 00011 * DTSBR722 READS DTSIR722 RECORDS. DTSBE722 00012 * DTSBE722 00013 * FUNCTION: RQC CREDITS/REFUNDS CONTRIBUTORY EMPLOYERS DTSBE722 00014 * UNIVERSE RECORDS EXTRACT. DTSBE722 00015 * DTSBE722 00016 * DTSBE722 00017 * MODIFICATION LOG: DTSBE722 00018 * DTSBE722 00019 * 11/15/2004 PROGRAM REWRITTEN TO COMPLY WITH REQUIREMENTS DTSBE722 00020 * WORK ORDER: PROGRAMMER: GD DTSBE722 00021 * DTSBE722 00022 * 04/20/2009 SELECTION PROCESS MODIFIED. TPS APPENDIX A REQUIRDTSBE722 00023 * THAT ONLY CREDITS STILL OUTSTANDING AT THE END OFDTSBE722 00024 * THE REPORTING PERIOD MAY BE INCLUDED. DTSBE722 00025 * WORK ORDER: PROGRAMMER: GD DTSBE722 00026 * DTSBE722 00027 * 06/23/2010 MODIFIED TO EXCLUDE REFUND REVERSALS. IT IS NOT DTSBE722 00028 * EXPECTED THAT A NEW CREDIT MEMO WILL BE ISSUED INDTSBE722 00029 * THIS SITUATION, SINCE THE CREDIT MEMO WOULD HAVE DTSBE722 00030 * BEEN SENT WHEN THE CREDIT WAS ORIGINALLY DTSBE722 00031 * ESTABLISHED. DTSBE722 00032 * MODIFIED TO EXCLUDE DELINQUENT EMPLOYERS, SINCE DTSBE722 00033 * THE CREDIT CANNOT BE REFUNDED. DTSBE722 00034 * WORK ORDER: PROGRAMMER: GD DTSBE722 00035 * DTSBE722 00036 * 06/24/2010 CHANGED WRK-MIN-CREDIT FROM $10.00 TO $100.00. DTSBE722 00037 * WORK ORDER: PROGRAMMER: GD DTSBE722 00038 * DTSBE722 00039 * 05/07/2013 CHANGED TO EXCLUDE DUMMY ACCT #010 010 - NON DTSBE722 00040 * DOES CHECK ACCOUNT PROGRAMMER: ZL1 DTSBE722 00041 * DTSBE722 00042 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE722 00043 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE722 00044 * WORK ORDER: PROGRAMMER: XXX DTSBE722 00045 * DTSBE722 00046 * DTSBE722 00047 * DESCRIPTION: DTSBE722 00048 * DTSBE722 00049 * DTSBE722 00050 * INITIATION: DTSBE722 00051 * DTSBE722 00052 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE722 00053 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE722 00054 * DTSBE722 00055 * EDIT AND DEFAULT PARAMETERS. DTSBE722 00056 * DTSBE722 00057 * DTSBE722 00058 * PROCESSING: DTSBE722 00059 * DTSBE722 00060 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (722R1). DTSBE722 00061 * DTSBE722 00062 * DTSBE722 00063 * TERMINATION: DTSBE722 00064 * DTSBE722 00065 * NONE. DTSBE722 00066 * DTSBE722 00067 * DTSBE722 00068 * RECORDS READ: DTSBE722 00069 * DTSBE722 00070 * MASTER: DTSBE722 00071 * DTSBE722 00072 * MJRN DTSBE722 00073 * DTSBE722 00074 * DTSBE722 00075 * ALTERNATE INDEX: DTSBE722 00076 * DTSBE722 00077 * NONE. DTSBE722 00078 * DTSBE722 00079 * DTSBE722 00080 * REFERENCE: DTSBE722 00081 * DTSBE722 00082 * NONE. DTSBE722 00083 * DTSBE722 00084 * DTSBE722 00085 * RECORDS UPDATED: DTSBE722 00086 * DTSBE722 00087 * NONE. DTSBE722 00088 * DTSBE722 00089 * DTSBE722 00090 * REPORT RECORDS WRITTEN: DTSBE722 00091 * DTSBE722 00092 * R722 RQC CREDITS/REFUNDS CONTRIBTORY EMPLOYERS DTSBE722 00093 * UNIVERSE RECORDS. DTSBE722 00094 * DTSBE722 00095 * DTSBE722 00096 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE722 00097 * DTSBE722 00098 * NONE. DTSBE722 00099 * DTSBE722 00100 * DTSBE722 00101 * MODULES CALLED: DTSBE722 00102 * DTSBE722 00103 * DTSBU001 DATE EDIT/CONVERSION. DTSBE722 00104 * DTSBU910 MASTER FILE I/O. DTSBE722 00105 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE722 00106 * DTSBE722 00107 * DTSBE722 00108 * VERMONT REFERENCE: DTSBE722 00109 * DTSBE722 00110 * NONE. DTSBE722 00111 * DTSBE722 00112 ***** DTSBE722 00113 SKIP3 DTSBE722 00114 ENVIRONMENT DIVISION. DTSBE722 00115 EJECT DTSBE722 00116 DATA DIVISION. DTSBE722 00117 SKIP3 DTSBE722 00118 WORKING-STORAGE SECTION. DTSBE722 001185 77 PAN-VALET PICTURE X(24) VALUE '022DTSBE722 05/07/13'. DTSBE722 00119 77 PAN-VALET PICTURE X(24) VALUE '002DTSBE722 05/07/13'. DTSBE722 00120 77 PAN-VALET PICTURE X(24) VALUE '020DTSBE722 06/24/10'. DTSBE722 00121 SKIP3 DTSBE722 00122 01 WRK-AREA. DTSBE722 00123 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +722.DTSBE722 00124 SKIP1 DTSBE722 00125 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE722'.DTSBE722 00126 SKIP3 DTSBE722 00127 05 ABEND-MSG PIC X(60). DTSBE722 00128 SKIP3 DTSBE722 00129 05 WRK-PARM-PERIOD-START-DATE PIC S9(09) COMP-3. DTSBE722 00130 DTSBE722 00131 05 WRK-PARM-PERIOD-END-DATE PIC S9(09) COMP-3. DTSBE722 00132 DTSBE722 00133 05 WRK-ABSTIME PIC S9(15) COMP-3. DTSBE722 00134 DTSBE722 00135 05 WRK-MIN-CREDIT PIC S9(09)V9(02) COMP-3 DTSBE722 00136 VALUE +100. DTSBE722 00137 05 WRK-TOT-CREDIT PIC S9(09)V9(02) COMP-3 DTSBE722 00138 VALUE +0. DTSBE722 00139 05 WRK-UI-PAID PIC S9(09)V9(02) COMP-3 DTSBE722 00140 VALUE +0. DTSBE722 00141 05 WRK-CREDIT-BATCHES. DTSBE722 00142 10 CSUB PIC S9(04) COMP VALUE +0. DTSBE722 00143 10 CTBL-LAST PIC S9(04) COMP VALUE +0. DTSBE722 00144 10 CTBL-MAX PIC S9(04) COMP VALUE +100. DTSBE722 00145 10 WRK-CR-TABLE OCCURS 100 TIMES. DTSBE722 00146 15 CR-BATCH PIC S9(05) COMP-3. DTSBE722 00147 15 CR-ITEM PIC S9(03) COMP-3. DTSBE722 00148 15 CR-ESTB-DT PIC S9(09) COMP-3. DTSBE722 00149 DTSBE722 00150 05 WRK-JRN-FOUND-IND PIC X(01). DTSBE722 00151 88 WRK-JRN-FOUND-YES-88 VALUE 'Y'. DTSBE722 00152 88 WRK-JRN-FOUND-NO-88 VALUE 'N'. DTSBE722 00153 DTSBE722 00154 ** 05 WRK-TOT-CHARGE PIC S9(09)V9(02) COMP-3. DTSBE722 00155 * DTSBE722 00156 * 05 WRK-TRN-CREDIT PIC S9(09)V9(02) COMP-3. DTSBE722 00157 * 05 WRK-TRN-CHARGE PIC S9(09)V9(02) COMP-3. DTSBE722 00158 * DTSBE722 00159 * 05 WRK-TRN-TABLE-AREA. DTSBE722 00160 * 10 TRN-SUB PIC S9(04) COMP. DTSBE722 00161 * 10 TRN-LAST PIC S9(04) COMP. DTSBE722 00162 * 10 TRN-MAX PIC S9(04) COMP VALUE +100. DTSBE722 00163 * 05 WRK-TRN-TABLE OCCURS 100 TIMES. DTSBE722 00164 * 10 TRN-YRQ PIC S9(05) COMP-3. DTSBE722 00165 * DTSBE722 00166 * 05 WRK-QTR-FOUND-IND PIC X(01). DTSBE722 00167 * 88 WRK-QTR-FOUND-YES-88 VALUE 'Y'. DTSBE722 00168 ** 88 WRK-QTR-FOUND-NO-88 VALUE 'N'. DTSBE722 00169 DTSBE722 00170 05 AMT-DISP1 PIC ---------9.99. DTSBE722 00171 05 AMT-DISP2 PIC ---------9.99. DTSBE722 00172 05 AMT-DISP3 PIC ---------9.99. DTSBE722 00173 05 AMT-DISP4 PIC ---------9.99. DTSBE722 00174 EJECT DTSBE722 00175 01 L001-LINK-AREA. DTSBE722 00176 ++INCLUDE DTSIL001 DTSBE722 00177 EJECT DTSBE722 00178 01 L005-LINK-AREA. DTSBE722 00179 ++INCLUDE DTSIL005 DTSBE722 00180 EJECT DTSBE722 00181 01 L910-LINK-AREA. DTSBE722 00182 ++INCLUDE DTSIL910 DTSBE722 00183 SKIP3 DTSBE722 00184 01 MSKL-REC. DTSBE722 00185 ++INCLUDE DTSIMSKL DTSBE722 00186 SKIP3 DTSBE722 00187 01 MDST-REC. DTSBE722 00188 ++INCLUDE DTSIMDST DTSBE722 00189 DTSBE722 00190 01 MJRN-REC. DTSBE722 00191 ++INCLUDE DTSIMJRN DTSBE722 00192 DTSBE722 00193 01 MPAY-REC. DTSBE722 00194 ++INCLUDE DTSIMPAY DTSBE722 00195 EJECT DTSBE722 00196 01 R722-REC. DTSBE722 00197 ++INCLUDE DTSIR722 DTSBE722 00198 EJECT DTSBE722 00199 LINKAGE SECTION. DTSBE722 00200 SKIP3 DTSBE722 00201 01 LECM-LINK-AREA. DTSBE722 00202 ++INCLUDE DTSILECM DTSBE722 00203 SKIP3 DTSBE722 00204 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE722 00205 15 LECM-PARM-PERIOD-START-DATE PIC X(06). DTSBE722 00206 15 FILLER PIC X(01). DTSBE722 00207 15 LECM-PARM-PERIOD-END-DATE PIC X(06). DTSBE722 00208 15 FILLER PIC X(55). DTSBE722 00209 EJECT DTSBE722 00210 01 MPRF-LINK-REC. DTSBE722 00211 ++INCLUDE DTSIMPRF DTSBE722 00212 EJECT DTSBE722 00213 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE722 00214 MPRF-LINK-REC. DTSBE722 00215 SKIP2 DTSBE722 00216 MOVE LENGTH OF R722-REC TO R722-LENGTH. DTSBE722 00217 MOVE '722' TO R722-REC-TYPE. DTSBE722 00218 SKIP2 DTSBE722 00219 IF LECM-PROCESS-88 DTSBE722 00220 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE722 00221 ELSE DTSBE722 00222 IF LECM-INITIALIZE-88 DTSBE722 00223 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE722 00224 ELSE DTSBE722 00225 IF LECM-TERMINATE-88 DTSBE722 00226 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE722 00227 ELSE DTSBE722 00228 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE722 00229 TO ABEND-MSG DTSBE722 00230 PERFORM S999-ABEND THRU S999-EXIT. DTSBE722 00231 SKIP2 DTSBE722 00232 GOBACK. DTSBE722 00233 EJECT DTSBE722 00234 I0000-INITIALIZE. DTSBE722 00235 SKIP2 DTSBE722 00236 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE722 00237 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE722 00238 DTSBE722 00239 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE722 00240 DTSBE722 00241 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE722 00242 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE722 00243 SKIP2 DTSBE722 00244 I0000-EXIT. DTSBE722 00245 EXIT. DTSBE722 00246 SKIP3 DTSBE722 00247 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE722 00248 PERFORM I1100-PERIOD-START-DATE THRU I1100-EXIT. DTSBE722 00249 DTSBE722 00250 PERFORM I1200-PERIOD-END-DATE THRU I1200-EXIT. DTSBE722 00251 I1000-EXIT. DTSBE722 00252 EXIT. DTSBE722 00253 SKIP3 DTSBE722 00254 I1100-PERIOD-START-DATE. DTSBE722 00255 IF LECM-PARM-PERIOD-START-DATE = SPACES DTSBE722 00256 MOVE 'LECM-PARM-PERIOD-START-DATE IS MISSING' DTSBE722 00257 TO ABEND-MSG DTSBE722 00258 PERFORM S999-ABEND THRU S999-EXIT DTSBE722 00259 ELSE DTSBE722 00260 MOVE LECM-PARM-PERIOD-START-DATE TO L001-CAL-6-DATE-X DTSBE722 00261 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE722 00262 IF L001-VALID-DATE DTSBE722 00263 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-START-DATE DTSBE722 00264 ELSE DTSBE722 00265 MOVE 'LECM-PARM-PERIOD-START-DATE NOT VALID' DTSBE722 00266 TO ABEND-MSG DTSBE722 00267 PERFORM S999-ABEND THRU S999-EXIT. DTSBE722 00268 DTSBE722 00269 IF WRK-PARM-PERIOD-START-DATE > LECM-LAST-MJRN-PURGE-DATE DTSBE722 00270 NEXT SENTENCE DTSBE722 00271 ELSE DTSBE722 00272 MOVE DTSBE722 00273 'PERIOD-START-DATE NOT GREATER THAN LAST-MJRN-PURGE-DATE' DTSBE722 00274 TO ABEND-MSG DTSBE722 00275 PERFORM S999-ABEND THRU S999-EXIT DTSBE722 00276 END-IF. DTSBE722 00277 DTSBE722 00278 MOVE WRK-PARM-PERIOD-START-DATE TO L005-DATE. DTSBE722 00279 MOVE ZERO TO L005-TIME. DTSBE722 00280 PERFORM S005-FROM-DATE-TIME THRU S005-EXIT. DTSBE722 00281 MOVE L005-ABSTIME TO WRK-ABSTIME. DTSBE722 00282 DTSBE722 00283 DISPLAY 'ABSTIME ' WRK-ABSTIME. DTSBE722 00284 DTSBE722 00285 I1100-EXIT. DTSBE722 00286 EXIT. DTSBE722 00287 SKIP3 DTSBE722 00288 I1200-PERIOD-END-DATE. DTSBE722 00289 IF LECM-PARM-PERIOD-END-DATE = SPACES DTSBE722 00290 MOVE 'LECM-PARM-PERIOD-END-DATE IS MISSING' DTSBE722 00291 TO ABEND-MSG DTSBE722 00292 PERFORM S999-ABEND THRU S999-EXIT DTSBE722 00293 ELSE DTSBE722 00294 MOVE LECM-PARM-PERIOD-END-DATE TO L001-CAL-6-DATE-X DTSBE722 00295 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE722 00296 IF L001-VALID-DATE DTSBE722 00297 MOVE L001-FED-8-DATE-9 TO WRK-PARM-PERIOD-END-DATE DTSBE722 00298 ELSE DTSBE722 00299 MOVE 'LECM-PARM-PERIOD-END-DATE NOT VALID' DTSBE722 00300 TO ABEND-MSG DTSBE722 00301 PERFORM S999-ABEND THRU S999-EXIT. DTSBE722 00302 DTSBE722 00303 IF WRK-PARM-PERIOD-END-DATE < WRK-PARM-PERIOD-START-DATE DTSBE722 00304 MOVE DTSBE722 00305 'PERIOD-END-DATE IS LESS THAN PERIOD-START-DATE' DTSBE722 00306 TO ABEND-MSG DTSBE722 00307 PERFORM S999-ABEND THRU S999-EXIT. DTSBE722 00308 I1200-EXIT. DTSBE722 00309 EXIT. DTSBE722 00310 EJECT DTSBE722 00311 P0000-PROCESS. DTSBE722 00312 IF MPRF-EMP-NO = 010010 DTSBE722 00313 GO TO P0000-EXIT. DTSBE722 00314 DTSBE722 00315 IF MPRF-CLASS-SELF-INS-88 DTSBE722 00316 GO TO P0000-EXIT. DTSBE722 00317 DTSBE722 00318 IF MPRF-TOT-CREDIT-AMT = ZERO DTSBE722 00319 GO TO P0000-EXIT. DTSBE722 00320 DTSBE722 00321 IF MPRF-NOT-WRITTEN-OFF-88 DTSBE722 00322 NEXT SENTENCE DTSBE722 00323 ELSE DTSBE722 00324 GO TO P0000-EXIT. DTSBE722 00325 DTSBE722 00326 IF MPRF-PURSUED-RPT-CNT > ZERO DTSBE722 00327 GO TO P0000-EXIT DTSBE722 00328 END-IF. DTSBE722 00329 DTSBE722 00330 MOVE +0 TO WRK-TOT-CREDIT DTSBE722 00331 WRK-UI-PAID DTSBE722 00332 CTBL-LAST. DTSBE722 00333 DTSBE722 00334 PERFORM DTSBE722 00335 VARYING CSUB FROM +1 BY +1 DTSBE722 00336 UNTIL CSUB > CTBL-MAX DTSBE722 00337 MOVE ZEROS TO CR-BATCH (CSUB) DTSBE722 00338 CR-ITEM (CSUB) DTSBE722 00339 CR-ESTB-DT (CSUB) DTSBE722 00340 END-PERFORM. DTSBE722 00341 DTSBE722 00342 ************************************************************ DTSBE722 00343 * FIND ALL OUTSTANDING CREDITS ESTABLISHED WITHIN THE DTSBE722 00344 * REPORTING PERIOD. BUILD A TABLE CONTAINING THE BATCH DTSBE722 00345 * AND ITEM NUMBERS OF EACH CREDIT FOUND. A SECOND PROCESS DTSBE722 00346 * (P2000-TPS-DATA) WILL FIND THE AMOUNTS DISTRIBUTED DTSBE722 00347 * TO UI TAX FOR EACH PAYMENT SELECTED. DTSBE722 00348 ************************************************************ DTSBE722 00349 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBE722 00350 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE722 00351 SET MDST-DST-88 TO TRUE. DTSBE722 00352 MOVE ZEROS TO MDST-BATCH-NO DTSBE722 00353 MDST-ITEM-NO. DTSBE722 00354 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE722 00355 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE722 00356 DTSBE722 00357 PERFORM UNTIL L910-NO-REC-88 DTSBE722 00358 MOVE MSKL-REC TO MDST-REC DTSBE722 00359 IF MDST-CREDIT-REC-88 DTSBE722 00360 AND MDST-ESTB-DATE >= WRK-PARM-PERIOD-START-DATE DTSBE722 00361 AND MDST-ESTB-DATE <= WRK-PARM-PERIOD-END-DATE DTSBE722 00362 PERFORM P1000-CHECK-MJRN THRU P1000-EXIT DTSBE722 00363 IF WRK-JRN-FOUND-YES-88 DTSBE722 00364 PERFORM P1100-ADD-TO-TABLE THRU P1100-EXIT DTSBE722 00365 END-IF DTSBE722 00366 END-IF DTSBE722 00367 MOVE MDST-REC TO MSKL-REC DTSBE722 00368 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE722 00369 END-PERFORM. DTSBE722 00370 DTSBE722 00371 IF CTBL-LAST > ZERO DTSBE722 00372 ** DISPLAY 'P0000 ' MPRF-EMP-NO ' ' CTBL-LAST DTSBE722 00373 ** ' ' CR-BATCH (1) ' ' CR-ITEM (1) DTSBE722 00374 PERFORM P2000-TPS-DATA THRU P2000-EXIT DTSBE722 00375 END-IF. DTSBE722 00376 DTSBE722 00377 ** MOVE +0 TO WRK-TOT-CREDIT DTSBE722 00378 * WRK-TOT-CHARGE. DTSBE722 00379 * DTSBE722 00380 * MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE722 00381 * MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE722 00382 * MOVE WRK-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBE722 00383 * SET MJRN-JRN-88 TO TRUE. DTSBE722 00384 * MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE722 00385 * PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE722 00386 * PERFORM P1000-SCAN-MJRN THRU P1000-EXIT DTSBE722 00387 * UNTIL L910-NO-REC-88. DTSBE722 00388 * DTSBE722 00389 * IF WRK-TOT-CREDIT > ZERO DTSBE722 00390 * NEXT SENTENCE DTSBE722 00391 * ELSE DTSBE722 00392 * GO TO P0000-EXIT. DTSBE722 00393 * DTSBE722 00394 * MOVE MPRF-EMP-NO TO R722-EMP-NO. DTSBE722 00395 * MOVE LECM-PRIOR-RUN-DATE TO R722-RUN-DATE. DTSBE722 00396 * MOVE WRK-TOT-CHARGE TO R722-TAX-DUE. DTSBE722 00397 * COMPUTE R722-TAX-PAID = DTSBE722 00398 * (WRK-TOT-CHARGE + WRK-TOT-CREDIT). DTSBE722 00399 * DTSBE722 00400 ** PERFORM S946-WRITE-R722 THRU S946-EXIT. DTSBE722 00401 P0000-EXIT. DTSBE722 00402 EXIT. DTSBE722 00403 DTSBE722 00404 P1000-CHECK-MJRN. DTSBE722 00405 SET WRK-JRN-FOUND-NO-88 TO TRUE. DTSBE722 00406 DTSBE722 00407 MOVE MDST-ESTB-DATE TO L005-DATE. DTSBE722 00408 MOVE ZEROS TO L005-TIME. DTSBE722 00409 PERFORM S005-FROM-DATE-TIME THRU S005-EXIT. DTSBE722 00410 DTSBE722 00411 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE722 00412 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE722 00413 MOVE L005-ABSTIME TO MJRN-ESTB-ABSTIME. DTSBE722 00414 SET MJRN-JRN-88 TO TRUE. DTSBE722 00415 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE722 00416 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE722 00417 PERFORM DTSBE722 00418 UNTIL L910-NO-REC-88 DTSBE722 00419 OR WRK-JRN-FOUND-YES-88 DTSBE722 00420 MOVE MSKL-REC TO MJRN-REC DTSBE722 00421 IF MJRN-ESTB-DATE = MDST-ESTB-DATE DTSBE722 00422 PERFORM DTSBE722 00423 VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBE722 00424 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBE722 00425 IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) DTSBE722 00426 AND MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBE722 00427 AND MJRN-AMT (MJRN-OCC-IDX) > ZERO DTSBE722 00428 AND NOT MJRN-REF-REV-PAY-88 DTSBE722 00429 SET WRK-JRN-FOUND-YES-88 TO TRUE DTSBE722 00430 DISPLAY 'JRN ' MJRN-EMP-NO ' ' MJRN-BATCH-NO DTSBE722 00431 ' ' MJRN-ITEM-NO DTSBE722 00432 DISPLAY 'DST ' MDST-BATCH-NO ' ' MDST-ITEM-NO DTSBE722 00433 END-IF DTSBE722 00434 END-PERFORM DTSBE722 00435 END-IF DTSBE722 00436 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE722 00437 END-PERFORM. DTSBE722 00438 DTSBE722 00439 P1000-EXIT. DTSBE722 00440 EXIT. DTSBE722 00441 DTSBE722 00442 P1100-ADD-TO-TABLE. DTSBE722 00443 PERFORM DTSBE722 00444 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBE722 00445 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBE722 00446 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBE722 00447 AND MDST-AMT (MDST-ACCT-IDX) > WRK-MIN-CREDIT DTSBE722 00448 IF CTBL-LAST < CTBL-MAX DTSBE722 00449 ADD +1 TO CTBL-LAST DTSBE722 00450 MOVE CTBL-LAST TO CSUB DTSBE722 00451 MOVE MDST-BATCH-NO TO CR-BATCH (CSUB) DTSBE722 00452 MOVE MDST-ITEM-NO TO CR-ITEM (CSUB) DTSBE722 00453 MOVE MDST-ESTB-DATE TO CR-ESTB-DT (CSUB) DTSBE722 00454 ELSE DTSBE722 00455 DISPLAY 'P1100 TBL LENGTH EXCEEDED ' MPRF-EMP-NO DTSBE722 00456 END-IF DTSBE722 00457 END-IF DTSBE722 00458 END-PERFORM. DTSBE722 00459 DTSBE722 00460 P1100-EXIT. DTSBE722 00461 EXIT. DTSBE722 00462 DTSBE722 00463 DTSBE722 00464 P2000-TPS-DATA. DTSBE722 00465 PERFORM DTSBE722 00466 VARYING CSUB FROM +1 BY +1 DTSBE722 00467 UNTIL CSUB > CTBL-LAST DTSBE722 00468 PERFORM P2100-MDST-DATA THRU P2100-EXIT DTSBE722 00469 END-PERFORM. DTSBE722 00470 DTSBE722 00471 P2000-EXIT. DTSBE722 00472 EXIT. DTSBE722 00473 DTSBE722 00474 P2100-MDST-DATA. DTSBE722 00475 IF MPRF-EMP-NO = 036703 DTSBE722 00476 DISPLAY 'P2100 ' MPRF-EMP-NO ' ' CR-BATCH (CSUB) DTSBE722 00477 ' ' CR-ITEM (CSUB) ' ' CR-ESTB-DT (CSUB) DTSBE722 00478 END-IF. DTSBE722 00479 MOVE ZERO TO WRK-TOT-CREDIT DTSBE722 00480 WRK-UI-PAID. DTSBE722 00481 DTSBE722 00482 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBE722 00483 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE722 00484 SET MDST-DST-88 TO TRUE. DTSBE722 00485 MOVE ZERO TO MDST-YRQ DTSBE722 00486 MDST-BATCH-NO DTSBE722 00487 MDST-ITEM-NO. DTSBE722 00488 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE722 00489 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE722 00490 DTSBE722 00491 PERFORM UNTIL L910-NO-REC-88 DTSBE722 00492 MOVE MSKL-REC TO MDST-REC DTSBE722 00493 IF MDST-BATCH-NO = CR-BATCH (CSUB) DTSBE722 00494 AND MDST-ITEM-NO = CR-ITEM (CSUB) DTSBE722 00495 PERFORM DTSBE722 00496 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBE722 00497 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBE722 00498 IF MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBE722 00499 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE722 00500 TO WRK-UI-PAID DTSBE722 00501 ELSE DTSBE722 00502 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBE722 00503 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE722 00504 TO WRK-TOT-CREDIT DTSBE722 00505 END-IF DTSBE722 00506 END-IF DTSBE722 00507 END-PERFORM DTSBE722 00508 END-IF DTSBE722 00509 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE722 00510 END-PERFORM. DTSBE722 00511 DTSBE722 00512 PERFORM P2300-WRITE-R722 THRU P2300-EXIT. DTSBE722 00513 DTSBE722 00514 ** IF MPRF-EMP-NO = 036703 DTSBE722 00515 * MOVE WRK-TOT-CREDIT TO AMT-DISP1 DTSBE722 00516 * MOVE WRK-UI-PAID TO AMT-DISP2 DTSBE722 00517 * DISPLAY 'P2100 CR ' AMT-DISP1 ' PD ' AMT-DISP2 DTSBE722 00518 ** END-IF. DTSBE722 00519 DTSBE722 00520 P2100-EXIT. DTSBE722 00521 EXIT. DTSBE722 00522 DTSBE722 00523 *P2200-MPAY-DATA. DTSBE722 00524 * DISPLAY 'P2200 ' MPRF-EMP-NO ' ' CR-BATCH (CSUB) DTSBE722 00525 * ' ' CR-ITEM (CSUB). DTSBE722 00526 * DTSBE722 00527 * MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBE722 00528 * MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBE722 00529 * SET MPAY-PAY-88 TO TRUE. DTSBE722 00530 * MOVE CR-BATCH (CSUB) TO MPAY-BATCH-NO DTSBE722 00531 * MOVE CR-ITEM (CSUB) TO MPAY-ITEM-NO. DTSBE722 00532 * MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBE722 00533 * PERFORM S910-READ THRU S910-EXIT. DTSBE722 00534 * IF L910-NO-REC-88 DTSBE722 00535 * DISPLAY 'MPAY NOT FOUND ' MPRF-EMP-NO DTSBE722 00536 * ' ' MDST-BATCH-NO ' ' MDST-ITEM-NO DTSBE722 00537 * PERFORM S999-ABEND THRU S999-EXIT DTSBE722 00538 * ELSE DTSBE722 00539 * MOVE MSKL-REC TO MPAY-REC DTSBE722 00540 * MOVE MPAY-REMIT-AMT TO WRK-REMIT-AMT DTSBE722 00541 * END-IF. DTSBE722 00542 *P2200-EXIT. DTSBE722 00543 * EXIT. DTSBE722 00544 DTSBE722 00545 P2300-WRITE-R722. DTSBE722 00546 IF WRK-TOT-CREDIT > ZERO DTSBE722 00547 NEXT SENTENCE DTSBE722 00548 ELSE DTSBE722 00549 GO TO P2300-EXIT DTSBE722 00550 END-IF. DTSBE722 00551 DTSBE722 00552 MOVE MPRF-EMP-NO TO R722-EMP-NO. DTSBE722 00553 MOVE CR-ESTB-DT (CSUB) TO R722-RUN-DATE. DTSBE722 00554 *** MOVE LECM-PRIOR-RUN-DATE TO R722-RUN-DATE. DTSBE722 00555 MOVE WRK-UI-PAID TO R722-TAX-DUE. DTSBE722 00556 COMPUTE R722-TAX-PAID = DTSBE722 00557 (WRK-UI-PAID + WRK-TOT-CREDIT). DTSBE722 00558 DTSBE722 00559 PERFORM S946-WRITE-R722 THRU S946-EXIT. DTSBE722 00560 DTSBE722 00561 MOVE WRK-TOT-CREDIT TO AMT-DISP1. DTSBE722 00562 MOVE WRK-UI-PAID TO AMT-DISP2. DTSBE722 00563 MOVE R722-TAX-PAID TO AMT-DISP3. DTSBE722 00564 DISPLAY MPRF-EMP-NO ' ' CR-BATCH (CSUB) DTSBE722 00565 ' ' CR-ITEM (CSUB) DTSBE722 00566 ' CR ' AMT-DISP1 DTSBE722 00567 ' PD ' AMT-DISP2 DTSBE722 00568 ' R722 ' AMT-DISP3. DTSBE722 00569 P2300-EXIT. DTSBE722 00570 EXIT. DTSBE722 00571 DTSBE722 00572 *P1000-SCAN-MJRN. DTSBE722 00573 * MOVE +0 TO WRK-TRN-CREDIT DTSBE722 00574 * TRN-LAST. DTSBE722 00575 * DTSBE722 00576 * PERFORM DTSBE722 00577 * VARYING TRN-SUB FROM +1 BY +1 DTSBE722 00578 * UNTIL TRN-SUB > TRN-MAX DTSBE722 00579 * MOVE ZERO TO TRN-YRQ (TRN-SUB) DTSBE722 00580 * END-PERFORM. DTSBE722 00581 * DTSBE722 00582 * MOVE MSKL-REC TO MJRN-REC. DTSBE722 00583 * DTSBE722 00584 * IF MJRN-TRAN-CNVR-88 DTSBE722 00585 * NEXT SENTENCE DTSBE722 00586 * ELSE DTSBE722 00587 * IF MJRN-ESTB-DATE < WRK-PARM-PERIOD-START-DATE DTSBE722 00588 * OR MJRN-ESTB-DATE > WRK-PARM-PERIOD-END-DATE DTSBE722 00589 * NEXT SENTENCE DTSBE722 00590 * ELSE DTSBE722 00591 * PERFORM P1100-ACCT-GROUP-SCAN THRU P1100-EXIT DTSBE722 00592 * VARYING MJRN-OCC-IDX FROM 1 BY 1 DTSBE722 00593 * UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBE722 00594 * END-IF DTSBE722 00595 * IF WRK-TRN-CREDIT > ZERO DTSBE722 00596 * PERFORM P1200-GET-UI-CHARGE THRU P1200-EXIT DTSBE722 00597 * ADD WRK-TRN-CREDIT TO WRK-TOT-CREDIT DTSBE722 00598 * END-IF DTSBE722 00599 * END-IF. DTSBE722 00600 * DTSBE722 00601 * MOVE MJRN-REC TO MSKL-REC. DTSBE722 00602 * PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE722 00603 *P1000-EXIT. DTSBE722 00604 * EXIT. DTSBE722 00605 * SKIP3 DTSBE722 00606 *P1100-ACCT-GROUP-SCAN. DTSBE722 00607 * IF MJRN-ROW-UI-88 (MJRN-OCC-IDX) DTSBE722 00608 * PERFORM P1110-UI-TAX THRU P1110-EXIT DTSBE722 00609 * ELSE DTSBE722 00610 * IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) DTSBE722 00611 * PERFORM P1120-CREDIT THRU P1120-EXIT DTSBE722 00612 * END-IF DTSBE722 00613 * END-IF. DTSBE722 00614 * DTSBE722 00615 *P1100-EXIT. DTSBE722 00616 * EXIT. DTSBE722 00617 * SKIP3 DTSBE722 00618 *P1110-UI-TAX. DTSBE722 00619 * SET WRK-QTR-FOUND-NO-88 TO TRUE. DTSBE722 00620 * PERFORM DTSBE722 00621 * VARYING TRN-SUB FROM +1 BY +1 DTSBE722 00622 * UNTIL TRN-SUB > TRN-LAST DTSBE722 00623 * OR WRK-QTR-FOUND-YES-88 DTSBE722 00624 * IF MJRN-YRQ (MJRN-OCC-IDX) = TRN-YRQ (TRN-SUB) DTSBE722 00625 * SET WRK-QTR-FOUND-YES-88 TO TRUE DTSBE722 00626 * END-IF DTSBE722 00627 * END-PERFORM. DTSBE722 00628 * DTSBE722 00629 * IF WRK-QTR-FOUND-YES-88 DTSBE722 00630 * GO TO P1110-EXIT DTSBE722 00631 * ELSE DTSBE722 00632 * IF TRN-LAST < TRN-MAX DTSBE722 00633 * ADD +1 TO TRN-LAST DTSBE722 00634 * MOVE MJRN-YRQ (MJRN-OCC-IDX) TO TRN-YRQ (TRN-LAST) DTSBE722 00635 * ELSE DTSBE722 00636 * DISPLAY 'TRN-TABLE LENGTH EXCEEDED ' DTSBE722 00637 * MPRF-EMP-NO ' ' MJRN-BATCH-NO ' ' MJRN-ITEM-NO DTSBE722 00638 * PERFORM S999-ABEND THRU S999-EXIT DTSBE722 00639 * END-IF DTSBE722 00640 * END-IF. DTSBE722 00641 * DTSBE722 00642 *P1110-EXIT. DTSBE722 00643 * EXIT. DTSBE722 00644 * DTSBE722 00645 *P1120-CREDIT. DTSBE722 00646 * ADD MJRN-AMT (MJRN-OCC-IDX) TO WRK-TRN-CREDIT. DTSBE722 00647 * DTSBE722 00648 * MOVE MJRN-AMT (MJRN-OCC-IDX) TO AMT-DISP1. DTSBE722 00649 * MOVE WRK-TRN-CREDIT TO AMT-DISP2. DTSBE722 00650 *P1120-EXIT. DTSBE722 00651 * EXIT. DTSBE722 00652 * DTSBE722 00653 *P1200-GET-UI-CHARGE. DTSBE722 00654 * PERFORM DTSBE722 00655 * VARYING TRN-SUB FROM +1 BY +1 DTSBE722 00656 * UNTIL TRN-SUB > TRN-LAST DTSBE722 00657 * PERFORM P1210-READ-QTR THRU P1210-EXIT DTSBE722 00658 * END-PERFORM. DTSBE722 00659 * DTSBE722 00660 *P1200-EXIT. DTSBE722 00661 * EXIT. DTSBE722 00662 * DTSBE722 00663 *P1210-READ-QTR. DTSBE722 00664 * MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE722 00665 * DTSBE722 00666 * MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE722 00667 * SET MQTR-QTR-88 TO TRUE. DTSBE722 00668 * MOVE TRN-YRQ (TRN-SUB) TO MQTR-YRQ. DTSBE722 00669 * MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE722 00670 * PERFORM S910-READ THRU S910-EXIT. DTSBE722 00671 * IF L910-OK-88 DTSBE722 00672 * MOVE MSKL-REC TO MQTR-REC DTSBE722 00673 * PERFORM DTSBE722 00674 * VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBE722 00675 * UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE722 00676 * IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE722 00677 * ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE722 00678 * TO WRK-TOT-CHARGE DTSBE722 00679 * END-IF DTSBE722 00680 * END-PERFORM. DTSBE722 00681 * DTSBE722 00682 *P1210-EXIT. DTSBE722 00683 ** EXIT. DTSBE722 00684 DTSBE722 00685 T0000-TERMINATE. DTSBE722 00686 SKIP2 DTSBE722 00687 SKIP2 DTSBE722 00688 T0000-EXIT. DTSBE722 00689 EXIT. DTSBE722 00690 EJECT DTSBE722 00691 S001-FROM-FED-8. DTSBE722 00692 SET L001-FROM-FED-8 TO TRUE. DTSBE722 00693 GO TO S001-DATE. DTSBE722 00694 SKIP1 DTSBE722 00695 S001-FROM-ABS-DAY. DTSBE722 00696 SET L001-FROM-ABS-DAY TO TRUE. DTSBE722 00697 GO TO S001-DATE. DTSBE722 00698 SKIP1 DTSBE722 00699 S001-FROM-CAL-6. DTSBE722 00700 SET L001-FROM-CAL-6 TO TRUE. DTSBE722 00701 GO TO S001-DATE. DTSBE722 00702 SKIP1 DTSBE722 00703 S001-DATE. DTSBE722 00704 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE722 00705 S001-EXIT. DTSBE722 00706 EXIT. DTSBE722 00707 SKIP3 DTSBE722 00708 S005-FROM-DATE-TIME. DTSBE722 00709 SET L005-FROM-DATE-TIME TO TRUE. DTSBE722 00710 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE722 00711 S005-EXIT. DTSBE722 00712 EXIT. DTSBE722 00713 DTSBE722 00714 S910-READ. DTSBE722 00715 SET L910-READ-88 TO TRUE. DTSBE722 00716 GO TO S910-MSTR-IO. DTSBE722 00717 SKIP1 DTSBE722 00718 S910-START-BROWSE. DTSBE722 00719 SET L910-START-BROWSE-88 TO TRUE. DTSBE722 00720 GO TO S910-MSTR-IO. DTSBE722 00721 SKIP1 DTSBE722 00722 S910-READ-NEXT. DTSBE722 00723 SET L910-READ-NEXT-88 TO TRUE. DTSBE722 00724 GO TO S910-MSTR-IO. DTSBE722 00725 SKIP1 DTSBE722 00726 S910-COUNT. DTSBE722 00727 SET L910-COUNT-88 TO TRUE. DTSBE722 00728 GO TO S910-MSTR-IO. DTSBE722 00729 SKIP1 DTSBE722 00730 S910-MSTR-IO. DTSBE722 00731 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE722 00732 MSKL-REC. DTSBE722 00733 S910-EXIT. DTSBE722 00734 EXIT. DTSBE722 00735 SKIP3 DTSBE722 00736 S946-WRITE-R722. DTSBE722 00737 CALL 'DTSBU946' USING R722-REC. DTSBE722 00738 GO TO S946-EXIT. DTSBE722 00739 SKIP1 DTSBE722 00740 S946-EXIT. DTSBE722 00741 EXIT. DTSBE722 00742 SKIP3 DTSBE722 00743 S999-ABEND. DTSBE722 00744 DISPLAY '*** DTSBE722 ABENDING. ' DTSBE722 00745 ABEND-MSG. DTSBE722 00746 SKIP1 DTSBE722 00747 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE722 00748 S999-EXIT. DTSBE722 00749 EXIT. DTSBE722