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