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