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