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

2416 lines
189 KiB
COBOL
Raw Blame History

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