00001 IDENTIFICATION DIVISION. 05/22/01 00002 PROGRAM-ID. DTSCSL8. DTSCSL8 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. JANUARY 2001. DTSCSL8 00005 DATE-COMPILED. DTSCSL8 00006 SKIP3 DTSCSL8 00007 ***** DTSCSL8 00008 * DTSCSL8 00009 * FUNCTION: ELECTRONIC MEDIA STATUS DTSCSL8 00010 * SCREEN PROCESSOR. DTSCSL8 00011 * DTSCSL8 00012 * DTSCSL8 00013 * MODIFICATION LOG: DTSCSL8 00014 * DTSCSL8 00015 * 02/15/2001 INITIAL DEVELOPMENT. MODIFIED FROM DTSCSL6. DTSCSL8 00016 * WORK ORDER: PROGRAMMER: GD DTSCSL8 00017 * DTSCSL8 00018 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSL8 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCSL8 00020 * WORK ORDER: PROGRAMMER: XXX DTSCSL8 00021 * DTSCSL8 00022 * DTSCSL8 00023 * DESCRIPTION: DTSCSL8 00024 * DTSCSL8 00025 * DTSCSL8 00026 * CLEAR: DTSCSL8 00027 * DTSCSL8 00028 * FIELD DISPLAYED :NONE. UPROTECT MAP-ELF-ID, DTSCSL8 00029 * MAP-DATA-TYPE-CD, MAP-LOG-NO. DTSCSL8 00030 * DTSCSL8 00031 * DTSCSL8 00032 * INQUIRY: DTSCSL8 00033 * DTSCSL8 00034 * CONTROL FIELD(S): MAP-ELF-ID AND (OPTIONALLY) DTSCSL8 00035 * MAP-DATA-TYPE-CD DTSCSL8 00036 * OR DTSCSL8 00037 * MAP-LOG-NO DTSCSL8 00038 * (MUTUALLY EXCLUSIVE). DTSCSL8 00039 * DTSCSL8 00040 * JUMP IN: IF LCCM-SCRL8-HOLD-AREA NOT = LOW-VALUES DTSCSL8 00041 * START A SEARCH AT THE AIX INDEX RECORD WHOSE DTSCSL8 00042 * KEY IS IN LCCM-SCRL8-HOLD-AREA DTSCSL8 00043 * ELSE DTSCSL8 00044 * CLEAR. DTSCSL8 00045 * DTSCSL8 00046 * ENTER: REDISPLAY SAME STUFF. DTSCSL8 00047 * DTSCSL8 00048 * F07, F08: DO NOT BOTHER TO 'WRAP' PAGING. SEE SCREEN DTSCSL8 00049 * DESCRIPTION FOR 'BREAK' POINTS. DTSCSL8 00050 * DTSCSL8 00051 * ?JUMP OUT: IF A LINE NO IS BEING SELECTED: DTSCSL8 00052 * STORE AIX RECORD REPRESENTING LINE NO DTSCSL8 00053 * SELECTED IN LCCM-SCRL8-HOLD-AREA DTSCSL8 00054 * IF JUMP TO SCREEN 'L5' REQUESTED DTSCSL8 00055 * CONSTRUCT LCCM-SCRL5-HOLD-AREA DTSCSL8 00056 * ELSE DTSCSL8 00057 * IF JUMP TO SCREEN 'L8' REQUESTED DTSCSL8 00058 * CONSTRUCT LCCM-SCRL8-HOLD-AREA. DTSCSL8 00059 * DTSCSL8 00060 * DTSCSL8 00061 * PROTECT THE 'CONTROL' FIELDS DURING A SEARCH - DTSCSL8 00062 * LEAVING THE USER SPECIFIED SEARCH CRITERIA DISPLAYED. DTSCSL8 00063 * THE USER MUST PRESS THE CLEAR KEY BEFORE RESTARTING DTSCSL8 00064 * A SEARCH. DTSCSL8 00065 * DTSCSL8 00066 * FOR EACH LOG RECORD DISPLAYS, READ THE RELATED DTSCSL8 00067 * EMSG RECORDS, AND DISPLAY UP TO 15 ON THE SCREEN. USE DTSCSL8 00068 * LCCM-SCR-HOLD-AREA TO HOLD THE FROM 1 TO 15 AIX DTSCSL8 00069 * RECORDS FROM WHICH THE 1 TO 15 LINES OF THE DISPLAY DTSCSL8 00070 * WERE CONSTRUCTED. DTSCSL8 00071 * DTSCSL8 00072 * DURING A DISPLAY OF THE RESULTS OF THE SEARCH, USE DTSCSL8 00073 * THE INFORMATION STORED IN LCCM-SCR-HOLD-AREA TO DTSCSL8 00074 * CONTROL PAGING. DTSCSL8 00075 * DTSCSL8 00076 * DTSCSL8 00077 * UPDATE: DTSCSL8 00078 * DTSCSL8 00079 * ELOG. DTSCSL8 00080 * EMSG. DTSCSL8 00081 * DTSCSL8 00082 * DTSCSL8 00083 * RECORDS READ: DTSCSL8 00084 * DTSCSL8 00085 * ELF: DTSCSL8 00086 * DTSCSL8 00087 * EPRF DTSCSL8 00088 * ELOG DTSCSL8 00089 * EMSG DTSCSL8 00090 * DTSCSL8 00091 * ALTERNATE INDEX: DTSCSL8 00092 * DTSCSL8 00093 * IESR DTSCSL8 00094 * DTSCSL8 00095 * REFERENCE: DTSCSL8 00096 * DTSCSL8 00097 * NONE. DTSCSL8 00098 * DTSCSL8 00099 * DTSCSL8 00100 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL8 00101 * DTSCSL8 00102 * NONE. DTSCSL8 00103 * DTSCSL8 00104 * DTSCSL8 00105 * RECORDS UPDATED: DTSCSL8 00106 * DTSCSL8 00107 * ELF: DTSCSL8 00108 * DTSCSL8 00109 * ELOG. DTSCSL8 00110 * EMSG DTSCSL8 00111 * DTSCSL8 00112 * DTSCSL8 00113 * REFERENCE: DTSCSL8 00114 * DTSCSL8 00115 * NONE. DTSCSL8 00116 * DTSCSL8 00117 * DTSCSL8 00118 * ACCOUNTING TRANSACTION COLLECTION: DTSCSL8 00119 * DTSCSL8 00120 * NONE. DTSCSL8 00121 * DTSCSL8 00122 * DTSCSL8 00123 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCSL8 00124 * DTSCSL8 00125 * NONE. DTSCSL8 00126 * DTSCSL8 00127 * DTSCSL8 00128 * TEMPORARY STORAGE USAGE: DTSCSL8 00129 * DTSCSL8 00130 * NONE. DTSCSL8 00131 * DTSCSL8 00132 * DTSCSL8 00133 * MODULES LINKED TO: DTSCSL8 00134 * DTSCSL8 00135 * DTSCU001 DATE EDIT/CONVERSION. DTSCSL8 00136 * DTSCU013 COUNT (INTEGER) FROM SCREEN FORMAT/EDIT. DTSCSL8 00137 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCSL8 00138 * DTSCU018 ELF-ID FROM SCREEN FORMAT/EDIT. DTSCSL8 00139 * DTSCU041 ELECTRONIC MEDIA CODES EDIT/DISPLAY. DTSCSL8 00140 * DTSCU835 ELECTRONIC MEDIA FILE INPUT/OUTPUT. DTSCSL8 00141 * DTSCU821 ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCSL8 00142 * DTSCSL8 00143 ***** DTSCSL8 00144 DTSCSL8 00145 ENVIRONMENT DIVISION. DTSCSL8 00146 DTSCSL8 00147 DATA DIVISION. DTSCSL8 00148 DTSCSL8 00149 WORKING-STORAGE SECTION. DTSCSL8 001495 77 PAN-VALET PICTURE X(24) VALUE '001DTSCSL8 05/22/01'. DTSCSL8 00150 DTSCSL8 00151 ************************************************************ DTSCSL8 00152 * THE TABLE BELOW CONTAINS DATA FROM THE LCCM-SCR-HOLD-AREA DTSCSL8 00153 ************************************************************ DTSCSL8 00154 01 WRK-SCR-HOLD-AREA. DTSCSL8 00155 05 WRK-SCR-HOLD-PROG-NAME PIC X(07). DTSCSL8 00156 05 WRK-SCR-HOLD-ORIG-ELF PIC 9(06). DTSCSL8 00157 05 WRK-SCR-HOLD-ORIG-TYPE PIC X(02). DTSCSL8 00158 05 WRK-SCR-HOLD-LOG-NO PIC 9(10). DTSCSL8 00159 05 WRK-SCR-HOLD-NEW-ELF PIC 9(06). DTSCSL8 00160 05 WRK-SCR-HOLD-NEW-TYPE PIC X(02). DTSCSL8 00161 05 WRK-SCR-HOLD-IESR PIC X(64). DTSCSL8 00162 05 WRK-SCR-HOLD-MSG-KEY-CTR PIC S9(04) COMP. DTSCSL8 00163 05 WRK-SCR-HOLD-MSG-KEY-AREA PIC X(360). DTSCSL8 00164 05 FILLER REDEFINES WRK-SCR-HOLD-MSG-KEY-AREA. DTSCSL8 00165 10 WRK-SCR-HOLD-MSG-KEY DTSCSL8 00166 OCCURS 15 TIMES PIC X(24). DTSCSL8 00167 DTSCSL8 00168 ************************************************************ DTSCSL8 00169 * THE PROGRAM STORES AIX KEYS AND FORMARTED MAP LINES IN THE DTSCSL8 00170 * TABLE BELOW DURING PAGE BACK OPERATIONS. BUILDING A TABLE DTSCSL8 00171 * BY READING BACKWARDS ORDERS THE LINES IN REVERSE ORDER DTSCSL8 00172 * (HIGHEST KEY TO LOWEST). TO BUILD THE SCREEN HOLD AREA DTSCSL8 00173 * AND THE MAP, THE PROGRAM READS THE TABLE ENTRIES IN DTSCSL8 00174 * REVERSE ORDER. DTSCSL8 00175 ************************************************************ DTSCSL8 00176 01 WRK-PAGE-BACK-AREA. DTSCSL8 00177 05 WRK-PAGE-BACK-CTR PIC S9(04) COMP. DTSCSL8 00178 05 WRK-PAGE-BACK-DATA-AREA PIC X(1545). DTSCSL8 00179 05 FILLER REDEFINES WRK-PAGE-BACK-DATA-AREA. DTSCSL8 00180 10 WRK-PAGE-BACK-ENTRY OCCURS 15 TIMES. DTSCSL8 00181 15 WRK-PAGE-BACK-KEY PIC X(24). DTSCSL8 00182 15 WRK-PAGE-BACK-MSG-TYPE PIC X(07). DTSCSL8 00183 15 WRK-PAGE-BACK-MESSAGE PIC X(60). DTSCSL8 00184 15 WRK-PAGE-BACK-MSG-OPID PIC X(08). DTSCSL8 00185 DTSCSL8 00186 01 WRK-AREA. DTSCSL8 00187 05 WRK-ABEND-CD PIC X(04) VALUE 'SL8 '. DTSCSL8 00188 DTSCSL8 00189 05 WRK-MOD-NAME PIC X(07) VALUE 'DTSCSL8'. DTSCSL8 00190 DTSCSL8 00191 05 WRK-FATAL-ERROR-IND PIC X(01). DTSCSL8 00192 88 WRK-FATAL-ERROR-YES VALUE 'Y'. DTSCSL8 00193 88 WRK-FATAL-ERROR-NO VALUE 'N'. DTSCSL8 00194 DTSCSL8 00195 05 WRK-SCR-ID PIC X(02) VALUE 'L8'. DTSCSL8 00196 DTSCSL8 00197 05 WRK-F03-SCR-ID PIC X(02) VALUE 'L0'. DTSCSL8 00198 05 SCR-ACCESS-IND PIC X(01). DTSCSL8 00199 88 SCR-ACCESS-INQ VALUE '1'. DTSCSL8 00200 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCSL8 00201 DTSCSL8 00202 05 CURSOR-SET-IND PIC X(01). DTSCSL8 00203 88 CURSOR-SET-YES VALUE 'Y'. DTSCSL8 00204 88 CURSOR-SET-NO VALUE 'N'. DTSCSL8 00205 88 CURSOR-SET-GOTO VALUE 'G'. DTSCSL8 00206 DTSCSL8 00207 05 REQ-IND PIC X(01). DTSCSL8 00208 88 REQ-ERROR VALUE 'O'. DTSCSL8 00209 88 REQ-JUMP VALUE 'J'. DTSCSL8 00210 88 REQ-INQUIRE VALUE 'I'. DTSCSL8 00211 88 REQ-NEW-MSG VALUE 'M'. DTSCSL8 00212 88 REQ-CLEAR VALUE 'C'. DTSCSL8 00213 88 REQ-EDIT VALUE 'E'. DTSCSL8 00214 88 REQ-UPDATE VALUE 'U'. DTSCSL8 00215 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCSL8 00216 DTSCSL8 00217 05 RESP-IND PIC X(01). DTSCSL8 00218 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCSL8 00219 88 RESP-SEND-MAP VALUE 'M'. DTSCSL8 00220 88 RESP-JUMP VALUE 'J'. DTSCSL8 00221 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCSL8 00222 DTSCSL8 00223 05 WRK-MSG-AREA PIC X(64). DTSCSL8 00224 DTSCSL8 00225 05 WRK-ATB-AN PIC X(01). DTSCSL8 00226 05 WRK-ATB-NUM PIC X(01). DTSCSL8 00227 05 WRK-MAP-LINE-ATB PIC X(01). DTSCSL8 00228 DTSCSL8 00229 ************************************************************** DTSCSL8 00230 * MAXIMUM NUMBER OF LINES THAT MAY BE DISPLAYED ON ONE PAGE. DTSCSL8 00231 ************************************************************** DTSCSL8 00232 05 MAX-LINES PIC S9(04) COMP VALUE +15. DTSCSL8 00233 DTSCSL8 00234 ************************************************************** DTSCSL8 00235 * THE DATA ELEMENT BELOW INDICATES WHETHER A LOG RECORD KEY DTSCSL8 00236 * HAS BEEN FOUND, EITHER FROM DATA ENTERED IN THE SEARCH DTSCSL8 00237 * FIELDS OR FROM A PREVIOUS TASK. DTSCSL8 00238 * DTSCSL8 00239 * WRK-KEY-FOUND-ELOG MEANS THAT THE USER HAS ENTERED A LOG DTSCSL8 00240 * NUMBER IN THE LOG NUMBER SEARCH FIELD, OR THAT THE PROGRAM DTSCSL8 00241 * FOUND A VALID LOG NUMBER FROM A PREVIOUS SEARCH. DTSCSL8 00242 * DTSCSL8 00243 * IN THIS CASE, THE F7 AND F8 PAGING KEYS ARE DISABLED, THOUGH DTSCSL8 00244 * THE F5 AND F6 MESSAGE PAGING KEYS REMAIN AVAILABLE. DTSCSL8 00245 * DTSCSL8 00246 * WRK-KEY-FOUND-IESR MEANS THAT THE USER HAS ENTERED AN ELF-ID DTSCSL8 00247 * IN THE ELF-ID SEARCH FIELD, OR THAT THE PROGRAM HAS FOUND A DTSCSL8 00248 * VALID IESR RECORD FROM A PREVIOUS SEARCH. DTSCSL8 00249 * DTSCSL8 00250 * IN THIS CASE, ALL PAGING KEYS ARE ENABLED. DTSCSL8 00251 * DTSCSL8 00252 * WRK-JUMP-IN-KEY-FND INDICATES THAT THE LCCM-SCRL8-HOLD-AREA DTSCSL8 00253 * CONTAINS A KEY. THIS MEANS THE USER DTSCSL8 00254 * HAS SELECTED A LINE FROM SCREEN L7, AND JUMPED TO SCREEN L8 DTSCSL8 00255 * FOR A DETAILED VIEW OF THE RECORD. DTSCSL8 00256 * DTSCSL8 00257 * *** NOTE: AN IESR KEY HAS A HIGHER PRIORITY THAN *** DTSCSL8 00258 * *** AN ELOG KEY. WHICHEVER TYPE OF KEY THE *** DTSCSL8 00259 * *** PROGRAM STARTS WITH IT WILL ALWAYS *** DTSCSL8 00260 * *** READ THE ELOG AND EPRF RECORDS. IF A *** DTSCSL8 00261 * *** SEARCH BEGINS WITH AN IESR KEY, HOWEVER,*** DTSCSL8 00262 * *** THE PF7 AND PF8 KEYS ARE ENABLED. *** DTSCSL8 00263 * DTSCSL8 00264 *************************************************************** DTSCSL8 00265 05 WRK-KEY-FOUND-IND PIC X(01). DTSCSL8 00266 88 WRK-KEY-FOUND-NO VALUE '0'. DTSCSL8 00267 88 WRK-KEY-FOUND-ELOG VALUE '1'. DTSCSL8 00268 88 WRK-KEY-FOUND-IESR VALUE '2'. DTSCSL8 00269 88 WRK-KEY-FOUND-YES VALUE '1' '2'. DTSCSL8 00270 DTSCSL8 00271 05 WRK-NUM-SRCH-FLDS-ENTERED PIC S9(04) COMP. DTSCSL8 00272 DTSCSL8 00273 05 WRK-CTR PIC S9(04) COMP. DTSCSL8 00274 DTSCSL8 00275 05 WRK-SUB PIC S9(04) COMP. DTSCSL8 00276 05 WRK-SUB-DISP PIC Z9. DTSCSL8 00277 DTSCSL8 00278 05 WRK-SUB2 PIC S9(04) COMP. DTSCSL8 00279 DTSCSL8 00280 05 WRK-SCREEN-DATA. DTSCSL8 00281 10 WRK-SCR-MSG-TYPE PIC X(07). DTSCSL8 00282 10 WRK-SCR-MESSAGE PIC X(60). DTSCSL8 00283 10 WRK-SCR-OPID PIC X(08). DTSCSL8 00284 DTSCSL8 00285 ************************************************************ DTSCSL8 00286 * THE TWO FOLLOWING FIELDS CONTAIN THE STARTING AND ENDING DTSCSL8 00287 * EMSG KEYS FOR THE CURRENT MESSAGE DISPLAY. DTSCSL8 00288 * THEY ARE USED TO SET THE STARTING DTSCSL8 00289 * POINT WHEN PAGING FORWARD OR BACKWARD. DTSCSL8 00290 ************************************************************ DTSCSL8 00291 05 WRK-STARTING-MSG-KEY PIC X(24). DTSCSL8 00292 05 WRK-ENDING-MSG-KEY PIC X(24). DTSCSL8 00293 DTSCSL8 00294 DTSCSL8 00295 05 WRK-EMSG-FOUND-IND PIC X(01). DTSCSL8 00296 88 WRK-EMSG-FOUND-YES VALUE 'Y'. DTSCSL8 00297 88 WRK-EMSG-FOUND-NO VALUE 'N'. DTSCSL8 00298 ************************************************************ DTSCSL8 00299 * WRK-ELOG-KEY CONTAINS THE KEY OF THE CURRENT ELOG RECORD DTSCSL8 00300 * IF THE USER HAS CALLED UP THIS SCREEN WITH A LOG NUMBER. DTSCSL8 00301 * WRK-IESR-KEY CONTAINS THE KEY OF THE CURRENT IESR AIX REC DTSCSL8 00302 * IF THE USER HAS CALLED UP THIS SCREEN WITH AN ELF-ID. DTSCSL8 00303 ************************************************************ DTSCSL8 00304 05 WRK-ELOG-KEY PIC 9(10). DTSCSL8 00305 05 WRK-IESR-KEY PIC X(64). DTSCSL8 00306 DTSCSL8 00307 ************************************************************ DTSCSL8 00308 * WRK-ORIG-ELF CONTAINS THE ELF-ID ORIGINALLY ENTERED. DTSCSL8 00309 * WRK-ORIG-TYPE CONTAINS THE DATA TYPE ORIGINALLY ENTERED. DTSCSL8 00310 * THESE FIELDS ARE USED TO CONTROL PAGING. IF THE USER DTSCSL8 00311 * DID NOT ENTER A DATA TYPE, THEN PAGING OPERATIONS WILL DTSCSL8 00312 * RETURN THE NEXT RECORD WITH A MATCHING ELF-ID. OTHERWISE DTSCSL8 00313 * THEY WILL REQUIRE A MATCH ON BOTH ELF-ID AND DATA TYPE. DTSCSL8 00314 ************************************************************ DTSCSL8 00315 05 WRK-ORIG-ELF PIC 9(06). DTSCSL8 00316 05 WRK-ORIG-TYPE PIC X(02). DTSCSL8 00317 DTSCSL8 00318 05 WRK-ELF-ID PIC S9(07) COMP-3. DTSCSL8 00319 88 WRK-ELF-ID-EXTERNAL-88 VALUE 3000 THRU 3999. DTSCSL8 00320 DTSCSL8 00321 05 WRK-ELF-ID-DISP PIC 9(07). DTSCSL8 00322 05 FILLER REDEFINES WRK-ELF-ID-DISP. DTSCSL8 00323 10 FILLER PIC X. DTSCSL8 00324 10 WRK-ELF-ID-DISP-1 PIC 9(03). DTSCSL8 00325 10 WRK-ELF-ID-DISP-2 PIC 9(03). DTSCSL8 00326 DTSCSL8 00327 05 WRK-DATA-TYPE-CD PIC X(02). DTSCSL8 00328 DTSCSL8 00329 05 WRK-LOG-NO PIC 9(10). DTSCSL8 00330 05 FILLER REDEFINES WRK-LOG-NO. DTSCSL8 00331 10 WRK-LOG-NO-YEAR PIC 9(04). DTSCSL8 00332 10 WRK-LOG-NO-SFX PIC 9(06). DTSCSL8 00333 05 WRK-LOG-NO-X REDEFINES WRK-LOG-NO DTSCSL8 00334 PIC X(10). DTSCSL8 00335 DTSCSL8 00336 05 WRK-IESR-FOUND-IND PIC X(01). DTSCSL8 00337 88 WRK-IESR-FOUND-NO VALUE '0'. DTSCSL8 00338 88 WRK-IESR-FOUND-YES VALUE '1'. DTSCSL8 00339 88 WRK-IESR-NO-REC VALUE '2'. DTSCSL8 00340 DTSCSL8 00341 05 WRK-BOX-NO PIC X(08). DTSCSL8 00342 DTSCSL8 00343 05 WRK-ORIG-VOL PIC X(06). DTSCSL8 00344 DTSCSL8 00345 05 WRK-RCVD-DATE PIC S9(09) COMP-3. DTSCSL8 00346 DTSCSL8 00347 05 WRK-CMPL-DATE PIC S9(09) COMP-3. DTSCSL8 00348 DTSCSL8 00349 05 WRK-DATE-DISP PIC 9(08). DTSCSL8 00350 05 FILLER REDEFINES WRK-DATE-DISP. DTSCSL8 00351 10 WRK-DATE-CC PIC 9(02). DTSCSL8 00352 10 WRK-DATE-YY PIC 9(02). DTSCSL8 00353 10 WRK-DATE-MM PIC 9(02). DTSCSL8 00354 10 WRK-DATE-DD PIC 9(02). DTSCSL8 00355 DTSCSL8 00356 05 WRK-EMSG-SEQ PIC 9(04) COMP-3. DTSCSL8 00357 DTSCSL8 00358 05 HOLD-ISKL-KEY-AREA PIC X(64). DTSCSL8 00359 DTSCSL8 00360 01 FKEY-LITERALS. DTSCSL8 00361 05 FKEY-MSG-BACK PIC X(11) DTSCSL8 00362 VALUE 'F5=MSG BACK'. DTSCSL8 00363 05 FKEY-MSG-FWRD PIC X(11) DTSCSL8 00364 VALUE 'F6=MSG FWRD'. DTSCSL8 00365 05 FKEY-NEW-MSG PIC X(11) DTSCSL8 00366 VALUE 'F9=NEW MSG '. DTSCSL8 00367 05 FKEY-SAVE-MSG PIC X(11) DTSCSL8 00368 VALUE 'F9=SAVE MSG'. DTSCSL8 00369 DTSCSL8 00370 01 MSG-LITERALS. DTSCSL8 00371 05 MSG-EL81-AREA. DTSCSL8 00372 10 FILLER PIC X(04) VALUE 'EL81'. DTSCSL8 00373 10 FILLER PIC X(30) DTSCSL8 00374 VALUE 'ENTER 1 SEARCH FIELD. '. DTSCSL8 00375 10 FILLER PIC X(30) DTSCSL8 00376 VALUE ' '. DTSCSL8 00377 DTSCSL8 00378 05 MSG-EL82-AREA. DTSCSL8 00379 10 FILLER PIC X(04) VALUE 'EL82'. DTSCSL8 00380 10 FILLER PIC X(30) DTSCSL8 00381 VALUE 'ENTRY OF ONLY 1 SEARCH FIELD A'. DTSCSL8 00382 10 FILLER PIC X(30) DTSCSL8 00383 VALUE 'LLOWED '. DTSCSL8 00384 DTSCSL8 00385 05 MSG-EL83-AREA. DTSCSL8 00386 10 FILLER PIC X(04) VALUE 'EL83'. DTSCSL8 00387 10 MSG-ELF-ID-IN-ERR PIC 999B999. DTSCSL8 00388 10 FILLER PIC X(50) VALUE DTSCSL8 00389 ' ALTERNATE INDEX FILE ERROR - CONTACT DP'. DTSCSL8 00390 DTSCSL8 00391 05 MSG-EL84-AREA. DTSCSL8 00392 10 FILLER PIC X(04) VALUE 'EL84'. DTSCSL8 00393 10 FILLER PIC X(30) DTSCSL8 00394 VALUE 'INQUIRY MUST PRECEDE UPDATE '. DTSCSL8 00395 10 FILLER PIC X(30) DTSCSL8 00396 VALUE ' '. DTSCSL8 00397 DTSCSL8 00398 05 MSG-EL85-AREA. DTSCSL8 00399 10 FILLER PIC X(04) VALUE 'EL85'. DTSCSL8 00400 10 FILLER PIC X(30) DTSCSL8 00401 VALUE 'PAGING NOT ALLOWED FOR LOG NO '. DTSCSL8 00402 10 FILLER PIC X(30) DTSCSL8 00403 VALUE 'SEARCH '. DTSCSL8 00404 DTSCSL8 00405 05 MSG-SUCCESSFUL-ADD-TEXT. DTSCSL8 00406 10 FILLER PIC X(42) DTSCSL8 00407 VALUE 'ELECTRONIC MEDIA SUCCESSFULLY LOGGED IN ('. DTSCSL8 00408 10 MSG-LOG-NO PIC X(10). DTSCSL8 00409 10 FILLER PIC X(01) VALUE ')'. DTSCSL8 00410 EJECT DTSCSL8 00411 01 C201-MESSAGE-AREA. DTSCSL8 00412 ++INCLUDE DTSIC201 DTSCSL8 00413 EJECT DTSCSL8 00414 01 L001-COMM-AREA. DTSCSL8 00415 ++INCLUDE DTSIL001 DTSCSL8 00416 EJECT DTSCSL8 00417 01 L005-COMM-AREA. DTSCSL8 00418 ++INCLUDE DTSIL005 DTSCSL8 00419 EJECT DTSCSL8 00420 01 L013-COMM-AREA. DTSCSL8 00421 ++INCLUDE DTSIL013 DTSCSL8 00422 EJECT DTSCSL8 00423 01 L015-COMM-AREA. DTSCSL8 00424 ++INCLUDE DTSIL015 DTSCSL8 00425 EJECT DTSCSL8 00426 01 L018-COMM-AREA. DTSCSL8 00427 ++INCLUDE DTSIL018 DTSCSL8 00428 EJECT DTSCSL8 00429 01 L041-COMM-AREA. DTSCSL8 00430 ++INCLUDE DTSIL041 DTSCSL8 00431 EJECT DTSCSL8 00432 01 L222-COMM-AREA. DTSCSL8 00433 ++INCLUDE DTSIL222 DTSCSL8 00434 EJECT DTSCSL8 00435 01 L357-COMM-AREA. DTSCSL8 00436 ++INCLUDE DTSIL357 DTSCSL8 00437 EJECT DTSCSL8 00438 01 L805-COMM-AREA. DTSCSL8 00439 ++INCLUDE DTSIL805 DTSCSL8 00440 EJECT DTSCSL8 00441 01 L810-COMM-AREA. DTSCSL8 00442 05 L810-CONTROL-BLOCK. DTSCSL8 00443 ++INCLUDE DTSIL810 DTSCSL8 00444 EJECT DTSCSL8 00445 05 MSKL-REC. DTSCSL8 00446 ++INCLUDE DTSIMSKL DTSCSL8 00447 EJECT DTSCSL8 00448 01 MPRF-REC. DTSCSL8 00449 ++INCLUDE DTSIMPRF DTSCSL8 00450 EJECT DTSCSL8 00451 01 L835-COMM-AREA. DTSCSL8 00452 05 L835-CONTROL-BLOCK. DTSCSL8 00453 ++INCLUDE DTSIL835 DTSCSL8 00454 EJECT DTSCSL8 00455 05 ESKL-REC. DTSCSL8 00456 ++INCLUDE DTSIESKL DTSCSL8 00457 EJECT DTSCSL8 00458 01 EPRF-REC. DTSCSL8 00459 ++INCLUDE DTSIEPRF DTSCSL8 00460 EJECT DTSCSL8 00461 01 ELOG-REC. DTSCSL8 00462 ++INCLUDE DTSIELOG DTSCSL8 00463 EJECT DTSCSL8 00464 01 EMSG-REC. DTSCSL8 00465 ++INCLUDE DTSIEMSG DTSCSL8 00466 EJECT DTSCSL8 00467 01 L821-COMM-AREA. DTSCSL8 00468 05 L821-CONTROL-BLOCK. DTSCSL8 00469 ++INCLUDE DTSIL821 DTSCSL8 00470 DTSCSL8 00471 05 ISKL-REC. DTSCSL8 00472 ++INCLUDE DTSIISKL DTSCSL8 00473 DTSCSL8 00474 01 IESR-REC. DTSCSL8 00475 ++INCLUDE DTSIIESR DTSCSL8 00476 DTSCSL8 00477 01 IEAL-REC. DTSCSL8 00478 ++INCLUDE DTSIIEAL DTSCSL8 00479 EJECT DTSCSL8 00480 DTSCSL8 00481 01 L851-COMM-AREA. DTSCSL8 00482 ++INCLUDE DTSIL851 DTSCSL8 00483 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCSL8 00484 ++INCLUDE DTSISL8 DTSCSL8 00485 EJECT DTSCSL8 00486 01 CATB-LITERALS. DTSCSL8 00487 ++INCLUDE DTSICATB DTSCSL8 00488 DTSCSL8 00489 01 CFKD-LITERALS. DTSCSL8 00490 ++INCLUDE DTSICFKD DTSCSL8 00491 DTSCSL8 00492 01 CECD-LITERALS. DTSCSL8 00493 ++INCLUDE DTSICECD DTSCSL8 00494 DTSCSL8 00495 01 CPCD-LITERALS. DTSCSL8 00496 ++INCLUDE DTSICPCD DTSCSL8 00497 EJECT DTSCSL8 00498 LINKAGE SECTION. DTSCSL8 00499 DTSCSL8 00500 01 DFHCOMMAREA. DTSCSL8 00501 ++INCLUDE DTSILCCM DTSCSL8 00502 DTSCSL8 00503 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCSL8 00504 20 LCCM-SCR-HOLD-PROG-NAME PIC X(07). DTSCSL8 00505 20 LCCM-SCR-HOLD-ORIG-ELF PIC 9(06). DTSCSL8 00506 20 LCCM-SCR-HOLD-ORIG-TYPE PIC X(02). DTSCSL8 00507 20 LCCM-SCR-HOLD-LOG-NO PIC 9(10). DTSCSL8 00508 20 LCCM-SCR-HOLD-NEW-ELF PIC 9(06). DTSCSL8 00509 20 LCCM-SCR-HOLD-NEW-TYPE PIC X(02). DTSCSL8 00510 20 LCCM-SCR-HOLD-IESR PIC X(64). DTSCSL8 00511 20 LCCM-SCR-HOLD-MSG-KEY-CTR PIC S9(04) COMP. DTSCSL8 00512 20 LCCM-SCR-HOLD-MSG-KEY-AREA PIC X(360). DTSCSL8 00513 20 FILLER REDEFINES LCCM-SCR-HOLD-MSG-KEY-AREA. DTSCSL8 00514 25 LCCM-SCR-HOLD-MSG-KEY OCCURS 15 TIMES DTSCSL8 00515 PIC X(24). DTSCSL8 00516 EJECT DTSCSL8 00517 ******************************************************************DTSCSL8 00518 * *DTSCSL8 00519 ******************************************************************DTSCSL8 00520 DTSCSL8 00521 PROCEDURE DIVISION. DTSCSL8 00522 DTSCSL8 00523 SET WRK-FATAL-ERROR-NO TO TRUE. DTSCSL8 00524 SET WRK-KEY-FOUND-NO TO TRUE. DTSCSL8 00525 DTSCSL8 00526 MOVE +0 TO WRK-RCVD-DATE. DTSCSL8 00527 DTSCSL8 00528 MOVE SPACES TO WRK-BOX-NO. DTSCSL8 00529 DTSCSL8 00530 MOVE +0 TO WRK-CTR DTSCSL8 00531 WRK-SUB DTSCSL8 00532 WRK-SUB2. DTSCSL8 00533 DTSCSL8 00534 MOVE ZERO TO WRK-ELOG-KEY DTSCSL8 00535 WRK-ELF-ID DTSCSL8 00536 WRK-DATA-TYPE-CD DTSCSL8 00537 WRK-EMSG-SEQ DTSCSL8 00538 WRK-ORIG-ELF DTSCSL8 00539 WRK-ORIG-TYPE. DTSCSL8 00540 DTSCSL8 00541 MOVE LOW-VALUES TO WRK-IESR-KEY DTSCSL8 00542 WRK-STARTING-MSG-KEY DTSCSL8 00543 WRK-ENDING-MSG-KEY. DTSCSL8 00544 DTSCSL8 00545 MOVE LOW-VALUES TO MAP-AREA. DTSCSL8 00546 DTSCSL8 00547 SET CURSOR-SET-NO TO TRUE. DTSCSL8 00548 DTSCSL8 00549 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCSL8 00550 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCSL8 00551 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCSL8 00552 DTSCSL8 00553 MOVE SPACE TO REQ-IND. DTSCSL8 00554 DTSCSL8 00555 MOVE SPACES TO LCCM-REQ-SCR-ID. DTSCSL8 00556 DTSCSL8 00557 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCSL8 00558 DTSCSL8 00559 *----------------------------------------------------- DTSCSL8 00560 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCSL8 00561 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCSL8 00562 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCSL8 00563 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCSL8 00564 * DTSCSL8 00565 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCSL8 00566 * PROCESSED. DTSCSL8 00567 * DTSCSL8 00568 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCSL8 00569 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCSL8 00570 * WORK STATION OPERATOR. DTSCSL8 00571 *----------------------------------------------------- DTSCSL8 00572 DTSCSL8 00573 MOVE SPACE TO RESP-IND. DTSCSL8 00574 DTSCSL8 00575 IF REQ-ERROR DTSCSL8 00576 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCSL8 00577 ELSE DTSCSL8 00578 IF REQ-JUMP DTSCSL8 00579 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCSL8 00580 ELSE DTSCSL8 00581 IF REQ-CLEAR DTSCSL8 00582 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCSL8 00583 ELSE DTSCSL8 00584 IF REQ-CURSOR-TO-GOTO DTSCSL8 00585 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCSL8 00586 ELSE DTSCSL8 00587 IF REQ-INQUIRE DTSCSL8 00588 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCSL8 00589 ELSE DTSCSL8 00590 IF REQ-EDIT DTSCSL8 00591 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCSL8 00592 ELSE DTSCSL8 00593 IF REQ-UPDATE DTSCSL8 00594 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCSL8 00595 ELSE DTSCSL8 00596 IF REQ-NEW-MSG DTSCSL8 00597 PERFORM P9500-REQUEST-NEW-MSG THRU P9500-EXIT DTSCSL8 00598 ELSE DTSCSL8 00599 GO TO S899-ABEND. DTSCSL8 00600 DTSCSL8 00601 IF WRK-FATAL-ERROR-YES DTSCSL8 00602 GO TO MAINLINE-EXIT. DTSCSL8 00603 *----------------------------------------------------- DTSCSL8 00604 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCSL8 00605 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCSL8 00606 *----------------------------------------------------- DTSCSL8 00607 DTSCSL8 00608 IF RESP-SEND-MAP DTSCSL8 00609 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCSL8 00610 SET LCCM-END-TASK-88 TO TRUE DTSCSL8 00611 ELSE DTSCSL8 00612 IF RESP-SEND-MSGONLY DTSCSL8 00613 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL8 00614 SET LCCM-END-TASK-88 TO TRUE DTSCSL8 00615 ELSE DTSCSL8 00616 IF RESP-JUMP DTSCSL8 00617 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 00618 ELSE DTSCSL8 00619 IF RESP-CURSOR-TO-GOTO DTSCSL8 00620 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCSL8 00621 SET LCCM-END-TASK-88 TO TRUE DTSCSL8 00622 ELSE DTSCSL8 00623 GO TO S899-ABEND. DTSCSL8 00624 DTSCSL8 00625 MAINLINE-EXIT. DTSCSL8 00626 DTSCSL8 00627 EXEC CICS DTSCSL8 00628 RETURN DTSCSL8 00629 END-EXEC. DTSCSL8 00630 DTSCSL8 00631 GOBACK. DTSCSL8 00632 EJECT DTSCSL8 00633 P0100-ACCESS-SEARCH. DTSCSL8 00634 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCSL8 00635 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCSL8 00636 TO SCR-ACCESS-IND. DTSCSL8 00637 DTSCSL8 00638 P0100-EXIT. DTSCSL8 00639 EXIT. DTSCSL8 00640 /*****************************************************************DTSCSL8 00641 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCSL8 00642 ******************************************************************DTSCSL8 00643 P1000-ANALYZE-REQUEST. DTSCSL8 00644 *----------------------------------------------------- DTSCSL8 00645 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCSL8 00646 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCSL8 00647 * REPLACED WITH ENTER) DTSCSL8 00648 * SET LCCM-SCR-HOLD-AREA TO LOW-VALUES. THIS AREA DTSCSL8 00649 * CONTAINS THE KEYS FOR THE CURRENT DISPLAY. DTSCSL8 00650 * THE LCCM-SCRL8-HOLD-AREA, IF PRESENT, CONTAINS DTSCSL8 00651 * THE LOG NUMBER OF THE ELOG RECORD TO BE DISPLAYED DTSCSL8 00652 * PASSED FROM ANOTHER PROGRAM. DTSCSL8 00653 * THE SYSTEM RETAINS THIS KEY WHEN THE USER JUMPS DTSCSL8 00654 * TO ANOTHER SCREEN, AND USES IT TO RECREATE THE DTSCSL8 00655 * THE DISPLAY IF THE USER RETURNS TO SCREEN L8. DTSCSL8 00656 *----------------------------------------------------- DTSCSL8 00657 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCSL8 00658 SET LCCM-ENTER-88 TO TRUE DTSCSL8 00659 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCSL8 00660 IF LCCM-SCRL8-HOLD-AREA = LOW-VALUES OR SPACES DTSCSL8 00661 SET REQ-CLEAR TO TRUE DTSCSL8 00662 GO TO P1000-EXIT DTSCSL8 00663 ELSE DTSCSL8 00664 PERFORM P1200-CHECK-HOLD-AREA THRU P1200-EXIT DTSCSL8 00665 IF WRK-KEY-FOUND-YES DTSCSL8 00666 SET REQ-INQUIRE TO TRUE DTSCSL8 00667 GO TO P1000-EXIT DTSCSL8 00668 ELSE DTSCSL8 00669 SET REQ-CLEAR TO TRUE DTSCSL8 00670 GO TO P1000-EXIT. DTSCSL8 00671 DTSCSL8 00672 *----------------------------------------------------- DTSCSL8 00673 * MAP IS RECEIVED DTSCSL8 00674 *----------------------------------------------------- DTSCSL8 00675 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCSL8 00676 DTSCSL8 00677 *----------------------------------------------------- DTSCSL8 00678 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCSL8 00679 * WORK STATION DTSCSL8 00680 *----------------------------------------------------- DTSCSL8 00681 IF LCCM-CLEAR-88 DTSCSL8 00682 SET REQ-CLEAR TO TRUE DTSCSL8 00683 GO TO P1000-EXIT. DTSCSL8 00684 DTSCSL8 00685 *----------------------------------------------------- DTSCSL8 00686 * IF IN UPDATE MODE, VALIDATE AID KEYS DTSCSL8 00687 *----------------------------------------------------- DTSCSL8 00688 IF LCCM-SCR-UPDATE-LOCKED DTSCSL8 00689 PERFORM P1100-UDPATE-LOCKED THRU P1100-EXIT DTSCSL8 00690 GO TO P1000-EXIT. DTSCSL8 00691 DTSCSL8 00692 *----------------------------------------------------- DTSCSL8 00693 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCSL8 00694 *----------------------------------------------------- DTSCSL8 00695 IF LCCM-PA2-88 DTSCSL8 00696 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCSL8 00697 GO TO P1000-EXIT. DTSCSL8 00698 DTSCSL8 00699 *----------------------------------------------------- DTSCSL8 00700 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCSL8 00701 *----------------------------------------------------- DTSCSL8 00702 IF LCCM-PA-88 DTSCSL8 00703 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL8 00704 SET REQ-ERROR TO TRUE DTSCSL8 00705 GO TO P1000-EXIT. DTSCSL8 00706 DTSCSL8 00707 *----------------------------------------------------- DTSCSL8 00708 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCSL8 00709 * REQUEST TO CLEAR THE SCREEN DTSCSL8 00710 *----------------------------------------------------- DTSCSL8 00711 IF LCCM-F12-88 DTSCSL8 00712 MOVE LOW-VALUES TO MAP-AREA DTSCSL8 00713 SET REQ-CLEAR TO TRUE DTSCSL8 00714 GO TO P1000-EXIT. DTSCSL8 00715 DTSCSL8 00716 *----------------------------------------------------- DTSCSL8 00717 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCSL8 00718 *----------------------------------------------------- DTSCSL8 00719 IF LCCM-F03-88 DTSCSL8 00720 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL8 00721 SET REQ-JUMP TO TRUE DTSCSL8 00722 GO TO P1000-EXIT. DTSCSL8 00723 DTSCSL8 00724 *----------------------------------------------------- DTSCSL8 00725 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCSL8 00726 *----------------------------------------------------- DTSCSL8 00727 IF LCCM-F04-88 DTSCSL8 00728 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL8 00729 SET REQ-JUMP TO TRUE DTSCSL8 00730 GO TO P1000-EXIT. DTSCSL8 00731 DTSCSL8 00732 *----------------------------------------------------- DTSCSL8 00733 * IF CORRESPONDENCE KEY PRESSED, JUMP TO DTSCSL8 00734 * CORRESPONDENCE INQUIRY/UPDATE SCREEN. DTSCSL8 00735 *----------------------------------------------------- DTSCSL8 00736 IF LCCM-F14-88 DTSCSL8 00737 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCSL8 00738 SET REQ-JUMP TO TRUE DTSCSL8 00739 GO TO P1000-EXIT. DTSCSL8 00740 DTSCSL8 00741 *----------------------------------------------------- DTSCSL8 00742 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCSL8 00743 * REQUESTED SCREEN TYPE DTSCSL8 00744 *----------------------------------------------------- DTSCSL8 00745 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCSL8 00746 NEXT SENTENCE DTSCSL8 00747 ELSE DTSCSL8 00748 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCSL8 00749 SET REQ-JUMP TO TRUE DTSCSL8 00750 GO TO P1000-EXIT. DTSCSL8 00751 DTSCSL8 00752 *----------------------------------------------------- DTSCSL8 00753 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCSL8 00754 * F9 CONTROLS MESSAGE FUNCTIONS. PRESSING F9 WHILE DTSCSL8 00755 * THE SCREEN IS IN INQUIRE MODE CLEARS THE MESSAGE DTSCSL8 00756 * AREA TO ALLOW THE USER TO ENTER NEW MESSAGES. DTSCSL8 00757 * PRESSING F9 AGAIN (WHILE THE SCREEN IS IN 'ADD DTSCSL8 00758 * NEW MESSAGE' MODE) EDITS THE MESSAGES AND LOCKS DTSCSL8 00759 * THE SCREEN FOR UPDATE. DTSCSL8 00760 *----------------------------------------------------- DTSCSL8 00761 IF LCCM-F09-88 DTSCSL8 00762 OR LCCM-F10-88 DTSCSL8 00763 IF SCR-ACCESS-UPDATE DTSCSL8 00764 NEXT SENTENCE DTSCSL8 00765 ELSE DTSCSL8 00766 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL8 00767 SET REQ-ERROR TO TRUE DTSCSL8 00768 GO TO P1000-EXIT DTSCSL8 00769 END-IF DTSCSL8 00770 END-IF. DTSCSL8 00771 DTSCSL8 00772 IF LCCM-F09-88 DTSCSL8 00773 IF LCCM-SCR-INQUIRE DTSCSL8 00774 SET REQ-NEW-MSG TO TRUE DTSCSL8 00775 GO TO P1000-EXIT DTSCSL8 00776 ELSE DTSCSL8 00777 IF LCCM-SCR-ADD-EMSG DTSCSL8 00778 SET REQ-EDIT TO TRUE DTSCSL8 00779 GO TO P1000-EXIT DTSCSL8 00780 ELSE DTSCSL8 00781 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCSL8 00782 SET REQ-ERROR TO TRUE DTSCSL8 00783 GO TO P1000-EXIT DTSCSL8 00784 END-IF DTSCSL8 00785 END-IF DTSCSL8 00786 END-IF. DTSCSL8 00787 DTSCSL8 00788 IF LCCM-F10-88 DTSCSL8 00789 SET REQ-EDIT TO TRUE DTSCSL8 00790 GO TO P1000-EXIT. DTSCSL8 00791 DTSCSL8 00792 *----------------------------------------------------- DTSCSL8 00793 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7 DTSCSL8 00794 * OR F8) INDICATE INQUIRY REQUEST DTSCSL8 00795 *----------------------------------------------------- DTSCSL8 00796 IF LCCM-F05-88 DTSCSL8 00797 OR LCCM-F06-88 DTSCSL8 00798 OR LCCM-F07-88 DTSCSL8 00799 OR LCCM-F08-88 DTSCSL8 00800 OR LCCM-ENTER-88 DTSCSL8 00801 SET REQ-INQUIRE TO TRUE DTSCSL8 00802 GO TO P1000-EXIT. DTSCSL8 00803 DTSCSL8 00804 *----------------------------------------------------- DTSCSL8 00805 * ANY OTHER KEY IS INVALID DTSCSL8 00806 *----------------------------------------------------- DTSCSL8 00807 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCSL8 00808 SET REQ-ERROR TO TRUE. DTSCSL8 00809 P1000-EXIT. DTSCSL8 00810 EXIT. DTSCSL8 00811 DTSCSL8 00812 P1100-UDPATE-LOCKED. DTSCSL8 00813 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCSL8 00814 SET REQ-UPDATE TO TRUE DTSCSL8 00815 ELSE DTSCSL8 00816 SET REQ-ERROR TO TRUE DTSCSL8 00817 IF LCCM-SCR-ADD-LOCKED DTSCSL8 00818 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCSL8 00819 ELSE DTSCSL8 00820 GO TO S899-ABEND. DTSCSL8 00821 DTSCSL8 00822 P1100-EXIT. DTSCSL8 00823 EXIT. DTSCSL8 00824 DTSCSL8 00825 ******************************************************************DTSCSL8 00826 * JUMP IN: IF LCCM-SCRL8-HOLD-AREA HAS VALID DATA, DTSCSL8 00827 * USE THE KEY TO READ THE LOG RECORD DTSCSL8 00828 * ELSE DTSCSL8 00829 * CLEAR. DTSCSL8 00830 * DTSCSL8 00831 * INPUT: LCCM-SCRL8-HOLD-AREA DTSCSL8 00832 * OUTPUT: IF VALID KEY FOUND: DTSCSL8 00833 * WRK-KEY-FOUND-ELOG SET TO TRUE DTSCSL8 00834 * ELOG RECORD DTSCSL8 00835 * MPRF RECORD DTSCSL8 00836 * WRK-ELOG-KEY DTSCSL8 00837 * WRK-ELF-ID DTSCSL8 00838 * WRK-ELF-DATA-TYPE-CD DTSCSL8 00839 * DTSCSL8 00840 * IF NO KEY FOUND: DTSCSL8 00841 * WRK-KEY-FOUND-ELOG SET TO FALSE DTSCSL8 00842 ******************************************************************DTSCSL8 00843 DTSCSL8 00844 P1200-CHECK-HOLD-AREA. DTSCSL8 00845 MOVE LCCM-SCRL8-HOLD-AREA TO WRK-LOG-NO-X. DTSCSL8 00846 DTSCSL8 00847 IF WRK-LOG-NO NOT NUMERIC DTSCSL8 00848 MOVE LOW-VALUE TO LCCM-SCRL8-HOLD-AREA DTSCSL8 00849 GO TO P1200-EXIT DTSCSL8 00850 ELSE DTSCSL8 00851 PERFORM S1080-READ-ELOG THRU S1080-EXIT DTSCSL8 00852 IF LCCM-MSG DTSCSL8 00853 MOVE LOW-VALUE TO LCCM-SCRL8-HOLD-AREA DTSCSL8 00854 ELSE DTSCSL8 00855 SET WRK-KEY-FOUND-YES TO TRUE DTSCSL8 00856 END-IF DTSCSL8 00857 END-IF. DTSCSL8 00858 DTSCSL8 00859 P1200-EXIT. DTSCSL8 00860 EXIT. DTSCSL8 00861 /*****************************************************************DTSCSL8 00862 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCSL8 00863 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCSL8 00864 ******************************************************************DTSCSL8 00865 DTSCSL8 00866 P2000-REQUEST-ERROR. DTSCSL8 00867 IF LCCM-MSG DTSCSL8 00868 SET RESP-SEND-MSGONLY TO TRUE DTSCSL8 00869 ELSE DTSCSL8 00870 GO TO S899-ABEND. DTSCSL8 00871 P2000-EXIT. DTSCSL8 00872 EXIT. DTSCSL8 00873 /*****************************************************************DTSCSL8 00874 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCSL8 00875 ******************************************************************DTSCSL8 00876 DTSCSL8 00877 P3000-REQUEST-JUMP. DTSCSL8 00878 *----------------------------------------------------- DTSCSL8 00879 * IF THERE IS A VALUE IN LCCM-REQ-SCR-ID (THE FIELD DTSCSL8 00880 * IS INITIALIZED TO SPACES ON ENTRY TO THE PROGRAM) DTSCSL8 00881 * THE USER HAS PRESSED F3 OR F4 OR HAS ENTERED A DTSCSL8 00882 * VALUE IN MAP-GOTO. DTSCSL8 00883 *----------------------------------------------------- DTSCSL8 00884 IF LCCM-REQ-SCR-ID NOT = SPACES DTSCSL8 00885 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCSL8 00886 IF LCCM-MSG DTSCSL8 00887 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCSL8 00888 SET RESP-SEND-MSGONLY TO TRUE DTSCSL8 00889 SET CURSOR-SET-GOTO TO TRUE DTSCSL8 00890 GO TO P3000-EXIT. DTSCSL8 00891 DTSCSL8 00892 *----------------------------------------------------- DTSCSL8 00893 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCSL8 00894 *----------------------------------------------------- DTSCSL8 00895 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCSL8 00896 LCCM-SCR-HOLD-AREA. DTSCSL8 00897 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCSL8 00898 SET RESP-JUMP TO TRUE. DTSCSL8 00899 P3000-EXIT. DTSCSL8 00900 EXIT. DTSCSL8 00901 DTSCSL8 00902 /*****************************************************************DTSCSL8 00903 * CLEAR KEY WAS PRESSED *DTSCSL8 00904 ******************************************************************DTSCSL8 00905 DTSCSL8 00906 P4000-REQUEST-CLEAR. DTSCSL8 00907 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT. DTSCSL8 00908 DTSCSL8 00909 *----------------------------------------------------- DTSCSL8 00910 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCSL8 00911 * FIELDS FROM EARLIER REQUESTS DTSCSL8 00912 *----------------------------------------------------- DTSCSL8 00913 DTSCSL8 00914 MOVE LOW-VALUES TO LCCM-SCRL8-HOLD-AREA DTSCSL8 00915 LCCM-SCR-HOLD-AREA. DTSCSL8 00916 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL8 00917 DTSCSL8 00918 SET LCCM-SCR-CLEAR TO TRUE. DTSCSL8 00919 DTSCSL8 00920 SET RESP-SEND-MAP TO TRUE. DTSCSL8 00921 P4000-EXIT. DTSCSL8 00922 EXIT. DTSCSL8 00923 DTSCSL8 00924 /*****************************************************************DTSCSL8 00925 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCSL8 00926 ******************************************************************DTSCSL8 00927 P5000-CURSOR-TO-GOTO. DTSCSL8 00928 SET CURSOR-SET-GOTO TO TRUE. DTSCSL8 00929 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCSL8 00930 P5000-EXIT. DTSCSL8 00931 EXIT. DTSCSL8 00932 DTSCSL8 00933 /*****************************************************************DTSCSL8 00934 * INQUIRY WAS REQUESTED *DTSCSL8 00935 ******************************************************************DTSCSL8 00936 P6000-REQUEST-INQUIRE. DTSCSL8 00937 MOVE LOW-VALUES TO MAP-TABLE-AREA. DTSCSL8 00938 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL8 00939 SET RESP-SEND-MAP TO TRUE. DTSCSL8 00940 DTSCSL8 00941 ************************************************************* DTSCSL8 00942 * IF P1200 HAS NOT FOUND A STARTING KEY IN LCCM-SCRL8-HOLD, DTSCSL8 00943 * CHECK WHETHER THE DATA FROM A PREVIOUS TASK EXIST DTSCSL8 00944 * IN LCCM-SCR-HOLD-AREA. IF VALID DATA EXIST, SET DTSCSL8 00945 * WRK-TBL-KEY-FND TO TRUE. DTSCSL8 00946 ************************************************************ DTSCSL8 00947 IF WRK-KEY-FOUND-NO DTSCSL8 00948 PERFORM P9000-CHECK-LCCM-SCR-HOLD THRU P9000-EXIT. DTSCSL8 00949 DTSCSL8 00950 MOVE LOW-VALUE TO LCCM-SCR-HOLD-AREA DTSCSL8 00951 WRK-SCR-HOLD-AREA DTSCSL8 00952 WRK-PAGE-BACK-AREA DTSCSL8 00953 LCCM-SCRL8-HOLD-AREA. DTSCSL8 00954 MOVE +0 TO WRK-SCR-HOLD-MSG-KEY-CTR. DTSCSL8 00955 MOVE WRK-MOD-NAME TO WRK-SCR-HOLD-PROG-NAME. DTSCSL8 00956 DTSCSL8 00957 IF LCCM-SCR-CLEAR DTSCSL8 00958 OR WRK-KEY-FOUND-NO DTSCSL8 00959 PERFORM S1001-SEARCH-KEY-EDITS THRU S1001-EXIT DTSCSL8 00960 IF LCCM-MSG DTSCSL8 00961 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT DTSCSL8 00962 GO TO P6000-EXIT. DTSCSL8 00963 DTSCSL8 00964 * AT THIS POINT THERE IS EITHER A VALID ELOG KEY OR A VALID DTSCSL8 00965 * IESR KEY. THE PROGRAM HAS FOUND THE ELOG AND EPRF RECORDS. DTSCSL8 00966 * CHECK THE ATTENTION KEYS TO DETERMINE THE USER'S INTENTION. DTSCSL8 00967 * PAGING THROUGH ELOG RECORDS IS ONLY ALLOWED IF DTSCSL8 00968 * WRK-KEY-FOUND-IESR IS TRUE. DTSCSL8 00969 DTSCSL8 00970 IF LCCM-ENTER-88 DTSCSL8 00971 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 00972 ELSE DTSCSL8 00973 IF LCCM-F08-88 DTSCSL8 00974 PERFORM P6300-NEXT-ELOG THRU P6300-EXIT DTSCSL8 00975 ELSE DTSCSL8 00976 IF LCCM-F07-88 DTSCSL8 00977 PERFORM P6200-PREV-ELOG THRU P6200-EXIT DTSCSL8 00978 ELSE DTSCSL8 00979 IF LCCM-F06-88 DTSCSL8 00980 PERFORM P6600-NEXT-EMSG THRU P6600-EXIT DTSCSL8 00981 ELSE DTSCSL8 00982 IF LCCM-F05-88 DTSCSL8 00983 PERFORM P6500-PREV-EMSG THRU P6500-EXIT DTSCSL8 00984 ELSE DTSCSL8 00985 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT. DTSCSL8 00986 DTSCSL8 00987 IF WRK-FATAL-ERROR-YES DTSCSL8 00988 GO TO P6000-EXIT. DTSCSL8 00989 DTSCSL8 00990 MOVE WRK-ELOG-KEY TO WRK-SCR-HOLD-LOG-NO. DTSCSL8 00991 IF WRK-KEY-FOUND-IESR DTSCSL8 00992 MOVE WRK-IESR-KEY TO WRK-SCR-HOLD-IESR DTSCSL8 00993 ELSE DTSCSL8 00994 MOVE LOW-VALUES TO WRK-SCR-HOLD-IESR. DTSCSL8 00995 DTSCSL8 00996 MOVE WRK-ORIG-ELF TO WRK-SCR-HOLD-ORIG-ELF. DTSCSL8 00997 MOVE WRK-ORIG-TYPE TO WRK-SCR-HOLD-ORIG-TYPE. DTSCSL8 00998 DTSCSL8 00999 MOVE ZERO TO WRK-SCR-HOLD-NEW-ELF DTSCSL8 01000 WRK-SCR-HOLD-NEW-TYPE. DTSCSL8 01001 DTSCSL8 01002 MOVE WRK-SCR-HOLD-AREA TO LCCM-SCR-HOLD-AREA. DTSCSL8 01003 DTSCSL8 01004 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCSL8 01005 MOVE CATB-CURSOR TO MAP-RCVD-MO-L. DTSCSL8 01006 SET CURSOR-SET-YES TO TRUE. DTSCSL8 01007 DTSCSL8 01008 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL8 01009 P6000-EXIT. DTSCSL8 01010 EXIT. DTSCSL8 01011 DTSCSL8 01012 DTSCSL8 01013 /*****************************************************************DTSCSL8 01014 * ENTER KEY WAS PRESSED, OR A PAGING OPERATION HAS RETURNED A *DTSCSL8 01015 * NEW LOG RECORD. BUILD THE SCREEN. *DTSCSL8 01016 ******************************************************************DTSCSL8 01017 P6100-BUILD-SCREEN. DTSCSL8 01018 DTSCSL8 01019 PERFORM P6400-BUILD-LOG-AREA THRU P6400-EXIT. DTSCSL8 01020 DTSCSL8 01021 PERFORM P6110-READ-EMSG THRU P6110-EXIT. DTSCSL8 01022 IF WRK-EMSG-FOUND-YES DTSCSL8 01023 PERFORM P6700-SCAN-MSG-FWD THRU P6700-EXIT DTSCSL8 01024 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 01025 UNTIL WRK-SUB > MAX-LINES DTSCSL8 01026 OR L835-NO-REC-88 DTSCSL8 01027 OR WRK-FATAL-ERROR-YES. DTSCSL8 01028 DTSCSL8 01029 P6100-EXIT. DTSCSL8 01030 EXIT. DTSCSL8 01031 DTSCSL8 01032 P6110-READ-EMSG. DTSCSL8 01033 MOVE LOW-VALUE TO EMSG-REC. DTSCSL8 01034 SET EMSG-MSG-88 TO TRUE. DTSCSL8 01035 MOVE WRK-ELOG-KEY TO EMSG-LOG-NO. DTSCSL8 01036 MOVE ZEROS TO EMSG-ABSTIME DTSCSL8 01037 EMSG-SEQ. DTSCSL8 01038 DTSCSL8 01039 MOVE EMSG-KEY-AREA TO ESKL-KEY-AREA. DTSCSL8 01040 PERFORM S835-START-BROWSE THRU S835-EXIT. DTSCSL8 01041 IF L835-OK-88 DTSCSL8 01042 MOVE ESKL-REC TO EMSG-REC DTSCSL8 01043 SET WRK-EMSG-FOUND-YES TO TRUE DTSCSL8 01044 ELSE DTSCSL8 01045 SET WRK-EMSG-FOUND-NO TO TRUE DTSCSL8 01046 END-IF. DTSCSL8 01047 DTSCSL8 01048 DTSCSL8 01049 P6110-EXIT. DTSCSL8 01050 EXIT. DTSCSL8 01051 DTSCSL8 01052 P6200-PREV-ELOG. DTSCSL8 01053 IF WRK-KEY-FOUND-IESR DTSCSL8 01054 NEXT SENTENCE DTSCSL8 01055 ELSE DTSCSL8 01056 PERFORM P6201-PAGING-ERROR THRU P6201-EXIT DTSCSL8 01057 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 01058 GO TO P6200-EXIT DTSCSL8 01059 END-IF. DTSCSL8 01060 DTSCSL8 01061 MOVE WRK-IESR-KEY TO ISKL-REC. DTSCSL8 01062 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCSL8 01063 IF L821-NO-REC-88 DTSCSL8 01064 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL8 01065 GO TO P6200-EXIT. DTSCSL8 01066 DTSCSL8 01067 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCSL8 01068 IF L821-NO-REC-88 DTSCSL8 01069 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCSL8 01070 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 01071 GO TO P6200-EXIT DTSCSL8 01072 ELSE DTSCSL8 01073 MOVE ISKL-REC TO IESR-REC DTSCSL8 01074 SET WRK-IESR-FOUND-NO TO TRUE DTSCSL8 01075 PERFORM P6210-SCAN-IESR THRU P6210-EXIT DTSCSL8 01076 UNTIL WRK-IESR-FOUND-YES DTSCSL8 01077 OR WRK-IESR-NO-REC DTSCSL8 01078 IF WRK-IESR-NO-REC DTSCSL8 01079 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCSL8 01080 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 01081 GO TO P6200-EXIT DTSCSL8 01082 ELSE DTSCSL8 01083 PERFORM P6220-BUILD-NEW-KEYS THRU P6220-EXIT DTSCSL8 01084 END-IF DTSCSL8 01085 END-IF. DTSCSL8 01086 DTSCSL8 01087 IF LCCM-MSG DTSCSL8 01088 GO TO P6200-EXIT. DTSCSL8 01089 DTSCSL8 01090 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT. DTSCSL8 01091 DTSCSL8 01092 P6200-EXIT. DTSCSL8 01093 EXIT. DTSCSL8 01094 DTSCSL8 01095 P6201-PAGING-ERROR. DTSCSL8 01096 MOVE MSG-EL85-AREA TO LCCM-MSG-AREA. DTSCSL8 01097 DTSCSL8 01098 P6201-EXIT. DTSCSL8 01099 EXIT. DTSCSL8 01100 DTSCSL8 01101 P6210-SCAN-IESR. DTSCSL8 01102 IF IESR-ELF-ID = WRK-ELF-ID DTSCSL8 01103 IF WRK-ORIG-TYPE = ZEROS DTSCSL8 01104 SET WRK-IESR-FOUND-YES TO TRUE DTSCSL8 01105 GO TO P6210-EXIT DTSCSL8 01106 ELSE DTSCSL8 01107 IF IESR-DATA-TYPE-CD = WRK-ORIG-TYPE DTSCSL8 01108 SET WRK-IESR-FOUND-YES TO TRUE DTSCSL8 01109 GO TO P6210-EXIT DTSCSL8 01110 ELSE DTSCSL8 01111 NEXT SENTENCE DTSCSL8 01112 END-IF DTSCSL8 01113 END-IF DTSCSL8 01114 ELSE DTSCSL8 01115 SET WRK-IESR-NO-REC TO TRUE DTSCSL8 01116 GO TO P6210-EXIT DTSCSL8 01117 END-IF. DTSCSL8 01118 DTSCSL8 01119 PERFORM S821-READ-PREV THRU S821-EXIT. DTSCSL8 01120 IF L821-NO-REC-88 DTSCSL8 01121 SET WRK-IESR-NO-REC TO TRUE DTSCSL8 01122 ELSE DTSCSL8 01123 MOVE ISKL-REC TO IESR-REC. DTSCSL8 01124 DTSCSL8 01125 P6210-EXIT. DTSCSL8 01126 EXIT. DTSCSL8 01127 DTSCSL8 01128 P6220-BUILD-NEW-KEYS. DTSCSL8 01129 MOVE IESR-LOG-NO TO WRK-LOG-NO. DTSCSL8 01130 PERFORM S1072-READ-ELOG THRU S1072-EXIT. DTSCSL8 01131 IF LCCM-MSG DTSCSL8 01132 GO TO P6220-EXIT. DTSCSL8 01133 DTSCSL8 01134 SET WRK-KEY-FOUND-IESR TO TRUE. DTSCSL8 01135 MOVE ISKL-KEY-AREA TO WRK-IESR-KEY DTSCSL8 01136 IESR-REC. DTSCSL8 01137 DTSCSL8 01138 P6220-EXIT. DTSCSL8 01139 EXIT. DTSCSL8 01140 DTSCSL8 01141 P6300-NEXT-ELOG. DTSCSL8 01142 IF WRK-KEY-FOUND-IESR DTSCSL8 01143 NEXT SENTENCE DTSCSL8 01144 ELSE DTSCSL8 01145 PERFORM P6301-PAGING-ERROR THRU P6301-EXIT DTSCSL8 01146 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 01147 GO TO P6300-EXIT DTSCSL8 01148 END-IF. DTSCSL8 01149 DTSCSL8 01150 MOVE WRK-IESR-KEY TO ISKL-REC. DTSCSL8 01151 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCSL8 01152 IF L821-NO-REC-88 DTSCSL8 01153 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCSL8 01154 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 01155 GO TO P6300-EXIT DTSCSL8 01156 ELSE DTSCSL8 01157 MOVE ISKL-REC TO IESR-REC DTSCSL8 01158 SET WRK-IESR-FOUND-NO TO TRUE DTSCSL8 01159 PERFORM P6310-SCAN-IESR THRU P6310-EXIT DTSCSL8 01160 UNTIL WRK-IESR-FOUND-YES DTSCSL8 01161 OR WRK-IESR-NO-REC DTSCSL8 01162 IF WRK-IESR-NO-REC DTSCSL8 01163 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCSL8 01164 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT DTSCSL8 01165 GO TO P6300-EXIT DTSCSL8 01166 ELSE DTSCSL8 01167 PERFORM P6320-BUILD-NEW-KEYS THRU P6320-EXIT DTSCSL8 01168 END-IF. DTSCSL8 01169 DTSCSL8 01170 IF LCCM-MSG DTSCSL8 01171 GO TO P6300-EXIT. DTSCSL8 01172 DTSCSL8 01173 PERFORM P6100-BUILD-SCREEN THRU P6100-EXIT. DTSCSL8 01174 DTSCSL8 01175 P6300-EXIT. DTSCSL8 01176 EXIT. DTSCSL8 01177 DTSCSL8 01178 P6301-PAGING-ERROR. DTSCSL8 01179 MOVE MSG-EL85-AREA TO LCCM-MSG-AREA. DTSCSL8 01180 DTSCSL8 01181 P6301-EXIT. DTSCSL8 01182 EXIT. DTSCSL8 01183 DTSCSL8 01184 P6310-SCAN-IESR. DTSCSL8 01185 IF IESR-ELF-ID = WRK-ELF-ID DTSCSL8 01186 IF WRK-ORIG-TYPE = ZEROS DTSCSL8 01187 SET WRK-IESR-FOUND-YES TO TRUE DTSCSL8 01188 GO TO P6310-EXIT DTSCSL8 01189 ELSE DTSCSL8 01190 IF IESR-DATA-TYPE-CD = WRK-ORIG-TYPE DTSCSL8 01191 SET WRK-IESR-FOUND-YES TO TRUE DTSCSL8 01192 GO TO P6310-EXIT DTSCSL8 01193 ELSE DTSCSL8 01194 NEXT SENTENCE DTSCSL8 01195 END-IF DTSCSL8 01196 END-IF DTSCSL8 01197 ELSE DTSCSL8 01198 SET WRK-IESR-NO-REC TO TRUE DTSCSL8 01199 GO TO P6310-EXIT DTSCSL8 01200 END-IF. DTSCSL8 01201 DTSCSL8 01202 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCSL8 01203 IF L821-NO-REC-88 DTSCSL8 01204 SET WRK-IESR-NO-REC TO TRUE DTSCSL8 01205 ELSE DTSCSL8 01206 MOVE ISKL-REC TO IESR-REC. DTSCSL8 01207 DTSCSL8 01208 P6310-EXIT. DTSCSL8 01209 EXIT. DTSCSL8 01210 DTSCSL8 01211 P6320-BUILD-NEW-KEYS. DTSCSL8 01212 MOVE IESR-LOG-NO TO WRK-LOG-NO. DTSCSL8 01213 PERFORM S1072-READ-ELOG THRU S1072-EXIT. DTSCSL8 01214 IF LCCM-MSG DTSCSL8 01215 GO TO P6320-EXIT. DTSCSL8 01216 DTSCSL8 01217 SET WRK-KEY-FOUND-IESR TO TRUE. DTSCSL8 01218 MOVE ISKL-KEY-AREA TO WRK-IESR-KEY DTSCSL8 01219 IESR-REC. DTSCSL8 01220 DTSCSL8 01221 P6320-EXIT. DTSCSL8 01222 EXIT. DTSCSL8 01223 DTSCSL8 01224 P6400-BUILD-LOG-AREA. DTSCSL8 01225 MOVE ELOG-ELF-ID TO WRK-ELF-ID-DISP. DTSCSL8 01226 MOVE WRK-ELF-ID-DISP-1 TO MAP-ELF-ID-1. DTSCSL8 01227 MOVE WRK-ELF-ID-DISP-2 TO MAP-ELF-ID-2. DTSCSL8 01228 MOVE ELOG-LOG-NO-SFX TO MAP-LOG-NO. DTSCSL8 01229 IF WRK-ELF-ID-EXTERNAL-88 DTSCSL8 01230 MOVE EPRF-ELF-NAME TO MAP-ELF-NAME DTSCSL8 01231 ELSE DTSCSL8 01232 MOVE MPRF-PRIMARY-NAME TO MAP-ELF-NAME. DTSCSL8 01233 DTSCSL8 01234 MOVE ELOG-DATA-TYPE-CD TO L041-CD-2 DTSCSL8 01235 MAP-DATA-TYPE-CD. DTSCSL8 01236 SET L041-EPRF-DATA-TYPE-CD TO TRUE. DTSCSL8 01237 PERFORM S041-ELEC-MEDIA-CODES THRU S041-EXIT. DTSCSL8 01238 IF L041-VALID DTSCSL8 01239 MOVE L041-LONG-DSCR TO MAP-DATA-TYPE-DSCR DTSCSL8 01240 ELSE DTSCSL8 01241 GO TO S899-ABEND. DTSCSL8 01242 DTSCSL8 01243 IF ELOG-RCVD-DATE NOT = ZERO DTSCSL8 01244 MOVE ELOG-RCVD-DATE TO WRK-DATE-DISP DTSCSL8 01245 MOVE WRK-DATE-MM TO MAP-RCVD-MO DTSCSL8 01246 MOVE WRK-DATE-DD TO MAP-RCVD-DA DTSCSL8 01247 MOVE WRK-DATE-YY TO MAP-RCVD-YR. DTSCSL8 01248 DTSCSL8 01249 IF ELOG-COMPLETE-DATE NOT = ZERO DTSCSL8 01250 MOVE ELOG-COMPLETE-DATE TO WRK-DATE-DISP DTSCSL8 01251 MOVE WRK-DATE-MM TO MAP-CMPL-MO DTSCSL8 01252 MOVE WRK-DATE-DD TO MAP-CMPL-DA DTSCSL8 01253 MOVE WRK-DATE-YY TO MAP-CMPL-YR. DTSCSL8 01254 DTSCSL8 01255 MOVE ELOG-BOX-NO TO MAP-BOX-NO. DTSCSL8 01256 MOVE ELOG-ORIG-VOL TO MAP-ORIG-VOL. DTSCSL8 01257 DTSCSL8 01258 MOVE ELOG-ESTB-DATE TO WRK-DATE-DISP. DTSCSL8 01259 MOVE WRK-DATE-MM TO MAP-ESTB-MO. DTSCSL8 01260 MOVE WRK-DATE-DD TO MAP-ESTB-DA. DTSCSL8 01261 MOVE WRK-DATE-YY TO MAP-ESTB-YR. DTSCSL8 01262 DTSCSL8 01263 MOVE ELOG-CHNG-DATE TO WRK-DATE-DISP. DTSCSL8 01264 MOVE WRK-DATE-MM TO MAP-CHNG-MO. DTSCSL8 01265 MOVE WRK-DATE-DD TO MAP-CHNG-DA. DTSCSL8 01266 MOVE WRK-DATE-YY TO MAP-CHNG-YR. DTSCSL8 01267 DTSCSL8 01268 MOVE ELOG-CHNG-OPID TO MAP-CHNG-OPID. DTSCSL8 01269 DTSCSL8 01270 P6400-EXIT. DTSCSL8 01271 EXIT. DTSCSL8 01272 DTSCSL8 01273 /*****************************************************************DTSCSL8 01274 * *DTSCSL8 01275 ******************************************************************DTSCSL8 01276 P6500-PREV-EMSG. DTSCSL8 01277 MOVE WRK-STARTING-MSG-KEY TO ESKL-REC. DTSCSL8 01278 PERFORM S835-START-BROWSE THRU S835-EXIT. DTSCSL8 01279 IF L835-NO-REC-88 DTSCSL8 01280 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL8 01281 GO TO P6500-EXIT. DTSCSL8 01282 DTSCSL8 01283 PERFORM S835-READ-PREV THRU S835-EXIT. DTSCSL8 01284 IF L835-NO-REC-88 DTSCSL8 01285 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL8 01286 GO TO P6500-EXIT. DTSCSL8 01287 DTSCSL8 01288 PERFORM S835-READ-PREV THRU S835-EXIT. DTSCSL8 01289 IF L835-NO-REC-88 DTSCSL8 01290 MOVE WRK-STARTING-MSG-KEY TO ESKL-REC DTSCSL8 01291 PERFORM S835-START-BROWSE THRU S835-EXIT DTSCSL8 01292 IF L821-NO-REC-88 DTSCSL8 01293 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL8 01294 GO TO P6500-EXIT DTSCSL8 01295 ELSE DTSCSL8 01296 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID DTSCSL8 01297 MOVE ESKL-REC TO EMSG-REC DTSCSL8 01298 PERFORM P6700-SCAN-MSG-FWD THRU P6700-EXIT DTSCSL8 01299 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 01300 UNTIL WRK-SUB > MAX-LINES DTSCSL8 01301 OR L835-NO-REC-88 DTSCSL8 01302 OR WRK-FATAL-ERROR-YES DTSCSL8 01303 GO TO P6500-EXIT. DTSCSL8 01304 DTSCSL8 01305 DTSCSL8 01306 MOVE ESKL-REC TO EMSG-REC. DTSCSL8 01307 PERFORM P6800-SCAN-MSG-BACK THRU P6800-EXIT DTSCSL8 01308 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 01309 UNTIL WRK-SUB > MAX-LINES DTSCSL8 01310 OR L835-NO-REC-88 DTSCSL8 01311 OR WRK-FATAL-ERROR-YES. DTSCSL8 01312 DTSCSL8 01313 IF L835-NO-REC-88 DTSCSL8 01314 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-ID. DTSCSL8 01315 DTSCSL8 01316 MOVE WRK-PAGE-BACK-CTR TO WRK-SCR-HOLD-MSG-KEY-CTR. DTSCSL8 01317 MOVE ZERO TO WRK-SUB2. DTSCSL8 01318 PERFORM P6510-BUILD-MAP THRU P6510-EXIT DTSCSL8 01319 VARYING WRK-SUB FROM WRK-PAGE-BACK-CTR BY -1 DTSCSL8 01320 UNTIL WRK-SUB < +1. DTSCSL8 01321 P6500-EXIT. DTSCSL8 01322 EXIT. DTSCSL8 01323 DTSCSL8 01324 P6510-BUILD-MAP. DTSCSL8 01325 ADD +1 TO WRK-SUB2. DTSCSL8 01326 MOVE WRK-PAGE-BACK-KEY (WRK-SUB) DTSCSL8 01327 TO WRK-SCR-HOLD-MSG-KEY (WRK-SUB2). DTSCSL8 01328 MOVE WRK-PAGE-BACK-MSG-TYPE (WRK-SUB) DTSCSL8 01329 TO MAP-MSG-TYPE (WRK-SUB2) DTSCSL8 01330 MOVE WRK-PAGE-BACK-MESSAGE (WRK-SUB) DTSCSL8 01331 TO MAP-MESSAGE (WRK-SUB2) DTSCSL8 01332 MOVE WRK-PAGE-BACK-MSG-OPID (WRK-SUB) DTSCSL8 01333 TO MAP-MSG-OPID (WRK-SUB2). DTSCSL8 01334 P6510-EXIT. DTSCSL8 01335 EXIT. DTSCSL8 01336 DTSCSL8 01337 /*****************************************************************DTSCSL8 01338 * *DTSCSL8 01339 ******************************************************************DTSCSL8 01340 P6600-NEXT-EMSG. DTSCSL8 01341 MOVE WRK-ENDING-MSG-KEY TO ESKL-REC. DTSCSL8 01342 PERFORM S835-START-BROWSE THRU S835-EXIT. DTSCSL8 01343 IF L835-NO-REC-88 DTSCSL8 01344 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL8 01345 GO TO P6600-EXIT. DTSCSL8 01346 DTSCSL8 01347 PERFORM S835-READ-NEXT THRU S835-EXIT. DTSCSL8 01348 IF L835-NO-REC-88 DTSCSL8 01349 MOVE WRK-STARTING-MSG-KEY TO ESKL-REC DTSCSL8 01350 PERFORM S835-START-BROWSE THRU S835-EXIT DTSCSL8 01351 IF L835-NO-REC-88 DTSCSL8 01352 MOVE EMSG-NO-RECORD TO LCCM-MSG-ID DTSCSL8 01353 GO TO P6600-EXIT DTSCSL8 01354 ELSE DTSCSL8 01355 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID DTSCSL8 01356 END-IF. DTSCSL8 01357 * ELSE DTSCSL8 01358 * MOVE ESKL-REC TO EMSG-REC DTSCSL8 01359 * END-IF. DTSCSL8 01360 DTSCSL8 01361 MOVE ESKL-REC TO EMSG-REC. DTSCSL8 01362 PERFORM P6700-SCAN-MSG-FWD THRU P6700-EXIT DTSCSL8 01363 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 01364 UNTIL WRK-SUB > MAX-LINES DTSCSL8 01365 OR L835-NO-REC-88 DTSCSL8 01366 OR WRK-FATAL-ERROR-YES. DTSCSL8 01367 DTSCSL8 01368 IF L835-NO-REC-88 DTSCSL8 01369 MOVE PMSG-LAST-PAGE TO LCCM-MSG-ID. DTSCSL8 01370 P6600-EXIT. DTSCSL8 01371 EXIT. DTSCSL8 01372 DTSCSL8 01373 P6700-SCAN-MSG-FWD. DTSCSL8 01374 PERFORM P6900-FORMAT-LINE THRU P6900-EXIT. DTSCSL8 01375 DTSCSL8 01376 MOVE EMSG-KEY-AREA TO WRK-SCR-HOLD-MSG-KEY (WRK-SUB). DTSCSL8 01377 MOVE SPACES TO MAP-MSG-TYPE (WRK-SUB) DTSCSL8 01378 MAP-MESSAGE (WRK-SUB) DTSCSL8 01379 MAP-MSG-OPID (WRK-SUB). DTSCSL8 01380 MOVE WRK-SCR-MSG-TYPE TO MAP-MSG-TYPE (WRK-SUB). DTSCSL8 01381 MOVE WRK-SCR-MESSAGE TO MAP-MESSAGE (WRK-SUB). DTSCSL8 01382 MOVE WRK-SCR-OPID TO MAP-MSG-OPID (WRK-SUB). DTSCSL8 01383 MOVE WRK-SUB TO WRK-SCR-HOLD-MSG-KEY-CTR. DTSCSL8 01384 DTSCSL8 01385 PERFORM S835-READ-NEXT THRU S835-EXIT. DTSCSL8 01386 IF L835-OK-88 DTSCSL8 01387 MOVE ESKL-REC TO EMSG-REC. DTSCSL8 01388 DTSCSL8 01389 P6700-EXIT. DTSCSL8 01390 EXIT. DTSCSL8 01391 DTSCSL8 01392 P6800-SCAN-MSG-BACK. DTSCSL8 01393 PERFORM P6900-FORMAT-LINE THRU P6900-EXIT. DTSCSL8 01394 DTSCSL8 01395 MOVE EMSG-KEY-AREA TO WRK-PAGE-BACK-KEY (WRK-SUB). DTSCSL8 01396 MOVE SPACES TO WRK-PAGE-BACK-MSG-TYPE (WRK-SUB) DTSCSL8 01397 WRK-PAGE-BACK-MESSAGE (WRK-SUB) DTSCSL8 01398 WRK-PAGE-BACK-MSG-OPID (WRK-SUB). DTSCSL8 01399 MOVE WRK-SCR-MSG-TYPE DTSCSL8 01400 TO WRK-PAGE-BACK-MSG-TYPE (WRK-SUB). DTSCSL8 01401 MOVE WRK-SCR-MESSAGE DTSCSL8 01402 TO WRK-PAGE-BACK-MESSAGE (WRK-SUB). DTSCSL8 01403 MOVE WRK-SCR-OPID DTSCSL8 01404 TO WRK-PAGE-BACK-MSG-OPID (WRK-SUB). DTSCSL8 01405 MOVE WRK-SUB TO WRK-PAGE-BACK-CTR. DTSCSL8 01406 DTSCSL8 01407 PERFORM S835-READ-PREV THRU S835-EXIT. DTSCSL8 01408 IF L835-OK-88 DTSCSL8 01409 MOVE ESKL-REC TO EMSG-REC. DTSCSL8 01410 DTSCSL8 01411 P6800-EXIT. DTSCSL8 01412 EXIT. DTSCSL8 01413 /*****************************************************************DTSCSL8 01414 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCSL8 01415 ******************************************************************DTSCSL8 01416 P6900-FORMAT-LINE. DTSCSL8 01417 DTSCSL8 01418 MOVE SPACES TO WRK-SCREEN-DATA. DTSCSL8 01419 DTSCSL8 01420 EVALUATE EMSG-MSG-TYPE DTSCSL8 01421 WHEN '0' DTSCSL8 01422 MOVE 'STATUS:' TO WRK-SCR-MSG-TYPE DTSCSL8 01423 WHEN '1' DTSCSL8 01424 MOVE 'ERROR: ' TO WRK-SCR-MSG-TYPE DTSCSL8 01425 WHEN '2' DTSCSL8 01426 MOVE 'MANUAL:' TO WRK-SCR-MSG-TYPE DTSCSL8 01427 WHEN '3' DTSCSL8 01428 MOVE 'FINAL: ' TO WRK-SCR-MSG-TYPE DTSCSL8 01429 END-EVALUATE. DTSCSL8 01430 DTSCSL8 01431 MOVE EMSG-FULL-MESSAGE TO WRK-SCR-MESSAGE. DTSCSL8 01432 DTSCSL8 01433 MOVE EMSG-ESTB-OPID TO WRK-SCR-OPID. DTSCSL8 01434 DTSCSL8 01435 P6900-EXIT. DTSCSL8 01436 EXIT. DTSCSL8 01437 DTSCSL8 01438 DTSCSL8 01439 /*****************************************************************DTSCSL8 01440 * FUNCTION KEY TO ADD RECORD WAS PRESSED. *DTSCSL8 01441 ******************************************************************DTSCSL8 01442 P7000-REQUEST-EDIT. DTSCSL8 01443 PERFORM S5400-SET-UPDATE-ATTRB THRU S5400-EXIT. DTSCSL8 01444 DTSCSL8 01445 IF LCCM-F09-88 DTSCSL8 01446 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCSL8 01447 ELSE DTSCSL8 01448 IF LCCM-F10-88 DTSCSL8 01449 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCSL8 01450 ELSE DTSCSL8 01451 GO TO S899-ABEND. DTSCSL8 01452 DTSCSL8 01453 *------------------------------------------------------ DTSCSL8 01454 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCSL8 01455 * IN ORDER TO CONTINUE WITH THE ADD OR MOD FUNCTION, DTSCSL8 01456 * THE SCREEN MUST REMAIN IN 'INQUIRE' STATUS. DTSCSL8 01457 *------------------------------------------------------ DTSCSL8 01458 DTSCSL8 01459 IF LCCM-MSG DTSCSL8 01460 NEXT SENTENCE DTSCSL8 01461 ELSE DTSCSL8 01462 MOVE WRK-SCR-HOLD-AREA TO LCCM-SCR-HOLD-AREA DTSCSL8 01463 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCSL8 01464 IF LCCM-F09-88 DTSCSL8 01465 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCSL8 01466 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCSL8 01467 ELSE DTSCSL8 01468 IF LCCM-F10-88 DTSCSL8 01469 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCSL8 01470 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID. DTSCSL8 01471 DTSCSL8 01472 SET RESP-SEND-MAP TO TRUE. DTSCSL8 01473 DTSCSL8 01474 P7000-EXIT. DTSCSL8 01475 EXIT. DTSCSL8 01476 DTSCSL8 01477 /*****************************************************************DTSCSL8 01478 * VALIDATE DATA NEEDED TO ADD NEW MESSAGE RECORDS. *DTSCSL8 01479 ******************************************************************DTSCSL8 01480 P7100-EDIT-ADD. DTSCSL8 01481 *----------------------------------------------------- DTSCSL8 01482 * ADD REQUIRES THAT A PREVIOUS INQUIRY REQUEST DTSCSL8 01483 * RETURNED DATA FROM AN ELOG RECORD. DTSCSL8 01484 *----------------------------------------------------- DTSCSL8 01485 IF NOT LCCM-SCR-ADD-EMSG DTSCSL8 01486 MOVE MSG-EL84-AREA TO LCCM-MSG-AREA DTSCSL8 01487 GO TO P7100-EXIT. DTSCSL8 01488 DTSCSL8 01489 MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA DTSCSL8 01490 IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME DTSCSL8 01491 NEXT SENTENCE DTSCSL8 01492 ELSE DTSCSL8 01493 MOVE MSG-EL84-AREA TO LCCM-MSG-AREA DTSCSL8 01494 GO TO P7100-EXIT. DTSCSL8 01495 DTSCSL8 01496 *----------------------------------------------------- DTSCSL8 01497 * EDIT MESSAGE DATA DTSCSL8 01498 *----------------------------------------------------- DTSCSL8 01499 PERFORM S2000-MSG-EDITS THRU S2000-EXIT. DTSCSL8 01500 IF LCCM-MSG DTSCSL8 01501 GO TO P7100-EXIT. DTSCSL8 01502 DTSCSL8 01503 P7100-EXIT. DTSCSL8 01504 EXIT. DTSCSL8 01505 DTSCSL8 01506 /*****************************************************************DTSCSL8 01507 * VALIDATE DATA NEEDED TO MODIFY THE LOG RECORD. *DTSCSL8 01508 ******************************************************************DTSCSL8 01509 P7200-EDIT-MOD. DTSCSL8 01510 *----------------------------------------------------- DTSCSL8 01511 * MOD REQUIRES THAT A PREVIOUS INQUIRY REQUEST DTSCSL8 01512 * RETURNED DATA FROM AN ELOG RECORD. DTSCSL8 01513 *----------------------------------------------------- DTSCSL8 01514 IF NOT LCCM-SCR-INQUIRE DTSCSL8 01515 MOVE MSG-EL84-AREA TO LCCM-MSG-AREA DTSCSL8 01516 GO TO P7200-EXIT. DTSCSL8 01517 DTSCSL8 01518 MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA DTSCSL8 01519 IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME DTSCSL8 01520 NEXT SENTENCE DTSCSL8 01521 ELSE DTSCSL8 01522 MOVE MSG-EL84-AREA TO LCCM-MSG-AREA DTSCSL8 01523 GO TO P7200-EXIT. DTSCSL8 01524 DTSCSL8 01525 MOVE WRK-SCR-HOLD-LOG-NO TO WRK-LOG-NO. DTSCSL8 01526 PERFORM S1080-READ-ELOG THRU S1080-EXIT. DTSCSL8 01527 IF LCCM-MSG DTSCSL8 01528 MOVE WRK-ELF-ID TO MSG-ELF-ID-IN-ERR DTSCSL8 01529 MOVE MSG-EL83-AREA TO LCCM-MSG-AREA DTSCSL8 01530 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 01531 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 01532 SET WRK-FATAL-ERROR-YES TO TRUE DTSCSL8 01533 GO TO P7200-EXIT. DTSCSL8 01534 DTSCSL8 01535 *----------------------------------------------------- DTSCSL8 01536 * EDIT DATA NEEDED TO MODIFY THE ELOG RECORD. DTSCSL8 01537 *----------------------------------------------------- DTSCSL8 01538 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCSL8 01539 IF LCCM-MSG DTSCSL8 01540 GO TO P7200-EXIT. DTSCSL8 01541 DTSCSL8 01542 P7200-EXIT. DTSCSL8 01543 EXIT. DTSCSL8 01544 DTSCSL8 01545 /*****************************************************************DTSCSL8 01546 * THE ADD FUNCTION WAS CONFIRMED OR CANCELED. *DTSCSL8 01547 ******************************************************************DTSCSL8 01548 P8000-REQUEST-UPDATE. DTSCSL8 01549 PERFORM S5400-SET-UPDATE-ATTRB THRU S5400-EXIT. DTSCSL8 01550 DTSCSL8 01551 MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA DTSCSL8 01552 IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME DTSCSL8 01553 NEXT SENTENCE DTSCSL8 01554 ELSE DTSCSL8 01555 MOVE MSG-EL84-AREA TO LCCM-MSG-AREA DTSCSL8 01556 GO TO P8000-EXIT. DTSCSL8 01557 DTSCSL8 01558 IF LCCM-SCR-ADD-LOCKED DTSCSL8 01559 PERFORM P8100-ADD THRU P8100-EXIT DTSCSL8 01560 ELSE DTSCSL8 01561 IF LCCM-SCR-MOD-LOCKED DTSCSL8 01562 PERFORM P8200-MOD THRU P8200-EXIT DTSCSL8 01563 ELSE DTSCSL8 01564 GO TO S899-ABEND. DTSCSL8 01565 DTSCSL8 01566 SET RESP-SEND-MAP TO TRUE. DTSCSL8 01567 DTSCSL8 01568 P8000-EXIT. DTSCSL8 01569 EXIT. DTSCSL8 01570 DTSCSL8 01571 P8100-ADD. DTSCSL8 01572 IF LCCM-F12-88 DTSCSL8 01573 SET LCCM-SCR-CLEAR TO TRUE DTSCSL8 01574 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCSL8 01575 GO TO P8100-EXIT. DTSCSL8 01576 DTSCSL8 01577 MOVE WRK-SCR-HOLD-LOG-NO TO WRK-LOG-NO. DTSCSL8 01578 PERFORM S1080-READ-ELOG THRU S1080-EXIT. DTSCSL8 01579 IF LCCM-MSG DTSCSL8 01580 MOVE WRK-ELF-ID TO MSG-ELF-ID-IN-ERR DTSCSL8 01581 MOVE MSG-EL83-AREA TO LCCM-MSG-AREA DTSCSL8 01582 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 01583 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 01584 SET WRK-FATAL-ERROR-YES TO TRUE DTSCSL8 01585 GO TO P8100-EXIT. DTSCSL8 01586 DTSCSL8 01587 MOVE 'A' TO L222-UPDATE-FUNCTION. DTSCSL8 01588 PERFORM P8800-LOCK-ELECTRONIC-FILER THRU P8800-EXIT. DTSCSL8 01589 IF LCCM-MSG DTSCSL8 01590 GO TO P8100-EXIT. DTSCSL8 01591 DTSCSL8 01592 PERFORM S005-ABSTIME THRU S005-EXIT. DTSCSL8 01593 DTSCSL8 01594 PERFORM P8110-BUILD-MESSAGES THRU P8110-EXIT. DTSCSL8 01595 DTSCSL8 01596 PERFORM S222-ELF-UNLOCK THRU S222-EXIT. DTSCSL8 01597 DTSCSL8 01598 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCSL8 01599 DTSCSL8 01600 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL8 01601 DTSCSL8 01602 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCSL8 01603 MOVE L222-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL8 01604 DTSCSL8 01605 P8100-EXIT. DTSCSL8 01606 EXIT. DTSCSL8 01607 DTSCSL8 01608 P8110-BUILD-MESSAGES. DTSCSL8 01609 PERFORM DTSCSL8 01610 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 01611 UNTIL WRK-SUB > MAX-LINES DTSCSL8 01612 IF MAP-MESSAGE (WRK-SUB) NOT = SPACES DTSCSL8 01613 PERFORM P8111-ADD-EMSG THRU P8111-EXIT DTSCSL8 01614 END-IF DTSCSL8 01615 END-PERFORM. DTSCSL8 01616 DTSCSL8 01617 P8110-EXIT. DTSCSL8 01618 EXIT. DTSCSL8 01619 DTSCSL8 01620 P8111-ADD-EMSG. DTSCSL8 01621 MOVE LOW-VALUE TO EMSG-REC. DTSCSL8 01622 DTSCSL8 01623 SET EMSG-MSG-88 TO TRUE. DTSCSL8 01624 MOVE ELOG-LOG-NO TO EMSG-LOG-NO. DTSCSL8 01625 MOVE L005-ABSTIME TO EMSG-ABSTIME. DTSCSL8 01626 ADD 1 TO WRK-EMSG-SEQ. DTSCSL8 01627 MOVE WRK-EMSG-SEQ TO EMSG-SEQ. DTSCSL8 01628 SET EMSG-TYPE-MANUAL-88 TO TRUE. DTSCSL8 01629 MOVE MAP-MESSAGE (WRK-SUB) DTSCSL8 01630 TO EMSG-FULL-MESSAGE. DTSCSL8 01631 MOVE SPACES TO EMSG-SHORT-MESSAGE. DTSCSL8 01632 MOVE LCCM-OP-ID TO EMSG-ESTB-OPID. DTSCSL8 01633 DTSCSL8 01634 MOVE EMSG-REC TO ESKL-REC. DTSCSL8 01635 PERFORM S835-WRITE THRU S835-EXIT. DTSCSL8 01636 DTSCSL8 01637 P8111-EXIT. DTSCSL8 01638 EXIT. DTSCSL8 01639 DTSCSL8 01640 P8200-MOD. DTSCSL8 01641 IF LCCM-F12-88 DTSCSL8 01642 SET LCCM-SCR-CLEAR TO TRUE DTSCSL8 01643 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCSL8 01644 GO TO P8200-EXIT. DTSCSL8 01645 DTSCSL8 01646 MOVE WRK-SCR-HOLD-LOG-NO TO WRK-LOG-NO. DTSCSL8 01647 PERFORM S1080-READ-ELOG THRU S1080-EXIT. DTSCSL8 01648 IF LCCM-MSG DTSCSL8 01649 MOVE WRK-ELF-ID TO MSG-ELF-ID-IN-ERR DTSCSL8 01650 MOVE MSG-EL83-AREA TO LCCM-MSG-AREA DTSCSL8 01651 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 01652 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 01653 SET WRK-FATAL-ERROR-YES TO TRUE DTSCSL8 01654 GO TO P8200-EXIT. DTSCSL8 01655 DTSCSL8 01656 MOVE 'M' TO L222-UPDATE-FUNCTION. DTSCSL8 01657 PERFORM P8800-LOCK-ELECTRONIC-FILER THRU P8800-EXIT. DTSCSL8 01658 IF LCCM-MSG DTSCSL8 01659 GO TO P8200-EXIT. DTSCSL8 01660 DTSCSL8 01661 PERFORM P8210-UPDATE-ELOG THRU P8210-EXIT. DTSCSL8 01662 DTSCSL8 01663 PERFORM S222-ELF-UNLOCK THRU S222-EXIT. DTSCSL8 01664 DTSCSL8 01665 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCSL8 01666 DTSCSL8 01667 SET LCCM-SCR-INQUIRE TO TRUE. DTSCSL8 01668 DTSCSL8 01669 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCSL8 01670 MOVE L222-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCSL8 01671 DTSCSL8 01672 P8200-EXIT. DTSCSL8 01673 EXIT. DTSCSL8 01674 DTSCSL8 01675 P8210-UPDATE-ELOG. DTSCSL8 01676 MOVE MAP-RCVD-DATE-AREA TO L015-S-DATE-AREA. DTSCSL8 01677 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCSL8 01678 IF L015-VALID DTSCSL8 01679 IF L015-DATE NOT = ELOG-RCVD-DATE DTSCSL8 01680 MOVE L015-DATE TO ELOG-RCVD-DATE. DTSCSL8 01681 DTSCSL8 01682 MOVE MAP-CMPL-DATE-AREA TO L015-S-DATE-AREA. DTSCSL8 01683 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCSL8 01684 IF L015-VALID DTSCSL8 01685 IF L015-DATE NOT = ELOG-COMPLETE-DATE DTSCSL8 01686 MOVE L015-DATE TO ELOG-COMPLETE-DATE. DTSCSL8 01687 DTSCSL8 01688 IF MAP-BOX-NO EQUAL LOW-VALUES OR SPACES DTSCSL8 01689 NEXT SENTENCE DTSCSL8 01690 ELSE DTSCSL8 01691 IF MAP-BOX-NO NOT = ELOG-BOX-NO DTSCSL8 01692 MOVE MAP-BOX-NO TO ELOG-BOX-NO. DTSCSL8 01693 DTSCSL8 01694 IF MAP-ORIG-VOL EQUAL LOW-VALUES OR SPACES DTSCSL8 01695 NEXT SENTENCE DTSCSL8 01696 ELSE DTSCSL8 01697 IF MAP-ORIG-VOL NOT = ELOG-ORIG-VOL DTSCSL8 01698 MOVE MAP-ORIG-VOL TO ELOG-ORIG-VOL. DTSCSL8 01699 DTSCSL8 01700 IF WRK-SCR-HOLD-NEW-ELF NOT = ZERO DTSCSL8 01701 IF WRK-SCR-HOLD-NEW-ELF NOT = ELOG-ELF-ID DTSCSL8 01702 MOVE WRK-SCR-HOLD-NEW-ELF TO ELOG-ELF-ID DTSCSL8 01703 END-IF DTSCSL8 01704 IF WRK-SCR-HOLD-NEW-TYPE NOT = ELOG-DATA-TYPE-CD DTSCSL8 01705 MOVE WRK-SCR-HOLD-NEW-TYPE TO ELOG-DATA-TYPE-CD DTSCSL8 01706 END-IF DTSCSL8 01707 END-IF. DTSCSL8 01708 DTSCSL8 01709 MOVE LCCM-CURR-RUN-DATE TO ELOG-CHNG-DATE. DTSCSL8 01710 MOVE LCCM-OP-ID TO ELOG-CHNG-OPID. DTSCSL8 01711 DTSCSL8 01712 MOVE ELOG-REC TO ESKL-REC. DTSCSL8 01713 PERFORM S835-REWRITE THRU S835-EXIT. DTSCSL8 01714 DTSCSL8 01715 P8210-EXIT. DTSCSL8 01716 EXIT. DTSCSL8 01717 DTSCSL8 01718 P8800-LOCK-ELECTRONIC-FILER. DTSCSL8 01719 DTSCSL8 01720 MOVE WRK-ELF-ID TO L222-ELF-ID. DTSCSL8 01721 MOVE WRK-DATA-TYPE-CD TO L222-DATA-TYPE-CD. DTSCSL8 01722 MOVE LCCM-SCR-ABSTIME TO L222-SCR-ABSTIME. DTSCSL8 01723 MOVE LCCM-TASK-ID TO L222-UPDATE-TASK-ID. DTSCSL8 01724 MOVE LCCM-OP-ID TO L222-UPDATE-OP-ID. DTSCSL8 01725 MOVE LCCM-CICS-TERM-ID TO L222-UPDATE-TERMID. DTSCSL8 01726 MOVE LCCM-TASK-NETNAME TO L222-UPDATE-NETNAME. DTSCSL8 01727 MOVE LCCM-TASK-START-DATE TO L222-UPDATE-START-DATE. DTSCSL8 01728 MOVE LCCM-TASK-START-TIME TO L222-UPDATE-START-TIME. DTSCSL8 01729 MOVE WRK-SCR-ID TO L222-UPDATE-SCR-ID. DTSCSL8 01730 PERFORM S222-ELF-LOCK THRU S222-EXIT. DTSCSL8 01731 DTSCSL8 01732 P8800-EXIT. DTSCSL8 01733 EXIT. DTSCSL8 01734 DTSCSL8 01735 /*****************************************************************DTSCSL8 01736 * CHECK DATA IN LCCM-SCR-HOLD-AREA. THE TABLE CONTAINS AIX KEYS DTSCSL8 01737 * REPRESENTING EACH LINE DISPLAYED. THIS PARAGRAPH IS CALLED DTSCSL8 01738 * FROM P3000, P4000, P6000. DTSCSL8 01739 ******************************************************************DTSCSL8 01740 P9000-CHECK-LCCM-SCR-HOLD. DTSCSL8 01741 MOVE LCCM-SCR-HOLD-AREA TO WRK-SCR-HOLD-AREA DTSCSL8 01742 IF WRK-SCR-HOLD-PROG-NAME = WRK-MOD-NAME DTSCSL8 01743 NEXT SENTENCE DTSCSL8 01744 ELSE DTSCSL8 01745 GO TO P9000-EXIT. DTSCSL8 01746 DTSCSL8 01747 MOVE WRK-SCR-HOLD-ORIG-ELF TO WRK-ORIG-ELF. DTSCSL8 01748 MOVE WRK-SCR-HOLD-ORIG-TYPE TO WRK-ORIG-TYPE. DTSCSL8 01749 DTSCSL8 01750 IF WRK-SCR-HOLD-LOG-NO = ZEROS DTSCSL8 01751 NEXT SENTENCE DTSCSL8 01752 ELSE DTSCSL8 01753 PERFORM P9100-GET-LOG-NO THRU P9100-EXIT DTSCSL8 01754 END-IF. DTSCSL8 01755 DTSCSL8 01756 IF WRK-SCR-HOLD-IESR = LOW-VALUES DTSCSL8 01757 NEXT SENTENCE DTSCSL8 01758 ELSE DTSCSL8 01759 PERFORM P9200-GET-IESR THRU P9200-EXIT DTSCSL8 01760 END-IF. DTSCSL8 01761 DTSCSL8 01762 IF WRK-SCR-HOLD-MSG-KEY-CTR > ZERO DTSCSL8 01763 MOVE WRK-SCR-HOLD-MSG-KEY (1) TO WRK-STARTING-MSG-KEY DTSCSL8 01764 MOVE WRK-SCR-HOLD-MSG-KEY (WRK-SCR-HOLD-MSG-KEY-CTR) DTSCSL8 01765 TO WRK-ENDING-MSG-KEY DTSCSL8 01766 END-IF. DTSCSL8 01767 DTSCSL8 01768 P9000-EXIT. DTSCSL8 01769 EXIT. DTSCSL8 01770 DTSCSL8 01771 P9100-GET-LOG-NO. DTSCSL8 01772 MOVE WRK-SCR-HOLD-LOG-NO TO WRK-LOG-NO. DTSCSL8 01773 PERFORM S1080-READ-ELOG THRU S1080-EXIT DTSCSL8 01774 IF LCCM-MSG DTSCSL8 01775 NEXT SENTENCE DTSCSL8 01776 ELSE DTSCSL8 01777 SET WRK-KEY-FOUND-ELOG TO TRUE DTSCSL8 01778 END-IF. DTSCSL8 01779 DTSCSL8 01780 P9100-EXIT. DTSCSL8 01781 EXIT. DTSCSL8 01782 DTSCSL8 01783 P9200-GET-IESR. DTSCSL8 01784 MOVE WRK-SCR-HOLD-IESR TO ISKL-KEY-AREA. DTSCSL8 01785 IF ISKL-ESR-88 DTSCSL8 01786 PERFORM S821-START-BROWSE THRU S821-EXIT DTSCSL8 01787 IF L821-NO-REC-88 DTSCSL8 01788 MOVE LOW-VALUES TO WRK-IESR-KEY DTSCSL8 01789 ELSE DTSCSL8 01790 PERFORM P9210-SET-KEY THRU P9210-EXIT DTSCSL8 01791 END-IF DTSCSL8 01792 ELSE DTSCSL8 01793 MOVE LOW-VALUES TO WRK-IESR-KEY DTSCSL8 01794 END-IF. DTSCSL8 01795 DTSCSL8 01796 IF WRK-KEY-FOUND-IESR DTSCSL8 01797 MOVE IESR-LOG-NO TO WRK-LOG-NO DTSCSL8 01798 PERFORM S1080-READ-ELOG THRU S1080-EXIT DTSCSL8 01799 IF LCCM-MSG DTSCSL8 01800 PERFORM S1099-AIX-ERROR THRU S1099-EXIT DTSCSL8 01801 END-IF DTSCSL8 01802 END-IF. DTSCSL8 01803 DTSCSL8 01804 P9200-EXIT. DTSCSL8 01805 EXIT. DTSCSL8 01806 DTSCSL8 01807 P9210-SET-KEY. DTSCSL8 01808 SET WRK-KEY-FOUND-IESR TO TRUE. DTSCSL8 01809 MOVE ISKL-KEY-AREA TO WRK-IESR-KEY DTSCSL8 01810 IESR-REC. DTSCSL8 01811 DTSCSL8 01812 MOVE IESR-ELF-ID TO WRK-ELF-ID. DTSCSL8 01813 MOVE IESR-DATA-TYPE-CD TO WRK-DATA-TYPE-CD. DTSCSL8 01814 DTSCSL8 01815 P9210-EXIT. DTSCSL8 01816 EXIT. DTSCSL8 01817 DTSCSL8 01818 P9500-REQUEST-NEW-MSG. DTSCSL8 01819 SET LCCM-SCR-ADD-EMSG TO TRUE. DTSCSL8 01820 DTSCSL8 01821 PERFORM DTSCSL8 01822 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 01823 UNTIL WRK-SUB > MAX-LINES DTSCSL8 01824 MOVE LOW-VALUE TO MAP-MSG-TYPE (WRK-SUB) DTSCSL8 01825 MAP-MESSAGE (WRK-SUB) DTSCSL8 01826 MAP-MSG-OPID (WRK-SUB) DTSCSL8 01827 END-PERFORM. DTSCSL8 01828 DTSCSL8 01829 PERFORM S5500-SET-NEW-MSG-ATTRB THRU S5500-EXIT. DTSCSL8 01830 DTSCSL8 01831 SET CURSOR-SET-YES TO TRUE. DTSCSL8 01832 DTSCSL8 01833 MOVE CATB-CURSOR TO MAP-MESSAGE-L (1). DTSCSL8 01834 DTSCSL8 01835 SET RESP-SEND-MAP TO TRUE. DTSCSL8 01836 DTSCSL8 01837 P9500-EXIT. DTSCSL8 01838 EXIT. DTSCSL8 01839 DTSCSL8 01840 /*****************************************************************DTSCSL8 01841 * LINKS TO UTILITY MODULES DTSCSL8 01842 ******************************************************************DTSCSL8 01843 DTSCSL8 01844 S005-ABSTIME. DTSCSL8 01845 EXEC CICS DTSCSL8 01846 ASKTIME DTSCSL8 01847 ABSTIME(L005-ABSTIME) DTSCSL8 01848 END-EXEC. DTSCSL8 01849 S005-EXIT. DTSCSL8 01850 EXIT. DTSCSL8 01851 DTSCSL8 01852 S013-COUNT-FROM-SCREEN. DTSCSL8 01853 EXEC CICS LINK DTSCSL8 01854 PROGRAM('DTSCU013') DTSCSL8 01855 COMMAREA(L013-COMM-AREA) DTSCSL8 01856 END-EXEC. DTSCSL8 01857 S013-EXIT. DTSCSL8 01858 EXIT. DTSCSL8 01859 DTSCSL8 01860 S015-DATE-FROM-SCREEN. DTSCSL8 01861 EXEC CICS LINK DTSCSL8 01862 PROGRAM('DTSCU015') DTSCSL8 01863 COMMAREA(L015-COMM-AREA) DTSCSL8 01864 END-EXEC. DTSCSL8 01865 S015-EXIT. DTSCSL8 01866 EXIT. DTSCSL8 01867 DTSCSL8 01868 S018-ELF-ID-FROM-SCREEN. DTSCSL8 01869 EXEC CICS LINK DTSCSL8 01870 PROGRAM('DTSCU018') DTSCSL8 01871 COMMAREA(L018-COMM-AREA) DTSCSL8 01872 END-EXEC. DTSCSL8 01873 S018-EXIT. DTSCSL8 01874 EXIT. DTSCSL8 01875 DTSCSL8 01876 S041-ELEC-MEDIA-CODES. DTSCSL8 01877 EXEC CICS LINK DTSCSL8 01878 PROGRAM('DTSCU041') DTSCSL8 01879 COMMAREA(L041-COMM-AREA) DTSCSL8 01880 END-EXEC. DTSCSL8 01881 S041-EXIT. DTSCSL8 01882 EXIT. DTSCSL8 01883 DTSCSL8 01884 S222-ELF-LOCK. DTSCSL8 01885 SET L222-START-UPDATE TO TRUE. DTSCSL8 01886 GO TO S222-ELF-LOCK-UNLOCK. DTSCSL8 01887 DTSCSL8 01888 S222-ELF-UNLOCK. DTSCSL8 01889 SET L222-END-UPDATE TO TRUE. DTSCSL8 01890 GO TO S222-ELF-LOCK-UNLOCK. DTSCSL8 01891 DTSCSL8 01892 S222-ELF-LOCK-UNLOCK. DTSCSL8 01893 EXEC CICS LINK DTSCSL8 01894 PROGRAM ('DTSCU222') DTSCSL8 01895 COMMAREA (L222-COMM-AREA) DTSCSL8 01896 END-EXEC. DTSCSL8 01897 DTSCSL8 01898 IF L222-FILE-CLOSED DTSCSL8 01899 MOVE L222-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 01900 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 01901 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 01902 GO TO MAINLINE-EXIT. DTSCSL8 01903 DTSCSL8 01904 IF L222-END-UPDATE DTSCSL8 01905 AND DTSCSL8 01906 L222-NO-REC DTSCSL8 01907 GO TO S222-EXIT. DTSCSL8 01908 DTSCSL8 01909 IF L222-NOT-OK DTSCSL8 01910 MOVE L222-MSG-AREA TO LCCM-MSG-AREA. DTSCSL8 01911 DTSCSL8 01912 S222-EXIT. DTSCSL8 01913 EXIT. DTSCSL8 01914 DTSCSL8 01915 S357-LINK-PRINT. DTSCSL8 01916 SET L357-EJECT-PAGE-88 TO TRUE. DTSCSL8 01917 DTSCSL8 01918 EXEC CICS LINK DTSCSL8 01919 PROGRAM ('DTSCU357') DTSCSL8 01920 COMMAREA (L357-COMM-AREA) DTSCSL8 01921 END-EXEC. DTSCSL8 01922 S357-EXIT. DTSCSL8 01923 EXIT. DTSCSL8 01924 DTSCSL8 01925 S803-REQ-SCR-ID-EDIT. DTSCSL8 01926 EXEC CICS LINK DTSCSL8 01927 PROGRAM ('DTSCU803') DTSCSL8 01928 COMMAREA (DFHCOMMAREA) DTSCSL8 01929 END-EXEC. DTSCSL8 01930 S803-EXIT. DTSCSL8 01931 EXIT. DTSCSL8 01932 DTSCSL8 01933 S804-INVALID-KEY. DTSCSL8 01934 EXEC CICS LINK DTSCSL8 01935 PROGRAM ('DTSCU804') DTSCSL8 01936 COMMAREA (DFHCOMMAREA) DTSCSL8 01937 END-EXEC. DTSCSL8 01938 S804-EXIT. DTSCSL8 01939 EXIT. DTSCSL8 01940 DTSCSL8 01941 S805-MSG-AREA. DTSCSL8 01942 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCSL8 01943 DTSCSL8 01944 EXEC CICS LINK DTSCSL8 01945 PROGRAM ('DTSCU805') DTSCSL8 01946 COMMAREA (L805-COMM-AREA) DTSCSL8 01947 END-EXEC. DTSCSL8 01948 DTSCSL8 01949 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCSL8 01950 S805-EXIT. DTSCSL8 01951 EXIT. DTSCSL8 01952 EJECT DTSCSL8 01953 S810-READ. DTSCSL8 01954 SET L810-READ-88 TO TRUE. DTSCSL8 01955 GO TO S810-IO. DTSCSL8 01956 DTSCSL8 01957 S810-IO. DTSCSL8 01958 DTSCSL8 01959 EXEC CICS LINK DTSCSL8 01960 PROGRAM ('DTSCU810') DTSCSL8 01961 COMMAREA (L810-COMM-AREA) DTSCSL8 01962 END-EXEC. DTSCSL8 01963 DTSCSL8 01964 IF L810-FILE-CLOSED-88 DTSCSL8 01965 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 01966 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 01967 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 01968 GO TO MAINLINE-EXIT. DTSCSL8 01969 S810-EXIT. DTSCSL8 01970 EXIT. DTSCSL8 01971 EJECT DTSCSL8 01972 DTSCSL8 01973 S835-READ. DTSCSL8 01974 SET L835-READ-88 TO TRUE. DTSCSL8 01975 GO TO S835-IO. DTSCSL8 01976 DTSCSL8 01977 S835-READ-UPDATE. DTSCSL8 01978 SET L835-READ-UPDATE-88 TO TRUE. DTSCSL8 01979 GO TO S835-IO. DTSCSL8 01980 DTSCSL8 01981 S835-START-BROWSE. DTSCSL8 01982 SET L835-START-BROWSE-88 TO TRUE. DTSCSL8 01983 GO TO S835-IO. DTSCSL8 01984 DTSCSL8 01985 S835-READ-NEXT. DTSCSL8 01986 SET L835-READ-NEXT-88 TO TRUE. DTSCSL8 01987 GO TO S835-IO. DTSCSL8 01988 DTSCSL8 01989 S835-READ-PREV. DTSCSL8 01990 SET L835-READ-PREV-88 TO TRUE. DTSCSL8 01991 GO TO S835-IO. DTSCSL8 01992 DTSCSL8 01993 S835-END-BROWSE. DTSCSL8 01994 SET L835-END-BROWSE-88 TO TRUE. DTSCSL8 01995 GO TO S835-IO. DTSCSL8 01996 DTSCSL8 01997 S835-COUNT. DTSCSL8 01998 SET L835-COUNT-88 TO TRUE. DTSCSL8 01999 GO TO S835-IO. DTSCSL8 02000 DTSCSL8 02001 S835-REWRITE. DTSCSL8 02002 SET L835-REWRITE-88 TO TRUE. DTSCSL8 02003 GO TO S835-IO. DTSCSL8 02004 DTSCSL8 02005 S835-REWRITE-UPDATE. DTSCSL8 02006 SET L835-REWRITE-UPDATE-88 TO TRUE. DTSCSL8 02007 GO TO S835-IO. DTSCSL8 02008 DTSCSL8 02009 S835-WRITE. DTSCSL8 02010 SET L835-WRITE-88 TO TRUE. DTSCSL8 02011 GO TO S835-IO. DTSCSL8 02012 DTSCSL8 02013 S835-DELETE. DTSCSL8 02014 SET L835-DELETE-88 TO TRUE. DTSCSL8 02015 GO TO S835-IO. DTSCSL8 02016 DTSCSL8 02017 S835-IO. DTSCSL8 02018 DTSCSL8 02019 EXEC CICS LINK DTSCSL8 02020 PROGRAM ('DTSCU835') DTSCSL8 02021 COMMAREA (L835-COMM-AREA) DTSCSL8 02022 END-EXEC. DTSCSL8 02023 DTSCSL8 02024 IF L835-FILE-CLOSED-88 DTSCSL8 02025 MOVE L835-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 02026 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 02027 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 02028 GO TO MAINLINE-EXIT. DTSCSL8 02029 S835-EXIT. DTSCSL8 02030 EXIT. DTSCSL8 02031 EJECT DTSCSL8 02032 S821-START-BROWSE. DTSCSL8 02033 SET L821-START-BROWSE-88 TO TRUE. DTSCSL8 02034 GO TO S821-MASTER-IO. DTSCSL8 02035 DTSCSL8 02036 S821-END-BROWSE. DTSCSL8 02037 SET L821-END-BROWSE-88 TO TRUE. DTSCSL8 02038 GO TO S821-MASTER-IO. DTSCSL8 02039 DTSCSL8 02040 S821-READ-PREV. DTSCSL8 02041 SET L821-READ-PREV-88 TO TRUE. DTSCSL8 02042 GO TO S821-MASTER-IO. DTSCSL8 02043 DTSCSL8 02044 S821-READ-NEXT. DTSCSL8 02045 SET L821-READ-NEXT-88 TO TRUE. DTSCSL8 02046 GO TO S821-MASTER-IO. DTSCSL8 02047 DTSCSL8 02048 S821-MASTER-IO. DTSCSL8 02049 MOVE ISKL-KEY-AREA TO HOLD-ISKL-KEY-AREA. DTSCSL8 02050 DTSCSL8 02051 EXEC CICS LINK DTSCSL8 02052 PROGRAM ('DTSCU821') DTSCSL8 02053 COMMAREA (L821-COMM-AREA) DTSCSL8 02054 END-EXEC. DTSCSL8 02055 DTSCSL8 02056 IF L821-FILE-CLOSED-88 DTSCSL8 02057 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 02058 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 02059 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 02060 GO TO MAINLINE-EXIT. DTSCSL8 02061 * ELSE DTSCSL8 02062 * IF L821-OK-88 DTSCSL8 02063 * PERFORM S821A-SIMULATE-NO-REC THRU S821A-EXIT. DTSCSL8 02064 S821-EXIT. EXIT. DTSCSL8 02065 DTSCSL8 02066 *S821A-SIMULATE-NO-REC. DTSCSL8 02067 * IF L821-END-BROWSE-88 DTSCSL8 02068 * GO TO S821A-EXIT. DTSCSL8 02069 * DTSCSL8 02070 * IF (ISKL-ESR-88) DTSCSL8 02071 * IF (IESR-ELF-ID NOT = WRK-ELF-ID) DTSCSL8 02072 * SET L821-END-BROWSE-88 TO TRUE DTSCSL8 02073 * EXEC CICS LINK DTSCSL8 02074 * PROGRAM ('DTSCU821') DTSCSL8 02075 * COMMAREA (L821-COMM-AREA) DTSCSL8 02076 * END-EXEC DTSCSL8 02077 * MOVE HOLD-ISKL-KEY-AREA TO ISKL-KEY-AREA DTSCSL8 02078 * SET L821-NO-REC-88 TO TRUE. DTSCSL8 02079 *S821A-EXIT. EXIT. DTSCSL8 02080 DTSCSL8 02081 S851-SCREEN-PROCESSING. DTSCSL8 02082 EXEC CICS LINK DTSCSL8 02083 PROGRAM ('DTSCU851') DTSCSL8 02084 COMMAREA (L851-COMM-AREA) DTSCSL8 02085 END-EXEC. DTSCSL8 02086 S851-EXIT. DTSCSL8 02087 EXIT. DTSCSL8 02088 DTSCSL8 02089 S899-ABEND. DTSCSL8 02090 EXEC CICS ABEND DTSCSL8 02091 ABCODE(WRK-ABEND-CD) DTSCSL8 02092 END-EXEC. DTSCSL8 02093 S899-EXIT. DTSCSL8 02094 EXIT. DTSCSL8 02095 /*****************************************************************DTSCSL8 02096 * EDIT THE INFORMATION ON THE SCREEN. *DTSCSL8 02097 ******************************************************************DTSCSL8 02098 S1000-SCREEN-EDITS. DTSCSL8 02099 PERFORM S1100-NEW-ELF-ID-EDIT THRU S1100-EXIT. DTSCSL8 02100 IF LCCM-MSG DTSCSL8 02101 GO TO S1000-EXIT. DTSCSL8 02102 DTSCSL8 02103 PERFORM S1200-RCVD-DT-EDIT THRU S1200-EXIT. DTSCSL8 02104 PERFORM S1300-CMPL-DT-EDIT THRU S1300-EXIT. DTSCSL8 02105 PERFORM S1400-DATE-CROSS-EDIT THRU S1400-EXIT. DTSCSL8 02106 PERFORM S1500-BOX-NO-EDIT THRU S1500-EXIT. DTSCSL8 02107 PERFORM S1600-ORIG-VOL-EDIT THRU S1600-EXIT. DTSCSL8 02108 DTSCSL8 02109 S1000-EXIT. EXIT. DTSCSL8 02110 DTSCSL8 02111 /*****************************************************************DTSCSL8 02112 * EDIT THE INFORMATION ENTERED IN THE SEARCH FIELDS *DTSCSL8 02113 * FIRST, EDIT THE ELF ID AND DATA TYPE. EXIT WITH AN ERROR *DTSCSL8 02114 * MESSAGE IF EITHER IS INVALID. OTHERWISE, READ THE IEST *DTSCSL8 02115 * AIX RECORDS TO FIND THE LOG NUMBER. IF THE LOG RECORD IS *DTSCSL8 02116 * FOUND, SET WRK-KEY-FOUND-IESR TO TRUE. *DTSCSL8 02117 * DTSCSL8 02118 * IF THE USER HAS NOT ENTERED AN ELF ID OR DATA TYPE, EDIT *DTSCSL8 02119 * LOG NUMBER FIELD. EXIT WITH AN ERROR MESSAGE IF INVALID, *DTSCSL8 02120 * OTHERWISE, READ THE LOG RECORD. IF THE LOG RECORD IS *DTSCSL8 02121 * FOUND, SET WRK-KEY-FOUND-LOG TO TRUE. *DTSCSL8 02122 * DTSCSL8 02123 * IF THE USER DID NOT ENTER EITHER AN ELF ID OR A LOG NUMBER, *DTSCSL8 02124 * EXIT WITH AN ERROR MESSAGE. DTSCSL8 02125 * DTSCSL8 02126 * INPUT: DTSCSL8 02127 * WRK-ELF-ID DTSCSL8 02128 * WRK-DATA-TYPE-CD DTSCSL8 02129 * WRK-LOG-NO DTSCSL8 02130 * EITHER ELF ID OR LOG NUMBER MUST BE ENTERED. DTSCSL8 02131 * DTSCSL8 02132 * OUTPUT: DTSCSL8 02133 * WRK-IESR-KEY OR WRK-ELOG-KEY DTSCSL8 02134 * EITHER WRK-KEY-FOUND-IESR OR WRK-KEY-FOUND-LOG SET TO TRUE DTSCSL8 02135 * (ERROR MESSAGES IF EXPECTED RECORDS NOT FOUND) DTSCSL8 02136 * DTSCSL8 02137 ******************************************************************DTSCSL8 02138 S1001-SEARCH-KEY-EDITS. DTSCSL8 02139 MOVE ZERO TO WRK-ELF-ID DTSCSL8 02140 WRK-DATA-TYPE-CD DTSCSL8 02141 WRK-LOG-NO. DTSCSL8 02142 DTSCSL8 02143 PERFORM S1011-EDIT-ELF-ID THRU S1011-EXIT. DTSCSL8 02144 PERFORM S1012-EDIT-DATA-TYPE THRU S1012-EXIT. DTSCSL8 02145 IF LCCM-MSG DTSCSL8 02146 GO TO S1001-EXIT DTSCSL8 02147 ELSE DTSCSL8 02148 IF WRK-ELF-ID NOT = ZERO DTSCSL8 02149 PERFORM S1070-FIND-IESR THRU S1070-EXIT DTSCSL8 02150 ELSE DTSCSL8 02151 PERFORM S1013-EDIT-LOG-NO THRU S1013-EXIT DTSCSL8 02152 IF LCCM-MSG DTSCSL8 02153 GO TO S1001-EXIT DTSCSL8 02154 ELSE DTSCSL8 02155 IF WRK-LOG-NO = ZERO DTSCSL8 02156 PERFORM S1096-NOTHING-ENTERED THRU S1096-EXIT DTSCSL8 02157 END-IF DTSCSL8 02158 END-IF DTSCSL8 02159 END-IF. DTSCSL8 02160 DTSCSL8 02161 S1001-EXIT. DTSCSL8 02162 EXIT. DTSCSL8 02163 EJECT DTSCSL8 02164 /**************************************************************** DTSCSL8 02165 * EDIT ELF-ID DTSCSL8 02166 ***************************************************************** DTSCSL8 02167 S1011-EDIT-ELF-ID. DTSCSL8 02168 MOVE MAP-ELF-ID-AREA TO L018-S-EMP-NO-AREA. DTSCSL8 02169 PERFORM S018-ELF-ID-FROM-SCREEN THRU S018-EXIT. DTSCSL8 02170 DTSCSL8 02171 IF L018-NO-ENTRY DTSCSL8 02172 GO TO S1011-EXIT DTSCSL8 02173 ELSE DTSCSL8 02174 IF L018-NOT-VALID DTSCSL8 02175 PERFORM S1091-INVALID-ELF-ID THRU S1091-EXIT DTSCSL8 02176 ELSE DTSCSL8 02177 MOVE L018-EMP-NO TO WRK-ELF-ID DTSCSL8 02178 WRK-ORIG-ELF. DTSCSL8 02179 DTSCSL8 02180 S1011-EXIT. DTSCSL8 02181 EXIT. DTSCSL8 02182 DTSCSL8 02183 /**************************************************************** DTSCSL8 02184 * EDIT DATA TYPE DTSCSL8 02185 ***************************************************************** DTSCSL8 02186 S1012-EDIT-DATA-TYPE. DTSCSL8 02187 IF MAP-DATA-TYPE-CD = LOW-VALUES OR SPACES DTSCSL8 02188 MOVE LOW-VALUES TO MAP-DATA-TYPE-CD DTSCSL8 02189 GO TO S1012-EXIT. DTSCSL8 02190 DTSCSL8 02191 MOVE MAP-DATA-TYPE-CD TO L041-CD-2. DTSCSL8 02192 SET L041-EPRF-DATA-TYPE-CD TO TRUE. DTSCSL8 02193 PERFORM S041-ELEC-MEDIA-CODES THRU S041-EXIT. DTSCSL8 02194 IF L041-VALID DTSCSL8 02195 MOVE L041-LONG-DSCR TO MAP-DATA-TYPE-DSCR DTSCSL8 02196 MOVE MAP-DATA-TYPE-CD TO WRK-DATA-TYPE-CD DTSCSL8 02197 WRK-ORIG-TYPE DTSCSL8 02198 ELSE DTSCSL8 02199 PERFORM S1092-INVALID-DATA-TYPE THRU S1092-EXIT DTSCSL8 02200 END-IF. DTSCSL8 02201 DTSCSL8 02202 S1012-EXIT. DTSCSL8 02203 EXIT. DTSCSL8 02204 DTSCSL8 02205 /**************************************************************** DTSCSL8 02206 * EDIT LOG NUMBER DTSCSL8 02207 ***************************************************************** DTSCSL8 02208 S1013-EDIT-LOG-NO. DTSCSL8 02209 IF MAP-LOG-NO = LOW-VALUES OR SPACES DTSCSL8 02210 GO TO S1013-EXIT DTSCSL8 02211 ELSE DTSCSL8 02212 MOVE +1 TO L013-MIN-CNT DTSCSL8 02213 MOVE +999999 TO L013-MAX-CNT DTSCSL8 02214 MOVE MAP-LOG-NO TO L013-S-CNT DTSCSL8 02215 PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT DTSCSL8 02216 IF L013-NO-ENTRY DTSCSL8 02217 OR L013-NOT-VALID DTSCSL8 02218 PERFORM S1094-INVALID-LOG-NO THRU S1094-EXIT DTSCSL8 02219 ELSE DTSCSL8 02220 MOVE L013-CNT TO WRK-LOG-NO-SFX DTSCSL8 02221 END-IF DTSCSL8 02222 END-IF. DTSCSL8 02223 DTSCSL8 02224 IF LCCM-MSG DTSCSL8 02225 GO TO S1013-EXIT. DTSCSL8 02226 DTSCSL8 02227 MOVE LOW-VALUE TO IEAL-REC. DTSCSL8 02228 SET IEAL-EAL-88 TO TRUE. DTSCSL8 02229 MOVE WRK-LOG-NO-SFX TO IEAL-LOG-NO-SFX. DTSCSL8 02230 MOVE ZERO TO IEAL-LOG-NO. DTSCSL8 02231 MOVE IEAL-REC TO ISKL-REC. DTSCSL8 02232 DTSCSL8 02233 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCSL8 02234 IF L821-OK-88 DTSCSL8 02235 MOVE ISKL-REC TO IEAL-REC DTSCSL8 02236 IF IEAL-LOG-NO-SFX = WRK-LOG-NO-SFX DTSCSL8 02237 MOVE IEAL-LOG-NO TO WRK-LOG-NO DTSCSL8 02238 PERFORM S1080-READ-ELOG THRU S1080-EXIT DTSCSL8 02239 IF LCCM-MSG DTSCSL8 02240 GO TO S1013-EXIT DTSCSL8 02241 ELSE DTSCSL8 02242 SET WRK-KEY-FOUND-ELOG TO TRUE DTSCSL8 02243 END-IF DTSCSL8 02244 ELSE DTSCSL8 02245 PERFORM S1095-LOG-NOT-FOUND THRU S1095-EXIT DTSCSL8 02246 END-IF DTSCSL8 02247 ELSE DTSCSL8 02248 PERFORM S1095-LOG-NOT-FOUND THRU S1095-EXIT DTSCSL8 02249 END-IF. DTSCSL8 02250 DTSCSL8 02251 S1013-EXIT. DTSCSL8 02252 EXIT. DTSCSL8 02253 DTSCSL8 02254 /**************************************************************** DTSCSL8 02255 * FIND LOG NUMBER BY USING ELF-ID. DTSCSL8 02256 * READ IESR AIX RECORD. IF IESR FOUND WITH CORRECT LOG NUMBER DTSCSL8 02257 * (AND DATA TYPE CODE, IF ENTERED), READ ELOG. DTSCSL8 02258 * DTSCSL8 02259 * INPUT: DTSCSL8 02260 * WRK-ELF-ID (REQUIRED) DTSCSL8 02261 * WRK-DATA-TYPE-CD (OPTIONAL) DTSCSL8 02262 * DTSCSL8 02263 * OUTPUT: DTSCSL8 02264 * WRK-IESR-KEY DTSCSL8 02265 * WRK-KEY-FOUND-IESR SET TO TRUE DTSCSL8 02266 * (ERROR MESSAGES IF EXPECTED RECORDS NOT FOUND) DTSCSL8 02267 * DTSCSL8 02268 ***************************************************************** DTSCSL8 02269 S1070-FIND-IESR. DTSCSL8 02270 MOVE LOW-VALUE TO IESR-REC. DTSCSL8 02271 SET IESR-ESR-88 TO TRUE. DTSCSL8 02272 MOVE WRK-ELF-ID TO IESR-ELF-ID. DTSCSL8 02273 MOVE ZERO TO IESR-RCVD-DATE-XOR DTSCSL8 02274 IESR-DATA-TYPE-CD DTSCSL8 02275 IESR-LOG-NO. DTSCSL8 02276 MOVE IESR-REC TO ISKL-REC. DTSCSL8 02277 DTSCSL8 02278 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCSL8 02279 IF L821-OK-88 DTSCSL8 02280 MOVE ISKL-REC TO IESR-REC DTSCSL8 02281 IF IESR-ELF-ID = WRK-ELF-ID DTSCSL8 02282 IF WRK-DATA-TYPE-CD NOT = ZERO DTSCSL8 02283 PERFORM S1071-FIND-DATA-TYPE THRU S1071-EXIT DTSCSL8 02284 ELSE DTSCSL8 02285 MOVE IESR-REC TO WRK-IESR-KEY DTSCSL8 02286 MOVE IESR-LOG-NO TO WRK-LOG-NO DTSCSL8 02287 END-IF DTSCSL8 02288 ELSE DTSCSL8 02289 PERFORM S1093-ELF-NOT-FOUND THRU S1093-EXIT DTSCSL8 02290 END-IF DTSCSL8 02291 ELSE DTSCSL8 02292 PERFORM S1093-ELF-NOT-FOUND THRU S1093-EXIT DTSCSL8 02293 END-IF. DTSCSL8 02294 DTSCSL8 02295 IF LCCM-MSG DTSCSL8 02296 GO TO S1070-EXIT DTSCSL8 02297 ELSE DTSCSL8 02298 PERFORM S1072-READ-ELOG THRU S1072-EXIT DTSCSL8 02299 IF LCCM-MSG DTSCSL8 02300 GO TO S1070-EXIT DTSCSL8 02301 ELSE DTSCSL8 02302 SET WRK-KEY-FOUND-IESR TO TRUE DTSCSL8 02303 PERFORM S1085-READ-EPRF THRU S1085-EXIT DTSCSL8 02304 END-IF DTSCSL8 02305 END-IF. DTSCSL8 02306 DTSCSL8 02307 S1070-EXIT. DTSCSL8 02308 EXIT. DTSCSL8 02309 DTSCSL8 02310 S1071-FIND-DATA-TYPE. DTSCSL8 02311 IF IESR-DATA-TYPE-CD = WRK-DATA-TYPE-CD DTSCSL8 02312 MOVE IESR-REC TO WRK-IESR-KEY DTSCSL8 02313 MOVE IESR-LOG-NO TO WRK-ELOG-KEY DTSCSL8 02314 ELSE DTSCSL8 02315 SET WRK-IESR-FOUND-NO TO TRUE DTSCSL8 02316 PERFORM S1071A-SCAN-IESR THRU S1071A-EXIT DTSCSL8 02317 UNTIL WRK-IESR-FOUND-YES DTSCSL8 02318 OR WRK-IESR-NO-REC DTSCSL8 02319 IF WRK-IESR-NO-REC DTSCSL8 02320 PERFORM S1093-ELF-NOT-FOUND THRU S1093-EXIT DTSCSL8 02321 END-IF DTSCSL8 02322 END-IF. DTSCSL8 02323 DTSCSL8 02324 S1071-EXIT. DTSCSL8 02325 EXIT. DTSCSL8 02326 DTSCSL8 02327 S1071A-SCAN-IESR. DTSCSL8 02328 PERFORM S821-READ-NEXT THRU S821-EXIT. DTSCSL8 02329 IF L821-OK-88 DTSCSL8 02330 MOVE ISKL-REC TO IESR-REC DTSCSL8 02331 IF IESR-ELF-ID = WRK-ELF-ID DTSCSL8 02332 IF WRK-DATA-TYPE-CD = WRK-DATA-TYPE-CD DTSCSL8 02333 SET WRK-IESR-FOUND-YES TO TRUE DTSCSL8 02334 MOVE IESR-REC TO WRK-IESR-KEY DTSCSL8 02335 MOVE IESR-LOG-NO TO WRK-ELOG-KEY DTSCSL8 02336 ELSE DTSCSL8 02337 NEXT SENTENCE DTSCSL8 02338 END-IF DTSCSL8 02339 ELSE DTSCSL8 02340 SET WRK-IESR-NO-REC TO TRUE DTSCSL8 02341 END-IF DTSCSL8 02342 ELSE DTSCSL8 02343 SET WRK-IESR-NO-REC TO TRUE DTSCSL8 02344 END-IF. DTSCSL8 02345 DTSCSL8 02346 S1071A-EXIT. DTSCSL8 02347 EXIT. DTSCSL8 02348 DTSCSL8 02349 S1072-READ-ELOG. DTSCSL8 02350 MOVE LOW-VALUE TO ELOG-REC. DTSCSL8 02351 SET ELOG-LOG-88 TO TRUE. DTSCSL8 02352 MOVE WRK-LOG-NO TO ELOG-LOG-NO. DTSCSL8 02353 MOVE ELOG-REC TO ESKL-REC. DTSCSL8 02354 DTSCSL8 02355 PERFORM S835-READ THRU S835-EXIT. DTSCSL8 02356 IF L835-NO-REC-88 DTSCSL8 02357 MOVE ZERO TO WRK-ELOG-KEY DTSCSL8 02358 PERFORM S1099-AIX-ERROR THRU S1099-EXIT DTSCSL8 02359 ELSE DTSCSL8 02360 MOVE ESKL-REC TO ELOG-REC DTSCSL8 02361 MOVE ELOG-LOG-NO TO WRK-ELOG-KEY DTSCSL8 02362 MOVE ELOG-ELF-ID TO WRK-ELF-ID DTSCSL8 02363 MOVE ELOG-DATA-TYPE-CD TO WRK-DATA-TYPE-CD DTSCSL8 02364 PERFORM S1085-READ-EPRF THRU S1085-EXIT DTSCSL8 02365 END-IF. DTSCSL8 02366 DTSCSL8 02367 S1072-EXIT. DTSCSL8 02368 EXIT. DTSCSL8 02369 DTSCSL8 02370 /**************************************************************** DTSCSL8 02371 * USER HAS ENTERED A LOG NUMBER. FIND ELOG RECORD. DTSCSL8 02372 * S1013 HAS READ THE IEAL AIX RECORD TO FIND THE DTSCSL8 02373 * COMPLETE LOG NUMBER, AND PLACED IT IN WRK-LOG-NO. DTSCSL8 02374 * USE WRK-LOG-NO TO READ ELOG RECORD. DTSCSL8 02375 * DTSCSL8 02376 * INPUT: DTSCSL8 02377 * WRK-LOG-NO (REQUIRED) DTSCSL8 02378 * DTSCSL8 02379 * OUTPUT: DTSCSL8 02380 * WRK-ELOG-KEY DTSCSL8 02381 * (ERROR MESSAGES IF EXPECTED RECORDS NOT FOUND) DTSCSL8 02382 * DTSCSL8 02383 ***************************************************************** DTSCSL8 02384 S1080-READ-ELOG. DTSCSL8 02385 MOVE LOW-VALUES TO ELOG-REC. DTSCSL8 02386 SET ELOG-LOG-88 TO TRUE. DTSCSL8 02387 MOVE WRK-LOG-NO TO ELOG-LOG-NO. DTSCSL8 02388 MOVE ELOG-REC TO ESKL-REC. DTSCSL8 02389 DTSCSL8 02390 PERFORM S835-READ THRU S835-EXIT. DTSCSL8 02391 IF L835-NO-REC-88 DTSCSL8 02392 PERFORM S1095-LOG-NOT-FOUND THRU S1095-EXIT DTSCSL8 02393 ELSE DTSCSL8 02394 MOVE ESKL-REC TO ELOG-REC DTSCSL8 02395 MOVE ELOG-LOG-NO TO WRK-ELOG-KEY DTSCSL8 02396 MOVE ELOG-ELF-ID TO WRK-ELF-ID DTSCSL8 02397 MOVE ELOG-DATA-TYPE-CD TO WRK-DATA-TYPE-CD DTSCSL8 02398 END-IF. DTSCSL8 02399 DTSCSL8 02400 PERFORM S1085-READ-EPRF THRU S1085-EXIT. DTSCSL8 02401 DTSCSL8 02402 S1080-EXIT. DTSCSL8 02403 EXIT. DTSCSL8 02404 DTSCSL8 02405 ******************************************************************DTSCSL8 02406 * SET UP READ OF EPRF RECORD USING WRK-ELF-ID AND DTSCSL8 02407 * WRK-DATA-TYPE-CD. DTSCSL8 02408 ******************************************************************DTSCSL8 02409 S1085-READ-EPRF. DTSCSL8 02410 MOVE LOW-VALUES TO EPRF-KEY-AREA. DTSCSL8 02411 MOVE WRK-ELF-ID TO EPRF-ELF-ID. DTSCSL8 02412 MOVE WRK-DATA-TYPE-CD TO EPRF-DATA-TYPE-CD. DTSCSL8 02413 SET EPRF-PRF-88 TO TRUE. DTSCSL8 02414 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DTSCSL8 02415 PERFORM S835-READ THRU S835-EXIT. DTSCSL8 02416 DTSCSL8 02417 IF L835-NO-REC-88 DTSCSL8 02418 MOVE WRK-ELF-ID TO MSG-ELF-ID-IN-ERR DTSCSL8 02419 MOVE MSG-EL83-AREA TO LCCM-MSG-AREA DTSCSL8 02420 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 02421 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 02422 SET WRK-FATAL-ERROR-YES TO TRUE DTSCSL8 02423 GO TO S1085-EXIT. DTSCSL8 02424 DTSCSL8 02425 MOVE ESKL-REC TO EPRF-REC. DTSCSL8 02426 DTSCSL8 02427 IF NOT WRK-ELF-ID-EXTERNAL-88 DTSCSL8 02428 PERFORM S1086-READ-MPRF THRU S1086-EXIT. DTSCSL8 02429 DTSCSL8 02430 S1085-EXIT. DTSCSL8 02431 EXIT. DTSCSL8 02432 DTSCSL8 02433 ******************************************************************DTSCSL8 02434 * READ MPRF RECORD FOR EMPLOYER PRIMARY NAME DTSCSL8 02435 ******************************************************************DTSCSL8 02436 S1086-READ-MPRF. DTSCSL8 02437 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCSL8 02438 MOVE WRK-ELF-ID TO MPRF-EMP-NO. DTSCSL8 02439 SET MPRF-PRF-88 TO TRUE. DTSCSL8 02440 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCSL8 02441 PERFORM S810-READ THRU S810-EXIT. DTSCSL8 02442 DTSCSL8 02443 IF L810-NO-REC-88 DTSCSL8 02444 MOVE WRK-ELF-ID TO MSG-ELF-ID-IN-ERR DTSCSL8 02445 MOVE MSG-EL83-AREA TO LCCM-MSG-AREA DTSCSL8 02446 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCSL8 02447 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCSL8 02448 SET WRK-FATAL-ERROR-YES TO TRUE DTSCSL8 02449 GO TO S1086-EXIT. DTSCSL8 02450 DTSCSL8 02451 MOVE MSKL-REC TO MPRF-REC. DTSCSL8 02452 DTSCSL8 02453 S1086-EXIT. DTSCSL8 02454 EXIT. DTSCSL8 02455 DTSCSL8 02456 /**************************************************************** DTSCSL8 02457 * INVALID ELF-ID ENTERED ERROR DTSCSL8 02458 ***************************************************************** DTSCSL8 02459 S1091-INVALID-ELF-ID. DTSCSL8 02460 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02461 MAP-ELF-ID-2-A. DTSCSL8 02462 DTSCSL8 02463 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02464 DTSCSL8 02465 IF LCCM-NO-MSG DTSCSL8 02466 MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA DTSCSL8 02467 MOVE CATB-CURSOR TO MAP-ELF-ID-1-L. DTSCSL8 02468 DTSCSL8 02469 S1091-EXIT. DTSCSL8 02470 EXIT. DTSCSL8 02471 DTSCSL8 02472 /**************************************************************** DTSCSL8 02473 * INVALID DATA TYPE CODE ENTERED ERROR DTSCSL8 02474 ***************************************************************** DTSCSL8 02475 S1092-INVALID-DATA-TYPE. DTSCSL8 02476 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DATA-TYPE-CD-A. DTSCSL8 02477 DTSCSL8 02478 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02479 DTSCSL8 02480 IF LCCM-NO-MSG DTSCSL8 02481 MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA DTSCSL8 02482 MOVE CATB-CURSOR TO MAP-DATA-TYPE-CD-L. DTSCSL8 02483 DTSCSL8 02484 S1092-EXIT. DTSCSL8 02485 EXIT. DTSCSL8 02486 DTSCSL8 02487 /**************************************************************** DTSCSL8 02488 * ELECTRONIC FILER NOT FOUND DTSCSL8 02489 ***************************************************************** DTSCSL8 02490 S1093-ELF-NOT-FOUND. DTSCSL8 02491 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02492 MAP-ELF-ID-2-A. DTSCSL8 02493 DTSCSL8 02494 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02495 DTSCSL8 02496 IF LCCM-NO-MSG DTSCSL8 02497 MOVE EMSG-SEARCH-CRITERIA TO LCCM-MSG-ID DTSCSL8 02498 PERFORM S5200-SET-CLEAR-ATTRB THRU S5200-EXIT DTSCSL8 02499 MOVE CATB-CURSOR TO MAP-ELF-ID-1-L. DTSCSL8 02500 DTSCSL8 02501 S1093-EXIT. DTSCSL8 02502 EXIT. DTSCSL8 02503 DTSCSL8 02504 /**************************************************************** DTSCSL8 02505 * INVALID LOG NUMBER ENTERED ERROR DTSCSL8 02506 ***************************************************************** DTSCSL8 02507 S1094-INVALID-LOG-NO. DTSCSL8 02508 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LOG-NO-A. DTSCSL8 02509 DTSCSL8 02510 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02511 DTSCSL8 02512 IF LCCM-NO-MSG DTSCSL8 02513 MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA DTSCSL8 02514 MOVE CATB-CURSOR TO MAP-LOG-NO-L. DTSCSL8 02515 DTSCSL8 02516 S1094-EXIT. DTSCSL8 02517 EXIT. DTSCSL8 02518 DTSCSL8 02519 /**************************************************************** DTSCSL8 02520 * LOG RECORD NOT FOUND DTSCSL8 02521 ***************************************************************** DTSCSL8 02522 S1095-LOG-NOT-FOUND. DTSCSL8 02523 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LOG-NO-A. DTSCSL8 02524 DTSCSL8 02525 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02526 DTSCSL8 02527 IF LCCM-NO-MSG DTSCSL8 02528 MOVE EMSG-NO-RECORD TO LCCM-MSG-AREA DTSCSL8 02529 MOVE CATB-CURSOR TO MAP-LOG-NO-L. DTSCSL8 02530 DTSCSL8 02531 S1095-EXIT. DTSCSL8 02532 EXIT. DTSCSL8 02533 DTSCSL8 02534 S1096-NOTHING-ENTERED. DTSCSL8 02535 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02536 MAP-ELF-ID-2-A. DTSCSL8 02537 DTSCSL8 02538 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02539 DTSCSL8 02540 IF LCCM-NO-MSG DTSCSL8 02541 MOVE EMSG-FIELD-NOT-VALID TO LCCM-MSG-AREA DTSCSL8 02542 MOVE CATB-CURSOR TO MAP-ELF-ID-1-L. DTSCSL8 02543 DTSCSL8 02544 S1096-EXIT. DTSCSL8 02545 EXIT. DTSCSL8 02546 DTSCSL8 02547 /**************************************************************** DTSCSL8 02548 * ALTERNATE INDEX ERROR DTSCSL8 02549 ***************************************************************** DTSCSL8 02550 S1099-AIX-ERROR. DTSCSL8 02551 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-LOG-NO-A. DTSCSL8 02552 DTSCSL8 02553 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02554 DTSCSL8 02555 IF LCCM-NO-MSG DTSCSL8 02556 MOVE EMSG-NO-RECORD TO LCCM-MSG-AREA DTSCSL8 02557 MOVE CATB-CURSOR TO MAP-LOG-NO-L. DTSCSL8 02558 DTSCSL8 02559 S1099-EXIT. DTSCSL8 02560 EXIT. DTSCSL8 02561 DTSCSL8 02562 /**************************************************************** DTSCSL8 02563 * EDIT NEW ELF-ID DTSCSL8 02564 ***************************************************************** DTSCSL8 02565 S1100-NEW-ELF-ID-EDIT. DTSCSL8 02566 MOVE ZERO TO WRK-ELF-ID DTSCSL8 02567 WRK-DATA-TYPE-CD DTSCSL8 02568 WRK-LOG-NO. DTSCSL8 02569 DTSCSL8 02570 PERFORM S1011-EDIT-ELF-ID THRU S1011-EXIT. DTSCSL8 02571 IF LCCM-MSG DTSCSL8 02572 GO TO S1100-EXIT. DTSCSL8 02573 DTSCSL8 02574 PERFORM S1012-EDIT-DATA-TYPE THRU S1012-EXIT. DTSCSL8 02575 IF LCCM-MSG DTSCSL8 02576 GO TO S1100-EXIT. DTSCSL8 02577 DTSCSL8 02578 IF ELOG-ELF-ID NOT = WRK-ELF-ID DTSCSL8 02579 OR ELOG-DATA-TYPE-CD NOT = WRK-DATA-TYPE-CD DTSCSL8 02580 IF WRK-DATA-TYPE-CD = ZERO DTSCSL8 02581 PERFORM S1101-INVALID-DATA-TYPE THRU S1101-EXIT DTSCSL8 02582 GO TO S1100-EXIT DTSCSL8 02583 ELSE DTSCSL8 02584 PERFORM S1110-READ-EPRF THRU S1110-EXIT DTSCSL8 02585 END-IF DTSCSL8 02586 ELSE DTSCSL8 02587 MOVE ELOG-ELF-ID TO WRK-ELF-ID DTSCSL8 02588 MOVE ELOG-DATA-TYPE-CD TO WRK-DATA-TYPE-CD DTSCSL8 02589 END-IF. DTSCSL8 02590 DTSCSL8 02591 S1100-EXIT. DTSCSL8 02592 EXIT. DTSCSL8 02593 DTSCSL8 02594 /**************************************************************** DTSCSL8 02595 * DATA TYPE CODE MISSING ERROR DTSCSL8 02596 ***************************************************************** DTSCSL8 02597 S1101-INVALID-DATA-TYPE. DTSCSL8 02598 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DATA-TYPE-CD-A. DTSCSL8 02599 DTSCSL8 02600 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02601 DTSCSL8 02602 IF LCCM-NO-MSG DTSCSL8 02603 MOVE EMSG-FIELD-REQUIRED TO LCCM-MSG-AREA DTSCSL8 02604 MOVE CATB-CURSOR TO MAP-DATA-TYPE-CD-L. DTSCSL8 02605 DTSCSL8 02606 S1101-EXIT. DTSCSL8 02607 EXIT. DTSCSL8 02608 DTSCSL8 02609 S1110-READ-EPRF. DTSCSL8 02610 MOVE LOW-VALUES TO EPRF-KEY-AREA. DTSCSL8 02611 MOVE WRK-ELF-ID TO EPRF-ELF-ID. DTSCSL8 02612 MOVE WRK-DATA-TYPE-CD TO EPRF-DATA-TYPE-CD. DTSCSL8 02613 SET EPRF-PRF-88 TO TRUE. DTSCSL8 02614 MOVE EPRF-KEY-AREA TO ESKL-KEY-AREA. DTSCSL8 02615 PERFORM S835-READ THRU S835-EXIT. DTSCSL8 02616 DTSCSL8 02617 IF L835-NO-REC-88 DTSCSL8 02618 MOVE WRK-ELF-ID TO MSG-ELF-ID-IN-ERR DTSCSL8 02619 PERFORM S1093-ELF-NOT-FOUND THRU S1093-EXIT DTSCSL8 02620 GO TO S1110-EXIT. DTSCSL8 02621 DTSCSL8 02622 MOVE ESKL-REC TO EPRF-REC. DTSCSL8 02623 MOVE EPRF-ELF-ID TO WRK-SCR-HOLD-NEW-ELF. DTSCSL8 02624 MOVE EPRF-DATA-TYPE-CD TO WRK-SCR-HOLD-NEW-TYPE. DTSCSL8 02625 DTSCSL8 02626 S1110-EXIT. DTSCSL8 02627 EXIT. DTSCSL8 02628 DTSCSL8 02629 S1200-RCVD-DT-EDIT. DTSCSL8 02630 MOVE ZEROS TO WRK-RCVD-DATE. DTSCSL8 02631 MOVE MAP-RCVD-DATE-AREA TO L015-S-DATE-AREA. DTSCSL8 02632 DTSCSL8 02633 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCSL8 02634 DTSCSL8 02635 IF L015-NO-ENTRY DTSCSL8 02636 GO TO S1200-EXIT DTSCSL8 02637 ELSE DTSCSL8 02638 IF L015-NOT-VALID DTSCSL8 02639 PERFORM S1201-RCVD-DT-ERROR THRU S1201-EXIT DTSCSL8 02640 ELSE DTSCSL8 02641 MOVE L015-DATE TO WRK-RCVD-DATE. DTSCSL8 02642 S1200-EXIT. DTSCSL8 02643 EXIT. DTSCSL8 02644 DTSCSL8 02645 S1201-RCVD-DT-ERROR. DTSCSL8 02646 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-RCVD-MO-A, DTSCSL8 02647 MAP-RCVD-DA-A, DTSCSL8 02648 MAP-RCVD-YR-A. DTSCSL8 02649 IF LCCM-NO-MSG DTSCSL8 02650 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 02651 MOVE CATB-CURSOR TO MAP-RCVD-MO-L DTSCSL8 02652 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02653 S1201-EXIT. DTSCSL8 02654 EXIT. DTSCSL8 02655 DTSCSL8 02656 S1300-CMPL-DT-EDIT. DTSCSL8 02657 MOVE ZEROS TO WRK-CMPL-DATE. DTSCSL8 02658 MOVE MAP-CMPL-DATE-AREA TO L015-S-DATE-AREA. DTSCSL8 02659 DTSCSL8 02660 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCSL8 02661 DTSCSL8 02662 IF L015-NO-ENTRY DTSCSL8 02663 GO TO S1300-EXIT DTSCSL8 02664 ELSE DTSCSL8 02665 IF L015-NOT-VALID DTSCSL8 02666 PERFORM S1301-CMPL-DT-ERROR THRU S1301-EXIT DTSCSL8 02667 ELSE DTSCSL8 02668 MOVE L015-DATE TO WRK-CMPL-DATE. DTSCSL8 02669 S1300-EXIT. DTSCSL8 02670 EXIT. DTSCSL8 02671 DTSCSL8 02672 S1301-CMPL-DT-ERROR. DTSCSL8 02673 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CMPL-MO-A DTSCSL8 02674 MAP-CMPL-DA-A DTSCSL8 02675 MAP-CMPL-YR-A. DTSCSL8 02676 IF LCCM-NO-MSG DTSCSL8 02677 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 02678 MOVE CATB-CURSOR TO MAP-CMPL-MO-L DTSCSL8 02679 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02680 S1301-EXIT. DTSCSL8 02681 EXIT. DTSCSL8 02682 DTSCSL8 02683 S1400-DATE-CROSS-EDIT. DTSCSL8 02684 IF WRK-CMPL-DATE < WRK-RCVD-DATE DTSCSL8 02685 *& ADD ERROR MESSAGE DTSCSL8 02686 PERFORM S1401-CROSS-EDIT-ERROR THRU S1401-EXIT. DTSCSL8 02687 DTSCSL8 02688 S1400-EXIT. DTSCSL8 02689 EXIT. DTSCSL8 02690 DTSCSL8 02691 S1401-CROSS-EDIT-ERROR. DTSCSL8 02692 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CMPL-MO-A DTSCSL8 02693 MAP-CMPL-DA-A DTSCSL8 02694 MAP-CMPL-YR-A. DTSCSL8 02695 IF LCCM-NO-MSG DTSCSL8 02696 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 02697 MOVE CATB-CURSOR TO MAP-CMPL-MO-L DTSCSL8 02698 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02699 S1401-EXIT. DTSCSL8 02700 EXIT. DTSCSL8 02701 DTSCSL8 02702 S1500-BOX-NO-EDIT. DTSCSL8 02703 IF MAP-BOX-NO EQUAL LOW-VALUES OR SPACES DTSCSL8 02704 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCSL8 02705 PERFORM S1501-BOX-NO-ERROR THRU S1501-EXIT DTSCSL8 02706 ELSE DTSCSL8 02707 MOVE MAP-BOX-NO TO WRK-BOX-NO. DTSCSL8 02708 S1500-EXIT. DTSCSL8 02709 EXIT. DTSCSL8 02710 DTSCSL8 02711 S1501-BOX-NO-ERROR. DTSCSL8 02712 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-BOX-NO-A. DTSCSL8 02713 DTSCSL8 02714 IF LCCM-NO-MSG DTSCSL8 02715 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCSL8 02716 MOVE CATB-CURSOR TO MAP-BOX-NO-L DTSCSL8 02717 SET CURSOR-SET-YES TO TRUE. DTSCSL8 02718 S1501-EXIT. DTSCSL8 02719 EXIT. DTSCSL8 02720 DTSCSL8 02721 S1600-ORIG-VOL-EDIT. DTSCSL8 02722 IF MAP-ORIG-VOL EQUAL LOW-VALUES OR SPACES DTSCSL8 02723 GO TO S1600-EXIT DTSCSL8 02724 ELSE DTSCSL8 02725 MOVE MAP-ORIG-VOL TO WRK-ORIG-VOL. DTSCSL8 02726 S1600-EXIT. DTSCSL8 02727 EXIT. DTSCSL8 02728 DTSCSL8 02729 S2000-MSG-EDITS. DTSCSL8 02730 PERFORM DTSCSL8 02731 VARYING WRK-SUB FROM 1 BY 1 DTSCSL8 02732 UNTIL WRK-SUB > MAX-LINES DTSCSL8 02733 INSPECT MAP-MESSAGE (WRK-SUB) DTSCSL8 02734 CONVERTING LOW-VALUE TO SPACE DTSCSL8 02735 END-PERFORM. DTSCSL8 02736 DTSCSL8 02737 S2000-EXIT. DTSCSL8 02738 EXIT. DTSCSL8 02739 DTSCSL8 02740 ******************************************************************DTSCSL8 02741 * SET ATTIBUTE BYTES TO LOCK SCREEN FOR UPDATE. PROTECT ALL *DTSCSL8 02742 * FIELDS EXCEPT GO TO. DTSCSL8 02743 ******************************************************************DTSCSL8 02744 S5100-SET-LOCK-ATTRB. DTSCSL8 02745 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02746 MAP-ELF-ID-2-A DTSCSL8 02747 MAP-DATA-TYPE-CD-A DTSCSL8 02748 MAP-DATA-TYPE-DSCR-A DTSCSL8 02749 MAP-LOG-NO-A DTSCSL8 02750 MAP-ELF-NAME-A DTSCSL8 02751 MAP-BOX-NO-A DTSCSL8 02752 MAP-RCVD-MO-A DTSCSL8 02753 MAP-RCVD-DA-A DTSCSL8 02754 MAP-RCVD-YR-A DTSCSL8 02755 MAP-CMPL-MO-A DTSCSL8 02756 MAP-CMPL-DA-A DTSCSL8 02757 MAP-CMPL-YR-A DTSCSL8 02758 MAP-BOX-NO-A DTSCSL8 02759 MAP-ORIG-VOL-A DTSCSL8 02760 MAP-CHNG-OPID-A DTSCSL8 02761 MAP-ESTB-MO-A DTSCSL8 02762 MAP-ESTB-DA-A DTSCSL8 02763 MAP-ESTB-YR-A DTSCSL8 02764 MAP-CHNG-MO-A DTSCSL8 02765 MAP-CHNG-DA-A DTSCSL8 02766 MAP-CHNG-YR-A DTSCSL8 02767 WRK-MAP-LINE-ATB. DTSCSL8 02768 DTSCSL8 02769 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL8 02770 DTSCSL8 02771 S5100-EXIT. DTSCSL8 02772 EXIT. DTSCSL8 02773 DTSCSL8 02774 ******************************************************************DTSCSL8 02775 * SET ATTIBUTE BYTES FOR SCREEN CLEAR REQUEST. THIS UNLOCKS THE *DTSCSL8 02776 * SEARCH CRITERIA FIELDS WHICH ARE PROTECTED WHEN REQ-INQUIRE DTSCSL8 02777 * IS TRUE. DTSCSL8 02778 ******************************************************************DTSCSL8 02779 S5200-SET-CLEAR-ATTRB. DTSCSL8 02780 *&* SET ELF-ID, TYPE, LOG-NO TO UNPROTECTED DTSCSL8 02781 *&* SET RCVD DT, COMPLETE DT, BOX NO, ORIG VOL TO ASKIP. DTSCSL8 02782 *&* DTSCSL8 02783 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02784 MAP-ELF-ID-2-A DTSCSL8 02785 MAP-DATA-TYPE-CD-A DTSCSL8 02786 MAP-LOG-NO-A. DTSCSL8 02787 DTSCSL8 02788 MOVE CATB-ASKIP-NORM-MDTON TO MAP-RCVD-MO-A DTSCSL8 02789 MAP-RCVD-DA-A DTSCSL8 02790 MAP-RCVD-YR-A DTSCSL8 02791 MAP-CMPL-MO-A DTSCSL8 02792 MAP-CMPL-DA-A DTSCSL8 02793 MAP-CMPL-YR-A DTSCSL8 02794 MAP-DATA-TYPE-DSCR-A DTSCSL8 02795 MAP-BOX-NO-A DTSCSL8 02796 MAP-ORIG-VOL-A DTSCSL8 02797 MAP-ESTB-MO-A DTSCSL8 02798 MAP-ESTB-DA-A DTSCSL8 02799 MAP-ESTB-YR-A DTSCSL8 02800 MAP-CHNG-MO-A DTSCSL8 02801 MAP-CHNG-DA-A DTSCSL8 02802 MAP-CHNG-YR-A DTSCSL8 02803 MAP-CHNG-OPID-A. DTSCSL8 02804 DTSCSL8 02805 MOVE CATB-ASKIP-BRT-MDTON TO WRK-MAP-LINE-ATB. DTSCSL8 02806 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL8 02807 DTSCSL8 02808 S5200-EXIT. DTSCSL8 02809 EXIT. DTSCSL8 02810 DTSCSL8 02811 ******************************************************************DTSCSL8 02812 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCSL8 02813 * WHILE AN INQUIRY IS IN PROGRESS, THE SEARCH CRITERIA FIELDS DTSCSL8 02814 * ARE PROTECTED. THE USER MUST CLEAR THE SCREEN TO CHANGE THE DTSCSL8 02815 * SEARCH CRITERIA. DTSCSL8 02816 ******************************************************************DTSCSL8 02817 S5300-SET-INQ-ATTRB. DTSCSL8 02818 *&* SET ELF-ID, TYPE, LOG-NO TO ASKIP DTSCSL8 02819 *&* SET RCVD DT, COMPLETE DT, BOX NO, ORIG VOL TO UNPROTECTED DTSCSL8 02820 *&* DTSCSL8 02821 MOVE CATB-ASKIP-NORM-MDTON TO MAP-LOG-NO-A DTSCSL8 02822 MAP-ESTB-MO-A DTSCSL8 02823 MAP-ESTB-DA-A DTSCSL8 02824 MAP-ESTB-YR-A DTSCSL8 02825 MAP-CHNG-MO-A DTSCSL8 02826 MAP-CHNG-DA-A DTSCSL8 02827 MAP-CHNG-YR-A DTSCSL8 02828 MAP-CHNG-OPID-A. DTSCSL8 02829 DTSCSL8 02830 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02831 MAP-ELF-ID-2-A DTSCSL8 02832 MAP-DATA-TYPE-CD-A DTSCSL8 02833 MAP-RCVD-MO-A DTSCSL8 02834 MAP-RCVD-DA-A DTSCSL8 02835 MAP-RCVD-YR-A DTSCSL8 02836 MAP-CMPL-MO-A DTSCSL8 02837 MAP-CMPL-DA-A DTSCSL8 02838 MAP-CMPL-YR-A DTSCSL8 02839 MAP-BOX-NO-A DTSCSL8 02840 MAP-ORIG-VOL-A. DTSCSL8 02841 DTSCSL8 02842 MOVE CATB-ASKIP-BRT-MDTON TO WRK-MAP-LINE-ATB. DTSCSL8 02843 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL8 02844 S5300-EXIT. DTSCSL8 02845 EXIT. DTSCSL8 02846 DTSCSL8 02847 ******************************************************************DTSCSL8 02848 * SET ATTRIBUTE BYTES FOR UPDATE STATUS *DTSCSL8 02849 * WHILE AN UPDATE IS IN PROGRESS, THE SEARCH CRITERIA FIELDS DTSCSL8 02850 * AND THE FIELDS AT THE BOTTOM OF THE SCREEN THAT IDENTIFY THE DTSCSL8 02851 * SUBMITTER THE BOX NBR AND RECEIVED DATE MUST BE PROTECTED. DTSCSL8 02852 * THE ATTRIBUTE FOR ANY ENTRIES DISPLAYED WILL BE CHANGED FROM DTSCSL8 02853 * BRIGHT TO NORMAL. ONLY THE LINE SELECTED WILL BE BRIGHT. DTSCSL8 02854 ******************************************************************DTSCSL8 02855 S5400-SET-UPDATE-ATTRB. DTSCSL8 02856 *&* BUILD PARAGRAPH. DTSCSL8 02857 *&* SET ELF-ID, NAME, LINE NBR, BOX NBR, RCVD DT TO ASKIP DTSCSL8 02858 DTSCSL8 02859 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02860 MAP-ELF-ID-2-A DTSCSL8 02861 MAP-ELF-NAME-A DTSCSL8 02862 MAP-DATA-TYPE-CD-A DTSCSL8 02863 MAP-DATA-TYPE-DSCR-A DTSCSL8 02864 MAP-BOX-NO-A DTSCSL8 02865 MAP-ORIG-VOL-A DTSCSL8 02866 MAP-RCVD-MO-A DTSCSL8 02867 MAP-RCVD-DA-A DTSCSL8 02868 MAP-RCVD-YR-A DTSCSL8 02869 MAP-CMPL-MO-A DTSCSL8 02870 MAP-CMPL-DA-A DTSCSL8 02871 MAP-CMPL-YR-A DTSCSL8 02872 MAP-ESTB-MO-A DTSCSL8 02873 MAP-ESTB-DA-A DTSCSL8 02874 MAP-ESTB-YR-A DTSCSL8 02875 MAP-CHNG-MO-A DTSCSL8 02876 MAP-CHNG-DA-A DTSCSL8 02877 MAP-CHNG-YR-A DTSCSL8 02878 MAP-CHNG-OPID-A DTSCSL8 02879 WRK-MAP-LINE-ATB. DTSCSL8 02880 DTSCSL8 02881 MOVE CATB-ASKIP-NORM-MDTON TO WRK-MAP-LINE-ATB. DTSCSL8 02882 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCSL8 02883 S5400-EXIT. DTSCSL8 02884 EXIT. DTSCSL8 02885 DTSCSL8 02886 ******************************************************************DTSCSL8 02887 * SET ATTRIBUTE BYTES FOR NEW MESSAGE STATUS. *DTSCSL8 02888 * THE MESSAGE LINES ARE CLEARED FOR DATA ENTRY. ALL OTHER DTSCSL8 02889 * FIELDS ARE PROTECTED. DTSCSL8 02890 ******************************************************************DTSCSL8 02891 S5500-SET-NEW-MSG-ATTRB. DTSCSL8 02892 DTSCSL8 02893 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ELF-ID-1-A DTSCSL8 02894 MAP-ELF-ID-2-A DTSCSL8 02895 MAP-DATA-TYPE-CD-A DTSCSL8 02896 MAP-DATA-TYPE-DSCR-A DTSCSL8 02897 MAP-LOG-NO-A DTSCSL8 02898 MAP-ELF-NAME-A DTSCSL8 02899 MAP-RCVD-MO-A DTSCSL8 02900 MAP-RCVD-DA-A DTSCSL8 02901 MAP-RCVD-YR-A DTSCSL8 02902 MAP-CMPL-MO-A DTSCSL8 02903 MAP-CMPL-DA-A DTSCSL8 02904 MAP-CMPL-YR-A DTSCSL8 02905 MAP-BOX-NO-A DTSCSL8 02906 MAP-ORIG-VOL-A DTSCSL8 02907 MAP-ESTB-MO-A DTSCSL8 02908 MAP-ESTB-DA-A DTSCSL8 02909 MAP-ESTB-YR-A DTSCSL8 02910 MAP-CHNG-MO-A DTSCSL8 02911 MAP-CHNG-DA-A DTSCSL8 02912 MAP-CHNG-YR-A DTSCSL8 02913 MAP-CHNG-OPID-A. DTSCSL8 02914 DTSCSL8 02915 MOVE CATB-UNPROT-NORM-AN-MDTON TO WRK-MAP-LINE-ATB. DTSCSL8 02916 PERFORM S5920-SET-ATTRB THRU S5920-EXIT. DTSCSL8 02917 S5500-EXIT. DTSCSL8 02918 EXIT. DTSCSL8 02919 DTSCSL8 02920 S5900-SET-ATTRB. DTSCSL8 02921 PERFORM S5910-TABLE THRU S5910-EXIT DTSCSL8 02922 VARYING WRK-CTR FROM 1 BY 1 DTSCSL8 02923 UNTIL WRK-CTR > MAX-LINES. DTSCSL8 02924 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCSL8 02925 S5900-EXIT. EXIT. DTSCSL8 02926 DTSCSL8 02927 S5910-TABLE. DTSCSL8 02928 MOVE WRK-MAP-LINE-ATB TO MAP-MSG-TYPE-A(WRK-CTR) DTSCSL8 02929 MAP-MESSAGE-A(WRK-CTR) DTSCSL8 02930 MAP-MSG-OPID-A(WRK-CTR). DTSCSL8 02931 S5910-EXIT. EXIT. DTSCSL8 02932 DTSCSL8 02933 S5920-SET-ATTRB. DTSCSL8 02934 PERFORM S5921-TABLE THRU S5921-EXIT DTSCSL8 02935 VARYING WRK-CTR FROM 1 BY 1 DTSCSL8 02936 UNTIL WRK-CTR > MAX-LINES. DTSCSL8 02937 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCSL8 02938 S5920-EXIT. EXIT. DTSCSL8 02939 DTSCSL8 02940 S5921-TABLE. DTSCSL8 02941 MOVE CATB-ASKIP-NORM-MDTOFF TO DTSCSL8 02942 MAP-MSG-TYPE-A(WRK-CTR) DTSCSL8 02943 MAP-MSG-OPID-A(WRK-CTR). DTSCSL8 02944 MOVE CATB-UNPROT-NORM-AN-MDTON TO DTSCSL8 02945 MAP-MESSAGE-A(WRK-CTR). DTSCSL8 02946 S5921-EXIT. EXIT. DTSCSL8 02947 DTSCSL8 02948 /*****************************************************************DTSCSL8 02949 * MAP ROUTINES *DTSCSL8 02950 ******************************************************************DTSCSL8 02951 S9100-RECEIVE. DTSCSL8 02952 SET L851-RECEIVE-88 TO TRUE. DTSCSL8 02953 DTSCSL8 02954 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCSL8 02955 DTSCSL8 02956 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL8 02957 DTSCSL8 02958 MOVE L851-AID TO LCCM-AID. DTSCSL8 02959 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCSL8 02960 S9100-EXIT. DTSCSL8 02961 EXIT. DTSCSL8 02962 DTSCSL8 02963 S9200-SEND-DATAONLY. DTSCSL8 02964 MOVE LOW-VALUES TO MAP-AREA. DTSCSL8 02965 DTSCSL8 02966 IF LCCM-NO-MSG DTSCSL8 02967 NEXT SENTENCE DTSCSL8 02968 ELSE DTSCSL8 02969 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL8 02970 DTSCSL8 02971 IF CURSOR-SET-GOTO DTSCSL8 02972 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCSL8 02973 ELSE DTSCSL8 02974 IF CURSOR-SET-NO DTSCSL8 02975 MOVE CATB-CURSOR TO MAP-ELF-ID-1-L. DTSCSL8 02976 DTSCSL8 02977 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCSL8 02978 DTSCSL8 02979 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL8 02980 DTSCSL8 02981 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL8 02982 S9200-EXIT. DTSCSL8 02983 EXIT. DTSCSL8 02984 DTSCSL8 02985 S9300-SEND-MAP. DTSCSL8 02986 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCSL8 02987 MOVE SPACES TO MAP-SYS-TIME. DTSCSL8 02988 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCSL8 02989 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCSL8 02990 DTSCSL8 02991 IF SCR-ACCESS-UPDATE DTSCSL8 02992 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCSL8 02993 ELSE DTSCSL8 02994 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL8 02995 DTSCSL8 02996 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCSL8 02997 DTSCSL8 02998 IF CURSOR-SET-NO DTSCSL8 02999 MOVE CATB-CURSOR TO MAP-ELF-ID-1-L. DTSCSL8 03000 DTSCSL8 03001 SET L851-SEND-88 TO TRUE. DTSCSL8 03002 DTSCSL8 03003 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCSL8 03004 DTSCSL8 03005 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCSL8 03006 S9300-EXIT. DTSCSL8 03007 EXIT. DTSCSL8 03008 DTSCSL8 03009 S9310-UPDATE-FKEYS. DTSCSL8 03010 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCSL8 03011 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCSL8 03012 IF LCCM-SCR-INQUIRE DTSCSL8 03013 MOVE FKEY-NEW-MSG TO MAP-KEY-SAVE-MSG DTSCSL8 03014 ELSE DTSCSL8 03015 IF LCCM-SCR-ADD-EMSG DTSCSL8 03016 MOVE FKEY-SAVE-MSG TO MAP-KEY-SAVE-MSG. DTSCSL8 03017 DTSCSL8 03018 S9310-EXIT. DTSCSL8 03019 EXIT. DTSCSL8 03020 DTSCSL8 03021 S9320-INQUIRY-FKEYS. DTSCSL8 03022 MOVE FKEY-MSG-BACK TO MAP-KEY-MSG-BACK. DTSCSL8 03023 MOVE FKEY-MSG-FWRD TO MAP-KEY-MSG-FWRD. DTSCSL8 03024 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCSL8 03025 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCSL8 03026 S9320-EXIT. DTSCSL8 03027 EXIT. DTSCSL8 03028 DTSCSL8 03029 S9900-PREPARE-SEND. DTSCSL8 03030 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCSL8 03031 LCCM-SCR-ID. DTSCSL8 03032 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCSL8 03033 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCSL8 03034 S9900-EXIT. DTSCSL8 03035 EXIT. DTSCSL8