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