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