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