3037 lines
237 KiB
COBOL
3037 lines
237 KiB
COBOL
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
|