giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
62d95f14f0cb5df07cf30450e671122a13fe012d
DUTAS/CICS/DTSCS98.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2103 lines
166 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink