1695 lines
132 KiB
COBOL
1695 lines
132 KiB
COBOL
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
|