00001 IDENTIFICATION DIVISION. 07/19/99 00002 PROGRAM-ID. DTSCSL2. DTSCSL2 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCSL2 00005 DATE-COMPILED. DTSCSL2 00006 SKIP3 DTSCSL2 00007 ***** DTSCSL2 00008 * DTSCSL2 00009 * FUNCTION: LMI INQUIRY CL**2 00010 * SCREEN PROCESSOR. DTSCSL2 00011 * DTSCSL2 00012 * DTSCSL2 00013 * MODIFICATION LOG: DTSCSL2 00014 * DTSCSL2 00015 * 03/30/99 INITIAL DEVELOPMENT COPIED FROM MACCSR2 CL**2 00016 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00017 * DTSCSL2 00018 * DTSCSL2 00019 * 05/27/1999 PICKUP MODIFICATIONS. CL**8 00020 * REFERENCE: PICKUP DIR PROGRAMMER: EHH CL**8 00021 * CL**8 00022 * CL**8 00023 * 07/19/1999 DISPLAY SIC AUX CD RATHER THAN NAICS AUX CD. CL**9 00024 * REFERENCE: 07/16/1999 EMAIL PROGRAMMER: EHH CL**9 00025 * FROM GIL CL**9 00026 * CL**9 00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**9 00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX CL**9 00030 * DTSCSL2 00031 * DTSCSL2 00032 * DESCRIPTION: DTSCSL2 00033 * DTSCSL2 00034 * DTSCSL2 00035 * CLEAR: DTSCSL2 00036 * DTSCSL2 00037 * FIELD DISPLAYED: MAP-EMP NO (FROM LCCM-EMP-NO). DTSCSL2 00038 * DTSCSL2 00039 * DTSCSL2 00040 * JUMP: DTSCSL2 00041 * DTSCSL2 00042 * NONE. DTSCSL2 00043 * DTSCSL2 00044 * DTSCSL2 00045 * INQUIRY: DTSCSL2 00046 * DTSCSL2 00047 * CONTROL FIELDS: MAP-EMP-NO. DTSCSL2 00048 * DTSCSL2 00049 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCRL2-HOLD-AREA EMP-NO CL**3 00050 * DISPLAY RECORD INDICATED BY LCCM-SCRL2-HOLD-AREA CL**3 00051 * ELSE DTSCSL2 00052 * DISPLAY FIRST PAGE OF DATA ASSOCIATED WITH DTSCSL2 00053 * LCCM-EMP-NO. DTSCSL2 00054 * DTSCSL2 00055 * ENTER, F5, F6, F7, F8: STANDARD PAGING. IF NO MQTR RECORD DTSCSL2 00056 * EXISTS, THEN DISPLAY THE FIELDS ON DTSCSL2 00057 * THE UPPER TWO THIRDS OF THE SCREEN DTSCSL2 00058 * ON PAGE ' 0 OF 0'. DTSCSL2 00059 * DTSCSL2 00060 * DISPLAY SEQUENCE: DESCENDING ON MQTR-YRQ. DTSCSL2 00061 * DTSCSL2 00062 * PAGE INITIALLY DISPLAYED: FIRST. DTSCSL2 00063 * DTSCSL2 00064 * DTSCSL2 00065 * F11: PROCESS AS THOUGH THE USER HAD KEYED THE VALUE DTSCSL2 00066 * DISPLAYED IN MAP-PRED-EMP-NO INTO MAP-EMP-NO AND DTSCSL2 00067 * PRESSED THE ENTER KEY. DTSCSL2 00068 * DTSCSL2 00069 * F12: PROCESS AS THOUGH THE USER HAD KEYED THE VALUE DTSCSL2 00070 * DISPLAYED IN MAP-SUC-EMP-NO INTO MAP-EMP-NO AND DTSCSL2 00071 * PRESSED THE ENTER KEY. DTSCSL2 00072 * DTSCSL2 00073 * JUMP OUT: STORE PAGING INFORMATION IN LCCM-SCRL2-HOLD-AREA. CL**3 00074 * DTSCSL2 00075 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCSL2 00076 * DTSCSL2 00077 * MAINTAIN PAGING INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCSL2 00078 * DTSCSL2 00079 * DTSCSL2 00080 * UPDATE: DTSCSL2 00081 * DTSCSL2 00082 * NONE. DTSCSL2 00083 * DTSCSL2 00084 * DTSCSL2 00085 * RECORDS READ: DTSCSL2 00086 * DTSCSL2 00087 * MASTER: DTSCSL2 00088 * DTSCSL2 00089 * MPRF DTSCSL2 00090 * MTAD DTSCSL2 00091 * MREL DTSCSL2 00092 * MSOL DTSCSL2 00093 * MQTR DTSCSL2 00094 * DTSCSL2 00095 * DTSCSL2 00096 * ALTERNATE INDEX: DTSCSL2 00097 * DTSCSL2 00098 * IPES DTSCSL2 00099 * DTSCSL2 00100 * DTSCSL2 00101 * REFERENCE: DTSCSL2 00102 * DTSCSL2 00103 * NONE. DTSCSL2 00104 * DTSCSL2 00105 * DTSCSL2 00106 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL2 00107 * DTSCSL2 00108 * NONE. DTSCSL2 00109 * DTSCSL2 00110 * DTSCSL2 00111 * RECORDS UPDATED: DTSCSL2 00112 * DTSCSL2 00113 * MASTER: DTSCSL2 00114 * DTSCSL2 00115 * NONE. DTSCSL2 00116 * DTSCSL2 00117 * DTSCSL2 00118 * REFERENCE: DTSCSL2 00119 * DTSCSL2 00120 * NONE. DTSCSL2 00121 * DTSCSL2 00122 * DTSCSL2 00123 * ACCOUNTING TRASACTION COLLECTION: DTSCSL2 00124 * DTSCSL2 00125 * NONE. DTSCSL2 00126 * DTSCSL2 00127 * DTSCSL2 00128 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCSL2 00129 * DTSCSL2 00130 * NONE. DTSCSL2 00131 * DTSCSL2 00132 * DTSCSL2 00133 * TEMPORARY STORAGE USAGE: DTSCSL2 00134 * DTSCSL2 00135 * S OVERFLOW FROM LCCM-SCR-HOLD-AREA DTSCSL2 00136 * DTSCSL2 00137 * (JEFF: OBVIOUSLY, YOU MAY OR MAY NOT NEED TO DTSCSL2 00138 * USE TS, DEPENDING ON THE TECHNIQUES YOU CHOOSE DTSCSL2 00139 * TO UTILIZE). DTSCSL2 00140 * DTSCSL2 00141 * DTSCSL2 00142 * MODULES LINKED TO: DTSCSL2 00143 * DTSCSL2 00144 * DTSCU001 DATE EDIT/CONVERSION. CL**2 00145 * DTSCU004 QUARTER EDIT/CONVERSION. CL**2 00146 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. CL**2 00147 * DTSCU031 EMPLOYER REGISTRACTION CODES EDIT/DESCRIPTION. CL**2 00148 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. CL**2 00149 * DTSCU038 R&A CODES EDIT/DESCRIPTION. CL**2 00150 * DTSCU039 R&A SIC EDIT/DESCRIPTION. CL**2 00151 * DTSCU056 RATE DISPLAY. CL**2 00152 * DTSCU810 MASTER FILE INPUT/OUTPUT. CL**2 00153 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. CL**2 00154 * DTSCU829 TEMPORARY STORAGE INPUT/OUTPUT. CL**2 00155 * DTSCSL2 00156 * DTSCSL2 00157 ***** DTSCSL2 00158 DTSCSL2 00159 ENVIRONMENT DIVISION. DTSCSL2 00160 DTSCSL2 00161 DATA DIVISION. DTSCSL2 00162 DTSCSL2 00163 WORKING-STORAGE SECTION. DTSCSL2 001635 77 PAN-VALET PICTURE X(24) VALUE '009DTSCSL2 07/19/99'. DTSCSL2 00164 DTSCSL2 00165 01 WRK-AREA. DTSCSL2 00166 05 WRK-ABEND-CD PIC X(04) VALUE 'LM2 '. CL**2 00167 DTSCSL2 00168 05 WRK-SCR-ID PIC X(02) VALUE 'L2'. CL**2 00169 05 FILLER REDEFINES WRK-SCR-ID. DTSCSL2 00170 10 FILLER PIC X(01). DTSCSL2 00171 10 WRK-SCR-ID-N PIC 9(01). DTSCSL2 00172 DTSCSL2 00173 05 WRK-F03-SCR-ID PIC X(02) VALUE 'L0'. CL**2 00174 DTSCSL2 00175 05 QTRS-PER-PAGE PIC S9(04) COMP VALUE +4. DTSCSL2 00176 DTSCSL2 00177 05 HOLD-KEY-AREA PIC X(16). DTSCSL2 00178 DTSCSL2 00179 05 SCR-ACCESS-IND PIC X(01). DTSCSL2 00180 88 SCR-ACCESS-INQ VALUE '1'. DTSCSL2 00181 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCSL2 00182 DTSCSL2 00183 05 CURSOR-SET-IND PIC X(01). DTSCSL2 00184 88 CURSOR-SET-YES VALUE 'Y'. DTSCSL2 00185 88 CURSOR-SET-NO VALUE 'N'. DTSCSL2 00186 88 CURSOR-SET-GOTO VALUE 'G'. DTSCSL2 00187 DTSCSL2 00188 05 REQ-IND PIC X(01). DTSCSL2 00189 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCSL2 00190 88 REQ-ERROR VALUE 'O'. DTSCSL2 00191 88 REQ-JUMP VALUE 'J'. DTSCSL2 00192 88 REQ-UPDATE VALUE 'U'. DTSCSL2 00193 88 REQ-INQUIRE VALUE 'I'. DTSCSL2 00194 88 REQ-CLEAR VALUE 'C'. DTSCSL2 00195 88 REQ-EDIT VALUE 'E'. DTSCSL2 00196 DTSCSL2 00197 05 RESP-IND PIC X(01). DTSCSL2 00198 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCSL2 00199 88 RESP-SEND-MAP VALUE 'M'. DTSCSL2 00200 88 RESP-JUMP VALUE 'J'. DTSCSL2 00201 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCSL2 00202 DTSCSL2 00203 05 WRK-MSG-AREA PIC X(64). DTSCSL2 00204 DTSCSL2 00205 05 WRK-ATB-AN PIC X(01). DTSCSL2 00206 05 WRK-ATB-NUM PIC X(01). DTSCSL2 00207 DTSCSL2 00208 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCSL2 00209 DTSCSL2 00210 05 WRK-SOL-CNT PIC S9(04) COMP. DTSCSL2 00211 DTSCSL2 00212 05 WRK-REL-CNT PIC S9(04) COMP. DTSCSL2 00213 DTSCSL2 00214 05 WRK-PES-CNT PIC S9(04) COMP. DTSCSL2 00215 DTSCSL2 00216 05 WRK-CTR PIC S9(04) COMP. DTSCSL2 00217 DTSCSL2 00218 05 WRK-OCC PIC S9(04) COMP. DTSCSL2 00219 DTSCSL2 00220 05 WRK-SUC-EMP-NO PIC S9(07) COMP-3. DTSCSL2 00221 05 WRK-SUC-EFF-DATE PIC S9(09) COMP-3. DTSCSL2 00222 DTSCSL2 00223 05 WRK-MPRF-IND PIC X(01). DTSCSL2 00224 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCSL2 00225 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCSL2 00226 DTSCSL2 00227 05 WRK-DISPLAY PIC 9(11). DTSCSL2 00228 DTSCSL2 00229 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL2 00230 10 FILLER PIC X(05). DTSCSL2 00231 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCSL2 00232 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCSL2 00233 DTSCSL2 00234 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL2 00235 10 FILLER PIC X(05). DTSCSL2 00236 10 WRK-DISPLAY-YR PIC X(02). DTSCSL2 00237 10 WRK-DISPLAY-MO PIC X(02). DTSCSL2 00238 10 WRK-DISPLAY-DA PIC X(02). DTSCSL2 00239 DTSCSL2 00240 05 FILLER REDEFINES WRK-DISPLAY. DTSCSL2 00241 10 FILLER PIC X(08). DTSCSL2 00242 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCSL2 00243 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCSL2 00244 DTSCSL2 00245 05 INQUIRY-CONTROL-AREA. DTSCSL2 00246 10 LAST-REC-NUM PIC S9(08) COMP. DTSCSL2 00247 DTSCSL2 00248 10 WS-REC-NUM PIC S9(08) COMP. DTSCSL2 00249 DTSCSL2 00250 10 LAST-PAGE-NUM PIC S9(04) COMP. DTSCSL2 00251 DTSCSL2 00252 10 CURR-PAGE-NUM PIC S9(04) COMP. DTSCSL2 00253 DTSCSL2 00254 10 START-REC-NUM PIC S9(04) COMP. DTSCSL2 00255 DTSCSL2 00256 10 LAST-REC-KEY-AREA PIC X(16). DTSCSL2 00257 DTSCSL2 00258 10 SCR-HOLD-AREA. DTSCSL2 00259 15 SCR-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCSL2 00260 15 SCR-HOLD-CURR-PAGE-NUM DTSCSL2 00261 PIC S9(04) COMP. DTSCSL2 00262 DTSCSL2 00263 10 WS-REC-FOUND-IND PIC X(01). DTSCSL2 00264 EJECT DTSCSL2 00265 01 MSG-LITERALS. DTSCSL2 00266 05 MSG-PL21-AREA. CL**5 00267 10 FILLER PIC X(04) VALUE 'PL21'. CL**5 00268 10 FILLER PIC X(30) DTSCSL2 00269 VALUE 'NO QUARTER DATA EXISTS '. DTSCSL2 00270 10 FILLER PIC X(30) DTSCSL2 00271 VALUE ' '. DTSCSL2 00272 05 MSG-EL22-AREA. CL**5 00273 10 FILLER PIC X(04) VALUE 'EL22'. CL**5 00274 10 FILLER PIC X(30) DTSCSL2 00275 VALUE 'NO PREDECESSOR EXISTS '. DTSCSL2 00276 10 FILLER PIC X(30) DTSCSL2 00277 VALUE ' '. DTSCSL2 00278 05 MSG-EL23-AREA. CL**5 00279 10 FILLER PIC X(04) VALUE 'EL23'. CL**5 00280 10 FILLER PIC X(30) DTSCSL2 00281 VALUE 'NO SUCCESSOR EXISTS '. DTSCSL2 00282 10 FILLER PIC X(30) DTSCSL2 00283 VALUE ' '. DTSCSL2 00284 DTSCSL2 00285 EJECT DTSCSL2 00286 01 L001-COMM-AREA. DTSCSL2 00287 ++INCLUDE DTSIL001 CL**2 00288 EJECT DTSCSL2 00289 01 L004-COMM-AREA. DTSCSL2 00290 ++INCLUDE DTSIL004 CL**2 00291 EJECT DTSCSL2 00292 01 L018-COMM-AREA. DTSCSL2 00293 ++INCLUDE DTSIL018 CL**2 00294 EJECT DTSCSL2 00295 01 L031-COMM-AREA. DTSCSL2 00296 ++INCLUDE DTSIL031 CL**2 00297 EJECT DTSCSL2 00298 01 L032-COMM-AREA. DTSCSL2 00299 ++INCLUDE DTSIL032 CL**2 00300 EJECT DTSCSL2 00301 01 L038-COMM-AREA. DTSCSL2 00302 ++INCLUDE DTSIL038 CL**2 00303 EJECT DTSCSL2 00304 *01 L039-COMM-AREA. DTSCSL2 00305 *****COPY MACIL039. DTSCSL2 00306 *****EJECT DTSCSL2 00307 01 L056-COMM-AREA. DTSCSL2 00308 ++INCLUDE DTSIL056 CL**2 00309 EJECT DTSCSL2 00310 *01 L829-COMM-AREA. DTSCSL2 00311 *****COPY MACIL829. DTSCSL2 00312 ***** DTSCSL2 00313 *****10 TS-AREA PIC X(20). DTSCSL2 00314 *****EJECT DTSCSL2 00315 01 L805-COMM-AREA. DTSCSL2 00316 ++INCLUDE DTSIL805 CL**2 00317 EJECT DTSCSL2 00318 01 L810-COMM-AREA. DTSCSL2 00319 05 L810-CONTROL-BLOCK. DTSCSL2 00320 ++INCLUDE DTSIL810 CL**2 00321 EJECT DTSCSL2 00322 05 MSKL-REC. DTSCSL2 00323 ++INCLUDE DTSIMSKL CL**2 00324 EJECT DTSCSL2 00325 01 MPRF-REC. DTSCSL2 00326 ++INCLUDE DTSIMPRF CL**2 00327 EJECT DTSCSL2 00328 01 MTAD-REC. DTSCSL2 00329 ++INCLUDE DTSIMTAD CL**2 00330 EJECT DTSCSL2 00331 01 MREL-REC. DTSCSL2 00332 ++INCLUDE DTSIMREL CL**2 00333 EJECT DTSCSL2 00334 01 MSOL-REC. DTSCSL2 00335 ++INCLUDE DTSIMSOL CL**2 00336 EJECT DTSCSL2 00337 01 MQTR-REC. DTSCSL2 00338 ++INCLUDE DTSIMQTR CL**2 00339 EJECT DTSCSL2 00340 01 L821-COMM-AREA. DTSCSL2 00341 05 L821-CONTROL-BLOCK. DTSCSL2 00342 ++INCLUDE DTSIL821 CL**2 00343 DTSCSL2 00344 05 ISKL-REC. DTSCSL2 00345 ++INCLUDE DTSIISKL CL**2 00346 05 FILLER REDEFINES ISKL-REC. DTSCSL2 00347 ++INCLUDE DTSIIPES CL**2 00348 EJECT DTSCSL2 00349 01 L851-COMM-AREA. DTSCSL2 00350 ++INCLUDE DTSIL851 CL**2 00351 DTSCSL2 00352 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCSL2 00353 ++INCLUDE DTSISL2 CL**2 00354 EJECT DTSCSL2 00355 01 CATB-LITERALS. DTSCSL2 00356 ++INCLUDE DTSICATB CL**2 00357 DTSCSL2 00358 01 CFKD-LITERALS. DTSCSL2 00359 ++INCLUDE DTSICFKD CL**2 00360 DTSCSL2 00361 01 CECD-LITERALS. DTSCSL2 00362 ++INCLUDE DTSICECD CL**2 00363 DTSCSL2 00364 01 CPCD-LITERALS. DTSCSL2 00365 ++INCLUDE DTSICPCD CL**2 00366 EJECT DTSCSL2 00367 LINKAGE SECTION. DTSCSL2 00368 DTSCSL2 00369 01 DFHCOMMAREA. DTSCSL2 00370 ++INCLUDE DTSILCCM CL**2 00371 EJECT DTSCSL2 00372 ******************************************************************DTSCSL2 00373 * *DTSCSL2 00374 ******************************************************************DTSCSL2 00375 DTSCSL2 00376 PROCEDURE DIVISION. DTSCSL2 00377 DTSCSL2 00378 DTSCSL2 00379 MOVE +0 TO WRK-EMP-NO. DTSCSL2 00380 SET WRK-MPRF-NO-88 TO TRUE. DTSCSL2 00381 DTSCSL2 00382 MOVE LOW-VALUES TO MAP-AREA. DTSCSL2 00383 DTSCSL2 00384 SET CURSOR-SET-NO TO TRUE. DTSCSL2 00385 DTSCSL2 00386 SET SCR-ACCESS-INQ TO TRUE. DTSCSL2 00387 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCSL2 00388 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCSL2 00389 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCSL2 00390 DTSCSL2 00391 MOVE SPACE TO REQ-IND. DTSCSL2 00392 DTSCSL2 00393 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCSL2 00394 DTSCSL2 00395 *----------------------------------------------------- DTSCSL2 00396 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCSL2 00397 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCSL2 00398 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCSL2 00399 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCSL2 00400 * DTSCSL2 00401 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCSL2 00402 * PROCESSED. DTSCSL2 00403 * DTSCSL2 00404 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCSL2 00405 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCSL2 00406 * WORK STATION OPERATOR. DTSCSL2 00407 *----------------------------------------------------- DTSCSL2 00408 DTSCSL2 00409 MOVE SPACE TO RESP-IND. DTSCSL2 00410 DTSCSL2 00411 IF REQ-ERROR DTSCSL2 00412 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCSL2 00413 ELSE DTSCSL2 00414 IF REQ-JUMP DTSCSL2 00415 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCSL2 00416 ELSE DTSCSL2 00417 IF REQ-CLEAR DTSCSL2 00418 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCSL2 00419 ELSE DTSCSL2 00420 IF REQ-CURSOR-TO-GOTO DTSCSL2 00421 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCSL2 00422 ELSE DTSCSL2 00423 IF REQ-INQUIRE DTSCSL2 00424 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSL2 00425 ELSE DTSCSL2 00426 GO TO S899-ABEND. DTSCSL2 00427 DTSCSL2 00428 *----------------------------------------------------- DTSCSL2 00429 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCSL2 00430 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCSL2 00431 *----------------------------------------------------- DTSCSL2 00432 DTSCSL2 00433 IF RESP-SEND-MAP DTSCSL2 00434 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCSL2 00435 SET LCCM-END-TASK-88 TO TRUE DTSCSL2 00436 ELSE DTSCSL2 00437 IF RESP-SEND-MSGONLY DTSCSL2 00438 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL2 00439 SET LCCM-END-TASK-88 TO TRUE DTSCSL2 00440 ELSE DTSCSL2 00441 IF RESP-JUMP DTSCSL2 00442 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL2 00443 ELSE DTSCSL2 00444 IF RESP-CURSOR-TO-GOTO DTSCSL2 00445 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL2 00446 SET LCCM-END-TASK-88 TO TRUE DTSCSL2 00447 ELSE DTSCSL2 00448 GO TO S899-ABEND. DTSCSL2 00449 DTSCSL2 00450 MAINLINE-EXIT. DTSCSL2 00451 DTSCSL2 00452 EXEC CICS DTSCSL2 00453 RETURN DTSCSL2 00454 END-EXEC. DTSCSL2 00455 DTSCSL2 00456 GOBACK. DTSCSL2 00457 DTSCSL2 00458 DTSCSL2 00459 DTSCSL2 00460 P0100-ACCESS-SEARCH. DTSCSL2 00461 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCSL2 00462 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCSL2 00463 TO SCR-ACCESS-IND. DTSCSL2 00464 P0100-EXIT. DTSCSL2 00465 EXIT. DTSCSL2 00466 EJECT DTSCSL2 00467 /*****************************************************************DTSCSL2 00468 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCSL2 00469 ******************************************************************DTSCSL2 00470 P1000-ANALYZE-REQUEST. DTSCSL2 00471 DTSCSL2 00472 *----------------------------------------------------- DTSCSL2 00473 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCSL2 00474 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCSL2 00475 * REPLACED WITH ENTER) DTSCSL2 00476 *----------------------------------------------------- DTSCSL2 00477 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCSL2 00478 SET LCCM-ENTER-88 TO TRUE DTSCSL2 00479 SET REQ-INQUIRE TO TRUE DTSCSL2 00480 IF LCCM-EMP-NO > ZERO DTSCSL2 00481 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCSL2 00482 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCSL2 00483 END-IF DTSCSL2 00484 GO TO P1000-EXIT. DTSCSL2 00485 DTSCSL2 00486 *----------------------------------------------------- DTSCSL2 00487 * MAP IS RECEIVED DTSCSL2 00488 *----------------------------------------------------- DTSCSL2 00489 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCSL2 00490 DTSCSL2 00491 *----------------------------------------------------- DTSCSL2 00492 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCSL2 00493 * WORK STATION DTSCSL2 00494 *----------------------------------------------------- DTSCSL2 00495 IF LCCM-CLEAR-88 DTSCSL2 00496 SET REQ-CLEAR TO TRUE DTSCSL2 00497 GO TO P1000-EXIT. DTSCSL2 00498 DTSCSL2 00499 *----------------------------------------------------- DTSCSL2 00500 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCSL2 00501 *----------------------------------------------------- DTSCSL2 00502 IF LCCM-PA2-88 DTSCSL2 00503 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCSL2 00504 GO TO P1000-EXIT. DTSCSL2 00505 DTSCSL2 00506 *----------------------------------------------------- DTSCSL2 00507 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCSL2 00508 *----------------------------------------------------- DTSCSL2 00509 IF LCCM-PA-88 DTSCSL2 00510 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL2 00511 SET REQ-ERROR TO TRUE DTSCSL2 00512 GO TO P1000-EXIT. DTSCSL2 00513 DTSCSL2 00514 *----------------------------------------------------- CL**2 00515 * IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS CL**2 00516 * CLEAR SCREEN CL**2 00517 *----------------------------------------------------- CL**2 00518 IF LCCM-F12-88 CL**2 00519 MOVE LOW-VALUES TO MAP-AREA CL**2 00520 SET REQ-CLEAR TO TRUE CL**2 00521 GO TO P1000-EXIT. CL**2 00522 CL**2 00523 *----------------------------------------------------- DTSCSL2 00524 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSL2 00525 *----------------------------------------------------- DTSCSL2 00526 IF LCCM-F03-88 DTSCSL2 00527 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL2 00528 SET REQ-JUMP TO TRUE DTSCSL2 00529 GO TO P1000-EXIT. DTSCSL2 00530 DTSCSL2 00531 *----------------------------------------------------- DTSCSL2 00532 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCSL2 00533 *----------------------------------------------------- DTSCSL2 00534 IF LCCM-F04-88 DTSCSL2 00535 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL2 00536 SET REQ-JUMP TO TRUE DTSCSL2 00537 GO TO P1000-EXIT. DTSCSL2 00538 DTSCSL2 00539 *--------------------------------------------------------- DTSCSL2 00540 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCSL2 00541 * CORRESPONDENCE SCREEN. DTSCSL2 00542 *--------------------------------------------------------- DTSCSL2 00543 CL**7 00544 IF LCCM-F14-88 CL**7 00545 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID CL**7 00546 SET REQ-JUMP TO TRUE CL**7 00547 GO TO P1000-EXIT. CL**7 00548 CL**7 00549 *----------------------------------------------------- DTSCSL2 00550 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCSL2 00551 * REQUESTED SCREEN TYPE DTSCSL2 00552 *----------------------------------------------------- DTSCSL2 00553 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCSL2 00554 NEXT SENTENCE DTSCSL2 00555 ELSE DTSCSL2 00556 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCSL2 00557 SET REQ-JUMP TO TRUE DTSCSL2 00558 GO TO P1000-EXIT. DTSCSL2 00559 DTSCSL2 00560 *----------------------------------------------------- DTSCSL2 00561 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCSL2 00562 * OR F8), INDICATE INQUIRY REQUEST DTSCSL2 00563 *----------------------------------------------------- DTSCSL2 00564 IF LCCM-INQUIRY-88 DTSCSL2 00565 SET REQ-INQUIRE TO TRUE DTSCSL2 00566 GO TO P1000-EXIT. DTSCSL2 00567 DTSCSL2 00568 *----------------------------------------------------- DTSCSL2 00569 * IF SWITCH EMPLOYER F19 / F20 THEN VERIFY THAT THERE CL**5 00570 * IS A PRED OR SUCC EMP NO AND THEN PROCESS AS IF THE DTSCSL2 00571 * PRED OR EMP NO WAS ENTERED ON THE SCREEN DTSCSL2 00572 *----------------------------------------------------- DTSCSL2 00573 IF LCCM-F19-88 CL**5 00574 SET LCCM-ENTER-88 TO TRUE DTSCSL2 00575 SET REQ-INQUIRE TO TRUE DTSCSL2 00576 PERFORM P1100-CHECK-PRED-EMP-NO THRU P1100-EXIT DTSCSL2 00577 GO TO P1000-EXIT. DTSCSL2 00578 DTSCSL2 00579 IF LCCM-F20-88 CL**5 00580 SET LCCM-ENTER-88 TO TRUE DTSCSL2 00581 SET REQ-INQUIRE TO TRUE DTSCSL2 00582 PERFORM P1200-CHECK-SUCC-EMP-NO THRU P1200-EXIT DTSCSL2 00583 GO TO P1000-EXIT. DTSCSL2 00584 DTSCSL2 00585 *----------------------------------------------------- DTSCSL2 00586 * ANY OTHER KEY IS INVALID DTSCSL2 00587 *----------------------------------------------------- DTSCSL2 00588 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCSL2 00589 SET REQ-ERROR TO TRUE. DTSCSL2 00590 P1000-EXIT. DTSCSL2 00591 EXIT. DTSCSL2 00592 DTSCSL2 00593 P1100-CHECK-PRED-EMP-NO. DTSCSL2 00594 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL2 00595 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL2 00596 DTSCSL2 00597 IF L018-NO-ENTRY DTSCSL2 00598 MOVE MSG-EL22-AREA TO LCCM-MSG-AREA CL**5 00599 SET REQ-ERROR TO TRUE DTSCSL2 00600 ELSE DTSCSL2 00601 MOVE MAP-PRED-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCSL2 00602 DTSCSL2 00603 P1100-EXIT. DTSCSL2 00604 EXIT. DTSCSL2 00605 DTSCSL2 00606 P1200-CHECK-SUCC-EMP-NO. DTSCSL2 00607 MOVE MAP-SUCC-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL2 00608 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL2 00609 DTSCSL2 00610 IF L018-NO-ENTRY DTSCSL2 00611 MOVE MSG-EL23-AREA TO LCCM-MSG-AREA CL**5 00612 SET REQ-ERROR TO TRUE DTSCSL2 00613 ELSE DTSCSL2 00614 MOVE MAP-SUCC-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCSL2 00615 DTSCSL2 00616 P1200-EXIT. DTSCSL2 00617 EXIT. DTSCSL2 00618 DTSCSL2 00619 /*****************************************************************DTSCSL2 00620 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSL2 00621 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCSL2 00622 ******************************************************************DTSCSL2 00623 DTSCSL2 00624 P2000-REQUEST-ERROR. DTSCSL2 00625 IF LCCM-MSG DTSCSL2 00626 SET RESP-SEND-MSGONLY TO TRUE DTSCSL2 00627 ELSE DTSCSL2 00628 GO TO S899-ABEND. DTSCSL2 00629 P2000-EXIT. DTSCSL2 00630 EXIT. DTSCSL2 00631 /*****************************************************************DTSCSL2 00632 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCSL2 00633 ******************************************************************DTSCSL2 00634 DTSCSL2 00635 P3000-REQUEST-JUMP. DTSCSL2 00636 *----------------------------------------------------- DTSCSL2 00637 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCSL2 00638 * BY USER DTSCSL2 00639 *----------------------------------------------------- DTSCSL2 00640 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCSL2 00641 DTSCSL2 00642 *----------------------------------------------------- DTSCSL2 00643 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCSL2 00644 *----------------------------------------------------- DTSCSL2 00645 IF LCCM-MSG DTSCSL2 00646 SET RESP-SEND-MSGONLY TO TRUE DTSCSL2 00647 SET CURSOR-SET-GOTO TO TRUE DTSCSL2 00648 GO TO P3000-EXIT. DTSCSL2 00649 SKIP3 DTSCSL2 00650 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL2 00651 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL2 00652 IF L018-VALID DTSCSL2 00653 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCSL2 00654 SKIP3 DTSCSL2 00655 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCSL2 00656 LCCM-SCR-HOLD-AREA. DTSCSL2 00657 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCSL2 00658 SET RESP-JUMP TO TRUE. DTSCSL2 00659 P3000-EXIT. DTSCSL2 00660 EXIT. DTSCSL2 00661 /*****************************************************************DTSCSL2 00662 * CLEAR KEY WAS PRESSED *DTSCSL2 00663 ******************************************************************DTSCSL2 00664 DTSCSL2 00665 P4000-REQUEST-CLEAR. DTSCSL2 00666 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL2 00667 DTSCSL2 00668 *----------------------------------------------------- DTSCSL2 00669 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCSL2 00670 * FIELDS FROM EARLIER REQUESTS DTSCSL2 00671 *----------------------------------------------------- DTSCSL2 00672 IF LCCM-EMP-NO > ZERO DTSCSL2 00673 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCSL2 00674 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCSL2 00675 DTSCSL2 00676 MOVE ZERO TO LCCM-EMP-NO. DTSCSL2 00677 DTSCSL2 00678 MOVE LOW-VALUES TO LCCM-SCRL2-HOLD-AREA. CL**3 00679 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL2 00680 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL2 00681 SET RESP-SEND-MAP TO TRUE. DTSCSL2 00682 P4000-EXIT. DTSCSL2 00683 EXIT. DTSCSL2 00684 /*****************************************************************DTSCSL2 00685 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCSL2 00686 ******************************************************************DTSCSL2 00687 DTSCSL2 00688 P5000-CURSOR-TO-GOTO. DTSCSL2 00689 SET CURSOR-SET-GOTO TO TRUE. DTSCSL2 00690 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCSL2 00691 P5000-EXIT. DTSCSL2 00692 EXIT. DTSCSL2 00693 /*****************************************************************DTSCSL2 00694 * INQUIRY WAS REQUESTED *DTSCSL2 00695 ******************************************************************DTSCSL2 00696 DTSCSL2 00697 P6000-REQUEST-INQUIRE. DTSCSL2 00698 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL2 00699 MOVE LOW-VALUES TO MAP-AREA. DTSCSL2 00700 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCSL2 00701 DTSCSL2 00702 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL2 00703 DTSCSL2 00704 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL2 00705 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL2 00706 DTSCSL2 00707 SET RESP-SEND-MAP TO TRUE. DTSCSL2 00708 DTSCSL2 00709 MOVE LCCM-SCRL2-HOLD-AREA TO SCR-HOLD-AREA. CL**3 00710 MOVE LOW-VALUES TO LCCM-SCRL2-HOLD-AREA. CL**3 00711 DTSCSL2 00712 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCSL2 00713 IF LCCM-MSG DTSCSL2 00714 GO TO P6000-EXIT. DTSCSL2 00715 DTSCSL2 00716 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCSL2 00717 IF LCCM-MSG DTSCSL2 00718 GO TO P6000-EXIT. DTSCSL2 00719 DTSCSL2 00720 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCSL2 00721 DTSCSL2 00722 PERFORM P6100-LOCATE-PAGE THRU P6100-EXIT. DTSCSL2 00723 IF LCCM-MSG DTSCSL2 00724 GO TO P6000-EXIT. DTSCSL2 00725 DTSCSL2 00726 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCSL2 00727 DTSCSL2 00728 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL2 00729 P6000-EXIT. DTSCSL2 00730 EXIT. DTSCSL2 00731 EJECT DTSCSL2 00732 P6100-LOCATE-PAGE. DTSCSL2 00733 MOVE LOW-VALUES TO MSKL-REC. DTSCSL2 00734 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL2 00735 SET MSKL-QTR-88 TO TRUE. DTSCSL2 00736 PERFORM S810-COUNT THRU S810-EXIT. DTSCSL2 00737 DTSCSL2 00738 MOVE L810-RECORD-CNT TO LAST-REC-NUM. DTSCSL2 00739 DTSCSL2 00740 IF LAST-REC-NUM = +0 DTSCSL2 00741 MOVE +0 TO LAST-PAGE-NUM DTSCSL2 00742 CURR-PAGE-NUM DTSCSL2 00743 GO TO P6100-EXIT. DTSCSL2 00744 DTSCSL2 00745 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCSL2 00746 DTSCSL2 00747 COMPUTE LAST-PAGE-NUM DTSCSL2 00748 = ((LAST-REC-NUM - 1) / QTRS-PER-PAGE) + 1. DTSCSL2 00749 DTSCSL2 00750 IF SCR-HOLD-AREA = LOW-VALUES DTSCSL2 00751 MOVE +1 TO CURR-PAGE-NUM DTSCSL2 00752 GO TO P6100-EXIT. DTSCSL2 00753 DTSCSL2 00754 IF SCR-HOLD-EMP-NO = WRK-EMP-NO DTSCSL2 00755 NEXT SENTENCE DTSCSL2 00756 ELSE DTSCSL2 00757 MOVE +1 TO CURR-PAGE-NUM DTSCSL2 00758 GO TO P6100-EXIT. DTSCSL2 00759 DTSCSL2 00760 IF LCCM-ENTER-88 DTSCSL2 00761 MOVE SCR-HOLD-CURR-PAGE-NUM TO CURR-PAGE-NUM DTSCSL2 00762 ELSE DTSCSL2 00763 IF LCCM-F05-88 DTSCSL2 00764 MOVE +1 TO CURR-PAGE-NUM DTSCSL2 00765 ELSE DTSCSL2 00766 IF LCCM-F06-88 DTSCSL2 00767 MOVE LAST-PAGE-NUM TO CURR-PAGE-NUM DTSCSL2 00768 ELSE DTSCSL2 00769 IF LCCM-F07-88 DTSCSL2 00770 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM - 1 DTSCSL2 00771 ELSE DTSCSL2 00772 IF LCCM-F08-88 DTSCSL2 00773 COMPUTE CURR-PAGE-NUM = SCR-HOLD-CURR-PAGE-NUM + 1 DTSCSL2 00774 ELSE DTSCSL2 00775 GO TO S899-ABEND. DTSCSL2 00776 DTSCSL2 00777 IF CURR-PAGE-NUM < +1 DTSCSL2 00778 MOVE +1 TO CURR-PAGE-NUM DTSCSL2 00779 ELSE DTSCSL2 00780 IF CURR-PAGE-NUM > LAST-PAGE-NUM DTSCSL2 00781 MOVE LAST-PAGE-NUM TO CURR-PAGE-NUM. DTSCSL2 00782 P6100-EXIT. DTSCSL2 00783 EXIT. DTSCSL2 00784 /*****************************************************************DTSCSL2 00785 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCSL2 00786 ******************************************************************DTSCSL2 00787 DTSCSL2 00788 P6900-CONSTRUCT-SCREEN. DTSCSL2 00789 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCSL2 00790 PERFORM P6920-FROM-MTAD THRU P6920-EXIT. DTSCSL2 00791 PERFORM P6930-FROM-MSOL THRU P6930-EXIT. DTSCSL2 00792 PERFORM P6940-FROM-IPES THRU P6940-EXIT. DTSCSL2 00793 PERFORM P6950-FROM-MREL THRU P6950-EXIT. DTSCSL2 00794 DTSCSL2 00795 IF CURR-PAGE-NUM = +0 DTSCSL2 00796 NEXT SENTENCE DTSCSL2 00797 ELSE DTSCSL2 00798 PERFORM P6970-FROM-MQTR THRU P6970-EXIT. DTSCSL2 00799 DTSCSL2 00800 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCSL2 00801 DTSCSL2 00802 MOVE WRK-EMP-NO TO SCR-HOLD-EMP-NO. DTSCSL2 00803 MOVE CURR-PAGE-NUM TO SCR-HOLD-CURR-PAGE-NUM. DTSCSL2 00804 DTSCSL2 00805 MOVE SCR-HOLD-AREA TO LCCM-SCRL2-HOLD-AREA. CL**3 00806 P6900-EXIT. DTSCSL2 00807 EXIT. DTSCSL2 00808 DTSCSL2 00809 P6910-FROM-MPRF. DTSCSL2 00810 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. CL**2 00811 CL**2 00812 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. CL**2 00813 DTSCSL2 00814 MOVE MPRF-EMP-CLASS TO L031-CD. DTSCSL2 00815 PERFORM S031-MPRF-EMP-CLASS THRU S031-EXIT. DTSCSL2 00816 MOVE L031-SHORT-DSCR TO MAP-EMP-CLASS-DSCR. DTSCSL2 00817 DTSCSL2 00818 MOVE MPRF-EMP-STATUS TO L031-CD. DTSCSL2 00819 PERFORM S031-MPRF-EMP-STATUS THRU S031-EXIT. DTSCSL2 00820 MOVE L031-SHORT-DSCR TO MAP-EMP-STATUS-DSCR. DTSCSL2 00821 DTSCSL2 00822 MOVE MPRF-NAICS-CD TO MAP-NAICS-CD. CL**2 00823 DTSCSL2 00824 IF MPRF-NAICS-CHNG-DATE > +0 CL**2 00825 MOVE MPRF-OLD-NAICS-CD TO MAP-OLD-NAICS-CD CL**2 00826 MOVE MPRF-NAICS-CHNG-DATE TO L001-FED-8-DATE-9 CL**2 00827 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL2 00828 MOVE L001-SLASH-DATE TO MAP-NAICS-CHNG-DATE CL**2 00829 END-IF. DTSCSL2 00830 DTSCSL2 00831 MOVE MPRF-SIC-CD TO MAP-SIC-CD. DTSCSL2 00832 DTSCSL2 00833 IF MPRF-SIC-CHNG-DATE > +0 DTSCSL2 00834 MOVE MPRF-OLD-SIC-CD TO MAP-OLD-SIC-CD DTSCSL2 00835 MOVE MPRF-SIC-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL2 00836 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL2 00837 MOVE L001-SLASH-DATE TO MAP-SIC-CHNG-DATE DTSCSL2 00838 END-IF. DTSCSL2 00839 DTSCSL2 00840 MOVE MPRF-OWN-CD TO MAP-OWN-CD. DTSCSL2 00841 DTSCSL2 00842 IF MPRF-OWN-CHNG-DATE > +0 DTSCSL2 00843 MOVE MPRF-OLD-OWN-CD TO MAP-OLD-OWN-CD DTSCSL2 00844 MOVE MPRF-OWN-CHNG-DATE TO L001-FED-8-DATE-9 DTSCSL2 00845 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL2 00846 MOVE L001-SLASH-DATE TO MAP-OWN-CHNG-DATE DTSCSL2 00847 END-IF. DTSCSL2 00848 DTSCSL2 00849 MOVE MPRF-SIC-AUXILIARY-CD TO MAP-SIC-AUX-CD. CL**9 00850 CL**2 00851 MOVE MPRF-MULTI-IND TO MAP-MULTI-IND. CL**2 00852 CL**2 00853 IF MPRF-FEIN > +0 DTSCSL2 00854 MOVE MPRF-FEIN TO MAP-FEIN. DTSCSL2 00855 DTSCSL2 00856 MOVE MPRF-ORG-TYPE TO MAP-ORG-TYPE DTSCSL2 00857 L031-CD. DTSCSL2 00858 PERFORM S031-MPRF-ORG-TYPE THRU S031-EXIT. DTSCSL2 00859 MOVE L031-SHORT-DSCR TO MAP-ORG-TYPE-DSCR. DTSCSL2 00860 DTSCSL2 00861 IF MPRF-DC-BUSINESS-TAX-ACCT-NO > +0 CL**5 00862 MOVE MPRF-DC-BUSINESS-TAX-ACCT-NO TO MAP-BTN. CL**5 00863 CL**5 00864 MOVE MPRF-WARD-CD TO MAP-WARD-CD. CL**2 00865 CL**2 00866 P6910-EXIT. DTSCSL2 00867 EXIT. DTSCSL2 00868 DTSCSL2 00869 P6920-FROM-MTAD. DTSCSL2 00870 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCSL2 00871 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCSL2 00872 SET MTAD-TAD-88 TO TRUE. DTSCSL2 00873 MOVE 1 TO MTAD-ID-NO. DTSCSL2 00874 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCSL2 00875 PERFORM S810-READ THRU S810-EXIT. DTSCSL2 00876 IF L810-OK-88 DTSCSL2 00877 PERFORM P6921-FORMAT-TAD-1 THRU P6921-EXIT DTSCSL2 00878 END-IF. DTSCSL2 00879 DTSCSL2 00880 MOVE 2 TO MTAD-ID-NO. DTSCSL2 00881 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCSL2 00882 PERFORM S810-READ THRU S810-EXIT. DTSCSL2 00883 IF L810-OK-88 DTSCSL2 00884 PERFORM P6922-FORMAT-TAD-2 THRU P6922-EXIT DTSCSL2 00885 END-IF. DTSCSL2 00886 P6920-EXIT. DTSCSL2 00887 EXIT. DTSCSL2 00888 P6921-FORMAT-TAD-1. DTSCSL2 00889 MOVE MSKL-REC TO MTAD-REC. DTSCSL2 00890 MOVE MTAD-ATTN-LINE TO MAP-TAX-ATTN. CL**2 00891 MOVE MTAD-DELIV-LINE-1 TO MAP-TAX-DLV1. CL**2 00892 MOVE MTAD-DELIV-LINE-2 TO MAP-TAX-DLV2 CL**2 00893 MOVE MTAD-CITY TO MAP-TAX-CITY. CL**2 00894 MOVE MTAD-ST TO MAP-TAX-ST. CL**2 00895 MOVE MTAD-ZIP TO MAP-TAX-ZIP. CL**2 00896 DTSCSL2 00897 MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-AREA-CD-1. CL**3 00898 MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-PREFIX-1. CL**3 00899 MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-SUFFIX-1. CL**3 00900 MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-EXTION-1. CL**3 00901 DTSCSL2 00902 P6921-EXIT. DTSCSL2 00903 EXIT. DTSCSL2 00904 DTSCSL2 00905 P6922-FORMAT-TAD-2. DTSCSL2 00906 MOVE MSKL-REC TO MTAD-REC. DTSCSL2 00907 MOVE MTAD-ATTN-LINE TO MAP-DC-ATTN. CL**2 00908 MOVE MTAD-DELIV-LINE-1 TO MAP-DC-DLV1. CL**2 00909 MOVE MTAD-DELIV-LINE-2 TO MAP-DC-DLV2. CL**2 00910 MOVE MTAD-CITY TO MAP-DC-CITY. CL**2 00911 MOVE MTAD-ST TO MAP-DC-ST. CL**2 00912 MOVE MTAD-ZIP TO MAP-DC-ZIP. CL**2 00913 DTSCSL2 00914 MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-AREA-CD-2. CL**3 00915 MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-PREFIX-2. CL**3 00916 MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-SUFFIX-2. CL**3 00917 MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-EXTION-2. CL**3 00918 DTSCSL2 00919 P6922-EXIT. DTSCSL2 00920 EXIT. DTSCSL2 00921 DTSCSL2 00922 P6930-FROM-MSOL. DTSCSL2 00923 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCSL2 00924 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCSL2 00925 SET MSKL-SOL-88 TO TRUE. DTSCSL2 00926 PERFORM S810-COUNT THRU S810-EXIT. DTSCSL2 00927 DTSCSL2 00928 IF L810-RECORD-CNT = +0 DTSCSL2 00929 GO TO P6930-EXIT. DTSCSL2 00930 DTSCSL2 00931 MOVE L810-RECORD-CNT TO MAP-SOL-CNT DTSCSL2 00932 WRK-SOL-CNT. DTSCSL2 00933 DTSCSL2 00934 PERFORM S810-READ THRU S810-EXIT. DTSCSL2 00935 MOVE MSKL-REC TO MSOL-REC. DTSCSL2 00936 IF MSOL-INACT-WITHDRAWN-88 DTSCSL2 00937 AND WRK-SOL-CNT > +1 DTSCSL2 00938 PERFORM P6931-LOCATE-MSOL THRU P6931-EXIT. DTSCSL2 00939 DTSCSL2 00940 MOVE MSOL-LIAB-DATE TO L001-FED-8-DATE-9. DTSCSL2 00941 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCSL2 00942 MOVE L001-SLASH-DATE TO MAP-LIAB-DATE. DTSCSL2 00943 DTSCSL2 00944 IF MSOL-FIRST-LIAB-YRQ > +0 DTSCSL2 00945 MOVE MSOL-FIRST-LIAB-YRQ TO L004-QTR-5-9 DTSCSL2 00946 PERFORM S004-FROM-5 THRU S004-EXIT DTSCSL2 00947 MOVE L004-SLASH-QTR TO MAP-FIRST-LIAB-YRQ. DTSCSL2 00948 DTSCSL2 00949 MOVE MSOL-LIAB-CD TO MAP-LIAB-CD DTSCSL2 00950 L031-CD. DTSCSL2 00951 PERFORM S031-MSOL-LIAB-CD THRU S031-EXIT. DTSCSL2 00952 MOVE L031-SHORT-DSCR TO MAP-LIAB-CD-DSCR. DTSCSL2 00953 DTSCSL2 00954 IF MSOL-INACT-INACTIVE-88 DTSCSL2 00955 MOVE MSOL-INACT-DATE TO L001-FED-8-DATE-9 DTSCSL2 00956 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL2 00957 MOVE L001-SLASH-DATE TO MAP-INACT-DATE DTSCSL2 00958 MOVE MSOL-INACT-CD TO MAP-INACT-CD DTSCSL2 00959 L031-CD DTSCSL2 00960 PERFORM S031-MSOL-INACT-CD THRU S031-EXIT DTSCSL2 00961 MOVE L031-SHORT-DSCR TO MAP-INACT-CD-DSCR DTSCSL2 00962 IF MSOL-LAST-LIAB-YRQ > +0 DTSCSL2 00963 MOVE MSOL-LAST-LIAB-YRQ TO L004-QTR-5-9 DTSCSL2 00964 PERFORM S004-FROM-5 THRU S004-EXIT DTSCSL2 00965 MOVE L004-SLASH-QTR TO MAP-LAST-LIAB-YRQ. DTSCSL2 00966 DTSCSL2 00967 P6930-EXIT. DTSCSL2 00968 EXIT. DTSCSL2 00969 DTSCSL2 00970 P6931-LOCATE-MSOL. DTSCSL2 00971 MOVE MSKL-KEY-AREA TO HOLD-KEY-AREA. DTSCSL2 00972 DTSCSL2 00973 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL2 00974 MOVE MSKL-REC TO MSOL-REC. DTSCSL2 00975 DTSCSL2 00976 PERFORM UNTIL L810-NO-REC-88 DTSCSL2 00977 OR NOT MSOL-INACT-WITHDRAWN-88 DTSCSL2 00978 PERFORM S810-READ-PREV THRU S810-EXIT DTSCSL2 00979 MOVE MSKL-REC TO MSOL-REC DTSCSL2 00980 END-PERFORM. DTSCSL2 00981 DTSCSL2 00982 IF L810-OK-88 DTSCSL2 00983 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCSL2 00984 ELSE DTSCSL2 00985 MOVE HOLD-KEY-AREA TO MSKL-KEY-AREA DTSCSL2 00986 PERFORM S810-READ THRU S810-EXIT DTSCSL2 00987 MOVE MSKL-REC TO MSOL-REC. DTSCSL2 00988 P6931-EXIT. DTSCSL2 00989 EXIT. DTSCSL2 00990 DTSCSL2 00991 P6940-FROM-IPES. DTSCSL2 00992 MOVE +0 TO WRK-PES-CNT. DTSCSL2 00993 DTSCSL2 00994 MOVE +0 TO WRK-SUC-EMP-NO DTSCSL2 00995 WRK-SUC-EFF-DATE. DTSCSL2 00996 DTSCSL2 00997 MOVE LOW-VALUES TO IPES-KEY-AREA. DTSCSL2 00998 SET IPES-PES-88 TO TRUE. DTSCSL2 00999 MOVE LCCM-EMP-NO TO IPES-PRED-EMP-NO. DTSCSL2 01000 MOVE ZEROS TO IPES-EFF-DATE DTSCSL2 01001 IPES-SUC-EMP-NO. DTSCSL2 01002 DTSCSL2 01003 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCSL2 01004 DTSCSL2 01005 PERFORM P6941-SCAN-IPES THRU P6941-EXIT DTSCSL2 01006 UNTIL L821-NO-REC-88. DTSCSL2 01007 DTSCSL2 01008 IF WRK-PES-CNT = +0 DTSCSL2 01009 GO TO P6940-EXIT. DTSCSL2 01010 DTSCSL2 01011 MOVE WRK-PES-CNT TO MAP-SUCC-CNT. DTSCSL2 01012 MOVE WRK-SUC-EMP-NO TO WRK-DISPLAY. DTSCSL2 01013 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-SUCC-EMP-NO-1. DTSCSL2 01014 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-SUCC-EMP-NO-2. DTSCSL2 01015 MOVE WRK-SUC-EFF-DATE TO L001-FED-8-DATE-9. DTSCSL2 01016 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCSL2 01017 MOVE L001-SLASH-DATE TO MAP-SUCC-EFF-DATE. DTSCSL2 01018 DTSCSL2 01019 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSCSL2 01020 MOVE WRK-SUC-EMP-NO TO MREL-EMP-NO. DTSCSL2 01021 SET MREL-REL-88 TO TRUE. DTSCSL2 01022 MOVE WRK-SUC-EFF-DATE TO MREL-EFF-DATE. DTSCSL2 01023 MOVE WRK-EMP-NO TO MREL-PRED-EMP-NO. DTSCSL2 01024 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSCSL2 01025 PERFORM S810-READ THRU S810-EXIT. DTSCSL2 01026 IF L810-OK-88 DTSCSL2 01027 MOVE MSKL-REC TO MREL-REC DTSCSL2 01028 MOVE MREL-RELATIONSHIP-CD TO MAP-SUCC-REL-CD DTSCSL2 01029 L031-CD DTSCSL2 01030 PERFORM S031-MREL-RELATIONSHIP-CD THRU S031-EXIT DTSCSL2 01031 MOVE L031-SHORT-DSCR TO MAP-SUCC-REL-CD-DSCR. DTSCSL2 01032 P6940-EXIT. DTSCSL2 01033 EXIT. DTSCSL2 01034 DTSCSL2 01035 P6941-SCAN-IPES. DTSCSL2 01036 IF IPES-PRED-EMP-NO = WRK-EMP-NO DTSCSL2 01037 NEXT SENTENCE DTSCSL2 01038 ELSE DTSCSL2 01039 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCSL2 01040 SET L821-NO-REC-88 TO TRUE DTSCSL2 01041 GO TO P6941-EXIT. DTSCSL2 01042 DTSCSL2 01043 ADD +1 TO WRK-PES-CNT. DTSCSL2 01044 DTSCSL2 01045 MOVE IPES-SUC-EMP-NO TO WRK-SUC-EMP-NO. DTSCSL2 01046 MOVE IPES-EFF-DATE TO WRK-SUC-EFF-DATE. DTSCSL2 01047 DTSCSL2 01048 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCSL2 01049 P6941-EXIT. DTSCSL2 01050 EXIT. DTSCSL2 01051 DTSCSL2 01052 DTSCSL2 01053 DTSCSL2 01054 P6950-FROM-MREL. DTSCSL2 01055 MOVE +0 TO WRK-REL-CNT. DTSCSL2 01056 DTSCSL2 01057 MOVE LOW-VALUES TO MREL-KEY-AREA. DTSCSL2 01058 MOVE WRK-EMP-NO TO MREL-EMP-NO. DTSCSL2 01059 MOVE ZEROS TO MREL-PRED-EMP-NO. DTSCSL2 01060 MOVE ZEROS TO MREL-EFF-DATE. DTSCSL2 01061 SET MREL-REL-88 TO TRUE. DTSCSL2 01062 MOVE MREL-KEY-AREA TO MSKL-KEY-AREA. DTSCSL2 01063 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL2 01064 DTSCSL2 01065 IF L810-NO-REC-88 DTSCSL2 01066 GO TO P6950-EXIT. DTSCSL2 01067 DTSCSL2 01068 PERFORM DTSCSL2 01069 UNTIL L810-NO-REC-88 DTSCSL2 01070 ADD +1 TO WRK-REL-CNT DTSCSL2 01071 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCSL2 01072 END-PERFORM. DTSCSL2 01073 DTSCSL2 01074 MOVE WRK-REL-CNT TO MAP-PRED-CNT. DTSCSL2 01075 DTSCSL2 01076 MOVE MSKL-REC TO MREL-REC. DTSCSL2 01077 MOVE MREL-PRED-EMP-NO TO WRK-DISPLAY. DTSCSL2 01078 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-EMP-NO-1. DTSCSL2 01079 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-EMP-NO-2. DTSCSL2 01080 MOVE MREL-EFF-DATE TO L001-FED-8-DATE-9. DTSCSL2 01081 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCSL2 01082 MOVE L001-SLASH-DATE TO MAP-PRED-EFF-DATE. DTSCSL2 01083 MOVE MREL-RELATIONSHIP-CD TO MAP-PRED-REL-CD DTSCSL2 01084 L031-CD. DTSCSL2 01085 PERFORM S031-MREL-RELATIONSHIP-CD THRU S031-EXIT. DTSCSL2 01086 MOVE L031-SHORT-DSCR TO MAP-PRED-REL-CD-DSCR. DTSCSL2 01087 DTSCSL2 01088 P6950-EXIT. DTSCSL2 01089 EXIT. DTSCSL2 01090 DTSCSL2 01091 P6970-FROM-MQTR. DTSCSL2 01092 MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. DTSCSL2 01093 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCSL2 01094 IF L810-NO-REC-88 DTSCSL2 01095 GO TO P6970-EXIT. DTSCSL2 01096 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL2 01097 IF L810-NO-REC-88 DTSCSL2 01098 GO TO P6970-EXIT. DTSCSL2 01099 DTSCSL2 01100 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCSL2 01101 DTSCSL2 01102 COMPUTE START-REC-NUM DTSCSL2 01103 = LAST-REC-NUM - ((CURR-PAGE-NUM - 1) * QTRS-PER-PAGE). DTSCSL2 01104 DTSCSL2 01105 PERFORM P6971-PREV-MQTR THRU P6971-EXIT DTSCSL2 01106 UNTIL (L810-NO-REC-88) DTSCSL2 01107 OR DTSCSL2 01108 (WS-REC-NUM NOT > START-REC-NUM). DTSCSL2 01109 DTSCSL2 01110 IF L810-NO-REC-88 DTSCSL2 01111 GO TO P6970-EXIT. DTSCSL2 01112 DTSCSL2 01113 PERFORM P6972-MQTR-PROCESS THRU P6972-EXIT DTSCSL2 01114 VARYING WRK-CTR FROM 1 BY 1 DTSCSL2 01115 UNTIL (L810-NO-REC-88) DTSCSL2 01116 OR DTSCSL2 01117 (WRK-CTR > QTRS-PER-PAGE). DTSCSL2 01118 IF L810-NO-REC-88 DTSCSL2 01119 NEXT SENTENCE DTSCSL2 01120 ELSE DTSCSL2 01121 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCSL2 01122 P6970-EXIT. DTSCSL2 01123 EXIT. DTSCSL2 01124 SKIP3 DTSCSL2 01125 P6971-PREV-MQTR. DTSCSL2 01126 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL2 01127 DTSCSL2 01128 IF L810-NO-REC-88 DTSCSL2 01129 NEXT SENTENCE DTSCSL2 01130 ELSE DTSCSL2 01131 SUBTRACT 1 FROM WS-REC-NUM. DTSCSL2 01132 P6971-EXIT. DTSCSL2 01133 EXIT. DTSCSL2 01134 DTSCSL2 01135 P6972-MQTR-PROCESS. DTSCSL2 01136 MOVE SPACES TO MAP-LINE(WRK-CTR) DTSCSL2 01137 MOVE MSKL-REC TO MQTR-REC DTSCSL2 01138 DTSCSL2 01139 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSCSL2 01140 PERFORM S004-FROM-5 THRU S004-EXIT DTSCSL2 01141 MOVE L004-SLASH-QTR TO MAP-LINE-YRQ(WRK-CTR) DTSCSL2 01142 DTSCSL2 01143 IF MQTR-YRQ = LCCM-PICKUP-YRQ CL**8 01144 MOVE 'PKUP' TO MAP-LINE-YRQ(WRK-CTR) CL**8 01145 END-IF. CL**8 01146 CL**8 01147 IF NOT MQTR-1ST-MTH-NO-ENTRY-88 DTSCSL2 01148 MOVE MQTR-1ST-MTH-EMPL-CNT DTSCSL2 01149 TO MAP-LINE-EMP-CNT-1(WRK-CTR) DTSCSL2 01150 END-IF. DTSCSL2 01151 DTSCSL2 01152 IF NOT MQTR-2ND-MTH-NO-ENTRY-88 DTSCSL2 01153 MOVE MQTR-2ND-MTH-EMPL-CNT DTSCSL2 01154 TO MAP-LINE-EMP-CNT-2(WRK-CTR) DTSCSL2 01155 END-IF. DTSCSL2 01156 DTSCSL2 01157 IF NOT MQTR-3RD-MTH-NO-ENTRY-88 DTSCSL2 01158 MOVE MQTR-3RD-MTH-EMPL-CNT DTSCSL2 01159 TO MAP-LINE-EMP-CNT-3(WRK-CTR) DTSCSL2 01160 END-IF. DTSCSL2 01161 DTSCSL2 01162 IF MQTR-YRQ = LCCM-PICKUP-YRQ CL**8 01163 NEXT SENTENCE CL**8 01164 ELSE CL**8 01165 ADD +.50 TO MQTR-TOT-WAGE CL**8 01166 MOVE MQTR-TOT-WAGE TO MAP-LINE-TOT-WAGE(WRK-CTR) CL**8 01167 ADD +.50 TO MQTR-TAX-WAGE CL**8 01168 MOVE MQTR-TAX-WAGE TO MAP-LINE-TAX-WAGE(WRK-CTR). CL**8 01169 DTSCSL2 01170 MOVE MQTR-CURR-RPT-TYPE TO L032-CD. DTSCSL2 01171 PERFORM S032-MQTR-CURR-RPT-TYPE THRU S032-EXIT. DTSCSL2 01172 MOVE L032-SHORT-DSCR TO MAP-LINE-RPT-TYPE-DSCR(WRK-CTR). DTSCSL2 01173 DTSCSL2 01174 PERFORM DTSCSL2 01175 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCSL2 01176 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCSL2 01177 DTSCSL2 01178 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSCSL2 01179 ADD +.50 TO MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCSL2 01180 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCSL2 01181 TO MAP-LINE-UI-CHGD (WRK-CTR) DTSCSL2 01182 END-IF DTSCSL2 01183 DTSCSL2 01184 END-PERFORM. DTSCSL2 01185 DTSCSL2 01186 DTSCSL2 01187 IF MQTR-NO-UI-RATE-88 DTSCSL2 01188 MOVE SPACES TO MAP-LINE-UI-RATE(WRK-CTR) DTSCSL2 01189 ELSE DTSCSL2 01190 MOVE MQTR-UI-RATE TO L056-RATE DTSCSL2 01191 PERFORM S056-RATE-DISPLAY-LEFT THRU S056-EXIT DTSCSL2 01192 MOVE L056-DISP-RATE TO MAP-LINE-UI-RATE(WRK-CTR) DTSCSL2 01193 END-IF. DTSCSL2 01194 DTSCSL2 01195 PERFORM S810-READ-PREV THRU S810-EXIT. DTSCSL2 01196 P6972-EXIT. DTSCSL2 01197 EXIT. DTSCSL2 01198 DTSCSL2 01199 P6990-PAGE-NUMBER. DTSCSL2 01200 IF CURR-PAGE-NUM = +0 DTSCSL2 01201 MOVE MSG-PL21-AREA TO LCCM-MSG-AREA CL**5 01202 GO TO P6990-EXIT. DTSCSL2 01203 DTSCSL2 01204 MOVE CURR-PAGE-NUM TO MAP-CURR-PAGE. DTSCSL2 01205 MOVE LAST-PAGE-NUM TO MAP-LAST-PAGE DTSCSL2 01206 DTSCSL2 01207 IF CURR-PAGE-NUM = +1 DTSCSL2 01208 IF LAST-PAGE-NUM = +1 DTSCSL2 01209 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCSL2 01210 ELSE DTSCSL2 01211 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCSL2 01212 ELSE DTSCSL2 01213 IF CURR-PAGE-NUM = LAST-PAGE-NUM DTSCSL2 01214 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCSL2 01215 P6990-EXIT. DTSCSL2 01216 EXIT. DTSCSL2 01217 /*****************************************************************DTSCSL2 01218 * LINKS TO UTILITY MODULES DTSCSL2 01219 ******************************************************************DTSCSL2 01220 DTSCSL2 01221 S001-FROM-FED-8. DTSCSL2 01222 SET L001-FROM-FED-8 TO TRUE. DTSCSL2 01223 GO TO S001-DATE. DTSCSL2 01224 DTSCSL2 01225 S001-FROM-ABS-DATE. DTSCSL2 01226 SET L001-FROM-ABS-DAY TO TRUE. DTSCSL2 01227 GO TO S001-DATE. DTSCSL2 01228 DTSCSL2 01229 S001-DATE. DTSCSL2 01230 EXEC CICS LINK DTSCSL2 01231 PROGRAM('DTSCU001') CL**2 01232 COMMAREA(L001-COMM-AREA) DTSCSL2 01233 END-EXEC. DTSCSL2 01234 S001-EXIT. DTSCSL2 01235 EXIT. DTSCSL2 01236 DTSCSL2 01237 S004-FROM-5. DTSCSL2 01238 IF L004-QTR-5-9 < 1000 DTSCSL2 01239 ADD 19000 TO L004-QTR-5-9 DTSCSL2 01240 END-IF DTSCSL2 01241 SET L004-FROM-5 TO TRUE. DTSCSL2 01242 GO TO S004-YRQ. DTSCSL2 01243 DTSCSL2 01244 S004-FROM-ABS. DTSCSL2 01245 SET L004-FROM-ABS TO TRUE. DTSCSL2 01246 GO TO S004-YRQ. DTSCSL2 01247 DTSCSL2 01248 S004-FROM-DATE. DTSCSL2 01249 SET L004-FROM-DATE TO TRUE. DTSCSL2 01250 GO TO S004-YRQ. DTSCSL2 01251 DTSCSL2 01252 S004-YRQ. DTSCSL2 01253 EXEC CICS LINK DTSCSL2 01254 PROGRAM('DTSCU004') CL**2 01255 COMMAREA(L004-COMM-AREA) DTSCSL2 01256 END-EXEC. DTSCSL2 01257 S004-EXIT. DTSCSL2 01258 EXIT. DTSCSL2 01259 DTSCSL2 01260 S018-EMP-NO-FROM-SCREEN. DTSCSL2 01261 EXEC CICS LINK DTSCSL2 01262 PROGRAM('DTSCU018') CL**2 01263 COMMAREA(L018-COMM-AREA) DTSCSL2 01264 END-EXEC. DTSCSL2 01265 S018-EXIT. DTSCSL2 01266 EXIT. DTSCSL2 01267 DTSCSL2 01268 S031-MPRF-EMP-CLASS. DTSCSL2 01269 SET L031-MPRF-EMP-CLASS TO TRUE. DTSCSL2 01270 GO TO S031-LINK. DTSCSL2 01271 DTSCSL2 01272 S031-MPRF-EMP-STATUS. DTSCSL2 01273 SET L031-MPRF-EMP-STATUS TO TRUE. DTSCSL2 01274 GO TO S031-LINK. DTSCSL2 01275 DTSCSL2 01276 S031-MPRF-ORG-TYPE. DTSCSL2 01277 SET L031-MPRF-ORG-TYPE TO TRUE. DTSCSL2 01278 GO TO S031-LINK. DTSCSL2 01279 DTSCSL2 01280 S031-MREL-RELATIONSHIP-CD. DTSCSL2 01281 SET L031-MREL-RELATIONSHIP-CD TO TRUE. DTSCSL2 01282 GO TO S031-LINK. DTSCSL2 01283 DTSCSL2 01284 S031-MSOL-LIAB-CD. DTSCSL2 01285 SET L031-MSOL-LIAB-CD TO TRUE. DTSCSL2 01286 GO TO S031-LINK. DTSCSL2 01287 DTSCSL2 01288 S031-MSOL-INACT-CD. DTSCSL2 01289 SET L031-MSOL-INACT-CD TO TRUE. DTSCSL2 01290 GO TO S031-LINK. DTSCSL2 01291 DTSCSL2 01292 S031-LINK. DTSCSL2 01293 EXEC CICS LINK DTSCSL2 01294 PROGRAM ('DTSCU031') CL**2 01295 COMMAREA (L031-COMM-AREA) DTSCSL2 01296 END-EXEC. DTSCSL2 01297 S031-EXIT. DTSCSL2 01298 EXIT. DTSCSL2 01299 S032-MQTR-CURR-RPT-TYPE . DTSCSL2 01300 SET L032-MQTR-CURR-RPT-TYPE TO TRUE. DTSCSL2 01301 GO TO S032-LINK. DTSCSL2 01302 DTSCSL2 01303 S032-LINK. DTSCSL2 01304 EXEC CICS LINK DTSCSL2 01305 PROGRAM ('DTSCU032') CL**2 01306 COMMAREA (L032-COMM-AREA) DTSCSL2 01307 END-EXEC. DTSCSL2 01308 S032-EXIT. DTSCSL2 01309 EXIT. DTSCSL2 01310 DTSCSL2 01311 S056-RATE-DISPLAY-RIGHT. DTSCSL2 01312 SET L056-DISP1-RIGHT-88 TO TRUE. DTSCSL2 01313 GO TO S056-RATE-DISPLAY. DTSCSL2 01314 DTSCSL2 01315 S056-RATE-DISPLAY-LEFT. DTSCSL2 01316 SET L056-DISP1-LEFT-88 TO TRUE. DTSCSL2 01317 GO TO S056-RATE-DISPLAY. DTSCSL2 01318 DTSCSL2 01319 S056-RATE-DISPLAY. DTSCSL2 01320 EXEC CICS LINK DTSCSL2 01321 PROGRAM('DTSCU056') CL**2 01322 COMMAREA(L056-COMM-AREA) DTSCSL2 01323 END-EXEC. DTSCSL2 01324 S056-EXIT. DTSCSL2 01325 EXIT. DTSCSL2 01326 DTSCSL2 01327 S803-REQ-SCR-ID-EDIT. DTSCSL2 01328 EXEC CICS LINK DTSCSL2 01329 PROGRAM ('DTSCU803') CL**2 01330 COMMAREA (DFHCOMMAREA) DTSCSL2 01331 END-EXEC. DTSCSL2 01332 S803-EXIT. DTSCSL2 01333 EXIT. DTSCSL2 01334 DTSCSL2 01335 S804-INVALID-KEY. DTSCSL2 01336 EXEC CICS LINK DTSCSL2 01337 PROGRAM ('DTSCU804') CL**2 01338 COMMAREA (DFHCOMMAREA) DTSCSL2 01339 END-EXEC. DTSCSL2 01340 S804-EXIT. DTSCSL2 01341 EXIT. DTSCSL2 01342 DTSCSL2 01343 S805-MSG-AREA. DTSCSL2 01344 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCSL2 01345 DTSCSL2 01346 EXEC CICS LINK DTSCSL2 01347 PROGRAM ('DTSCU805') CL**2 01348 COMMAREA (L805-COMM-AREA) DTSCSL2 01349 END-EXEC. DTSCSL2 01350 DTSCSL2 01351 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCSL2 01352 S805-EXIT. DTSCSL2 01353 EXIT. DTSCSL2 01354 EJECT DTSCSL2 01355 S810-READ. DTSCSL2 01356 SET L810-READ-88 TO TRUE. DTSCSL2 01357 GO TO S810-IO. DTSCSL2 01358 DTSCSL2 01359 S810-START-BROWSE. DTSCSL2 01360 SET L810-START-BROWSE-88 TO TRUE. DTSCSL2 01361 GO TO S810-IO. DTSCSL2 01362 DTSCSL2 01363 S810-READ-NEXT. DTSCSL2 01364 SET L810-READ-NEXT-88 TO TRUE. DTSCSL2 01365 GO TO S810-IO. DTSCSL2 01366 DTSCSL2 01367 S810-READ-PREV. DTSCSL2 01368 SET L810-READ-PREV-88 TO TRUE. DTSCSL2 01369 GO TO S810-IO. DTSCSL2 01370 DTSCSL2 01371 S810-END-BROWSE. DTSCSL2 01372 SET L810-END-BROWSE-88 TO TRUE. DTSCSL2 01373 GO TO S810-IO. DTSCSL2 01374 DTSCSL2 01375 S810-COUNT. DTSCSL2 01376 SET L810-COUNT-88 TO TRUE. DTSCSL2 01377 GO TO S810-IO. DTSCSL2 01378 DTSCSL2 01379 S810-REWRITE. DTSCSL2 01380 SET L810-REWRITE-88 TO TRUE. DTSCSL2 01381 GO TO S810-IO. DTSCSL2 01382 DTSCSL2 01383 S810-WRITE. DTSCSL2 01384 SET L810-WRITE-88 TO TRUE. DTSCSL2 01385 GO TO S810-IO. DTSCSL2 01386 DTSCSL2 01387 S810-DELETE. DTSCSL2 01388 SET L810-DELETE-88 TO TRUE. DTSCSL2 01389 GO TO S810-IO. DTSCSL2 01390 DTSCSL2 01391 S810-IO. DTSCSL2 01392 DTSCSL2 01393 EXEC CICS LINK DTSCSL2 01394 PROGRAM ('DTSCU810') CL**2 01395 COMMAREA (L810-COMM-AREA) DTSCSL2 01396 END-EXEC. DTSCSL2 01397 DTSCSL2 01398 IF L810-FILE-CLOSED-88 DTSCSL2 01399 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCSL2 01400 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL2 01401 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL2 01402 GO TO MAINLINE-EXIT. DTSCSL2 01403 S810-EXIT. DTSCSL2 01404 EXIT. DTSCSL2 01405 EJECT DTSCSL2 01406 S821-START-BROWSE. DTSCSL2 01407 SET L821-START-BROWSE-88 TO TRUE. DTSCSL2 01408 GO TO S821-MASTER-IO. DTSCSL2 01409 S821-END-BROWSE. DTSCSL2 01410 SET L821-END-BROWSE-88 TO TRUE. DTSCSL2 01411 GO TO S821-MASTER-IO. DTSCSL2 01412 S821-READ-PREV. DTSCSL2 01413 SET L821-READ-PREV-88 TO TRUE. DTSCSL2 01414 GO TO S821-MASTER-IO. DTSCSL2 01415 S821-READ-NEXT. DTSCSL2 01416 SET L821-READ-NEXT-88 TO TRUE. DTSCSL2 01417 GO TO S821-MASTER-IO. DTSCSL2 01418 S821-MASTER-IO. DTSCSL2 01419 EXEC CICS LINK DTSCSL2 01420 PROGRAM ('DTSCU821') CL**2 01421 COMMAREA (L821-COMM-AREA) DTSCSL2 01422 END-EXEC. DTSCSL2 01423 IF L821-FILE-CLOSED-88 DTSCSL2 01424 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCSL2 01425 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL2 01426 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL2 01427 GO TO MAINLINE-EXIT. DTSCSL2 01428 S821-EXIT. EXIT. DTSCSL2 01429 DTSCSL2 01430 DTSCSL2 01431 *S829-READ-ITEM. DTSCSL2 01432 *****SET L829-READ-ITEM-88 TO TRUE DTSCSL2 01433 *****GO TO S829-LINK. DTSCSL2 01434 ***** DTSCSL2 01435 *S829-DELETE-TS. DTSCSL2 01436 *****SET L829-DELETE-QUEUE-88 TO TRUE DTSCSL2 01437 *****GO TO S829-LINK. DTSCSL2 01438 ***** DTSCSL2 01439 *S829-WRITE-TS. DTSCSL2 01440 *****SET L829-WRITE-88 TO TRUE DTSCSL2 01441 *****GO TO S829-LINK. DTSCSL2 01442 ***** DTSCSL2 01443 *S829-LINK. DTSCSL2 01444 *****EXEC CICS LINK DTSCSL2 01445 ***** PROGRAM ('DTSCU829') CL**2 01446 ***** COMMAREA (L829-COMM-AREA) DTSCSL2 01447 ***** LENGTH (L829-COMM-AREA-LENGTH) DTSCSL2 01448 *****END-EXEC. DTSCSL2 01449 *S829-EXIT. DTSCSL2 01450 *****EXIT. DTSCSL2 01451 DTSCSL2 01452 DTSCSL2 01453 S851-SCREEN-PROCESSING. DTSCSL2 01454 EXEC CICS LINK DTSCSL2 01455 PROGRAM ('DTSCU851') CL**2 01456 COMMAREA (L851-COMM-AREA) DTSCSL2 01457 END-EXEC. DTSCSL2 01458 S851-EXIT. DTSCSL2 01459 EXIT. DTSCSL2 01460 DTSCSL2 01461 S899-ABEND. DTSCSL2 01462 EXEC CICS ABEND DTSCSL2 01463 ABCODE(WRK-ABEND-CD) DTSCSL2 01464 END-EXEC. DTSCSL2 01465 S899-EXIT. DTSCSL2 01466 EXIT. DTSCSL2 01467 /*****************************************************************DTSCSL2 01468 * EDIT THE INFORMATION ON THE SCREEN. *DTSCSL2 01469 ******************************************************************DTSCSL2 01470 DTSCSL2 01471 S1100-EDIT-KEY. DTSCSL2 01472 PERFORM S1101-EMP-NO THRU S1101-EXIT. DTSCSL2 01473 S1100-EXIT. EXIT. DTSCSL2 01474 /*****************************************************************DTSCSL2 01475 * DTSCSL2 01476 ******************************************************************DTSCSL2 01477 S1101-EMP-NO. DTSCSL2 01478 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL2 01479 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL2 01480 DTSCSL2 01481 IF L018-NO-ENTRY DTSCSL2 01482 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCSL2 01483 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL2 01484 GO TO S1101-EXIT. DTSCSL2 01485 DTSCSL2 01486 IF L018-NOT-VALID DTSCSL2 01487 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL2 01488 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL2 01489 GO TO S1101-EXIT. DTSCSL2 01490 DTSCSL2 01491 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCSL2 01492 S1101-EXIT. EXIT. DTSCSL2 01493 DTSCSL2 01494 S1110-READ-MPRF. DTSCSL2 01495 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL2 01496 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCSL2 01497 SET MPRF-PRF-88 TO TRUE. DTSCSL2 01498 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL2 01499 PERFORM S810-READ THRU S810-EXIT. DTSCSL2 01500 IF L810-NO-REC-88 DTSCSL2 01501 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCSL2 01502 PERFORM S1199-ERROR THRU S1199-EXIT DTSCSL2 01503 ELSE DTSCSL2 01504 MOVE MSKL-REC TO MPRF-REC DTSCSL2 01505 SET WRK-MPRF-YES-88 TO TRUE. DTSCSL2 01506 S1110-EXIT. DTSCSL2 01507 EXIT. DTSCSL2 01508 DTSCSL2 01509 DTSCSL2 01510 S1199-ERROR. DTSCSL2 01511 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCSL2 01512 MAP-EMP-NO-2-A. DTSCSL2 01513 IF LCCM-NO-MSG DTSCSL2 01514 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL2 01515 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCSL2 01516 SET CURSOR-SET-YES TO TRUE. DTSCSL2 01517 S1199-EXIT. EXIT. DTSCSL2 01518 /*****************************************************************DTSCSL2 01519 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCSL2 01520 ******************************************************************DTSCSL2 01521 S5300-SET-INQ-ATTRB. DTSCSL2 01522 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCSL2 01523 WRK-ATB-NUM. DTSCSL2 01524 DTSCSL2 01525 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL2 01526 S5300-EXIT. DTSCSL2 01527 EXIT. DTSCSL2 01528 DTSCSL2 01529 S5900-SET-ATTRB. DTSCSL2 01530 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCSL2 01531 MAP-EMP-NO-2-A. DTSCSL2 01532 DTSCSL2 01533 MOVE CATB-ASKIP-BRT-MDTON TO DTSCSL2 01534 MAP-PRIMARY-NAME-A CL**2 01535 MAP-ENTITY-NAME-A CL**2 01536 MAP-NAICS-CD-A CL**2 01537 MAP-OLD-NAICS-CD-A CL**5 01538 MAP-NAICS-CHNG-DATE-A CL**2 01539 MAP-TAX-ATTN-A CL**2 01540 MAP-DC-ATTN-A CL**2 01541 MAP-SIC-AUX-CD-A CL**9 01542 MAP-TAX-CITY-A CL**2 01543 MAP-DC-CITY-A CL**2 01544 MAP-TAX-DLV1-A CL**2 01545 MAP-DC-DLV1-A CL**2 01546 MAP-TAX-DLV2-A CL**2 01547 MAP-DC-DLV2-A CL**2 01548 MAP-PRED-EFF-DATE-A DTSCSL2 01549 MAP-FEIN-A DTSCSL2 01550 MAP-BTN-A CL**5 01551 MAP-FIRST-LIAB-YRQ-A DTSCSL2 01552 MAP-INACT-CD-A DTSCSL2 01553 MAP-INACT-DATE-A DTSCSL2 01554 MAP-LAST-LIAB-YRQ-A DTSCSL2 01555 MAP-LIAB-CD-A DTSCSL2 01556 MAP-LIAB-DATE-A DTSCSL2 01557 MAP-MULTI-IND-A DTSCSL2 01558 MAP-WARD-CD-A CL**4 01559 MAP-SIC-CD-A DTSCSL2 01560 MAP-OLD-SIC-CD-A DTSCSL2 01561 MAP-OWN-CD-A DTSCSL2 01562 MAP-OLD-OWN-CD-A DTSCSL2 01563 MAP-SIC-CHNG-DATE-A DTSCSL2 01564 MAP-OWN-CHNG-DATE-A DTSCSL2 01565 MAP-ORG-TYPE-A DTSCSL2 01566 MAP-PRED-CNT-A DTSCSL2 01567 MAP-PRED-EMP-NO-1-A DTSCSL2 01568 MAP-PRED-EMP-NO-2-A DTSCSL2 01569 MAP-PRED-REL-CD-A DTSCSL2 01570 MAP-SOL-CNT-A DTSCSL2 01571 MAP-TAX-ST-A CL**2 01572 MAP-DC-ST-A CL**2 01573 MAP-SUCC-CNT-A DTSCSL2 01574 MAP-SUCC-EFF-DATE-A DTSCSL2 01575 MAP-SUCC-EMP-NO-1-A DTSCSL2 01576 MAP-SUCC-EMP-NO-2-A DTSCSL2 01577 MAP-SUCC-REL-CD-A DTSCSL2 01578 MAP-VOICE-AREA-CD-1-A DTSCSL2 01579 MAP-VOICE-AREA-CD-2-A DTSCSL2 01580 MAP-VOICE-PREFIX-1-A DTSCSL2 01581 MAP-VOICE-PREFIX-2-A DTSCSL2 01582 MAP-VOICE-SUFFIX-1-A DTSCSL2 01583 MAP-VOICE-SUFFIX-2-A DTSCSL2 01584 MAP-VOICE-EXTION-1-A CL**2 01585 MAP-VOICE-EXTION-2-A CL**2 01586 MAP-TAX-ZIP-A CL**2 01587 MAP-DC-ZIP-A CL**2 01588 MAP-EMP-CLASS-DSCR-A DTSCSL2 01589 MAP-EMP-STATUS-DSCR-A DTSCSL2 01590 MAP-CURR-PAGE-A DTSCSL2 01591 MAP-LAST-PAGE-A. DTSCSL2 01592 DTSCSL2 01593 PERFORM DTSCSL2 01594 VARYING WRK-OCC FROM 1 BY 1 DTSCSL2 01595 UNTIL WRK-OCC > QTRS-PER-PAGE DTSCSL2 01596 MOVE CATB-ASKIP-BRT-MDTON TO MAP-LINE-A (WRK-OCC) DTSCSL2 01597 END-PERFORM. DTSCSL2 01598 DTSCSL2 01599 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-LIAB-CD-DSCR-A CL**2 01600 MAP-INACT-CD-DSCR-A DTSCSL2 01601 MAP-PRED-REL-CD-DSCR-A DTSCSL2 01602 MAP-ORG-TYPE-DSCR-A CL**5 01603 MAP-SUCC-REL-CD-DSCR-A. DTSCSL2 01604 DTSCSL2 01605 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCSL2 01606 S5900-EXIT. DTSCSL2 01607 EXIT. DTSCSL2 01608 EJECT DTSCSL2 01609 /*****************************************************************DTSCSL2 01610 * MAP ROUTINES *DTSCSL2 01611 ******************************************************************DTSCSL2 01612 S9100-RECEIVE. DTSCSL2 01613 SET L851-RECEIVE-88 TO TRUE. DTSCSL2 01614 DTSCSL2 01615 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCSL2 01616 DTSCSL2 01617 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL2 01618 DTSCSL2 01619 MOVE L851-AID TO LCCM-AID. DTSCSL2 01620 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCSL2 01621 S9100-EXIT. DTSCSL2 01622 EXIT. DTSCSL2 01623 DTSCSL2 01624 S9200-SEND-DATAONLY. DTSCSL2 01625 MOVE LOW-VALUES TO MAP-AREA. DTSCSL2 01626 DTSCSL2 01627 IF LCCM-NO-MSG DTSCSL2 01628 NEXT SENTENCE DTSCSL2 01629 ELSE DTSCSL2 01630 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL2 01631 DTSCSL2 01632 IF CURSOR-SET-GOTO DTSCSL2 01633 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCSL2 01634 ELSE DTSCSL2 01635 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCSL2 01636 DTSCSL2 01637 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCSL2 01638 DTSCSL2 01639 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL2 01640 DTSCSL2 01641 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL2 01642 S9200-EXIT. DTSCSL2 01643 EXIT. DTSCSL2 01644 DTSCSL2 01645 S9300-SEND-MAP. DTSCSL2 01646 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCSL2 01647 MOVE SPACES TO MAP-SYS-TIME. DTSCSL2 01648 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCSL2 01649 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCSL2 01650 DTSCSL2 01651 IF SCR-ACCESS-UPDATE DTSCSL2 01652 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCSL2 01653 ELSE DTSCSL2 01654 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL2 01655 DTSCSL2 01656 DTSCSL2 01657 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL2 01658 DTSCSL2 01659 IF CURSOR-SET-NO DTSCSL2 01660 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCSL2 01661 DTSCSL2 01662 SET L851-SEND-88 TO TRUE. DTSCSL2 01663 DTSCSL2 01664 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL2 01665 DTSCSL2 01666 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL2 01667 S9300-EXIT. DTSCSL2 01668 EXIT. DTSCSL2 01669 DTSCSL2 01670 S9310-UPDATE-FKEYS. DTSCSL2 01671 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL2 01672 DTSCSL2 01673 S9310-EXIT. DTSCSL2 01674 EXIT. DTSCSL2 01675 DTSCSL2 01676 S9320-INQUIRY-FKEYS. DTSCSL2 01677 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCSL2 01678 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCSL2 01679 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCSL2 01680 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCSL2 01681 MOVE 'F19=PRED' TO MAP-KEY-PRED. CL**5 01682 MOVE 'F20=SUCC' TO MAP-KEY-SUCC. CL**5 01683 DTSCSL2 01684 S9320-EXIT. DTSCSL2 01685 EXIT. DTSCSL2 01686 DTSCSL2 01687 S9900-PREPARE-SEND. DTSCSL2 01688 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCSL2 01689 LCCM-SCR-ID. DTSCSL2 01690 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCSL2 01691 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCSL2 01692 S9900-EXIT. DTSCSL2 01693 EXIT. DTSCSL2