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