2068 lines
162 KiB
COBOL
2068 lines
162 KiB
COBOL
00001 IDENTIFICATION DIVISION. 05/22/01
|
|
00002 PROGRAM-ID. DTSCSL9. DTSCSL9
|
|
00003 AUTHOR. TRW. LV001
|
|
00004 DATE-WRITTEN. JANUARY 2001. DTSCSL9
|
|
00005 DATE-COMPILED. DTSCSL9
|
|
00006 SKIP3 DTSCSL9
|
|
00007 ***** DTSCSL9
|
|
00008 * DTSCSL9
|
|
00009 * FUNCTION: ELECTRONIC MEDIA EMPLOYER HISTORY DTSCSL9
|
|
00010 * SCREEN PROCESSOR. DTSCSL9
|
|
00011 * DTSCSL9
|
|
00012 * DTSCSL9
|
|
00013 * MODIFICATION LOG: DTSCSL9
|
|
00014 * DTSCSL9
|
|
00015 * 02/27/2001 INITIAL DEVELOPMENT. MODIFIED FROM DTSCSL7. DTSCSL9
|
|
00016 * WORK ORDER: PROGRAMMER: GD DTSCSL9
|
|
00017 * DTSCSL9
|
|
00018 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSL9
|
|
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSL9
|
|
00020 * WORK ORDER: PROGRAMMER: XXX DTSCSL9
|
|
00021 * DTSCSL9
|
|
00022 * DTSCSL9
|
|
00023 * DESCRIPTION: DTSCSL9
|
|
00024 * DTSCSL9
|
|
00025 * DTSCSL9
|
|
00026 * CLEAR: DTSCSL9
|
|
00027 * DTSCSL9
|
|
00028 * FIELD DISPLAYED :NONE. UNPROTECT MAP-SRCH-EMP-NO DTSCSL9
|
|
00029 * MAP-SEARCH-DATA-TYPE, MAP-RPT-YR, -QTR, -MO, -DAY. DTSCSL9
|
|
00030 * DTSCSL9
|
|
00031 * DTSCSL9
|
|
00032 * INQUIRY: DTSCSL9
|
|
00033 * DTSCSL9
|
|
00034 * CONTROL FIELDS : MAP-SEARCH-ELF-ID (REQUIRED) DTSCSL9
|
|
00035 * MAP-DATA-TYPE, MAP-SEARCH-RPT-* (OPTIONAL) DTSCSL9
|
|
00036 * DTSCSL9
|
|
00037 * JUMP IN: IF LCCM-SCRL9-HOLD-AREA NOT = LOW-VALUES DTSCSL9
|
|
00038 * START A SEARCH AT THE EEMH RECORD WHOSE DTSCSL9
|
|
00039 * KEY IS IN LCCM-SCRL9-HOLD-AREA DTSCSL9
|
|
00040 * ELSE DTSCSL9
|
|
00041 * CLEAR. DTSCSL9
|
|
00042 * DTSCSL9
|
|
00043 * ENTER: REDISPLAY SAME STUFF. DTSCSL9
|
|
00044 * DTSCSL9
|
|
00045 * F07, F08: DO NOT BOTHER TO 'WRAP' PAGING. SEE SCREEN DTSCSL9
|
|
00046 * DESCRIPTION FOR 'BREAK' POINTS. DTSCSL9
|
|
00047 * DTSCSL9
|
|
00048 * JUMP OUT: CLEAR STORAGE AND EXIT DTSCSL9
|
|
00049 * DTSCSL9
|
|
00050 * DTSCSL9
|
|
00051 * PROTECT THE 'CONTROL' FIELDS DURING A SEARCH - DTSCSL9
|
|
00052 * LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED. DTSCSL9
|
|
00053 * THE USER MUST PRESS THE CLEAR KEY BEFORE RESTARTING DTSCSL9
|
|
00054 * A SEARCH. DTSCSL9
|
|
00055 * DTSCSL9
|
|
00056 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCSL9
|
|
00057 * LCCM-SCR-HOLD-AREA TO HOLD THE FROM 1 TO 16 AIX DTSCSL9
|
|
00058 * RECORDS FROM WHICH THE 1 TO 16 LINES OF THE DISPLAY DTSCSL9
|
|
00059 * WERE CONSTRUCTED. DTSCSL9
|
|
00060 * DTSCSL9
|
|
00061 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCSL9
|
|
00062 * THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA TO DTSCSL9
|
|
00063 * CONTROL PAGING. DTSCSL9
|
|
00064 * DTSCSL9
|
|
00065 * DTSCSL9
|
|
00066 * UPDATE: DTSCSL9
|
|
00067 * DTSCSL9
|
|
00068 * NONE. DTSCSL9
|
|
00069 * DTSCSL9
|
|
00070 * DTSCSL9
|
|
00071 * RECORDS READ: DTSCSL9
|
|
00072 * DTSCSL9
|
|
00073 * ELF: DTSCSL9
|
|
00074 * DTSCSL9
|
|
00075 * EPRF DTSCSL9
|
|
00076 * EEMH DTSCSL9
|
|
00077 * ELOG DTSCSL9
|
|
00078 * DTSCSL9
|
|
00079 * DTSCSL9
|
|
00080 * ALTERNATE INDEX: DTSCSL9
|
|
00081 * DTSCSL9
|
|
00082 * IEET DTSCSL9
|
|
00083 * IEER DTSCSL9
|
|
00084 * DTSCSL9
|
|
00085 * DTSCSL9
|
|
00086 * REFERENCE: DTSCSL9
|
|
00087 * DTSCSL9
|
|
00088 * NONE. DTSCSL9
|
|
00089 * DTSCSL9
|
|
00090 * DTSCSL9
|
|
00091 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL9
|
|
00092 * DTSCSL9
|
|
00093 * NONE. DTSCSL9
|
|
00094 * DTSCSL9
|
|
00095 * DTSCSL9
|
|
00096 * RECORDS UPDATED: DTSCSL9
|
|
00097 * DTSCSL9
|
|
00098 * NONE. DTSCSL9
|
|
00099 * DTSCSL9
|
|
00100 * DTSCSL9
|
|
00101 * REFERENCE: DTSCSL9
|
|
00102 * DTSCSL9
|
|
00103 * NONE. DTSCSL9
|
|
00104 * DTSCSL9
|
|
00105 * DTSCSL9
|
|
00106 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL9
|
|
00107 * DTSCSL9
|
|
00108 * NONE. DTSCSL9
|
|
00109 * DTSCSL9
|
|
00110 * DTSCSL9
|
|
00111 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCSL9
|
|
00112 * DTSCSL9
|
|
00113 * NONE. DTSCSL9
|
|
00114 * DTSCSL9
|
|
00115 * DTSCSL9
|
|
00116 * TEMPORARY STORAGE USAGE: DTSCSL9
|
|
00117 * DTSCSL9
|
|
00118 * NONE. DTSCSL9
|
|
00119 * DTSCSL9
|
|
00120 * DTSCSL9
|
|
00121 * MODULES LINKED TO: DTSCSL9
|
|
00122 * DTSCSL9
|
|
00123 * DTSCU001 DATE EDIT/CONVERSION. DTSCSL9
|
|
00124 * DTSCU013 COUNT (INTEGER) FROM SCREEN FORMAT/EDIT. DTSCSL9
|
|
00125 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCSL9
|
|
00126 * DTSCU018 ELF-ID FROM SCREEN FORMAT/EDIT. DTSCSL9
|
|
00127 * DTSCU041 ELECTRONIC MEDIA CODES EDIT/DISPLAY. DTSCSL9
|
|
00128 * DTSCU835 ELECTRONIC MEDIA FILE INPUT/OUTPUT. DTSCSL9
|
|
00129 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCSL9
|
|
00130 * DTSCSL9
|
|
00131 ***** DTSCSL9
|
|
00132 DTSCSL9
|
|
00133 ENVIRONMENT DIVISION. DTSCSL9
|
|
00134 DTSCSL9
|
|
00135 DATA DIVISION. DTSCSL9
|
|
00136 DTSCSL9
|
|
00137 WORKING-STORAGE SECTION. DTSCSL9
|
|
001375 77 PAN-VALET PICTURE X(24) VALUE '001DTSCSL9 05/22/01'. DTSCSL9
|
|
00138 DTSCSL9
|
|
00139 ************************************************************ DTSCSL9
|
|
00140 * THE TABLE BELOW CONTAINS DATA FROM THE LCCM-SCR-HOLD-AREA DTSCSL9
|
|
00141 ************************************************************ DTSCSL9
|
|
00142 01 WRK-SCR-HOLD-AREA. DTSCSL9
|
|
00143 05 WRK-SCR-HOLD-PROG-NAME PIC X(07). DTSCSL9
|
|
00144 05 WRK-SCR-HOLD-EMP-NO PIC 9(06). DTSCSL9
|
|
00145 05 WRK-SCR-HOLD-DATA-TYPE PIC X(02). DTSCSL9
|
|
00146 05 WRK-SCR-HOLD-RPT-YY PIC 9(02). DTSCSL9
|
|
00147 05 WRK-SCR-HOLD-RPT-QTR PIC 9(01). DTSCSL9
|
|
00148 05 WRK-SCR-HOLD-RPT-MM PIC 9(02). DTSCSL9
|
|
00149 05 WRK-SCR-HOLD-RPT-DD PIC 9(02). DTSCSL9
|
|
00150 05 WRK-SCR-HOLD-KEY-CTR PIC S9(04) COMP. DTSCSL9
|
|
00151 05 WRK-SCR-HOLD-KEY-AREA PIC X(1024). DTSCSL9
|
|
00152 05 FILLER REDEFINES WRK-SCR-HOLD-KEY-AREA. DTSCSL9
|
|
00153 10 WRK-SCR-HOLD-KEY OCCURS 16 TIMES. DTSCSL9
|
|
00154 15 WRK-SCR-HOLD-REC-TYPE PIC S9(04) COMP. DTSCSL9
|
|
00155 15 FILLER PIC X(62). DTSCSL9
|
|
00156 DTSCSL9
|
|
00157 ************************************************************ DTSCSL9
|
|
00158 * THE PROGRAM STORES AIX KEYS AND FORMARTED MAP LINES IN THE DTSCSL9
|
|
00159 * TABLE BELOW DURING PAGE BACK OPERATIONS. BUILDING A TABLE DTSCSL9
|
|
00160 * BY READING BACKWARDS ORDERS THE LINES IN REVERSE ORDER DTSCSL9
|
|
00161 * (HIGHEST KEY TO LOWEST). TO BUILD THE SCREEN HOLD AREA DTSCSL9
|
|
00162 * AND THE MAP, THE PROGRAM READS THE TABLE ENTRIES IN DTSCSL9
|
|
00163 * REVERSE ORDER. DTSCSL9
|
|
00164 ************************************************************ DTSCSL9
|
|
00165 01 WRK-PAGE-BACK-AREA. DTSCSL9
|
|
00166 05 WRK-PAGE-BACK-CTR PIC S9(04) COMP. DTSCSL9
|
|
00167 05 WRK-PAGE-BACK-DATA-AREA PIC X(2288). DTSCSL9
|
|
00168 05 FILLER REDEFINES WRK-PAGE-BACK-DATA-AREA. DTSCSL9
|
|
00169 10 WRK-PAGE-BACK-ENTRY OCCURS 16 TIMES. DTSCSL9
|
|
00170 15 WRK-PAGE-BACK-KEY PIC X(64). DTSCSL9
|
|
00171 15 WRK-PAGE-BACK-LINE PIC X(79). DTSCSL9
|
|
00172 15 FILLER REDEFINES WRK-PAGE-BACK-LINE. DTSCSL9
|
|
00173 20 WRK-PAGE-BACK-LINE-NO PIC X(02). DTSCSL9
|
|
00174 20 FILLER PIC X(77). DTSCSL9
|
|
00175 DTSCSL9
|
|
00176 01 WRK-AREA. DTSCSL9
|
|
00177 05 WRK-ABEND-CD PIC X(04) VALUE 'SL9 '. DTSCSL9
|
|
00178 DTSCSL9
|
|
00179 05 WRK-MOD-NAME PIC X(07) VALUE 'DTSCSL9'. DTSCSL9
|
|
00180 DTSCSL9
|
|
00181 05 WRK-FATAL-ERROR-IND PIC X(01). DTSCSL9
|
|
00182 88 WRK-FATAL-ERROR-YES VALUE 'Y'. DTSCSL9
|
|
00183 88 WRK-FATAL-ERROR-NO VALUE 'N'. DTSCSL9
|
|
00184 DTSCSL9
|
|
00185 05 WRK-SCR-ID PIC X(02) VALUE 'L9'. DTSCSL9
|
|
00186 DTSCSL9
|
|
00187 05 WRK-F03-SCR-ID PIC X(02) VALUE 'L0'. DTSCSL9
|
|
00188 05 SCR-ACCESS-IND PIC X(01). DTSCSL9
|
|
00189 88 SCR-ACCESS-INQ VALUE '1'. DTSCSL9
|
|
00190 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCSL9
|
|
00191 DTSCSL9
|
|
00192 05 CURSOR-SET-IND PIC X(01). DTSCSL9
|
|
00193 88 CURSOR-SET-YES VALUE 'Y'. DTSCSL9
|
|
00194 88 CURSOR-SET-NO VALUE 'N'. DTSCSL9
|
|
00195 88 CURSOR-SET-GOTO VALUE 'G'. DTSCSL9
|
|
00196 DTSCSL9
|
|
00197 05 REQ-IND PIC X(01). DTSCSL9
|
|
00198 88 REQ-ERROR VALUE 'O'. DTSCSL9
|
|
00199 88 REQ-JUMP VALUE 'J'. DTSCSL9
|
|
00200 88 REQ-INQUIRE VALUE 'I'. DTSCSL9
|
|
00201 88 REQ-CLEAR VALUE 'C'. DTSCSL9
|
|
00202 88 REQ-EDIT VALUE 'E'. DTSCSL9
|
|
00203 88 REQ-UPDATE VALUE 'U'. DTSCSL9
|
|
00204 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCSL9
|
|
00205 DTSCSL9
|
|
00206 05 RESP-IND PIC X(01). DTSCSL9
|
|
00207 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCSL9
|
|
00208 88 RESP-SEND-MAP VALUE 'M'. DTSCSL9
|
|
00209 88 RESP-JUMP VALUE 'J'. DTSCSL9
|
|
00210 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCSL9
|
|
00211 DTSCSL9
|
|
00212 05 WRK-MSG-AREA PIC X(64). DTSCSL9
|
|
00213 DTSCSL9
|
|
00214 05 WRK-ATB-AN PIC X(01). DTSCSL9
|
|
00215 05 WRK-ATB-NUM PIC X(01). DTSCSL9
|
|
00216 05 WRK-MAP-LINE-ATB PIC X(01). DTSCSL9
|
|
00217 DTSCSL9
|
|
00218 ************************************************************** DTSCSL9
|
|
00219 * MAXIMUM NUMBER OF LINES THAT MAY BE DISPLAYED ON ONE PAGE. DTSCSL9
|
|
00220 ************************************************************** DTSCSL9
|
|
00221 05 MAX-LINES PIC S9(04) COMP VALUE +14. DTSCSL9
|
|
00222 DTSCSL9
|
|
00223 ************************************************************** DTSCSL9
|
|
00224 * THE DATA ELEMENT BELOW INDICATES WHETHER AN AIX KEY FROM DTSCSL9
|
|
00225 * A PREVIOUS TASK HAS BEEN FOUND. DTSCSL9
|
|
00226 * WRK-AIX-TBL-KEY-FND INDICATES THAT THE LCCM-SCR-HOLD AREA DTSCSL9
|
|
00227 * CONTAINS THE AIX KEYS USED TO BUILD THE PREVIOUS DISPLAY. DTSCSL9
|
|
00228 * THIS IMPLIES THAT THE USER IS IN THE MIDDLE OF A SEARCH DTSCSL9
|
|
00229 * AND IS PAGING THROUGH THE SCREENS. DTSCSL9
|
|
00230 * WRK-JUMP-IN-KEY-FND INDICATES THAT THE LCCM-SCRL9-HOLD-AREA DTSCSL9
|
|
00231 * CONTAINS A KEY. THIS MEANS THE USER DTSCSL9
|
|
00232 * HAS SELECTED A LINE FROM SCREEN L9, JUMPED TO ANOTHER SCREEN DTSCSL9
|
|
00233 * FOR A DETAILED VIEW OF THE RECORD, THEN RETURNED TO SCR L9. DTSCSL9
|
|
00234 *************************************************************** DTSCSL9
|
|
00235 05 WRK-KEY-FOUND-IND PIC X(01). DTSCSL9
|
|
00236 88 WRK-AIX-TBL-KEY-FND VALUE '1'. DTSCSL9
|
|
00237 88 WRK-JUMP-IN-KEY-FND VALUE '2'. DTSCSL9
|
|
00238 88 WRK-KEY-FOUND-YES VALUE '1' '2'. DTSCSL9
|
|
00239 88 WRK-KEY-FOUND-NO VALUE '0'. DTSCSL9
|
|
00240 DTSCSL9
|
|
00241 05 WRK-NUM-SRCH-FLDS-ENTERED PIC S9(04) COMP. DTSCSL9
|
|
00242 DTSCSL9
|
|
00243 DTSCSL9
|
|
00244 05 WRK-CTR PIC S9(04) COMP. DTSCSL9
|
|
00245 DTSCSL9
|
|
00246 05 WRK-SUB PIC S9(04) COMP. DTSCSL9
|
|
00247 05 WRK-SUB-DISP PIC Z9. DTSCSL9
|
|
00248 DTSCSL9
|
|
00249 05 WRK-SUB2 PIC S9(04) COMP. DTSCSL9
|
|
00250 DTSCSL9
|
|
00251 05 WRK-SCREEN-DATA-LINE. DTSCSL9
|
|
00252 10 WRK-SCR-LINE-NO PIC X(02). DTSCSL9
|
|
00253 10 FILLER PIC X(02). DTSCSL9
|
|
00254 10 WRK-SCR-DATA-TYPE PIC X(31). DTSCSL9
|
|
00255 10 FILLER PIC X(02). DTSCSL9
|
|
00256 10 WRK-SCR-RPT-DATE PIC X(08). DTSCSL9
|
|
00257 10 FILLER PIC X(02). DTSCSL9
|
|
00258 10 WRK-SCR-RCVD-DATE PIC X(08). DTSCSL9
|
|
00259 10 FILLER PIC X(02). DTSCSL9
|
|
00260 10 WRK-SCR-CMPL-DATE PIC X(08). DTSCSL9
|
|
00261 10 FILLER PIC X(02). DTSCSL9
|
|
00262 10 WRK-SCR-RESULT PIC X(12). DTSCSL9
|
|
00263 DTSCSL9
|
|
00264 ************************************************************ DTSCSL9
|
|
00265 * THE FOLLOWING FIELDS CONTAIN THE STARTING AND ENDING AIX DTSCSL9
|
|
00266 * KEYS FOR THE CURRENT SCREEN DISPLAY. DTSCSL9
|
|
00267 * THE STARTING KEY IS BUILT INITIALLY FROM THE S1000 EDITS DTSCSL9
|
|
00268 * AND REPLACED BY THE ACTUAL AIX KEY DURING INQUIRY DTSCSL9
|
|
00269 * PROCESSING IN P6000. DTSCSL9
|
|
00270 * THE INQUIRY PROCESS MOVES THIS KEY TO LCCM-SCRL9-HOLD-AREA. DTSCSL9
|
|
00271 * DTSCSL9
|
|
00272 * THE ENDING KEY IS THE LAST ENTRY IN THE AIX TABLE STORED DTSCSL9
|
|
00273 * IN LCCM-SCR-HOLD-AREA. IT IS USED TO SET THE STARTING DTSCSL9
|
|
00274 * POINT WHEN PAGING FORWARD. DTSCSL9
|
|
00275 ************************************************************ DTSCSL9
|
|
00276 05 WRK-STARTING-SEARCH-KEY PIC X(64). DTSCSL9
|
|
00277 05 WRK-ENDING-SEARCH-KEY PIC X(64). DTSCSL9
|
|
00278 DTSCSL9
|
|
00279 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCSL9
|
|
00280 05 WRK-EMP-NO-DISP PIC 9(07). DTSCSL9
|
|
00281 05 FILLER REDEFINES WRK-EMP-NO-DISP. DTSCSL9
|
|
00282 10 FILLER PIC X. DTSCSL9
|
|
00283 10 WRK-EMP-NO-DISP-1 PIC 9(03). DTSCSL9
|
|
00284 10 WRK-EMP-NO-DISP-2 PIC 9(03). DTSCSL9
|
|
00285 DTSCSL9
|
|
00286 05 WRK-DATA-TYPE-CD PIC X(02). DTSCSL9
|
|
00287 DTSCSL9
|
|
00288 05 WRK-SRCH-EMP-NO PIC S9(07) COMP-3. DTSCSL9
|
|
00289 88 WRK-EXTERNAL-ELF-88 VALUE 3000 THRU 3999. DTSCSL9
|
|
00290 05 WRK-SRCH-DATA-TYPE PIC 9(02). DTSCSL9
|
|
00291 05 WRK-SRCH-RPT-DATE PIC 9(08). DTSCSL9
|
|
00292 DTSCSL9
|
|
00293 05 WRK-SRCH-RPT-YY PIC 9(02). DTSCSL9
|
|
00294 05 WRK-SRCH-RPT-QTR PIC 9(01). DTSCSL9
|
|
00295 05 WRK-SRCH-RPT-MM PIC 9(02). DTSCSL9
|
|
00296 05 WRK-SRCH-RPT-DD PIC 9(02). DTSCSL9
|
|
00297 DTSCSL9
|
|
00298 05 WRK-AIX-EMP-NO PIC S9(07) COMP-3. DTSCSL9
|
|
00299 05 WRK-AIX-DATA-TYPE PIC X(02). DTSCSL9
|
|
00300 05 WRK-AIX-RPT-DATE PIC 9(08). DTSCSL9
|
|
00301 05 WRK-AIX-LOG-NO PIC 9(10). DTSCSL9
|
|
00302 DTSCSL9
|
|
00303 05 WRK-ELF-NAME PIC X(40). DTSCSL9
|
|
00304 DTSCSL9
|
|
00305 05 HOLD-ISKL-KEY-AREA PIC X(64). DTSCSL9
|
|
00306 DTSCSL9
|
|
00307 01 MSG-LITERALS. DTSCSL9
|
|
00308 05 MSG-EL91-AREA. DTSCSL9
|
|
00309 10 FILLER PIC X(04) VALUE 'EL91'. DTSCSL9
|
|
00310 10 FILLER PIC X(30) DTSCSL9
|
|
00311 VALUE 'ENTER 1 SEARCH FIELD. '. DTSCSL9
|
|
00312 10 FILLER PIC X(30) DTSCSL9
|
|
00313 VALUE ' '. DTSCSL9
|
|
00314 DTSCSL9
|
|
00315 05 MSG-EL92-AREA. DTSCSL9
|
|
00316 10 FILLER PIC X(04) VALUE 'EL92'. DTSCSL9
|
|
00317 10 FILLER PIC X(30) DTSCSL9
|
|
00318 VALUE 'ENTRY OF ONLY 1 SEARCH FIELD A'. DTSCSL9
|
|
00319 10 FILLER PIC X(30) DTSCSL9
|
|
00320 VALUE 'LLOWED '. DTSCSL9
|
|
00321 DTSCSL9
|
|
00322 05 MSG-EL93-AREA. DTSCSL9
|
|
00323 10 FILLER PIC X(04) VALUE 'EL93'. DTSCSL9
|
|
00324 10 MSG-ELF-ID-IN-ERR PIC 999B999. DTSCSL9
|
|
00325 10 FILLER PIC X(50) VALUE DTSCSL9
|
|
00326 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCSL9
|
|
00327 DTSCSL9
|
|
00328 05 MSG-EL94-AREA. DTSCSL9
|
|
00329 10 FILLER PIC X(04) VALUE 'EL94'. DTSCSL9
|
|
00330 10 FILLER PIC X(30) DTSCSL9
|
|
00331 VALUE 'BOX NUMBER MUST BE ENTERED '. DTSCSL9
|
|
00332 10 FILLER PIC X(30) DTSCSL9
|
|
00333 VALUE ' '. DTSCSL9
|
|
00334 DTSCSL9
|
|
00335 EJECT DTSCSL9
|
|
00336 01 L001-COMM-AREA. DTSCSL9
|
|
00337 ++INCLUDE DTSIL001 DTSCSL9
|
|
00338 EJECT DTSCSL9
|
|
00339 01 L004-COMM-AREA. DTSCSL9
|
|
00340 ++INCLUDE DTSIL004 DTSCSL9
|
|
00341 EJECT DTSCSL9
|
|
00342 01 L013-COMM-AREA. DTSCSL9
|
|
00343 ++INCLUDE DTSIL013 DTSCSL9
|
|
00344 EJECT DTSCSL9
|
|
00345 01 L015-COMM-AREA. DTSCSL9
|
|
00346 ++INCLUDE DTSIL015 DTSCSL9
|
|
00347 EJECT DTSCSL9
|
|
00348 01 L018-COMM-AREA. DTSCSL9
|
|
00349 ++INCLUDE DTSIL018 DTSCSL9
|
|
00350 EJECT DTSCSL9
|
|
00351 01 L041-COMM-AREA. DTSCSL9
|
|
00352 ++INCLUDE DTSIL041 DTSCSL9
|
|
00353 EJECT DTSCSL9
|
|
00354 01 L222-COMM-AREA. DTSCSL9
|
|
00355 ++INCLUDE DTSIL222 DTSCSL9
|
|
00356 EJECT DTSCSL9
|
|
00357 01 L357-COMM-AREA. DTSCSL9
|
|
00358 ++INCLUDE DTSIL357 DTSCSL9
|
|
00359 EJECT DTSCSL9
|
|
00360 01 L805-COMM-AREA. DTSCSL9
|
|
00361 ++INCLUDE DTSIL805 DTSCSL9
|
|
00362 EJECT DTSCSL9
|
|
00363 01 L810-COMM-AREA. DTSCSL9
|
|
00364 05 L810-CONTROL-BLOCK. DTSCSL9
|
|
00365 ++INCLUDE DTSIL810 DTSCSL9
|
|
00366 EJECT DTSCSL9
|
|
00367 05 MSKL-REC. DTSCSL9
|
|
00368 ++INCLUDE DTSIMSKL DTSCSL9
|
|
00369 EJECT DTSCSL9
|
|
00370 01 MPRF-REC. DTSCSL9
|
|
00371 ++INCLUDE DTSIMPRF DTSCSL9
|
|
00372 EJECT DTSCSL9
|
|
00373 01 L821-COMM-AREA. DTSCSL9
|
|
00374 05 L821-CONTROL-BLOCK. DTSCSL9
|
|
00375 ++INCLUDE DTSIL821 DTSCSL9
|
|
00376 EJECT DTSCSL9
|
|
00377 05 ISKL-REC. DTSCSL9
|
|
00378 ++INCLUDE DTSIISKL DTSCSL9
|
|
00379 EJECT DTSCSL9
|
|
00380 01 IEET-REC. DTSCSL9
|
|
00381 ++INCLUDE DTSIIEET DTSCSL9
|
|
00382 EJECT DTSCSL9
|
|
00383 01 IEER-REC. DTSCSL9
|
|
00384 ++INCLUDE DTSIIEER DTSCSL9
|
|
00385 EJECT DTSCSL9
|
|
00386 01 L835-COMM-AREA. DTSCSL9
|
|
00387 05 L835-CONTROL-BLOCK. DTSCSL9
|
|
00388 ++INCLUDE DTSIL835 DTSCSL9
|
|
00389 EJECT DTSCSL9
|
|
00390 05 ESKL-REC. DTSCSL9
|
|
00391 ++INCLUDE DTSIESKL DTSCSL9
|
|
00392 EJECT DTSCSL9
|
|
00393 01 EPRF-REC. DTSCSL9
|
|
00394 ++INCLUDE DTSIEPRF DTSCSL9
|
|
00395 EJECT DTSCSL9
|
|
00396 01 EEMH-REC. DTSCSL9
|
|
00397 ++INCLUDE DTSIEEMH DTSCSL9
|
|
00398 EJECT DTSCSL9
|
|
00399 01 ELOG-REC. DTSCSL9
|
|
00400 ++INCLUDE DTSIELOG DTSCSL9
|
|
00401 EJECT DTSCSL9
|
|
00402 DTSCSL9
|
|
00403 01 L851-COMM-AREA. DTSCSL9
|
|
00404 ++INCLUDE DTSIL851 DTSCSL9
|
|
00405 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCSL9
|
|
00406 ++INCLUDE DTSISL9 DTSCSL9
|
|
00407 EJECT DTSCSL9
|
|
00408 01 CATB-LITERALS. DTSCSL9
|
|
00409 ++INCLUDE DTSICATB DTSCSL9
|
|
00410 DTSCSL9
|
|
00411 01 CFKD-LITERALS. DTSCSL9
|
|
00412 ++INCLUDE DTSICFKD DTSCSL9
|
|
00413 DTSCSL9
|
|
00414 01 CECD-LITERALS. DTSCSL9
|
|
00415 ++INCLUDE DTSICECD DTSCSL9
|
|
00416 DTSCSL9
|
|
00417 01 CPCD-LITERALS. DTSCSL9
|
|
00418 ++INCLUDE DTSICPCD DTSCSL9
|
|
00419 EJECT DTSCSL9
|
|
00420 LINKAGE SECTION. DTSCSL9
|
|
00421 DTSCSL9
|
|
00422 01 DFHCOMMAREA. DTSCSL9
|
|
00423 ++INCLUDE DTSILCCM DTSCSL9
|
|
00424 DTSCSL9
|
|
00425 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCSL9
|
|
00426 20 LCCM-SCR-HOLD-PROG-NAME PIC X(07). DTSCSL9
|
|
00427 20 LCCM-SCR-HOLD-ELF-ID PIC 9(06). DTSCSL9
|
|
00428 20 LCCM-SCR-HOLD-DATA-TYPE PIC X(02). DTSCSL9
|
|
00429 20 LCCM-SCR-HOLD-RPT-YY PIC 9(02). DTSCSL9
|
|
00430 20 LCCM-SCR-HOLD-RPT-QTR PIC 9(01). DTSCSL9
|
|
00431 20 LCCM-SCR-HOLD-RPT-MM PIC 9(02). DTSCSL9
|
|
00432 20 LCCM-SCR-HOLD-RPT-DD PIC 9(02). DTSCSL9
|
|
00433 20 LCCM-SCR-HOLD-KEY-CTR PIC S9(04) COMP. DTSCSL9
|
|
00434 20 LCCM-SCR-HOLD-KEY-AREA PIC X(1024). DTSCSL9
|
|
00435 20 FILLER REDEFINES LCCM-SCR-HOLD-KEY-AREA. DTSCSL9
|
|
00436 25 LCCM-SCR-HOLD-KEY DTSCSL9
|
|
00437 OCCURS 16 TIMES PIC X(64). DTSCSL9
|
|
00438 EJECT DTSCSL9
|
|
00439 ******************************************************************DTSCSL9
|
|
00440 * *DTSCSL9
|
|
00441 ******************************************************************DTSCSL9
|
|
00442 DTSCSL9
|
|
00443 PROCEDURE DIVISION. DTSCSL9
|
|
00444 DTSCSL9
|
|
00445 SET WRK-FATAL-ERROR-NO TO TRUE. DTSCSL9
|
|
00446 SET WRK-KEY-FOUND-NO TO TRUE. DTSCSL9
|
|
00447 DTSCSL9
|
|
00448 MOVE ZERO TO WRK-SRCH-EMP-NO DTSCSL9
|
|
00449 WRK-SRCH-DATA-TYPE DTSCSL9
|
|
00450 WRK-SRCH-RPT-DATE DTSCSL9
|
|
00451 WRK-SRCH-RPT-YY DTSCSL9
|
|
00452 WRK-SRCH-RPT-QTR DTSCSL9
|
|
00453 WRK-SRCH-RPT-MM DTSCSL9
|
|
00454 WRK-SRCH-RPT-DD DTSCSL9
|
|
00455 WRK-AIX-EMP-NO DTSCSL9
|
|
00456 WRK-AIX-DATA-TYPE DTSCSL9
|
|
00457 WRK-AIX-RPT-DATE DTSCSL9
|
|
00458 WRK-AIX-LOG-NO. DTSCSL9
|
|
00459 DTSCSL9
|
|
00460 MOVE +0 TO WRK-CTR DTSCSL9
|
|
00461 WRK-SUB DTSCSL9
|
|
00462 WRK-SUB2. DTSCSL9
|
|
00463 DTSCSL9
|
|
00464 MOVE LOW-VALUES TO WRK-STARTING-SEARCH-KEY DTSCSL9
|
|
00465 WRK-ENDING-SEARCH-KEY. DTSCSL9
|
|
00466 DTSCSL9
|
|
00467 MOVE LOW-VALUES TO MAP-AREA. DTSCSL9
|
|
00468 DTSCSL9
|
|
00469 SET CURSOR-SET-NO TO TRUE. DTSCSL9
|
|
00470 DTSCSL9
|
|
00471 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCSL9
|
|
00472 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCSL9
|
|
00473 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCSL9
|
|
00474 DTSCSL9
|
|
00475 MOVE SPACE TO REQ-IND. DTSCSL9
|
|
00476 DTSCSL9
|
|
00477 MOVE SPACES TO LCCM-REQ-SCR-ID. DTSCSL9
|
|
00478 DTSCSL9
|
|
00479 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCSL9
|
|
00480 DTSCSL9
|
|
00481 *----------------------------------------------------- DTSCSL9
|
|
00482 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCSL9
|
|
00483 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCSL9
|
|
00484 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCSL9
|
|
00485 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCSL9
|
|
00486 * DTSCSL9
|
|
00487 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCSL9
|
|
00488 * PROCESSED. DTSCSL9
|
|
00489 * DTSCSL9
|
|
00490 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCSL9
|
|
00491 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCSL9
|
|
00492 * WORK STATION OPERATOR. DTSCSL9
|
|
00493 *----------------------------------------------------- DTSCSL9
|
|
00494 DTSCSL9
|
|
00495 MOVE SPACE TO RESP-IND. DTSCSL9
|
|
00496 DTSCSL9
|
|
00497 IF REQ-ERROR DTSCSL9
|
|
00498 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCSL9
|
|
00499 ELSE DTSCSL9
|
|
00500 IF REQ-JUMP DTSCSL9
|
|
00501 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCSL9
|
|
00502 ELSE DTSCSL9
|
|
00503 IF REQ-CLEAR DTSCSL9
|
|
00504 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCSL9
|
|
00505 ELSE DTSCSL9
|
|
00506 IF REQ-CURSOR-TO-GOTO DTSCSL9
|
|
00507 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCSL9
|
|
00508 ELSE DTSCSL9
|
|
00509 IF REQ-INQUIRE DTSCSL9
|
|
00510 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSL9
|
|
00511 ** ELSE DTSCSL9
|
|
00512 ** IF REQ-EDIT DTSCSL9
|
|
00513 ** PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCSL9
|
|
00514 ** ELSE DTSCSL9
|
|
00515 ** IF REQ-UPDATE DTSCSL9
|
|
00516 ** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCSL9
|
|
00517 ELSE DTSCSL9
|
|
00518 GO TO S899-ABEND. DTSCSL9
|
|
00519 DTSCSL9
|
|
00520 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
00521 GO TO MAINLINE-EXIT. DTSCSL9
|
|
00522 *----------------------------------------------------- DTSCSL9
|
|
00523 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCSL9
|
|
00524 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCSL9
|
|
00525 *----------------------------------------------------- DTSCSL9
|
|
00526 DTSCSL9
|
|
00527 IF RESP-SEND-MAP DTSCSL9
|
|
00528 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCSL9
|
|
00529 SET LCCM-END-TASK-88 TO TRUE DTSCSL9
|
|
00530 ELSE DTSCSL9
|
|
00531 IF RESP-SEND-MSGONLY DTSCSL9
|
|
00532 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL9
|
|
00533 SET LCCM-END-TASK-88 TO TRUE DTSCSL9
|
|
00534 ELSE DTSCSL9
|
|
00535 IF RESP-JUMP DTSCSL9
|
|
00536 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL9
|
|
00537 ELSE DTSCSL9
|
|
00538 IF RESP-CURSOR-TO-GOTO DTSCSL9
|
|
00539 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL9
|
|
00540 SET LCCM-END-TASK-88 TO TRUE DTSCSL9
|
|
00541 ELSE DTSCSL9
|
|
00542 GO TO S899-ABEND. DTSCSL9
|
|
00543 DTSCSL9
|
|
00544 MAINLINE-EXIT. DTSCSL9
|
|
00545 DTSCSL9
|
|
00546 EXEC CICS DTSCSL9
|
|
00547 RETURN DTSCSL9
|
|
00548 END-EXEC. DTSCSL9
|
|
00549 DTSCSL9
|
|
00550 GOBACK. DTSCSL9
|
|
00551 EJECT DTSCSL9
|
|
00552 P0100-ACCESS-SEARCH. DTSCSL9
|
|
00553 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCSL9
|
|
00554 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCSL9
|
|
00555 TO SCR-ACCESS-IND. DTSCSL9
|
|
00556 DTSCSL9
|
|
00557 P0100-EXIT. DTSCSL9
|
|
00558 EXIT. DTSCSL9
|
|
00559 /*****************************************************************DTSCSL9
|
|
00560 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCSL9
|
|
00561 ******************************************************************DTSCSL9
|
|
00562 P1000-ANALYZE-REQUEST. DTSCSL9
|
|
00563 *----------------------------------------------------- DTSCSL9
|
|
00564 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCSL9
|
|
00565 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCSL9
|
|
00566 * REPLACED WITH ENTER) DTSCSL9
|
|
00567 * SET LCCM-SCR-HOLD-AREA TO LOW-VALUES. THIS AREA DTSCSL9
|
|
00568 * CONTAINS THE AIX KEYS FOR THE CURRENT DISPLAY. DTSCSL9
|
|
00569 * IF LCCM-EMP-NO CONTAINS AN EMPLOYER ACCOUNT NUMBER, DTSCSL9
|
|
00570 * USE IT TO BUILD THE INITIAL SCREEN. OTHERWISE, DTSCSL9
|
|
00571 * SEND A BLANK SCREEN. DTSCSL9
|
|
00572 *----------------------------------------------------- DTSCSL9
|
|
00573 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCSL9
|
|
00574 SET LCCM-ENTER-88 TO TRUE DTSCSL9
|
|
00575 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCSL9
|
|
00576 IF LCCM-EMP-NO > ZERO DTSCSL9
|
|
00577 SET REQ-INQUIRE TO TRUE DTSCSL9
|
|
00578 MOVE LCCM-EMP-NO-1 TO MAP-SRCH-EMP-NO-1 DTSCSL9
|
|
00579 MOVE LCCM-EMP-NO-2 TO MAP-SRCH-EMP-NO-2 DTSCSL9
|
|
00580 GO TO P1000-EXIT DTSCSL9
|
|
00581 ELSE DTSCSL9
|
|
00582 SET REQ-CLEAR TO TRUE DTSCSL9
|
|
00583 GO TO P1000-EXIT. DTSCSL9
|
|
00584 DTSCSL9
|
|
00585 DTSCSL9
|
|
00586 *----------------------------------------------------- DTSCSL9
|
|
00587 * MAP IS RECEIVED DTSCSL9
|
|
00588 *----------------------------------------------------- DTSCSL9
|
|
00589 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCSL9
|
|
00590 DTSCSL9
|
|
00591 *----------------------------------------------------- DTSCSL9
|
|
00592 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCSL9
|
|
00593 * WORK STATION DTSCSL9
|
|
00594 *----------------------------------------------------- DTSCSL9
|
|
00595 IF LCCM-CLEAR-88 DTSCSL9
|
|
00596 SET REQ-CLEAR TO TRUE DTSCSL9
|
|
00597 GO TO P1000-EXIT. DTSCSL9
|
|
00598 DTSCSL9
|
|
00599 *----------------------------------------------------- DTSCSL9
|
|
00600 * IF IN UPDATE MODE, VALIDATE AID KEYS DTSCSL9
|
|
00601 *----------------------------------------------------- DTSCSL9
|
|
00602 ** IF LCCM-SCR-UPDATE-LOCKED DTSCSL9
|
|
00603 ** PERFORM P1100-UDPATE-LOCKED THRU P1100-EXIT DTSCSL9
|
|
00604 ** GO TO P1000-EXIT. DTSCSL9
|
|
00605 ** DTSCSL9
|
|
00606 *----------------------------------------------------- DTSCSL9
|
|
00607 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCSL9
|
|
00608 *----------------------------------------------------- DTSCSL9
|
|
00609 IF LCCM-PA2-88 DTSCSL9
|
|
00610 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCSL9
|
|
00611 GO TO P1000-EXIT. DTSCSL9
|
|
00612 DTSCSL9
|
|
00613 *----------------------------------------------------- DTSCSL9
|
|
00614 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCSL9
|
|
00615 *----------------------------------------------------- DTSCSL9
|
|
00616 IF LCCM-PA-88 DTSCSL9
|
|
00617 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL9
|
|
00618 SET REQ-ERROR TO TRUE DTSCSL9
|
|
00619 GO TO P1000-EXIT. DTSCSL9
|
|
00620 DTSCSL9
|
|
00621 *----------------------------------------------------- DTSCSL9
|
|
00622 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCSL9
|
|
00623 * REQUEST TO CLEAR THE SCREEN DTSCSL9
|
|
00624 *----------------------------------------------------- DTSCSL9
|
|
00625 IF LCCM-F12-88 DTSCSL9
|
|
00626 MOVE LOW-VALUES TO MAP-AREA DTSCSL9
|
|
00627 SET REQ-CLEAR TO TRUE DTSCSL9
|
|
00628 GO TO P1000-EXIT. DTSCSL9
|
|
00629 DTSCSL9
|
|
00630 *----------------------------------------------------- DTSCSL9
|
|
00631 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSL9
|
|
00632 *----------------------------------------------------- DTSCSL9
|
|
00633 IF LCCM-F03-88 DTSCSL9
|
|
00634 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL9
|
|
00635 SET REQ-JUMP TO TRUE DTSCSL9
|
|
00636 GO TO P1000-EXIT. DTSCSL9
|
|
00637 DTSCSL9
|
|
00638 *----------------------------------------------------- DTSCSL9
|
|
00639 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCSL9
|
|
00640 *----------------------------------------------------- DTSCSL9
|
|
00641 IF LCCM-F04-88 DTSCSL9
|
|
00642 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL9
|
|
00643 SET REQ-JUMP TO TRUE DTSCSL9
|
|
00644 GO TO P1000-EXIT. DTSCSL9
|
|
00645 DTSCSL9
|
|
00646 *----------------------------------------------------- DTSCSL9
|
|
00647 * IF CORRESPONDENCE KEY PRESSED, JUMP TO DTSCSL9
|
|
00648 * CORRESPONDENCE INQUIRY/UPDATE SCREEN. DTSCSL9
|
|
00649 *----------------------------------------------------- DTSCSL9
|
|
00650 IF LCCM-F14-88 DTSCSL9
|
|
00651 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL9
|
|
00652 SET REQ-JUMP TO TRUE DTSCSL9
|
|
00653 GO TO P1000-EXIT. DTSCSL9
|
|
00654 DTSCSL9
|
|
00655 *----------------------------------------------------- DTSCSL9
|
|
00656 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCSL9
|
|
00657 * REQUESTED SCREEN TYPE DTSCSL9
|
|
00658 *----------------------------------------------------- DTSCSL9
|
|
00659 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCSL9
|
|
00660 NEXT SENTENCE DTSCSL9
|
|
00661 ELSE DTSCSL9
|
|
00662 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCSL9
|
|
00663 SET REQ-JUMP TO TRUE DTSCSL9
|
|
00664 GO TO P1000-EXIT. DTSCSL9
|
|
00665 DTSCSL9
|
|
00666 *----------------------------------------------------- DTSCSL9
|
|
00667 * IF THE USER SELECTED A LINE, JUMP TO DTSCSL9
|
|
00668 * REQUESTED SCREEN TYPE DTSCSL9
|
|
00669 *----------------------------------------------------- DTSCSL9
|
|
00670 IF MAP-LINE-NUMBER = SPACES OR LOW-VALUES DTSCSL9
|
|
00671 NEXT SENTENCE DTSCSL9
|
|
00672 ELSE DTSCSL9
|
|
00673 SET REQ-JUMP TO TRUE DTSCSL9
|
|
00674 GO TO P1000-EXIT. DTSCSL9
|
|
00675 DTSCSL9
|
|
00676 *----------------------------------------------------- DTSCSL9
|
|
00677 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCSL9
|
|
00678 * VERIFY USER ACCESS TO PERFORM UDPATE. DTSCSL9
|
|
00679 *----------------------------------------------------- DTSCSL9
|
|
00680 *** IF LCCM-F05-88 DTSCSL9
|
|
00681 *** OR LCCM-F10-88 DTSCSL9
|
|
00682 *** IF SCR-ACCESS-UPDATE DTSCSL9
|
|
00683 *** SET REQ-EDIT TO TRUE DTSCSL9
|
|
00684 *** GO TO P1000-EXIT DTSCSL9
|
|
00685 *** ELSE DTSCSL9
|
|
00686 *** PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL9
|
|
00687 *** SET REQ-ERROR TO TRUE DTSCSL9
|
|
00688 *** GO TO P1000-EXIT. DTSCSL9
|
|
00689 *** DTSCSL9
|
|
00690 *----------------------------------------------------- DTSCSL9
|
|
00691 * IF INQUIRY TYPE KEY PRESSED (ENTER, F7, DTSCSL9
|
|
00692 * OR F8), INDICATE INQUIRY REQUEST DTSCSL9
|
|
00693 *----------------------------------------------------- DTSCSL9
|
|
00694 IF LCCM-F07-88 DTSCSL9
|
|
00695 OR LCCM-F08-88 DTSCSL9
|
|
00696 OR LCCM-ENTER-88 DTSCSL9
|
|
00697 SET REQ-INQUIRE TO TRUE DTSCSL9
|
|
00698 GO TO P1000-EXIT. DTSCSL9
|
|
00699 DTSCSL9
|
|
00700 *----------------------------------------------------- DTSCSL9
|
|
00701 * ANY OTHER KEY IS INVALID DTSCSL9
|
|
00702 *----------------------------------------------------- DTSCSL9
|
|
00703 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCSL9
|
|
00704 SET REQ-ERROR TO TRUE. DTSCSL9
|
|
00705 P1000-EXIT. DTSCSL9
|
|
00706 EXIT. DTSCSL9
|
|
00707 DTSCSL9
|
|
00708 DTSCSL9
|
|
00709 /*****************************************************************DTSCSL9
|
|
00710 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSL9
|
|
00711 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCSL9
|
|
00712 ******************************************************************DTSCSL9
|
|
00713 P2000-REQUEST-ERROR. DTSCSL9
|
|
00714 IF LCCM-MSG DTSCSL9
|
|
00715 SET RESP-SEND-MSGONLY TO TRUE DTSCSL9
|
|
00716 ELSE DTSCSL9
|
|
00717 GO TO S899-ABEND. DTSCSL9
|
|
00718 P2000-EXIT. DTSCSL9
|
|
00719 EXIT. DTSCSL9
|
|
00720 DTSCSL9
|
|
00721 /*****************************************************************DTSCSL9
|
|
00722 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCSL9
|
|
00723 ******************************************************************DTSCSL9
|
|
00724 P3000-REQUEST-JUMP. DTSCSL9
|
|
00725 *----------------------------------------------------- DTSCSL9
|
|
00726 * IF THERE IS A VALUE IN LCCM-REQ-SCR-ID (THE FIELD DTSCSL9
|
|
00727 * IS INITIALIZED TO SPACES ON ENTRY TO THE PROGRAM) DTSCSL9
|
|
00728 * THE USER HAS PRESSED F3 OR F4 OR HAS ENTERED A DTSCSL9
|
|
00729 * VALUE IN MAP-GOTO. DTSCSL9
|
|
00730 * DTSCSL9
|
|
00731 * IF THERE IS NO VALUE IN LCCM-REQ-SCR-ID, THEN THE DTSCSL9
|
|
00732 * USER HAS SELECTED A LINE WITHOUT SPECIFYING A DTSCSL9
|
|
00733 * SCREEN - SET UP A JUMP TO THE L8 SCREEN BY DEFAULT. DTSCSL9
|
|
00734 * DTSCSL9
|
|
00735 *----------------------------------------------------- DTSCSL9
|
|
00736 IF LCCM-REQ-SCR-ID NOT = SPACES DTSCSL9
|
|
00737 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCSL9
|
|
00738 IF LCCM-MSG DTSCSL9
|
|
00739 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCSL9
|
|
00740 SET RESP-SEND-MSGONLY TO TRUE DTSCSL9
|
|
00741 SET CURSOR-SET-GOTO TO TRUE DTSCSL9
|
|
00742 GO TO P3000-EXIT DTSCSL9
|
|
00743 ELSE DTSCSL9
|
|
00744 NEXT SENTENCE DTSCSL9
|
|
00745 END-IF DTSCSL9
|
|
00746 ELSE DTSCSL9
|
|
00747 MOVE 'L8' TO LCCM-REQ-SCR-ID DTSCSL9
|
|
00748 END-IF. DTSCSL9
|
|
00749 DTSCSL9
|
|
00750 *----------------------------------------------------- DTSCSL9
|
|
00751 * IF THE USER REQUESTED A JUMP TO THE L5 SCREEN: DTSCSL9
|
|
00752 * MOVE THE EPRF KEY TO THE LCCM-SCRL5-HOLD-AREA DTSCSL9
|
|
00753 * ELSE DTSCSL9
|
|
00754 * IF THE USER REQUESTED A JUMP TO THE L8 SCREEN: DTSCSL9
|
|
00755 * IF THE USER HAS SELECTED A LINE DTSCSL9
|
|
00756 * FIND THE KEY FOR THAT LINE IN THE LCCM-SCR-HOLD-AREA DTSCSL9
|
|
00757 * MOVE THE ELOG KEY TO THE LCCM-SCRL8-HOLD-AREA DTSCSL9
|
|
00758 * ELSE DTSCSL9
|
|
00759 * SET UP THE JUMP WITHOUT A KEY DTSCSL9
|
|
00760 * END-IF DTSCSL9
|
|
00761 * END-IF. DTSCSL9
|
|
00762 * DTSCSL9
|
|
00763 * IF THE USER HAS SELECTED A LINE WITHOUT CHOOSING A SCREEN DTSCSL9
|
|
00764 * SET UP A JUMP TO THE L8 SCREEN: DTSCSL9
|
|
00765 * FIND THE KEY FOR THAT LINE IN THE LCCM-SCR-HOLD-AREA DTSCSL9
|
|
00766 * AND MOVE THE ELOG KEY TO THE LCCM-SCRL8-HOLD-AREA DTSCSL9
|
|
00767 * END-IF. DTSCSL9
|
|
00768 * DTSCSL9
|
|
00769 * EDIT LCCM-SCR-HOLD-AREA FOR VALIDITY: THE AIX KEYS DTSCSL9
|
|
00770 * IN THIS AREA CORRESPOND TO THE LINES DISPLAYED AND DTSCSL9
|
|
00771 * ENABLE THE SYSTEM TO FIND THE DETAILED DATA FOR DTSCSL9
|
|
00772 * THE LINE SELECTED. DTSCSL9
|
|
00773 *----------------------------------------------------- DTSCSL9
|
|
00774 IF LCCM-REQ-SCR-ID = 'L5' OR 'L8' DTSCSL9
|
|
00775 PERFORM P3100-JUMP-TO-L-SERIES-SCR THRU P3100-EXIT. DTSCSL9
|
|
00776 DTSCSL9
|
|
00777 MOVE MAP-SRCH-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL9
|
|
00778 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL9
|
|
00779 IF L018-VALID DTSCSL9
|
|
00780 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCSL9
|
|
00781 DTSCSL9
|
|
00782 *----------------------------------------------------- DTSCSL9
|
|
00783 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCSL9
|
|
00784 *----------------------------------------------------- DTSCSL9
|
|
00785 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCSL9
|
|
00786 LCCM-SCR-HOLD-AREA. DTSCSL9
|
|
00787 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCSL9
|
|
00788 SET RESP-JUMP TO TRUE. DTSCSL9
|
|
00789 P3000-EXIT. DTSCSL9
|
|
00790 EXIT. DTSCSL9
|
|
00791 DTSCSL9
|
|
00792 ******************************************************************DTSCSL9
|
|
00793 * USER HAS REQUESTED A JUMP TO ANOTHER L-SERIES SCREEN. DTSCSL9
|
|
00794 ******************************************************************DTSCSL9
|
|
00795 P3100-JUMP-TO-L-SERIES-SCR. DTSCSL9
|
|
00796 PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT. DTSCSL9
|
|
00797 IF WRK-KEY-FOUND-NO DTSCSL9
|
|
00798 GO TO P3100-EXIT. DTSCSL9
|
|
00799 DTSCSL9
|
|
00800 IF LCCM-REQ-SCR-ID = 'L5' DTSCSL9
|
|
00801 PERFORM P3130-JUMP-TO-SCR-L5 THRU P3130-EXIT DTSCSL9
|
|
00802 GO TO P3100-EXIT. DTSCSL9
|
|
00803 DTSCSL9
|
|
00804 PERFORM P3110-SELECTION-LINE-EDIT THRU P3110-EXIT. DTSCSL9
|
|
00805 IF L013-CNT = ZERO DTSCSL9
|
|
00806 GO TO P3100-EXIT. DTSCSL9
|
|
00807 DTSCSL9
|
|
00808 PERFORM P3120-BUILD-KEY-FOR-JUMP THRU P3120-EXIT. DTSCSL9
|
|
00809 DTSCSL9
|
|
00810 P3100-EXIT. DTSCSL9
|
|
00811 EXIT. DTSCSL9
|
|
00812 DTSCSL9
|
|
00813 ******************************************************************DTSCSL9
|
|
00814 * LINE NUMBER IS REQUIRED. NUMBER ENTERED CANNOT BE GREATER DTSCSL9
|
|
00815 * WRK-SCR-HOLD-KEY-CTR (NUMBER OF ENTRIES IN TABLE CORRESPONDS DTSCSL9
|
|
00816 * TO NUMBER OF LINES ON SCREEN). THIS PARAGRAPH RETURNS L013-CNT. DTSCSL9
|
|
00817 ******************************************************************DTSCSL9
|
|
00818 P3110-SELECTION-LINE-EDIT. DTSCSL9
|
|
00819 MOVE +1 TO L013-MIN-CNT. DTSCSL9
|
|
00820 MOVE WRK-SCR-HOLD-KEY-CTR TO L013-MAX-CNT. DTSCSL9
|
|
00821 MOVE MAP-LINE-NUMBER-AREA TO L013-S-CNT-AREA. DTSCSL9
|
|
00822 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT. DTSCSL9
|
|
00823 IF L013-NO-ENTRY DTSCSL9
|
|
00824 MOVE ZERO TO L013-CNT DTSCSL9
|
|
00825 ELSE DTSCSL9
|
|
00826 IF L013-NOT-VALID DTSCSL9
|
|
00827 MOVE ZERO TO L013-CNT. DTSCSL9
|
|
00828 DTSCSL9
|
|
00829 P3110-EXIT. DTSCSL9
|
|
00830 EXIT. DTSCSL9
|
|
00831 DTSCSL9
|
|
00832 P3120-BUILD-KEY-FOR-JUMP. DTSCSL9
|
|
00833 IF LCCM-REQ-SCR-ID = 'L8' DTSCSL9
|
|
00834 PERFORM P3122-JUMP-TO-SCR-L8 THRU P3122-EXIT. DTSCSL9
|
|
00835 DTSCSL9
|
|
00836 P3120-EXIT. DTSCSL9
|
|
00837 EXIT. DTSCSL9
|
|
00838 DTSCSL9
|
|
00839 ******************************************************************DTSCSL9
|
|
00840 * THE L8 SCREEN REQUIRES THE LOG NO. DTSCSL9
|
|
00841 * PASS THE LOG NO FROM THE AIX RECORD TO THE L8 SCREEN IN THE DTSCSL9
|
|
00842 * LCCM-SCRL8-HOLD-AREA. DTSCSL9
|
|
00843 ******************************************************************DTSCSL9
|
|
00844 P3122-JUMP-TO-SCR-L8. DTSCSL9
|
|
00845 MOVE WRK-SCR-HOLD-KEY (L013-CNT) TO ISKL-KEY-AREA. DTSCSL9
|
|
00846 DTSCSL9
|
|
00847 IF ISKL-EET-88 DTSCSL9
|
|
00848 MOVE ISKL-REC TO IEET-REC DTSCSL9
|
|
00849 MOVE IEET-LOG-NO TO WRK-AIX-LOG-NO DTSCSL9
|
|
00850 ELSE DTSCSL9
|
|
00851 IF ISKL-EER-88 DTSCSL9
|
|
00852 MOVE ISKL-REC TO IEER-REC DTSCSL9
|
|
00853 MOVE IEER-LOG-NO TO WRK-AIX-LOG-NO DTSCSL9
|
|
00854 ELSE DTSCSL9
|
|
00855 GO TO P3122-EXIT. DTSCSL9
|
|
00856 DTSCSL9
|
|
00857 MOVE LOW-VALUES TO LCCM-SCRL8-HOLD-AREA. DTSCSL9
|
|
00858 DTSCSL9
|
|
00859 PERFORM P6920-READ-LOG THRU P6920-EXIT. DTSCSL9
|
|
00860 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
00861 GO TO P3122-EXIT. DTSCSL9
|
|
00862 DTSCSL9
|
|
00863 MOVE WRK-AIX-LOG-NO TO LCCM-SCRL8-HOLD-AREA. DTSCSL9
|
|
00864 DTSCSL9
|
|
00865 P3122-EXIT. DTSCSL9
|
|
00866 EXIT. DTSCSL9
|
|
00867 DTSCSL9
|
|
00868 ******************************************************************DTSCSL9
|
|
00869 * THE L5 SCREEN REQUIRES AN EPRF KEY. USE WRK-SRCH-EMP-NO AND DTSCSL9
|
|
00870 * WRK-SRCH-DATA-TYPE RETURNED FROM P9000 TO BUILD THE EPRF KEY. DTSCSL9
|
|
00871 * PASS THE KEY TO THE L5 SCREEN IN THE LCCM-SCRL5-HOLD-AREA. DTSCSL9
|
|
00872 ******************************************************************DTSCSL9
|
|
00873 P3130-JUMP-TO-SCR-L5. DTSCSL9
|
|
00874 MOVE LOW-VALUES TO LCCM-SCRL5-HOLD-AREA. DTSCSL9
|
|
00875 DTSCSL9
|
|
00876 MOVE LOW-VALUES TO EPRF-KEY-AREA. DTSCSL9
|
|
00877 SET EPRF-PRF-88 TO TRUE. DTSCSL9
|
|
00878 MOVE WRK-SRCH-EMP-NO TO EPRF-ELF-ID. DTSCSL9
|
|
00879 MOVE WRK-SRCH-DATA-TYPE TO EPRF-DATA-TYPE-CD. DTSCSL9
|
|
00880 DTSCSL9
|
|
00881 MOVE EPRF-KEY-AREA TO LCCM-SCRL5-HOLD-AREA. DTSCSL9
|
|
00882 DTSCSL9
|
|
00883 P3130-EXIT. DTSCSL9
|
|
00884 EXIT. DTSCSL9
|
|
00885 DTSCSL9
|
|
00886 /*****************************************************************DTSCSL9
|
|
00887 * CLEAR KEY WAS PRESSED *DTSCSL9
|
|
00888 ******************************************************************DTSCSL9
|
|
00889 DTSCSL9
|
|
00890 P4000-REQUEST-CLEAR. DTSCSL9
|
|
00891 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT. DTSCSL9
|
|
00892 DTSCSL9
|
|
00893 *----------------------------------------------------- DTSCSL9
|
|
00894 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCSL9
|
|
00895 * FIELDS FROM EARLIER REQUESTS DTSCSL9
|
|
00896 *----------------------------------------------------- DTSCSL9
|
|
00897 DTSCSL9
|
|
00898 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCSL9
|
|
00899 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL9
|
|
00900 DTSCSL9
|
|
00901 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL9
|
|
00902 DTSCSL9
|
|
00903 SET RESP-SEND-MAP TO TRUE. DTSCSL9
|
|
00904 P4000-EXIT. DTSCSL9
|
|
00905 EXIT. DTSCSL9
|
|
00906 DTSCSL9
|
|
00907 /*****************************************************************DTSCSL9
|
|
00908 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCSL9
|
|
00909 ******************************************************************DTSCSL9
|
|
00910 P5000-CURSOR-TO-GOTO. DTSCSL9
|
|
00911 SET CURSOR-SET-GOTO TO TRUE. DTSCSL9
|
|
00912 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCSL9
|
|
00913 P5000-EXIT. DTSCSL9
|
|
00914 EXIT. DTSCSL9
|
|
00915 DTSCSL9
|
|
00916 /*****************************************************************DTSCSL9
|
|
00917 * INQUIRY WAS REQUESTED *DTSCSL9
|
|
00918 ******************************************************************DTSCSL9
|
|
00919 P6000-REQUEST-INQUIRE. DTSCSL9
|
|
00920 MOVE LOW-VALUES TO MAP-TABLE. DTSCSL9
|
|
00921 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL9
|
|
00922 SET RESP-SEND-MAP TO TRUE. DTSCSL9
|
|
00923 DTSCSL9
|
|
00924 ************************************************************* DTSCSL9
|
|
00925 * IF P1200 HAS NOT FOUND A STARTING KEY IN LCCM-SCRL9-HOLD, DTSCSL9
|
|
00926 * CHECK WHETHER THE AIX TABLE FROM A PREVIOUS TASK EXISTS DTSCSL9
|
|
00927 * IN LCCM-SCR-HOLD-AREA. IF A VALID AIX TABLE EXISTS, SET DTSCSL9
|
|
00928 * WRK-AIX-TBL-KEY-FND TO TRUE. DTSCSL9
|
|
00929 ************************************************************ DTSCSL9
|
|
00930 IF WRK-KEY-FOUND-NO DTSCSL9
|
|
00931 PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT. DTSCSL9
|
|
00932 DTSCSL9
|
|
00933 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCSL9
|
|
00934 WRK-SCR-HOLD-AREA DTSCSL9
|
|
00935 WRK-PAGE-BACK-AREA. DTSCSL9
|
|
00936 *** LCCM-SCRL9-HOLD-AREA. DTSCSL9
|
|
00937 MOVE +0 TO WRK-SCR-HOLD-KEY-CTR. DTSCSL9
|
|
00938 MOVE WRK-MOD-NAME TO WRK-SCR-HOLD-PROG-NAME. DTSCSL9
|
|
00939 DTSCSL9
|
|
00940 IF LCCM-SCR-CLEAR DTSCSL9
|
|
00941 OR WRK-KEY-FOUND-NO DTSCSL9
|
|
00942 PERFORM S1000-SEARCH-KEY-EDITS THRU S1000-EXIT DTSCSL9
|
|
00943 IF LCCM-MSG DTSCSL9
|
|
00944 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT DTSCSL9
|
|
00945 GO TO P6000-EXIT. DTSCSL9
|
|
00946 DTSCSL9
|
|
00947 IF LCCM-F08-88 DTSCSL9
|
|
00948 IF WRK-AIX-TBL-KEY-FND DTSCSL9
|
|
00949 MOVE WRK-ENDING-SEARCH-KEY TO ISKL-KEY-AREA DTSCSL9
|
|
00950 ELSE DTSCSL9
|
|
00951 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCSL9
|
|
00952 ELSE DTSCSL9
|
|
00953 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA. DTSCSL9
|
|
00954 DTSCSL9
|
|
00955 DTSCSL9
|
|
00956 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCSL9
|
|
00957 IF L821-NO-REC-88 DTSCSL9
|
|
00958 PERFORM P6001-SRCH-CRITERIA-ERR THRU P6001-EXIT DTSCSL9
|
|
00959 GO TO P6000-EXIT. DTSCSL9
|
|
00960 DTSCSL9
|
|
00961 IF LCCM-ENTER-88 DTSCSL9
|
|
00962 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCSL9
|
|
00963 ELSE DTSCSL9
|
|
00964 IF LCCM-F07-88 DTSCSL9
|
|
00965 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCSL9
|
|
00966 ELSE DTSCSL9
|
|
00967 IF LCCM-F08-88 DTSCSL9
|
|
00968 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCSL9
|
|
00969 ELSE DTSCSL9
|
|
00970 GO TO S899-ABEND. DTSCSL9
|
|
00971 DTSCSL9
|
|
00972 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
00973 GO TO P6000-EXIT. DTSCSL9
|
|
00974 DTSCSL9
|
|
00975 IF WRK-SCR-HOLD-KEY-CTR > 0 DTSCSL9
|
|
00976 MOVE WRK-SRCH-EMP-NO TO WRK-SCR-HOLD-EMP-NO DTSCSL9
|
|
00977 MOVE WRK-SRCH-DATA-TYPE TO WRK-SCR-HOLD-DATA-TYPE DTSCSL9
|
|
00978 MOVE WRK-SRCH-RPT-YY TO WRK-SCR-HOLD-RPT-YY DTSCSL9
|
|
00979 MOVE WRK-SRCH-RPT-QTR TO WRK-SCR-HOLD-RPT-QTR DTSCSL9
|
|
00980 MOVE WRK-SRCH-RPT-MM TO WRK-SCR-HOLD-RPT-MM DTSCSL9
|
|
00981 MOVE WRK-SRCH-RPT-DD TO WRK-SCR-HOLD-RPT-DD DTSCSL9
|
|
00982 MOVE WRK-SCR-HOLD-AREA TO LCCM-SCR-HOLD-AREA DTSCSL9
|
|
00983 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCSL9
|
|
00984 *** MOVE WRK-SCR-HOLD-KEY (1) TO LCCM-SCRL9-HOLD-AREA DTSCSL9
|
|
00985 MOVE CATB-UNPROT-BRT-NUM-MDTON DTSCSL9
|
|
00986 TO MAP-LINE-NUMBER-A DTSCSL9
|
|
00987 MOVE CATB-CURSOR TO MAP-LINE-NUMBER-L DTSCSL9
|
|
00988 SET CURSOR-SET-YES TO TRUE DTSCSL9
|
|
00989 ELSE DTSCSL9
|
|
00990 GO TO P6000-EXIT. DTSCSL9
|
|
00991 DTSCSL9
|
|
00992 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL9
|
|
00993 P6000-EXIT. DTSCSL9
|
|
00994 EXIT. DTSCSL9
|
|
00995 DTSCSL9
|
|
00996 P6001-SRCH-CRITERIA-ERR. DTSCSL9
|
|
00997 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID DTSCSL9
|
|
00998 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT. DTSCSL9
|
|
00999 DTSCSL9
|
|
01000 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L. DTSCSL9
|
|
01001 DTSCSL9
|
|
01002 IF LCCM-MSG DTSCSL9
|
|
01003 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01004 P6001-EXIT. DTSCSL9
|
|
01005 EXIT. DTSCSL9
|
|
01006 DTSCSL9
|
|
01007 /*****************************************************************DTSCSL9
|
|
01008 * ENTER KEY WAS PRESSED. THE STARTING KEY HAS BEEN SET IN *DTSCSL9
|
|
01009 * P6000, AND THE FIRST RECORD RETURNED FROM A START BROWSE. *DTSCSL9
|
|
01010 ******************************************************************DTSCSL9
|
|
01011 P6100-NO-PAGE. DTSCSL9
|
|
01012 DTSCSL9
|
|
01013 PERFORM P6500-SET-SEARCH-FIELDS THRU P6500-EXIT. DTSCSL9
|
|
01014 PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT DTSCSL9
|
|
01015 VARYING WRK-SUB FROM 1 BY 1 DTSCSL9
|
|
01016 UNTIL WRK-SUB > MAX-LINES DTSCSL9
|
|
01017 OR L821-NO-REC-88 DTSCSL9
|
|
01018 OR WRK-FATAL-ERROR-YES. DTSCSL9
|
|
01019 DTSCSL9
|
|
01020 P6100-EXIT. DTSCSL9
|
|
01021 EXIT. DTSCSL9
|
|
01022 DTSCSL9
|
|
01023 /*****************************************************************DTSCSL9
|
|
01024 * *DTSCSL9
|
|
01025 ******************************************************************DTSCSL9
|
|
01026 P6200-PAGE-BACK. DTSCSL9
|
|
01027 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCSL9
|
|
01028 IF L821-NO-REC-88 DTSCSL9
|
|
01029 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL9
|
|
01030 GO TO P6200-EXIT. DTSCSL9
|
|
01031 DTSCSL9
|
|
01032 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCSL9
|
|
01033 IF L821-NO-REC-88 DTSCSL9
|
|
01034 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCSL9
|
|
01035 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCSL9
|
|
01036 IF L821-NO-REC-88 DTSCSL9
|
|
01037 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL9
|
|
01038 GO TO P6200-EXIT DTSCSL9
|
|
01039 ELSE DTSCSL9
|
|
01040 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCSL9
|
|
01041 PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT DTSCSL9
|
|
01042 VARYING WRK-SUB FROM 1 BY 1 DTSCSL9
|
|
01043 UNTIL WRK-SUB > MAX-LINES DTSCSL9
|
|
01044 OR L821-NO-REC-88 DTSCSL9
|
|
01045 OR WRK-FATAL-ERROR-YES DTSCSL9
|
|
01046 GO TO P6200-EXIT. DTSCSL9
|
|
01047 DTSCSL9
|
|
01048 PERFORM P6800-SCAN-AIX-BACK THRU P6800-EXIT DTSCSL9
|
|
01049 VARYING WRK-SUB FROM 1 BY 1 DTSCSL9
|
|
01050 UNTIL WRK-SUB > MAX-LINES DTSCSL9
|
|
01051 OR L821-NO-REC-88 DTSCSL9
|
|
01052 OR WRK-FATAL-ERROR-YES. DTSCSL9
|
|
01053 DTSCSL9
|
|
01054 IF L821-NO-REC-88 DTSCSL9
|
|
01055 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID. DTSCSL9
|
|
01056 DTSCSL9
|
|
01057 MOVE WRK-PAGE-BACK-CTR TO WRK-SCR-HOLD-KEY-CTR. DTSCSL9
|
|
01058 MOVE ZERO TO WRK-SUB2. DTSCSL9
|
|
01059 PERFORM P6210-BUILD-MAP THRU P6210-EXIT DTSCSL9
|
|
01060 VARYING WRK-SUB FROM WRK-PAGE-BACK-CTR BY -1 DTSCSL9
|
|
01061 UNTIL WRK-SUB < +1. DTSCSL9
|
|
01062 P6200-EXIT. DTSCSL9
|
|
01063 EXIT. DTSCSL9
|
|
01064 DTSCSL9
|
|
01065 P6210-BUILD-MAP. DTSCSL9
|
|
01066 ADD +1 TO WRK-SUB2. DTSCSL9
|
|
01067 MOVE WRK-PAGE-BACK-KEY (WRK-SUB) DTSCSL9
|
|
01068 TO WRK-SCR-HOLD-KEY (WRK-SUB2). DTSCSL9
|
|
01069 MOVE WRK-SUB2 TO WRK-SUB-DISP DTSCSL9
|
|
01070 MOVE WRK-SUB-DISP TO WRK-PAGE-BACK-LINE-NO (WRK-SUB). DTSCSL9
|
|
01071 MOVE WRK-PAGE-BACK-LINE (WRK-SUB) DTSCSL9
|
|
01072 TO MAP-LINE-DATA (WRK-SUB2). DTSCSL9
|
|
01073 P6210-EXIT. DTSCSL9
|
|
01074 EXIT. DTSCSL9
|
|
01075 DTSCSL9
|
|
01076 /*****************************************************************DTSCSL9
|
|
01077 * *DTSCSL9
|
|
01078 ******************************************************************DTSCSL9
|
|
01079 P6300-PAGE-NEXT. DTSCSL9
|
|
01080 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCSL9
|
|
01081 IF L821-NO-REC-88 DTSCSL9
|
|
01082 MOVE WRK-STARTING-SEARCH-KEY TO ISKL-KEY-AREA DTSCSL9
|
|
01083 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCSL9
|
|
01084 IF L821-NO-REC-88 DTSCSL9
|
|
01085 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL9
|
|
01086 GO TO P6300-EXIT DTSCSL9
|
|
01087 ELSE DTSCSL9
|
|
01088 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID. DTSCSL9
|
|
01089 DTSCSL9
|
|
01090 DTSCSL9
|
|
01091 PERFORM P6700-SCAN-AIX-FWD THRU P6700-EXIT DTSCSL9
|
|
01092 VARYING WRK-SUB FROM 1 BY 1 DTSCSL9
|
|
01093 UNTIL WRK-SUB > MAX-LINES DTSCSL9
|
|
01094 OR L821-NO-REC-88 DTSCSL9
|
|
01095 OR WRK-FATAL-ERROR-YES. DTSCSL9
|
|
01096 DTSCSL9
|
|
01097 IF L821-NO-REC-88 DTSCSL9
|
|
01098 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID. DTSCSL9
|
|
01099 P6300-EXIT. DTSCSL9
|
|
01100 EXIT. DTSCSL9
|
|
01101 DTSCSL9
|
|
01102 P6500-SET-SEARCH-FIELDS. DTSCSL9
|
|
01103 MOVE WRK-SRCH-EMP-NO TO WRK-EMP-NO-DISP. DTSCSL9
|
|
01104 MOVE WRK-EMP-NO-DISP-1 TO MAP-SRCH-EMP-NO-1. DTSCSL9
|
|
01105 MOVE WRK-EMP-NO-DISP-2 TO MAP-SRCH-EMP-NO-2. DTSCSL9
|
|
01106 DTSCSL9
|
|
01107 IF WRK-SRCH-DATA-TYPE > ZERO DTSCSL9
|
|
01108 MOVE WRK-SRCH-DATA-TYPE TO MAP-SRCH-DATA-TYPE-CD DTSCSL9
|
|
01109 MOVE WRK-SRCH-DATA-TYPE TO L041-CD-2 DTSCSL9
|
|
01110 SET L041-EPRF-DATA-TYPE-CD TO TRUE DTSCSL9
|
|
01111 PERFORM S041-ELEC-MEDIA-CODES THRU S041-EXIT DTSCSL9
|
|
01112 IF L041-VALID DTSCSL9
|
|
01113 MOVE L041-SHORT-DSCR TO MAP-DATA-TYPE-DSCR. DTSCSL9
|
|
01114 DTSCSL9
|
|
01115 IF WRK-SRCH-RPT-YY > ZERO DTSCSL9
|
|
01116 MOVE WRK-SRCH-RPT-YY TO MAP-SRCH-RPT-YR. DTSCSL9
|
|
01117 IF WRK-SRCH-RPT-QTR > ZERO DTSCSL9
|
|
01118 MOVE WRK-SRCH-RPT-QTR TO MAP-SRCH-RPT-QTR. DTSCSL9
|
|
01119 IF WRK-SRCH-RPT-MM > ZERO DTSCSL9
|
|
01120 MOVE WRK-SRCH-RPT-MM TO MAP-SRCH-RPT-MTH. DTSCSL9
|
|
01121 IF WRK-SRCH-RPT-DD > ZERO DTSCSL9
|
|
01122 MOVE WRK-SRCH-RPT-DD TO MAP-SRCH-RPT-DAY. DTSCSL9
|
|
01123 DTSCSL9
|
|
01124 P6500-EXIT. DTSCSL9
|
|
01125 EXIT. DTSCSL9
|
|
01126 DTSCSL9
|
|
01127 P6700-SCAN-AIX-FWD. DTSCSL9
|
|
01128 PERFORM P6900-FORMAT-LINE THRU P6900-EXIT. DTSCSL9
|
|
01129 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
01130 GO TO P6700-EXIT DTSCSL9
|
|
01131 ELSE DTSCSL9
|
|
01132 MOVE ISKL-KEY-AREA TO WRK-SCR-HOLD-KEY (WRK-SUB) DTSCSL9
|
|
01133 MOVE WRK-SUB TO WRK-SUB-DISP DTSCSL9
|
|
01134 MOVE WRK-SUB-DISP TO WRK-SCR-LINE-NO DTSCSL9
|
|
01135 MOVE SPACES TO MAP-LINE-DATA (WRK-SUB) DTSCSL9
|
|
01136 MOVE WRK-SCREEN-DATA-LINE TO MAP-LINE-DATA (WRK-SUB) DTSCSL9
|
|
01137 MOVE WRK-SUB TO WRK-SCR-HOLD-KEY-CTR. DTSCSL9
|
|
01138 DTSCSL9
|
|
01139 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCSL9
|
|
01140 IF L821-OK-88 DTSCSL9
|
|
01141 IF ISKL-EER-88 DTSCSL9
|
|
01142 MOVE ISKL-REC TO IEER-REC DTSCSL9
|
|
01143 ELSE DTSCSL9
|
|
01144 IF ISKL-EET-88 DTSCSL9
|
|
01145 MOVE ISKL-REC TO IEET-REC. DTSCSL9
|
|
01146 DTSCSL9
|
|
01147 P6700-EXIT. DTSCSL9
|
|
01148 EXIT. DTSCSL9
|
|
01149 P6800-SCAN-AIX-BACK. DTSCSL9
|
|
01150 PERFORM P6900-FORMAT-LINE THRU P6900-EXIT. DTSCSL9
|
|
01151 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
01152 GO TO P6800-EXIT DTSCSL9
|
|
01153 ELSE DTSCSL9
|
|
01154 MOVE ISKL-KEY-AREA TO WRK-PAGE-BACK-KEY (WRK-SUB) DTSCSL9
|
|
01155 MOVE SPACES TO WRK-PAGE-BACK-LINE (WRK-SUB) DTSCSL9
|
|
01156 MOVE WRK-SCREEN-DATA-LINE DTSCSL9
|
|
01157 TO WRK-PAGE-BACK-LINE (WRK-SUB) DTSCSL9
|
|
01158 MOVE WRK-SUB TO WRK-PAGE-BACK-CTR. DTSCSL9
|
|
01159 DTSCSL9
|
|
01160 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCSL9
|
|
01161 IF L821-OK-88 DTSCSL9
|
|
01162 IF ISKL-EER-88 DTSCSL9
|
|
01163 MOVE ISKL-REC TO IEER-REC DTSCSL9
|
|
01164 ELSE DTSCSL9
|
|
01165 IF ISKL-EET-88 DTSCSL9
|
|
01166 MOVE ISKL-REC TO IEET-REC. DTSCSL9
|
|
01167 DTSCSL9
|
|
01168 P6800-EXIT. DTSCSL9
|
|
01169 EXIT. DTSCSL9
|
|
01170 /*****************************************************************DTSCSL9
|
|
01171 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCSL9
|
|
01172 ******************************************************************DTSCSL9
|
|
01173 P6900-FORMAT-LINE. DTSCSL9
|
|
01174 DTSCSL9
|
|
01175 MOVE SPACES TO WRK-SCREEN-DATA-LINE. DTSCSL9
|
|
01176 DTSCSL9
|
|
01177 PERFORM P6910-READ-EMH THRU P6910-EXIT. DTSCSL9
|
|
01178 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
01179 GO TO P6900-EXIT. DTSCSL9
|
|
01180 DTSCSL9
|
|
01181 PERFORM P6920-READ-LOG THRU P6920-EXIT. DTSCSL9
|
|
01182 IF WRK-FATAL-ERROR-YES DTSCSL9
|
|
01183 GO TO P6900-EXIT. DTSCSL9
|
|
01184 DTSCSL9
|
|
01185 MOVE WRK-ELF-NAME TO MAP-EMP-NAME. DTSCSL9
|
|
01186 DTSCSL9
|
|
01187 MOVE EEMH-DATA-TYPE-CD TO L041-CD-2. DTSCSL9
|
|
01188 SET L041-EPRF-DATA-TYPE-CD TO TRUE. DTSCSL9
|
|
01189 PERFORM S041-ELEC-MEDIA-CODES THRU S041-EXIT. DTSCSL9
|
|
01190 IF L041-VALID DTSCSL9
|
|
01191 MOVE L041-LONG-DSCR TO WRK-SCR-DATA-TYPE. DTSCSL9
|
|
01192 DTSCSL9
|
|
01193 IF EEMH-REPORTING-DATE > ZERO DTSCSL9
|
|
01194 MOVE EEMH-REPORTING-DATE TO L001-FED-8-DATE-9 DTSCSL9
|
|
01195 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL9
|
|
01196 IF L001-VALID-DATE DTSCSL9
|
|
01197 MOVE L001-SLASH-DATE TO WRK-SCR-RPT-DATE. DTSCSL9
|
|
01198 DTSCSL9
|
|
01199 IF ELOG-RCVD-DATE > ZERO DTSCSL9
|
|
01200 MOVE ELOG-RCVD-DATE TO L001-FED-8-DATE-9 DTSCSL9
|
|
01201 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL9
|
|
01202 IF L001-VALID-DATE DTSCSL9
|
|
01203 MOVE L001-SLASH-DATE TO WRK-SCR-RCVD-DATE. DTSCSL9
|
|
01204 DTSCSL9
|
|
01205 IF ELOG-COMPLETE-DATE > ZERO DTSCSL9
|
|
01206 MOVE ELOG-COMPLETE-DATE TO L001-FED-8-DATE-9 DTSCSL9
|
|
01207 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCSL9
|
|
01208 IF L001-VALID-DATE DTSCSL9
|
|
01209 MOVE L001-SLASH-DATE TO WRK-SCR-CMPL-DATE. DTSCSL9
|
|
01210 DTSCSL9
|
|
01211 MOVE EEMH-RESULT-CD TO L041-CD-2. DTSCSL9
|
|
01212 SET L041-EEMH-RESULT-CD TO TRUE. DTSCSL9
|
|
01213 PERFORM S041-ELEC-MEDIA-CODES THRU S041-EXIT. DTSCSL9
|
|
01214 IF L041-VALID DTSCSL9
|
|
01215 MOVE L041-SHORT-DSCR TO WRK-SCR-RESULT. DTSCSL9
|
|
01216 DTSCSL9
|
|
01217 DTSCSL9
|
|
01218 P6900-EXIT. DTSCSL9
|
|
01219 EXIT. DTSCSL9
|
|
01220 DTSCSL9
|
|
01221 P6910-READ-EMH. DTSCSL9
|
|
01222 MOVE LOW-VALUES TO EEMH-REC. DTSCSL9
|
|
01223 SET EEMH-EMH-88 TO TRUE. DTSCSL9
|
|
01224 MOVE WRK-AIX-EMP-NO TO EEMH-EMP-NO. DTSCSL9
|
|
01225 MOVE WRK-AIX-RPT-DATE TO EEMH-REPORTING-DATE. DTSCSL9
|
|
01226 MOVE WRK-AIX-DATA-TYPE TO EEMH-DATA-TYPE-CD. DTSCSL9
|
|
01227 MOVE WRK-AIX-LOG-NO TO EEMH-LOG-NO. DTSCSL9
|
|
01228 MOVE EEMH-KEY-AREA TO ESKL-KEY-AREA. DTSCSL9
|
|
01229 DTSCSL9
|
|
01230 PERFORM S835-READ THRU S835-EXIT. DTSCSL9
|
|
01231 IF L835-OK-88 DTSCSL9
|
|
01232 MOVE ESKL-REC TO EEMH-REC DTSCSL9
|
|
01233 ELSE DTSCSL9
|
|
01234 MOVE MSG-EL93-AREA TO LCCM-MSG-ID DTSCSL9
|
|
01235 SET WRK-FATAL-ERROR-YES TO TRUE. DTSCSL9
|
|
01236 DTSCSL9
|
|
01237 P6910-EXIT. DTSCSL9
|
|
01238 EXIT. DTSCSL9
|
|
01239 DTSCSL9
|
|
01240 P6920-READ-LOG. DTSCSL9
|
|
01241 MOVE LOW-VALUES TO ELOG-REC. DTSCSL9
|
|
01242 SET ELOG-LOG-88 TO TRUE. DTSCSL9
|
|
01243 MOVE WRK-AIX-LOG-NO TO ELOG-LOG-NO. DTSCSL9
|
|
01244 MOVE ELOG-KEY-AREA TO ESKL-KEY-AREA. DTSCSL9
|
|
01245 DTSCSL9
|
|
01246 PERFORM S835-READ THRU S835-EXIT. DTSCSL9
|
|
01247 IF L835-OK-88 DTSCSL9
|
|
01248 MOVE ESKL-REC TO ELOG-REC DTSCSL9
|
|
01249 ELSE DTSCSL9
|
|
01250 MOVE MSG-EL93-AREA TO LCCM-MSG-ID DTSCSL9
|
|
01251 SET WRK-FATAL-ERROR-YES TO TRUE. DTSCSL9
|
|
01252 DTSCSL9
|
|
01253 DTSCSL9
|
|
01254 P6920-EXIT. DTSCSL9
|
|
01255 EXIT. DTSCSL9
|
|
01256 DTSCSL9
|
|
01257 /*****************************************************************DTSCSL9
|
|
01258 * CHECK DATA IN LCCM-SCR-HOLD-AREA. THE TABLE CONTAINS AIX KEYS DTSCSL9
|
|
01259 * REPRESENTING EACH LINE DISPLAYED. THIS PARAGRAPH IS CALLED DTSCSL9
|
|
01260 * FROM P3000, P4000, P6000. DTSCSL9
|
|
01261 ******************************************************************DTSCSL9
|
|
01262 P9000-CHECK-LCCM-SCR-HOLD. DTSCSL9
|
|
01263 MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA DTSCSL9
|
|
01264 IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME DTSCSL9
|
|
01265 NEXT SENTENCE DTSCSL9
|
|
01266 ELSE DTSCSL9
|
|
01267 GO TO P9000-EXIT. DTSCSL9
|
|
01268 DTSCSL9
|
|
01269 MOVE WRK-SCR-HOLD-EMP-NO TO WRK-SRCH-EMP-NO. DTSCSL9
|
|
01270 MOVE WRK-SCR-HOLD-DATA-TYPE TO WRK-SRCH-DATA-TYPE. DTSCSL9
|
|
01271 MOVE WRK-SCR-HOLD-RPT-YY TO WRK-SRCH-RPT-YY. DTSCSL9
|
|
01272 MOVE WRK-SCR-HOLD-RPT-QTR TO WRK-SRCH-RPT-QTR. DTSCSL9
|
|
01273 MOVE WRK-SCR-HOLD-RPT-MM TO WRK-SRCH-RPT-MM. DTSCSL9
|
|
01274 MOVE WRK-SCR-HOLD-RPT-DD TO WRK-SRCH-RPT-DD. DTSCSL9
|
|
01275 DTSCSL9
|
|
01276 MOVE WRK-SRCH-RPT-YY TO L001-FED-6-YR. DTSCSL9
|
|
01277 MOVE WRK-SRCH-RPT-MM TO L001-FED-6-MO. DTSCSL9
|
|
01278 MOVE WRK-SRCH-RPT-DD TO L001-FED-6-DA. DTSCSL9
|
|
01279 IF L001-FED-6-DATE-9 = ZEROS DTSCSL9
|
|
01280 NEXT SENTENCE DTSCSL9
|
|
01281 ELSE DTSCSL9
|
|
01282 PERFORM S001-FROM-FED-6 THRU S001-EXIT DTSCSL9
|
|
01283 IF L001-VALID-DATE DTSCSL9
|
|
01284 MOVE L001-FED-8-DATE-9 TO WRK-SRCH-RPT-DATE DTSCSL9
|
|
01285 ELSE DTSCSL9
|
|
01286 MOVE ZEROS TO WRK-SRCH-RPT-YY DTSCSL9
|
|
01287 WRK-SRCH-RPT-QTR DTSCSL9
|
|
01288 WRK-SRCH-RPT-MM DTSCSL9
|
|
01289 WRK-SRCH-RPT-DD DTSCSL9
|
|
01290 WRK-SRCH-RPT-DATE. DTSCSL9
|
|
01291 DTSCSL9
|
|
01292 MOVE WRK-SCR-HOLD-KEY (1) TO ISKL-KEY-AREA. DTSCSL9
|
|
01293 IF ISKL-EET-88 DTSCSL9
|
|
01294 OR ISKL-EER-88 DTSCSL9
|
|
01295 MOVE ISKL-KEY-AREA TO WRK-STARTING-SEARCH-KEY DTSCSL9
|
|
01296 ELSE DTSCSL9
|
|
01297 GO TO P9000-EXIT. DTSCSL9
|
|
01298 DTSCSL9
|
|
01299 MOVE WRK-SCR-HOLD-KEY (WRK-SCR-HOLD-KEY-CTR) DTSCSL9
|
|
01300 TO ISKL-KEY-AREA. DTSCSL9
|
|
01301 IF ISKL-EET-88 DTSCSL9
|
|
01302 OR ISKL-EER-88 DTSCSL9
|
|
01303 MOVE ISKL-KEY-AREA TO WRK-ENDING-SEARCH-KEY DTSCSL9
|
|
01304 ELSE DTSCSL9
|
|
01305 MOVE WRK-STARTING-SEARCH-KEY DTSCSL9
|
|
01306 TO WRK-ENDING-SEARCH-KEY. DTSCSL9
|
|
01307 DTSCSL9
|
|
01308 SET WRK-AIX-TBL-KEY-FND TO TRUE. DTSCSL9
|
|
01309 DTSCSL9
|
|
01310 P9000-EXIT. DTSCSL9
|
|
01311 EXIT. DTSCSL9
|
|
01312 DTSCSL9
|
|
01313 /*****************************************************************DTSCSL9
|
|
01314 * LINKS TO UTILITY MODULES DTSCSL9
|
|
01315 ******************************************************************DTSCSL9
|
|
01316 DTSCSL9
|
|
01317 S001-FROM-FED-6. DTSCSL9
|
|
01318 SET L001-FROM-FED-6 TO TRUE. DTSCSL9
|
|
01319 GO TO S001-DATE. DTSCSL9
|
|
01320 DTSCSL9
|
|
01321 S001-FROM-FED-8. DTSCSL9
|
|
01322 SET L001-FROM-FED-8 TO TRUE. DTSCSL9
|
|
01323 GO TO S001-DATE. DTSCSL9
|
|
01324 DTSCSL9
|
|
01325 S001-DATE. DTSCSL9
|
|
01326 EXEC CICS LINK DTSCSL9
|
|
01327 PROGRAM('DTSCU001') DTSCSL9
|
|
01328 COMMAREA(L001-COMM-AREA) DTSCSL9
|
|
01329 END-EXEC. DTSCSL9
|
|
01330 S001-EXIT. DTSCSL9
|
|
01331 EXIT. DTSCSL9
|
|
01332 DTSCSL9
|
|
01333 S004-FROM-3. DTSCSL9
|
|
01334 SET L004-FROM-3 TO TRUE. DTSCSL9
|
|
01335 GO TO S004-LINK. DTSCSL9
|
|
01336 DTSCSL9
|
|
01337 S004-LINK. DTSCSL9
|
|
01338 EXEC CICS LINK DTSCSL9
|
|
01339 PROGRAM('DTSCU004') DTSCSL9
|
|
01340 COMMAREA(L004-COMM-AREA) DTSCSL9
|
|
01341 END-EXEC. DTSCSL9
|
|
01342 S004-EXIT. DTSCSL9
|
|
01343 EXIT. DTSCSL9
|
|
01344 DTSCSL9
|
|
01345 S013-COUNT-FROM-SCREEN. DTSCSL9
|
|
01346 EXEC CICS LINK DTSCSL9
|
|
01347 PROGRAM('DTSCU013') DTSCSL9
|
|
01348 COMMAREA(L013-COMM-AREA) DTSCSL9
|
|
01349 END-EXEC. DTSCSL9
|
|
01350 S013-EXIT. DTSCSL9
|
|
01351 EXIT. DTSCSL9
|
|
01352 DTSCSL9
|
|
01353 S015-DATE-FROM-SCREEN. DTSCSL9
|
|
01354 EXEC CICS LINK DTSCSL9
|
|
01355 PROGRAM('DTSCU015') DTSCSL9
|
|
01356 COMMAREA(L015-COMM-AREA) DTSCSL9
|
|
01357 END-EXEC. DTSCSL9
|
|
01358 S015-EXIT. DTSCSL9
|
|
01359 EXIT. DTSCSL9
|
|
01360 DTSCSL9
|
|
01361 S018-EMP-NO-FROM-SCREEN. DTSCSL9
|
|
01362 EXEC CICS LINK DTSCSL9
|
|
01363 PROGRAM('DTSCU018') DTSCSL9
|
|
01364 COMMAREA(L018-COMM-AREA) DTSCSL9
|
|
01365 END-EXEC. DTSCSL9
|
|
01366 S018-EXIT. DTSCSL9
|
|
01367 EXIT. DTSCSL9
|
|
01368 DTSCSL9
|
|
01369 S041-ELEC-MEDIA-CODES. DTSCSL9
|
|
01370 EXEC CICS LINK DTSCSL9
|
|
01371 PROGRAM('DTSCU041') DTSCSL9
|
|
01372 COMMAREA(L041-COMM-AREA) DTSCSL9
|
|
01373 END-EXEC. DTSCSL9
|
|
01374 S041-EXIT. DTSCSL9
|
|
01375 EXIT. DTSCSL9
|
|
01376 DTSCSL9
|
|
01377 S803-REQ-SCR-ID-EDIT. DTSCSL9
|
|
01378 EXEC CICS LINK DTSCSL9
|
|
01379 PROGRAM ('DTSCU803') DTSCSL9
|
|
01380 COMMAREA (DFHCOMMAREA) DTSCSL9
|
|
01381 END-EXEC. DTSCSL9
|
|
01382 S803-EXIT. DTSCSL9
|
|
01383 EXIT. DTSCSL9
|
|
01384 DTSCSL9
|
|
01385 S804-INVALID-KEY. DTSCSL9
|
|
01386 EXEC CICS LINK DTSCSL9
|
|
01387 PROGRAM ('DTSCU804') DTSCSL9
|
|
01388 COMMAREA (DFHCOMMAREA) DTSCSL9
|
|
01389 END-EXEC. DTSCSL9
|
|
01390 S804-EXIT. DTSCSL9
|
|
01391 EXIT. DTSCSL9
|
|
01392 DTSCSL9
|
|
01393 S805-MSG-AREA. DTSCSL9
|
|
01394 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCSL9
|
|
01395 DTSCSL9
|
|
01396 EXEC CICS LINK DTSCSL9
|
|
01397 PROGRAM ('DTSCU805') DTSCSL9
|
|
01398 COMMAREA (L805-COMM-AREA) DTSCSL9
|
|
01399 END-EXEC. DTSCSL9
|
|
01400 DTSCSL9
|
|
01401 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCSL9
|
|
01402 S805-EXIT. DTSCSL9
|
|
01403 EXIT. DTSCSL9
|
|
01404 EJECT DTSCSL9
|
|
01405 S810-READ. DTSCSL9
|
|
01406 SET L810-READ-88 TO TRUE. DTSCSL9
|
|
01407 GO TO S810-IO. DTSCSL9
|
|
01408 DTSCSL9
|
|
01409 S810-IO. DTSCSL9
|
|
01410 DTSCSL9
|
|
01411 EXEC CICS LINK DTSCSL9
|
|
01412 PROGRAM ('DTSCU810') DTSCSL9
|
|
01413 COMMAREA (L810-COMM-AREA) DTSCSL9
|
|
01414 END-EXEC. DTSCSL9
|
|
01415 DTSCSL9
|
|
01416 IF L810-FILE-CLOSED-88 DTSCSL9
|
|
01417 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01418 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL9
|
|
01419 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL9
|
|
01420 GO TO MAINLINE-EXIT. DTSCSL9
|
|
01421 S810-EXIT. DTSCSL9
|
|
01422 EXIT. DTSCSL9
|
|
01423 EJECT DTSCSL9
|
|
01424 DTSCSL9
|
|
01425 S835-READ. DTSCSL9
|
|
01426 SET L835-READ-88 TO TRUE. DTSCSL9
|
|
01427 GO TO S835-IO. DTSCSL9
|
|
01428 DTSCSL9
|
|
01429 S835-READ-UPDATE. DTSCSL9
|
|
01430 SET L835-READ-UPDATE-88 TO TRUE. DTSCSL9
|
|
01431 GO TO S835-IO. DTSCSL9
|
|
01432 DTSCSL9
|
|
01433 S835-START-BROWSE. DTSCSL9
|
|
01434 SET L835-START-BROWSE-88 TO TRUE. DTSCSL9
|
|
01435 GO TO S835-IO. DTSCSL9
|
|
01436 DTSCSL9
|
|
01437 S835-READ-NEXT. DTSCSL9
|
|
01438 SET L835-READ-NEXT-88 TO TRUE. DTSCSL9
|
|
01439 GO TO S835-IO. DTSCSL9
|
|
01440 DTSCSL9
|
|
01441 S835-READ-PREV. DTSCSL9
|
|
01442 SET L835-READ-PREV-88 TO TRUE. DTSCSL9
|
|
01443 GO TO S835-IO. DTSCSL9
|
|
01444 DTSCSL9
|
|
01445 S835-END-BROWSE. DTSCSL9
|
|
01446 SET L835-END-BROWSE-88 TO TRUE. DTSCSL9
|
|
01447 GO TO S835-IO. DTSCSL9
|
|
01448 DTSCSL9
|
|
01449 S835-COUNT. DTSCSL9
|
|
01450 SET L835-COUNT-88 TO TRUE. DTSCSL9
|
|
01451 GO TO S835-IO. DTSCSL9
|
|
01452 DTSCSL9
|
|
01453 S835-REWRITE. DTSCSL9
|
|
01454 SET L835-REWRITE-88 TO TRUE. DTSCSL9
|
|
01455 GO TO S835-IO. DTSCSL9
|
|
01456 DTSCSL9
|
|
01457 S835-REWRITE-UPDATE. DTSCSL9
|
|
01458 SET L835-REWRITE-UPDATE-88 TO TRUE. DTSCSL9
|
|
01459 GO TO S835-IO. DTSCSL9
|
|
01460 DTSCSL9
|
|
01461 S835-WRITE. DTSCSL9
|
|
01462 SET L835-WRITE-88 TO TRUE. DTSCSL9
|
|
01463 GO TO S835-IO. DTSCSL9
|
|
01464 DTSCSL9
|
|
01465 S835-DELETE. DTSCSL9
|
|
01466 SET L835-DELETE-88 TO TRUE. DTSCSL9
|
|
01467 GO TO S835-IO. DTSCSL9
|
|
01468 DTSCSL9
|
|
01469 S835-IO. DTSCSL9
|
|
01470 DTSCSL9
|
|
01471 EXEC CICS LINK DTSCSL9
|
|
01472 PROGRAM ('DTSCU835') DTSCSL9
|
|
01473 COMMAREA (L835-COMM-AREA) DTSCSL9
|
|
01474 END-EXEC. DTSCSL9
|
|
01475 DTSCSL9
|
|
01476 IF L835-FILE-CLOSED-88 DTSCSL9
|
|
01477 MOVE L835-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01478 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL9
|
|
01479 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL9
|
|
01480 GO TO MAINLINE-EXIT. DTSCSL9
|
|
01481 S835-EXIT. DTSCSL9
|
|
01482 EXIT. DTSCSL9
|
|
01483 EJECT DTSCSL9
|
|
01484 S821-START-BROWSE. DTSCSL9
|
|
01485 SET L821-START-BROWSE-88 TO TRUE. DTSCSL9
|
|
01486 GO TO S821-MASTER-IO. DTSCSL9
|
|
01487 DTSCSL9
|
|
01488 S821-END-BROWSE. DTSCSL9
|
|
01489 SET L821-END-BROWSE-88 TO TRUE. DTSCSL9
|
|
01490 GO TO S821-MASTER-IO. DTSCSL9
|
|
01491 DTSCSL9
|
|
01492 S821-READ-PREV. DTSCSL9
|
|
01493 SET L821-READ-PREV-88 TO TRUE. DTSCSL9
|
|
01494 GO TO S821-MASTER-IO. DTSCSL9
|
|
01495 DTSCSL9
|
|
01496 S821-READ-NEXT. DTSCSL9
|
|
01497 SET L821-READ-NEXT-88 TO TRUE. DTSCSL9
|
|
01498 GO TO S821-MASTER-IO. DTSCSL9
|
|
01499 DTSCSL9
|
|
01500 S821-MASTER-IO. DTSCSL9
|
|
01501 MOVE ISKL-KEY-AREA TO HOLD-ISKL-KEY-AREA. DTSCSL9
|
|
01502 DTSCSL9
|
|
01503 EXEC CICS LINK DTSCSL9
|
|
01504 PROGRAM ('DTSCU821') DTSCSL9
|
|
01505 COMMAREA (L821-COMM-AREA) DTSCSL9
|
|
01506 END-EXEC. DTSCSL9
|
|
01507 DTSCSL9
|
|
01508 IF L821-FILE-CLOSED-88 DTSCSL9
|
|
01509 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01510 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL9
|
|
01511 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL9
|
|
01512 GO TO MAINLINE-EXIT DTSCSL9
|
|
01513 ELSE DTSCSL9
|
|
01514 IF L821-OK-88 DTSCSL9
|
|
01515 PERFORM S821A-SIMULATE-NO-REC THRU S821A-EXIT. DTSCSL9
|
|
01516 S821-EXIT. EXIT. DTSCSL9
|
|
01517 DTSCSL9
|
|
01518 S821A-SIMULATE-NO-REC. DTSCSL9
|
|
01519 IF L821-END-BROWSE-88 DTSCSL9
|
|
01520 GO TO S821A-EXIT. DTSCSL9
|
|
01521 DTSCSL9
|
|
01522 IF ISKL-EET-88 DTSCSL9
|
|
01523 MOVE ISKL-REC TO IEET-REC DTSCSL9
|
|
01524 PERFORM S821A1-EET THRU S821A1-EXIT DTSCSL9
|
|
01525 ELSE DTSCSL9
|
|
01526 IF ISKL-EER-88 DTSCSL9
|
|
01527 MOVE ISKL-REC TO IEER-REC DTSCSL9
|
|
01528 PERFORM S821A2-EER THRU S821A2-EXIT. DTSCSL9
|
|
01529 DTSCSL9
|
|
01530 IF L821-NO-REC-88 DTSCSL9
|
|
01531 SET L821-END-BROWSE-88 TO TRUE DTSCSL9
|
|
01532 EXEC CICS LINK DTSCSL9
|
|
01533 PROGRAM ('DTSCU821') DTSCSL9
|
|
01534 COMMAREA (L821-COMM-AREA) DTSCSL9
|
|
01535 END-EXEC DTSCSL9
|
|
01536 MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA DTSCSL9
|
|
01537 SET L821-NO-REC-88 TO TRUE. DTSCSL9
|
|
01538 DTSCSL9
|
|
01539 S821A-EXIT. EXIT. DTSCSL9
|
|
01540 DTSCSL9
|
|
01541 S821A1-EET. DTSCSL9
|
|
01542 IF IEET-EMP-NO NOT = WRK-SRCH-EMP-NO DTSCSL9
|
|
01543 SET L821-NO-REC-88 TO TRUE DTSCSL9
|
|
01544 GO TO S821A1-EXIT DTSCSL9
|
|
01545 END-IF. DTSCSL9
|
|
01546 DTSCSL9
|
|
01547 IF WRK-SRCH-DATA-TYPE = ZEROS DTSCSL9
|
|
01548 NEXT SENTENCE DTSCSL9
|
|
01549 ELSE DTSCSL9
|
|
01550 IF IEET-DATA-TYPE-CD NOT = WRK-SRCH-DATA-TYPE DTSCSL9
|
|
01551 SET L821-NO-REC-88 TO TRUE DTSCSL9
|
|
01552 GO TO S821A1-EXIT DTSCSL9
|
|
01553 END-IF DTSCSL9
|
|
01554 END-IF. DTSCSL9
|
|
01555 DTSCSL9
|
|
01556 IF WRK-SRCH-RPT-DATE = ZEROS DTSCSL9
|
|
01557 NEXT SENTENCE DTSCSL9
|
|
01558 ELSE DTSCSL9
|
|
01559 IF WRK-SRCH-RPT-DATE NOT = DTSCSL9
|
|
01560 (99999999 - IEET-RPT-DATE-XOR) DTSCSL9
|
|
01561 SET L821-NO-REC-88 TO TRUE DTSCSL9
|
|
01562 GO TO S821A1-EXIT DTSCSL9
|
|
01563 END-IF DTSCSL9
|
|
01564 END-IF. DTSCSL9
|
|
01565 DTSCSL9
|
|
01566 MOVE IEET-EMP-NO TO WRK-AIX-EMP-NO. DTSCSL9
|
|
01567 MOVE IEET-DATA-TYPE-CD TO WRK-AIX-DATA-TYPE. DTSCSL9
|
|
01568 COMPUTE WRK-AIX-RPT-DATE = DTSCSL9
|
|
01569 (99999999 - IEET-RPT-DATE-XOR). DTSCSL9
|
|
01570 MOVE IEET-LOG-NO TO WRK-AIX-LOG-NO. DTSCSL9
|
|
01571 DTSCSL9
|
|
01572 S821A1-EXIT. DTSCSL9
|
|
01573 EXIT. DTSCSL9
|
|
01574 DTSCSL9
|
|
01575 S821A2-EER. DTSCSL9
|
|
01576 IF IEER-EMP-NO NOT = WRK-SRCH-EMP-NO DTSCSL9
|
|
01577 SET L821-NO-REC-88 TO TRUE DTSCSL9
|
|
01578 GO TO S821A2-EXIT DTSCSL9
|
|
01579 END-IF. DTSCSL9
|
|
01580 DTSCSL9
|
|
01581 IF WRK-SRCH-DATA-TYPE = ZEROS DTSCSL9
|
|
01582 NEXT SENTENCE DTSCSL9
|
|
01583 ELSE DTSCSL9
|
|
01584 IF IEER-DATA-TYPE-CD NOT = WRK-SRCH-DATA-TYPE DTSCSL9
|
|
01585 SET L821-NO-REC-88 TO TRUE DTSCSL9
|
|
01586 GO TO S821A2-EXIT DTSCSL9
|
|
01587 END-IF DTSCSL9
|
|
01588 END-IF. DTSCSL9
|
|
01589 DTSCSL9
|
|
01590 MOVE IEER-EMP-NO TO WRK-AIX-EMP-NO. DTSCSL9
|
|
01591 MOVE IEER-DATA-TYPE-CD TO WRK-AIX-DATA-TYPE. DTSCSL9
|
|
01592 COMPUTE WRK-AIX-RPT-DATE = DTSCSL9
|
|
01593 (99999999 - IEER-RPT-DATE-XOR). DTSCSL9
|
|
01594 MOVE IEER-LOG-NO TO WRK-AIX-LOG-NO. DTSCSL9
|
|
01595 DTSCSL9
|
|
01596 S821A2-EXIT. DTSCSL9
|
|
01597 EXIT. DTSCSL9
|
|
01598 DTSCSL9
|
|
01599 S851-SCREEN-PROCESSING. DTSCSL9
|
|
01600 EXEC CICS LINK DTSCSL9
|
|
01601 PROGRAM ('DTSCU851') DTSCSL9
|
|
01602 COMMAREA (L851-COMM-AREA) DTSCSL9
|
|
01603 END-EXEC. DTSCSL9
|
|
01604 S851-EXIT. DTSCSL9
|
|
01605 EXIT. DTSCSL9
|
|
01606 DTSCSL9
|
|
01607 S899-ABEND. DTSCSL9
|
|
01608 EXEC CICS ABEND DTSCSL9
|
|
01609 ABCODE(WRK-ABEND-CD) DTSCSL9
|
|
01610 END-EXEC. DTSCSL9
|
|
01611 S899-EXIT. DTSCSL9
|
|
01612 EXIT. DTSCSL9
|
|
01613 /*****************************************************************DTSCSL9
|
|
01614 * EDIT SEARCH KEY FIELDS - EMP-NO, DATA TYPE AND REPORTING DTSCSL9
|
|
01615 * DATE. DTSCSL9
|
|
01616 ******************************************************************DTSCSL9
|
|
01617 S1000-SEARCH-KEY-EDITS. DTSCSL9
|
|
01618 MOVE ZERO TO WRK-SRCH-EMP-NO DTSCSL9
|
|
01619 WRK-SRCH-DATA-TYPE DTSCSL9
|
|
01620 WRK-SRCH-RPT-YY DTSCSL9
|
|
01621 WRK-SRCH-RPT-QTR DTSCSL9
|
|
01622 WRK-SRCH-RPT-MM DTSCSL9
|
|
01623 WRK-SRCH-RPT-DD DTSCSL9
|
|
01624 WRK-SRCH-RPT-DATE. DTSCSL9
|
|
01625 DTSCSL9
|
|
01626 PERFORM S1100-EDIT-EMP-NO THRU S1100-EXIT. DTSCSL9
|
|
01627 PERFORM S1200-EDIT-DATA-TYPE THRU S1200-EXIT. DTSCSL9
|
|
01628 PERFORM S1300-EDIT-RPT-DATE THRU S1300-EXIT. DTSCSL9
|
|
01629 DTSCSL9
|
|
01630 IF (WRK-SRCH-EMP-NO = ZERO) DTSCSL9
|
|
01631 AND (WRK-SRCH-DATA-TYPE = ZERO) DTSCSL9
|
|
01632 AND (WRK-SRCH-RPT-DATE = ZERO) DTSCSL9
|
|
01633 MOVE MSG-EL91-AREA TO WRK-MSG-AREA DTSCSL9
|
|
01634 PERFORM S1001-SRCH-CRITERIA-ERR THRU S1001-EXIT DTSCSL9
|
|
01635 GO TO S1000-EXIT DTSCSL9
|
|
01636 ELSE DTSCSL9
|
|
01637 PERFORM S1010-SET-INIT-KEY THRU S1010-EXIT. DTSCSL9
|
|
01638 DTSCSL9
|
|
01639 S1000-EXIT. EXIT. DTSCSL9
|
|
01640 DTSCSL9
|
|
01641 S1001-SRCH-CRITERIA-ERR. DTSCSL9
|
|
01642 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCSL9
|
|
01643 MAP-SRCH-EMP-NO-2-A. DTSCSL9
|
|
01644 DTSCSL9
|
|
01645 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01646 IF LCCM-NO-MSG DTSCSL9
|
|
01647 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01648 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L. DTSCSL9
|
|
01649 DTSCSL9
|
|
01650 S1001-EXIT. EXIT. DTSCSL9
|
|
01651 DTSCSL9
|
|
01652 S1010-SET-INIT-KEY. DTSCSL9
|
|
01653 IF WRK-SRCH-DATA-TYPE > ZERO DTSCSL9
|
|
01654 MOVE LOW-VALUES TO IEET-KEY-AREA DTSCSL9
|
|
01655 SET IEET-EET-88 TO TRUE DTSCSL9
|
|
01656 MOVE WRK-SRCH-EMP-NO TO IEET-EMP-NO DTSCSL9
|
|
01657 MOVE WRK-SRCH-DATA-TYPE TO IEET-DATA-TYPE-CD DTSCSL9
|
|
01658 IF WRK-SRCH-RPT-DATE = ZERO DTSCSL9
|
|
01659 MOVE ZERO TO IEET-RPT-DATE-XOR DTSCSL9
|
|
01660 ELSE DTSCSL9
|
|
01661 COMPUTE IEET-RPT-DATE-XOR = DTSCSL9
|
|
01662 (99999999 - WRK-SRCH-RPT-DATE) DTSCSL9
|
|
01663 END-IF DTSCSL9
|
|
01664 MOVE IEET-KEY-AREA TO WRK-STARTING-SEARCH-KEY DTSCSL9
|
|
01665 ELSE DTSCSL9
|
|
01666 MOVE LOW-VALUES TO IEER-KEY-AREA DTSCSL9
|
|
01667 SET IEER-EER-88 TO TRUE DTSCSL9
|
|
01668 MOVE WRK-SRCH-EMP-NO TO IEER-EMP-NO DTSCSL9
|
|
01669 MOVE WRK-SRCH-DATA-TYPE TO IEER-DATA-TYPE-CD DTSCSL9
|
|
01670 IF WRK-SRCH-RPT-DATE = ZERO DTSCSL9
|
|
01671 MOVE ZERO TO IEER-RPT-DATE-XOR DTSCSL9
|
|
01672 ELSE DTSCSL9
|
|
01673 COMPUTE IEER-RPT-DATE-XOR = DTSCSL9
|
|
01674 (99999999 - WRK-SRCH-RPT-DATE) DTSCSL9
|
|
01675 END-IF DTSCSL9
|
|
01676 MOVE IEER-KEY-AREA TO WRK-STARTING-SEARCH-KEY DTSCSL9
|
|
01677 END-IF. DTSCSL9
|
|
01678 DTSCSL9
|
|
01679 S1010-EXIT. EXIT. DTSCSL9
|
|
01680 DTSCSL9
|
|
01681 /**************************************************************** DTSCSL9
|
|
01682 * EDIT EMPLOYER ACCOUNT NUMBER DTSCSL9
|
|
01683 ***************************************************************** DTSCSL9
|
|
01684 S1100-EDIT-EMP-NO. DTSCSL9
|
|
01685 DTSCSL9
|
|
01686 MOVE MAP-SRCH-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCSL9
|
|
01687 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCSL9
|
|
01688 IF L018-NO-ENTRY DTSCSL9
|
|
01689 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCSL9
|
|
01690 PERFORM S1101-ERROR THRU S1101-EXIT DTSCSL9
|
|
01691 GO TO S1100-EXIT DTSCSL9
|
|
01692 ELSE DTSCSL9
|
|
01693 IF L018-NOT-VALID DTSCSL9
|
|
01694 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL9
|
|
01695 PERFORM S1101-ERROR THRU S1101-EXIT DTSCSL9
|
|
01696 ELSE DTSCSL9
|
|
01697 MOVE L018-EMP-NO TO WRK-SRCH-EMP-NO DTSCSL9
|
|
01698 PERFORM S1900-READ-PROFILE THRU S1900-EXIT DTSCSL9
|
|
01699 END-IF DTSCSL9
|
|
01700 END-IF. DTSCSL9
|
|
01701 DTSCSL9
|
|
01702 S1100-EXIT. EXIT. DTSCSL9
|
|
01703 DTSCSL9
|
|
01704 S1101-ERROR. DTSCSL9
|
|
01705 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCSL9
|
|
01706 MAP-SRCH-EMP-NO-2-A. DTSCSL9
|
|
01707 DTSCSL9
|
|
01708 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01709 IF LCCM-NO-MSG DTSCSL9
|
|
01710 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01711 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L. DTSCSL9
|
|
01712 DTSCSL9
|
|
01713 S1101-EXIT. EXIT. DTSCSL9
|
|
01714 DTSCSL9
|
|
01715 /**************************************************************** DTSCSL9
|
|
01716 * EDIT DATA TYPE CODE DTSCSL9
|
|
01717 ***************************************************************** DTSCSL9
|
|
01718 S1200-EDIT-DATA-TYPE. DTSCSL9
|
|
01719 DTSCSL9
|
|
01720 IF MAP-SRCH-DATA-TYPE-CD = LOW-VALUE OR SPACES DTSCSL9
|
|
01721 GO TO S1200-EXIT. DTSCSL9
|
|
01722 DTSCSL9
|
|
01723 MOVE MAP-SRCH-DATA-TYPE-CD TO L041-CD-2. DTSCSL9
|
|
01724 SET L041-EPRF-DATA-TYPE-CD TO TRUE. DTSCSL9
|
|
01725 PERFORM S041-ELEC-MEDIA-CODES THRU S041-EXIT. DTSCSL9
|
|
01726 IF L041-VALID DTSCSL9
|
|
01727 MOVE MAP-SRCH-DATA-TYPE-CD TO WRK-SRCH-DATA-TYPE DTSCSL9
|
|
01728 MOVE L041-SHORT-DSCR TO MAP-DATA-TYPE-DSCR DTSCSL9
|
|
01729 ELSE DTSCSL9
|
|
01730 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL9
|
|
01731 PERFORM S1201-ERROR THRU S1201-EXIT DTSCSL9
|
|
01732 END-IF. DTSCSL9
|
|
01733 DTSCSL9
|
|
01734 S1200-EXIT. EXIT. DTSCSL9
|
|
01735 DTSCSL9
|
|
01736 S1201-ERROR. DTSCSL9
|
|
01737 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SRCH-DATA-TYPE-A. DTSCSL9
|
|
01738 DTSCSL9
|
|
01739 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01740 IF LCCM-NO-MSG DTSCSL9
|
|
01741 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01742 MOVE CATB-CURSOR TO MAP-SRCH-DATA-TYPE-L. DTSCSL9
|
|
01743 DTSCSL9
|
|
01744 S1201-EXIT. EXIT. DTSCSL9
|
|
01745 DTSCSL9
|
|
01746 /**************************************************************** DTSCSL9
|
|
01747 * EDIT REPORTING DATE DTSCSL9
|
|
01748 ***************************************************************** DTSCSL9
|
|
01749 S1300-EDIT-RPT-DATE. DTSCSL9
|
|
01750 MOVE ZERO TO WRK-SRCH-RPT-YY DTSCSL9
|
|
01751 WRK-SRCH-RPT-QTR DTSCSL9
|
|
01752 WRK-SRCH-RPT-MM DTSCSL9
|
|
01753 WRK-SRCH-RPT-DD DTSCSL9
|
|
01754 WRK-SRCH-RPT-DATE. DTSCSL9
|
|
01755 DTSCSL9
|
|
01756 IF (MAP-SRCH-RPT-QTR = LOW-VALUE OR SPACES) DTSCSL9
|
|
01757 AND (MAP-SRCH-RPT-YR = LOW-VALUE OR SPACES) DTSCSL9
|
|
01758 AND (MAP-SRCH-RPT-MTH = LOW-VALUE OR SPACES) DTSCSL9
|
|
01759 AND (MAP-SRCH-RPT-DAY = LOW-VALUE OR SPACES) DTSCSL9
|
|
01760 GO TO S1300-EXIT. DTSCSL9
|
|
01761 DTSCSL9
|
|
01762 IF MAP-SRCH-RPT-QTR = LOW-VALUE OR SPACES DTSCSL9
|
|
01763 PERFORM S1310-FULL-DATE THRU S1310-EXIT DTSCSL9
|
|
01764 ELSE DTSCSL9
|
|
01765 PERFORM S1320-QTR THRU S1320-EXIT DTSCSL9
|
|
01766 END-IF. DTSCSL9
|
|
01767 DTSCSL9
|
|
01768 S1300-EXIT. EXIT. DTSCSL9
|
|
01769 DTSCSL9
|
|
01770 S1310-FULL-DATE. DTSCSL9
|
|
01771 IF MAP-SRCH-RPT-YR = LOW-VALUE OR SPACES DTSCSL9
|
|
01772 NEXT SENTENCE DTSCSL9
|
|
01773 ELSE DTSCSL9
|
|
01774 IF MAP-SRCH-RPT-YR NUMERIC DTSCSL9
|
|
01775 MOVE MAP-SRCH-RPT-YR TO WRK-SRCH-RPT-YY DTSCSL9
|
|
01776 END-IF DTSCSL9
|
|
01777 END-IF. DTSCSL9
|
|
01778 DTSCSL9
|
|
01779 IF MAP-SRCH-RPT-MTH = LOW-VALUE OR SPACES DTSCSL9
|
|
01780 NEXT SENTENCE DTSCSL9
|
|
01781 ELSE DTSCSL9
|
|
01782 IF MAP-SRCH-RPT-MTH NUMERIC DTSCSL9
|
|
01783 MOVE MAP-SRCH-RPT-MTH TO WRK-SRCH-RPT-MM DTSCSL9
|
|
01784 END-IF DTSCSL9
|
|
01785 END-IF. DTSCSL9
|
|
01786 DTSCSL9
|
|
01787 IF MAP-SRCH-RPT-DAY = LOW-VALUE OR SPACES DTSCSL9
|
|
01788 NEXT SENTENCE DTSCSL9
|
|
01789 ELSE DTSCSL9
|
|
01790 IF MAP-SRCH-RPT-DAY NUMERIC DTSCSL9
|
|
01791 MOVE MAP-SRCH-RPT-DAY TO WRK-SRCH-RPT-DD DTSCSL9
|
|
01792 END-IF DTSCSL9
|
|
01793 END-IF. DTSCSL9
|
|
01794 DTSCSL9
|
|
01795 MOVE WRK-SRCH-RPT-YY TO L001-FED-6-YR. DTSCSL9
|
|
01796 MOVE WRK-SRCH-RPT-MM TO L001-FED-6-MO. DTSCSL9
|
|
01797 MOVE WRK-SRCH-RPT-DD TO L001-FED-6-DA. DTSCSL9
|
|
01798 PERFORM S001-FROM-FED-6 THRU S001-EXIT. DTSCSL9
|
|
01799 IF L001-VALID-DATE DTSCSL9
|
|
01800 MOVE L001-FED-8-DATE-9 TO WRK-SRCH-RPT-DATE DTSCSL9
|
|
01801 ELSE DTSCSL9
|
|
01802 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL9
|
|
01803 PERFORM S1311-QTR-ERROR THRU S1311-EXIT DTSCSL9
|
|
01804 GO TO S1310-EXIT DTSCSL9
|
|
01805 END-IF. DTSCSL9
|
|
01806 DTSCSL9
|
|
01807 S1310-EXIT. EXIT. DTSCSL9
|
|
01808 DTSCSL9
|
|
01809 S1311-QTR-ERROR. DTSCSL9
|
|
01810 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SRCH-RPT-YR-A DTSCSL9
|
|
01811 MAP-SRCH-RPT-MTH-A DTSCSL9
|
|
01812 MAP-SRCH-RPT-DAY-A. DTSCSL9
|
|
01813 DTSCSL9
|
|
01814 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01815 IF LCCM-NO-MSG DTSCSL9
|
|
01816 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01817 MOVE CATB-CURSOR TO MAP-SRCH-RPT-YR-L. DTSCSL9
|
|
01818 DTSCSL9
|
|
01819 S1311-EXIT. EXIT. DTSCSL9
|
|
01820 DTSCSL9
|
|
01821 S1320-QTR. DTSCSL9
|
|
01822 IF MAP-SRCH-RPT-QTR NUMERIC DTSCSL9
|
|
01823 MOVE MAP-SRCH-RPT-QTR TO WRK-SRCH-RPT-QTR DTSCSL9
|
|
01824 ELSE DTSCSL9
|
|
01825 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL9
|
|
01826 PERFORM S1321-QTR-ERROR THRU S1321-EXIT DTSCSL9
|
|
01827 GO TO S1320-EXIT DTSCSL9
|
|
01828 END-IF. DTSCSL9
|
|
01829 DTSCSL9
|
|
01830 IF MAP-SRCH-RPT-YR = LOW-VALUE OR SPACES DTSCSL9
|
|
01831 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCSL9
|
|
01832 PERFORM S1321-QTR-ERROR THRU S1321-EXIT DTSCSL9
|
|
01833 GO TO S1320-EXIT DTSCSL9
|
|
01834 ELSE DTSCSL9
|
|
01835 IF MAP-SRCH-RPT-YR NUMERIC DTSCSL9
|
|
01836 MOVE MAP-SRCH-RPT-YR TO WRK-SRCH-RPT-YY DTSCSL9
|
|
01837 ELSE DTSCSL9
|
|
01838 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL9
|
|
01839 PERFORM S1321-QTR-ERROR THRU S1321-EXIT DTSCSL9
|
|
01840 GO TO S1320-EXIT DTSCSL9
|
|
01841 END-IF DTSCSL9
|
|
01842 END-IF. DTSCSL9
|
|
01843 DTSCSL9
|
|
01844 MOVE WRK-SRCH-RPT-YY TO L004-QTR-3-YR. DTSCSL9
|
|
01845 MOVE WRK-SRCH-RPT-QTR TO L004-QTR-3-Q. DTSCSL9
|
|
01846 PERFORM S004-FROM-3 THRU S004-EXIT. DTSCSL9
|
|
01847 IF L004-VALID-QTR DTSCSL9
|
|
01848 MOVE L004-QTR-END-DATE TO WRK-SRCH-RPT-DATE DTSCSL9
|
|
01849 ELSE DTSCSL9
|
|
01850 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCSL9
|
|
01851 PERFORM S1321-QTR-ERROR THRU S1321-EXIT DTSCSL9
|
|
01852 GO TO S1320-EXIT DTSCSL9
|
|
01853 END-IF. DTSCSL9
|
|
01854 DTSCSL9
|
|
01855 S1320-EXIT. EXIT. DTSCSL9
|
|
01856 DTSCSL9
|
|
01857 DTSCSL9
|
|
01858 S1321-QTR-ERROR. DTSCSL9
|
|
01859 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SRCH-RPT-QTR-A DTSCSL9
|
|
01860 MAP-SRCH-RPT-YR-A. DTSCSL9
|
|
01861 DTSCSL9
|
|
01862 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01863 IF LCCM-NO-MSG DTSCSL9
|
|
01864 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01865 MOVE CATB-CURSOR TO MAP-SRCH-RPT-YR-L. DTSCSL9
|
|
01866 DTSCSL9
|
|
01867 S1321-EXIT. EXIT. DTSCSL9
|
|
01868 DTSCSL9
|
|
01869 ******************************************************************DTSCSL9
|
|
01870 * SET UP READ OF EPRF RECORD DTSCSL9
|
|
01871 ******************************************************************DTSCSL9
|
|
01872 S1900-READ-PROFILE. DTSCSL9
|
|
01873 IF WRK-EXTERNAL-ELF-88 DTSCSL9
|
|
01874 PERFORM S1910-READ-EPRF THRU S1910-EXIT DTSCSL9
|
|
01875 ELSE DTSCSL9
|
|
01876 PERFORM S1920-READ-MPRF THRU S1920-EXIT DTSCSL9
|
|
01877 END-IF. DTSCSL9
|
|
01878 DTSCSL9
|
|
01879 S1900-EXIT. DTSCSL9
|
|
01880 EXIT. DTSCSL9
|
|
01881 DTSCSL9
|
|
01882 S1901-NO-PROFILE. DTSCSL9
|
|
01883 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCSL9
|
|
01884 MAP-SRCH-EMP-NO-2-A. DTSCSL9
|
|
01885 DTSCSL9
|
|
01886 SET CURSOR-SET-YES TO TRUE. DTSCSL9
|
|
01887 IF LCCM-NO-MSG DTSCSL9
|
|
01888 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL9
|
|
01889 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L. DTSCSL9
|
|
01890 DTSCSL9
|
|
01891 S1901-EXIT. EXIT. DTSCSL9
|
|
01892 DTSCSL9
|
|
01893 S1910-READ-EPRF. DTSCSL9
|
|
01894 MOVE LOW-VALUES TO EPRF-KEY-AREA. DTSCSL9
|
|
01895 MOVE WRK-SRCH-EMP-NO TO EPRF-ELF-ID. DTSCSL9
|
|
01896 MOVE WRK-SRCH-DATA-TYPE TO EPRF-DATA-TYPE-CD. DTSCSL9
|
|
01897 SET EPRF-PRF-88 TO TRUE. DTSCSL9
|
|
01898 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DTSCSL9
|
|
01899 PERFORM S835-READ THRU S835-EXIT. DTSCSL9
|
|
01900 IF L835-NO-REC-88 DTSCSL9
|
|
01901 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCSL9
|
|
01902 PERFORM S1901-NO-PROFILE THRU S1901-EXIT DTSCSL9
|
|
01903 GO TO S1910-EXIT. DTSCSL9
|
|
01904 DTSCSL9
|
|
01905 MOVE ESKL-REC TO EPRF-REC. DTSCSL9
|
|
01906 MOVE EPRF-ELF-NAME TO WRK-ELF-NAME. DTSCSL9
|
|
01907 DTSCSL9
|
|
01908 S1910-EXIT. DTSCSL9
|
|
01909 EXIT. DTSCSL9
|
|
01910 DTSCSL9
|
|
01911 S1920-READ-MPRF. DTSCSL9
|
|
01912 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL9
|
|
01913 MOVE WRK-SRCH-EMP-NO TO MPRF-EMP-NO. DTSCSL9
|
|
01914 SET MPRF-PRF-88 TO TRUE. DTSCSL9
|
|
01915 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL9
|
|
01916 PERFORM S810-READ THRU S810-EXIT. DTSCSL9
|
|
01917 IF L810-NO-REC-88 DTSCSL9
|
|
01918 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCSL9
|
|
01919 PERFORM S1901-NO-PROFILE THRU S1901-EXIT DTSCSL9
|
|
01920 GO TO S1920-EXIT. DTSCSL9
|
|
01921 DTSCSL9
|
|
01922 MOVE MSKL-REC TO MPRF-REC. DTSCSL9
|
|
01923 MOVE MPRF-PRIMARY-NAME TO WRK-ELF-NAME. DTSCSL9
|
|
01924 DTSCSL9
|
|
01925 S1920-EXIT. DTSCSL9
|
|
01926 EXIT. DTSCSL9
|
|
01927 DTSCSL9
|
|
01928 ******************************************************************DTSCSL9
|
|
01929 * SET ATTIBUTE BYTES FOR SCREEN CLEAR REQUEST. THIS UNLOCKS THE *DTSCSL9
|
|
01930 * SEARCH CRITERIA FIELDS WHICH ARE PROTECTED WHEN REQ-INQUIRE DTSCSL9
|
|
01931 * IS TRUE. DTSCSL9
|
|
01932 ******************************************************************DTSCSL9
|
|
01933 S5200-SET-CLEAR-ATTRB. DTSCSL9
|
|
01934 MOVE CATB-UNPROT-NORM-NUM-MDTON TO DTSCSL9
|
|
01935 MAP-SRCH-EMP-NO-1-A DTSCSL9
|
|
01936 MAP-SRCH-EMP-NO-2-A DTSCSL9
|
|
01937 MAP-SRCH-DATA-TYPE-A DTSCSL9
|
|
01938 MAP-SRCH-RPT-YR-A DTSCSL9
|
|
01939 MAP-SRCH-RPT-QTR-A DTSCSL9
|
|
01940 MAP-SRCH-RPT-MTH-A DTSCSL9
|
|
01941 MAP-SRCH-RPT-DAY-A. DTSCSL9
|
|
01942 DTSCSL9
|
|
01943 MOVE CATB-ASKIP-NORM-MDTON TO MAP-EMP-NAME-A DTSCSL9
|
|
01944 MAP-DATA-TYPE-DSCR-A DTSCSL9
|
|
01945 DTSCSL9
|
|
01946 MOVE CATB-ASKIP-BRT-MDTON TO WRK-MAP-LINE-ATB. DTSCSL9
|
|
01947 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL9
|
|
01948 DTSCSL9
|
|
01949 S5200-EXIT. DTSCSL9
|
|
01950 EXIT. DTSCSL9
|
|
01951 DTSCSL9
|
|
01952 ******************************************************************DTSCSL9
|
|
01953 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCSL9
|
|
01954 * WHILE AN INQUIRY IS IN PROGRESS, THE SEARCH CRITERIA FIELDS DTSCSL9
|
|
01955 * ARE PROTECTED. THE USER MUST CLEAR THE SCREEN TO CHANGE THE DTSCSL9
|
|
01956 * SEARCH CRITERIA. DTSCSL9
|
|
01957 ******************************************************************DTSCSL9
|
|
01958 S5300-SET-INQ-ATTRB. DTSCSL9
|
|
01959 DTSCSL9
|
|
01960 MOVE CATB-ASKIP-NORM-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCSL9
|
|
01961 MAP-SRCH-EMP-NO-2-A DTSCSL9
|
|
01962 MAP-SRCH-DATA-TYPE-A DTSCSL9
|
|
01963 MAP-SRCH-RPT-YR-A DTSCSL9
|
|
01964 MAP-SRCH-RPT-QTR-A DTSCSL9
|
|
01965 MAP-SRCH-RPT-MTH-A DTSCSL9
|
|
01966 MAP-SRCH-RPT-DAY-A. DTSCSL9
|
|
01967 DTSCSL9
|
|
01968 MOVE CATB-ASKIP-NORM-MDTON TO MAP-EMP-NAME-A DTSCSL9
|
|
01969 MAP-DATA-TYPE-DSCR-A DTSCSL9
|
|
01970 DTSCSL9
|
|
01971 MOVE CATB-ASKIP-BRT-MDTON TO WRK-MAP-LINE-ATB. DTSCSL9
|
|
01972 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL9
|
|
01973 S5300-EXIT. DTSCSL9
|
|
01974 EXIT. DTSCSL9
|
|
01975 DTSCSL9
|
|
01976 DTSCSL9
|
|
01977 S5900-SET-ATTRB. DTSCSL9
|
|
01978 PERFORM S5910-TABLE THRU S5910-EXIT DTSCSL9
|
|
01979 VARYING WRK-CTR FROM 1 BY 1 DTSCSL9
|
|
01980 UNTIL WRK-CTR > MAX-LINES. DTSCSL9
|
|
01981 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCSL9
|
|
01982 S5900-EXIT. EXIT. DTSCSL9
|
|
01983 DTSCSL9
|
|
01984 S5910-TABLE. DTSCSL9
|
|
01985 MOVE WRK-MAP-LINE-ATB TO MAP-LINE-A(WRK-CTR). DTSCSL9
|
|
01986 S5910-EXIT. EXIT. DTSCSL9
|
|
01987 /*****************************************************************DTSCSL9
|
|
01988 * MAP ROUTINES *DTSCSL9
|
|
01989 ******************************************************************DTSCSL9
|
|
01990 S9100-RECEIVE. DTSCSL9
|
|
01991 SET L851-RECEIVE-88 TO TRUE. DTSCSL9
|
|
01992 DTSCSL9
|
|
01993 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCSL9
|
|
01994 DTSCSL9
|
|
01995 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL9
|
|
01996 DTSCSL9
|
|
01997 MOVE L851-AID TO LCCM-AID. DTSCSL9
|
|
01998 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCSL9
|
|
01999 S9100-EXIT. DTSCSL9
|
|
02000 EXIT. DTSCSL9
|
|
02001 DTSCSL9
|
|
02002 S9200-SEND-DATAONLY. DTSCSL9
|
|
02003 MOVE LOW-VALUES TO MAP-AREA. DTSCSL9
|
|
02004 DTSCSL9
|
|
02005 IF LCCM-NO-MSG DTSCSL9
|
|
02006 NEXT SENTENCE DTSCSL9
|
|
02007 ELSE DTSCSL9
|
|
02008 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL9
|
|
02009 DTSCSL9
|
|
02010 IF CURSOR-SET-GOTO DTSCSL9
|
|
02011 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCSL9
|
|
02012 ELSE DTSCSL9
|
|
02013 IF CURSOR-SET-NO DTSCSL9
|
|
02014 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L. DTSCSL9
|
|
02015 DTSCSL9
|
|
02016 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCSL9
|
|
02017 DTSCSL9
|
|
02018 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL9
|
|
02019 DTSCSL9
|
|
02020 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL9
|
|
02021 S9200-EXIT. DTSCSL9
|
|
02022 EXIT. DTSCSL9
|
|
02023 DTSCSL9
|
|
02024 S9300-SEND-MAP. DTSCSL9
|
|
02025 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCSL9
|
|
02026 MOVE SPACES TO MAP-SYS-TIME. DTSCSL9
|
|
02027 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCSL9
|
|
02028 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCSL9
|
|
02029 DTSCSL9
|
|
02030 IF SCR-ACCESS-UPDATE DTSCSL9
|
|
02031 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCSL9
|
|
02032 ELSE DTSCSL9
|
|
02033 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL9
|
|
02034 DTSCSL9
|
|
02035 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL9
|
|
02036 DTSCSL9
|
|
02037 IF CURSOR-SET-NO DTSCSL9
|
|
02038 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L. DTSCSL9
|
|
02039 DTSCSL9
|
|
02040 SET L851-SEND-88 TO TRUE. DTSCSL9
|
|
02041 DTSCSL9
|
|
02042 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL9
|
|
02043 DTSCSL9
|
|
02044 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL9
|
|
02045 S9300-EXIT. DTSCSL9
|
|
02046 EXIT. DTSCSL9
|
|
02047 DTSCSL9
|
|
02048 S9310-UPDATE-FKEYS. DTSCSL9
|
|
02049 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL9
|
|
02050 DTSCSL9
|
|
02051 S9310-EXIT. DTSCSL9
|
|
02052 EXIT. DTSCSL9
|
|
02053 DTSCSL9
|
|
02054 S9320-INQUIRY-FKEYS. DTSCSL9
|
|
02055 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCSL9
|
|
02056 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCSL9
|
|
02057 S9320-EXIT. DTSCSL9
|
|
02058 EXIT. DTSCSL9
|
|
02059 DTSCSL9
|
|
02060 S9900-PREPARE-SEND. DTSCSL9
|
|
02061 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCSL9
|
|
02062 LCCM-SCR-ID. DTSCSL9
|
|
02063 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCSL9
|
|
02064 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCSL9
|
|
02065 S9900-EXIT. DTSCSL9
|
|
02066 EXIT. DTSCSL9
|