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

2407 lines
188 KiB
COBOL
Raw Blame History

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