00001 IDENTIFICATION DIVISION. 05/19/08 00002 PROGRAM-ID. DTSCS32. DTSCS32 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV012 00004 DATE-WRITTEN. JUNE 1994. DTSCS32 00005 DATE-COMPILED. DTSCS32 00006 SKIP3 DTSCS32 00007 ***** DTSCS32 00008 * DTSCS32 00009 * FUNCTION: ALTERNATE QUARTER INQUIRY SCREEN PROCESSOR. DTSCS32 00010 * DTSCS32 00011 * DTSCS32 00012 * MODIFICATION LOG: DTSCS32 00013 * DTSCS32 00014 * 12/23/98 INITIAL DEVELOPMENT COPIED FROM MACCS32 DTSCS32 00015 * WORK ORDER: PROGRAMMER: ZL1 DTSCS32 00016 * DTSCS32 00017 * 05/17/1999 PICKUP MODIFICATIONS. DTSCS32 00018 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS32 00019 * DTSCS32 00020 * 02/20/2006 MODIFIED INTEREST CALCULATION - ONLY UI TAX DTSCS32 00021 * BALANCE INCLUDED. DTSCS32 00022 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: GD DTSCS32 00023 * DTSCS32 00024 * 02/12/2008 MODIFIED INTEREST CALCULATION TO INCLUDE SUR DTSCS32 00025 * TAX. DTSCS32 00026 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSCS32 00027 * DTSCS32 00028 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS32 00029 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS32 00030 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS32 00031 * DTSCS32 00032 * DTSCS32 00033 * DESCRIPTION: DTSCS32 00034 * DTSCS32 00035 * CLEAR: DTSCS32 00036 * DTSCS32 00037 * FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS32 00038 * DTSCS32 00039 * DTSCS32 00040 * JUMP: DTSCS32 00041 * DTSCS32 00042 * F09 NOTE PAD INQUIRY/UPDATE (71). DTSCS32 00043 * F10 REPORT INQUIRY (33). DTSCS32 00044 * F11 PAYMENT INQUIRY (34). DTSCS32 00045 * F12 ADJUSTMENT INQUIRY (35). DTSCS32 00046 * F17 REGISTRATION INQUIRY (11). DTSCS32 00047 * F20 COLLECTIONS INQUIRY (41). DTSCS32 00048 * DTSCS32 00049 * DTSCS32 00050 * INQUIRY: DTSCS32 00051 * DTSCS32 00052 * CONTROL FIELD(S): MAP-EMP-NO DTSCS32 00053 * MAP-YRQ DTSCS32 00054 * MAP-COMBINE-IND. DTSCS32 00055 * DTSCS32 00056 * DTSCS32 00057 * JUMP IN: DISPLAY BASED ON LCCM-EMP-NO, LCCM-YRQ, DTSCS32 00058 * AND THE LAST SPECIFIED "COMBINE IND" DTSCS32 00059 * (STORED IN LCCM-SCR32-HOLD-AREA). DTSCS32 00060 * DTSCS32 00061 * DTSCS32 00062 * ENTER, F05, F06, F07, F08: DTSCS32 00063 * DTSCS32 00064 * PAGING ON THIS SCREEN IS TOO COMPLEX TO DESCRIBE. DTSCS32 00065 * FOR HINTS REGARDING HOW PAGING IS TO FUNCTION, DTSCS32 00066 * SEE THE SCREEN DESCRIPTION. DTSCS32 00067 * DTSCS32 00068 * DISPLAY SEQUENCE: DEPENDS ON MAP-COMBINE-IND DTSCS32 00069 * (SEE SCREEN DESCRIPTION DTSCS32 00070 * FOR DETAILS). DTSCS32 00071 * DTSCS32 00072 * PAGE INITIALLY DISPLAYED: DEPENDS ON MAP-COMBINE-IND DTSCS32 00073 * (SEE SCREEN DESCRIPTION DTSCS32 00074 * FOR DETAILS). DTSCS32 00075 * DTSCS32 00076 * DTSCS32 00077 * CONSTRUCTION OF THE PAGES IS SO COMPLEX THAT IT DTSCS32 00078 * WILL PROBABLY BE NECESSARY TO CONSTRUCT PAGES DTSCS32 00079 * OF INFORMATION IN TS Q 'S'. DTSCS32 00080 * DTSCS32 00081 * DTSCS32 00082 * JUMP OUT: STORE INFORMATION REPRESENTING PAGE DTSCS32 00083 * CURRENTLY DISPLAYED (AND MAP-COMBINE-IND) DTSCS32 00084 * IN LCCM-SCR32-HOLD-AREA. DTSCS32 00085 * DTSCS32 00086 * DELETE TEMPORARY STORAGE QUEUE 'S'. DTSCS32 00087 * DTSCS32 00088 * DTSCS32 00089 * LCCM-MISC-CONTROL-AREA MAINTENANCE: DTSCS32 00090 * DTSCS32 00091 * LCCM-EMP-NO DTSCS32 00092 * DTSCS32 00093 * LCCM-YRQ DTSCS32 00094 * DTSCS32 00095 * LCCM-COMP-DATE DTSCS32 00096 * DTSCS32 00097 * DTSCS32 00098 * UPDATE: DTSCS32 00099 * DTSCS32 00100 * NONE. DTSCS32 00101 * DTSCS32 00102 * DTSCS32 00103 * RECORDS READ: DTSCS32 00104 * DTSCS32 00105 * MASTER: DTSCS32 00106 * DTSCS32 00107 * MPRF DTSCS32 00108 * MQTR DTSCS32 00109 * MRPT DTSCS32 00110 * DTSCS32 00111 * DTSCS32 00112 * ALTERNATE INDEX: DTSCS32 00113 * DTSCS32 00114 * NONE. DTSCS32 00115 * DTSCS32 00116 * DTSCS32 00117 * REFERENCE: DTSCS32 00118 * DTSCS32 00119 * NONE. DTSCS32 00120 * DTSCS32 00121 * DTSCS32 00122 * ACCOUNTING TRANSACTION COLLECTION: DTSCS32 00123 * DTSCS32 00124 * NONE. DTSCS32 00125 * DTSCS32 00126 * DTSCS32 00127 * RECORDS UPDATED: DTSCS32 00128 * DTSCS32 00129 * MASTER: DTSCS32 00130 * DTSCS32 00131 * NONE. DTSCS32 00132 * DTSCS32 00133 * DTSCS32 00134 * REFERENCE: DTSCS32 00135 * DTSCS32 00136 * NONE. DTSCS32 00137 * DTSCS32 00138 * DTSCS32 00139 * ACCOUNTING TRANSACTION COLLECTION: DTSCS32 00140 * DTSCS32 00141 * NONE. DTSCS32 00142 * DTSCS32 00143 * DTSCS32 00144 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS32 00145 * DTSCS32 00146 * NONE. DTSCS32 00147 * DTSCS32 00148 * DTSCS32 00149 * TEMPORARY STORAGE USAGE: DTSCS32 00150 * DTSCS32 00151 * S IF NECESSARY FOR PAGE CONSTRUCTION/CONTROL. DTSCS32 00152 * DTSCS32 00153 * DTSCS32 00154 * MODULES LINKED TO: DTSCS32 00155 * DTSCS32 00156 * DTSCU001 DATE EDIT/CONVERSION. DTSCS32 00157 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS32 00158 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS32 00159 * DTSCU016 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS32 00160 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. DTSCS32 00161 * DTSCU056 RATE DISPLAY. DTSCS32 00162 * DTSCU101 INTEREST AND PENALTY CHARGE/ABATEMENT DTSCS32 00163 * CALCULATION. DTSCS32 00164 * DTSCU381 DETERMINE LIABILITY, DEFAULT DUE DATE, AND DTSCS32 00165 * UI RATE FOR A GIVEN QUARTER. DTSCS32 00166 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS32 00167 * DTSCS32 00168 * DTSCS32 00169 * VERMONT REFERENCE: DTSCS32 00170 * DTSCS32 00171 * NONE. DTSCS32 00172 * DTSCS32 00173 * DTSCS32 00174 * NOTES TO JEFF: DTSCS32 00175 * DTSCS32 00176 * . I TRIED TO GET THIS MODULE STARTED. YOUR ASSIGNMENT IS DTSCS32 00177 * TO FINISH IT. DTSCS32 00178 * DTSCS32 00179 * . THE LOGIC TO DETERMINE WHICH QUARTERS TO DISPLAY HAS BEEN DTSCS32 00180 * CODED. DTSCS32 00181 * DTSCS32 00182 * . THE MAP SEND/RECEIVE AREA IS JUST SOMETHING I CREATED IN DTSCS32 00183 * ORDER TO GET A COMPILE TO WORK. YOU WILL PROBABLY WANT DTSCS32 00184 * TO EITHER JUNK IT OR JUST MOVE THE "CENTER" OF THE SCREEN DTSCS32 00185 * INTO IT. DTSCS32 00186 * DTSCS32 00187 * . THERE ARE SOME COMMENTS IN THE P69* PARAGRAPHS INDICATING DTSCS32 00188 * SOME OF THE CODE THAT MUST BE ADDED TO THIS MODULE. DTSCS32 00189 * DTSCS32 00190 * DTSCS32 00191 ***** DTSCS32 00192 SKIP3 DTSCS32 00193 ENVIRONMENT DIVISION. DTSCS32 00194 SKIP3 DTSCS32 00195 DATA DIVISION. DTSCS32 00196 SKIP3 DTSCS32 00197 WORKING-STORAGE SECTION. DTSCS32 001975 77 PAN-VALET PICTURE X(24) VALUE '012DTSCS32 05/19/08'. DTSCS32 00198 SKIP3 DTSCS32 00199 01 WRK-AREA. DTSCS32 00200 05 WRK-ABEND-CD PIC X(04) VALUE 'S32 '. DTSCS32 00201 SKIP1 DTSCS32 00202 05 WRK-SCR-ID. DTSCS32 00203 10 WRK-SCR-ID-N PIC 9(02) VALUE 32. DTSCS32 00204 SKIP1 DTSCS32 00205 05 WRK-F03-SCR-ID PIC X(02) VALUE '30'. DTSCS32 00206 DTSCS32 00207 05 COLUMNS-PER-PAGE PIC S9(04) COMP VALUE +4. DTSCS32 00208 DTSCS32 00209 05 ALL-NINES-YRQ PIC S9(05) COMP-3 DTSCS32 00210 VALUE +99999. DTSCS32 00211 DTSCS32 00212 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS32 00213 VALUE +999999999.DTSCS32 00214 DTSCS32 00215 05 LIT-TOT PIC S9(04) COMP VALUE +1. DTSCS32 00216 05 LIT-COL PIC S9(04) COMP VALUE +2. DTSCS32 00217 DTSCS32 00218 05 LIT-TOT-WG PIC S9(04) COMP VALUE +1. DTSCS32 00219 05 LIT-EXC-WG PIC S9(04) COMP VALUE +2. DTSCS32 00220 05 LIT-TAX-WG PIC S9(04) COMP VALUE +3. DTSCS32 00221 05 LIT-UI-CHG PIC S9(04) COMP VALUE +4. DTSCS32 00222 05 LIT-SUR-CHG PIC S9(04) COMP VALUE +5. DTSCS32 00223 05 LIT-INT-CHG PIC S9(04) COMP VALUE +6. DTSCS32 00224 05 LIT-LATE-PEN-CHG PIC S9(04) COMP VALUE +7. DTSCS32 00225 05 LIT-N-M-CHG PIC S9(04) COMP VALUE +8. DTSCS32 00226 05 LIT-UI-PD PIC S9(04) COMP VALUE +9. DTSCS32 00227 05 LIT-SUR-PD PIC S9(04) COMP VALUE +10. DTSCS32 00228 05 LIT-INT-PD PIC S9(04) COMP VALUE +11. DTSCS32 00229 05 LIT-LATE-PEN-PD PIC S9(04) COMP VALUE +12. DTSCS32 00230 05 LIT-N-M-PD PIC S9(04) COMP VALUE +13. DTSCS32 00231 05 LIT-UI-DUE PIC S9(04) COMP VALUE +14. DTSCS32 00232 05 LIT-SUR-DUE PIC S9(04) COMP VALUE +15. DTSCS32 00233 05 LIT-INT-DUE PIC S9(04) COMP VALUE +16. DTSCS32 00234 05 LIT-LATE-PEN-DUE PIC S9(04) COMP VALUE +17. DTSCS32 00235 05 LIT-N-M-DUE PIC S9(04) COMP VALUE +18. DTSCS32 00236 SKIP3 DTSCS32 00237 05 SCR-ACCESS-IND PIC X(01). DTSCS32 00238 88 SCR-ACCESS-INQ VALUE '1'. DTSCS32 00239 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS32 00240 DTSCS32 00241 05 CURSOR-SET-IND PIC X(01). DTSCS32 00242 88 CURSOR-SET-YES VALUE 'Y'. DTSCS32 00243 88 CURSOR-SET-NO VALUE 'N'. DTSCS32 00244 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS32 00245 DTSCS32 00246 05 REQ-IND PIC X(01). DTSCS32 00247 88 REQ-ERROR VALUE 'O'. DTSCS32 00248 88 REQ-JUMP VALUE 'J'. DTSCS32 00249 88 REQ-INQUIRE VALUE 'I'. DTSCS32 00250 88 REQ-CLEAR VALUE 'C'. DTSCS32 00251 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS32 00252 DTSCS32 00253 05 RESP-IND PIC X(01). DTSCS32 00254 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS32 00255 88 RESP-SEND-MAP VALUE 'M'. DTSCS32 00256 88 RESP-JUMP VALUE 'J'. DTSCS32 00257 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS32 00258 DTSCS32 00259 05 WRK-MSG-AREA PIC X(64). DTSCS32 00260 DTSCS32 00261 05 WRK-ATB-AN PIC X(01). DTSCS32 00262 05 WRK-ATB-NUM PIC X(01). DTSCS32 00263 SKIP3 DTSCS32 00264 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS32 00265 DTSCS32 00266 05 WRK-MPRF-IND PIC X(01). DTSCS32 00267 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS32 00268 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS32 00269 DTSCS32 00270 05 WRK-YRQ PIC S9(05) COMP-3. DTSCS32 00271 DTSCS32 00272 05 WRK-COMBINE-IND PIC X(01). DTSCS32 00273 DTSCS32 00274 05 WRK-FIRST-ABS-QTR PIC S9(04) COMP. DTSCS32 00275 DTSCS32 00276 05 WRK-LAST-ABS-QTR PIC S9(04) COMP. DTSCS32 00277 SKIP3 DTSCS32 00278 05 WRK-QTR-CNT PIC S9(04) COMP. DTSCS32 00279 DTSCS32 00280 05 WRK-ABS-QTR PIC S9(04) COMP. DTSCS32 00281 DTSCS32 00282 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. DTSCS32 00283 SKIP3 DTSCS32 00284 05 WRK-DISPLAY PIC 9(11). DTSCS32 00285 DTSCS32 00286 05 FILLER REDEFINES WRK-DISPLAY. DTSCS32 00287 10 FILLER PIC X(05). DTSCS32 00288 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS32 00289 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS32 00290 DTSCS32 00291 05 FILLER REDEFINES WRK-DISPLAY. DTSCS32 00292 10 FILLER PIC X(08). DTSCS32 00293 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS32 00294 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS32 00295 DTSCS32 00296 05 FILLER REDEFINES WRK-DISPLAY. DTSCS32 00297 10 FILLER PIC X(05). DTSCS32 00298 10 WRK-DISPLAY-YR PIC X(02). DTSCS32 00299 10 WRK-DISPLAY-MO PIC X(02). DTSCS32 00300 10 WRK-DISPLAY-DA PIC X(02). DTSCS32 00301 SKIP3 DTSCS32 00302 05 COL-SUB PIC S9(04) COMP. DTSCS32 00303 SKIP3 DTSCS32 00304 05 WRK-ROW PIC S9(04) COMP. DTSCS32 00305 DTSCS32 00306 05 WRK-COL PIC S9(04) COMP. DTSCS32 00307 SKIP3 DTSCS32 00308 05 HOLD-LAST-MQTR-KEY-AREA PIC X(16). DTSCS32 00309 SKIP3 DTSCS32 00310 05 SCR-HOLD-AREA. DTSCS32 00311 10 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS32 00312 10 SCR-HOLD-YRQ PIC S9(05) COMP-3. DTSCS32 00313 10 SCR-HOLD-FIRST-ABS-QTR PIC S9(04) COMP. DTSCS32 00314 10 SCR-HOLD-LAST-ABS-QTR PIC S9(04) COMP. DTSCS32 00315 EJECT DTSCS32 00316 01 WRK-SUM-TABLE. DTSCS32 00317 05 FILLER OCCURS 2 TIMES. DTSCS32 00318 10 WRK-TOTAL OCCURS 18 TIMES PIC S9(9)V99 COMP-3. DTSCS32 00319 SKIP3 DTSCS32 00320 *01 MSG-LITERALS. DTSCS32 00321 *****05 MSG-E321-AREA. DTSCS32 00322 ***** 10 FILLER PIC X(04) VALUE 'E321'. DTSCS32 00323 ***** 10 FILLER PIC X(30) DTSCS32 00324 ***** VALUE ' '. DTSCS32 00325 ***** 10 FILLER PIC X(30) DTSCS32 00326 ***** VALUE ' '. DTSCS32 00327 EJECT DTSCS32 00328 01 L001-COMM-AREA. DTSCS32 00329 ++INCLUDE DTSIL001 DTSCS32 00330 EJECT DTSCS32 00331 01 L004-COMM-AREA. DTSCS32 00332 ++INCLUDE DTSIL004 DTSCS32 00333 EJECT DTSCS32 00334 01 L015-COMM-AREA. DTSCS32 00335 ++INCLUDE DTSIL015 DTSCS32 00336 EJECT DTSCS32 00337 01 L016-COMM-AREA. DTSCS32 00338 ++INCLUDE DTSIL016 DTSCS32 00339 EJECT DTSCS32 00340 01 L018-COMM-AREA. DTSCS32 00341 ++INCLUDE DTSIL018 DTSCS32 00342 EJECT DTSCS32 00343 01 L029-COMM-AREA. DTSCS32 00344 ++INCLUDE DTSIL029 DTSCS32 00345 EJECT DTSCS32 00346 01 L056-COMM-AREA. DTSCS32 00347 ++INCLUDE DTSIL056 DTSCS32 00348 EJECT DTSCS32 00349 01 L101-COMM-AREA. DTSCS32 00350 ++INCLUDE DTSIL101 DTSCS32 00351 EJECT DTSCS32 00352 01 L109-COMM-AREA. DTSCS32 00353 ++INCLUDE DTSIL109 DTSCS32 00354 EJECT DTSCS32 00355 01 L805-COMM-AREA. DTSCS32 00356 ++INCLUDE DTSIL805 DTSCS32 00357 EJECT DTSCS32 00358 01 L810-COMM-AREA. DTSCS32 00359 05 L810-CONTROL-BLOCK. DTSCS32 00360 ++INCLUDE DTSIL810 DTSCS32 00361 EJECT DTSCS32 00362 05 MSKL-REC. DTSCS32 00363 ++INCLUDE DTSIMSKL DTSCS32 00364 EJECT DTSCS32 00365 01 MPRF-REC. DTSCS32 00366 ++INCLUDE DTSIMPRF DTSCS32 00367 EJECT DTSCS32 00368 01 MQTR-REC. DTSCS32 00369 ++INCLUDE DTSIMQTR DTSCS32 00370 EJECT DTSCS32 00371 01 MRPT-REC. DTSCS32 00372 ++INCLUDE DTSIMRPT DTSCS32 00373 EJECT DTSCS32 00374 01 L851-COMM-AREA. DTSCS32 00375 ++INCLUDE DTSIL851 DTSCS32 00376 SKIP3 DTSCS32 00377 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS32 00378 ++INCLUDE DTSIS32 DTSCS32 00379 EJECT DTSCS32 00380 01 CATB-LITERALS. DTSCS32 00381 ++INCLUDE DTSICATB DTSCS32 00382 SKIP3 DTSCS32 00383 01 CFKD-LITERALS. DTSCS32 00384 ++INCLUDE DTSICFKD DTSCS32 00385 SKIP3 DTSCS32 00386 01 CECD-LITERALS. DTSCS32 00387 ++INCLUDE DTSICECD DTSCS32 00388 SKIP3 DTSCS32 00389 01 CPCD-LITERALS. DTSCS32 00390 ++INCLUDE DTSICPCD DTSCS32 00391 EJECT DTSCS32 00392 LINKAGE SECTION. DTSCS32 00393 SKIP3 DTSCS32 00394 01 DFHCOMMAREA. DTSCS32 00395 ++INCLUDE DTSILCCM DTSCS32 00396 EJECT DTSCS32 00397 ******************************************************************DTSCS32 00398 * *DTSCS32 00399 ******************************************************************DTSCS32 00400 SKIP1 DTSCS32 00401 PROCEDURE DIVISION. DTSCS32 00402 SKIP2 DTSCS32 00403 MOVE +0 TO WRK-EMP-NO DTSCS32 00404 WRK-YRQ. DTSCS32 00405 DTSCS32 00406 SET WRK-MPRF-NO-88 TO TRUE. DTSCS32 00407 DTSCS32 00408 MOVE LOW-VALUES TO MAP-AREA. DTSCS32 00409 DTSCS32 00410 SET CURSOR-SET-NO TO TRUE. DTSCS32 00411 DTSCS32 00412 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS32 00413 TO SCR-ACCESS-IND. DTSCS32 00414 SKIP3 DTSCS32 00415 MOVE SPACE TO REQ-IND. DTSCS32 00416 DTSCS32 00417 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS32 00418 DTSCS32 00419 *----------------------------------------------------- DTSCS32 00420 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS32 00421 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS32 00422 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS32 00423 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS32 00424 * DTSCS32 00425 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS32 00426 * PROCESSED. DTSCS32 00427 * DTSCS32 00428 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS32 00429 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS32 00430 * WORK STATION OPERATOR. DTSCS32 00431 *----------------------------------------------------- DTSCS32 00432 DTSCS32 00433 MOVE SPACE TO RESP-IND. DTSCS32 00434 DTSCS32 00435 IF REQ-ERROR DTSCS32 00436 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS32 00437 ELSE DTSCS32 00438 IF REQ-JUMP DTSCS32 00439 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS32 00440 ELSE DTSCS32 00441 IF REQ-CLEAR DTSCS32 00442 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS32 00443 ELSE DTSCS32 00444 IF REQ-CURSOR-TO-GOTO DTSCS32 00445 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS32 00446 ELSE DTSCS32 00447 IF REQ-INQUIRE DTSCS32 00448 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS32 00449 ELSE DTSCS32 00450 *****IF REQ-EDIT DTSCS32 00451 ***** PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS32 00452 *****ELSE DTSCS32 00453 *****IF REQ-UPDATE DTSCS32 00454 ***** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS32 00455 *****ELSE DTSCS32 00456 GO TO S899-ABEND. DTSCS32 00457 SKIP3 DTSCS32 00458 *----------------------------------------------------- DTSCS32 00459 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS32 00460 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS32 00461 *----------------------------------------------------- DTSCS32 00462 DTSCS32 00463 IF RESP-SEND-MAP DTSCS32 00464 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS32 00465 SET LCCM-END-TASK-88 TO TRUE DTSCS32 00466 ELSE DTSCS32 00467 IF RESP-SEND-MSGONLY DTSCS32 00468 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS32 00469 SET LCCM-END-TASK-88 TO TRUE DTSCS32 00470 ELSE DTSCS32 00471 IF RESP-JUMP DTSCS32 00472 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS32 00473 ELSE DTSCS32 00474 IF RESP-CURSOR-TO-GOTO DTSCS32 00475 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS32 00476 SET LCCM-END-TASK-88 TO TRUE DTSCS32 00477 ELSE DTSCS32 00478 GO TO S899-ABEND. DTSCS32 00479 SKIP3 DTSCS32 00480 MAINLINE-EXIT. DTSCS32 00481 SKIP1 DTSCS32 00482 EXEC CICS DTSCS32 00483 RETURN DTSCS32 00484 END-EXEC. DTSCS32 00485 SKIP2 DTSCS32 00486 GOBACK. DTSCS32 00487 EJECT DTSCS32 00488 /*****************************************************************DTSCS32 00489 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS32 00490 ******************************************************************DTSCS32 00491 P1000-ANALYZE-REQUEST. DTSCS32 00492 DTSCS32 00493 *----------------------------------------------------- DTSCS32 00494 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS32 00495 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS32 00496 * REPLACED WITH ENTER) DTSCS32 00497 *----------------------------------------------------- DTSCS32 00498 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS32 00499 SET LCCM-ENTER-88 TO TRUE DTSCS32 00500 IF LCCM-EMP-NO = +0 DTSCS32 00501 MOVE +0 TO LCCM-YRQ DTSCS32 00502 MOVE PMSG-KEY-EMP-NO TO LCCM-MSG-AREA DTSCS32 00503 SET REQ-CLEAR TO TRUE DTSCS32 00504 ELSE DTSCS32 00505 SET REQ-INQUIRE TO TRUE DTSCS32 00506 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS32 00507 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS32 00508 PERFORM P1100-CHECK-LCCM-YRQ THRU P1100-EXIT DTSCS32 00509 END-IF DTSCS32 00510 GO TO P1000-EXIT. DTSCS32 00511 SKIP3 DTSCS32 00512 *----------------------------------------------------- DTSCS32 00513 * MAP IS RECEIVED DTSCS32 00514 *----------------------------------------------------- DTSCS32 00515 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS32 00516 SKIP3 DTSCS32 00517 *----------------------------------------------------- DTSCS32 00518 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS32 00519 * WORK STATION DTSCS32 00520 *----------------------------------------------------- DTSCS32 00521 IF LCCM-CLEAR-88 DTSCS32 00522 SET REQ-CLEAR TO TRUE DTSCS32 00523 GO TO P1000-EXIT. DTSCS32 00524 SKIP3 DTSCS32 00525 *----------------------------------------------------- DTSCS32 00526 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS32 00527 *----------------------------------------------------- DTSCS32 00528 IF LCCM-PA2-88 DTSCS32 00529 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS32 00530 GO TO P1000-EXIT. DTSCS32 00531 SKIP3 DTSCS32 00532 *----------------------------------------------------- DTSCS32 00533 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS32 00534 *----------------------------------------------------- DTSCS32 00535 IF LCCM-PA-88 DTSCS32 00536 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS32 00537 SET REQ-ERROR TO TRUE DTSCS32 00538 GO TO P1000-EXIT. DTSCS32 00539 SKIP3 DTSCS32 00540 *----------------------------------------------------- DTSCS32 00541 * IF F12 KEYS IS PRESSED AND UPDATE NOT IN PROGRESS DTSCS32 00542 * CLEAR SCREEN DTSCS32 00543 *----------------------------------------------------- DTSCS32 00544 IF LCCM-F12-88 DTSCS32 00545 MOVE LOW-VALUES TO MAP-AREA DTSCS32 00546 SET REQ-CLEAR TO TRUE DTSCS32 00547 GO TO P1000-EXIT. DTSCS32 00548 SKIP3 DTSCS32 00549 *----------------------------------------------------- DTSCS32 00550 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS32 00551 *----------------------------------------------------- DTSCS32 00552 IF LCCM-F03-88 DTSCS32 00553 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS32 00554 SET REQ-JUMP TO TRUE DTSCS32 00555 GO TO P1000-EXIT. DTSCS32 00556 SKIP3 DTSCS32 00557 *----------------------------------------------------- DTSCS32 00558 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS32 00559 *----------------------------------------------------- DTSCS32 00560 IF LCCM-F04-88 DTSCS32 00561 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS32 00562 SET REQ-JUMP TO TRUE DTSCS32 00563 GO TO P1000-EXIT. DTSCS32 00564 SKIP3 DTSCS32 00565 *----------------------------------------------------- DTSCS32 00566 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS32 00567 * CORRESPONDENCE SCREEN DTSCS32 00568 *----------------------------------------------------- DTSCS32 00569 IF LCCM-F14-88 DTSCS32 00570 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS32 00571 SET REQ-JUMP TO TRUE DTSCS32 00572 GO TO P1000-EXIT. DTSCS32 00573 SKIP3 DTSCS32 00574 * IF LCCM-F09-88 DTSCS32 00575 * MOVE '71' TO LCCM-REQ-SCR-ID DTSCS32 00576 * SET REQ-JUMP TO TRUE DTSCS32 00577 * GO TO P1000-EXIT. DTSCS32 00578 * DTSCS32 00579 * IF LCCM-F10-88 DTSCS32 00580 * MOVE '33' TO LCCM-REQ-SCR-ID DTSCS32 00581 * SET REQ-JUMP TO TRUE DTSCS32 00582 * GO TO P1000-EXIT. DTSCS32 00583 * DTSCS32 00584 * IF LCCM-F11-88 DTSCS32 00585 * MOVE '34' TO LCCM-REQ-SCR-ID DTSCS32 00586 * SET REQ-JUMP TO TRUE DTSCS32 00587 * GO TO P1000-EXIT. DTSCS32 00588 * DTSCS32 00589 * IF LCCM-F12-88 DTSCS32 00590 * MOVE '35' TO LCCM-REQ-SCR-ID DTSCS32 00591 * SET REQ-JUMP TO TRUE DTSCS32 00592 * GO TO P1000-EXIT. DTSCS32 00593 * DTSCS32 00594 * IF LCCM-F17-88 DTSCS32 00595 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS32 00596 * SET REQ-JUMP TO TRUE DTSCS32 00597 * GO TO P1000-EXIT. DTSCS32 00598 * DTSCS32 00599 * IF LCCM-F20-88 DTSCS32 00600 * MOVE '41' TO LCCM-REQ-SCR-ID DTSCS32 00601 * SET REQ-JUMP TO TRUE DTSCS32 00602 * GO TO P1000-EXIT. DTSCS32 00603 * SKIP3 DTSCS32 00604 *----------------------------------------------------- DTSCS32 00605 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS32 00606 * REQUESTED SCREEN TYPE DTSCS32 00607 *----------------------------------------------------- DTSCS32 00608 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS32 00609 NEXT SENTENCE DTSCS32 00610 ELSE DTSCS32 00611 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS32 00612 SET REQ-JUMP TO TRUE DTSCS32 00613 GO TO P1000-EXIT. DTSCS32 00614 SKIP3 DTSCS32 00615 *----------------------------------------------------- DTSCS32 00616 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS32 00617 * F8), INDICATE INQUIRY REQUEST DTSCS32 00618 *----------------------------------------------------- DTSCS32 00619 IF LCCM-INQUIRY-88 DTSCS32 00620 SET REQ-INQUIRE TO TRUE DTSCS32 00621 GO TO P1000-EXIT. DTSCS32 00622 SKIP3 DTSCS32 00623 *----------------------------------------------------- DTSCS32 00624 * ANY OTHER KEY IS INVALID DTSCS32 00625 *----------------------------------------------------- DTSCS32 00626 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS32 00627 SET REQ-ERROR TO TRUE. DTSCS32 00628 P1000-EXIT. DTSCS32 00629 EXIT. DTSCS32 00630 SKIP3 DTSCS32 00631 P1100-CHECK-LCCM-YRQ. DTSCS32 00632 IF (LCCM-YRQ = ALL-NINES-YRQ) DTSCS32 00633 OR DTSCS32 00634 (LCCM-YRQ < LCCM-PICKUP-YRQ) DTSCS32 00635 MOVE +0 TO LCCM-YRQ DTSCS32 00636 GO TO P1100-EXIT. DTSCS32 00637 DTSCS32 00638 IF LCCM-YRQ > +0 DTSCS32 00639 PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT DTSCS32 00640 GO TO P1100-EXIT. DTSCS32 00641 DTSCS32 00642 *****MOVE LCCM-SCR32-HOLD-AREA TO SCR-HOLD-AREA. DTSCS32 00643 *****IF SCR-HOLD-AREA NOT = LOW-VALUES DTSCS32 00644 ***** IF SCR-HOLD-EMP-NO = LCCM-EMP-NO DTSCS32 00645 ***** IF SCR-HOLD-YRQ > +0 DTSCS32 00646 ***** MOVE SCR-HOLD-YRQ TO LCCM-YRQ DTSCS32 00647 ***** PERFORM P1110-DISPLAY-YRQ THRU P1110-EXIT. DTSCS32 00648 P1100-EXIT. DTSCS32 00649 EXIT. DTSCS32 00650 SKIP3 DTSCS32 00651 P1110-DISPLAY-YRQ. DTSCS32 00652 IF LCCM-YRQ = LCCM-PICKUP-YRQ DTSCS32 00653 MOVE 'PU' TO MAP-YRQ-YR DTSCS32 00654 MOVE SPACE TO MAP-YRQ-Q DTSCS32 00655 ELSE DTSCS32 00656 MOVE LCCM-YRQ TO WRK-DISPLAY DTSCS32 00657 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR DTSCS32 00658 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. DTSCS32 00659 P1110-EXIT. DTSCS32 00660 EXIT. DTSCS32 00661 /*****************************************************************DTSCS32 00662 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS32 00663 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS32 00664 ******************************************************************DTSCS32 00665 SKIP1 DTSCS32 00666 P2000-REQUEST-ERROR. DTSCS32 00667 IF LCCM-MSG DTSCS32 00668 SET RESP-SEND-MSGONLY TO TRUE DTSCS32 00669 ELSE DTSCS32 00670 GO TO S899-ABEND. DTSCS32 00671 P2000-EXIT. DTSCS32 00672 EXIT. DTSCS32 00673 /*****************************************************************DTSCS32 00674 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS32 00675 ******************************************************************DTSCS32 00676 SKIP1 DTSCS32 00677 P3000-REQUEST-JUMP. DTSCS32 00678 *----------------------------------------------------- DTSCS32 00679 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS32 00680 * BY USER DTSCS32 00681 *----------------------------------------------------- DTSCS32 00682 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS32 00683 SKIP3 DTSCS32 00684 *----------------------------------------------------- DTSCS32 00685 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS32 00686 *----------------------------------------------------- DTSCS32 00687 IF LCCM-MSG DTSCS32 00688 SET RESP-SEND-MSGONLY TO TRUE DTSCS32 00689 SET CURSOR-SET-GOTO TO TRUE DTSCS32 00690 GO TO P3000-EXIT. DTSCS32 00691 SKIP3 DTSCS32 00692 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS32 00693 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS32 00694 IF L018-VALID DTSCS32 00695 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCS32 00696 DTSCS32 00697 MOVE MAP-YRQ-AREA TO L029-S-YRQ-AREA DTSCS32 00698 PERFORM S029-YRQ-WITH-PU-FROM-SCREEN THRU S029-EXIT DTSCS32 00699 IF L029-VALID DTSCS32 00700 MOVE L029-YRQ TO LCCM-YRQ. DTSCS32 00701 SKIP3 DTSCS32 00702 *----------------------------------------------------- DTSCS32 00703 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS32 00704 *----------------------------------------------------- DTSCS32 00705 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS32 00706 LCCM-SCR-HOLD-AREA. DTSCS32 00707 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS32 00708 SET RESP-JUMP TO TRUE. DTSCS32 00709 P3000-EXIT. DTSCS32 00710 EXIT. DTSCS32 00711 /*****************************************************************DTSCS32 00712 * CLEAR KEY WAS PRESSED *DTSCS32 00713 ******************************************************************DTSCS32 00714 SKIP1 DTSCS32 00715 P4000-REQUEST-CLEAR. DTSCS32 00716 *----------------------------------------------------- DTSCS32 00717 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS32 00718 * FIELDS FROM EARLIER REQUESTS DTSCS32 00719 *----------------------------------------------------- DTSCS32 00720 IF LCCM-EMP-NO > ZERO DTSCS32 00721 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS32 00722 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS32 00723 DTSCS32 00724 DTSCS32 00725 MOVE ZERO TO LCCM-EMP-NO DTSCS32 00726 LCCM-YRQ. DTSCS32 00727 DTSCS32 00728 MOVE LCCM-COMBINE-IND TO MAP-COMBINE-IND. DTSCS32 00729 DTSCS32 00730 MOVE LCCM-COMP-DATE TO WRK-DISPLAY. DTSCS32 00731 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO. DTSCS32 00732 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA. DTSCS32 00733 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR. DTSCS32 00734 DTSCS32 00735 DTSCS32 00736 DTSCS32 00737 MOVE LOW-VALUES TO LCCM-SCR32-HOLD-AREA. DTSCS32 00738 DTSCS32 00739 DTSCS32 00740 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS32 00741 DTSCS32 00742 SET LCCM-SCR-CLEAR TO TRUE. DTSCS32 00743 DTSCS32 00744 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS32 00745 DTSCS32 00746 SET RESP-SEND-MAP TO TRUE. DTSCS32 00747 P4000-EXIT. DTSCS32 00748 EXIT. DTSCS32 00749 /*****************************************************************DTSCS32 00750 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS32 00751 ******************************************************************DTSCS32 00752 SKIP1 DTSCS32 00753 P5000-CURSOR-TO-GOTO. DTSCS32 00754 SET CURSOR-SET-GOTO TO TRUE. DTSCS32 00755 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS32 00756 P5000-EXIT. DTSCS32 00757 EXIT. DTSCS32 00758 /*****************************************************************DTSCS32 00759 * INQUIRY WAS REQUESTED *DTSCS32 00760 ******************************************************************DTSCS32 00761 SKIP1 DTSCS32 00762 P6000-REQUEST-INQUIRE. DTSCS32 00763 *------------------------------------------------------------ DTSCS32 00764 * CLEAR MAP-AREA WHILE PRESERVING MAP-EMP-NO-AREA AND DTSCS32 00765 * MAP-YRQ-AREA. DTSCS32 00766 *------------------------------------------------------------ DTSCS32 00767 DTSCS32 00768 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS32 00769 DTSCS32 00770 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS32 00771 DTSCS32 00772 MOVE MAP-COMBINE-IND TO WRK-COMBINE-IND. DTSCS32 00773 DTSCS32 00774 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS32 00775 DTSCS32 00776 DTSCS32 00777 MOVE LOW-VALUES TO MAP-AREA. DTSCS32 00778 DTSCS32 00779 DTSCS32 00780 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS32 00781 DTSCS32 00782 MOVE L016-S-YRQ-AREA TO MAP-YRQ-AREA. DTSCS32 00783 DTSCS32 00784 MOVE WRK-COMBINE-IND TO MAP-COMBINE-IND. DTSCS32 00785 DTSCS32 00786 MOVE L015-S-DATE-AREA TO MAP-COMP-DATE-AREA. DTSCS32 00787 DTSCS32 00788 DTSCS32 00789 SET LCCM-SCR-CLEAR TO TRUE. DTSCS32 00790 DTSCS32 00791 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS32 00792 DTSCS32 00793 SET RESP-SEND-MAP TO TRUE. DTSCS32 00794 DTSCS32 00795 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS32 00796 DTSCS32 00797 DTSCS32 00798 *------------------------------------------------------------ DTSCS32 00799 * IF LAST ACTION WAS A SCREEN 32 DISPLAY, THEN LCCM-SCR32 DTSCS32 00800 * HOLD-AREA CONTAINS EMP NO, YRQ AND PAGE NUMBER LAST DTSCS32 00801 * DISPLAYED. DTSCS32 00802 *------------------------------------------------------------ DTSCS32 00803 DTSCS32 00804 MOVE LCCM-SCR32-HOLD-AREA TO SCR-HOLD-AREA. DTSCS32 00805 DTSCS32 00806 MOVE LOW-VALUES TO LCCM-SCR32-HOLD-AREA. DTSCS32 00807 DTSCS32 00808 DTSCS32 00809 *------------------------------------------------------------ DTSCS32 00810 * EDIT MAP-EMP-NO-AREA AND MAP-YRQ-AREA FOR VALIDITY. DTSCS32 00811 *------------------------------------------------------------ DTSCS32 00812 DTSCS32 00813 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS32 00814 IF LCCM-MSG DTSCS32 00815 NEXT SENTENCE DTSCS32 00816 ELSE DTSCS32 00817 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS32 00818 DTSCS32 00819 PERFORM S1200-YRQ THRU S1200-EXIT. DTSCS32 00820 IF LCCM-MSG DTSCS32 00821 NEXT SENTENCE DTSCS32 00822 ELSE DTSCS32 00823 MOVE WRK-YRQ TO LCCM-YRQ. DTSCS32 00824 DTSCS32 00825 PERFORM S1300-COMBINE-IND THRU S1300-EXIT. DTSCS32 00826 DTSCS32 00827 PERFORM S1400-COMP-DATE THRU S1400-EXIT. DTSCS32 00828 DTSCS32 00829 IF LCCM-MSG DTSCS32 00830 GO TO P6000-EXIT. DTSCS32 00831 DTSCS32 00832 DTSCS32 00833 PERFORM P6100-DETERMINE-YRQ-TO-DISPLAY THRU P6100-EXIT. DTSCS32 00834 DTSCS32 00835 IF LCCM-MSG DTSCS32 00836 GO TO P6000-EXIT. DTSCS32 00837 DTSCS32 00838 DTSCS32 00839 *------------------------------------------------------------ DTSCS32 00840 * PLACE INFORMATION INTO MAP-AREA. DTSCS32 00841 *------------------------------------------------------------ DTSCS32 00842 DTSCS32 00843 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS32 00844 DTSCS32 00845 DTSCS32 00846 MOVE LOW-VALUES TO SCR-HOLD-AREA. DTSCS32 00847 DTSCS32 00848 DTSCS32 00849 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCS32 00850 DTSCS32 00851 IF LCCM-COMBINE-NO-88 DTSCS32 00852 MOVE WRK-LAST-ABS-QTR TO L004-ABS-QTR DTSCS32 00853 ELSE DTSCS32 00854 MOVE WRK-FIRST-ABS-QTR TO L004-ABS-QTR. DTSCS32 00855 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS32 00856 MOVE L004-QTR-5-9 TO SCR-HOLD-YRQ DTSCS32 00857 LCCM-YRQ. DTSCS32 00858 DTSCS32 00859 MOVE WRK-FIRST-ABS-QTR TO SCR-HOLD-FIRST-ABS-QTR. DTSCS32 00860 DTSCS32 00861 MOVE WRK-LAST-ABS-QTR TO SCR-HOLD-LAST-ABS-QTR. DTSCS32 00862 DTSCS32 00863 DTSCS32 00864 MOVE SCR-HOLD-AREA TO LCCM-SCR32-HOLD-AREA. DTSCS32 00865 DTSCS32 00866 DTSCS32 00867 IF L004-QTR-5-9 = LCCM-PICKUP-YRQ DTSCS32 00868 MOVE 'PU' TO MAP-YRQ-YR DTSCS32 00869 MOVE ' ' TO MAP-YRQ-Q DTSCS32 00870 ELSE DTSCS32 00871 MOVE L004-QTR-5-9 TO WRK-DISPLAY DTSCS32 00872 MOVE WRK-DISPLAY-YRQ-YR TO MAP-YRQ-YR DTSCS32 00873 MOVE WRK-DISPLAY-YRQ-Q TO MAP-YRQ-Q. DTSCS32 00874 DTSCS32 00875 DTSCS32 00876 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS32 00877 P6000-EXIT. DTSCS32 00878 EXIT. DTSCS32 00879 EJECT DTSCS32 00880 P6100-DETERMINE-YRQ-TO-DISPLAY. DTSCS32 00881 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS32 00882 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS32 00883 SET MSKL-QTR-88 TO TRUE. DTSCS32 00884 DTSCS32 00885 PERFORM S810-COUNT THRU S810-EXIT. DTSCS32 00886 DTSCS32 00887 IF L810-RECORD-CNT = +0 DTSCS32 00888 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS32 00889 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS32 00890 GO TO P6100-EXIT. DTSCS32 00891 DTSCS32 00892 MOVE MSKL-KEY-AREA TO HOLD-LAST-MQTR-KEY-AREA. DTSCS32 00893 DTSCS32 00894 IF LCCM-COMBINE-YES-88 DTSCS32 00895 MOVE +4 TO WRK-QTR-CNT DTSCS32 00896 ELSE DTSCS32 00897 MOVE +5 TO WRK-QTR-CNT. DTSCS32 00898 DTSCS32 00899 IF LCCM-F05-88 DTSCS32 00900 PERFORM P6110-LAST THRU P6110-EXIT DTSCS32 00901 GO TO P6100-EXIT. DTSCS32 00902 DTSCS32 00903 IF LCCM-F06-88 DTSCS32 00904 PERFORM P6120-FIRST THRU P6120-EXIT DTSCS32 00905 GO TO P6100-EXIT. DTSCS32 00906 DTSCS32 00907 IF WRK-YRQ = +0 DTSCS32 00908 PERFORM P6110-LAST THRU P6110-EXIT DTSCS32 00909 GO TO P6100-EXIT. DTSCS32 00910 DTSCS32 00911 IF SCR-HOLD-AREA = LOW-VALUES DTSCS32 00912 PERFORM P6150-WRK-YRQ THRU P6150-EXIT DTSCS32 00913 ELSE DTSCS32 00914 IF (WRK-EMP-NO = SCR-HOLD-EMP-NO) DTSCS32 00915 AND DTSCS32 00916 (WRK-YRQ = SCR-HOLD-YRQ) DTSCS32 00917 IF LCCM-F07-88 DTSCS32 00918 PERFORM P6130-PRIOR THRU P6130-EXIT DTSCS32 00919 ELSE DTSCS32 00920 IF LCCM-F08-88 DTSCS32 00921 PERFORM P6140-NEXT THRU P6140-EXIT DTSCS32 00922 ELSE DTSCS32 00923 PERFORM P6150-WRK-YRQ THRU P6150-EXIT DTSCS32 00924 ELSE DTSCS32 00925 PERFORM P6150-WRK-YRQ THRU P6150-EXIT. DTSCS32 00926 P6100-EXIT. DTSCS32 00927 EXIT. DTSCS32 00928 SKIP3 DTSCS32 00929 P6110-LAST. DTSCS32 00930 MOVE HOLD-LAST-MQTR-KEY-AREA TO MQTR-KEY-AREA. DTSCS32 00931 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS32 00932 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS32 00933 MOVE L004-ABS-QTR TO WRK-LAST-ABS-QTR. DTSCS32 00934 COMPUTE WRK-FIRST-ABS-QTR DTSCS32 00935 = WRK-LAST-ABS-QTR - (WRK-QTR-CNT - 1). DTSCS32 00936 P6110-EXIT. DTSCS32 00937 EXIT. DTSCS32 00938 SKIP3 DTSCS32 00939 P6120-FIRST. DTSCS32 00940 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS32 00941 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS32 00942 SET MSKL-QTR-88 TO TRUE. DTSCS32 00943 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS32 00944 IF L810-NO-REC-88 DTSCS32 00945 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS32 00946 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS32 00947 GO TO P6120-EXIT. DTSCS32 00948 DTSCS32 00949 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS32 00950 DTSCS32 00951 MOVE MSKL-KEY-AREA TO MQTR-KEY-AREA. DTSCS32 00952 DTSCS32 00953 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS32 00954 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS32 00955 MOVE L004-ABS-QTR TO WRK-FIRST-ABS-QTR. DTSCS32 00956 COMPUTE WRK-LAST-ABS-QTR DTSCS32 00957 = WRK-FIRST-ABS-QTR + (WRK-QTR-CNT - 1). DTSCS32 00958 P6120-EXIT. DTSCS32 00959 EXIT. DTSCS32 00960 SKIP3 DTSCS32 00961 P6130-PRIOR. DTSCS32 00962 IF SCR-HOLD-FIRST-ABS-QTR > +0 DTSCS32 00963 NEXT SENTENCE DTSCS32 00964 ELSE DTSCS32 00965 PERFORM P6110-LAST THRU P6110-EXIT DTSCS32 00966 GO TO P6130-EXIT. DTSCS32 00967 DTSCS32 00968 COMPUTE WRK-LAST-ABS-QTR = SCR-HOLD-FIRST-ABS-QTR - 1. DTSCS32 00969 COMPUTE WRK-FIRST-ABS-QTR DTSCS32 00970 = WRK-LAST-ABS-QTR - (WRK-QTR-CNT - 1). DTSCS32 00971 P6130-EXIT. DTSCS32 00972 EXIT. DTSCS32 00973 SKIP3 DTSCS32 00974 P6140-NEXT. DTSCS32 00975 IF SCR-HOLD-LAST-ABS-QTR > +0 DTSCS32 00976 NEXT SENTENCE DTSCS32 00977 ELSE DTSCS32 00978 PERFORM P6110-LAST THRU P6110-EXIT DTSCS32 00979 GO TO P6140-EXIT. DTSCS32 00980 DTSCS32 00981 COMPUTE WRK-FIRST-ABS-QTR = SCR-HOLD-LAST-ABS-QTR + 1. DTSCS32 00982 COMPUTE WRK-LAST-ABS-QTR DTSCS32 00983 = WRK-FIRST-ABS-QTR + (WRK-QTR-CNT - 1). DTSCS32 00984 P6140-EXIT. DTSCS32 00985 EXIT. DTSCS32 00986 SKIP3 DTSCS32 00987 P6150-WRK-YRQ. DTSCS32 00988 MOVE WRK-YRQ TO L004-QTR-5-9. DTSCS32 00989 PERFORM S004-FROM-5 THRU S004-EXIT. DTSCS32 00990 DTSCS32 00991 IF LCCM-COMBINE-YES-88 DTSCS32 00992 MOVE L004-ABS-QTR TO WRK-FIRST-ABS-QTR DTSCS32 00993 COMPUTE WRK-LAST-ABS-QTR DTSCS32 00994 = WRK-FIRST-ABS-QTR + (WRK-QTR-CNT - 1) DTSCS32 00995 ELSE DTSCS32 00996 MOVE L004-ABS-QTR TO WRK-LAST-ABS-QTR DTSCS32 00997 COMPUTE WRK-FIRST-ABS-QTR DTSCS32 00998 = WRK-LAST-ABS-QTR - (WRK-QTR-CNT - 1). DTSCS32 00999 P6150-EXIT. DTSCS32 01000 EXIT. DTSCS32 01001 /*****************************************************************DTSCS32 01002 * *DTSCS32 01003 ******************************************************************DTSCS32 01004 SKIP1 DTSCS32 01005 P6900-CONSTRUCT-SCREEN. DTSCS32 01006 DTSCS32 01007 PERFORM S109-SUR-TAX-QTR THRU S109-EXIT DTSCS32 01008 DTSCS32 01009 PERFORM P6910-INITIALIZE-TOTALS THRU P6910-EXIT DTSCS32 01010 VARYING WRK-COL FROM 1 BY 1 DTSCS32 01011 UNTIL WRK-COL > 2 DTSCS32 01012 DTSCS32 01013 MOVE +0 TO COL-SUB. DTSCS32 01014 DTSCS32 01015 IF WRK-LAST-ABS-QTR - WRK-FIRST-ABS-QTR = 3 OR 4 DTSCS32 01016 NEXT SENTENCE DTSCS32 01017 ELSE DTSCS32 01018 GO TO S899-ABEND. DTSCS32 01019 DTSCS32 01020 IF LCCM-COMBINE-YES-88 DTSCS32 01021 PERFORM P6920-MQTR-TO-MAP THRU P6920-EXIT DTSCS32 01022 VARYING WRK-ABS-QTR FROM WRK-FIRST-ABS-QTR BY 1 DTSCS32 01023 UNTIL WRK-ABS-QTR > WRK-LAST-ABS-QTR DTSCS32 01024 PERFORM P6990-TOTALS-TO-MAP THRU P6990-EXIT DTSCS32 01025 ELSE DTSCS32 01026 PERFORM P6920-MQTR-TO-MAP THRU P6920-EXIT DTSCS32 01027 VARYING WRK-ABS-QTR FROM WRK-LAST-ABS-QTR BY -1 DTSCS32 01028 UNTIL WRK-ABS-QTR < WRK-FIRST-ABS-QTR. DTSCS32 01029 P6900-EXIT. DTSCS32 01030 EXIT. DTSCS32 01031 SKIP3 DTSCS32 01032 ***** DTSCS32 01033 * DTSCS32 01034 * CODE TO INITIALIZE WORKING STORAGE TOTAL COLUMN DTSCS32 01035 * ACCUMULATORS. DTSCS32 01036 * DTSCS32 01037 ***** DTSCS32 01038 P6910-INITIALIZE-TOTALS. DTSCS32 01039 DTSCS32 01040 PERFORM VARYING WRK-ROW FROM 1 BY 1 DTSCS32 01041 UNTIL WRK-ROW > 18 DTSCS32 01042 MOVE +0 TO WRK-TOTAL (WRK-COL, WRK-ROW) DTSCS32 01043 END-PERFORM. DTSCS32 01044 DTSCS32 01045 P6910-EXIT. DTSCS32 01046 EXIT. DTSCS32 01047 DTSCS32 01048 ***** DTSCS32 01049 * DTSCS32 01050 ***** DTSCS32 01051 P6920-MQTR-TO-MAP. DTSCS32 01052 DTSCS32 01053 ADD +1 TO COL-SUB. DTSCS32 01054 DTSCS32 01055 MOVE LIT-COL TO WRK-COL. DTSCS32 01056 DTSCS32 01057 PERFORM P6910-INITIALIZE-TOTALS THRU P6910-EXIT. DTSCS32 01058 DTSCS32 01059 * :---------------------------------- DTSCS32 01060 * -------------------------: YRQ TO DISPLAY WAS CALCULATED DTSCS32 01061 * :---------------------------------- DTSCS32 01062 MOVE WRK-ABS-QTR TO L004-ABS-QTR. DTSCS32 01063 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSCS32 01064 MOVE L004-SLASH-QTR TO MAP-YYQ (COL-SUB). DTSCS32 01065 DTSCS32 01066 IF L004-QTR-5-9 = LCCM-PICKUP-YRQ DTSCS32 01067 MOVE SPACES TO MAP-YYQ (COL-SUB). DTSCS32 01068 DTSCS32 01069 DTSCS32 01070 * :---------------------------------- DTSCS32 01071 * -------------------------: BUILD MQTR KEY AREA AND READ DTSCS32 01072 * :---------------------------------- DTSCS32 01073 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS32 01074 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS32 01075 SET MQTR-QTR-88 TO TRUE. DTSCS32 01076 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSCS32 01077 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS32 01078 PERFORM S810-READ THRU S810-EXIT. DTSCS32 01079 IF L810-NO-REC-88 DTSCS32 01080 MOVE 'NOREC' TO MAP-UI-RATE (COL-SUB) DTSCS32 01081 GO TO P6920-EXIT DTSCS32 01082 ELSE DTSCS32 01083 MOVE MSKL-REC TO MQTR-REC DTSCS32 01084 END-IF. DTSCS32 01085 DTSCS32 01086 ADD MQTR-TOT-WAGE TO WRK-TOTAL (LIT-TOT, LIT-TOT-WG). DTSCS32 01087 ADD MQTR-EXCESS-WAGE TO WRK-TOTAL (LIT-TOT, LIT-EXC-WG). DTSCS32 01088 ADD MQTR-TAX-WAGE TO WRK-TOTAL (LIT-TOT, LIT-TAX-WG). DTSCS32 01089 DTSCS32 01090 PERFORM P6921-PROJECT-PEN-AND-INT THRU P6921-EXIT. DTSCS32 01091 DTSCS32 01092 PERFORM P6950-SCAN-MRPT-FOR-DOC THRU P6950-EXIT. DTSCS32 01093 DTSCS32 01094 IF COL-SUB = +5 DTSCS32 01095 PERFORM P6980-COLUMN-5 THRU P6980-EXIT DTSCS32 01096 ELSE DTSCS32 01097 PERFORM P6970-COLUMNS-1-4 THRU P6970-EXIT. DTSCS32 01098 P6920-EXIT. DTSCS32 01099 EXIT. DTSCS32 01100 ***** DTSCS32 01101 * DTSCS32 01102 ***** DTSCS32 01103 P6921-PROJECT-PEN-AND-INT. DTSCS32 01104 MOVE +0 TO L101-PAID-CHNG. DTSCS32 01105 * L101-PEN-CHARGED-AMT. DTSCS32 01106 DTSCS32 01107 ********************************************************** DTSCS32 01108 * ONLY UI TAX BALANCE INCLUDED IN INTEREST CALCULATION DTSCS32 01109 ********************************************************** DTSCS32 01110 PERFORM DTSCS32 01111 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS32 01112 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS32 01113 DTSCS32 01114 PERFORM P6924-ACCUM THRU P6924-EXIT DTSCS32 01115 DTSCS32 01116 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS32 01117 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01118 TO L101-PAID-CHNG DTSCS32 01119 END-IF DTSCS32 01120 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) AND DTSCS32 01121 MQTR-YRQ >= L109-FIRST-PEN-INT-YRQ DTSCS32 01122 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01123 TO L101-PAID-CHNG DTSCS32 01124 END-IF DTSCS32 01125 * ELSE DTSCS32 01126 DTSCS32 01127 * IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSCS32 01128 * ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS32 01129 * TO L101-PEN-CHARGED-AMT DTSCS32 01130 * END-IF DTSCS32 01131 DTSCS32 01132 DTSCS32 01133 END-PERFORM. DTSCS32 01134 DTSCS32 01135 IF L101-PAID-CHNG > +0 DTSCS32 01136 NEXT SENTENCE DTSCS32 01137 ELSE DTSCS32 01138 GO TO P6921-EXIT. DTSCS32 01139 DTSCS32 01140 IF LCCM-COMP-DATE = ALL-NINES-DATE DTSCS32 01141 GO TO P6921-EXIT. DTSCS32 01142 DTSCS32 01143 MOVE LCCM-COMP-DATE TO L101-RECEIVED-DATE. DTSCS32 01144 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSCS32 01145 * SET L101-ABATE-PEN-NO-88 TO TRUE. DTSCS32 01146 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSCS32 01147 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSCS32 01148 DTSCS32 01149 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSCS32 01150 DTSCS32 01151 ADD L101-INT-CHARGE-CHNG DTSCS32 01152 TO WRK-TOTAL (LIT-COL, LIT-INT-CHG) DTSCS32 01153 WRK-TOTAL (LIT-TOT, LIT-INT-CHG) DTSCS32 01154 WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01155 WRK-TOTAL (LIT-TOT, LIT-INT-DUE). DTSCS32 01156 DTSCS32 01157 * ADD L101-PEN-CHARGE-CHNG DTSCS32 01158 * TO WRK-TOTAL (LIT-COL, LIT-P-J-CHG) DTSCS32 01159 * WRK-TOTAL (LIT-TOT, LIT-P-J-CHG) DTSCS32 01160 * WRK-TOTAL (LIT-COL, LIT-P-J-DUE) DTSCS32 01161 * WRK-TOTAL (LIT-TOT, LIT-P-J-DUE). DTSCS32 01162 DTSCS32 01163 SUBTRACT L101-INT-WAIVE-CHNG DTSCS32 01164 FROM WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01165 WRK-TOTAL (LIT-TOT, LIT-INT-DUE). DTSCS32 01166 DTSCS32 01167 * SUBTRACT L101-PEN-ABATE-CHNG DTSCS32 01168 * FROM WRK-TOTAL (LIT-COL, LIT-P-J-DUE) DTSCS32 01169 * WRK-TOTAL (LIT-TOT, LIT-P-J-DUE). DTSCS32 01170 P6921-EXIT. DTSCS32 01171 EXIT. DTSCS32 01172 DTSCS32 01173 P6924-ACCUM. DTSCS32 01174 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCS32 01175 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS32 01176 TO WRK-TOTAL (LIT-COL, LIT-UI-CHG) DTSCS32 01177 WRK-TOTAL (LIT-TOT, LIT-UI-CHG) DTSCS32 01178 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS32 01179 TO WRK-TOTAL (LIT-COL, LIT-UI-PD) DTSCS32 01180 WRK-TOTAL (LIT-TOT, LIT-UI-PD) DTSCS32 01181 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01182 TO WRK-TOTAL (LIT-COL, LIT-UI-DUE) DTSCS32 01183 WRK-TOTAL (LIT-TOT, LIT-UI-DUE) DTSCS32 01184 ELSE DTSCS32 01185 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSCS32 01186 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS32 01187 TO WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) DTSCS32 01188 WRK-TOTAL (LIT-TOT, LIT-LATE-PEN-CHG) DTSCS32 01189 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS32 01190 TO WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) DTSCS32 01191 WRK-TOTAL (LIT-TOT, LIT-LATE-PEN-PD) DTSCS32 01192 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01193 TO WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) DTSCS32 01194 WRK-TOTAL (LIT-TOT, LIT-LATE-PEN-DUE) DTSCS32 01195 ELSE DTSCS32 01196 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSCS32 01197 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS32 01198 TO WRK-TOTAL (LIT-COL, LIT-SUR-CHG) DTSCS32 01199 WRK-TOTAL (LIT-TOT, LIT-SUR-CHG) DTSCS32 01200 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS32 01201 TO WRK-TOTAL (LIT-COL, LIT-SUR-PD) DTSCS32 01202 WRK-TOTAL (LIT-TOT, LIT-SUR-PD) DTSCS32 01203 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01204 TO WRK-TOTAL (LIT-COL, LIT-SUR-DUE) DTSCS32 01205 WRK-TOTAL (LIT-TOT, LIT-SUR-DUE) DTSCS32 01206 ELSE DTSCS32 01207 IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSCS32 01208 OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSCS32 01209 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS32 01210 TO WRK-TOTAL (LIT-COL, LIT-N-M-CHG) DTSCS32 01211 WRK-TOTAL (LIT-TOT, LIT-N-M-CHG) DTSCS32 01212 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS32 01213 TO WRK-TOTAL (LIT-COL, LIT-N-M-PD) DTSCS32 01214 WRK-TOTAL (LIT-TOT, LIT-N-M-PD) DTSCS32 01215 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01216 TO WRK-TOTAL (LIT-COL, LIT-N-M-DUE) DTSCS32 01217 WRK-TOTAL (LIT-TOT, LIT-N-M-DUE) DTSCS32 01218 ELSE DTSCS32 01219 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSCS32 01220 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS32 01221 TO WRK-TOTAL (LIT-COL, LIT-INT-CHG) DTSCS32 01222 WRK-TOTAL (LIT-TOT, LIT-INT-CHG) DTSCS32 01223 ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) DTSCS32 01224 TO WRK-TOTAL (LIT-COL, LIT-INT-PD) DTSCS32 01225 WRK-TOTAL (LIT-TOT, LIT-INT-PD) DTSCS32 01226 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSCS32 01227 TO WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01228 WRK-TOTAL (LIT-TOT, LIT-INT-DUE). DTSCS32 01229 P6924-EXIT. DTSCS32 01230 EXIT. DTSCS32 01231 DTSCS32 01232 P6950-SCAN-MRPT-FOR-DOC. DTSCS32 01233 MOVE +0 TO WRK-RECEIVED-DATE. DTSCS32 01234 DTSCS32 01235 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSCS32 01236 MOVE WRK-EMP-NO TO MRPT-EMP-NO. DTSCS32 01237 SET MRPT-RPT-88 TO TRUE. DTSCS32 01238 MOVE MQTR-YRQ TO MRPT-YRQ. DTSCS32 01239 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSCS32 01240 PERFORM S810-START-BROWSE THRU S810-EXIT DTSCS32 01241 DTSCS32 01242 PERFORM P6955-FIND-DOC THRU P6955-EXIT DTSCS32 01243 UNTIL L810-NO-REC-88. DTSCS32 01244 P6950-EXIT. DTSCS32 01245 EXIT. DTSCS32 01246 DTSCS32 01247 P6955-FIND-DOC. DTSCS32 01248 MOVE MSKL-REC TO MRPT-REC. DTSCS32 01249 DTSCS32 01250 IF MQTR-YRQ = MRPT-YRQ DTSCS32 01251 NEXT SENTENCE DTSCS32 01252 ELSE DTSCS32 01253 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS32 01254 SET L810-NO-REC-88 TO TRUE DTSCS32 01255 GO TO P6955-EXIT. DTSCS32 01256 DTSCS32 01257 IF MRPT-ORIG-88 DTSCS32 01258 IF MRPT-RECEIVED-DATE > WRK-RECEIVED-DATE DTSCS32 01259 MOVE MRPT-BATCH-NO TO MAP-BATCH-NO-Z (COL-SUB) DTSCS32 01260 MOVE MRPT-ITEM-NO TO MAP-ITEM-NO-Z (COL-SUB) DTSCS32 01261 MOVE MRPT-RECEIVED-DATE TO WRK-RECEIVED-DATE. DTSCS32 01262 DTSCS32 01263 PERFORM S810-READ-NEXT THRU S810-EXIT. DTSCS32 01264 P6955-EXIT. DTSCS32 01265 EXIT. DTSCS32 01266 EJECT DTSCS32 01267 P6970-COLUMNS-1-4. DTSCS32 01268 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS32 01269 MOVE ' PKUP' TO MAP-UI-RATE (COL-SUB) DTSCS32 01270 ELSE DTSCS32 01271 MOVE MQTR-UI-RATE TO L056-RATE DTSCS32 01272 PERFORM S056-DISP1-RIGHT THRU S056-EXIT DTSCS32 01273 MOVE L056-DISP-RATE TO MAP-UI-RATE (COL-SUB). DTSCS32 01274 DTSCS32 01275 IF MQTR-CURR-NOT-LIABLE-88 DTSCS32 01276 OR MQTR-CURR-NOT-DUE-88 DTSCS32 01277 OR MQTR-CURR-DELINQ-88 DTSCS32 01278 PERFORM P6971-DISPLAY-BLANK-IF-0 THRU P6971-EXIT DTSCS32 01279 ELSE DTSCS32 01280 PERFORM P6972-DISPLAY-0-IF-0 THRU P6972-EXIT. DTSCS32 01281 P6970-EXIT. DTSCS32 01282 EXIT. DTSCS32 01283 SKIP3 DTSCS32 01284 P6971-DISPLAY-BLANK-IF-0. DTSCS32 01285 IF MQTR-TOT-WAGE = 0 DTSCS32 01286 MOVE SPACE DTSCS32 01287 TO MAP-LINE-AMT-TABLE (LIT-TOT-WG, COL-SUB) DTSCS32 01288 ELSE DTSCS32 01289 MOVE MQTR-TOT-WAGE DTSCS32 01290 TO MAP-LINE-AMT-Z (LIT-TOT-WG, COL-SUB). DTSCS32 01291 DTSCS32 01292 IF MQTR-EXCESS-WAGE = 0 DTSCS32 01293 MOVE SPACE DTSCS32 01294 TO MAP-LINE-AMT-TABLE (LIT-EXC-WG, COL-SUB) DTSCS32 01295 ELSE DTSCS32 01296 MOVE MQTR-EXCESS-WAGE DTSCS32 01297 TO MAP-LINE-AMT-Z (LIT-EXC-WG, COL-SUB). DTSCS32 01298 DTSCS32 01299 IF MQTR-TAX-WAGE = 0 DTSCS32 01300 MOVE SPACE DTSCS32 01301 TO MAP-LINE-AMT-TABLE (LIT-TAX-WG, COL-SUB) DTSCS32 01302 ELSE DTSCS32 01303 MOVE MQTR-TAX-WAGE DTSCS32 01304 TO MAP-LINE-AMT-Z (LIT-TAX-WG, COL-SUB). DTSCS32 01305 SKIP3 DTSCS32 01306 IF WRK-TOTAL (LIT-COL, LIT-UI-CHG) = 0 DTSCS32 01307 MOVE SPACE DTSCS32 01308 TO MAP-LINE-AMT-TABLE (LIT-UI-CHG, COL-SUB) DTSCS32 01309 ELSE DTSCS32 01310 MOVE WRK-TOTAL (LIT-COL, LIT-UI-CHG) DTSCS32 01311 TO MAP-LINE-AMT-Z (LIT-UI-CHG, COL-SUB). DTSCS32 01312 DTSCS32 01313 IF WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) = 0 DTSCS32 01314 MOVE SPACE DTSCS32 01315 TO MAP-LINE-AMT-TABLE (LIT-LATE-PEN-CHG, COL-SUB) DTSCS32 01316 ELSE DTSCS32 01317 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) DTSCS32 01318 TO MAP-LINE-AMT-Z (LIT-LATE-PEN-CHG, COL-SUB). DTSCS32 01319 DTSCS32 01320 IF WRK-TOTAL (LIT-COL, LIT-SUR-CHG) = 0 DTSCS32 01321 MOVE SPACE DTSCS32 01322 TO MAP-LINE-AMT-TABLE (LIT-SUR-CHG, COL-SUB) DTSCS32 01323 ELSE DTSCS32 01324 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-CHG) DTSCS32 01325 TO MAP-LINE-AMT-Z (LIT-SUR-CHG, COL-SUB). DTSCS32 01326 DTSCS32 01327 IF WRK-TOTAL (LIT-COL, LIT-INT-CHG) = 0 DTSCS32 01328 MOVE SPACE DTSCS32 01329 TO MAP-LINE-AMT-TABLE (LIT-INT-CHG, COL-SUB) DTSCS32 01330 ELSE DTSCS32 01331 MOVE WRK-TOTAL (LIT-COL, LIT-INT-CHG) DTSCS32 01332 TO MAP-LINE-AMT-Z (LIT-INT-CHG, COL-SUB). DTSCS32 01333 DTSCS32 01334 IF WRK-TOTAL (LIT-COL, LIT-N-M-CHG) = 0 DTSCS32 01335 MOVE SPACE DTSCS32 01336 TO MAP-LINE-AMT-TABLE (LIT-N-M-CHG, COL-SUB) DTSCS32 01337 ELSE DTSCS32 01338 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-CHG) DTSCS32 01339 TO MAP-LINE-AMT-Z (LIT-N-M-CHG, COL-SUB). DTSCS32 01340 SKIP3 DTSCS32 01341 IF WRK-TOTAL (LIT-COL, LIT-UI-PD) = 0 DTSCS32 01342 MOVE SPACE DTSCS32 01343 TO MAP-LINE-AMT-TABLE (LIT-UI-PD, COL-SUB) DTSCS32 01344 ELSE DTSCS32 01345 MOVE WRK-TOTAL (LIT-COL, LIT-UI-PD) DTSCS32 01346 TO MAP-LINE-AMT-Z (LIT-UI-PD, COL-SUB). DTSCS32 01347 DTSCS32 01348 IF WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) = 0 DTSCS32 01349 MOVE SPACE DTSCS32 01350 TO MAP-LINE-AMT-TABLE (LIT-LATE-PEN-PD, COL-SUB) DTSCS32 01351 ELSE DTSCS32 01352 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) DTSCS32 01353 TO MAP-LINE-AMT-Z (LIT-LATE-PEN-PD, COL-SUB). DTSCS32 01354 DTSCS32 01355 IF WRK-TOTAL (LIT-COL, LIT-INT-PD) = 0 DTSCS32 01356 MOVE SPACE DTSCS32 01357 TO MAP-LINE-AMT-TABLE (LIT-INT-PD, COL-SUB) DTSCS32 01358 ELSE DTSCS32 01359 MOVE WRK-TOTAL (LIT-COL, LIT-INT-PD) DTSCS32 01360 TO MAP-LINE-AMT-Z (LIT-INT-PD, COL-SUB). DTSCS32 01361 DTSCS32 01362 IF WRK-TOTAL (LIT-COL, LIT-SUR-PD) = 0 DTSCS32 01363 MOVE SPACE DTSCS32 01364 TO MAP-LINE-AMT-TABLE (LIT-SUR-PD, COL-SUB) DTSCS32 01365 ELSE DTSCS32 01366 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-PD) DTSCS32 01367 TO MAP-LINE-AMT-Z (LIT-SUR-PD, COL-SUB). DTSCS32 01368 DTSCS32 01369 IF WRK-TOTAL (LIT-COL, LIT-N-M-PD) = 0 DTSCS32 01370 MOVE SPACE DTSCS32 01371 TO MAP-LINE-AMT-TABLE (LIT-N-M-PD, COL-SUB) DTSCS32 01372 ELSE DTSCS32 01373 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-PD) DTSCS32 01374 TO MAP-LINE-AMT-Z (LIT-N-M-PD, COL-SUB). DTSCS32 01375 SKIP3 DTSCS32 01376 IF WRK-TOTAL (LIT-COL, LIT-UI-DUE) = 0 DTSCS32 01377 MOVE SPACE DTSCS32 01378 TO MAP-LINE-AMT-TABLE (LIT-UI-DUE, COL-SUB) DTSCS32 01379 ELSE DTSCS32 01380 MOVE WRK-TOTAL (LIT-COL, LIT-UI-DUE) DTSCS32 01381 TO MAP-LINE-AMT-Z (LIT-UI-DUE, COL-SUB). DTSCS32 01382 DTSCS32 01383 IF WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) = 0 DTSCS32 01384 MOVE SPACE DTSCS32 01385 TO MAP-LINE-AMT-TABLE (LIT-LATE-PEN-DUE, COL-SUB) DTSCS32 01386 ELSE DTSCS32 01387 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) DTSCS32 01388 TO MAP-LINE-AMT-Z (LIT-LATE-PEN-DUE, COL-SUB). DTSCS32 01389 DTSCS32 01390 IF WRK-TOTAL (LIT-COL, LIT-INT-DUE) = 0 DTSCS32 01391 MOVE SPACE DTSCS32 01392 TO MAP-LINE-AMT-TABLE (LIT-INT-DUE, COL-SUB) DTSCS32 01393 ELSE DTSCS32 01394 MOVE WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01395 TO MAP-LINE-AMT-Z (LIT-INT-DUE, COL-SUB). DTSCS32 01396 DTSCS32 01397 IF WRK-TOTAL (LIT-COL, LIT-SUR-DUE) = 0 DTSCS32 01398 MOVE SPACE DTSCS32 01399 TO MAP-LINE-AMT-TABLE (LIT-SUR-DUE, COL-SUB) DTSCS32 01400 ELSE DTSCS32 01401 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-DUE) DTSCS32 01402 TO MAP-LINE-AMT-Z (LIT-SUR-DUE, COL-SUB). DTSCS32 01403 DTSCS32 01404 IF WRK-TOTAL (LIT-COL, LIT-N-M-DUE) = 0 DTSCS32 01405 MOVE SPACE DTSCS32 01406 TO MAP-LINE-AMT-TABLE (LIT-N-M-DUE, COL-SUB) DTSCS32 01407 ELSE DTSCS32 01408 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-DUE) DTSCS32 01409 TO MAP-LINE-AMT-Z (LIT-N-M-DUE, COL-SUB). DTSCS32 01410 P6971-EXIT. DTSCS32 01411 EXIT. DTSCS32 01412 DTSCS32 01413 DTSCS32 01414 P6972-DISPLAY-0-IF-0. DTSCS32 01415 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS32 01416 MOVE SPACES DTSCS32 01417 TO MAP-LINE-AMT-TABLE (LIT-TOT-WG, COL-SUB) DTSCS32 01418 MAP-LINE-AMT-TABLE (LIT-EXC-WG, COL-SUB) DTSCS32 01419 MAP-LINE-AMT-TABLE (LIT-TAX-WG, COL-SUB) DTSCS32 01420 ELSE DTSCS32 01421 MOVE MQTR-TOT-WAGE DTSCS32 01422 TO MAP-LINE-AMT-Z (LIT-TOT-WG, COL-SUB) DTSCS32 01423 MOVE MQTR-EXCESS-WAGE DTSCS32 01424 TO MAP-LINE-AMT-Z (LIT-EXC-WG, COL-SUB) DTSCS32 01425 MOVE MQTR-TAX-WAGE DTSCS32 01426 TO MAP-LINE-AMT-Z (LIT-TAX-WG, COL-SUB). DTSCS32 01427 SKIP3 DTSCS32 01428 MOVE WRK-TOTAL (LIT-COL, LIT-UI-CHG) DTSCS32 01429 TO MAP-LINE-AMT-Z (LIT-UI-CHG, COL-SUB). DTSCS32 01430 DTSCS32 01431 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) DTSCS32 01432 TO MAP-LINE-AMT-Z (LIT-LATE-PEN-CHG, COL-SUB). DTSCS32 01433 DTSCS32 01434 MOVE WRK-TOTAL (LIT-COL, LIT-INT-CHG) DTSCS32 01435 TO MAP-LINE-AMT-Z (LIT-INT-CHG, COL-SUB). DTSCS32 01436 DTSCS32 01437 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-CHG) DTSCS32 01438 TO MAP-LINE-AMT-Z (LIT-SUR-CHG, COL-SUB). DTSCS32 01439 DTSCS32 01440 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-CHG) DTSCS32 01441 TO MAP-LINE-AMT-Z (LIT-N-M-CHG, COL-SUB). DTSCS32 01442 SKIP3 DTSCS32 01443 MOVE WRK-TOTAL (LIT-COL, LIT-UI-PD) DTSCS32 01444 TO MAP-LINE-AMT-Z (LIT-UI-PD, COL-SUB). DTSCS32 01445 DTSCS32 01446 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) DTSCS32 01447 TO MAP-LINE-AMT-Z (LIT-LATE-PEN-PD, COL-SUB). DTSCS32 01448 DTSCS32 01449 MOVE WRK-TOTAL (LIT-COL, LIT-INT-PD) DTSCS32 01450 TO MAP-LINE-AMT-Z (LIT-INT-PD, COL-SUB). DTSCS32 01451 DTSCS32 01452 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-PD) DTSCS32 01453 TO MAP-LINE-AMT-Z (LIT-SUR-PD, COL-SUB). DTSCS32 01454 DTSCS32 01455 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-PD) DTSCS32 01456 TO MAP-LINE-AMT-Z (LIT-N-M-PD, COL-SUB). DTSCS32 01457 SKIP3 DTSCS32 01458 MOVE WRK-TOTAL (LIT-COL, LIT-UI-DUE) DTSCS32 01459 TO MAP-LINE-AMT-Z (LIT-UI-DUE, COL-SUB). DTSCS32 01460 DTSCS32 01461 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) DTSCS32 01462 TO MAP-LINE-AMT-Z (LIT-LATE-PEN-DUE, COL-SUB). DTSCS32 01463 DTSCS32 01464 MOVE WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01465 TO MAP-LINE-AMT-Z (LIT-INT-DUE, COL-SUB). DTSCS32 01466 DTSCS32 01467 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-DUE) DTSCS32 01468 TO MAP-LINE-AMT-Z (LIT-SUR-DUE, COL-SUB). DTSCS32 01469 DTSCS32 01470 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-DUE) DTSCS32 01471 TO MAP-LINE-AMT-Z (LIT-N-M-DUE, COL-SUB). DTSCS32 01472 P6972-EXIT. DTSCS32 01473 EXIT. DTSCS32 01474 * GOING TO USE THE TOTAL COLUMN FOR A SINGLE QUARTER DISPLAY DTSCS32 01475 * BUT SINCE THE FIELD LENGTH IS N0T THE SAME AS COLUMNS 1 THRU DTSCS32 01476 * 4 IT COULD NOT BE PART OF THE OCCURS. DTSCS32 01477 P6980-COLUMN-5. DTSCS32 01478 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS32 01479 MOVE ' PKUP' TO MAP-UI-RATE (COL-SUB) DTSCS32 01480 ELSE DTSCS32 01481 MOVE MQTR-UI-RATE TO L056-RATE DTSCS32 01482 PERFORM S056-DISP1-RIGHT THRU S056-EXIT DTSCS32 01483 MOVE L056-DISP-RATE TO MAP-UI-RATE (COL-SUB). DTSCS32 01484 DTSCS32 01485 IF MQTR-CURR-NOT-LIABLE-88 DTSCS32 01486 OR MQTR-CURR-NOT-DUE-88 DTSCS32 01487 OR MQTR-CURR-DELINQ-88 DTSCS32 01488 PERFORM P6981-DISPLAY-5-BLANK-IF-0 THRU P6981-EXIT DTSCS32 01489 ELSE DTSCS32 01490 PERFORM P6982-DISPLAY-5-0-IF-0 THRU P6982-EXIT. DTSCS32 01491 P6980-EXIT. DTSCS32 01492 EXIT. DTSCS32 01493 SKIP3 DTSCS32 01494 P6981-DISPLAY-5-BLANK-IF-0. DTSCS32 01495 IF MQTR-TOT-WAGE = 0 DTSCS32 01496 MOVE SPACE DTSCS32 01497 TO MAP-AMT-TTL (LIT-TOT-WG) DTSCS32 01498 ELSE DTSCS32 01499 MOVE MQTR-TOT-WAGE DTSCS32 01500 TO MAP-LINE-TOT-Z (LIT-TOT-WG). DTSCS32 01501 DTSCS32 01502 IF MQTR-EXCESS-WAGE = 0 DTSCS32 01503 MOVE SPACE DTSCS32 01504 TO MAP-AMT-TTL (LIT-EXC-WG) DTSCS32 01505 ELSE DTSCS32 01506 MOVE MQTR-EXCESS-WAGE DTSCS32 01507 TO MAP-LINE-TOT-Z (LIT-EXC-WG). DTSCS32 01508 DTSCS32 01509 IF MQTR-TAX-WAGE = 0 DTSCS32 01510 MOVE SPACE DTSCS32 01511 TO MAP-AMT-TTL (LIT-TAX-WG) DTSCS32 01512 ELSE DTSCS32 01513 MOVE MQTR-TAX-WAGE DTSCS32 01514 TO MAP-LINE-TOT-Z (LIT-TAX-WG). DTSCS32 01515 SKIP3 DTSCS32 01516 IF WRK-TOTAL(LIT-COL, LIT-UI-CHG) = 0 DTSCS32 01517 MOVE SPACE DTSCS32 01518 TO MAP-AMT-TTL (LIT-UI-CHG) DTSCS32 01519 ELSE DTSCS32 01520 MOVE WRK-TOTAL (LIT-COL, LIT-UI-CHG) DTSCS32 01521 TO MAP-LINE-TOT-Z (LIT-UI-CHG). DTSCS32 01522 DTSCS32 01523 IF WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) = 0 DTSCS32 01524 MOVE SPACE DTSCS32 01525 TO MAP-AMT-TTL (LIT-LATE-PEN-CHG) DTSCS32 01526 ELSE DTSCS32 01527 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) DTSCS32 01528 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-CHG). DTSCS32 01529 DTSCS32 01530 IF WRK-TOTAL (LIT-COL, LIT-INT-CHG) = 0 DTSCS32 01531 MOVE SPACE DTSCS32 01532 TO MAP-AMT-TTL (LIT-INT-CHG) DTSCS32 01533 ELSE DTSCS32 01534 MOVE WRK-TOTAL (LIT-COL, LIT-INT-CHG) DTSCS32 01535 TO MAP-LINE-TOT-Z (LIT-INT-CHG). DTSCS32 01536 DTSCS32 01537 IF WRK-TOTAL (LIT-COL, LIT-SUR-CHG) = 0 DTSCS32 01538 MOVE SPACE DTSCS32 01539 TO MAP-AMT-TTL (LIT-SUR-CHG) DTSCS32 01540 ELSE DTSCS32 01541 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-CHG) DTSCS32 01542 TO MAP-LINE-TOT-Z (LIT-SUR-CHG). DTSCS32 01543 DTSCS32 01544 IF WRK-TOTAL (LIT-COL, LIT-N-M-CHG) = 0 DTSCS32 01545 MOVE SPACE DTSCS32 01546 TO MAP-AMT-TTL (LIT-N-M-CHG) DTSCS32 01547 ELSE DTSCS32 01548 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-CHG) DTSCS32 01549 TO MAP-LINE-TOT-Z (LIT-N-M-CHG). DTSCS32 01550 SKIP3 DTSCS32 01551 IF WRK-TOTAL (LIT-COL, LIT-UI-PD) = 0 DTSCS32 01552 MOVE SPACE DTSCS32 01553 TO MAP-AMT-TTL (LIT-UI-PD) DTSCS32 01554 ELSE DTSCS32 01555 MOVE WRK-TOTAL (LIT-COL, LIT-UI-PD) DTSCS32 01556 TO MAP-LINE-TOT-Z (LIT-UI-PD). DTSCS32 01557 DTSCS32 01558 IF WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) = 0 DTSCS32 01559 MOVE SPACE DTSCS32 01560 TO MAP-AMT-TTL (LIT-LATE-PEN-PD) DTSCS32 01561 ELSE DTSCS32 01562 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) DTSCS32 01563 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-PD). DTSCS32 01564 DTSCS32 01565 IF WRK-TOTAL (LIT-COL, LIT-INT-PD) = 0 DTSCS32 01566 MOVE SPACE DTSCS32 01567 TO MAP-AMT-TTL (LIT-INT-PD) DTSCS32 01568 ELSE DTSCS32 01569 MOVE WRK-TOTAL (LIT-COL, LIT-INT-PD) DTSCS32 01570 TO MAP-LINE-TOT-Z (LIT-INT-PD). DTSCS32 01571 DTSCS32 01572 IF WRK-TOTAL (LIT-COL, LIT-SUR-PD) = 0 DTSCS32 01573 MOVE SPACE DTSCS32 01574 TO MAP-AMT-TTL (LIT-SUR-PD) DTSCS32 01575 ELSE DTSCS32 01576 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-PD) DTSCS32 01577 TO MAP-LINE-TOT-Z (LIT-SUR-PD). DTSCS32 01578 DTSCS32 01579 IF WRK-TOTAL (LIT-COL, LIT-N-M-PD) = 0 DTSCS32 01580 MOVE SPACE DTSCS32 01581 TO MAP-AMT-TTL (LIT-N-M-PD) DTSCS32 01582 ELSE DTSCS32 01583 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-PD) DTSCS32 01584 TO MAP-LINE-TOT-Z (LIT-N-M-PD). DTSCS32 01585 SKIP3 DTSCS32 01586 IF WRK-TOTAL (LIT-COL, LIT-UI-DUE) = 0 DTSCS32 01587 MOVE SPACE DTSCS32 01588 TO MAP-AMT-TTL (LIT-UI-DUE) DTSCS32 01589 ELSE DTSCS32 01590 MOVE WRK-TOTAL (LIT-COL, LIT-UI-DUE) DTSCS32 01591 TO MAP-LINE-TOT-Z (LIT-UI-DUE). DTSCS32 01592 DTSCS32 01593 IF WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) = 0 DTSCS32 01594 MOVE SPACE DTSCS32 01595 TO MAP-AMT-TTL (LIT-LATE-PEN-DUE) DTSCS32 01596 ELSE DTSCS32 01597 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) DTSCS32 01598 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-DUE). DTSCS32 01599 DTSCS32 01600 IF WRK-TOTAL (LIT-COL, LIT-INT-DUE) = 0 DTSCS32 01601 MOVE SPACE DTSCS32 01602 TO MAP-AMT-TTL (LIT-INT-DUE) DTSCS32 01603 ELSE DTSCS32 01604 MOVE WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01605 TO MAP-LINE-TOT-Z (LIT-INT-DUE). DTSCS32 01606 DTSCS32 01607 IF WRK-TOTAL (LIT-COL, LIT-SUR-DUE) = 0 DTSCS32 01608 MOVE SPACE DTSCS32 01609 TO MAP-AMT-TTL (LIT-SUR-DUE) DTSCS32 01610 ELSE DTSCS32 01611 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-DUE) DTSCS32 01612 TO MAP-LINE-TOT-Z (LIT-SUR-DUE). DTSCS32 01613 DTSCS32 01614 IF WRK-TOTAL (LIT-COL, LIT-N-M-DUE) = 0 DTSCS32 01615 MOVE SPACE DTSCS32 01616 TO MAP-AMT-TTL (LIT-N-M-DUE) DTSCS32 01617 ELSE DTSCS32 01618 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-DUE) DTSCS32 01619 TO MAP-LINE-TOT-Z (LIT-N-M-DUE). DTSCS32 01620 P6981-EXIT. DTSCS32 01621 EXIT. DTSCS32 01622 SKIP3 DTSCS32 01623 P6982-DISPLAY-5-0-IF-0. DTSCS32 01624 IF MQTR-YRQ = LCCM-PICKUP-YRQ DTSCS32 01625 MOVE SPACES TO MAP-AMT-TTL (LIT-TOT-WG) DTSCS32 01626 MAP-AMT-TTL (LIT-EXC-WG) DTSCS32 01627 MAP-AMT-TTL (LIT-TAX-WG) DTSCS32 01628 ELSE DTSCS32 01629 MOVE MQTR-TOT-WAGE DTSCS32 01630 TO MAP-LINE-TOT-Z (LIT-TOT-WG) DTSCS32 01631 MOVE MQTR-EXCESS-WAGE DTSCS32 01632 TO MAP-LINE-TOT-Z (LIT-EXC-WG) DTSCS32 01633 MOVE MQTR-TAX-WAGE DTSCS32 01634 TO MAP-LINE-TOT-Z (LIT-TAX-WG). DTSCS32 01635 SKIP3 DTSCS32 01636 MOVE WRK-TOTAL (LIT-COL, LIT-UI-CHG) DTSCS32 01637 TO MAP-LINE-TOT-Z (LIT-UI-CHG). DTSCS32 01638 DTSCS32 01639 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-CHG) DTSCS32 01640 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-CHG). DTSCS32 01641 DTSCS32 01642 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-CHG) DTSCS32 01643 TO MAP-LINE-TOT-Z (LIT-SUR-CHG). DTSCS32 01644 DTSCS32 01645 MOVE WRK-TOTAL (LIT-COL, LIT-INT-CHG) DTSCS32 01646 TO MAP-LINE-TOT-Z (LIT-INT-CHG). DTSCS32 01647 DTSCS32 01648 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-CHG) DTSCS32 01649 TO MAP-LINE-TOT-Z (LIT-N-M-CHG). DTSCS32 01650 SKIP3 DTSCS32 01651 MOVE WRK-TOTAL (LIT-COL, LIT-UI-PD) DTSCS32 01652 TO MAP-LINE-TOT-Z (LIT-UI-PD). DTSCS32 01653 DTSCS32 01654 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-PD) DTSCS32 01655 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-PD). DTSCS32 01656 DTSCS32 01657 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-PD) DTSCS32 01658 TO MAP-LINE-TOT-Z (LIT-SUR-PD). DTSCS32 01659 DTSCS32 01660 MOVE WRK-TOTAL (LIT-COL, LIT-INT-PD) DTSCS32 01661 TO MAP-LINE-TOT-Z (LIT-INT-PD). DTSCS32 01662 DTSCS32 01663 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-PD) DTSCS32 01664 TO MAP-LINE-TOT-Z (LIT-N-M-PD). DTSCS32 01665 SKIP3 DTSCS32 01666 MOVE WRK-TOTAL (LIT-COL, LIT-UI-DUE) DTSCS32 01667 TO MAP-LINE-TOT-Z (LIT-UI-DUE). DTSCS32 01668 DTSCS32 01669 MOVE WRK-TOTAL (LIT-COL, LIT-LATE-PEN-DUE) DTSCS32 01670 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-DUE). DTSCS32 01671 DTSCS32 01672 MOVE WRK-TOTAL (LIT-COL, LIT-SUR-DUE) DTSCS32 01673 TO MAP-LINE-TOT-Z (LIT-SUR-DUE). DTSCS32 01674 DTSCS32 01675 MOVE WRK-TOTAL (LIT-COL, LIT-INT-DUE) DTSCS32 01676 TO MAP-LINE-TOT-Z (LIT-INT-DUE). DTSCS32 01677 DTSCS32 01678 MOVE WRK-TOTAL (LIT-COL, LIT-N-M-DUE) DTSCS32 01679 TO MAP-LINE-TOT-Z (LIT-N-M-DUE). DTSCS32 01680 P6982-EXIT. DTSCS32 01681 EXIT. DTSCS32 01682 EJECT DTSCS32 01683 P6990-TOTALS-TO-MAP. DTSCS32 01684 MOVE 'TOTAL' TO MAP-UI-RATE (5) DTSCS32 01685 MOVE WRK-TOTAL (LIT-TOT, LIT-TOT-WG) DTSCS32 01686 TO MAP-LINE-TOT-Z (LIT-TOT-WG). DTSCS32 01687 DTSCS32 01688 MOVE WRK-TOTAL (LIT-TOT, LIT-EXC-WG) DTSCS32 01689 TO MAP-LINE-TOT-Z (LIT-EXC-WG). DTSCS32 01690 DTSCS32 01691 MOVE WRK-TOTAL (LIT-TOT, LIT-TAX-WG) DTSCS32 01692 TO MAP-LINE-TOT-Z (LIT-TAX-WG). DTSCS32 01693 DTSCS32 01694 MOVE WRK-TOTAL (LIT-TOT, LIT-UI-CHG) DTSCS32 01695 TO MAP-LINE-TOT-Z (LIT-UI-CHG). DTSCS32 01696 DTSCS32 01697 MOVE WRK-TOTAL (LIT-TOT, LIT-LATE-PEN-CHG) DTSCS32 01698 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-CHG). DTSCS32 01699 DTSCS32 01700 MOVE WRK-TOTAL (LIT-TOT, LIT-SUR-CHG) DTSCS32 01701 TO MAP-LINE-TOT-Z (LIT-SUR-CHG). DTSCS32 01702 DTSCS32 01703 MOVE WRK-TOTAL (LIT-TOT, LIT-INT-CHG) DTSCS32 01704 TO MAP-LINE-TOT-Z (LIT-INT-CHG). DTSCS32 01705 DTSCS32 01706 MOVE WRK-TOTAL (LIT-TOT, LIT-N-M-CHG) DTSCS32 01707 TO MAP-LINE-TOT-Z (LIT-N-M-CHG). DTSCS32 01708 DTSCS32 01709 DTSCS32 01710 MOVE WRK-TOTAL (LIT-TOT, LIT-UI-PD) DTSCS32 01711 TO MAP-LINE-TOT-Z (LIT-UI-PD). DTSCS32 01712 DTSCS32 01713 MOVE WRK-TOTAL (LIT-TOT, LIT-LATE-PEN-PD) DTSCS32 01714 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-PD). DTSCS32 01715 DTSCS32 01716 MOVE WRK-TOTAL (LIT-TOT, LIT-SUR-PD) DTSCS32 01717 TO MAP-LINE-TOT-Z (LIT-SUR-PD). DTSCS32 01718 DTSCS32 01719 MOVE WRK-TOTAL (LIT-TOT, LIT-INT-PD) DTSCS32 01720 TO MAP-LINE-TOT-Z (LIT-INT-PD). DTSCS32 01721 DTSCS32 01722 MOVE WRK-TOTAL (LIT-TOT, LIT-N-M-PD) DTSCS32 01723 TO MAP-LINE-TOT-Z (LIT-N-M-PD). DTSCS32 01724 DTSCS32 01725 DTSCS32 01726 MOVE WRK-TOTAL (LIT-TOT, LIT-UI-DUE) DTSCS32 01727 TO MAP-LINE-TOT-Z (LIT-UI-DUE). DTSCS32 01728 DTSCS32 01729 MOVE WRK-TOTAL (LIT-TOT, LIT-LATE-PEN-DUE) DTSCS32 01730 TO MAP-LINE-TOT-Z (LIT-LATE-PEN-DUE). DTSCS32 01731 DTSCS32 01732 MOVE WRK-TOTAL (LIT-TOT, LIT-SUR-DUE) DTSCS32 01733 TO MAP-LINE-TOT-Z (LIT-SUR-DUE). DTSCS32 01734 DTSCS32 01735 MOVE WRK-TOTAL (LIT-TOT, LIT-INT-DUE) DTSCS32 01736 TO MAP-LINE-TOT-Z (LIT-INT-DUE). DTSCS32 01737 DTSCS32 01738 MOVE WRK-TOTAL (LIT-TOT, LIT-N-M-DUE) DTSCS32 01739 TO MAP-LINE-TOT-Z (LIT-N-M-DUE). DTSCS32 01740 DTSCS32 01741 P6990-EXIT. DTSCS32 01742 EXIT. DTSCS32 01743 /*****************************************************************DTSCS32 01744 * LINKS TO UTILITY MODULES DTSCS32 01745 ******************************************************************DTSCS32 01746 DTSCS32 01747 *S001-FROM-FED-8. DTSCS32 01748 *****SET L001-FROM-FED-8 TO TRUE. DTSCS32 01749 *****GO TO S001-DATE. DTSCS32 01750 DTSCS32 01751 *S001-FROM-ABS-DATE. DTSCS32 01752 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS32 01753 *****GO TO S001-DATE. DTSCS32 01754 DTSCS32 01755 *S001-DATE. DTSCS32 01756 *****EXEC CICS LINK DTSCS32 01757 ***** PROGRAM('DTSCU001') DTSCS32 01758 ***** COMMAREA(L001-COMM-AREA) DTSCS32 01759 ***** LENGTH(L001-LENGTH) DTSCS32 01760 *****END-EXEC. DTSCS32 01761 *S001-EXIT. DTSCS32 01762 *****EXIT. DTSCS32 01763 SKIP3 DTSCS32 01764 S004-FROM-5. DTSCS32 01765 SET L004-FROM-5 TO TRUE. DTSCS32 01766 GO TO S004-QTR. DTSCS32 01767 SKIP1 DTSCS32 01768 S004-FROM-ABS. DTSCS32 01769 SET L004-FROM-ABS TO TRUE. DTSCS32 01770 GO TO S004-QTR. DTSCS32 01771 SKIP1 DTSCS32 01772 S004-QTR. DTSCS32 01773 EXEC CICS LINK DTSCS32 01774 PROGRAM('DTSCU004') DTSCS32 01775 COMMAREA(L004-COMM-AREA) DTSCS32 01776 END-EXEC. DTSCS32 01777 S004-EXIT. DTSCS32 01778 EXIT. DTSCS32 01779 SKIP3 DTSCS32 01780 S015-DATE-FROM-SCREEN. DTSCS32 01781 EXEC CICS LINK DTSCS32 01782 PROGRAM('DTSCU015') DTSCS32 01783 COMMAREA(L015-COMM-AREA) DTSCS32 01784 END-EXEC. DTSCS32 01785 S015-EXIT. DTSCS32 01786 EXIT. DTSCS32 01787 SKIP3 DTSCS32 01788 S016-YRQ-FROM-SCREEN. DTSCS32 01789 EXEC CICS LINK DTSCS32 01790 PROGRAM('DTSCU016') DTSCS32 01791 COMMAREA(L016-COMM-AREA) DTSCS32 01792 END-EXEC. DTSCS32 01793 S016-EXIT. DTSCS32 01794 EXIT. DTSCS32 01795 SKIP3 DTSCS32 01796 S018-EMP-NO-FROM-SCREEN. DTSCS32 01797 EXEC CICS LINK DTSCS32 01798 PROGRAM('DTSCU018') DTSCS32 01799 COMMAREA(L018-COMM-AREA) DTSCS32 01800 END-EXEC. DTSCS32 01801 S018-EXIT. DTSCS32 01802 EXIT. DTSCS32 01803 SKIP3 DTSCS32 01804 S029-YRQ-WITH-PU-FROM-SCREEN. DTSCS32 01805 EXEC CICS LINK DTSCS32 01806 PROGRAM('DTSCU029') DTSCS32 01807 COMMAREA(L029-COMM-AREA) DTSCS32 01808 END-EXEC. DTSCS32 01809 S029-EXIT. DTSCS32 01810 EXIT. DTSCS32 01811 SKIP3 DTSCS32 01812 S056-DISP1-RIGHT. DTSCS32 01813 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCS32 01814 GO TO S056-RATE-DISPLAY. DTSCS32 01815 DTSCS32 01816 S056-RATE-DISPLAY. DTSCS32 01817 EXEC CICS LINK DTSCS32 01818 PROGRAM('DTSCU056') DTSCS32 01819 COMMAREA(L056-COMM-AREA) DTSCS32 01820 END-EXEC. DTSCS32 01821 S056-EXIT. DTSCS32 01822 EXIT. DTSCS32 01823 SKIP3 DTSCS32 01824 S101-PER-MONTH-NO. DTSCS32 01825 SET L101-PER-MONTH-NO-88 TO TRUE. DTSCS32 01826 GO TO S101-INT-PEN-CALC. DTSCS32 01827 DTSCS32 01828 S101-INT-PEN-CALC. DTSCS32 01829 EXEC CICS LINK DTSCS32 01830 PROGRAM('DTSCU101') DTSCS32 01831 COMMAREA(L101-COMM-AREA) DTSCS32 01832 END-EXEC. DTSCS32 01833 S101-EXIT. DTSCS32 01834 EXIT. DTSCS32 01835 SKIP3 DTSCS32 01836 S109-SUR-TAX-QTR. DTSCS32 01837 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSCS32 01838 DTSCS32 01839 EXEC CICS LINK DTSCS32 01840 PROGRAM ('DTSCU109') DTSCS32 01841 COMMAREA (L109-COMM-AREA) DTSCS32 01842 END-EXEC. DTSCS32 01843 S109-EXIT. DTSCS32 01844 EXIT. DTSCS32 01845 S803-REQ-SCR-ID-EDIT. DTSCS32 01846 EXEC CICS LINK DTSCS32 01847 PROGRAM ('DTSCU803') DTSCS32 01848 COMMAREA (DFHCOMMAREA) DTSCS32 01849 END-EXEC. DTSCS32 01850 S803-EXIT. DTSCS32 01851 EXIT. DTSCS32 01852 SKIP3 DTSCS32 01853 S804-INVALID-KEY. DTSCS32 01854 EXEC CICS LINK DTSCS32 01855 PROGRAM ('DTSCU804') DTSCS32 01856 COMMAREA (DFHCOMMAREA) DTSCS32 01857 END-EXEC. DTSCS32 01858 S804-EXIT. DTSCS32 01859 EXIT. DTSCS32 01860 SKIP3 DTSCS32 01861 S805-MSG-AREA. DTSCS32 01862 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS32 01863 SKIP1 DTSCS32 01864 EXEC CICS LINK DTSCS32 01865 PROGRAM ('DTSCU805') DTSCS32 01866 COMMAREA (L805-COMM-AREA) DTSCS32 01867 END-EXEC. DTSCS32 01868 SKIP1 DTSCS32 01869 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS32 01870 S805-EXIT. DTSCS32 01871 EXIT. DTSCS32 01872 EJECT DTSCS32 01873 S810-READ. DTSCS32 01874 SET L810-READ-88 TO TRUE. DTSCS32 01875 GO TO S810-IO. DTSCS32 01876 DTSCS32 01877 S810-START-BROWSE. DTSCS32 01878 SET L810-START-BROWSE-88 TO TRUE. DTSCS32 01879 GO TO S810-IO. DTSCS32 01880 DTSCS32 01881 S810-READ-NEXT. DTSCS32 01882 SET L810-READ-NEXT-88 TO TRUE. DTSCS32 01883 GO TO S810-IO. DTSCS32 01884 DTSCS32 01885 *S810-READ-PREV. DTSCS32 01886 *****SET L810-READ-PREV-88 TO TRUE. DTSCS32 01887 *****GO TO S810-IO. DTSCS32 01888 DTSCS32 01889 S810-END-BROWSE. DTSCS32 01890 SET L810-END-BROWSE-88 TO TRUE. DTSCS32 01891 GO TO S810-IO. DTSCS32 01892 DTSCS32 01893 S810-COUNT. DTSCS32 01894 SET L810-COUNT-88 TO TRUE. DTSCS32 01895 GO TO S810-IO. DTSCS32 01896 DTSCS32 01897 *S810-REWRITE. DTSCS32 01898 *****SET L810-REWRITE-88 TO TRUE. DTSCS32 01899 *****GO TO S810-IO. DTSCS32 01900 DTSCS32 01901 *S810-WRITE. DTSCS32 01902 *****SET L810-WRITE-88 TO TRUE. DTSCS32 01903 *****GO TO S810-IO. DTSCS32 01904 DTSCS32 01905 *S810-DELETE. DTSCS32 01906 *****SET L810-DELETE-88 TO TRUE. DTSCS32 01907 *****GO TO S810-IO. DTSCS32 01908 DTSCS32 01909 S810-IO. DTSCS32 01910 SKIP1 DTSCS32 01911 EXEC CICS LINK DTSCS32 01912 PROGRAM ('DTSCU810') DTSCS32 01913 COMMAREA (L810-COMM-AREA) DTSCS32 01914 END-EXEC. DTSCS32 01915 DTSCS32 01916 IF L810-FILE-CLOSED-88 DTSCS32 01917 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS32 01918 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS32 01919 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS32 01920 GO TO MAINLINE-EXIT. DTSCS32 01921 S810-EXIT. DTSCS32 01922 EXIT. DTSCS32 01923 EJECT DTSCS32 01924 S851-SCREEN-PROCESSING. DTSCS32 01925 EXEC CICS LINK DTSCS32 01926 PROGRAM ('DTSCU851') DTSCS32 01927 COMMAREA (L851-COMM-AREA) DTSCS32 01928 END-EXEC. DTSCS32 01929 S851-EXIT. DTSCS32 01930 EXIT. DTSCS32 01931 SKIP3 DTSCS32 01932 S899-ABEND. DTSCS32 01933 EXEC CICS ABEND DTSCS32 01934 ABCODE(WRK-ABEND-CD) DTSCS32 01935 END-EXEC. DTSCS32 01936 S899-EXIT. DTSCS32 01937 EXIT. DTSCS32 01938 EJECT DTSCS32 01939 S1100-EDIT-KEY. DTSCS32 01940 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCS32 01941 S1100-EXIT. EXIT. DTSCS32 01942 /*****************************************************************DTSCS32 01943 * DTSCS32 01944 ******************************************************************DTSCS32 01945 S1101-EMP-NO. DTSCS32 01946 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS32 01947 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS32 01948 DTSCS32 01949 IF L018-NO-ENTRY DTSCS32 01950 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS32 01951 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS32 01952 GO TO S1101-EXIT. DTSCS32 01953 DTSCS32 01954 IF L018-NOT-VALID DTSCS32 01955 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS32 01956 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS32 01957 GO TO S1101-EXIT. DTSCS32 01958 DTSCS32 01959 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS32 01960 DTSCS32 01961 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS32 01962 S1101-EXIT. EXIT. DTSCS32 01963 SKIP3 DTSCS32 01964 S1110-READ-MPRF. DTSCS32 01965 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS32 01966 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS32 01967 SET MPRF-PRF-88 TO TRUE. DTSCS32 01968 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS32 01969 PERFORM S810-READ THRU S810-EXIT. DTSCS32 01970 IF L810-NO-REC-88 DTSCS32 01971 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS32 01972 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS32 01973 ELSE DTSCS32 01974 MOVE MSKL-REC TO MPRF-REC DTSCS32 01975 SET WRK-MPRF-YES-88 TO TRUE. DTSCS32 01976 S1110-EXIT. DTSCS32 01977 EXIT. DTSCS32 01978 SKIP3 DTSCS32 01979 S1199-ERROR. DTSCS32 01980 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS32 01981 MAP-EMP-NO-2-A. DTSCS32 01982 IF LCCM-NO-MSG DTSCS32 01983 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS32 01984 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS32 01985 SET CURSOR-SET-YES TO TRUE. DTSCS32 01986 S1199-EXIT. EXIT. DTSCS32 01987 /*****************************************************************DTSCS32 01988 * DTSCS32 01989 ******************************************************************DTSCS32 01990 S1200-YRQ. DTSCS32 01991 IF (MAP-YRQ-YR = 'PU') DTSCS32 01992 AND DTSCS32 01993 (MAP-YRQ-Q = LOW-VALUES OR SPACES) DTSCS32 01994 MOVE LCCM-PICKUP-YRQ TO WRK-YRQ DTSCS32 01995 GO TO S1200-EXIT. DTSCS32 01996 DTSCS32 01997 DTSCS32 01998 MOVE MAP-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS32 01999 DTSCS32 02000 PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT. DTSCS32 02001 DTSCS32 02002 IF L016-NO-ENTRY DTSCS32 02003 MOVE +0 TO WRK-YRQ DTSCS32 02004 ELSE DTSCS32 02005 IF L016-VALID DTSCS32 02006 MOVE L016-YRQ TO WRK-YRQ DTSCS32 02007 ELSE DTSCS32 02008 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS32 02009 PERFORM S1299-ERROR THRU S1299-EXIT. DTSCS32 02010 S1200-EXIT. DTSCS32 02011 EXIT. DTSCS32 02012 SKIP3 DTSCS32 02013 S1299-ERROR. DTSCS32 02014 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-YRQ-YR-A DTSCS32 02015 MAP-YRQ-Q-A. DTSCS32 02016 DTSCS32 02017 IF LCCM-NO-MSG DTSCS32 02018 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS32 02019 MOVE CATB-CURSOR TO MAP-YRQ-YR-L DTSCS32 02020 SET CURSOR-SET-YES TO TRUE. DTSCS32 02021 S1299-EXIT. DTSCS32 02022 EXIT. DTSCS32 02023 /*****************************************************************DTSCS32 02024 * DTSCS32 02025 ******************************************************************DTSCS32 02026 S1300-COMBINE-IND. DTSCS32 02027 IF MAP-COMBINE-IND = LOW-VALUES OR SPACES DTSCS32 02028 MOVE LCCM-COMBINE-IND TO MAP-COMBINE-IND. DTSCS32 02029 DTSCS32 02030 IF MAP-COMBINE-VALID-88 DTSCS32 02031 MOVE MAP-COMBINE-IND TO LCCM-COMBINE-IND DTSCS32 02032 ELSE DTSCS32 02033 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS32 02034 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS32 02035 S1300-EXIT. DTSCS32 02036 EXIT. DTSCS32 02037 SKIP3 DTSCS32 02038 S1399-ERROR. DTSCS32 02039 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-COMBINE-IND-A. DTSCS32 02040 DTSCS32 02041 IF LCCM-NO-MSG DTSCS32 02042 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS32 02043 MOVE CATB-CURSOR TO MAP-COMBINE-IND-L DTSCS32 02044 SET CURSOR-SET-YES TO TRUE. DTSCS32 02045 S1399-EXIT. DTSCS32 02046 EXIT. DTSCS32 02047 /*****************************************************************DTSCS32 02048 * DTSCS32 02049 ******************************************************************DTSCS32 02050 S1400-COMP-DATE. DTSCS32 02051 MOVE MAP-COMP-DATE-AREA TO L015-S-DATE-AREA. DTSCS32 02052 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS32 02053 DTSCS32 02054 IF MAP-COMP-MO = '99' DTSCS32 02055 AND MAP-COMP-DA = '99' DTSCS32 02056 AND MAP-COMP-YR = '99' DTSCS32 02057 MOVE ALL-NINES-DATE TO LCCM-COMP-DATE DTSCS32 02058 GO TO S1400-EXIT. DTSCS32 02059 DTSCS32 02060 IF L015-NO-ENTRY DTSCS32 02061 MOVE LCCM-COMP-DATE TO WRK-DISPLAY DTSCS32 02062 MOVE WRK-DISPLAY-MO TO MAP-COMP-MO DTSCS32 02063 MOVE WRK-DISPLAY-DA TO MAP-COMP-DA DTSCS32 02064 MOVE WRK-DISPLAY-YR TO MAP-COMP-YR DTSCS32 02065 ELSE DTSCS32 02066 IF L015-NOT-VALID DTSCS32 02067 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS32 02068 PERFORM S1499-ERROR THRU S1499-EXIT DTSCS32 02069 ELSE DTSCS32 02070 MOVE L015-DATE TO LCCM-COMP-DATE. DTSCS32 02071 S1400-EXIT. DTSCS32 02072 EXIT. DTSCS32 02073 SKIP3 DTSCS32 02074 S1499-ERROR. DTSCS32 02075 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-COMP-MO-A DTSCS32 02076 MAP-COMP-DA-A DTSCS32 02077 MAP-COMP-YR-A. DTSCS32 02078 DTSCS32 02079 IF LCCM-NO-MSG DTSCS32 02080 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS32 02081 MOVE CATB-CURSOR TO MAP-COMP-MO-L DTSCS32 02082 SET CURSOR-SET-YES TO TRUE. DTSCS32 02083 S1499-EXIT. DTSCS32 02084 EXIT. DTSCS32 02085 /*****************************************************************DTSCS32 02086 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS32 02087 ******************************************************************DTSCS32 02088 S5300-SET-INQ-ATTRB. DTSCS32 02089 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS32 02090 WRK-ATB-NUM. DTSCS32 02091 DTSCS32 02092 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS32 02093 S5300-EXIT. DTSCS32 02094 EXIT. DTSCS32 02095 SKIP3 DTSCS32 02096 S5900-SET-ATTRB. DTSCS32 02097 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS32 02098 MAP-EMP-NO-2-A. DTSCS32 02099 DTSCS32 02100 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-YRQ-YR-A DTSCS32 02101 MAP-YRQ-Q-A. DTSCS32 02102 DTSCS32 02103 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-COMBINE-IND-A. DTSCS32 02104 DTSCS32 02105 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-COMP-MO-A DTSCS32 02106 MAP-COMP-DA-A DTSCS32 02107 MAP-COMP-YR-A. DTSCS32 02108 DTSCS32 02109 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-PRIMARY-NAME-A. DTSCS32 02110 DTSCS32 02111 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS32 02112 DTSCS32 02113 PERFORM VARYING COL-SUB FROM 1 BY 1 DTSCS32 02114 UNTIL COL-SUB > 5 DTSCS32 02115 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-YYQ-A (COL-SUB) DTSCS32 02116 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-UI-RATE-A (COL-SUB) DTSCS32 02117 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-BATCH-NO-A (COL-SUB) DTSCS32 02118 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-ITEM-NO-A (COL-SUB) DTSCS32 02119 END-PERFORM. DTSCS32 02120 DTSCS32 02121 PERFORM VARYING WRK-ROW FROM 1 BY 1 DTSCS32 02122 UNTIL WRK-ROW > 18 DTSCS32 02123 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-AMT-LINE-A (WRK-ROW) DTSCS32 02124 MOVE SPACES TO MAP-AMT-LINE (WRK-ROW) DTSCS32 02125 END-PERFORM. DTSCS32 02126 S5900-EXIT. DTSCS32 02127 EXIT. DTSCS32 02128 /*****************************************************************DTSCS32 02129 * MAP ROUTINES *DTSCS32 02130 ******************************************************************DTSCS32 02131 S9100-RECEIVE. DTSCS32 02132 SET L851-RECEIVE-88 TO TRUE. DTSCS32 02133 SKIP1 DTSCS32 02134 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS32 02135 SKIP1 DTSCS32 02136 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS32 02137 SKIP1 DTSCS32 02138 MOVE L851-AID TO LCCM-AID. DTSCS32 02139 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS32 02140 S9100-EXIT. DTSCS32 02141 EXIT. DTSCS32 02142 SKIP3 DTSCS32 02143 S9200-SEND-DATAONLY. DTSCS32 02144 MOVE LOW-VALUES TO MAP-AREA. DTSCS32 02145 SKIP1 DTSCS32 02146 IF LCCM-NO-MSG DTSCS32 02147 NEXT SENTENCE DTSCS32 02148 ELSE DTSCS32 02149 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS32 02150 SKIP1 DTSCS32 02151 IF CURSOR-SET-GOTO DTSCS32 02152 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS32 02153 ELSE DTSCS32 02154 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS32 02155 SKIP1 DTSCS32 02156 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS32 02157 SKIP1 DTSCS32 02158 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS32 02159 SKIP1 DTSCS32 02160 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS32 02161 S9200-EXIT. DTSCS32 02162 EXIT. DTSCS32 02163 SKIP3 DTSCS32 02164 S9300-SEND-MAP. DTSCS32 02165 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS32 02166 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS32 02167 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS32 02168 SKIP1 DTSCS32 02169 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS32 02170 SKIP1 DTSCS32 02171 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS32 02172 SKIP1 DTSCS32 02173 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS32 02174 SKIP1 DTSCS32 02175 IF CURSOR-SET-NO DTSCS32 02176 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS32 02177 SKIP1 DTSCS32 02178 SET L851-SEND-88 TO TRUE. DTSCS32 02179 SKIP1 DTSCS32 02180 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS32 02181 SKIP1 DTSCS32 02182 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS32 02183 S9300-EXIT. DTSCS32 02184 EXIT. DTSCS32 02185 SKIP3 DTSCS32 02186 S9320-INQUIRY-FKEYS. DTSCS32 02187 MOVE 'F5=FRST' TO MAP-KEY-FIRST. DTSCS32 02188 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS32 02189 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS32 02190 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS32 02191 DTSCS32 02192 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS32 02193 S9320-EXIT. DTSCS32 02194 EXIT. DTSCS32 02195 SKIP3 DTSCS32 02196 *S9321-JUMP-KEYS. DTSCS32 02197 * MOVE 'F9=NOTE' TO MAP-KEY-NOTE. DTSCS32 02198 * MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ. DTSCS32 02199 * MOVE 'F11=PAY' TO MAP-KEY-PAY-INQ. DTSCS32 02200 * MOVE 'F12=ADJ' TO MAP-KEY-ADJ-INQ. DTSCS32 02201 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS32 02202 * MOVE 'F20=COL' TO MAP-KEY-COL-INQ. DTSCS32 02203 *S9321-EXIT. DTSCS32 02204 * EXIT. DTSCS32 02205 SKIP3 DTSCS32 02206 S9330-DSCR-FIELDS. DTSCS32 02207 IF WRK-MPRF-YES-88 DTSCS32 02208 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS32 02209 ELSE DTSCS32 02210 MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS32 02211 S9330-EXIT. DTSCS32 02212 EXIT. DTSCS32 02213 SKIP3 DTSCS32 02214 S9900-PREPARE-SEND. DTSCS32 02215 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS32 02216 LCCM-SCR-ID. DTSCS32 02217 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS32 02218 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS32 02219 S9900-EXIT. DTSCS32 02220 EXIT. DTSCS32