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