844 lines
66 KiB
COBOL
844 lines
66 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/15/02
|
|
00002 PROGRAM-ID. DTSCS8A. DTSCS8A
|
|
00003 AUTHOR. TRW. LV003
|
|
00004 DATE-WRITTEN. OCT 2001. DTSCS8A
|
|
00005 DATE-COMPILED. DTSCS8A
|
|
00006 SKIP3 DTSCS8A
|
|
00007 ***** DTSCS8A
|
|
00008 * DTSCS8A
|
|
00009 * FUNCTION: ONLINE JOB REQUEST INQUIRY PROGRAM. DTSCS8A
|
|
00010 * DTSCS8A
|
|
00011 * DTSCS8A
|
|
00012 * MODIFICATION LOG: DTSCS8A
|
|
00013 * DTSCS8A
|
|
00014 * 11/20/01 INITIAL DEVELOPMENT. COPIED FROM DTSCS86 & 68 DTSCS8A
|
|
00015 * WORK ORDER: PROGRAMMER: JMO. DTSCS8A
|
|
00016 * DTSCS8A
|
|
00017 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS8A
|
|
00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS8A
|
|
00019 * WORK ORDER: PROGRAMMER: XXX DTSCS8A
|
|
00020 * DTSCS8A
|
|
00021 * DTSCS8A
|
|
00022 * DESCRIPTION: DTSCS8A
|
|
00023 * DTSCS8A
|
|
00024 * CLEAR: DTSCS8A
|
|
00025 * DTSCS8A
|
|
00026 * DATA FIELDS DISPLAYED: NONE. DTSCS8A
|
|
00027 * MESSAGE: NONE DTSCS8A
|
|
00028 * DTSCS8A
|
|
00029 * DTSCS8A
|
|
00030 * INQUIRY: DTSCS8A
|
|
00031 * DTSCS8A
|
|
00032 * CONTROL FIELD(S): BUSINESS AREA DTSCS8A
|
|
00033 * DTSCS8A
|
|
00034 * JUMP IN: USE CLEAR LOGIC. DTSCS8A
|
|
00035 * DTSCS8A
|
|
00036 * ENTER: DISPLAY ALL JOBS AVAILABLE FOR ONLINE SUBMISSION DTSCS8A
|
|
00037 * FIELDS. DTSCS8A
|
|
00038 * DTSCS8A
|
|
00039 * PRIOR: USING THE SUBSCRIPTS FROM THE COMMAREA DTSCS8A
|
|
00040 * DECREMENT SUB AND BUILD SCREEN DTSCS8A
|
|
00041 * DTSCS8A
|
|
00042 * NEXT: USING THE SUBSCRIPTS FROM THE COMMAREA DTSCS8A
|
|
00043 * INCREMENT SUB AND BUILD SCREEN DTSCS8A
|
|
00044 * DTSCS8A
|
|
00045 * DTSCS8A
|
|
00046 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS8A
|
|
00047 * DO NOT "WRAP" PAGING. DTSCS8A
|
|
00048 * DTSCS8A
|
|
00049 * DTSCS8A
|
|
00050 * DTSCS8A
|
|
00051 * UPDATE: DTSCS8A
|
|
00052 * DTSCS8A
|
|
00053 * NONE DTSCS8A
|
|
00054 * DTSCS8A
|
|
00055 * DTSCS8A
|
|
00056 * RECORDS READ: DTSCS8A
|
|
00057 * DTSCS8A
|
|
00058 * MASTER: DTSCS8A
|
|
00059 * DTSCS8A
|
|
00060 * NONE. DTSCS8A
|
|
00061 * DTSCS8A
|
|
00062 * DTSCS8A
|
|
00063 * ALTERNATE INDEX: DTSCS8A
|
|
00064 * DTSCS8A
|
|
00065 * NONE. DTSCS8A
|
|
00066 * DTSCS8A
|
|
00067 * DTSCS8A
|
|
00068 * REFERENCE: DTSCS8A
|
|
00069 * DTSCS8A
|
|
00070 * NONE. DTSCS8A
|
|
00071 * DTSCS8A
|
|
00072 * DTSCS8A
|
|
00073 * ACCOUNTING TRANSACTION COLLECTION: DTSCS8A
|
|
00074 * DTSCS8A
|
|
00075 * NONE. DTSCS8A
|
|
00076 * DTSCS8A
|
|
00077 * DTSCS8A
|
|
00078 * RECORDS UPDATED: DTSCS8A
|
|
00079 * DTSCS8A
|
|
00080 * MASTER: DTSCS8A
|
|
00081 * DTSCS8A
|
|
00082 * NONE. DTSCS8A
|
|
00083 * DTSCS8A
|
|
00084 * DTSCS8A
|
|
00085 * REFERENCE: DTSCS8A
|
|
00086 * DTSCS8A
|
|
00087 * NONE DTSCS8A
|
|
00088 * DTSCS8A
|
|
00089 * DTSCS8A
|
|
00090 * ACCOUNTING TRANSACTION COLLECTION: DTSCS8A
|
|
00091 * DTSCS8A
|
|
00092 * NONE. DTSCS8A
|
|
00093 * DTSCS8A
|
|
00094 * DTSCS8A
|
|
00095 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS8A
|
|
00096 * DTSCS8A
|
|
00097 * NONE. DTSCS8A
|
|
00098 * DTSCS8A
|
|
00099 * DTSCS8A
|
|
00100 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS8A
|
|
00101 * UTILITY MODULES) LINKED TO: DTSCS8A
|
|
00102 * DTSCS8A
|
|
00103 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. DTSCS8A
|
|
00104 * DTSCS8A
|
|
00105 * DTSCS8A
|
|
00106 * MAINTENANCE NOTES: DTSCS8A
|
|
00107 * DTSCS8A
|
|
00108 *3/21 MAX REPORTS = 52 DTSCS8A
|
|
00109 *6/12 MAX REPORTS = 20 DTSCS8A
|
|
00110 * LINES / PAGE = 12 DTSCS8A
|
|
00111 * REPORT INFO COMES FROM REDEFINED TABLE IN COPYBOOK DTSCS8A
|
|
00112 * DTSCS8A
|
|
00113 ***** DTSCS8A
|
|
00114 SKIP3 DTSCS8A
|
|
00115 ENVIRONMENT DIVISION. DTSCS8A
|
|
00116 EJECT DTSCS8A
|
|
00117 DATA DIVISION. DTSCS8A
|
|
00118 WORKING-STORAGE SECTION. DTSCS8A
|
|
001185 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS8A 08/15/02'. DTSCS8A
|
|
00119 DTSCS8A
|
|
00120 01 WRK-AREA. DTSCS8A
|
|
00121 05 WRK-ABEND-CD PIC X(04) VALUE 'S8A '. DTSCS8A
|
|
00122 DTSCS8A
|
|
00123 05 WRK-SCR-ID. DTSCS8A
|
|
00124 10 WRK-SCR-ID-X PIC X(02) VALUE '8A'. DTSCS8A
|
|
00125 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS8A
|
|
00126 05 WRK-REQ-PARM-SCR-ID PIC X(02) VALUE '8B'. DTSCS8A
|
|
00127 DTSCS8A
|
|
00128 05 WRK-MAX-REPORTS PIC 9(03) COMP-3 DTSCS8A
|
|
00129 VALUE 20. DTSCS8A
|
|
00130 DTSCS8A
|
|
00131 05 WRK-SLOTS-PER-SCREEN PIC S9(02) VALUE +12. DTSCS8A
|
|
00132 DTSCS8A
|
|
00133 05 WRK-JOB-NAME PIC X(08). DTSCS8A
|
|
00134 DTSCS8A
|
|
00135 05 WRK-MSG-AREA PIC X(64) VALUE SPACES. DTSCS8A
|
|
00136 SKIP1 DTSCS8A
|
|
00137 05 WRK-BUS-AREA PIC X(02). DTSCS8A
|
|
00138 DTSCS8A
|
|
00139 05 WRK-SCREEN-STATE PIC X(01). DTSCS8A
|
|
00140 88 WRK-SCREEN-FINI-88 VALUE 'Y'. DTSCS8A
|
|
00141 DTSCS8A
|
|
00142 05 WRK-DISP-STATE PIC X(01). DTSCS8A
|
|
00143 88 WRK-FIRST-PAGE-88 VALUE 'Y'. DTSCS8A
|
|
00144 DTSCS8A
|
|
00145 05 WRK-USE-FILTER PIC X(01). DTSCS8A
|
|
00146 88 WRK-USE-REPT-NAME-88 VALUE 'R'. DTSCS8A
|
|
00147 88 WRK-USE-BUS-AREA-88 VALUE 'B'. DTSCS8A
|
|
00148 DTSCS8A
|
|
00149 05 WRK-SUB PIC S9(04) COMP. DTSCS8A
|
|
00150 05 WRK-SUB-START PIC S9(04) COMP. DTSCS8A
|
|
00151 05 WRK-SUB-INCREMENTOR PIC S9(04) COMP. DTSCS8A
|
|
00152 05 WRK-SCREEN-SLOT PIC S9(04) COMP. DTSCS8A
|
|
00153 DTSCS8A
|
|
00154 EJECT DTSCS8A
|
|
00155 01 MSG-AREA. DTSCS8A
|
|
00156 05 MSG-E8A1-AREA. DTSCS8A
|
|
00157 10 FILLER PIC X(04) VALUE 'E8A1'. DTSCS8A
|
|
00158 10 FILLER PIC X(30) DTSCS8A
|
|
00159 VALUE 'LINE NUMBER SELECTED IS NOT VA'. DTSCS8A
|
|
00160 10 FILLER PIC X(30) DTSCS8A
|
|
00161 VALUE 'LID '. DTSCS8A
|
|
00162 EJECT DTSCS8A
|
|
00163 01 SCREEN-CONTROL. DTSCS8A
|
|
00164 05 SCR-ACCESS-IND PIC X(01). DTSCS8A
|
|
00165 88 SCR-ACCESS-INQ VALUE '1'. DTSCS8A
|
|
00166 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS8A
|
|
00167 SKIP1 DTSCS8A
|
|
00168 05 CURSOR-SET-IND PIC X(01). DTSCS8A
|
|
00169 88 CURSOR-SET-YES VALUE 'Y'. DTSCS8A
|
|
00170 88 CURSOR-SET-NO VALUE 'N'. DTSCS8A
|
|
00171 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS8A
|
|
00172 SKIP1 DTSCS8A
|
|
00173 05 REQ-IND PIC X(01). DTSCS8A
|
|
00174 88 REQ-ERROR VALUE 'O'. DTSCS8A
|
|
00175 88 REQ-JUMP VALUE 'J'. DTSCS8A
|
|
00176 88 REQ-INQUIRE VALUE 'I'. DTSCS8A
|
|
00177 88 REQ-CLEAR VALUE 'C'. DTSCS8A
|
|
00178 88 REQ-EDIT VALUE 'E'. DTSCS8A
|
|
00179 88 REQ-UPDATE VALUE 'U'. DTSCS8A
|
|
00180 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS8A
|
|
00181 SKIP1 DTSCS8A
|
|
00182 05 RESP-IND PIC X(01). DTSCS8A
|
|
00183 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS8A
|
|
00184 88 RESP-SEND-MAP VALUE 'M'. DTSCS8A
|
|
00185 88 RESP-JUMP VALUE 'J'. DTSCS8A
|
|
00186 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS8A
|
|
00187 SKIP1 DTSCS8A
|
|
00188 05 SCR-ATB-AN PIC X(01). DTSCS8A
|
|
00189 05 SCR-ATB-NUM PIC X(01). DTSCS8A
|
|
00190 EJECT DTSCS8A
|
|
00191 01 L001-COMM-AREA. DTSCS8A
|
|
00192 ++INCLUDE DTSIL001 DTSCS8A
|
|
00193 EJECT DTSCS8A
|
|
00194 01 L013-COMM-AREA. DTSCS8A
|
|
00195 ++INCLUDE DTSIL013 DTSCS8A
|
|
00196 EJECT DTSCS8A
|
|
00197 * ERROR MSG MODULE DTSCS8A
|
|
00198 01 L805-COMM-AREA. DTSCS8A
|
|
00199 ++INCLUDE DTSIL805 DTSCS8A
|
|
00200 EJECT DTSCS8A
|
|
00201 * REPORT INFO IN TABLE FORMAT DTSCS8A
|
|
00202 ++INCLUDE OJRIC089 DTSCS8A
|
|
00203 * MAP DEFINITION DTSCS8A
|
|
00204 01 L851-COMM-AREA. DTSCS8A
|
|
00205 ++INCLUDE DTSIL851 DTSCS8A
|
|
00206 SKIP3 DTSCS8A
|
|
00207 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS8A
|
|
00208 ++INCLUDE DTSIS8A DTSCS8A
|
|
00209 EJECT DTSCS8A
|
|
00210 * ATTRIBUTE LITERALS DTSCS8A
|
|
00211 01 CATB-LITERALS. DTSCS8A
|
|
00212 ++INCLUDE DTSICATB DTSCS8A
|
|
00213 SKIP3 DTSCS8A
|
|
00214 * FUNCTION KEY DESCRIPTION LITERALS DTSCS8A
|
|
00215 01 CFKD-LITERALS. DTSCS8A
|
|
00216 ++INCLUDE DTSICFKD DTSCS8A
|
|
00217 EJECT DTSCS8A
|
|
00218 * ERROR CODE MESSAGE LITERALS DTSCS8A
|
|
00219 01 CECD-LITERALS. DTSCS8A
|
|
00220 ++INCLUDE DTSICECD DTSCS8A
|
|
00221 SKIP3 DTSCS8A
|
|
00222 * PROMPT CODE MESSAGE LITERALS DTSCS8A
|
|
00223 01 CPCD-LITERALS. DTSCS8A
|
|
00224 ++INCLUDE DTSICPCD DTSCS8A
|
|
00225 EJECT DTSCS8A
|
|
00226 LINKAGE SECTION. DTSCS8A
|
|
00227 SKIP3 DTSCS8A
|
|
00228 01 DFHCOMMAREA. DTSCS8A
|
|
00229 ++INCLUDE DTSILCCM DTSCS8A
|
|
00230 SKIP3 DTSCS8A
|
|
00231 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS8A
|
|
00232 20 LCCM-REPORT-SUB PIC S9(04) COMP. DTSCS8A
|
|
00233 20 LCCM-BUS-AREA PIC X(02). DTSCS8A
|
|
00234 20 LCCM-PAGE-NUM PIC 9(02). DTSCS8A
|
|
00235 20 LCCM-SUBS-THIS-PAGE PIC S9(04) COMP DTSCS8A
|
|
00236 OCCURS 12 TIMES. DTSCS8A
|
|
00237 EJECT DTSCS8A
|
|
00238 ******************************************************************DTSCS8A
|
|
00239 * *DTSCS8A
|
|
00240 ******************************************************************DTSCS8A
|
|
00241 SKIP1 DTSCS8A
|
|
00242 PROCEDURE DIVISION. DTSCS8A
|
|
00243 SKIP2 DTSCS8A
|
|
00244 SET CURSOR-SET-NO TO TRUE. DTSCS8A
|
|
00245 SKIP1 DTSCS8A
|
|
00246 MOVE LOW-VALUES TO MAP-AREA. DTSCS8A
|
|
00247 SKIP1 DTSCS8A
|
|
00248 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS8A
|
|
00249 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCS8A
|
|
00250 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT DTSCS8A
|
|
00251 DTSCS8A
|
|
00252 INITIALIZE WRK-SUB DTSCS8A
|
|
00253 WRK-SUB-START DTSCS8A
|
|
00254 DTSCS8A
|
|
00255 MOVE SPACE TO REQ-IND DTSCS8A
|
|
00256 DTSCS8A
|
|
00257 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT DTSCS8A
|
|
00258 SKIP1 DTSCS8A
|
|
00259 *----------------------------------------------------- DTSCS8A
|
|
00260 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS8A
|
|
00261 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS8A
|
|
00262 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS8A
|
|
00263 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS8A
|
|
00264 * DTSCS8A
|
|
00265 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS8A
|
|
00266 * PROCESSED. DTSCS8A
|
|
00267 * DTSCS8A
|
|
00268 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS8A
|
|
00269 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS8A
|
|
00270 * WORK STATION OPERATOR. DTSCS8A
|
|
00271 *----------------------------------------------------- DTSCS8A
|
|
00272 SKIP1 DTSCS8A
|
|
00273 INITIALIZE RESP-IND DTSCS8A
|
|
00274 SKIP1 DTSCS8A
|
|
00275 EVALUATE TRUE DTSCS8A
|
|
00276 WHEN REQ-ERROR DTSCS8A
|
|
00277 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS8A
|
|
00278 WHEN REQ-JUMP DTSCS8A
|
|
00279 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS8A
|
|
00280 WHEN REQ-CLEAR DTSCS8A
|
|
00281 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS8A
|
|
00282 WHEN REQ-CURSOR-TO-GOTO DTSCS8A
|
|
00283 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS8A
|
|
00284 WHEN REQ-INQUIRE DTSCS8A
|
|
00285 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS8A
|
|
00286 WHEN OTHER DTSCS8A
|
|
00287 GO TO S899-ABEND DTSCS8A
|
|
00288 END-EVALUATE DTSCS8A
|
|
00289 SKIP3 DTSCS8A
|
|
00290 *----------------------------------------------------- DTSCS8A
|
|
00291 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS8A
|
|
00292 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS8A
|
|
00293 *----------------------------------------------------- DTSCS8A
|
|
00294 SKIP1 DTSCS8A
|
|
00295 EVALUATE TRUE DTSCS8A
|
|
00296 WHEN RESP-SEND-MAP DTSCS8A
|
|
00297 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS8A
|
|
00298 SET LCCM-END-TASK-88 TO TRUE DTSCS8A
|
|
00299 WHEN RESP-SEND-MSGONLY OR RESP-CURSOR-TO-GOTO DTSCS8A
|
|
00300 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS8A
|
|
00301 SET LCCM-END-TASK-88 TO TRUE DTSCS8A
|
|
00302 WHEN RESP-JUMP DTSCS8A
|
|
00303 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS8A
|
|
00304 WHEN OTHER DTSCS8A
|
|
00305 GO TO S899-ABEND DTSCS8A
|
|
00306 END-EVALUATE. DTSCS8A
|
|
00307 SKIP3 DTSCS8A
|
|
00308 MAINLINE-EXIT. DTSCS8A
|
|
00309 DTSCS8A
|
|
00310 EXEC CICS DTSCS8A
|
|
00311 RETURN DTSCS8A
|
|
00312 END-EXEC. DTSCS8A
|
|
00313 DTSCS8A
|
|
00314 GOBACK. DTSCS8A
|
|
00315 EJECT DTSCS8A
|
|
00316 DTSCS8A
|
|
00317 P0100-ACCESS-SEARCH. DTSCS8A
|
|
00318 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCS8A
|
|
00319 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS8A
|
|
00320 TO SCR-ACCESS-IND. DTSCS8A
|
|
00321 P0100-EXIT. DTSCS8A
|
|
00322 EXIT. DTSCS8A
|
|
00323 /*****************************************************************DTSCS8A
|
|
00324 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS8A
|
|
00325 ******************************************************************DTSCS8A
|
|
00326 P1000-ANALYZE-REQUEST. DTSCS8A
|
|
00327 SKIP1 DTSCS8A
|
|
00328 *----------------------------------------------------- DTSCS8A
|
|
00329 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS8A
|
|
00330 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS8A
|
|
00331 * REPLACED WITH ENTER) DTSCS8A
|
|
00332 *----------------------------------------------------- DTSCS8A
|
|
00333 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS8A
|
|
00334 SET LCCM-ENTER-88 TO TRUE DTSCS8A
|
|
00335 SET REQ-CLEAR TO TRUE DTSCS8A
|
|
00336 GO TO P1000-EXIT DTSCS8A
|
|
00337 END-IF DTSCS8A
|
|
00338 SKIP3 DTSCS8A
|
|
00339 *----------------------------------------------------- DTSCS8A
|
|
00340 * MAP IS RECEIVED DTSCS8A
|
|
00341 *----------------------------------------------------- DTSCS8A
|
|
00342 PERFORM S9100-RECEIVE THRU S9100-EXIT DTSCS8A
|
|
00343 SKIP3 DTSCS8A
|
|
00344 *----------------------------------------------------- DTSCS8A
|
|
00345 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS8A
|
|
00346 * WORK STATION DTSCS8A
|
|
00347 *----------------------------------------------------- DTSCS8A
|
|
00348 IF LCCM-CLEAR-88 DTSCS8A
|
|
00349 SET REQ-CLEAR TO TRUE DTSCS8A
|
|
00350 GO TO P1000-EXIT DTSCS8A
|
|
00351 END-IF DTSCS8A
|
|
00352 SKIP3 DTSCS8A
|
|
00353 *----------------------------------------------------- DTSCS8A
|
|
00354 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS8A
|
|
00355 *----------------------------------------------------- DTSCS8A
|
|
00356 IF LCCM-PA2-88 DTSCS8A
|
|
00357 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS8A
|
|
00358 GO TO P1000-EXIT DTSCS8A
|
|
00359 END-IF DTSCS8A
|
|
00360 SKIP3 DTSCS8A
|
|
00361 *----------------------------------------------------- DTSCS8A
|
|
00362 * IF F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS8A
|
|
00363 * REQUEST TO CLEAR THE SCREEN. DTSCS8A
|
|
00364 *----------------------------------------------------- DTSCS8A
|
|
00365 IF LCCM-F12-88 DTSCS8A
|
|
00366 MOVE LOW-VALUES TO MAP-AREA DTSCS8A
|
|
00367 SET REQ-CLEAR TO TRUE DTSCS8A
|
|
00368 GO TO P1000-EXIT DTSCS8A
|
|
00369 END-IF DTSCS8A
|
|
00370 SKIP3 DTSCS8A
|
|
00371 *----------------------------------------------------- DTSCS8A
|
|
00372 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS8A
|
|
00373 *----------------------------------------------------- DTSCS8A
|
|
00374 IF LCCM-PA-88 DTSCS8A
|
|
00375 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS8A
|
|
00376 SET REQ-ERROR TO TRUE DTSCS8A
|
|
00377 GO TO P1000-EXIT DTSCS8A
|
|
00378 END-IF DTSCS8A
|
|
00379 SKIP3 DTSCS8A
|
|
00380 *----------------------------------------------------- DTSCS8A
|
|
00381 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS8A
|
|
00382 *----------------------------------------------------- DTSCS8A
|
|
00383 IF LCCM-F03-88 DTSCS8A
|
|
00384 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS8A
|
|
00385 SET REQ-JUMP TO TRUE DTSCS8A
|
|
00386 GO TO P1000-EXIT DTSCS8A
|
|
00387 END-IF DTSCS8A
|
|
00388 SKIP3 DTSCS8A
|
|
00389 *----------------------------------------------------- DTSCS8A
|
|
00390 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS8A
|
|
00391 *----------------------------------------------------- DTSCS8A
|
|
00392 IF LCCM-F04-88 DTSCS8A
|
|
00393 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS8A
|
|
00394 SET REQ-JUMP TO TRUE DTSCS8A
|
|
00395 GO TO P1000-EXIT DTSCS8A
|
|
00396 END-IF DTSCS8A
|
|
00397 SKIP3 DTSCS8A
|
|
00398 *----------------------------------------------------- DTSCS8A
|
|
00399 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS8A
|
|
00400 * CORRESPONDENCE SCREEN DTSCS8A
|
|
00401 *----------------------------------------------------- DTSCS8A
|
|
00402 IF LCCM-F14-88 DTSCS8A
|
|
00403 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS8A
|
|
00404 SET REQ-JUMP TO TRUE DTSCS8A
|
|
00405 GO TO P1000-EXIT DTSCS8A
|
|
00406 END-IF DTSCS8A
|
|
00407 SKIP3 DTSCS8A
|
|
00408 *----------------------------------------------------- DTSCS8A
|
|
00409 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS8A
|
|
00410 * REQUESTED SCREEN TYPE DTSCS8A
|
|
00411 *----------------------------------------------------- DTSCS8A
|
|
00412 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS8A
|
|
00413 CONTINUE DTSCS8A
|
|
00414 ELSE DTSCS8A
|
|
00415 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS8A
|
|
00416 SET REQ-JUMP TO TRUE DTSCS8A
|
|
00417 GO TO P1000-EXIT DTSCS8A
|
|
00418 END-IF DTSCS8A
|
|
00419 SKIP3 DTSCS8A
|
|
00420 *----------------------------------------------------- DTSCS8A
|
|
00421 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS8A
|
|
00422 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS8A
|
|
00423 *----------------------------------------------------- DTSCS8A
|
|
00424 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS8A
|
|
00425 SET REQ-INQUIRE TO TRUE DTSCS8A
|
|
00426 GO TO P1000-EXIT DTSCS8A
|
|
00427 END-IF DTSCS8A
|
|
00428 SKIP3 DTSCS8A
|
|
00429 *----------------------------------------------------- DTSCS8A
|
|
00430 * ANY OTHER KEY IS INVALID DTSCS8A
|
|
00431 *----------------------------------------------------- DTSCS8A
|
|
00432 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS8A
|
|
00433 SET REQ-ERROR TO TRUE. DTSCS8A
|
|
00434 P1000-EXIT. DTSCS8A
|
|
00435 EXIT. DTSCS8A
|
|
00436 SKIP3 DTSCS8A
|
|
00437 /*****************************************************************DTSCS8A
|
|
00438 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS8A
|
|
00439 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS8A
|
|
00440 ******************************************************************DTSCS8A
|
|
00441 SKIP1 DTSCS8A
|
|
00442 P2000-REQUEST-ERROR. DTSCS8A
|
|
00443 IF LCCM-MSG DTSCS8A
|
|
00444 SET RESP-SEND-MSGONLY TO TRUE DTSCS8A
|
|
00445 ELSE DTSCS8A
|
|
00446 GO TO S899-ABEND DTSCS8A
|
|
00447 END-IF. DTSCS8A
|
|
00448 P2000-EXIT. DTSCS8A
|
|
00449 EXIT. DTSCS8A
|
|
00450 /*****************************************************************DTSCS8A
|
|
00451 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS8A
|
|
00452 ******************************************************************DTSCS8A
|
|
00453 SKIP1 DTSCS8A
|
|
00454 P3000-REQUEST-JUMP. DTSCS8A
|
|
00455 *----------------------------------------------------- DTSCS8A
|
|
00456 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS8A
|
|
00457 * BY USER DTSCS8A
|
|
00458 *----------------------------------------------------- DTSCS8A
|
|
00459 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS8A
|
|
00460 SKIP3 DTSCS8A
|
|
00461 *----------------------------------------------------- DTSCS8A
|
|
00462 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS8A
|
|
00463 *----------------------------------------------------- DTSCS8A
|
|
00464 IF LCCM-MSG DTSCS8A
|
|
00465 SET RESP-SEND-MSGONLY TO TRUE DTSCS8A
|
|
00466 SET CURSOR-SET-GOTO TO TRUE DTSCS8A
|
|
00467 GO TO P3000-EXIT DTSCS8A
|
|
00468 END-IF DTSCS8A
|
|
00469 SKIP3 DTSCS8A
|
|
00470 *----------------------------------------------------- DTSCS8A
|
|
00471 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS8A
|
|
00472 *----------------------------------------------------- DTSCS8A
|
|
00473 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS8A
|
|
00474 LCCM-SCR-HOLD-AREA DTSCS8A
|
|
00475 MOVE +0 TO LCCM-SCR-ABSTIME DTSCS8A
|
|
00476 SET RESP-JUMP TO TRUE. DTSCS8A
|
|
00477 P3000-EXIT. DTSCS8A
|
|
00478 EXIT. DTSCS8A
|
|
00479 /*****************************************************************DTSCS8A
|
|
00480 * CLEAR KEY WAS PRESSED *DTSCS8A
|
|
00481 ******************************************************************DTSCS8A
|
|
00482 SKIP1 DTSCS8A
|
|
00483 P4000-REQUEST-CLEAR. DTSCS8A
|
|
00484 *----------------------------------------------------- DTSCS8A
|
|
00485 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS8A
|
|
00486 * FIELDS FROM EARLIER REQUESTS DTSCS8A
|
|
00487 *----------------------------------------------------- DTSCS8A
|
|
00488 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA DTSCS8A
|
|
00489 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME DTSCS8A
|
|
00490 SET LCCM-SCR-CLEAR TO TRUE DTSCS8A
|
|
00491 SET RESP-SEND-MAP TO TRUE. DTSCS8A
|
|
00492 P4000-EXIT. DTSCS8A
|
|
00493 EXIT. DTSCS8A
|
|
00494 /*****************************************************************DTSCS8A
|
|
00495 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS8A
|
|
00496 ******************************************************************DTSCS8A
|
|
00497 SKIP1 DTSCS8A
|
|
00498 P5000-CURSOR-TO-GOTO. DTSCS8A
|
|
00499 SET CURSOR-SET-GOTO TO TRUE DTSCS8A
|
|
00500 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS8A
|
|
00501 P5000-EXIT. DTSCS8A
|
|
00502 EXIT. DTSCS8A
|
|
00503 /*****************************************************************DTSCS8A
|
|
00504 * INQUIRY WAS REQUESTED *DTSCS8A
|
|
00505 ******************************************************************DTSCS8A
|
|
00506 DTSCS8A
|
|
00507 P6000-REQUEST-INQUIRE. DTSCS8A
|
|
00508 *JMO BREAK UP INTO MULTIPLE PARAS DTSCS8A
|
|
00509 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME DTSCS8A
|
|
00510 DTSCS8A
|
|
00511 INSPECT MAP-BUS-AREA CONVERTING LOW-VALUE TO SPACES DTSCS8A
|
|
00512 IF MAP-BUS-AREA = SPACES DTSCS8A
|
|
00513 SET WRK-USE-REPT-NAME-88 TO TRUE DTSCS8A
|
|
00514 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L DTSCS8A
|
|
00515 SET CURSOR-SET-YES TO TRUE DTSCS8A
|
|
00516 ELSE DTSCS8A
|
|
00517 MOVE MAP-BUSINESS-AREA TO L013-S-CNT-AREA DTSCS8A
|
|
00518 MOVE +1 TO L013-MIN-CNT DTSCS8A
|
|
00519 MOVE +7 TO L013-MAX-CNT DTSCS8A
|
|
00520 PERFORM S013-SCREEN-COUNT THRU S013-EXIT DTSCS8A
|
|
00521 IF L013-VALID AND MAP-VALID-BUS-AREA DTSCS8A
|
|
00522 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L DTSCS8A
|
|
00523 SET CURSOR-SET-YES TO TRUE DTSCS8A
|
|
00524 SET WRK-USE-BUS-AREA-88 TO TRUE DTSCS8A
|
|
00525 IF MAP-BUS-AREA(1:1) = SPACES DTSCS8A
|
|
00526 MOVE ZERO TO MAP-BUS-AREA(1:1) DTSCS8A
|
|
00527 ELSE DTSCS8A
|
|
00528 IF MAP-BUS-AREA(2:1) = SPACES DTSCS8A
|
|
00529 MOVE MAP-BUS-AREA(1:1) TO MAP-BUS-AREA(2:1) DTSCS8A
|
|
00530 MOVE ZERO TO MAP-BUS-AREA(1:1) DTSCS8A
|
|
00531 END-IF DTSCS8A
|
|
00532 END-IF DTSCS8A
|
|
00533 ELSE DTSCS8A
|
|
00534 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS8A
|
|
00535 MOVE CATB-CURSOR TO MAP-BUS-AREA-L DTSCS8A
|
|
00536 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8A
|
|
00537 END-IF DTSCS8A
|
|
00538 END-IF DTSCS8A
|
|
00539 DTSCS8A
|
|
00540 IF LCCM-NO-MSG DTSCS8A
|
|
00541 IF MAP-BUS-AREA = LCCM-BUS-AREA DTSCS8A
|
|
00542 EVALUATE TRUE DTSCS8A
|
|
00543 WHEN LCCM-ENTER-88 DTSCS8A
|
|
00544 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS8A
|
|
00545 WHEN LCCM-F07-88 DTSCS8A
|
|
00546 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS8A
|
|
00547 WHEN LCCM-F08-88 DTSCS8A
|
|
00548 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS8A
|
|
00549 WHEN OTHER DTSCS8A
|
|
00550 GO TO S899-ABEND DTSCS8A
|
|
00551 END-EVALUATE DTSCS8A
|
|
00552 ELSE DTSCS8A
|
|
00553 SET LCCM-ENTER-88 TO TRUE DTSCS8A
|
|
00554 SET WRK-FIRST-PAGE-88 TO TRUE DTSCS8A
|
|
00555 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS8A
|
|
00556 END-IF DTSCS8A
|
|
00557 DTSCS8A
|
|
00558 IF LCCM-NO-MSG DTSCS8A
|
|
00559 IF LCCM-SCR-ID = LCCM-REQ-SCR-ID DTSCS8A
|
|
00560 PERFORM DTSCS8A
|
|
00561 VARYING WRK-SUB DTSCS8A
|
|
00562 FROM 1 BY 1 DTSCS8A
|
|
00563 UNTIL WRK-SUB > WRK-SLOTS-PER-SCREEN DTSCS8A
|
|
00564 MOVE 0 TO LCCM-SUBS-THIS-PAGE(WRK-SUB) DTSCS8A
|
|
00565 END-PERFORM DTSCS8A
|
|
00566 DTSCS8A
|
|
00567 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS8A
|
|
00568 ELSE DTSCS8A
|
|
00569 SET RESP-JUMP TO TRUE DTSCS8A
|
|
00570 GO TO P6000-EXIT DTSCS8A
|
|
00571 END-IF DTSCS8A
|
|
00572 END-IF DTSCS8A
|
|
00573 END-IF DTSCS8A
|
|
00574 DTSCS8A
|
|
00575 PERFORM S5900-SET-ATTRB THRU S5900-EXIT DTSCS8A
|
|
00576 SET RESP-SEND-MAP TO TRUE. DTSCS8A
|
|
00577 P6000-EXIT. DTSCS8A
|
|
00578 EXIT. DTSCS8A
|
|
00579 DTSCS8A
|
|
00580 P6100-NO-PAGE. DTSCS8A
|
|
00581 IF WRK-FIRST-PAGE-88 DTSCS8A
|
|
00582 MOVE +1 TO WRK-SUB-START DTSCS8A
|
|
00583 MOVE +1 TO WRK-SUB-INCREMENTOR DTSCS8A
|
|
00584 MOVE +1 TO WRK-SCREEN-SLOT DTSCS8A
|
|
00585 MOVE 1 TO LCCM-PAGE-NUM DTSCS8A
|
|
00586 PERFORM DTSCS8A
|
|
00587 VARYING WRK-SUB DTSCS8A
|
|
00588 FROM 1 BY 1 DTSCS8A
|
|
00589 UNTIL WRK-SUB > WRK-SLOTS-PER-SCREEN DTSCS8A
|
|
00590 MOVE SPACES TO MAP-LINE-DATA(WRK-SUB) DTSCS8A
|
|
00591 END-PERFORM DTSCS8A
|
|
00592 ELSE DTSCS8A
|
|
00593 IF MAP-SELECT-LINE-NO = SPACES OR LOW-VALUES DTSCS8A
|
|
00594 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L DTSCS8A
|
|
00595 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS8A
|
|
00596 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8A
|
|
00597 ELSE DTSCS8A
|
|
00598 MOVE MAP-SELECT-LINE-NO-AREA TO L013-S-CNT-AREA DTSCS8A
|
|
00599 MOVE +1 TO L013-MIN-CNT DTSCS8A
|
|
00600 MOVE +12 TO L013-MAX-CNT DTSCS8A
|
|
00601 PERFORM S013-SCREEN-COUNT THRU S013-EXIT DTSCS8A
|
|
00602 IF L013-VALID DTSCS8A
|
|
00603 MOVE L013-CNT TO MAP-SELECT-LINE-NO-N DTSCS8A
|
|
00604 PERFORM P6150-PROCESS-SELECTED-LINE THRU P6150-EXITDTSCS8A
|
|
00605 ELSE DTSCS8A
|
|
00606 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8A
|
|
00607 END-IF DTSCS8A
|
|
00608 END-IF DTSCS8A
|
|
00609 END-IF. DTSCS8A
|
|
00610 P6100-EXIT. DTSCS8A
|
|
00611 EXIT. DTSCS8A
|
|
00612 DTSCS8A
|
|
00613 P6150-PROCESS-SELECTED-LINE. DTSCS8A
|
|
00614 MOVE LCCM-SUBS-THIS-PAGE(MAP-SELECT-LINE-NO-N) DTSCS8A
|
|
00615 TO LCCM-REPORT-SUB DTSCS8A
|
|
00616 MOVE WRK-REQ-PARM-SCR-ID TO LCCM-REQ-SCR-ID. DTSCS8A
|
|
00617 P6150-EXIT. DTSCS8A
|
|
00618 EXIT. DTSCS8A
|
|
00619 DTSCS8A
|
|
00620 P6200-PAGE-BACK. DTSCS8A
|
|
00621 IF LCCM-PAGE-NUM > 1 DTSCS8A
|
|
00622 COMPUTE WRK-SUB-START = LCCM-SUBS-THIS-PAGE(1) - 1 DTSCS8A
|
|
00623 MOVE -1 TO WRK-SUB-INCREMENTOR DTSCS8A
|
|
00624 MOVE WRK-SLOTS-PER-SCREEN TO WRK-SCREEN-SLOT DTSCS8A
|
|
00625 COMPUTE LCCM-PAGE-NUM = LCCM-PAGE-NUM - 1 DTSCS8A
|
|
00626 ELSE DTSCS8A
|
|
00627 MOVE PMSG-FIRST-PAGE TO WRK-MSG-AREA DTSCS8A
|
|
00628 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8A
|
|
00629 END-IF. DTSCS8A
|
|
00630 P6200-EXIT. DTSCS8A
|
|
00631 EXIT. DTSCS8A
|
|
00632 DTSCS8A
|
|
00633 P6300-PAGE-NEXT. DTSCS8A
|
|
00634 IF LCCM-SUBS-THIS-PAGE(WRK-SLOTS-PER-SCREEN) > 0 DTSCS8A
|
|
00635 COMPUTE WRK-SUB-START = DTSCS8A
|
|
00636 LCCM-SUBS-THIS-PAGE(WRK-SLOTS-PER-SCREEN) + 1 DTSCS8A
|
|
00637 END-IF DTSCS8A
|
|
00638 DTSCS8A
|
|
00639 IF WRK-SUB-START > WRK-MAX-REPORTS OR DTSCS8A
|
|
00640 LCCM-SUBS-THIS-PAGE(WRK-SLOTS-PER-SCREEN) = 0 DTSCS8A
|
|
00641 MOVE PMSG-LAST-PAGE TO WRK-MSG-AREA DTSCS8A
|
|
00642 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8A
|
|
00643 ELSE DTSCS8A
|
|
00644 MOVE +1 TO WRK-SUB-INCREMENTOR DTSCS8A
|
|
00645 MOVE +1 TO WRK-SCREEN-SLOT DTSCS8A
|
|
00646 COMPUTE LCCM-PAGE-NUM = LCCM-PAGE-NUM + 1 DTSCS8A
|
|
00647 END-IF. DTSCS8A
|
|
00648 P6300-EXIT. DTSCS8A
|
|
00649 EXIT. DTSCS8A
|
|
00650 DTSCS8A
|
|
00651 P6900-CONSTRUCT-SCREEN. DTSCS8A
|
|
00652 INITIALIZE MAP-TABLE DTSCS8A
|
|
00653 SET LCCM-SCR-INQUIRE TO TRUE DTSCS8A
|
|
00654 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME DTSCS8A
|
|
00655 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE DTSCS8A
|
|
00656 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME DTSCS8A
|
|
00657 DTSCS8A
|
|
00658 PERFORM P6910-CHECK-FILTER THRU P6910-EXIT DTSCS8A
|
|
00659 VARYING WRK-SUB DTSCS8A
|
|
00660 FROM WRK-SUB-START BY WRK-SUB-INCREMENTOR DTSCS8A
|
|
00661 UNTIL WRK-SCREEN-FINI-88 DTSCS8A
|
|
00662 DTSCS8A
|
|
00663 MOVE MAP-BUS-AREA TO LCCM-BUS-AREA. DTSCS8A
|
|
00664 P6900-EXIT. DTSCS8A
|
|
00665 EXIT. DTSCS8A
|
|
00666 DTSCS8A
|
|
00667 P6910-CHECK-FILTER. DTSCS8A
|
|
00668 IF WRK-SUB > WRK-MAX-REPORTS OR WRK-SUB = ZERO DTSCS8A
|
|
00669 SET WRK-SCREEN-FINI-88 TO TRUE DTSCS8A
|
|
00670 ELSE DTSCS8A
|
|
00671 IF WRK-USE-BUS-AREA-88 DTSCS8A
|
|
00672 IF FOJR-BUSINESS-AREA(WRK-SUB) = MAP-BUS-AREA DTSCS8A
|
|
00673 PERFORM P6920-POPULATE-SCREEN THRU P6920-EXIT DTSCS8A
|
|
00674 END-IF DTSCS8A
|
|
00675 ELSE DTSCS8A
|
|
00676 PERFORM P6920-POPULATE-SCREEN THRU P6920-EXIT DTSCS8A
|
|
00677 END-IF DTSCS8A
|
|
00678 IF WRK-SCREEN-SLOT > WRK-SLOTS-PER-SCREEN OR DTSCS8A
|
|
00679 WRK-SCREEN-SLOT = ZERO DTSCS8A
|
|
00680 SET WRK-SCREEN-FINI-88 TO TRUE DTSCS8A
|
|
00681 END-IF DTSCS8A
|
|
00682 END-IF. DTSCS8A
|
|
00683 P6910-EXIT. DTSCS8A
|
|
00684 EXIT. DTSCS8A
|
|
00685 DTSCS8A
|
|
00686 P6920-POPULATE-SCREEN. DTSCS8A
|
|
00687 MOVE FOJR-JOB-NAME(WRK-SUB) TO WRK-JOB-NAME DTSCS8A
|
|
00688 MOVE WRK-JOB-NAME(5:4) TO MAP-JOB-NAME(WRK-SCREEN-SLOT) DTSCS8A
|
|
00689 MOVE FOJR-JOB-DESC(WRK-SUB) TO MAP-JOB-DESC(WRK-SCREEN-SLOT) DTSCS8A
|
|
00690 MOVE WRK-SCREEN-SLOT TO MAP-LINE-NO(WRK-SCREEN-SLOT) DTSCS8A
|
|
00691 MOVE WRK-SUB TO DTSCS8A
|
|
00692 LCCM-SUBS-THIS-PAGE(WRK-SCREEN-SLOT) DTSCS8A
|
|
00693 COMPUTE WRK-SCREEN-SLOT = WRK-SCREEN-SLOT + DTSCS8A
|
|
00694 WRK-SUB-INCREMENTOR. DTSCS8A
|
|
00695 P6920-EXIT. DTSCS8A
|
|
00696 EXIT. DTSCS8A
|
|
00697 DTSCS8A
|
|
00698 /*****************************************************************DTSCS8A
|
|
00699 * LINKS TO UTILITY MODULES DTSCS8A
|
|
00700 ******************************************************************DTSCS8A
|
|
00701 SKIP1 DTSCS8A
|
|
00702 S013-SCREEN-COUNT. DTSCS8A
|
|
00703 EXEC CICS LINK DTSCS8A
|
|
00704 PROGRAM ('DTSCU013') DTSCS8A
|
|
00705 COMMAREA (L013-COMM-AREA) DTSCS8A
|
|
00706 END-EXEC. DTSCS8A
|
|
00707 S013-EXIT. DTSCS8A
|
|
00708 EXIT. DTSCS8A
|
|
00709 EJECT DTSCS8A
|
|
00710 S803-REQ-SCR-ID-EDIT. DTSCS8A
|
|
00711 EXEC CICS LINK DTSCS8A
|
|
00712 PROGRAM ('DTSCU803') DTSCS8A
|
|
00713 COMMAREA (DFHCOMMAREA) DTSCS8A
|
|
00714 END-EXEC. DTSCS8A
|
|
00715 S803-EXIT. DTSCS8A
|
|
00716 EXIT. DTSCS8A
|
|
00717 SKIP3 DTSCS8A
|
|
00718 S804-INVALID-KEY. DTSCS8A
|
|
00719 EXEC CICS LINK DTSCS8A
|
|
00720 PROGRAM ('DTSCU804') DTSCS8A
|
|
00721 COMMAREA (DFHCOMMAREA) DTSCS8A
|
|
00722 END-EXEC. DTSCS8A
|
|
00723 S804-EXIT. DTSCS8A
|
|
00724 EXIT. DTSCS8A
|
|
00725 SKIP3 DTSCS8A
|
|
00726 S805-MSG-AREA. DTSCS8A
|
|
00727 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS8A
|
|
00728 SKIP1 DTSCS8A
|
|
00729 EXEC CICS LINK DTSCS8A
|
|
00730 PROGRAM ('DTSCU805') DTSCS8A
|
|
00731 COMMAREA (L805-COMM-AREA) DTSCS8A
|
|
00732 END-EXEC. DTSCS8A
|
|
00733 SKIP1 DTSCS8A
|
|
00734 *JMO - HERE IS WHERE THE 'DTS' IN THE MSG AREA IS COMING FROM DTSCS8A
|
|
00735 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS8A
|
|
00736 S805-EXIT. DTSCS8A
|
|
00737 EXIT. DTSCS8A
|
|
00738 DTSCS8A
|
|
00739 SKIP3 DTSCS8A
|
|
00740 S851-SCREEN-PROCESSING. DTSCS8A
|
|
00741 EXEC CICS LINK DTSCS8A
|
|
00742 PROGRAM ('DTSCU851') DTSCS8A
|
|
00743 COMMAREA (L851-COMM-AREA) DTSCS8A
|
|
00744 END-EXEC. DTSCS8A
|
|
00745 S851-EXIT. DTSCS8A
|
|
00746 EXIT. DTSCS8A
|
|
00747 SKIP3 DTSCS8A
|
|
00748 S899-ABEND. DTSCS8A
|
|
00749 EXEC CICS ABEND DTSCS8A
|
|
00750 ABCODE(WRK-ABEND-CD) DTSCS8A
|
|
00751 END-EXEC. DTSCS8A
|
|
00752 *S899-EXIT. DTSCS8A
|
|
00753 * EXIT. DTSCS8A
|
|
00754 S1101-ERROR. DTSCS8A
|
|
00755 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS8A
|
|
00756 S1101-EXIT. DTSCS8A
|
|
00757 EXIT. DTSCS8A
|
|
00758 DTSCS8A
|
|
00759 S5900-SET-ATTRB. DTSCS8A
|
|
00760 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SELECT-LINE-NO-A DTSCS8A
|
|
00761 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-BUS-AREA-A DTSCS8A
|
|
00762 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A DTSCS8A
|
|
00763 PERFORM DTSCS8A
|
|
00764 VARYING WRK-SUB DTSCS8A
|
|
00765 FROM 1 BY 1 DTSCS8A
|
|
00766 UNTIL WRK-SUB > WRK-SLOTS-PER-SCREEN DTSCS8A
|
|
00767 MOVE CATB-PROT-NORM-MDTON TO MAP-LINE-A(WRK-SUB) DTSCS8A
|
|
00768 END-PERFORM. DTSCS8A
|
|
00769 S5900-EXIT. DTSCS8A
|
|
00770 EXIT. DTSCS8A
|
|
00771 DTSCS8A
|
|
00772 DTSCS8A
|
|
00773 /*****************************************************************DTSCS8A
|
|
00774 * MAP ROUTINES *DTSCS8A
|
|
00775 ******************************************************************DTSCS8A
|
|
00776 S9100-RECEIVE. DTSCS8A
|
|
00777 SET L851-RECEIVE-88 TO TRUE. DTSCS8A
|
|
00778 SKIP1 DTSCS8A
|
|
00779 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS8A
|
|
00780 SKIP1 DTSCS8A
|
|
00781 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS8A
|
|
00782 SKIP1 DTSCS8A
|
|
00783 MOVE L851-AID TO LCCM-AID. DTSCS8A
|
|
00784 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS8A
|
|
00785 S9100-EXIT. DTSCS8A
|
|
00786 EXIT. DTSCS8A
|
|
00787 SKIP3 DTSCS8A
|
|
00788 S9200-SEND-DATAONLY. DTSCS8A
|
|
00789 MOVE LOW-VALUES TO MAP-AREA. DTSCS8A
|
|
00790 SKIP1 DTSCS8A
|
|
00791 IF LCCM-NO-MSG DTSCS8A
|
|
00792 NEXT SENTENCE DTSCS8A
|
|
00793 ELSE DTSCS8A
|
|
00794 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS8A
|
|
00795 SKIP1 DTSCS8A
|
|
00796 IF CURSOR-SET-GOTO DTSCS8A
|
|
00797 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS8A
|
|
00798 ELSE DTSCS8A
|
|
00799 MOVE CATB-CURSOR TO MAP-BUS-AREA-L. DTSCS8A
|
|
00800 SKIP1 DTSCS8A
|
|
00801 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS8A
|
|
00802 SKIP1 DTSCS8A
|
|
00803 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS8A
|
|
00804 SKIP1 DTSCS8A
|
|
00805 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS8A
|
|
00806 S9200-EXIT. DTSCS8A
|
|
00807 EXIT. DTSCS8A
|
|
00808 SKIP3 DTSCS8A
|
|
00809 S9300-SEND-MAP. DTSCS8A
|
|
00810 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS8A
|
|
00811 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS8A
|
|
00812 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS8A
|
|
00813 SKIP1 DTSCS8A
|
|
00814 PERFORM S5900-SET-ATTRB THRU S5900-EXIT . DTSCS8A
|
|
00815 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS8A
|
|
00816 SKIP1 DTSCS8A
|
|
00817 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS8A
|
|
00818 DTSCS8A
|
|
00819 IF CURSOR-SET-NO DTSCS8A
|
|
00820 MOVE CATB-CURSOR TO MAP-BUS-AREA-L. DTSCS8A
|
|
00821 SKIP1 DTSCS8A
|
|
00822 SET L851-SEND-88 TO TRUE. DTSCS8A
|
|
00823 SKIP1 DTSCS8A
|
|
00824 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS8A
|
|
00825 SKIP1 DTSCS8A
|
|
00826 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS8A
|
|
00827 S9300-EXIT. DTSCS8A
|
|
00828 EXIT. DTSCS8A
|
|
00829 DTSCS8A
|
|
00830 S9320-INQUIRY-FKEYS. DTSCS8A
|
|
00831 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS8A
|
|
00832 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS8A
|
|
00833 S9320-EXIT. DTSCS8A
|
|
00834 EXIT. DTSCS8A
|
|
00835 EJECT DTSCS8A
|
|
00836 S9900-PREPARE-SEND. DTSCS8A
|
|
00837 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS8A
|
|
00838 LCCM-SCR-ID. DTSCS8A
|
|
00839 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS8A
|
|
00840 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS8A
|
|
00841 S9900-EXIT. DTSCS8A
|
|
00842 EXIT. DTSCS8A
|