00001 IDENTIFICATION DIVISION. 02/07/12 00002 PROGRAM-ID. DTSCS87. DTSCS87 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV020 00004 DATE-WRITTEN. MAY 1994. DTSCS87 00005 DATE-COMPILED. DTSCS87 00006 SKIP3 DTSCS87 00007 ***** DTSCS87 00008 * DTSCS87 00009 * FUNCTION: AUDIT CANDIDATE SELECTION CRITERA INQUIRY/UPDATE DTSCS87 00010 * SCREEN PROCESSOR. DTSCS87 00011 * DTSCS87 00012 * DTSCS87 00013 * MODIFICATION LOG: DTSCS87 00014 * DTSCS87 00015 * 09/15/98 INITIAL DEVELOPMENT. COPIED FROM MACCS87. DTSCS87 00016 * WORK ORDER: PROGRAMMER: ZL1. DTSCS87 00017 * DTSCS87 00018 * 05/21/1999 PICKUP MODIFICATIONS. REQUIRE ALL YRQ VALUES DTSCS87 00019 * TO BE GREATER THAN 19924. DTSCS87 00020 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS87 00021 * DTSCS87 00022 * 01/24/2012 MODIFY PROGRAM TO INCLUDE NEW TARGETED FEILD DTSCS87 00023 * FOR AUDITS DTSCS87 00024 * REFERENCE: PROGRAMMER: ZL1 DTSCS87 00025 * DTSCS87 00026 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS87 00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS87 00028 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS87 00029 * DTSCS87 00030 * DTSCS87 00031 * DESCRIPTION: DTSCS87 00032 * DTSCS87 00033 * CLEAR: DTSCS87 00034 * DTSCS87 00035 * DATA FIELDS DISPLAYED: NONE. DTSCS87 00036 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS87 00037 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS87 00038 * DTSCS87 00039 * DTSCS87 00040 * INQUIRY: DTSCS87 00041 * DTSCS87 00042 * CONTROL FIELD(S): NONE - MAXIMUM OF ONE FSEL RECORD. DTSCS87 00043 * DTSCS87 00044 * JUMP IN: USE CLEAR LOGIC. DTSCS87 00045 * DTSCS87 00046 * ENTER: DISPLAY FSEL RECORD IF IT EXISTS. DTSCS87 00047 * DTSCS87 00048 * NO PAGING. DTSCS87 00049 * DTSCS87 00050 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS87 00051 * FSEL-KEY-AREA OF THE DISPLAYED FSEL RECORD IN DTSCS87 00052 * LCCM-SCR-KEY-AREA. DTSCS87 00053 * DTSCS87 00054 * DTSCS87 00055 * UPDATE: DTSCS87 00056 * DTSCS87 00057 * ADD DTSCS87 00058 * MOD DTSCS87 00059 * DEL DTSCS87 00060 * DTSCS87 00061 * DTSCS87 00062 * RECORDS READ: DTSCS87 00063 * DTSCS87 00064 * MASTER: DTSCS87 00065 * DTSCS87 00066 * NONE. DTSCS87 00067 * DTSCS87 00068 * DTSCS87 00069 * ALTERNATE INDEX: DTSCS87 00070 * DTSCS87 00071 * NONE. DTSCS87 00072 * DTSCS87 00073 * DTSCS87 00074 * REFERENCE: DTSCS87 00075 * DTSCS87 00076 * FSEL. DTSCS87 00077 * DTSCS87 00078 * DTSCS87 00079 * ACCOUNTING TRANSACTION COLLECTION: DTSCS87 00080 * DTSCS87 00081 * NONE. DTSCS87 00082 * DTSCS87 00083 * DTSCS87 00084 * RECORDS UPDATED: DTSCS87 00085 * DTSCS87 00086 * MASTER: DTSCS87 00087 * DTSCS87 00088 * NONE. DTSCS87 00089 * DTSCS87 00090 * DTSCS87 00091 * REFERENCE: DTSCS87 00092 * DTSCS87 00093 * FSEL (ADD, MOD, DEL). DTSCS87 00094 * DTSCS87 00095 * DTSCS87 00096 * ACCOUNTING TRANSACTION COLLECTION: DTSCS87 00097 * DTSCS87 00098 * NONE. DTSCS87 00099 * DTSCS87 00100 * DTSCS87 00101 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS87 00102 * DTSCS87 00103 * NONE. DTSCS87 00104 * DTSCS87 00105 * DTSCS87 00106 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS87 00107 * UTILITY MODULES) LINKED TO: DTSCS87 00108 * DTSCS87 00109 * DTSCU001 DATE EDIT/CONVERSION. DTSCS87 00110 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS87 00111 * DTSCU011 AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS87 00112 * DTSCU012 RATE FROM SCREEN FORMAT/EDIT. DTSCS87 00113 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. DTSCS87 00114 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS87 00115 * DTSCU016 YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS87 00116 * DTSCU024 START/END YEAR/QUARTER FROM SCREEN FORMAT/EDIT. DTSCS87 00117 * DTSCU039 RATE SIC (ETC) EDIT/DESCRIPTION. DTSCS87 00118 * DTSCU056 RATE DISPLAY. DTSCS87 00119 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS87 00120 * DTSCU831 REFERENCE FILE I/O. DTSCS87 00121 * DTSCS87 00122 * DTSCS87 00123 * MAINTENANCE NOTES: DTSCS87 00124 * DTSCS87 00125 * A FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS87 00126 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS87 00127 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS87 00128 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1000, DTSCS87 00129 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS87), DTSCS87 00130 * ALTER THE MAP (DTSM87) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS87 00131 * DTSCS87 00132 ***** DTSCS87 00133 SKIP3 DTSCS87 00134 ENVIRONMENT DIVISION. DTSCS87 00135 EJECT DTSCS87 00136 DATA DIVISION. DTSCS87 00137 WORKING-STORAGE SECTION. DTSCS87 001375 77 PAN-VALET PICTURE X(24) VALUE '020DTSCS87 02/07/12'. DTSCS87 00138 SKIP3 DTSCS87 00139 01 WRK-AREA. DTSCS87 00140 05 WRK-ABEND-CD PIC X(04) VALUE 'S87 '. DTSCS87 00141 SKIP1 DTSCS87 00142 05 WRK-SCR-ID. DTSCS87 00143 10 WRK-SCR-ID-9 PIC 9(02) VALUE 87. DTSCS87 00144 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS87 00145 SKIP1 DTSCS87 00146 05 WRK-KEY-AREA. DTSCS87 00147 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS87 00148 10 FILLER PIC X(14). DTSCS87 00149 SKIP1 DTSCS87 00150 05 WRK-MSG-AREA PIC X(64). DTSCS87 00151 SKIP1 DTSCS87 00152 05 WRK-HOLD-VALUE PIC S9(11)V9(04) COMP-3. DTSCS87 00153 05 WRK-PAIR-CHECKING PIC X(01). DTSCS87 00154 88 START-NO-ENTRY VALUE '0'. DTSCS87 00155 88 START-VALID VALUE '1'. DTSCS87 00156 88 START-NOT-VALID VALUE '2'. DTSCS87 00157 88 START-CLEAR VALUE '-'. DTSCS87 00158 SKIP1 DTSCS87 00159 05 WRK-FLD-REP-IND PIC X(01). DTSCS87 00160 88 FLD-REP-ENTERED VALUE 'Y'. DTSCS87 00161 88 FLD-REP-NOT-ENTERED VALUE 'N'. DTSCS87 00162 SKIP1 DTSCS87 00163 05 WRK-RANGE-ENTRY PIC X(01). DTSCS87 00164 88 RANGE-ENTRY VALUE 'Y'. DTSCS87 00165 88 RANGE-NO-ENTRY VALUE 'N'. DTSCS87 00166 EJECT DTSCS87 00167 01 MSG-AREA. DTSCS87 00168 05 MSG-E871-AREA. DTSCS87 00169 10 FILLER PIC X(04) VALUE 'E871'. DTSCS87 00170 10 FILLER PIC X(30) DTSCS87 00171 VALUE 'IF RANDOM, THEN ENTRY OF SELEC'. DTSCS87 00172 10 FILLER PIC X(30) DTSCS87 00173 VALUE 'TION CRITERIA IS NOT ALLOWED '. DTSCS87 00174 DTSCS87 00175 05 MSG-E872-AREA. DTSCS87 00176 10 FILLER PIC X(04) VALUE 'E872'. DTSCS87 00177 10 FILLER PIC X(30) DTSCS87 00178 VALUE 'AUDITED START QTR MUST BE <= D'. DTSCS87 00179 10 FILLER PIC X(30) DTSCS87 00180 VALUE 'EL MAIL QTR '. DTSCS87 00181 DTSCS87 00182 05 MSG-E873-AREA. DTSCS87 00183 10 FILLER PIC X(04) VALUE 'E873'. DTSCS87 00184 10 FILLER PIC X(30) DTSCS87 00185 VALUE 'LIABILITY END DATE MUST BE <= '. DTSCS87 00186 10 FILLER PIC X(30) DTSCS87 00187 VALUE 'PROCESSING DATE '. DTSCS87 00188 DTSCS87 00189 05 MSG-E874-AREA. DTSCS87 00190 10 FILLER PIC X(04) VALUE 'E874'. DTSCS87 00191 10 FILLER PIC X(30) DTSCS87 00192 VALUE 'START VALUE MUST BE <= END VAL'. DTSCS87 00193 10 FILLER PIC X(30) DTSCS87 00194 VALUE 'UE '. DTSCS87 00195 DTSCS87 00196 05 MSG-E875-AREA. DTSCS87 00197 10 FILLER PIC X(04) VALUE 'E875'. DTSCS87 00198 10 FILLER PIC X(30) DTSCS87 00199 VALUE 'END QTR MUST BY <= DEL MAIL QT'. DTSCS87 00200 10 FILLER PIC X(30) DTSCS87 00201 VALUE 'R '. DTSCS87 00202 EJECT DTSCS87 00203 01 SCREEN-CONTROL. DTSCS87 00204 05 SCR-ACCESS-IND PIC X(01). DTSCS87 00205 88 SCR-ACCESS-INQ VALUE '1'. DTSCS87 00206 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS87 00207 SKIP1 DTSCS87 00208 05 CURSOR-SET-IND PIC X(01). DTSCS87 00209 88 CURSOR-SET-YES VALUE 'Y'. DTSCS87 00210 88 CURSOR-SET-NO VALUE 'N'. DTSCS87 00211 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS87 00212 SKIP1 DTSCS87 00213 05 REQ-IND PIC X(01). DTSCS87 00214 88 REQ-ERROR VALUE 'O'. DTSCS87 00215 88 REQ-JUMP VALUE 'J'. DTSCS87 00216 88 REQ-INQUIRE VALUE 'I'. DTSCS87 00217 88 REQ-CLEAR VALUE 'C'. DTSCS87 00218 88 REQ-EDIT VALUE 'E'. DTSCS87 00219 88 REQ-UPDATE VALUE 'U'. DTSCS87 00220 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS87 00221 SKIP1 DTSCS87 00222 05 RESP-IND PIC X(01). DTSCS87 00223 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS87 00224 88 RESP-SEND-MAP VALUE 'M'. DTSCS87 00225 88 RESP-JUMP VALUE 'J'. DTSCS87 00226 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS87 00227 SKIP1 DTSCS87 00228 05 SCR-ATB-AN PIC X(01). DTSCS87 00229 05 SCR-ATB-NUM PIC X(01). DTSCS87 00230 EJECT DTSCS87 00231 01 L001-COMM-AREA. DTSCS87 00232 ++INCLUDE DTSIL001 DTSCS87 00233 EJECT DTSCS87 00234 01 L004-COMM-AREA. DTSCS87 00235 ++INCLUDE DTSIL004 DTSCS87 00236 EJECT DTSCS87 00237 01 L011-COMM-AREA. DTSCS87 00238 ++INCLUDE DTSIL011 DTSCS87 00239 EJECT DTSCS87 00240 01 L012-COMM-AREA. DTSCS87 00241 ++INCLUDE DTSIL012 DTSCS87 00242 EJECT DTSCS87 00243 01 L013-COMM-AREA. DTSCS87 00244 ++INCLUDE DTSIL013 DTSCS87 00245 EJECT DTSCS87 00246 01 L015-COMM-AREA. DTSCS87 00247 ++INCLUDE DTSIL015 DTSCS87 00248 EJECT DTSCS87 00249 01 L016-COMM-AREA. DTSCS87 00250 ++INCLUDE DTSIL016 DTSCS87 00251 EJECT DTSCS87 00252 01 L024-COMM-AREA. DTSCS87 00253 ++INCLUDE DTSIL024 DTSCS87 00254 EJECT DTSCS87 00255 01 L039-COMM-AREA. DTSCS87 00256 ++INCLUDE DTSIL039 DTSCS87 00257 EJECT DTSCS87 00258 01 L056-COMM-AREA. DTSCS87 00259 ++INCLUDE DTSIL056 DTSCS87 00260 EJECT DTSCS87 00261 01 L062-COMM-AREA. DTSCS87 00262 ++INCLUDE DTSIL062 DTSCS87 00263 EJECT DTSCS87 00264 * ERROR MSG MODULE DTSCS87 00265 01 L805-COMM-AREA. DTSCS87 00266 ++INCLUDE DTSIL805 DTSCS87 00267 EJECT DTSCS87 00268 * REFERENCE FILE I-O LINKAGE DTSCS87 00269 01 L831-COMM-AREA. DTSCS87 00270 05 L831-CONTROL-BLOCK. DTSCS87 00271 ++INCLUDE DTSIL831 DTSCS87 00272 EJECT DTSCS87 00273 * COMMON SKELETAL RECORD DTSCS87 00274 05 FCOMM-REC. DTSCS87 00275 ++INCLUDE DTSIFSKL DTSCS87 00276 SKIP3 DTSCS87 00277 * AUDIT CANDIDATE SELECTION CRITERIA RECORD LAYOUT DTSCS87 00278 05 FSEL-REC REDEFINES FCOMM-REC. DTSCS87 00279 ++INCLUDE DTSIFSEL DTSCS87 00280 EJECT DTSCS87 00281 * MAP DEFINITION DTSCS87 00282 01 L851-COMM-AREA. DTSCS87 00283 ++INCLUDE DTSIL851 DTSCS87 00284 SKIP3 DTSCS87 00285 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS87 00286 ++INCLUDE DTSIS87 DTSCS87 00287 EJECT DTSCS87 00288 * REFERENCE FILE OCCURRENCE MAXIMUMS DTSCS87 00289 01 FMAX-LITERALS. DTSCS87 00290 ++INCLUDE DTSIFMAX DTSCS87 00291 SKIP3 DTSCS87 00292 * ATTRIBUTE LITERALS DTSCS87 00293 01 CATB-LITERALS. DTSCS87 00294 ++INCLUDE DTSICATB DTSCS87 00295 SKIP3 DTSCS87 00296 * FUNCTION KEY DESCRIPTION LITERALS DTSCS87 00297 01 CFKD-LITERALS. DTSCS87 00298 ++INCLUDE DTSICFKD DTSCS87 00299 EJECT DTSCS87 00300 * ERROR CODE MESSAGE LITERALS DTSCS87 00301 01 CECD-LITERALS. DTSCS87 00302 ++INCLUDE DTSICECD DTSCS87 00303 SKIP3 DTSCS87 00304 * PROMPT CODE MESSAGE LITERALS DTSCS87 00305 01 CPCD-LITERALS. DTSCS87 00306 ++INCLUDE DTSICPCD DTSCS87 00307 EJECT DTSCS87 00308 LINKAGE SECTION. DTSCS87 00309 SKIP3 DTSCS87 00310 01 DFHCOMMAREA. DTSCS87 00311 ++INCLUDE DTSILCCM DTSCS87 00312 SKIP3 DTSCS87 00313 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS87 00314 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS87 00315 EJECT DTSCS87 00316 ******************************************************************DTSCS87 00317 * *DTSCS87 00318 ******************************************************************DTSCS87 00319 PROCEDURE DIVISION. DTSCS87 00320 SKIP2 DTSCS87 00321 SET CURSOR-SET-NO TO TRUE. DTSCS87 00322 SKIP1 DTSCS87 00323 MOVE LOW-VALUES TO MAP-AREA. DTSCS87 00324 SKIP1 DTSCS87 00325 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS87 00326 TO SCR-ACCESS-IND. DTSCS87 00327 SKIP3 DTSCS87 00328 MOVE SPACE TO REQ-IND. DTSCS87 00329 SKIP1 DTSCS87 00330 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS87 00331 SKIP1 DTSCS87 00332 *----------------------------------------------------- DTSCS87 00333 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS87 00334 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS87 00335 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS87 00336 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS87 00337 * DTSCS87 00338 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS87 00339 * PROCESSED. DTSCS87 00340 * DTSCS87 00341 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS87 00342 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS87 00343 * WORK STATION OPERATOR. DTSCS87 00344 *----------------------------------------------------- DTSCS87 00345 SKIP1 DTSCS87 00346 MOVE SPACE TO RESP-IND. DTSCS87 00347 SKIP1 DTSCS87 00348 IF REQ-ERROR DTSCS87 00349 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS87 00350 ELSE DTSCS87 00351 IF REQ-JUMP DTSCS87 00352 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS87 00353 ELSE DTSCS87 00354 IF REQ-CLEAR DTSCS87 00355 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS87 00356 ELSE DTSCS87 00357 IF REQ-CURSOR-TO-GOTO DTSCS87 00358 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS87 00359 ELSE DTSCS87 00360 IF REQ-INQUIRE DTSCS87 00361 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS87 00362 ELSE DTSCS87 00363 IF REQ-EDIT DTSCS87 00364 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS87 00365 ELSE DTSCS87 00366 IF REQ-UPDATE DTSCS87 00367 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS87 00368 ELSE DTSCS87 00369 GO TO S899-ABEND. DTSCS87 00370 SKIP3 DTSCS87 00371 *----------------------------------------------------- DTSCS87 00372 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS87 00373 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS87 00374 *----------------------------------------------------- DTSCS87 00375 SKIP1 DTSCS87 00376 IF RESP-SEND-MAP DTSCS87 00377 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS87 00378 SET LCCM-END-TASK-88 TO TRUE DTSCS87 00379 ELSE DTSCS87 00380 IF RESP-SEND-MSGONLY DTSCS87 00381 OR RESP-CURSOR-TO-GOTO DTSCS87 00382 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS87 00383 SET LCCM-END-TASK-88 TO TRUE DTSCS87 00384 ELSE DTSCS87 00385 IF RESP-JUMP DTSCS87 00386 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS87 00387 ELSE DTSCS87 00388 GO TO S899-ABEND. DTSCS87 00389 SKIP3 DTSCS87 00390 MAINLINE-EXIT. DTSCS87 00391 SKIP1 DTSCS87 00392 EXEC CICS DTSCS87 00393 RETURN DTSCS87 00394 END-EXEC. DTSCS87 00395 SKIP2 DTSCS87 00396 * GOBACK. DTSCS87 00397 /*****************************************************************DTSCS87 00398 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS87 00399 ******************************************************************DTSCS87 00400 P1000-ANALYZE-REQUEST. DTSCS87 00401 SKIP1 DTSCS87 00402 *----------------------------------------------------- DTSCS87 00403 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS87 00404 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS87 00405 * REPLACED WITH ENTER) DTSCS87 00406 *----------------------------------------------------- DTSCS87 00407 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS87 00408 SET LCCM-ENTER-88 TO TRUE DTSCS87 00409 SET REQ-CLEAR TO TRUE DTSCS87 00410 GO TO P1000-EXIT. DTSCS87 00411 SKIP3 DTSCS87 00412 *----------------------------------------------------- DTSCS87 00413 * MAP IS RECEIVED DTSCS87 00414 *----------------------------------------------------- DTSCS87 00415 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS87 00416 SKIP3 DTSCS87 00417 *----------------------------------------------------- DTSCS87 00418 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS87 00419 * WORK STATION DTSCS87 00420 *----------------------------------------------------- DTSCS87 00421 IF LCCM-CLEAR-88 DTSCS87 00422 SET REQ-CLEAR TO TRUE DTSCS87 00423 GO TO P1000-EXIT. DTSCS87 00424 SKIP3 DTSCS87 00425 *----------------------------------------------------- DTSCS87 00426 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS87 00427 *----------------------------------------------------- DTSCS87 00428 IF LCCM-SCR-UPDATE-LOCKED DTSCS87 00429 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS87 00430 GO TO P1000-EXIT. DTSCS87 00431 SKIP3 DTSCS87 00432 *----------------------------------------------------- DTSCS87 00433 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS87 00434 *----------------------------------------------------- DTSCS87 00435 IF LCCM-PA2-88 DTSCS87 00436 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS87 00437 GO TO P1000-EXIT. DTSCS87 00438 SKIP3 DTSCS87 00439 *----------------------------------------------------- DTSCS87 00440 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS87 00441 *----------------------------------------------------- DTSCS87 00442 IF LCCM-PA-88 DTSCS87 00443 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS87 00444 SET REQ-ERROR TO TRUE DTSCS87 00445 GO TO P1000-EXIT. DTSCS87 00446 SKIP3 DTSCS87 00447 *----------------------------------------------------- DTSCS87 00448 * IF F12 IS PRESSED WHEN UPDATE NOT IN PROGRESS IT DTSCS87 00449 * IS A REQUEST TO CLEAR SCREEN. DTSCS87 00450 *----------------------------------------------------- DTSCS87 00451 IF LCCM-F12-88 DTSCS87 00452 MOVE LOW-VALUES TO MAP-AREA DTSCS87 00453 SET REQ-CLEAR TO TRUE DTSCS87 00454 GO TO P1000-EXIT. DTSCS87 00455 SKIP3 DTSCS87 00456 *----------------------------------------------------- DTSCS87 00457 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS87 00458 *----------------------------------------------------- DTSCS87 00459 IF LCCM-F03-88 DTSCS87 00460 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS87 00461 SET REQ-JUMP TO TRUE DTSCS87 00462 GO TO P1000-EXIT. DTSCS87 00463 SKIP3 DTSCS87 00464 *----------------------------------------------------- DTSCS87 00465 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS87 00466 *----------------------------------------------------- DTSCS87 00467 IF LCCM-F04-88 DTSCS87 00468 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS87 00469 SET REQ-JUMP TO TRUE DTSCS87 00470 GO TO P1000-EXIT. DTSCS87 00471 SKIP3 DTSCS87 00472 *----------------------------------------------------- DTSCS87 00473 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS87 00474 * CORRESPONDENCE SCREEN DTSCS87 00475 *----------------------------------------------------- DTSCS87 00476 IF LCCM-F14-88 DTSCS87 00477 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS87 00478 SET REQ-JUMP TO TRUE DTSCS87 00479 GO TO P1000-EXIT. DTSCS87 00480 SKIP3 DTSCS87 00481 *----------------------------------------------------- DTSCS87 00482 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS87 00483 * REQUESTED SCREEN TYPE DTSCS87 00484 *----------------------------------------------------- DTSCS87 00485 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS87 00486 NEXT SENTENCE DTSCS87 00487 ELSE DTSCS87 00488 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS87 00489 SET REQ-JUMP TO TRUE DTSCS87 00490 GO TO P1000-EXIT. DTSCS87 00491 SKIP3 DTSCS87 00492 *----------------------------------------------------- DTSCS87 00493 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS87 00494 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS87 00495 *----------------------------------------------------- DTSCS87 00496 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS87 00497 IF SCR-ACCESS-UPDATE DTSCS87 00498 SET REQ-EDIT TO TRUE DTSCS87 00499 GO TO P1000-EXIT DTSCS87 00500 ELSE DTSCS87 00501 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS87 00502 SET REQ-ERROR TO TRUE DTSCS87 00503 GO TO P1000-EXIT. DTSCS87 00504 SKIP3 DTSCS87 00505 *----------------------------------------------------- DTSCS87 00506 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS87 00507 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS87 00508 *----------------------------------------------------- DTSCS87 00509 IF LCCM-ENTER-88 DTSCS87 00510 SET REQ-INQUIRE TO TRUE DTSCS87 00511 GO TO P1000-EXIT. DTSCS87 00512 SKIP3 DTSCS87 00513 *----------------------------------------------------- DTSCS87 00514 * ANY OTHER KEY IS INVALID DTSCS87 00515 *----------------------------------------------------- DTSCS87 00516 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS87 00517 SET REQ-ERROR TO TRUE. DTSCS87 00518 P1000-EXIT. DTSCS87 00519 EXIT. DTSCS87 00520 SKIP3 DTSCS87 00521 ******************************************************************DTSCS87 00522 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS87 00523 ******************************************************************DTSCS87 00524 SKIP1 DTSCS87 00525 P1100-UPDATE-LOCKED. DTSCS87 00526 *----------------------------------------------------- DTSCS87 00527 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS87 00528 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS87 00529 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS87 00530 *----------------------------------------------------- DTSCS87 00531 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS87 00532 SET REQ-UPDATE TO TRUE DTSCS87 00533 ELSE DTSCS87 00534 SET REQ-ERROR TO TRUE DTSCS87 00535 IF LCCM-SCR-ADD-LOCKED DTSCS87 00536 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS87 00537 ELSE DTSCS87 00538 IF LCCM-SCR-MOD-LOCKED DTSCS87 00539 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS87 00540 ELSE DTSCS87 00541 IF LCCM-SCR-DEL-LOCKED DTSCS87 00542 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA DTSCS87 00543 ELSE DTSCS87 00544 GO TO S899-ABEND. DTSCS87 00545 P1100-EXIT. DTSCS87 00546 EXIT. DTSCS87 00547 /*****************************************************************DTSCS87 00548 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS87 00549 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS87 00550 ******************************************************************DTSCS87 00551 SKIP1 DTSCS87 00552 P2000-REQUEST-ERROR. DTSCS87 00553 IF LCCM-MSG DTSCS87 00554 SET RESP-SEND-MSGONLY TO TRUE DTSCS87 00555 ELSE DTSCS87 00556 GO TO S899-ABEND. DTSCS87 00557 P2000-EXIT. DTSCS87 00558 EXIT. DTSCS87 00559 /*****************************************************************DTSCS87 00560 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS87 00561 ******************************************************************DTSCS87 00562 SKIP1 DTSCS87 00563 P3000-REQUEST-JUMP. DTSCS87 00564 *----------------------------------------------------- DTSCS87 00565 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS87 00566 * BY USER DTSCS87 00567 *----------------------------------------------------- DTSCS87 00568 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS87 00569 SKIP3 DTSCS87 00570 *----------------------------------------------------- DTSCS87 00571 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS87 00572 *----------------------------------------------------- DTSCS87 00573 IF LCCM-MSG DTSCS87 00574 SET RESP-SEND-MSGONLY TO TRUE DTSCS87 00575 SET CURSOR-SET-GOTO TO TRUE DTSCS87 00576 GO TO P3000-EXIT. DTSCS87 00577 SKIP3 DTSCS87 00578 *----------------------------------------------------- DTSCS87 00579 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS87 00580 *----------------------------------------------------- DTSCS87 00581 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS87 00582 LCCM-SCR-HOLD-AREA. DTSCS87 00583 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS87 00584 SET RESP-JUMP TO TRUE. DTSCS87 00585 P3000-EXIT. DTSCS87 00586 EXIT. DTSCS87 00587 /*****************************************************************DTSCS87 00588 * CLEAR KEY WAS PRESSED *DTSCS87 00589 ******************************************************************DTSCS87 00590 SKIP1 DTSCS87 00591 P4000-REQUEST-CLEAR. DTSCS87 00592 IF SCR-ACCESS-UPDATE DTSCS87 00593 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS87 00594 ELSE DTSCS87 00595 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS87 00596 SKIP3 DTSCS87 00597 *----------------------------------------------------- DTSCS87 00598 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS87 00599 * FIELDS FROM EARLIER REQUESTS DTSCS87 00600 *----------------------------------------------------- DTSCS87 00601 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS87 00602 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS87 00603 SET LCCM-SCR-CLEAR TO TRUE. DTSCS87 00604 SET RESP-SEND-MAP TO TRUE. DTSCS87 00605 P4000-EXIT. DTSCS87 00606 EXIT. DTSCS87 00607 /*****************************************************************DTSCS87 00608 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS87 00609 ******************************************************************DTSCS87 00610 SKIP1 DTSCS87 00611 P5000-CURSOR-TO-GOTO. DTSCS87 00612 SET CURSOR-SET-GOTO TO TRUE. DTSCS87 00613 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS87 00614 P5000-EXIT. DTSCS87 00615 EXIT. DTSCS87 00616 /*****************************************************************DTSCS87 00617 * INQUIRY WAS REQUESTED *DTSCS87 00618 ******************************************************************DTSCS87 00619 SKIP1 DTSCS87 00620 P6000-REQUEST-INQUIRE. DTSCS87 00621 MOVE LOW-VALUES TO FSEL-KEY-AREA. DTSCS87 00622 SET FSEL-SEL-88 TO TRUE. DTSCS87 00623 SKIP1 DTSCS87 00624 IF SCR-ACCESS-UPDATE DTSCS87 00625 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS87 00626 ELSE DTSCS87 00627 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS87 00628 SKIP1 DTSCS87 00629 SET LCCM-SCR-CLEAR TO TRUE. DTSCS87 00630 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS87 00631 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS87 00632 SKIP1 DTSCS87 00633 IF LCCM-MSG DTSCS87 00634 NEXT SENTENCE DTSCS87 00635 ELSE DTSCS87 00636 IF LCCM-ENTER-88 DTSCS87 00637 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS87 00638 ELSE DTSCS87 00639 GO TO S899-ABEND. DTSCS87 00640 SKIP1 DTSCS87 00641 SET RESP-SEND-MAP TO TRUE. DTSCS87 00642 P6000-EXIT. DTSCS87 00643 EXIT. DTSCS87 00644 EJECT DTSCS87 00645 P6100-NO-PAGE. DTSCS87 00646 PERFORM S831-READ THRU S831-EXIT. DTSCS87 00647 IF L831-NO-REC-88 DTSCS87 00648 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS87 00649 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT DTSCS87 00650 GO TO P6100-EXIT. DTSCS87 00651 SKIP1 DTSCS87 00652 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS87 00653 P6100-EXIT. DTSCS87 00654 EXIT. DTSCS87 00655 /*****************************************************************DTSCS87 00656 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS87 00657 ******************************************************************DTSCS87 00658 SKIP1 DTSCS87 00659 P6900-CONSTRUCT-SCREEN. DTSCS87 00660 SET L001-FROM-FED-8 TO TRUE. DTSCS87 00661 SET L004-FROM-5 TO TRUE. DTSCS87 00662 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS87 00663 SKIP3 DTSCS87 00664 MOVE FSEL-AUDIT-START-YRQ TO L004-QTR-5-9. DTSCS87 00665 PERFORM S004-YRQ THRU S004-EXIT. DTSCS87 00666 MOVE L004-QTR-3-YR TO MAP-AUDIT-START-YR. DTSCS87 00667 MOVE L004-QTR-3-Q TO MAP-AUDIT-START-Q. DTSCS87 00668 MOVE FSEL-AUDIT-END-YRQ TO L004-QTR-5-9. DTSCS87 00669 PERFORM S004-YRQ THRU S004-EXIT. DTSCS87 00670 MOVE L004-QTR-3-YR TO MAP-AUDIT-END-YR. DTSCS87 00671 MOVE L004-QTR-3-Q TO MAP-AUDIT-END-Q. DTSCS87 00672 SKIP1 DTSCS87 00673 IF FSEL-SMALL-EMP-LIST-CNT NOT = +0 DTSCS87 00674 MOVE FSEL-SMALL-EMP-LIST-CNT TO MAP-SMALL-EMP-LIST-CNT-N.DTSCS87 00675 IF FSEL-LARGE-EMP-LIST-CNT NOT = +0 DTSCS87 00676 MOVE FSEL-LARGE-EMP-LIST-CNT TO MAP-LARGE-EMP-LIST-CNT-N.DTSCS87 00677 MOVE FSEL-LARGE-EMP-DEFINITION-IND TO MAP-LARGE-EMP-DEFIN. DTSCS87 00678 SKIP1 DTSCS87 00679 MOVE FSEL-RANDOM-IND TO MAP-RANDOM-IND. DTSCS87 00680 MOVE FSEL-TARGET-IND TO MAP-TARGET-IND. DTSCS87 00681 SKIP1 DTSCS87 00682 PERFORM P6910-CONSTRUCT-REST THRU P6910-EXIT. DTSCS87 00683 SKIP1 DTSCS87 00684 IF FSEL-CHNG-DATE NOT = +0 DTSCS87 00685 MOVE FSEL-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS87 00686 SET L001-FROM-FED-8 TO TRUE DTSCS87 00687 PERFORM S001-DATE THRU S001-EXIT DTSCS87 00688 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS87 00689 SKIP1 DTSCS87 00690 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS87 00691 MOVE FSEL-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS87 00692 P6900-EXIT. DTSCS87 00693 EXIT. DTSCS87 00694 SKIP3 DTSCS87 00695 P6910-CONSTRUCT-REST. DTSCS87 00696 PERFORM VARYING MAP-IDX FROM 1 BY 1 DTSCS87 00697 UNTIL MAP-IDX > FMAX-SEL-FLD-REP-ID-MAX DTSCS87 00698 SET FSEL-FLD-REP-IDX TO MAP-IDX DTSCS87 00699 MOVE FSEL-FLD-REP-ID (FSEL-FLD-REP-IDX) DTSCS87 00700 TO MAP-FLD-REP-ID (MAP-IDX)DTSCS87 00701 END-PERFORM. DTSCS87 00702 SKIP1 DTSCS87 00703 IF FSEL-AUDITED-START-YRQ NOT = +0 DTSCS87 00704 MOVE FSEL-AUDITED-START-YRQ TO L004-QTR-5-9 DTSCS87 00705 PERFORM S004-YRQ THRU S004-EXIT DTSCS87 00706 MOVE L004-QTR-3-YR TO MAP-AUDITED-START-YR DTSCS87 00707 MOVE L004-QTR-3-Q TO MAP-AUDITED-START-Q. DTSCS87 00708 SKIP1 DTSCS87 00709 MOVE FSEL-ACTIVE-AUDIT-PERIOD-IND TO MAP-ACTIVE-PERIOD-IND. DTSCS87 00710 MOVE FSEL-ACTIVE-CURRENT-IND TO MAP-ACTIVE-CURR-IND. DTSCS87 00711 SKIP1 DTSCS87 00712 MOVE FSEL-START-SIC-CD TO MAP-START-SIC-CD. DTSCS87 00713 MOVE FSEL-END-SIC-CD TO MAP-END-SIC-CD. DTSCS87 00714 SKIP1 DTSCS87 00715 MOVE FSEL-START-NAICS-CD TO MAP-START-NAICS-CD. DTSCS87 00716 MOVE FSEL-END-NAICS-CD TO MAP-END-NAICS-CD. DTSCS87 00717 SKIP1 DTSCS87 00718 MOVE FSEL-FLD-ZIP-TERRITORY-IND TO MAP-FLD-ZIP-DC-IND. DTSCS87 00719 SKIP1 DTSCS87 00720 MOVE FSEL-FLD-ZIP-START TO MAP-FLD-ZIP-START. DTSCS87 00721 MOVE FSEL-FLD-ZIP-END TO MAP-FLD-ZIP-END. DTSCS87 00722 SKIP1 DTSCS87 00723 IF FSEL-INIT-LIAB-END-DATE NOT = +0 DTSCS87 00724 MOVE FSEL-INIT-LIAB-START-DATE TO L001-FED-8-DATE-9 DTSCS87 00725 PERFORM S001-DATE THRU S001-EXIT DTSCS87 00726 MOVE L001-CAL-6-MO TO MAP-LIAB-START-MM DTSCS87 00727 MOVE L001-CAL-6-DA TO MAP-LIAB-START-DD DTSCS87 00728 MOVE L001-CAL-6-YR TO MAP-LIAB-START-YY DTSCS87 00729 MOVE FSEL-INIT-LIAB-END-DATE TO L001-FED-8-DATE-9 DTSCS87 00730 PERFORM S001-DATE THRU S001-EXIT DTSCS87 00731 MOVE L001-CAL-6-MO TO MAP-LIAB-END-MM DTSCS87 00732 MOVE L001-CAL-6-DA TO MAP-LIAB-END-DD DTSCS87 00733 MOVE L001-CAL-6-YR TO MAP-LIAB-END-YY. DTSCS87 00734 SKIP1 DTSCS87 00735 IF FSEL-TOT-WAGE-END-AMT NOT = -1 DTSCS87 00736 MOVE FSEL-TOT-WAGE-START-AMT TO MAP-WAGE-START-AMT-N DTSCS87 00737 MOVE FSEL-TOT-WAGE-END-AMT TO MAP-WAGE-END-AMT-N. DTSCS87 00738 SKIP1 DTSCS87 00739 IF FSEL-TOT-WAGE-DECR-END-YRQ NOT = +0 DTSCS87 00740 MOVE FSEL-TOT-WAGE-DECR-START-YRQ TO L004-QTR-5-9 DTSCS87 00741 PERFORM S004-YRQ THRU S004-EXIT DTSCS87 00742 MOVE L004-QTR-3-YR TO MAP-DECR-START-YR DTSCS87 00743 MOVE L004-QTR-3-Q TO MAP-DECR-START-Q DTSCS87 00744 MOVE FSEL-TOT-WAGE-DECR-END-YRQ TO L004-QTR-5-9 DTSCS87 00745 PERFORM S004-YRQ THRU S004-EXIT DTSCS87 00746 MOVE L004-QTR-3-YR TO MAP-DECR-END-YR DTSCS87 00747 MOVE L004-QTR-3-Q TO MAP-DECR-END-Q DTSCS87 00748 MOVE FSEL-TOT-WAGE-START-RATIO TO L056-RATE DTSCS87 00749 PERFORM S056-DISP-RATE THRU S056-EXIT DTSCS87 00750 MOVE L056-DISP-RATE TO MAP-WAGE-START-RATIO DTSCS87 00751 MOVE FSEL-TOT-WAGE-END-RATIO TO L056-RATE DTSCS87 00752 PERFORM S056-DISP-RATE THRU S056-EXIT DTSCS87 00753 MOVE L056-DISP-RATE TO MAP-WAGE-END-RATIO. DTSCS87 00754 SKIP1 DTSCS87 00755 IF FSEL-TOT-WAGE-CHNG-END-YRQ NOT = +0 DTSCS87 00756 MOVE FSEL-TOT-WAGE-CHNG-START-YRQ TO L004-QTR-5-9 DTSCS87 00757 PERFORM S004-YRQ THRU S004-EXIT DTSCS87 00758 MOVE L004-QTR-3-YR TO MAP-CHNG-START-YR DTSCS87 00759 MOVE L004-QTR-3-Q TO MAP-CHNG-START-Q DTSCS87 00760 MOVE FSEL-TOT-WAGE-CHNG-END-YRQ TO L004-QTR-5-9 DTSCS87 00761 PERFORM S004-YRQ THRU S004-EXIT DTSCS87 00762 MOVE L004-QTR-3-YR TO MAP-CHNG-END-YR DTSCS87 00763 MOVE L004-QTR-3-Q TO MAP-CHNG-END-Q DTSCS87 00764 MOVE FSEL-TOT-WAGE-CHNG-TRIGGER-CNT DTSCS87 00765 TO MAP-WAGE-CHNG-TRIG. DTSCS87 00766 SKIP1 DTSCS87 00767 IF FSEL-UI-RATE-MIN NOT = +0 DTSCS87 00768 MOVE FSEL-UI-RATE-MIN TO L056-RATE DTSCS87 00769 PERFORM S056-DISP-RATE THRU S056-EXIT DTSCS87 00770 MOVE L056-DISP-RATE TO MAP-UI-RATE-MIN. DTSCS87 00771 P6910-EXIT. DTSCS87 00772 EXIT. DTSCS87 00773 /*****************************************************************DTSCS87 00774 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS87 00775 ******************************************************************DTSCS87 00776 SKIP1 DTSCS87 00777 P7000-REQUEST-EDIT. DTSCS87 00778 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS87 00779 SKIP1 DTSCS87 00780 IF LCCM-F09-88 DTSCS87 00781 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS87 00782 ELSE DTSCS87 00783 IF LCCM-F10-88 DTSCS87 00784 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS87 00785 ELSE DTSCS87 00786 IF LCCM-F23-88 DTSCS87 00787 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS87 00788 ELSE DTSCS87 00789 GO TO S899-ABEND. DTSCS87 00790 SKIP3 DTSCS87 00791 *------------------------------------------------------ DTSCS87 00792 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS87 00793 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS87 00794 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS87 00795 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS87 00796 *------------------------------------------------------ DTSCS87 00797 SKIP1 DTSCS87 00798 IF LCCM-MSG DTSCS87 00799 NEXT SENTENCE DTSCS87 00800 ELSE DTSCS87 00801 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS87 00802 IF LCCM-F09-88 DTSCS87 00803 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS87 00804 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS87 00805 ELSE DTSCS87 00806 IF LCCM-F10-88 DTSCS87 00807 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS87 00808 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS87 00809 ELSE DTSCS87 00810 IF LCCM-F23-88 DTSCS87 00811 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS87 00812 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA. DTSCS87 00813 SKIP1 DTSCS87 00814 SET RESP-SEND-MAP TO TRUE. DTSCS87 00815 P7000-EXIT. DTSCS87 00816 EXIT. DTSCS87 00817 /*****************************************************************DTSCS87 00818 * ADD FUNCTION WAS REQUESTED *DTSCS87 00819 ******************************************************************DTSCS87 00820 SKIP1 DTSCS87 00821 P7100-EDIT-ADD. DTSCS87 00822 *------------------------------------------------------ DTSCS87 00823 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS87 00824 *------------------------------------------------------ DTSCS87 00825 IF NOT LCCM-SCR-CLEAR DTSCS87 00826 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-AREA DTSCS87 00827 GO TO P7100-EXIT. DTSCS87 00828 SKIP1 DTSCS87 00829 PERFORM S8010-READ-FSEL THRU S8010-EXIT. DTSCS87 00830 IF L831-OK-88 DTSCS87 00831 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS87 00832 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT DTSCS87 00833 ELSE DTSCS87 00834 PERFORM S1000-SCREEN-DATA-EDITS THRU S1000-EXIT. DTSCS87 00835 P7100-EXIT. DTSCS87 00836 EXIT. DTSCS87 00837 /*****************************************************************DTSCS87 00838 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS87 00839 ******************************************************************DTSCS87 00840 SKIP1 DTSCS87 00841 P7200-EDIT-MOD. DTSCS87 00842 *----------------------------------------------------- DTSCS87 00843 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS87 00844 * INQUIRED DTSCS87 00845 *----------------------------------------------------- DTSCS87 00846 IF NOT LCCM-SCR-INQUIRE DTSCS87 00847 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS87 00848 GO TO P7200-EXIT. DTSCS87 00849 SKIP3 DTSCS87 00850 PERFORM S8010-READ-FSEL THRU S8010-EXIT. DTSCS87 00851 IF L831-NO-REC-88 DTSCS87 00852 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS87 00853 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT DTSCS87 00854 ELSE DTSCS87 00855 PERFORM S1000-SCREEN-DATA-EDITS THRU S1000-EXIT. DTSCS87 00856 P7200-EXIT. DTSCS87 00857 EXIT. DTSCS87 00858 /*****************************************************************DTSCS87 00859 * DELETE FUNCTION WAS REQUESTED *DTSCS87 00860 ******************************************************************DTSCS87 00861 SKIP1 DTSCS87 00862 P7300-EDIT-DEL. DTSCS87 00863 *----------------------------------------------------- DTSCS87 00864 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS87 00865 * INQUIRED DTSCS87 00866 *----------------------------------------------------- DTSCS87 00867 IF NOT LCCM-SCR-INQUIRE DTSCS87 00868 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-AREA DTSCS87 00869 GO TO P7300-EXIT. DTSCS87 00870 SKIP3 DTSCS87 00871 PERFORM S8010-READ-FSEL THRU S8010-EXIT. DTSCS87 00872 IF L831-NO-REC-88 DTSCS87 00873 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS87 00874 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT. DTSCS87 00875 P7300-EXIT. DTSCS87 00876 EXIT. DTSCS87 00877 /*****************************************************************DTSCS87 00878 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS87 00879 ******************************************************************DTSCS87 00880 SKIP1 DTSCS87 00881 P8000-REQUEST-UPDATE. DTSCS87 00882 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS87 00883 SKIP1 DTSCS87 00884 IF LCCM-SCR-ADD-LOCKED DTSCS87 00885 PERFORM P8100-ADD THRU P8100-EXIT DTSCS87 00886 ELSE DTSCS87 00887 IF LCCM-SCR-MOD-LOCKED DTSCS87 00888 PERFORM P8200-MOD THRU P8200-EXIT DTSCS87 00889 ELSE DTSCS87 00890 IF LCCM-SCR-DEL-LOCKED DTSCS87 00891 PERFORM P8300-DEL THRU P8300-EXIT DTSCS87 00892 ELSE DTSCS87 00893 GO TO S899-ABEND. DTSCS87 00894 SKIP1 DTSCS87 00895 SET RESP-SEND-MAP TO TRUE. DTSCS87 00896 P8000-EXIT. DTSCS87 00897 EXIT. DTSCS87 00898 /*****************************************************************DTSCS87 00899 * *DTSCS87 00900 ******************************************************************DTSCS87 00901 SKIP1 DTSCS87 00902 P8100-ADD. DTSCS87 00903 SET LCCM-SCR-CLEAR TO TRUE. DTSCS87 00904 SKIP1 DTSCS87 00905 IF LCCM-F12-88 DTSCS87 00906 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-AREA DTSCS87 00907 GO TO P8100-EXIT. DTSCS87 00908 SKIP1 DTSCS87 00909 PERFORM S8010-READ-FSEL THRU S8010-EXIT. DTSCS87 00910 IF L831-OK-88 DTSCS87 00911 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS87 00912 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT DTSCS87 00913 GO TO P8100-EXIT. DTSCS87 00914 SKIP1 DTSCS87 00915 MOVE LOW-VALUES TO FSEL-DATA-AREA. DTSCS87 00916 SKIP1 DTSCS87 00917 PERFORM P8900-CONSTRUCT-FSEL THRU P8900-EXIT. DTSCS87 00918 SKIP1 DTSCS87 00919 MOVE LCCM-CURR-RUN-DATE TO FSEL-CHNG-DATE. DTSCS87 00920 SKIP1 DTSCS87 00921 PERFORM S831-WRITE THRU S831-EXIT. DTSCS87 00922 SKIP1 DTSCS87 00923 MOVE LOW-VALUES TO MAP-AREA. DTSCS87 00924 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS87 00925 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS87 00926 P8100-EXIT. DTSCS87 00927 EXIT. DTSCS87 00928 /*****************************************************************DTSCS87 00929 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS87 00930 ******************************************************************DTSCS87 00931 SKIP1 DTSCS87 00932 P8200-MOD. DTSCS87 00933 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS87 00934 SKIP1 DTSCS87 00935 IF LCCM-F12-88 DTSCS87 00936 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS87 00937 GO TO P8200-EXIT. DTSCS87 00938 SKIP1 DTSCS87 00939 PERFORM S8010-READ-FSEL THRU S8010-EXIT. DTSCS87 00940 IF L831-NO-REC-88 DTSCS87 00941 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS87 00942 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT DTSCS87 00943 GO TO P8200-EXIT. DTSCS87 00944 SKIP1 DTSCS87 00945 PERFORM P8900-CONSTRUCT-FSEL THRU P8900-EXIT. DTSCS87 00946 SKIP1 DTSCS87 00947 MOVE LCCM-CURR-RUN-DATE TO FSEL-CHNG-DATE. DTSCS87 00948 SKIP1 DTSCS87 00949 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS87 00950 SKIP1 DTSCS87 00951 MOVE FSEL-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS87 00952 SET L001-FROM-FED-8 TO TRUE. DTSCS87 00953 PERFORM S001-DATE THRU S001-EXIT. DTSCS87 00954 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS87 00955 SKIP1 DTSCS87 00956 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS87 00957 P8200-EXIT. DTSCS87 00958 EXIT. DTSCS87 00959 /*****************************************************************DTSCS87 00960 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS87 00961 ******************************************************************DTSCS87 00962 SKIP1 DTSCS87 00963 P8300-DEL. DTSCS87 00964 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS87 00965 SKIP1 DTSCS87 00966 IF LCCM-F12-88 DTSCS87 00967 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-AREA DTSCS87 00968 GO TO P8300-EXIT. DTSCS87 00969 SKIP1 DTSCS87 00970 PERFORM S8010-READ-FSEL THRU S8010-EXIT. DTSCS87 00971 IF NOT L831-OK-88 DTSCS87 00972 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS87 00973 PERFORM S1001-NON-FIELD-ERROR THRU S1001-EXIT DTSCS87 00974 GO TO P8300-EXIT. DTSCS87 00975 SKIP1 DTSCS87 00976 PERFORM S831-DELETE THRU S831-EXIT. DTSCS87 00977 SKIP1 DTSCS87 00978 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS87 00979 SET LCCM-SCR-CLEAR TO TRUE. DTSCS87 00980 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS87 00981 SKIP1 DTSCS87 00982 MOVE LOW-VALUES TO MAP-AREA. DTSCS87 00983 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS87 00984 SKIP1 DTSCS87 00985 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS87 00986 P8300-EXIT. DTSCS87 00987 EXIT. DTSCS87 00988 /*****************************************************************DTSCS87 00989 * MOVE ALL NON-KEY SCREEN FIELDS TO FILE RECORD LAYOUT *DTSCS87 00990 ******************************************************************DTSCS87 00991 SKIP1 DTSCS87 00992 P8900-CONSTRUCT-FSEL. DTSCS87 00993 SKIP1 DTSCS87 00994 MOVE +0 TO L011-MIN-AMT. DTSCS87 00995 MOVE +999999999.99 TO L011-MAX-AMT. DTSCS87 00996 MOVE +0 TO L013-MIN-CNT. DTSCS87 00997 MOVE +999 TO L013-MAX-CNT. DTSCS87 00998 SKIP3 DTSCS87 00999 MOVE MAP-AUDIT-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01000 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01001 IF L016-VALID DTSCS87 01002 MOVE L016-YRQ TO FSEL-AUDIT-START-YRQ DTSCS87 01003 ELSE DTSCS87 01004 GO TO S899-ABEND. DTSCS87 01005 MOVE MAP-AUDIT-END-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01006 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01007 IF L016-VALID DTSCS87 01008 MOVE L016-YRQ TO FSEL-AUDIT-END-YRQ DTSCS87 01009 ELSE DTSCS87 01010 GO TO S899-ABEND. DTSCS87 01011 SKIP1 DTSCS87 01012 MOVE MAP-SMALL-EMP-LIST-CNT-AREA TO L013-S-CNT-AREA. DTSCS87 01013 PERFORM S013-SCREEN-COUNT THRU S013-EXIT. DTSCS87 01014 MOVE L013-CNT TO FSEL-SMALL-EMP-LIST-CNT. DTSCS87 01015 MOVE MAP-LARGE-EMP-LIST-CNT-AREA TO L013-S-CNT-AREA. DTSCS87 01016 PERFORM S013-SCREEN-COUNT THRU S013-EXIT. DTSCS87 01017 MOVE L013-CNT TO FSEL-LARGE-EMP-LIST-CNT. DTSCS87 01018 SKIP1 DTSCS87 01019 MOVE MAP-LARGE-EMP-DEFIN TO FSEL-LARGE-EMP-DEFINITION-IND. DTSCS87 01020 SKIP1 DTSCS87 01021 MOVE MAP-RANDOM-IND TO FSEL-RANDOM-IND. DTSCS87 01022 IF MAP-TARGET-IND NOT = 'Y' DTSCS87 01023 MOVE 'N' TO FSEL-TARGET-IND DTSCS87 01024 ELSE DTSCS87 01025 MOVE MAP-TARGET-IND TO FSEL-TARGET-IND. DTSCS87 01026 SKIP1 DTSCS87 01027 PERFORM VARYING MAP-IDX FROM 1 BY 1 DTSCS87 01028 UNTIL MAP-IDX > FMAX-SEL-FLD-REP-ID-MAX DTSCS87 01029 INSPECT MAP-FLD-REP-ID (MAP-IDX) DTSCS87 01030 CONVERTING LOW-VALUE TO SPACE DTSCS87 01031 SET FSEL-FLD-REP-IDX TO MAP-IDX DTSCS87 01032 MOVE MAP-FLD-REP-ID (MAP-IDX) DTSCS87 01033 TO FSEL-FLD-REP-ID (FSEL-FLD-REP-IDX) DTSCS87 01034 END-PERFORM. DTSCS87 01035 SKIP1 DTSCS87 01036 MOVE MAP-AUDITED-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01037 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01038 MOVE L016-YRQ TO FSEL-AUDITED-START-YRQ. DTSCS87 01039 SKIP1 DTSCS87 01040 MOVE MAP-ACTIVE-PERIOD-IND TO FSEL-ACTIVE-AUDIT-PERIOD-IND. DTSCS87 01041 MOVE MAP-ACTIVE-CURR-IND TO FSEL-ACTIVE-CURRENT-IND. DTSCS87 01042 SKIP1 DTSCS87 01043 INSPECT MAP-START-SIC-CD CONVERTING LOW-VALUE TO SPACE. DTSCS87 01044 MOVE MAP-START-SIC-CD TO FSEL-START-SIC-CD. DTSCS87 01045 SKIP1 DTSCS87 01046 INSPECT MAP-END-SIC-CD CONVERTING LOW-VALUE TO SPACE. DTSCS87 01047 MOVE MAP-END-SIC-CD TO FSEL-END-SIC-CD. DTSCS87 01048 SKIP1 DTSCS87 01049 INSPECT MAP-START-NAICS-CD CONVERTING LOW-VALUE TO SPACE. DTSCS87 01050 MOVE MAP-START-NAICS-CD TO FSEL-START-NAICS-CD. DTSCS87 01051 SKIP1 DTSCS87 01052 INSPECT MAP-END-NAICS-CD CONVERTING LOW-VALUE TO SPACE. DTSCS87 01053 MOVE MAP-END-NAICS-CD TO FSEL-END-NAICS-CD. DTSCS87 01054 SKIP1 DTSCS87 01055 MOVE MAP-FLD-ZIP-DC-IND TO FSEL-FLD-ZIP-TERRITORY-IND. DTSCS87 01056 SKIP1 DTSCS87 01057 INSPECT MAP-FLD-ZIP-START CONVERTING LOW-VALUE TO SPACE. DTSCS87 01058 MOVE MAP-FLD-ZIP-START TO FSEL-FLD-ZIP-START. DTSCS87 01059 SKIP1 DTSCS87 01060 INSPECT MAP-FLD-ZIP-END CONVERTING LOW-VALUE TO SPACE. DTSCS87 01061 MOVE MAP-FLD-ZIP-END TO FSEL-FLD-ZIP-END. DTSCS87 01062 SKIP1 DTSCS87 01063 MOVE MAP-LIAB-START-AREA TO L015-S-DATE-AREA. DTSCS87 01064 PERFORM S015-SCREEN-DATE THRU S015-EXIT. DTSCS87 01065 MOVE L015-DATE TO FSEL-INIT-LIAB-START-DATE. DTSCS87 01066 MOVE MAP-LIAB-END-AREA TO L015-S-DATE-AREA. DTSCS87 01067 PERFORM S015-SCREEN-DATE THRU S015-EXIT. DTSCS87 01068 MOVE L015-DATE TO FSEL-INIT-LIAB-END-DATE. DTSCS87 01069 SKIP1 DTSCS87 01070 MOVE MAP-WAGE-START-AMT-AREA TO L011-S-AMT-AREA. DTSCS87 01071 PERFORM S011-SCREEN-AMT THRU S011-EXIT. DTSCS87 01072 MOVE L011-AMT TO FSEL-TOT-WAGE-START-AMT. DTSCS87 01073 MOVE MAP-WAGE-END-AMT-AREA TO L011-S-AMT-AREA. DTSCS87 01074 PERFORM S011-SCREEN-AMT THRU S011-EXIT. DTSCS87 01075 IF L011-NO-ENTRY DTSCS87 01076 MOVE -1 TO FSEL-TOT-WAGE-END-AMT DTSCS87 01077 ELSE DTSCS87 01078 MOVE L011-AMT TO FSEL-TOT-WAGE-END-AMT. DTSCS87 01079 SKIP1 DTSCS87 01080 MOVE MAP-DECR-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01081 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01082 MOVE L016-YRQ TO FSEL-TOT-WAGE-DECR-START-YRQ. DTSCS87 01083 MOVE MAP-DECR-END-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01084 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01085 MOVE L016-YRQ TO FSEL-TOT-WAGE-DECR-END-YRQ. DTSCS87 01086 SKIP1 DTSCS87 01087 MOVE MAP-WAGE-START-RATIO-AREA TO L012-S-RATE-AREA. DTSCS87 01088 PERFORM S012-SCREEN-RATE THRU S012-EXIT. DTSCS87 01089 MOVE L012-RATE TO FSEL-TOT-WAGE-START-RATIO. DTSCS87 01090 MOVE MAP-WAGE-END-RATIO-AREA TO L012-S-RATE-AREA. DTSCS87 01091 PERFORM S012-SCREEN-RATE THRU S012-EXIT. DTSCS87 01092 MOVE L012-RATE TO FSEL-TOT-WAGE-END-RATIO. DTSCS87 01093 SKIP1 DTSCS87 01094 MOVE MAP-CHNG-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01095 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01096 MOVE L016-YRQ TO FSEL-TOT-WAGE-CHNG-START-YRQ. DTSCS87 01097 MOVE MAP-CHNG-END-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01098 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01099 MOVE L016-YRQ TO FSEL-TOT-WAGE-CHNG-END-YRQ. DTSCS87 01100 SKIP1 DTSCS87 01101 MOVE MAP-WAGE-CHNG-TRIG-AREA TO L013-S-CNT-AREA. DTSCS87 01102 PERFORM S013-SCREEN-COUNT THRU S013-EXIT. DTSCS87 01103 MOVE L013-CNT TO FSEL-TOT-WAGE-CHNG-TRIGGER-CNT. DTSCS87 01104 SKIP1 DTSCS87 01105 MOVE MAP-UI-RATE-MIN-AREA TO L012-S-RATE-AREA. DTSCS87 01106 PERFORM S012-SCREEN-RATE THRU S012-EXIT. DTSCS87 01107 MOVE L012-RATE TO FSEL-UI-RATE-MIN. DTSCS87 01108 P8900-EXIT. DTSCS87 01109 EXIT. DTSCS87 01110 /*****************************************************************DTSCS87 01111 * LINKS TO UTILITY MODULES DTSCS87 01112 ******************************************************************DTSCS87 01113 SKIP1 DTSCS87 01114 S001-DATE. DTSCS87 01115 EXEC CICS LINK DTSCS87 01116 PROGRAM ('DTSCU001') DTSCS87 01117 COMMAREA (L001-COMM-AREA) DTSCS87 01118 END-EXEC. DTSCS87 01119 S001-EXIT. DTSCS87 01120 EXIT. DTSCS87 01121 SKIP3 DTSCS87 01122 S004-YRQ. DTSCS87 01123 EXEC CICS LINK DTSCS87 01124 PROGRAM ('DTSCU004') DTSCS87 01125 COMMAREA (L004-COMM-AREA) DTSCS87 01126 END-EXEC. DTSCS87 01127 S004-EXIT. DTSCS87 01128 EXIT. DTSCS87 01129 SKIP3 DTSCS87 01130 S011-SCREEN-AMT. DTSCS87 01131 EXEC CICS LINK DTSCS87 01132 PROGRAM ('DTSCU011') DTSCS87 01133 COMMAREA (L011-COMM-AREA) DTSCS87 01134 END-EXEC. DTSCS87 01135 S011-EXIT. DTSCS87 01136 EXIT. DTSCS87 01137 SKIP3 DTSCS87 01138 S012-SCREEN-RATE. DTSCS87 01139 EXEC CICS LINK DTSCS87 01140 PROGRAM ('DTSCU012') DTSCS87 01141 COMMAREA (L012-COMM-AREA) DTSCS87 01142 END-EXEC. DTSCS87 01143 S012-EXIT. DTSCS87 01144 EXIT. DTSCS87 01145 SKIP3 DTSCS87 01146 S013-SCREEN-COUNT. DTSCS87 01147 EXEC CICS LINK DTSCS87 01148 PROGRAM ('DTSCU013') DTSCS87 01149 COMMAREA (L013-COMM-AREA) DTSCS87 01150 END-EXEC. DTSCS87 01151 S013-EXIT. DTSCS87 01152 EXIT. DTSCS87 01153 SKIP3 DTSCS87 01154 S015-SCREEN-DATE. DTSCS87 01155 EXEC CICS LINK DTSCS87 01156 PROGRAM ('DTSCU015') DTSCS87 01157 COMMAREA (L015-COMM-AREA) DTSCS87 01158 END-EXEC. DTSCS87 01159 S015-EXIT. DTSCS87 01160 EXIT. DTSCS87 01161 SKIP3 DTSCS87 01162 S016-SCREEN-YRQ. DTSCS87 01163 EXEC CICS LINK DTSCS87 01164 PROGRAM ('DTSCU016') DTSCS87 01165 COMMAREA (L016-COMM-AREA) DTSCS87 01166 END-EXEC. DTSCS87 01167 S016-EXIT. DTSCS87 01168 EXIT. DTSCS87 01169 SKIP3 DTSCS87 01170 S024-SCREEN-YRQ-RANGE. DTSCS87 01171 EXEC CICS LINK DTSCS87 01172 PROGRAM ('DTSCU024') DTSCS87 01173 COMMAREA (L024-COMM-AREA) DTSCS87 01174 END-EXEC. DTSCS87 01175 S024-EXIT. DTSCS87 01176 EXIT. DTSCS87 01177 SKIP3 DTSCS87 01178 S056-DISP-RATE. DTSCS87 01179 EXEC CICS LINK DTSCS87 01180 PROGRAM ('DTSCU056') DTSCS87 01181 COMMAREA (L056-COMM-AREA) DTSCS87 01182 END-EXEC. DTSCS87 01183 S056-EXIT. DTSCS87 01184 EXIT. DTSCS87 01185 SKIP3 DTSCS87 01186 S062-REP-ID. DTSCS87 01187 EXEC CICS LINK DTSCS87 01188 PROGRAM ('DTSCU062') DTSCS87 01189 COMMAREA (L062-COMM-AREA) DTSCS87 01190 END-EXEC. DTSCS87 01191 SKIP1 DTSCS87 01192 IF L062-FILE-CLOSED DTSCS87 01193 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01194 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS87 01195 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS87 01196 GO TO MAINLINE-EXIT. DTSCS87 01197 S062-EXIT. DTSCS87 01198 EXIT. DTSCS87 01199 EJECT DTSCS87 01200 S803-REQ-SCR-ID-EDIT. DTSCS87 01201 EXEC CICS LINK DTSCS87 01202 PROGRAM ('DTSCU803') DTSCS87 01203 COMMAREA (DFHCOMMAREA) DTSCS87 01204 END-EXEC. DTSCS87 01205 S803-EXIT. DTSCS87 01206 EXIT. DTSCS87 01207 SKIP3 DTSCS87 01208 S804-INVALID-KEY. DTSCS87 01209 EXEC CICS LINK DTSCS87 01210 PROGRAM ('DTSCU804') DTSCS87 01211 COMMAREA (DFHCOMMAREA) DTSCS87 01212 END-EXEC. DTSCS87 01213 S804-EXIT. DTSCS87 01214 EXIT. DTSCS87 01215 SKIP3 DTSCS87 01216 S805-MSG-AREA. DTSCS87 01217 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS87 01218 SKIP1 DTSCS87 01219 EXEC CICS LINK DTSCS87 01220 PROGRAM ('DTSCU805') DTSCS87 01221 COMMAREA (L805-COMM-AREA) DTSCS87 01222 END-EXEC. DTSCS87 01223 SKIP1 DTSCS87 01224 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS87 01225 S805-EXIT. DTSCS87 01226 EXIT. DTSCS87 01227 EJECT DTSCS87 01228 S831-READ. DTSCS87 01229 SET L831-READ-88 TO TRUE. DTSCS87 01230 GO TO S831-IO. DTSCS87 01231 SKIP1 DTSCS87 01232 S831-REWRITE. DTSCS87 01233 SET L831-REWRITE-88 TO TRUE. DTSCS87 01234 GO TO S831-IO. DTSCS87 01235 SKIP1 DTSCS87 01236 S831-WRITE. DTSCS87 01237 SET L831-WRITE-88 TO TRUE. DTSCS87 01238 GO TO S831-IO. DTSCS87 01239 SKIP1 DTSCS87 01240 S831-DELETE. DTSCS87 01241 SET L831-DELETE-88 TO TRUE. DTSCS87 01242 GO TO S831-IO. DTSCS87 01243 SKIP1 DTSCS87 01244 S831-IO. DTSCS87 01245 SKIP1 DTSCS87 01246 EXEC CICS LINK DTSCS87 01247 PROGRAM ('DTSCU831') DTSCS87 01248 COMMAREA (L831-COMM-AREA) DTSCS87 01249 END-EXEC. DTSCS87 01250 SKIP1 DTSCS87 01251 IF L831-FILE-CLOSED-88 DTSCS87 01252 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01253 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS87 01254 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS87 01255 GO TO MAINLINE-EXIT. DTSCS87 01256 S831-EXIT. DTSCS87 01257 EXIT. DTSCS87 01258 SKIP3 DTSCS87 01259 S851-SCREEN-PROCESSING. DTSCS87 01260 EXEC CICS LINK DTSCS87 01261 PROGRAM ('DTSCU851') DTSCS87 01262 COMMAREA (L851-COMM-AREA) DTSCS87 01263 END-EXEC. DTSCS87 01264 S851-EXIT. DTSCS87 01265 EXIT. DTSCS87 01266 SKIP3 DTSCS87 01267 S899-ABEND. DTSCS87 01268 EXEC CICS ABEND DTSCS87 01269 ABCODE(WRK-ABEND-CD) DTSCS87 01270 END-EXEC. DTSCS87 01271 *S899-EXIT. DTSCS87 01272 * EXIT. DTSCS87 01273 /*****************************************************************DTSCS87 01274 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS87 01275 ******************************************************************DTSCS87 01276 SKIP1 DTSCS87 01277 S1000-SCREEN-DATA-EDITS. DTSCS87 01278 SKIP1 DTSCS87 01279 PERFORM S1100-AUDIT-YRQ-RANGE THRU S1100-EXIT. DTSCS87 01280 PERFORM S1200-EMPS THRU S1200-EXIT. DTSCS87 01281 SKIP1 DTSCS87 01282 PERFORM S1300-RANDOM-IND THRU S1300-EXIT. DTSCS87 01283 IF MAP-RANDOM-IND = 'Y' DTSCS87 01284 SET FLD-REP-NOT-ENTERED TO TRUE DTSCS87 01285 PERFORM VARYING MAP-IDX FROM 1 BY 1 DTSCS87 01286 UNTIL MAP-IDX > FMAX-SEL-FLD-REP-ID-MAX DTSCS87 01287 IF MAP-FLD-REP-ID (MAP-IDX) NOT = SPACE DTSCS87 01288 AND MAP-FLD-REP-ID (MAP-IDX) NOT = LOW-VALUE DTSCS87 01289 SET FLD-REP-ENTERED TO TRUE DTSCS87 01290 END-IF DTSCS87 01291 END-PERFORM DTSCS87 01292 IF FLD-REP-NOT-ENTERED DTSCS87 01293 AND ( MAP-AUDITED-START-YR = SPACE OR LOW-VALUE ) DTSCS87 01294 AND ( MAP-AUDITED-START-Q = SPACE OR LOW-VALUE ) DTSCS87 01295 AND ( MAP-ACTIVE-PERIOD-IND = SPACE OR LOW-VALUE ) DTSCS87 01296 AND ( MAP-ACTIVE-CURR-IND = SPACE OR LOW-VALUE ) DTSCS87 01297 AND ( MAP-START-SIC-CD = SPACE OR LOW-VALUE ) DTSCS87 01298 AND ( MAP-END-SIC-CD = SPACE OR LOW-VALUE ) DTSCS87 01299 AND ( MAP-START-NAICS-CD = SPACE OR LOW-VALUE ) DTSCS87 01300 AND ( MAP-END-NAICS-CD = SPACE OR LOW-VALUE ) DTSCS87 01301 AND ( MAP-FLD-ZIP-DC-IND = SPACE OR LOW-VALUE ) DTSCS87 01302 AND ( MAP-FLD-ZIP-START = SPACE OR LOW-VALUE ) DTSCS87 01303 AND ( MAP-FLD-ZIP-END = SPACE OR LOW-VALUE ) DTSCS87 01304 AND ( MAP-LIAB-START-MM = SPACE OR LOW-VALUE ) DTSCS87 01305 AND ( MAP-LIAB-START-DD = SPACE OR LOW-VALUE ) DTSCS87 01306 AND ( MAP-LIAB-START-YY = SPACE OR LOW-VALUE ) DTSCS87 01307 AND ( MAP-LIAB-END-MM = SPACE OR LOW-VALUE ) DTSCS87 01308 AND ( MAP-LIAB-END-DD = SPACE OR LOW-VALUE ) DTSCS87 01309 AND ( MAP-LIAB-END-YY = SPACE OR LOW-VALUE ) DTSCS87 01310 AND ( MAP-WAGE-START-AMT = SPACE OR LOW-VALUE ) DTSCS87 01311 AND ( MAP-WAGE-END-AMT = SPACE OR LOW-VALUE ) DTSCS87 01312 AND ( MAP-DECR-START-YR = SPACE OR LOW-VALUE ) DTSCS87 01313 AND ( MAP-DECR-START-Q = SPACE OR LOW-VALUE ) DTSCS87 01314 AND ( MAP-DECR-END-YR = SPACE OR LOW-VALUE ) DTSCS87 01315 AND ( MAP-DECR-END-Q = SPACE OR LOW-VALUE ) DTSCS87 01316 AND ( MAP-WAGE-START-RATIO = SPACE OR LOW-VALUE ) DTSCS87 01317 AND ( MAP-WAGE-END-RATIO = SPACE OR LOW-VALUE ) DTSCS87 01318 AND ( MAP-CHNG-START-YR = SPACE OR LOW-VALUE ) DTSCS87 01319 AND ( MAP-CHNG-START-Q = SPACE OR LOW-VALUE ) DTSCS87 01320 AND ( MAP-CHNG-END-YR = SPACE OR LOW-VALUE ) DTSCS87 01321 AND ( MAP-CHNG-END-Q = SPACE OR LOW-VALUE ) DTSCS87 01322 AND ( MAP-WAGE-CHNG-TRIG = SPACE OR LOW-VALUE ) DTSCS87 01323 AND ( MAP-UI-RATE-MIN = SPACE OR LOW-VALUE ) DTSCS87 01324 NEXT SENTENCE DTSCS87 01325 ELSE DTSCS87 01326 MOVE MSG-E871-AREA TO WRK-MSG-AREA DTSCS87 01327 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS87 01328 SKIP1 DTSCS87 01329 PERFORM S1350-TARGET-IND THRU S1350-EXIT. DTSCS87 01330 PERFORM S1400-FIELD-REP-ID THRU S1400-EXIT DTSCS87 01331 VARYING MAP-IDX FROM 1 BY 1 DTSCS87 01332 UNTIL MAP-IDX > FMAX-SEL-FLD-REP-ID-MAX. DTSCS87 01333 PERFORM S1600-AUDITED-START-YRQ THRU S1600-EXIT. DTSCS87 01334 PERFORM S1700-ACTIVE THRU S1700-EXIT. DTSCS87 01335 PERFORM S1800-SIC-CODES THRU S1800-EXIT. DTSCS87 01336 PERFORM S1850-NAICS-CODES THRU S1850-EXIT. DTSCS87 01337 PERFORM S1900-DC THRU S1900-EXIT. DTSCS87 01338 PERFORM S2000-ZIP-CODES THRU S2000-EXIT. DTSCS87 01339 PERFORM S2100-LIABILITY THRU S2100-EXIT. DTSCS87 01340 PERFORM S2200-TOT-WAGES THRU S2200-EXIT. DTSCS87 01341 PERFORM S2300-TOT-WAGE-DECREASE THRU S2300-EXIT. DTSCS87 01342 PERFORM S2400-WAGE-CHANGE THRU S2400-EXIT. DTSCS87 01343 PERFORM S2500-UI-RATE THRU S2500-EXIT. DTSCS87 01344 SKIP1 DTSCS87 01345 S1000-EXIT. DTSCS87 01346 EXIT. DTSCS87 01347 SKIP3 DTSCS87 01348 S1001-NON-FIELD-ERROR. DTSCS87 01349 IF LCCM-NO-MSG DTSCS87 01350 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS87 01351 S1001-EXIT. DTSCS87 01352 EXIT. DTSCS87 01353 EJECT DTSCS87 01354 S1100-AUDIT-YRQ-RANGE. DTSCS87 01355 MOVE MAP-AUDIT-YRQ-RANGE-AREA TO L024-S-YRQ-RANGE-AREA. DTSCS87 01356 SET L024-END-REQUIRED TO TRUE. DTSCS87 01357 PERFORM S024-SCREEN-YRQ-RANGE THRU S024-EXIT. DTSCS87 01358 SKIP1 DTSCS87 01359 IF L024-END-BEFORE-START DTSCS87 01360 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01361 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS87 01362 PERFORM S1102-ERROR THRU S1102-EXIT DTSCS87 01363 GO TO S1100-EXIT. DTSCS87 01364 SKIP1 DTSCS87 01365 IF L024-START-NO-ENTRY DTSCS87 01366 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01367 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS87 01368 ELSE DTSCS87 01369 IF (L024-START-NOT-VALID) DTSCS87 01370 OR DTSCS87 01371 (L024-START-YRQ <= LCCM-PICKUP-YRQ) DTSCS87 01372 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01373 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS87 01374 SKIP1 DTSCS87 01375 IF L024-END-NO-ENTRY DTSCS87 01376 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01377 PERFORM S1102-ERROR THRU S1102-EXIT DTSCS87 01378 ELSE DTSCS87 01379 IF L024-END-NOT-VALID DTSCS87 01380 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01381 PERFORM S1102-ERROR THRU S1102-EXIT. DTSCS87 01382 SKIP1 DTSCS87 01383 IF L024-QTRS-SPANNED > +20 DTSCS87 01384 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS87 01385 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS87 01386 PERFORM S1102-ERROR THRU S1102-EXIT. DTSCS87 01387 S1100-EXIT. DTSCS87 01388 EXIT. DTSCS87 01389 SKIP3 DTSCS87 01390 S1101-ERROR. DTSCS87 01391 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-START-YR-A DTSCS87 01392 MAP-AUDIT-START-Q-A. DTSCS87 01393 IF LCCM-NO-MSG DTSCS87 01394 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01395 MOVE CATB-CURSOR TO MAP-AUDIT-START-YR-L DTSCS87 01396 SET CURSOR-SET-YES TO TRUE. DTSCS87 01397 S1101-EXIT. DTSCS87 01398 EXIT. DTSCS87 01399 SKIP3 DTSCS87 01400 S1102-ERROR. DTSCS87 01401 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDIT-END-YR-A DTSCS87 01402 MAP-AUDIT-END-Q-A. DTSCS87 01403 IF LCCM-NO-MSG DTSCS87 01404 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01405 MOVE CATB-CURSOR TO MAP-AUDIT-END-YR-L DTSCS87 01406 SET CURSOR-SET-YES TO TRUE. DTSCS87 01407 S1102-EXIT. DTSCS87 01408 EXIT. DTSCS87 01409 EJECT DTSCS87 01410 S1200-EMPS. DTSCS87 01411 SET START-CLEAR TO TRUE. DTSCS87 01412 MOVE +0 TO L013-MIN-CNT. DTSCS87 01413 MOVE +999 TO L013-MAX-CNT. DTSCS87 01414 SKIP1 DTSCS87 01415 MOVE MAP-SMALL-EMP-LIST-CNT-AREA TO L013-S-CNT-AREA. DTSCS87 01416 PERFORM S013-SCREEN-COUNT THRU S013-EXIT. DTSCS87 01417 IF L013-VALID DTSCS87 01418 MOVE L013-CNT TO MAP-SMALL-EMP-LIST-CNT-N. DTSCS87 01419 SKIP1 DTSCS87 01420 IF L013-INVALID-NEGATIVE DTSCS87 01421 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS87 01422 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS87 01423 ELSE DTSCS87 01424 IF L013-EXCEEDS-MIN-MAX DTSCS87 01425 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS87 01426 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS87 01427 ELSE DTSCS87 01428 IF L013-NOT-VALID DTSCS87 01429 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01430 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS87 01431 ELSE DTSCS87 01432 IF L013-CNT = 0 DTSCS87 01433 SET START-NO-ENTRY TO TRUE. DTSCS87 01434 SKIP1 DTSCS87 01435 MOVE MAP-LARGE-EMP-LIST-CNT-AREA TO L013-S-CNT-AREA. DTSCS87 01436 PERFORM S013-SCREEN-COUNT THRU S013-EXIT. DTSCS87 01437 IF L013-VALID DTSCS87 01438 MOVE L013-CNT TO MAP-LARGE-EMP-LIST-CNT-N. DTSCS87 01439 SKIP1 DTSCS87 01440 IF L013-INVALID-NEGATIVE DTSCS87 01441 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS87 01442 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS87 01443 ELSE DTSCS87 01444 IF L013-EXCEEDS-MIN-MAX DTSCS87 01445 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS87 01446 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS87 01447 ELSE DTSCS87 01448 IF L013-NOT-VALID DTSCS87 01449 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01450 PERFORM S1202-ERROR THRU S1202-EXIT DTSCS87 01451 ELSE DTSCS87 01452 IF L013-CNT = 0 DTSCS87 01453 AND START-NO-ENTRY DTSCS87 01454 * MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS87 01455 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS87 01456 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS87 01457 PERFORM S1202-ERROR THRU S1202-EXIT. DTSCS87 01458 SKIP1 DTSCS87 01459 IF MAP-LARGE-EMP-DEFIN = 'T' OR 'E' DTSCS87 01460 NEXT SENTENCE DTSCS87 01461 ELSE DTSCS87 01462 IF MAP-LARGE-EMP-DEFIN = SPACE OR LOW-VALUE DTSCS87 01463 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01464 PERFORM S1203-ERROR THRU S1203-EXIT DTSCS87 01465 ELSE DTSCS87 01466 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01467 PERFORM S1203-ERROR THRU S1203-EXIT. DTSCS87 01468 S1200-EXIT. DTSCS87 01469 EXIT. DTSCS87 01470 SKIP3 DTSCS87 01471 S1201-ERROR. DTSCS87 01472 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SMALL-EMP-LIST-CNT-A. DTSCS87 01473 IF LCCM-NO-MSG DTSCS87 01474 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01475 MOVE CATB-CURSOR TO MAP-SMALL-EMP-LIST-CNT-L DTSCS87 01476 SET CURSOR-SET-YES TO TRUE. DTSCS87 01477 S1201-EXIT. DTSCS87 01478 EXIT. DTSCS87 01479 SKIP3 DTSCS87 01480 S1202-ERROR. DTSCS87 01481 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LARGE-EMP-LIST-CNT-A. DTSCS87 01482 IF LCCM-NO-MSG DTSCS87 01483 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01484 MOVE CATB-CURSOR TO MAP-LARGE-EMP-LIST-CNT-L DTSCS87 01485 SET CURSOR-SET-YES TO TRUE. DTSCS87 01486 S1202-EXIT. DTSCS87 01487 EXIT. DTSCS87 01488 SKIP3 DTSCS87 01489 S1203-ERROR. DTSCS87 01490 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LARGE-EMP-DEFIN-A. DTSCS87 01491 IF LCCM-NO-MSG DTSCS87 01492 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01493 MOVE CATB-CURSOR TO MAP-LARGE-EMP-DEFIN-L DTSCS87 01494 SET CURSOR-SET-YES TO TRUE. DTSCS87 01495 S1203-EXIT. DTSCS87 01496 EXIT. DTSCS87 01497 EJECT DTSCS87 01498 S1300-RANDOM-IND. DTSCS87 01499 IF MAP-RANDOM-IND = 'Y' OR 'N' DTSCS87 01500 NEXT SENTENCE DTSCS87 01501 ELSE DTSCS87 01502 IF MAP-RANDOM-IND = SPACE OR LOW-VALUE DTSCS87 01503 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01504 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS87 01505 ELSE DTSCS87 01506 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01507 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS87 01508 S1300-EXIT. DTSCS87 01509 EXIT. DTSCS87 01510 SKIP3 DTSCS87 01511 S1301-ERROR. DTSCS87 01512 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RANDOM-IND-A. DTSCS87 01513 IF LCCM-NO-MSG DTSCS87 01514 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01515 MOVE CATB-CURSOR TO MAP-RANDOM-IND-L DTSCS87 01516 SET CURSOR-SET-YES TO TRUE. DTSCS87 01517 S1301-EXIT. DTSCS87 01518 EXIT. DTSCS87 01519 EJECT DTSCS87 01520 S1350-TARGET-IND. DTSCS87 01521 IF MAP-TARGET-IND = 'Y' OR 'N' OR SPACE OR LOW-VALUE DTSCS87 01522 NEXT SENTENCE DTSCS87 01523 ELSE DTSCS87 01524 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01525 PERFORM S1351-ERROR THRU S1351-EXIT. DTSCS87 01526 S1350-EXIT. DTSCS87 01527 EXIT. DTSCS87 01528 SKIP3 DTSCS87 01529 S1351-ERROR. DTSCS87 01530 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-TARGET-IND-A. DTSCS87 01531 IF LCCM-NO-MSG DTSCS87 01532 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01533 MOVE CATB-CURSOR TO MAP-TARGET-IND-L DTSCS87 01534 SET CURSOR-SET-YES TO TRUE. DTSCS87 01535 S1351-EXIT. DTSCS87 01536 EXIT. DTSCS87 01537 EJECT DTSCS87 01538 S1400-FIELD-REP-ID. DTSCS87 01539 IF MAP-FLD-REP-ID (MAP-IDX) = SPACE OR LOW-VALUE DTSCS87 01540 GO TO S1400-EXIT. DTSCS87 01541 SKIP1 DTSCS87 01542 MOVE MAP-FLD-REP-ID (MAP-IDX) TO L062-FLD-REP-ID. DTSCS87 01543 PERFORM S062-REP-ID THRU S062-EXIT. DTSCS87 01544 IF L062-NOT-VALID DTSCS87 01545 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01546 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS87 01547 ELSE DTSCS87 01548 IF MAP-FLD-REP-ID (1) = SPACE OR LOW-VALUE DTSCS87 01549 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01550 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS87 01551 S1400-EXIT. DTSCS87 01552 EXIT. DTSCS87 01553 SKIP3 DTSCS87 01554 S1401-ERROR. DTSCS87 01555 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS87 01556 TO MAP-FLD-REP-ID-A (1). DTSCS87 01557 IF LCCM-NO-MSG DTSCS87 01558 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01559 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-L (1) DTSCS87 01560 SET CURSOR-SET-YES TO TRUE. DTSCS87 01561 S1401-EXIT. DTSCS87 01562 EXIT. DTSCS87 01563 SKIP3 DTSCS87 01564 S1402-ERROR. DTSCS87 01565 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS87 01566 TO MAP-FLD-REP-ID-A (MAP-IDX). DTSCS87 01567 IF LCCM-NO-MSG DTSCS87 01568 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01569 MOVE CATB-CURSOR TO MAP-FLD-REP-ID-L (MAP-IDX) DTSCS87 01570 SET CURSOR-SET-YES TO TRUE. DTSCS87 01571 S1402-EXIT. DTSCS87 01572 EXIT. DTSCS87 01573 EJECT DTSCS87 01574 S1600-AUDITED-START-YRQ. DTSCS87 01575 MOVE MAP-AUDITED-START-YRQ-AREA TO L016-S-YRQ-AREA. DTSCS87 01576 PERFORM S016-SCREEN-YRQ THRU S016-EXIT. DTSCS87 01577 SKIP1 DTSCS87 01578 IF L016-NOT-VALID DTSCS87 01579 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01580 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS87 01581 ELSE DTSCS87 01582 IF L016-NO-ENTRY DTSCS87 01583 NEXT SENTENCE DTSCS87 01584 ELSE DTSCS87 01585 IF L016-YRQ <= LCCM-PICKUP-YRQ DTSCS87 01586 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01587 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS87 01588 ELSE DTSCS87 01589 IF L016-YRQ > LCCM-LAST-UC30-DEL-MAIL-YRQ DTSCS87 01590 MOVE MSG-E872-AREA TO WRK-MSG-AREA DTSCS87 01591 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS87 01592 S1600-EXIT. DTSCS87 01593 EXIT. DTSCS87 01594 SKIP3 DTSCS87 01595 S1601-ERROR. DTSCS87 01596 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AUDITED-START-YR-A DTSCS87 01597 MAP-AUDITED-START-Q-A. DTSCS87 01598 IF LCCM-NO-MSG DTSCS87 01599 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01600 MOVE CATB-CURSOR TO MAP-AUDITED-START-YR-L DTSCS87 01601 SET CURSOR-SET-YES TO TRUE. DTSCS87 01602 S1601-EXIT. DTSCS87 01603 EXIT. DTSCS87 01604 EJECT DTSCS87 01605 S1700-ACTIVE. DTSCS87 01606 IF MAP-ACTIVE-PERIOD-IND = 'Y' OR 'N' OR SPACE OR LOW-VALUE DTSCS87 01607 NEXT SENTENCE DTSCS87 01608 ELSE DTSCS87 01609 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01610 PERFORM S1701-ERROR THRU S1701-EXIT. DTSCS87 01611 SKIP1 DTSCS87 01612 IF MAP-ACTIVE-CURR-IND = 'Y' OR 'N' OR SPACE OR LOW-VALUE DTSCS87 01613 NEXT SENTENCE DTSCS87 01614 ELSE DTSCS87 01615 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01616 PERFORM S1702-ERROR THRU S1702-EXIT. DTSCS87 01617 S1700-EXIT. DTSCS87 01618 EXIT. DTSCS87 01619 SKIP3 DTSCS87 01620 S1701-ERROR. DTSCS87 01621 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACTIVE-PERIOD-IND-A. DTSCS87 01622 IF LCCM-NO-MSG DTSCS87 01623 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01624 MOVE CATB-CURSOR TO MAP-ACTIVE-PERIOD-IND-L DTSCS87 01625 SET CURSOR-SET-YES TO TRUE. DTSCS87 01626 S1701-EXIT. DTSCS87 01627 EXIT. DTSCS87 01628 SKIP3 DTSCS87 01629 S1702-ERROR. DTSCS87 01630 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACTIVE-CURR-IND-A. DTSCS87 01631 IF LCCM-NO-MSG DTSCS87 01632 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01633 MOVE CATB-CURSOR TO MAP-ACTIVE-CURR-IND-L DTSCS87 01634 SET CURSOR-SET-YES TO TRUE. DTSCS87 01635 S1702-EXIT. DTSCS87 01636 EXIT. DTSCS87 01637 EJECT DTSCS87 01638 S1800-SIC-CODES. DTSCS87 01639 IF ( MAP-START-SIC-CD = SPACE OR LOW-VALUE ) DTSCS87 01640 AND ( MAP-END-SIC-CD = SPACE OR LOW-VALUE ) DTSCS87 01641 GO TO S1800-EXIT. DTSCS87 01642 SKIP1 DTSCS87 01643 IF MAP-START-SIC-CD = SPACE OR LOW-VALUE DTSCS87 01644 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01645 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS87 01646 SKIP1 DTSCS87 01647 IF MAP-END-SIC-CD = SPACE OR LOW-VALUE DTSCS87 01648 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01649 PERFORM S1802-ERROR THRU S1802-EXIT. DTSCS87 01650 SKIP1 DTSCS87 01651 IF MAP-START-SIC-CD GREATER THAN MAP-END-SIC-CD DTSCS87 01652 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01653 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS87 01654 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS87 01655 GO TO S1800-EXIT. DTSCS87 01656 S1800-EXIT. DTSCS87 01657 EXIT. DTSCS87 01658 SKIP3 DTSCS87 01659 S1801-ERROR. DTSCS87 01660 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-START-SIC-CD-A. DTSCS87 01661 IF LCCM-NO-MSG DTSCS87 01662 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01663 MOVE CATB-CURSOR TO MAP-START-SIC-CD-L DTSCS87 01664 SET CURSOR-SET-YES TO TRUE. DTSCS87 01665 S1801-EXIT. DTSCS87 01666 EXIT. DTSCS87 01667 SKIP3 DTSCS87 01668 S1802-ERROR. DTSCS87 01669 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-END-SIC-CD-A. DTSCS87 01670 IF LCCM-NO-MSG DTSCS87 01671 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01672 MOVE CATB-CURSOR TO MAP-END-SIC-CD-L DTSCS87 01673 SET CURSOR-SET-YES TO TRUE. DTSCS87 01674 S1802-EXIT. DTSCS87 01675 EXIT. DTSCS87 01676 EJECT DTSCS87 01677 S1850-NAICS-CODES. DTSCS87 01678 IF ( MAP-START-NAICS-CD = SPACE OR LOW-VALUE ) DTSCS87 01679 AND ( MAP-END-NAICS-CD = SPACE OR LOW-VALUE ) DTSCS87 01680 GO TO S1850-EXIT. DTSCS87 01681 SKIP1 DTSCS87 01682 IF MAP-START-NAICS-CD = SPACE OR LOW-VALUE DTSCS87 01683 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01684 PERFORM S1851-ERROR THRU S1851-EXIT. DTSCS87 01685 SKIP1 DTSCS87 01686 IF MAP-END-NAICS-CD = SPACE OR LOW-VALUE DTSCS87 01687 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01688 PERFORM S1852-ERROR THRU S1852-EXIT. DTSCS87 01689 SKIP1 DTSCS87 01690 IF MAP-START-NAICS-CD GREATER THAN MAP-END-NAICS-CD DTSCS87 01691 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01692 PERFORM S1851-ERROR THRU S1851-EXIT DTSCS87 01693 PERFORM S1852-ERROR THRU S1852-EXIT DTSCS87 01694 GO TO S1850-EXIT. DTSCS87 01695 S1850-EXIT. DTSCS87 01696 EXIT. DTSCS87 01697 SKIP3 DTSCS87 01698 S1851-ERROR. DTSCS87 01699 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-START-NAICS-CD-A. DTSCS87 01700 IF LCCM-NO-MSG DTSCS87 01701 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01702 MOVE CATB-CURSOR TO MAP-START-NAICS-CD-L DTSCS87 01703 SET CURSOR-SET-YES TO TRUE. DTSCS87 01704 S1851-EXIT. DTSCS87 01705 EXIT. DTSCS87 01706 SKIP3 DTSCS87 01707 S1852-ERROR. DTSCS87 01708 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-END-NAICS-CD-A. DTSCS87 01709 IF LCCM-NO-MSG DTSCS87 01710 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01711 MOVE CATB-CURSOR TO MAP-END-NAICS-CD-L DTSCS87 01712 SET CURSOR-SET-YES TO TRUE. DTSCS87 01713 S1852-EXIT. DTSCS87 01714 EXIT. DTSCS87 01715 EJECT DTSCS87 01716 S1900-DC. DTSCS87 01717 IF MAP-FLD-ZIP-DC-IND = 'Y' OR 'N' OR SPACE OR LOW-VALUE DTSCS87 01718 NEXT SENTENCE DTSCS87 01719 ELSE DTSCS87 01720 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01721 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS87 01722 S1900-EXIT. DTSCS87 01723 EXIT. DTSCS87 01724 SKIP3 DTSCS87 01725 S1901-ERROR. DTSCS87 01726 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-ZIP-DC-IND-A. DTSCS87 01727 IF LCCM-NO-MSG DTSCS87 01728 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01729 MOVE CATB-CURSOR TO MAP-FLD-ZIP-DC-IND-L DTSCS87 01730 SET CURSOR-SET-YES TO TRUE. DTSCS87 01731 S1901-EXIT. DTSCS87 01732 EXIT. DTSCS87 01733 EJECT DTSCS87 01734 S2000-ZIP-CODES. DTSCS87 01735 IF ( MAP-FLD-ZIP-START = SPACE OR LOW-VALUE ) DTSCS87 01736 AND ( MAP-FLD-ZIP-END = SPACE OR LOW-VALUE ) DTSCS87 01737 GO TO S2000-EXIT. DTSCS87 01738 SKIP1 DTSCS87 01739 IF MAP-FLD-ZIP-START = SPACE OR LOW-VALUE DTSCS87 01740 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 01741 PERFORM S2002-ERROR THRU S2002-EXIT DTSCS87 01742 GO TO S2000-EXIT. DTSCS87 01743 SKIP1 DTSCS87 01744 IF MAP-FLD-ZIP-END = SPACE OR LOW-VALUE DTSCS87 01745 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 01746 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS87 01747 GO TO S2000-EXIT. DTSCS87 01748 SKIP3 DTSCS87 01749 IF MAP-FLD-ZIP-START NOT NUMERIC DTSCS87 01750 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01751 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS87 01752 GO TO S2000-EXIT. DTSCS87 01753 SKIP1 DTSCS87 01754 IF MAP-FLD-ZIP-END NOT NUMERIC DTSCS87 01755 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01756 PERFORM S2002-ERROR THRU S2002-EXIT DTSCS87 01757 GO TO S2000-EXIT. DTSCS87 01758 SKIP1 DTSCS87 01759 IF MAP-FLD-ZIP-START GREATER THAN MAP-FLD-ZIP-END DTSCS87 01760 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01761 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS87 01762 PERFORM S2002-ERROR THRU S2002-EXIT DTSCS87 01763 GO TO S2000-EXIT. DTSCS87 01764 S2000-EXIT. DTSCS87 01765 EXIT. DTSCS87 01766 SKIP3 DTSCS87 01767 S2001-ERROR. DTSCS87 01768 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-ZIP-START-A. DTSCS87 01769 IF LCCM-NO-MSG DTSCS87 01770 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01771 MOVE CATB-CURSOR TO MAP-FLD-ZIP-START-L DTSCS87 01772 SET CURSOR-SET-YES TO TRUE. DTSCS87 01773 S2001-EXIT. DTSCS87 01774 EXIT. DTSCS87 01775 SKIP3 DTSCS87 01776 S2002-ERROR. DTSCS87 01777 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FLD-ZIP-END-A. DTSCS87 01778 IF LCCM-NO-MSG DTSCS87 01779 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01780 MOVE CATB-CURSOR TO MAP-FLD-ZIP-END-L DTSCS87 01781 SET CURSOR-SET-YES TO TRUE. DTSCS87 01782 S2002-EXIT. DTSCS87 01783 EXIT. DTSCS87 01784 EJECT DTSCS87 01785 S2100-LIABILITY. DTSCS87 01786 MOVE -1 TO WRK-HOLD-VALUE. DTSCS87 01787 SKIP1 DTSCS87 01788 MOVE MAP-LIAB-START-AREA TO L015-S-DATE-AREA. DTSCS87 01789 PERFORM S015-SCREEN-DATE THRU S015-EXIT. DTSCS87 01790 IF L015-NO-ENTRY DTSCS87 01791 SET START-NO-ENTRY TO TRUE DTSCS87 01792 ELSE DTSCS87 01793 IF L015-VALID DTSCS87 01794 SET START-VALID TO TRUE DTSCS87 01795 MOVE L015-DATE TO WRK-HOLD-VALUE DTSCS87 01796 ELSE DTSCS87 01797 SET START-NOT-VALID TO TRUE DTSCS87 01798 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01799 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS87 01800 SKIP1 DTSCS87 01801 MOVE MAP-LIAB-END-AREA TO L015-S-DATE-AREA. DTSCS87 01802 PERFORM S015-SCREEN-DATE THRU S015-EXIT. DTSCS87 01803 IF L015-NO-ENTRY DTSCS87 01804 IF START-VALID DTSCS87 01805 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01806 PERFORM S2102-ERROR THRU S2102-EXIT DTSCS87 01807 ELSE DTSCS87 01808 NEXT SENTENCE DTSCS87 01809 ELSE DTSCS87 01810 IF L015-VALID DTSCS87 01811 PERFORM S2110-LIABILITY-END-EDIT THRU S2110-EXIT DTSCS87 01812 ELSE DTSCS87 01813 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01814 PERFORM S2102-ERROR THRU S2102-EXIT. DTSCS87 01815 S2100-EXIT. DTSCS87 01816 EXIT. DTSCS87 01817 SKIP3 DTSCS87 01818 S2101-ERROR. DTSCS87 01819 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-START-MM-A DTSCS87 01820 MAP-LIAB-START-DD-A DTSCS87 01821 MAP-LIAB-START-YY-A. DTSCS87 01822 IF LCCM-NO-MSG DTSCS87 01823 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01824 MOVE CATB-CURSOR TO MAP-LIAB-START-MM-L DTSCS87 01825 SET CURSOR-SET-YES TO TRUE. DTSCS87 01826 S2101-EXIT. DTSCS87 01827 EXIT. DTSCS87 01828 SKIP3 DTSCS87 01829 S2102-ERROR. DTSCS87 01830 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LIAB-END-MM-A DTSCS87 01831 MAP-LIAB-END-DD-A DTSCS87 01832 MAP-LIAB-END-YY-A. DTSCS87 01833 IF LCCM-NO-MSG DTSCS87 01834 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01835 MOVE CATB-CURSOR TO MAP-LIAB-END-MM-L DTSCS87 01836 SET CURSOR-SET-YES TO TRUE. DTSCS87 01837 S2102-EXIT. DTSCS87 01838 EXIT. DTSCS87 01839 SKIP3 DTSCS87 01840 S2110-LIABILITY-END-EDIT. DTSCS87 01841 IF WRK-HOLD-VALUE > L015-DATE DTSCS87 01842 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01843 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS87 01844 PERFORM S2102-ERROR THRU S2102-EXIT DTSCS87 01845 GO TO S2110-EXIT. DTSCS87 01846 DTSCS87 01847 IF START-NO-ENTRY DTSCS87 01848 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 01849 PERFORM S2102-ERROR THRU S2102-EXIT DTSCS87 01850 GO TO S2110-EXIT. DTSCS87 01851 DTSCS87 01852 IF L015-DATE > LCCM-CURR-RUN-DATE DTSCS87 01853 MOVE MSG-E873-AREA TO WRK-MSG-AREA DTSCS87 01854 PERFORM S2102-ERROR THRU S2102-EXIT. DTSCS87 01855 S2110-EXIT. DTSCS87 01856 EXIT. DTSCS87 01857 EJECT DTSCS87 01858 S2200-TOT-WAGES. DTSCS87 01859 MOVE +0 TO L011-MIN-AMT. DTSCS87 01860 MOVE +999999999.99 TO L011-MAX-AMT. DTSCS87 01861 MOVE -1 TO WRK-HOLD-VALUE. DTSCS87 01862 SKIP1 DTSCS87 01863 MOVE MAP-WAGE-START-AMT-AREA TO L011-S-AMT-AREA. DTSCS87 01864 PERFORM S011-SCREEN-AMT THRU S011-EXIT. DTSCS87 01865 IF L011-NO-ENTRY DTSCS87 01866 SET START-NO-ENTRY TO TRUE DTSCS87 01867 ELSE DTSCS87 01868 IF L011-VALID DTSCS87 01869 SET START-VALID TO TRUE DTSCS87 01870 MOVE L011-AMT TO MAP-WAGE-START-AMT-N DTSCS87 01871 WRK-HOLD-VALUE DTSCS87 01872 ELSE DTSCS87 01873 SET START-NOT-VALID TO TRUE DTSCS87 01874 IF L011-INVALID-NEGATIVE DTSCS87 01875 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS87 01876 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS87 01877 ELSE DTSCS87 01878 IF L011-EXCEEDS-MIN-MAX DTSCS87 01879 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS87 01880 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS87 01881 ELSE DTSCS87 01882 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01883 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS87 01884 SKIP1 DTSCS87 01885 MOVE MAP-WAGE-END-AMT-AREA TO L011-S-AMT-AREA. DTSCS87 01886 PERFORM S011-SCREEN-AMT THRU S011-EXIT. DTSCS87 01887 IF L011-NO-ENTRY DTSCS87 01888 IF START-VALID DTSCS87 01889 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01890 PERFORM S2202-ERROR THRU S2202-EXIT DTSCS87 01891 END-IF DTSCS87 01892 ELSE DTSCS87 01893 IF L011-VALID DTSCS87 01894 MOVE L011-AMT TO MAP-WAGE-END-AMT-N DTSCS87 01895 IF WRK-HOLD-VALUE GREATER THAN L011-AMT DTSCS87 01896 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01897 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS87 01898 PERFORM S2202-ERROR THRU S2202-EXIT DTSCS87 01899 ELSE DTSCS87 01900 IF START-NO-ENTRY DTSCS87 01901 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 01902 PERFORM S2202-ERROR THRU S2202-EXIT DTSCS87 01903 END-IF DTSCS87 01904 END-IF DTSCS87 01905 ELSE DTSCS87 01906 IF L011-INVALID-NEGATIVE DTSCS87 01907 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS87 01908 PERFORM S2202-ERROR THRU S2202-EXIT DTSCS87 01909 ELSE DTSCS87 01910 IF L011-EXCEEDS-MIN-MAX DTSCS87 01911 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS87 01912 PERFORM S2202-ERROR THRU S2202-EXIT DTSCS87 01913 ELSE DTSCS87 01914 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01915 PERFORM S2202-ERROR THRU S2202-EXIT. DTSCS87 01916 S2200-EXIT. DTSCS87 01917 EXIT. DTSCS87 01918 SKIP3 DTSCS87 01919 S2201-ERROR. DTSCS87 01920 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAGE-START-AMT-A. DTSCS87 01921 IF LCCM-NO-MSG DTSCS87 01922 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01923 MOVE CATB-CURSOR TO MAP-WAGE-START-AMT-L DTSCS87 01924 SET CURSOR-SET-YES TO TRUE. DTSCS87 01925 S2201-EXIT. DTSCS87 01926 EXIT. DTSCS87 01927 SKIP3 DTSCS87 01928 S2202-ERROR. DTSCS87 01929 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAGE-END-AMT-A. DTSCS87 01930 IF LCCM-NO-MSG DTSCS87 01931 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 01932 MOVE CATB-CURSOR TO MAP-WAGE-END-AMT-L DTSCS87 01933 SET CURSOR-SET-YES TO TRUE. DTSCS87 01934 S2202-EXIT. DTSCS87 01935 EXIT. DTSCS87 01936 EJECT DTSCS87 01937 S2300-TOT-WAGE-DECREASE. DTSCS87 01938 PERFORM S2310-DECR-YRQ-RANGE THRU S2310-EXIT. DTSCS87 01939 PERFORM S2320-RATIOS THRU S2320-EXIT. DTSCS87 01940 S2300-EXIT. DTSCS87 01941 EXIT. DTSCS87 01942 SKIP3 DTSCS87 01943 S2310-DECR-YRQ-RANGE. DTSCS87 01944 MOVE MAP-DECR-YRQ-RANGE-AREA TO L024-S-YRQ-RANGE-AREA. DTSCS87 01945 SET L024-END-REQUIRED TO TRUE. DTSCS87 01946 PERFORM S024-SCREEN-YRQ-RANGE THRU S024-EXIT. DTSCS87 01947 SKIP1 DTSCS87 01948 IF L024-START-NO-ENTRY DTSCS87 01949 AND L024-END-NO-ENTRY DTSCS87 01950 SET RANGE-NO-ENTRY TO TRUE DTSCS87 01951 GO TO S2310-EXIT DTSCS87 01952 ELSE DTSCS87 01953 SET RANGE-ENTRY TO TRUE. DTSCS87 01954 SKIP1 DTSCS87 01955 IF L024-END-BEFORE-START DTSCS87 01956 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 01957 PERFORM S2391-ERROR THRU S2391-EXIT DTSCS87 01958 PERFORM S2392-ERROR THRU S2392-EXIT DTSCS87 01959 GO TO S2310-EXIT. DTSCS87 01960 SKIP1 DTSCS87 01961 IF L024-START-NO-ENTRY DTSCS87 01962 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01963 PERFORM S2391-ERROR THRU S2391-EXIT DTSCS87 01964 ELSE DTSCS87 01965 IF (L024-START-NOT-VALID) DTSCS87 01966 OR DTSCS87 01967 (L024-START-YRQ <= LCCM-PICKUP-YRQ) DTSCS87 01968 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01969 PERFORM S2391-ERROR THRU S2391-EXIT. DTSCS87 01970 SKIP1 DTSCS87 01971 IF L024-END-NO-ENTRY DTSCS87 01972 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01973 PERFORM S2392-ERROR THRU S2392-EXIT DTSCS87 01974 ELSE DTSCS87 01975 IF L024-END-NOT-VALID DTSCS87 01976 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 01977 PERFORM S2392-ERROR THRU S2392-EXIT. DTSCS87 01978 DTSCS87 01979 IF L024-END-VALID DTSCS87 01980 IF L024-END-YRQ > LCCM-LAST-UC30-DEL-MAIL-YRQ DTSCS87 01981 MOVE MSG-E875-AREA TO WRK-MSG-AREA DTSCS87 01982 PERFORM S2392-ERROR THRU S2392-EXIT. DTSCS87 01983 S2310-EXIT. DTSCS87 01984 EXIT. DTSCS87 01985 SKIP3 DTSCS87 01986 S2320-RATIOS. DTSCS87 01987 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS87 01988 MOVE -1 TO WRK-HOLD-VALUE. DTSCS87 01989 SKIP1 DTSCS87 01990 MOVE MAP-WAGE-START-RATIO-AREA TO L012-S-RATE-AREA. DTSCS87 01991 PERFORM S012-SCREEN-RATE THRU S012-EXIT. DTSCS87 01992 IF L012-NO-ENTRY DTSCS87 01993 SET START-NO-ENTRY TO TRUE DTSCS87 01994 IF RANGE-ENTRY DTSCS87 01995 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 01996 PERFORM S2393-ERROR THRU S2393-EXIT DTSCS87 01997 END-IF DTSCS87 01998 ELSE DTSCS87 01999 IF RANGE-NO-ENTRY DTSCS87 02000 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 02001 PERFORM S2393-ERROR THRU S2393-EXIT DTSCS87 02002 END-IF DTSCS87 02003 IF L012-VALID DTSCS87 02004 SET START-VALID TO TRUE DTSCS87 02005 MOVE L012-RATE TO L056-RATE DTSCS87 02006 WRK-HOLD-VALUE DTSCS87 02007 PERFORM S056-DISP-RATE THRU S056-EXIT DTSCS87 02008 MOVE L056-DISP-RATE TO MAP-WAGE-START-RATIO DTSCS87 02009 ELSE DTSCS87 02010 SET START-NOT-VALID TO TRUE DTSCS87 02011 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 02012 PERFORM S2393-ERROR THRU S2393-EXIT. DTSCS87 02013 SKIP1 DTSCS87 02014 MOVE MAP-WAGE-END-RATIO-AREA TO L012-S-RATE-AREA. DTSCS87 02015 PERFORM S012-SCREEN-RATE THRU S012-EXIT. DTSCS87 02016 IF L012-NO-ENTRY DTSCS87 02017 IF START-VALID DTSCS87 02018 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 02019 PERFORM S2394-ERROR THRU S2394-EXIT DTSCS87 02020 END-IF DTSCS87 02021 ELSE DTSCS87 02022 IF L012-VALID DTSCS87 02023 MOVE L012-RATE TO L056-RATE DTSCS87 02024 PERFORM S056-DISP-RATE THRU S056-EXIT DTSCS87 02025 MOVE L056-DISP-RATE TO MAP-WAGE-END-RATIO DTSCS87 02026 IF WRK-HOLD-VALUE GREATER THAN L012-RATE DTSCS87 02027 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 02028 PERFORM S2393-ERROR THRU S2393-EXIT DTSCS87 02029 PERFORM S2394-ERROR THRU S2394-EXIT DTSCS87 02030 ELSE DTSCS87 02031 IF START-NO-ENTRY DTSCS87 02032 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 02033 PERFORM S2394-ERROR THRU S2394-EXIT DTSCS87 02034 END-IF DTSCS87 02035 END-IF DTSCS87 02036 ELSE DTSCS87 02037 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 02038 PERFORM S2394-ERROR THRU S2394-EXIT. DTSCS87 02039 S2320-EXIT. DTSCS87 02040 EXIT. DTSCS87 02041 SKIP3 DTSCS87 02042 S2391-ERROR. DTSCS87 02043 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DECR-START-YR-A DTSCS87 02044 MAP-DECR-START-Q-A. DTSCS87 02045 IF LCCM-NO-MSG DTSCS87 02046 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02047 MOVE CATB-CURSOR TO MAP-DECR-START-YR-L DTSCS87 02048 SET CURSOR-SET-YES TO TRUE. DTSCS87 02049 S2391-EXIT. DTSCS87 02050 EXIT. DTSCS87 02051 SKIP3 DTSCS87 02052 S2392-ERROR. DTSCS87 02053 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DECR-END-YR-A DTSCS87 02054 MAP-DECR-END-Q-A. DTSCS87 02055 IF LCCM-NO-MSG DTSCS87 02056 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02057 MOVE CATB-CURSOR TO MAP-DECR-END-YR-L DTSCS87 02058 SET CURSOR-SET-YES TO TRUE. DTSCS87 02059 S2392-EXIT. DTSCS87 02060 EXIT. DTSCS87 02061 SKIP3 DTSCS87 02062 S2393-ERROR. DTSCS87 02063 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAGE-START-RATIO-A. DTSCS87 02064 IF LCCM-NO-MSG DTSCS87 02065 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02066 MOVE CATB-CURSOR TO MAP-WAGE-START-RATIO-L DTSCS87 02067 SET CURSOR-SET-YES TO TRUE. DTSCS87 02068 S2393-EXIT. DTSCS87 02069 EXIT. DTSCS87 02070 SKIP3 DTSCS87 02071 S2394-ERROR. DTSCS87 02072 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAGE-END-RATIO-A. DTSCS87 02073 IF LCCM-NO-MSG DTSCS87 02074 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02075 MOVE CATB-CURSOR TO MAP-WAGE-END-RATIO-L DTSCS87 02076 SET CURSOR-SET-YES TO TRUE. DTSCS87 02077 S2394-EXIT. DTSCS87 02078 EXIT. DTSCS87 02079 EJECT DTSCS87 02080 S2400-WAGE-CHANGE. DTSCS87 02081 PERFORM S2410-CHNG-YRQ-RANGE THRU S2410-EXIT. DTSCS87 02082 PERFORM S2420-TRIGGER THRU S2420-EXIT. DTSCS87 02083 S2400-EXIT. DTSCS87 02084 EXIT. DTSCS87 02085 SKIP3 DTSCS87 02086 S2410-CHNG-YRQ-RANGE. DTSCS87 02087 MOVE MAP-CHNG-YRQ-RANGE-AREA TO L024-S-YRQ-RANGE-AREA. DTSCS87 02088 SET L024-END-REQUIRED TO TRUE. DTSCS87 02089 PERFORM S024-SCREEN-YRQ-RANGE THRU S024-EXIT. DTSCS87 02090 SKIP1 DTSCS87 02091 IF L024-START-NO-ENTRY DTSCS87 02092 AND L024-END-NO-ENTRY DTSCS87 02093 SET RANGE-NO-ENTRY TO TRUE DTSCS87 02094 GO TO S2410-EXIT DTSCS87 02095 ELSE DTSCS87 02096 SET RANGE-ENTRY TO TRUE. DTSCS87 02097 SKIP1 DTSCS87 02098 IF L024-END-BEFORE-START DTSCS87 02099 MOVE MSG-E874-AREA TO WRK-MSG-AREA DTSCS87 02100 PERFORM S2491-ERROR THRU S2491-EXIT DTSCS87 02101 PERFORM S2492-ERROR THRU S2492-EXIT DTSCS87 02102 GO TO S2410-EXIT. DTSCS87 02103 SKIP1 DTSCS87 02104 IF L024-START-NO-ENTRY DTSCS87 02105 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 02106 PERFORM S2491-ERROR THRU S2491-EXIT DTSCS87 02107 ELSE DTSCS87 02108 IF (L024-START-NOT-VALID) DTSCS87 02109 OR DTSCS87 02110 (L024-START-YRQ <= LCCM-PICKUP-YRQ) DTSCS87 02111 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 02112 PERFORM S2491-ERROR THRU S2491-EXIT. DTSCS87 02113 SKIP1 DTSCS87 02114 IF L024-END-NO-ENTRY DTSCS87 02115 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 02116 PERFORM S2492-ERROR THRU S2492-EXIT DTSCS87 02117 ELSE DTSCS87 02118 IF L024-END-NOT-VALID DTSCS87 02119 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 02120 PERFORM S2492-ERROR THRU S2492-EXIT. DTSCS87 02121 DTSCS87 02122 IF L024-END-VALID DTSCS87 02123 IF L024-END-YRQ > LCCM-LAST-UC30-DEL-MAIL-YRQ DTSCS87 02124 MOVE MSG-E875-AREA TO WRK-MSG-AREA DTSCS87 02125 PERFORM S2492-ERROR THRU S2492-EXIT. DTSCS87 02126 S2410-EXIT. DTSCS87 02127 EXIT. DTSCS87 02128 SKIP3 DTSCS87 02129 S2420-TRIGGER. DTSCS87 02130 MOVE +1 TO L013-MIN-CNT. DTSCS87 02131 MOVE +999 TO L013-MAX-CNT. DTSCS87 02132 MOVE MAP-WAGE-CHNG-TRIG-AREA TO L013-S-CNT-AREA. DTSCS87 02133 PERFORM S013-SCREEN-COUNT THRU S013-EXIT. DTSCS87 02134 IF L013-NO-ENTRY DTSCS87 02135 IF RANGE-ENTRY DTSCS87 02136 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS87 02137 PERFORM S2493-ERROR THRU S2493-EXIT DTSCS87 02138 END-IF DTSCS87 02139 ELSE DTSCS87 02140 IF RANGE-NO-ENTRY DTSCS87 02141 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS87 02142 PERFORM S2493-ERROR THRU S2493-EXIT DTSCS87 02143 END-IF DTSCS87 02144 IF L013-VALID DTSCS87 02145 MOVE L013-CNT TO MAP-WAGE-CHNG-TRIG-N DTSCS87 02146 ELSE DTSCS87 02147 IF L013-INVALID-NEGATIVE DTSCS87 02148 MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA DTSCS87 02149 PERFORM S2493-ERROR THRU S2493-EXIT DTSCS87 02150 ELSE DTSCS87 02151 IF L013-EXCEEDS-MIN-MAX DTSCS87 02152 MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA DTSCS87 02153 PERFORM S2493-ERROR THRU S2493-EXIT DTSCS87 02154 ELSE DTSCS87 02155 IF L013-NOT-VALID DTSCS87 02156 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 02157 PERFORM S2493-ERROR THRU S2493-EXIT. DTSCS87 02158 S2420-EXIT. DTSCS87 02159 EXIT. DTSCS87 02160 SKIP3 DTSCS87 02161 S2491-ERROR. DTSCS87 02162 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CHNG-START-YR-A DTSCS87 02163 MAP-CHNG-START-Q-A. DTSCS87 02164 IF LCCM-NO-MSG DTSCS87 02165 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02166 MOVE CATB-CURSOR TO MAP-CHNG-START-YR-L DTSCS87 02167 SET CURSOR-SET-YES TO TRUE. DTSCS87 02168 S2491-EXIT. DTSCS87 02169 EXIT. DTSCS87 02170 SKIP3 DTSCS87 02171 S2492-ERROR. DTSCS87 02172 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CHNG-END-YR-A DTSCS87 02173 MAP-CHNG-END-Q-A. DTSCS87 02174 IF LCCM-NO-MSG DTSCS87 02175 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02176 MOVE CATB-CURSOR TO MAP-CHNG-END-YR-L DTSCS87 02177 SET CURSOR-SET-YES TO TRUE. DTSCS87 02178 S2492-EXIT. DTSCS87 02179 EXIT. DTSCS87 02180 SKIP3 DTSCS87 02181 S2493-ERROR. DTSCS87 02182 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WAGE-CHNG-TRIG-A. DTSCS87 02183 IF LCCM-NO-MSG DTSCS87 02184 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02185 MOVE CATB-CURSOR TO MAP-WAGE-CHNG-TRIG-L DTSCS87 02186 SET CURSOR-SET-YES TO TRUE. DTSCS87 02187 S2493-EXIT. DTSCS87 02188 EXIT. DTSCS87 02189 EJECT DTSCS87 02190 S2500-UI-RATE. DTSCS87 02191 MOVE MAP-UI-RATE-MIN-AREA TO L012-S-RATE-AREA. DTSCS87 02192 PERFORM S012-SCREEN-RATE THRU S012-EXIT. DTSCS87 02193 IF L012-VALID DTSCS87 02194 MOVE L012-RATE TO L056-RATE DTSCS87 02195 SET L056-DISP1-LEFT-88 TO TRUE DTSCS87 02196 PERFORM S056-DISP-RATE THRU S056-EXIT DTSCS87 02197 MOVE L056-DISP-RATE TO MAP-UI-RATE-MIN DTSCS87 02198 ELSE DTSCS87 02199 IF L012-NOT-VALID DTSCS87 02200 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS87 02201 PERFORM S2501-ERROR THRU S2501-EXIT. DTSCS87 02202 S2500-EXIT. DTSCS87 02203 EXIT. DTSCS87 02204 SKIP3 DTSCS87 02205 S2501-ERROR. DTSCS87 02206 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-UI-RATE-MIN-A. DTSCS87 02207 IF LCCM-NO-MSG DTSCS87 02208 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS87 02209 MOVE CATB-CURSOR TO MAP-UI-RATE-MIN-L DTSCS87 02210 SET CURSOR-SET-YES TO TRUE. DTSCS87 02211 S2501-EXIT. DTSCS87 02212 EXIT. DTSCS87 02213 /*****************************************************************DTSCS87 02214 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS87 02215 ******************************************************************DTSCS87 02216 S5100-SET-LOCK-ATTRB. DTSCS87 02217 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS87 02218 SCR-ATB-NUM. DTSCS87 02219 SKIP1 DTSCS87 02220 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS87 02221 SKIP1 DTSCS87 02222 MOVE CATB-ASKIP-BRT-MDTON TO MAP-GOTO-A. DTSCS87 02223 S5100-EXIT. DTSCS87 02224 EXIT. DTSCS87 02225 SKIP3 DTSCS87 02226 ******************************************************************DTSCS87 02227 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS87 02228 ******************************************************************DTSCS87 02229 S5200-SET-UPDATE-ATTRB. DTSCS87 02230 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS87 02231 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS87 02232 SKIP1 DTSCS87 02233 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS87 02234 S5200-EXIT. DTSCS87 02235 EXIT. DTSCS87 02236 SKIP3 DTSCS87 02237 ******************************************************************DTSCS87 02238 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS87 02239 ******************************************************************DTSCS87 02240 S5300-SET-INQ-ATTRB. DTSCS87 02241 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS87 02242 SCR-ATB-NUM. DTSCS87 02243 SKIP1 DTSCS87 02244 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS87 02245 S5300-EXIT. DTSCS87 02246 EXIT. DTSCS87 02247 SKIP3 DTSCS87 02248 ******************************************************************DTSCS87 02249 * DO IT *DTSCS87 02250 ******************************************************************DTSCS87 02251 S5900-SET-ATTRB. DTSCS87 02252 MOVE SCR-ATB-NUM TO MAP-AUDIT-START-YR-A DTSCS87 02253 MAP-AUDIT-START-Q-A DTSCS87 02254 MAP-AUDIT-END-YR-A DTSCS87 02255 MAP-AUDIT-END-Q-A DTSCS87 02256 MAP-SMALL-EMP-LIST-CNT-A DTSCS87 02257 MAP-LARGE-EMP-LIST-CNT-A. DTSCS87 02258 MOVE SCR-ATB-AN TO MAP-LARGE-EMP-DEFIN-A DTSCS87 02259 MAP-RANDOM-IND-A DTSCS87 02260 MAP-TARGET-IND-A. DTSCS87 02261 PERFORM VARYING MAP-IDX FROM 1 BY 1 DTSCS87 02262 UNTIL MAP-IDX > FMAX-SEL-FLD-REP-ID-MAX DTSCS87 02263 MOVE SCR-ATB-AN TO MAP-FLD-REP-ID-A (MAP-IDX) DTSCS87 02264 END-PERFORM. DTSCS87 02265 MOVE SCR-ATB-NUM TO MAP-AUDITED-START-YR-A DTSCS87 02266 MAP-AUDITED-START-Q-A. DTSCS87 02267 MOVE SCR-ATB-AN TO MAP-ACTIVE-PERIOD-IND-A DTSCS87 02268 MAP-ACTIVE-CURR-IND-A. DTSCS87 02269 MOVE SCR-ATB-AN TO MAP-START-SIC-CD-A DTSCS87 02270 MAP-END-SIC-CD-A. DTSCS87 02271 MOVE SCR-ATB-AN TO MAP-START-NAICS-CD-A DTSCS87 02272 MAP-END-NAICS-CD-A. DTSCS87 02273 MOVE SCR-ATB-AN TO MAP-FLD-ZIP-DC-IND-A. DTSCS87 02274 MOVE SCR-ATB-AN TO MAP-FLD-ZIP-START-A DTSCS87 02275 MAP-FLD-ZIP-END-A. DTSCS87 02276 MOVE SCR-ATB-NUM TO MAP-LIAB-START-MM-A DTSCS87 02277 MAP-LIAB-START-DD-A DTSCS87 02278 MAP-LIAB-START-YY-A DTSCS87 02279 MAP-LIAB-END-MM-A DTSCS87 02280 MAP-LIAB-END-DD-A DTSCS87 02281 MAP-LIAB-END-YY-A DTSCS87 02282 MAP-WAGE-START-AMT-A DTSCS87 02283 MAP-WAGE-END-AMT-A DTSCS87 02284 MAP-DECR-START-YR-A DTSCS87 02285 MAP-DECR-START-Q-A DTSCS87 02286 MAP-DECR-END-YR-A DTSCS87 02287 MAP-DECR-END-Q-A DTSCS87 02288 MAP-WAGE-START-RATIO-A DTSCS87 02289 MAP-WAGE-END-RATIO-A DTSCS87 02290 MAP-CHNG-START-YR-A DTSCS87 02291 MAP-CHNG-START-Q-A DTSCS87 02292 MAP-CHNG-END-YR-A DTSCS87 02293 MAP-CHNG-END-Q-A DTSCS87 02294 MAP-WAGE-CHNG-TRIG-A DTSCS87 02295 MAP-UI-RATE-MIN-A. DTSCS87 02296 SKIP1 DTSCS87 02297 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CHNG-DATE-A. DTSCS87 02298 SKIP1 DTSCS87 02299 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS87 02300 S5900-EXIT. DTSCS87 02301 EXIT. DTSCS87 02302 /*****************************************************************DTSCS87 02303 * READ PREPARATION ROUTINES *DTSCS87 02304 ******************************************************************DTSCS87 02305 S8010-READ-FSEL. DTSCS87 02306 MOVE LOW-VALUES TO FSEL-KEY-AREA. DTSCS87 02307 SET FSEL-SEL-88 TO TRUE. DTSCS87 02308 PERFORM S831-READ THRU S831-EXIT. DTSCS87 02309 S8010-EXIT. DTSCS87 02310 EXIT. DTSCS87 02311 /*****************************************************************DTSCS87 02312 * MAP ROUTINES *DTSCS87 02313 ******************************************************************DTSCS87 02314 S9100-RECEIVE. DTSCS87 02315 SET L851-RECEIVE-88 TO TRUE. DTSCS87 02316 SKIP1 DTSCS87 02317 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS87 02318 SKIP1 DTSCS87 02319 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS87 02320 SKIP1 DTSCS87 02321 MOVE L851-AID TO LCCM-AID. DTSCS87 02322 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS87 02323 S9100-EXIT. DTSCS87 02324 EXIT. DTSCS87 02325 SKIP3 DTSCS87 02326 S9200-SEND-DATAONLY. DTSCS87 02327 MOVE LOW-VALUES TO MAP-AREA. DTSCS87 02328 SKIP1 DTSCS87 02329 IF LCCM-NO-MSG DTSCS87 02330 NEXT SENTENCE DTSCS87 02331 ELSE DTSCS87 02332 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS87 02333 SKIP1 DTSCS87 02334 IF CURSOR-SET-GOTO DTSCS87 02335 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS87 02336 ELSE DTSCS87 02337 MOVE CATB-CURSOR TO MAP-AUDIT-START-YR-L. DTSCS87 02338 SKIP1 DTSCS87 02339 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS87 02340 SKIP1 DTSCS87 02341 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS87 02342 SKIP1 DTSCS87 02343 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS87 02344 S9200-EXIT. DTSCS87 02345 EXIT. DTSCS87 02346 SKIP3 DTSCS87 02347 S9300-SEND-MAP. DTSCS87 02348 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS87 02349 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS87 02350 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS87 02351 SKIP1 DTSCS87 02352 IF SCR-ACCESS-UPDATE DTSCS87 02353 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS87 02354 ELSE DTSCS87 02355 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS87 02356 SKIP1 DTSCS87 02357 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS87 02358 SKIP1 DTSCS87 02359 IF CURSOR-SET-NO DTSCS87 02360 MOVE CATB-CURSOR TO MAP-AUDIT-START-YR-L. DTSCS87 02361 SKIP1 DTSCS87 02362 SET L851-SEND-88 TO TRUE. DTSCS87 02363 SKIP1 DTSCS87 02364 IF MAP-RANDOM-IND = 'N' DTSCS87 02365 PERFORM S9330-DEFAULT-IS-BYPASS THRU S9330-EXIT. DTSCS87 02366 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS87 02367 SKIP1 DTSCS87 02368 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS87 02369 S9300-EXIT. DTSCS87 02370 EXIT. DTSCS87 02371 SKIP3 DTSCS87 02372 S9310-UPDATE-FKEYS. DTSCS87 02373 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS87 02374 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS87 02375 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS87 02376 SKIP1 DTSCS87 02377 IF LCCM-SCR-CLEAR DTSCS87 02378 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS87 02379 MAP-KEY-DEL DTSCS87 02380 ELSE DTSCS87 02381 IF LCCM-SCR-UPDATE-LOCKED DTSCS87 02382 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS87 02383 MAP-KEY-MOD DTSCS87 02384 MAP-KEY-DEL DTSCS87 02385 ELSE DTSCS87 02386 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS87 02387 S9310-EXIT. DTSCS87 02388 EXIT. DTSCS87 02389 SKIP3 DTSCS87 02390 S9320-INQUIRY-FKEYS. DTSCS87 02391 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS87 02392 MAP-KEY-MOD DTSCS87 02393 MAP-KEY-DEL. DTSCS87 02394 S9320-EXIT. DTSCS87 02395 EXIT. DTSCS87 02396 EJECT DTSCS87 02397 S9330-DEFAULT-IS-BYPASS. DTSCS87 02398 SKIP1 DTSCS87 02399 IF MAP-ACTIVE-PERIOD-IND = SPACE OR LOW-VALUE DTSCS87 02400 MOVE 'N' TO MAP-ACTIVE-PERIOD-IND. DTSCS87 02401 IF MAP-ACTIVE-CURR-IND = SPACE OR LOW-VALUE DTSCS87 02402 MOVE 'N' TO MAP-ACTIVE-CURR-IND. DTSCS87 02403 IF MAP-FLD-ZIP-DC-IND = SPACE OR LOW-VALUE DTSCS87 02404 MOVE 'N' TO MAP-FLD-ZIP-DC-IND. DTSCS87 02405 S9330-EXIT. DTSCS87 02406 EXIT. DTSCS87 02407 EJECT DTSCS87 02408 S9900-PREPARE-SEND. DTSCS87 02409 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS87 02410 LCCM-SCR-ID. DTSCS87 02411 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS87 02412 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS87 02413 S9900-EXIT. DTSCS87 02414 EXIT. DTSCS87