00001 IDENTIFICATION DIVISION. 08/20/02 00002 PROGRAM-ID. DTSCS8B. DTSCS8B 00003 AUTHOR. TRW. LV009 00004 DATE-WRITTEN. OCT 2001. DTSCS8B 00005 DATE-COMPILED. DTSCS8B 00006 * DTSCS8B 00007 * DTSCS8B 00008 * MODIFICATION LOG: DTSCS8B 00009 * DTSCS8B 00010 * 11/20/01 INITIAL DEVELOPMENT. COPIED FROM DTSCSA DTSCS8B 00011 * WORK ORDER: PROGRAMMER: JMO. DTSCS8B 00012 * DTSCS8B 00013 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS8B 00014 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS8B 00015 * WORK ORDER: PROGRAMMER: XXX DTSCS8B 00016 * DTSCS8B 00017 * DTSCS8B 00018 * DESCRIPTION: DTSCS8B 00019 * DTSCS8B 00020 * CLEAR: DTSCS8B 00021 * DTSCS8B 00022 * DATA FIELDS DISPLAYED: NONE. DTSCS8B 00023 * MESSAGE: NONE DTSCS8B 00024 * DTSCS8B 00025 * DTSCS8B 00026 * INQUIRY: DTSCS8B 00027 * DTSCS8B 00028 * CONTROL FIELD(S): BUSINESS AREA DTSCS8B 00029 * DTSCS8B 00030 * JUMP IN: USE CLEAR LOGIC. DTSCS8B 00031 * DTSCS8B 00032 * ENTER: DISPLAY ALL JOBS AVAILABLE FOR ONLINE SUBMISSION DTSCS8B 00033 * FIELDS. DTSCS8B 00034 * DTSCS8B 00035 * PRIOR: USING THE SUBSCRIPTS FROM THE COMMAREA DTSCS8B 00036 * DECREMENT SUB AND BUILD SCREEN DTSCS8B 00037 * DTSCS8B 00038 * NEXT: USING THE SUBSCRIPTS FROM THE COMMAREA DTSCS8B 00039 * INCREMENT SUB AND BUILD SCREEN DTSCS8B 00040 * DTSCS8B 00041 * DTSCS8B 00042 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS8B 00043 * DO NOT "WRAP" PAGING. DTSCS8B 00044 * DTSCS8B 00045 * DTSCS8B 00046 * DTSCS8B 00047 * UPDATE: DTSCS8B 00048 * DTSCS8B 00049 * NONE DTSCS8B 00050 * DTSCS8B 00051 * DTSCS8B 00052 * RECORDS READ: DTSCS8B 00053 * DTSCS8B 00054 * MASTER: DTSCS8B 00055 * DTSCS8B 00056 * NONE. DTSCS8B 00057 * DTSCS8B 00058 * DTSCS8B 00059 * ALTERNATE INDEX: DTSCS8B 00060 * DTSCS8B 00061 * NONE. DTSCS8B 00062 * DTSCS8B 00063 * DTSCS8B 00064 * REFERENCE: DTSCS8B 00065 * DTSCS8B 00066 * NONE. DTSCS8B 00067 * DTSCS8B 00068 * DTSCS8B 00069 * ACCOUNTING TRANSACTION COLLECTION: DTSCS8B 00070 * DTSCS8B 00071 * NONE. DTSCS8B 00072 * DTSCS8B 00073 * DTSCS8B 00074 * RECORDS UPDATED: DTSCS8B 00075 * DTSCS8B 00076 * MASTER: DTSCS8B 00077 * DTSCS8B 00078 * NONE. DTSCS8B 00079 * DTSCS8B 00080 * DTSCS8B 00081 * REFERENCE: DTSCS8B 00082 * DTSCS8B 00083 * NONE DTSCS8B 00084 * DTSCS8B 00085 * DTSCS8B 00086 * ACCOUNTING TRANSACTION COLLECTION: DTSCS8B 00087 * DTSCS8B 00088 * NONE. DTSCS8B 00089 * DTSCS8B 00090 * DTSCS8B 00091 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS8B 00092 * DTSCS8B 00093 * NONE. DTSCS8B 00094 * DTSCS8B 00095 * DTSCS8B 00096 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS8B 00097 * UTILITY MODULES) LINKED TO: DTSCS8B 00098 * DTSCS8B 00099 * DTSCU013 COUNT FROM SCREEN FORMAT/EDIT. DTSCS8B 00100 * DTSCS8B 00101 * DTSCS8B 00102 * MAINTENANCE NOTES: DTSCS8B 00103 * DTSCS8B 00104 *3/21 MAX REPORTS = 52 DTSCS8B 00105 * MAX REPORTS = 30 DTSCS8B 00106 * LINES / PAGE = 12 DTSCS8B 00107 * REPORT INFO COMES FROM REDEFINED TABLE IN COPYBOOK DTSCS8B 00108 * DTSCS8B 00109 ***** DTSCS8B 00110 SKIP3 DTSCS8B 00111 ENVIRONMENT DIVISION. DTSCS8B 00112 EJECT DTSCS8B 00113 DATA DIVISION. DTSCS8B 00114 WORKING-STORAGE SECTION. DTSCS8B 001145 77 PAN-VALET PICTURE X(24) VALUE '009DTSCS8B 08/20/02'. DTSCS8B 00115 DTSCS8B 00116 01 WRK-AREA. DTSCS8B 00117 05 WRK-ABEND-CD PIC X(04) VALUE 'S8B '. DTSCS8B 00118 DTSCS8B 00119 05 WRK-SCR-ID. DTSCS8B 00120 10 WRK-SCR-ID-X PIC X(02) VALUE '8B'. DTSCS8B 00121 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS8B 00122 DTSCS8B 00123 05 WRK-MAX-PARMS PIC 9(03) COMP-3 DTSCS8B 00124 VALUE 16. DTSCS8B 00125 DTSCS8B 00126 05 WRK-RESP-CD PIC S9(08) COMP. DTSCS8B 00127 DTSCS8B 00128 05 WRK-PARM-START PIC 9(03) COMP-3 DTSCS8B 00129 VALUE 0. DTSCS8B 00130 DTSCS8B 00131 05 WRK-PARM-LEN PIC 9(03) COMP-3 DTSCS8B 00132 VALUE 0. DTSCS8B 00133 DTSCS8B 00134 05 WRK-JOB-NAME PIC X(08). DTSCS8B 00135 DTSCS8B 00136 05 WRK-JOB-MAP. DTSCS8B 00137 10 WRK-JOB-MAP-LIT PIC X(04) VALUE 'JOB '. DTSCS8B 00138 10 WRK-JOB-MAP-NAME PIC X(08). DTSCS8B 00139 10 FILLER PIC X(01) VALUE ' '. DTSCS8B 00140 10 WRK-JOB-MAP-DESC PIC X(34). DTSCS8B 00141 DTSCS8B 00142 05 WRK-LINK-TO-PGM. DTSCS8B 00143 10 WRK-LINK-TO-PGM-5 PIC X(05) VALUE 'OJRCU'. DTSCS8B 00144 10 WRK-LINK-TO-PGM-3 PIC X(03). DTSCS8B 00145 DTSCS8B 00146 05 WRK-PARM-TYPE PIC X(02). DTSCS8B 00147 88 WRK-PARM-TYPE-DATE-88 VALUE '00'. DTSCS8B 00148 88 WRK-PARM-TYPE-QTR-88 VALUE '01'. DTSCS8B 00149 88 WRK-PARM-TYPE-UID-88 VALUE '02'. DTSCS8B 00150 88 WRK-PARM-TYPE-TEXT-88 VALUE '03'. DTSCS8B 00151 DTSCS8B 00152 05 WRK-CAPTURE-DATE PIC X(03) VALUE '001'. DTSCS8B 00153 05 WRK-CAPTURE-QTR PIC X(03) VALUE '002'. DTSCS8B 00154 05 WRK-CAPTURE-UID PIC X(03) VALUE '003'. DTSCS8B 00155 05 WRK-CAPTURE-TEXT PIC X(03) VALUE '004'. DTSCS8B 00156 DTSCS8B 00157 05 WRK-PARM PIC X(32). DTSCS8B 00158 DTSCS8B 00159 05 WRK-PARM-DATE. DTSCS8B 00160 10 WRK-PARM-DATE-MM PIC X(02). DTSCS8B 00161 10 FILLER PIC X(01) VALUE '/'. DTSCS8B 00162 10 WRK-PARM-DATE-DD PIC X(02). DTSCS8B 00163 10 FILLER PIC X(01) VALUE '/'. DTSCS8B 00164 10 WRK-PARM-DATE-YY PIC X(02). DTSCS8B 00165 DTSCS8B 00166 05 WRK-MSG-AREA PIC X(64) VALUE SPACES. DTSCS8B 00167 DTSCS8B 00168 05 WRK-CONFIRM-MSG PIC X(64) VALUE DTSCS8B 00169 'PRESS ENTER TO CONFIRM SUBMIT, F12 TO RETURN '. DTSCS8B 00170 DTSCS8B 00171 05 WRK-DEFAULTS-USED-MSG PIC X(64) VALUE DTSCS8B 00172 'NO PARAMETERS ALLOWED, DEFAULTS WILL BE USED '. DTSCS8B 00173 DTSCS8B 00174 05 WRK-JOB-SUBMITTED-MSG PIC X(64) VALUE DTSCS8B 00175 'JOB SUBMITTED SUCCESSFULLY '. DTSCS8B 00176 DTSCS8B 00177 05 WRK-JOB-CANCELLED-MSG PIC X(64) VALUE DTSCS8B 00178 'PREVIOUS JOB SUBMISSION CANCELED '. DTSCS8B 00179 DTSCS8B 00180 05 WRK-SUB PIC S9(04) COMP. DTSCS8B 00181 DTSCS8B 00182 05 WRK-CFKD-SUBMIT PIC X(09) DTSCS8B 00183 VALUE 'F9=SUBMIT'. DTSCS8B 00184 DTSCS8B 00185 EJECT DTSCS8B 00186 01 MSG-AREA. DTSCS8B 00187 05 MSG-E8B1-AREA. DTSCS8B 00188 10 FILLER PIC X(04) VALUE 'E8B1'. DTSCS8B 00189 10 FILLER PIC X(30) DTSCS8B 00190 VALUE 'LINE NUMBER SELECTED IS NOT VA'. DTSCS8B 00191 10 FILLER PIC X(30) DTSCS8B 00192 VALUE 'LID '. DTSCS8B 00193 EJECT DTSCS8B 00194 01 SCREEN-CONTROL. DTSCS8B 00195 05 SCR-ACCESS-IND PIC X(01). DTSCS8B 00196 88 SCR-ACCESS-INQ VALUE '1'. DTSCS8B 00197 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS8B 00198 SKIP1 DTSCS8B 00199 05 CURSOR-SET-IND PIC X(01). DTSCS8B 00200 88 CURSOR-SET-YES VALUE 'Y'. DTSCS8B 00201 88 CURSOR-SET-NO VALUE 'N'. DTSCS8B 00202 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS8B 00203 SKIP1 DTSCS8B 00204 05 REQ-IND PIC X(01). DTSCS8B 00205 88 REQ-ERROR VALUE 'O'. DTSCS8B 00206 88 REQ-JUMP VALUE 'J'. DTSCS8B 00207 88 REQ-INQUIRE VALUE 'I'. DTSCS8B 00208 88 REQ-CLEAR VALUE 'C'. DTSCS8B 00209 88 REQ-EDIT VALUE 'E'. DTSCS8B 00210 88 REQ-UPDATE VALUE 'U'. DTSCS8B 00211 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS8B 00212 SKIP1 DTSCS8B 00213 05 RESP-IND PIC X(01). DTSCS8B 00214 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS8B 00215 88 RESP-SEND-MAP VALUE 'M'. DTSCS8B 00216 88 RESP-JUMP VALUE 'J'. DTSCS8B 00217 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS8B 00218 SKIP1 DTSCS8B 00219 05 SCR-ATB-AN PIC X(01). DTSCS8B 00220 05 SCR-ATB-NUM PIC X(01). DTSCS8B 00221 EJECT DTSCS8B 00222 01 L001-COMM-AREA. DTSCS8B 00223 ++INCLUDE DTSIL001 DTSCS8B 00224 EJECT DTSCS8B 00225 01 L013-COMM-AREA. DTSCS8B 00226 ++INCLUDE DTSIL013 DTSCS8B 00227 EJECT DTSCS8B 00228 * ERROR MSG MODULE DTSCS8B 00229 01 L805-COMM-AREA. DTSCS8B 00230 ++INCLUDE DTSIL805 DTSCS8B 00231 EJECT DTSCS8B 00232 01 L825-COMM-AREA. DTSCS8B 00233 05 L825-CONTROL-BLOCK. DTSCS8B 00234 ++INCLUDE DTSIL825 DTSCS8B 00235 05 RSKL-REC. DTSCS8B 00236 ++INCLUDE DTSIRSK1 DTSCS8B 00237 01 T070-REC. DTSCS8B 00238 ++INCLUDE DTSIT070 DTSCS8B 00239 * REPORT INFO IN TABLE FORMAT DTSCS8B 00240 ++INCLUDE OJRIC089 DTSCS8B 00241 * INTERNAL READER TABLE DTSCS8B 00242 ++INCLUDE OJRICRDR DTSCS8B 00243 * MAP DEFINITION DTSCS8B 00244 01 L851-COMM-AREA. DTSCS8B 00245 ++INCLUDE DTSIL851 DTSCS8B 00246 SKIP3 DTSCS8B 00247 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS8B 00248 ++INCLUDE DTSIS8B DTSCS8B 00249 EJECT DTSCS8B 00250 * ATTRIBUTE LITERALS DTSCS8B 00251 01 CATB-LITERALS. DTSCS8B 00252 ++INCLUDE DTSICATB DTSCS8B 00253 SKIP3 DTSCS8B 00254 * FUNCTION KEY DESCRIPTION LITERALS DTSCS8B 00255 01 CFKD-LITERALS. DTSCS8B 00256 ++INCLUDE DTSICFKD DTSCS8B 00257 EJECT DTSCS8B 00258 * ERROR CODE MESSAGE LITERALS DTSCS8B 00259 01 CECD-LITERALS. DTSCS8B 00260 ++INCLUDE DTSICECD DTSCS8B 00261 SKIP3 DTSCS8B 00262 * PROMPT CODE MESSAGE LITERALS DTSCS8B 00263 01 CPCD-LITERALS. DTSCS8B 00264 ++INCLUDE DTSICPCD DTSCS8B 00265 EJECT DTSCS8B 00266 LINKAGE SECTION. DTSCS8B 00267 SKIP3 DTSCS8B 00268 01 DFHCOMMAREA. DTSCS8B 00269 ++INCLUDE DTSILCCM DTSCS8B 00270 SKIP3 DTSCS8B 00271 * PARM EDIT AND DATA CAPTURE AREA DTSCS8B 00272 ++INCLUDE OJRILCCM DTSCS8B 00273 EJECT DTSCS8B 00274 ******************************************************************DTSCS8B 00275 * *DTSCS8B 00276 ******************************************************************DTSCS8B 00277 SKIP1 DTSCS8B 00278 PROCEDURE DIVISION. DTSCS8B 00279 SKIP2 DTSCS8B 00280 SET CURSOR-SET-NO TO TRUE. DTSCS8B 00281 SKIP1 DTSCS8B 00282 MOVE LOW-VALUES TO MAP-AREA. DTSCS8B 00283 SKIP1 DTSCS8B 00284 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS8B 00285 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCS8B 00286 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT DTSCS8B 00287 DTSCS8B 00288 DTSCS8B 00289 MOVE SPACE TO REQ-IND DTSCS8B 00290 DTSCS8B 00291 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT DTSCS8B 00292 SKIP1 DTSCS8B 00293 *----------------------------------------------------- DTSCS8B 00294 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS8B 00295 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS8B 00296 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS8B 00297 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS8B 00298 * DTSCS8B 00299 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS8B 00300 * PROCESSED. DTSCS8B 00301 * DTSCS8B 00302 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS8B 00303 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS8B 00304 * WORK STATION OPERATOR. DTSCS8B 00305 *----------------------------------------------------- DTSCS8B 00306 SKIP1 DTSCS8B 00307 INITIALIZE RESP-IND DTSCS8B 00308 SKIP1 DTSCS8B 00309 EVALUATE TRUE DTSCS8B 00310 WHEN REQ-ERROR DTSCS8B 00311 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS8B 00312 WHEN REQ-JUMP DTSCS8B 00313 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS8B 00314 WHEN REQ-CURSOR-TO-GOTO DTSCS8B 00315 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS8B 00316 WHEN REQ-INQUIRE DTSCS8B 00317 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS8B 00318 WHEN OTHER DTSCS8B 00319 GO TO S899-ABEND DTSCS8B 00320 END-EVALUATE DTSCS8B 00321 SKIP3 DTSCS8B 00322 *----------------------------------------------------- DTSCS8B 00323 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS8B 00324 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS8B 00325 *----------------------------------------------------- DTSCS8B 00326 SKIP1 DTSCS8B 00327 EVALUATE TRUE DTSCS8B 00328 WHEN RESP-SEND-MAP DTSCS8B 00329 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS8B 00330 SET LCCM-END-TASK-88 TO TRUE DTSCS8B 00331 WHEN RESP-SEND-MSGONLY OR RESP-CURSOR-TO-GOTO DTSCS8B 00332 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS8B 00333 SET LCCM-END-TASK-88 TO TRUE DTSCS8B 00334 WHEN RESP-JUMP DTSCS8B 00335 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS8B 00336 END-EVALUATE. DTSCS8B 00337 SKIP3 DTSCS8B 00338 MAINLINE-EXIT. DTSCS8B 00339 DTSCS8B 00340 EXEC CICS DTSCS8B 00341 RETURN DTSCS8B 00342 END-EXEC. DTSCS8B 00343 DTSCS8B 00344 GOBACK. DTSCS8B 00345 EJECT DTSCS8B 00346 DTSCS8B 00347 P0100-ACCESS-SEARCH. DTSCS8B 00348 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCS8B 00349 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS8B 00350 TO SCR-ACCESS-IND. DTSCS8B 00351 P0100-EXIT. DTSCS8B 00352 EXIT. DTSCS8B 00353 /*****************************************************************DTSCS8B 00354 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS8B 00355 ******************************************************************DTSCS8B 00356 P1000-ANALYZE-REQUEST. DTSCS8B 00357 SKIP1 DTSCS8B 00358 *----------------------------------------------------- DTSCS8B 00359 * IF USER HAS COME FROM DATA CAPTURE 'ENTER' SCREEN DTSCS8B 00360 * GOTO DATA CAPTURE RECEIVE PROCESSING DTSCS8B 00361 *----------------------------------------------------- DTSCS8B 00362 IF LCCM-SEND-MAP-88 DTSCS8B 00363 SET LCCM-ENTER-88 TO TRUE DTSCS8B 00364 SET REQ-INQUIRE TO TRUE DTSCS8B 00365 SET LCCM-RECEIVE-MAP-88 TO TRUE DTSCS8B 00366 GO TO P1000-EXIT DTSCS8B 00367 END-IF DTSCS8B 00368 *----------------------------------------------------- DTSCS8B 00369 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS8B 00370 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS8B 00371 * REPLACED WITH ENTER) DTSCS8B 00372 *----------------------------------------------------- DTSCS8B 00373 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS8B 00374 SET LCCM-ENTER-88 TO TRUE DTSCS8B 00375 SET REQ-INQUIRE TO TRUE DTSCS8B 00376 SET LCCM-GET-DEFAULTS-88 TO TRUE DTSCS8B 00377 GO TO P1000-EXIT DTSCS8B 00378 END-IF DTSCS8B 00379 SKIP3 DTSCS8B 00380 *----------------------------------------------------- DTSCS8B 00381 * MAP IS RECEIVED DTSCS8B 00382 *----------------------------------------------------- DTSCS8B 00383 PERFORM S9100-RECEIVE THRU S9100-EXIT DTSCS8B 00384 SKIP3 DTSCS8B 00385 *----------------------------------------------------- DTSCS8B 00386 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS8B 00387 *----------------------------------------------------- DTSCS8B 00388 IF LCCM-SCR-UPDATE-LOCKED DTSCS8B 00389 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS8B 00390 GO TO P1000-EXIT. DTSCS8B 00391 DTSCS8B 00392 *----------------------------------------------------- DTSCS8B 00393 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS8B 00394 *----------------------------------------------------- DTSCS8B 00395 IF LCCM-PA2-88 DTSCS8B 00396 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS8B 00397 GO TO P1000-EXIT. DTSCS8B 00398 DTSCS8B 00399 *----------------------------------------------------- DTSCS8B 00400 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS8B 00401 *----------------------------------------------------- DTSCS8B 00402 IF LCCM-PA-88 DTSCS8B 00403 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS8B 00404 SET REQ-ERROR TO TRUE DTSCS8B 00405 GO TO P1000-EXIT DTSCS8B 00406 END-IF DTSCS8B 00407 SKIP3 DTSCS8B 00408 *----------------------------------------------------- DTSCS8B 00409 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS8B 00410 *----------------------------------------------------- DTSCS8B 00411 IF LCCM-F03-88 DTSCS8B 00412 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS8B 00413 SET REQ-JUMP TO TRUE DTSCS8B 00414 GO TO P1000-EXIT DTSCS8B 00415 END-IF DTSCS8B 00416 SKIP3 DTSCS8B 00417 *----------------------------------------------------- DTSCS8B 00418 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS8B 00419 *----------------------------------------------------- DTSCS8B 00420 IF LCCM-F04-88 DTSCS8B 00421 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS8B 00422 SET REQ-JUMP TO TRUE DTSCS8B 00423 GO TO P1000-EXIT DTSCS8B 00424 END-IF DTSCS8B 00425 SKIP3 DTSCS8B 00426 *----------------------------------------------------- DTSCS8B 00427 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS8B 00428 * CORRESPONDENCE SCREEN DTSCS8B 00429 *----------------------------------------------------- DTSCS8B 00430 IF LCCM-F14-88 DTSCS8B 00431 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS8B 00432 SET REQ-JUMP TO TRUE DTSCS8B 00433 GO TO P1000-EXIT DTSCS8B 00434 END-IF DTSCS8B 00435 SKIP3 DTSCS8B 00436 *----------------------------------------------------- DTSCS8B 00437 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS8B 00438 * REQUESTED SCREEN TYPE DTSCS8B 00439 *----------------------------------------------------- DTSCS8B 00440 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS8B 00441 CONTINUE DTSCS8B 00442 ELSE DTSCS8B 00443 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS8B 00444 SET REQ-JUMP TO TRUE DTSCS8B 00445 GO TO P1000-EXIT DTSCS8B 00446 END-IF DTSCS8B 00447 SKIP3 DTSCS8B 00448 *----------------------------------------------------- DTSCS8B 00449 * IF SUBMIT KEY PRESSED (F9) DTSCS8B 00450 *----------------------------------------------------- DTSCS8B 00451 * IF LCCM-ENTER-88 OR LCCM-F09-88 DTSCS8B 00452 IF LCCM-F09-88 DTSCS8B 00453 SET REQ-INQUIRE TO TRUE DTSCS8B 00454 GO TO P1000-EXIT DTSCS8B 00455 END-IF DTSCS8B 00456 SKIP3 DTSCS8B 00457 *----------------------------------------------------- DTSCS8B 00458 * IF CANCEL KEY PRESSED (F12) DTSCS8B 00459 *----------------------------------------------------- DTSCS8B 00460 IF LCCM-F12-88 AND DTSCS8B 00461 (LCCM-UPDATE-OLA-88 OR LCCM-INT-RDR-88) DTSCS8B 00462 SET REQ-INQUIRE TO TRUE DTSCS8B 00463 GO TO P1000-EXIT DTSCS8B 00464 END-IF DTSCS8B 00465 SKIP3 DTSCS8B 00466 *----------------------------------------------------- DTSCS8B 00467 * IF CONFIRM KEY PRESSED (ENTER) DTSCS8B 00468 *----------------------------------------------------- DTSCS8B 00469 IF LCCM-ENTER-88 AND DTSCS8B 00470 (LCCM-UPDATE-OLA-88 OR LCCM-INT-RDR-88) DTSCS8B 00471 SET REQ-INQUIRE TO TRUE DTSCS8B 00472 GO TO P1000-EXIT DTSCS8B 00473 END-IF DTSCS8B 00474 SKIP3 DTSCS8B 00475 *----------------------------------------------------- DTSCS8B 00476 * IF LINE SELECTED (ENTER) DTSCS8B 00477 *----------------------------------------------------- DTSCS8B 00478 IF LCCM-ENTER-88 AND DTSCS8B 00479 (MAP-SELECT-LINE-NO NOT EQUAL SPACES AND DTSCS8B 00480 MAP-SELECT-LINE-NO NOT EQUAL LOW-VALUES) DTSCS8B 00481 SET REQ-INQUIRE TO TRUE DTSCS8B 00482 GO TO P1000-EXIT DTSCS8B 00483 END-IF DTSCS8B 00484 SKIP3 DTSCS8B 00485 *----------------------------------------------------- DTSCS8B 00486 * ANY OTHER KEY IS INVALID DTSCS8B 00487 *----------------------------------------------------- DTSCS8B 00488 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS8B 00489 SET REQ-ERROR TO TRUE. DTSCS8B 00490 P1000-EXIT. DTSCS8B 00491 EXIT. DTSCS8B 00492 DTSCS8B 00493 P1100-UPDATE-LOCKED. DTSCS8B 00494 *----------------------------------------------------- DTSCS8B 00495 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS8B 00496 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS8B 00497 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS8B 00498 *----------------------------------------------------- DTSCS8B 00499 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS8B 00500 SET REQ-UPDATE TO TRUE DTSCS8B 00501 ELSE DTSCS8B 00502 SET REQ-ERROR TO TRUE DTSCS8B 00503 IF LCCM-SCR-MOD-LOCKED DTSCS8B 00504 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS8B 00505 ELSE DTSCS8B 00506 GO TO S899-ABEND DTSCS8B 00507 END-IF DTSCS8B 00508 END-IF. DTSCS8B 00509 P1100-EXIT. DTSCS8B 00510 EXIT. DTSCS8B 00511 DTSCS8B 00512 /*****************************************************************DTSCS8B 00513 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS8B 00514 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS8B 00515 ******************************************************************DTSCS8B 00516 SKIP1 DTSCS8B 00517 P2000-REQUEST-ERROR. DTSCS8B 00518 IF LCCM-MSG DTSCS8B 00519 SET RESP-SEND-MSGONLY TO TRUE DTSCS8B 00520 ELSE DTSCS8B 00521 GO TO S899-ABEND DTSCS8B 00522 END-IF. DTSCS8B 00523 P2000-EXIT. DTSCS8B 00524 EXIT. DTSCS8B 00525 /*****************************************************************DTSCS8B 00526 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS8B 00527 ******************************************************************DTSCS8B 00528 SKIP1 DTSCS8B 00529 P3000-REQUEST-JUMP. DTSCS8B 00530 *----------------------------------------------------- DTSCS8B 00531 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS8B 00532 * BY USER DTSCS8B 00533 *----------------------------------------------------- DTSCS8B 00534 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS8B 00535 SKIP3 DTSCS8B 00536 *----------------------------------------------------- DTSCS8B 00537 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS8B 00538 *----------------------------------------------------- DTSCS8B 00539 IF LCCM-MSG DTSCS8B 00540 SET RESP-SEND-MSGONLY TO TRUE DTSCS8B 00541 SET CURSOR-SET-GOTO TO TRUE DTSCS8B 00542 GO TO P3000-EXIT DTSCS8B 00543 END-IF DTSCS8B 00544 SKIP3 DTSCS8B 00545 *----------------------------------------------------- DTSCS8B 00546 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS8B 00547 *----------------------------------------------------- DTSCS8B 00548 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS8B 00549 LCCM-SCR-HOLD-AREA DTSCS8B 00550 MOVE +0 TO LCCM-SCR-ABSTIME DTSCS8B 00551 SET RESP-JUMP TO TRUE. DTSCS8B 00552 P3000-EXIT. DTSCS8B 00553 EXIT. DTSCS8B 00554 /*****************************************************************DTSCS8B 00555 * CLEAR KEY WAS PRESSED *DTSCS8B 00556 ******************************************************************DTSCS8B 00557 SKIP1 DTSCS8B 00558 /*****************************************************************DTSCS8B 00559 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS8B 00560 ******************************************************************DTSCS8B 00561 SKIP1 DTSCS8B 00562 P5000-CURSOR-TO-GOTO. DTSCS8B 00563 SET CURSOR-SET-GOTO TO TRUE DTSCS8B 00564 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS8B 00565 P5000-EXIT. DTSCS8B 00566 EXIT. DTSCS8B 00567 /*****************************************************************DTSCS8B 00568 * INQUIRY WAS REQUESTED *DTSCS8B 00569 ******************************************************************DTSCS8B 00570 DTSCS8B 00571 P6000-REQUEST-INQUIRE. DTSCS8B 00572 INITIALIZE LCCM-MSG-AREA DTSCS8B 00573 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME DTSCS8B 00574 DTSCS8B 00575 EVALUATE TRUE DTSCS8B 00576 WHEN LCCM-ENTER-88 DTSCS8B 00577 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS8B 00578 WHEN LCCM-F09-88 DTSCS8B 00579 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS8B 00580 WHEN LCCM-F12-88 DTSCS8B 00581 INITIALIZE LCCM-REPORT-REQUEST DTSCS8B 00582 MOVE WRK-JOB-CANCELLED-MSG TO LCCM-MSG-TEXT DTSCS8B 00583 SET LCCM-ERROR-MSG TO TRUE DTSCS8B 00584 SET RESP-SEND-MAP TO TRUE DTSCS8B 00585 WHEN OTHER DTSCS8B 00586 GO TO S899-ABEND DTSCS8B 00587 END-EVALUATE. DTSCS8B 00588 DTSCS8B 00589 P6000-EXIT. DTSCS8B 00590 EXIT. DTSCS8B 00591 DTSCS8B 00592 P6100-NO-PAGE. DTSCS8B 00593 IF LCCM-GET-DEFAULTS-88 DTSCS8B 00594 PERFORM P6110-GET-DEFAULTS THRU P6110-EXIT DTSCS8B 00595 ELSE DTSCS8B 00596 IF LCCM-RECEIVE-MAP-88 DTSCS8B 00597 PERFORM P6150-OVERRIDE-PARM THRU P6150-EXIT DTSCS8B 00598 ELSE DTSCS8B 00599 IF LCCM-UPDATE-CONF-88 DTSCS8B 00600 PERFORM P8000-PROCESS-UPDATE THRU P8000-EXIT DTSCS8B 00601 ELSE DTSCS8B 00602 IF MAP-SELECT-LINE-NO = SPACES OR LOW-VALUES DTSCS8B 00603 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L DTSCS8B 00604 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS8B 00605 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8B 00606 ELSE DTSCS8B 00607 PERFORM P6130-PROCESS-LINE-NO THRU P6130-EXIT DTSCS8B 00608 END-IF DTSCS8B 00609 END-IF DTSCS8B 00610 END-IF DTSCS8B 00611 END-IF. DTSCS8B 00612 P6100-EXIT. DTSCS8B 00613 EXIT. DTSCS8B 00614 DTSCS8B 00615 P6110-GET-DEFAULTS. DTSCS8B 00616 MOVE FOJR-JOB-NAME(LCCM-REPORT-SUB) TO WRK-JOB-NAME, DTSCS8B 00617 LCCM-REPORT-NAME DTSCS8B 00618 MOVE FOJR-JOB-DESC(LCCM-REPORT-SUB) TO DTSCS8B 00619 LCCM-REPORT-DESC DTSCS8B 00620 MOVE FOJR-JOB-TYPE(LCCM-REPORT-SUB) TO DTSCS8B 00621 LCCM-REPORT-TYPE DTSCS8B 00622 MOVE WRK-JOB-NAME(6:3) TO WRK-LINK-TO-PGM-3DTSCS8B 00623 DTSCS8B 00624 IF FOJR-PARM-LENGTH (LCCM-REPORT-SUB, 1) > ZEROS DTSCS8B 00625 PERFORM P6120-BUILD-LCCM THRU P6120-EXIT DTSCS8B 00626 PERFORM P6900-READY-TO-LINK THRU P6900-EXIT DTSCS8B 00627 ELSE DTSCS8B 00628 MOVE WRK-CFKD-SUBMIT TO MAP-KEY-SUBMIT DTSCS8B 00629 MOVE WRK-DEFAULTS-USED-MSG TO LCCM-MSG-TEXT DTSCS8B 00630 SET LCCM-ERROR-MSG TO TRUE DTSCS8B 00631 END-IF DTSCS8B 00632 DTSCS8B 00633 PERFORM P9000-PROCESS-SCREEN THRU P9000-EXIT. DTSCS8B 00634 P6110-EXIT. DTSCS8B 00635 EXIT. DTSCS8B 00636 DTSCS8B 00637 P6120-BUILD-LCCM. DTSCS8B 00638 PERFORM DTSCS8B 00639 VARYING WRK-SUB DTSCS8B 00640 FROM 1 BY 1 DTSCS8B 00641 UNTIL WRK-SUB > WRK-MAX-PARMS OR DTSCS8B 00642 FOJR-PARM-LENGTH (LCCM-REPORT-SUB, WRK-SUB) = ZEROS DTSCS8B 00643 DTSCS8B 00644 * MOVE FOJR-LAST-PARM-VALUE(LCCM-REPORT-SUB, WRK-SUB) TODTSCS8B 00645 * LCCM-PARM-VALUE(WRK-SUB) DTSCS8B 00646 DTSCS8B 00647 MOVE FOJR-PARM-DESC(LCCM-REPORT-SUB, WRK-SUB) TODTSCS8B 00648 LCCM-PARM-DESC(WRK-SUB) DTSCS8B 00649 DTSCS8B 00650 MOVE FOJR-PARM-LENGTH(LCCM-REPORT-SUB, WRK-SUB) TODTSCS8B 00651 LCCM-PARM-LENGTH(WRK-SUB) DTSCS8B 00652 DTSCS8B 00653 MOVE FOJR-PARM-TYPE(LCCM-REPORT-SUB, WRK-SUB) TODTSCS8B 00654 LCCM-PARM-TYPE(WRK-SUB) DTSCS8B 00655 DTSCS8B 00656 END-PERFORM. DTSCS8B 00657 P6120-EXIT. DTSCS8B 00658 EXIT. DTSCS8B 00659 DTSCS8B 00660 P6130-PROCESS-LINE-NO. DTSCS8B 00661 MOVE MAP-SELECT-LINE-NO-AREA TO L013-S-CNT-AREA DTSCS8B 00662 MOVE +1 TO L013-MIN-CNT DTSCS8B 00663 MOVE +16 TO L013-MAX-CNT DTSCS8B 00664 PERFORM S013-SCREEN-COUNT THRU S013-EXIT DTSCS8B 00665 *GIL ASRA 8B DTSCS8B 00666 IF L013-VALID DTSCS8B 00667 MOVE L013-CNT TO MAP-SELECT-LINE-NO-N DTSCS8B 00668 MOVE MAP-SELECT-LINE-NO-N TO LCCM-PARM-SUB DTSCS8B 00669 IF FOJR-PARM-LENGTH(LCCM-REPORT-SUB, LCCM-PARM-SUB) > ZERODTSCS8B 00670 PERFORM P6140-GET-PARM-TYPE THRU P6140-EXIT DTSCS8B 00671 SET LCCM-SEND-MAP-88 TO TRUE DTSCS8B 00672 PERFORM P6900-READY-TO-LINK THRU P6900-EXIT DTSCS8B 00673 ELSE DTSCS8B 00674 MOVE MSG-E8B1-AREA TO WRK-MSG-AREA DTSCS8B 00675 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8B 00676 END-IF DTSCS8B 00677 ELSE DTSCS8B 00678 MOVE MSG-E8B1-AREA TO WRK-MSG-AREA DTSCS8B 00679 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS8B 00680 END-IF. DTSCS8B 00681 P6130-EXIT. DTSCS8B 00682 EXIT. DTSCS8B 00683 DTSCS8B 00684 P6140-GET-PARM-TYPE. DTSCS8B 00685 MOVE LCCM-PARM-TYPE(LCCM-PARM-SUB) TO WRK-PARM-TYPE DTSCS8B 00686 DTSCS8B 00687 EVALUATE TRUE DTSCS8B 00688 WHEN WRK-PARM-TYPE-DATE-88 DTSCS8B 00689 MOVE WRK-CAPTURE-DATE TO WRK-LINK-TO-PGM-3 DTSCS8B 00690 WHEN WRK-PARM-TYPE-QTR-88 DTSCS8B 00691 MOVE WRK-CAPTURE-QTR TO WRK-LINK-TO-PGM-3 DTSCS8B 00692 WHEN WRK-PARM-TYPE-UID-88 DTSCS8B 00693 MOVE WRK-CAPTURE-UID TO WRK-LINK-TO-PGM-3 DTSCS8B 00694 WHEN WRK-PARM-TYPE-TEXT-88 DTSCS8B 00695 MOVE WRK-CAPTURE-TEXT TO WRK-LINK-TO-PGM-3 DTSCS8B 00696 END-EVALUATE. DTSCS8B 00697 P6140-EXIT. DTSCS8B 00698 EXIT. DTSCS8B 00699 DTSCS8B 00700 P6150-OVERRIDE-PARM. DTSCS8B 00701 PERFORM P6140-GET-PARM-TYPE THRU P6140-EXIT DTSCS8B 00702 PERFORM P6900-READY-TO-LINK THRU P6900-EXIT DTSCS8B 00703 PERFORM P9000-PROCESS-SCREEN THRU P9000-EXIT. DTSCS8B 00704 P6150-EXIT. DTSCS8B 00705 EXIT. DTSCS8B 00706 DTSCS8B 00707 P7000-REQUEST-EDIT. DTSCS8B 00708 MOVE LCCM-REPORT-NAME TO WRK-JOB-NAME DTSCS8B 00709 MOVE WRK-JOB-NAME(6:3) TO WRK-LINK-TO-PGM-3 DTSCS8B 00710 SET LCCM-EDIT-PARMS-88 TO TRUE DTSCS8B 00711 PERFORM P6900-READY-TO-LINK THRU P6900-EXIT DTSCS8B 00712 DTSCS8B 00713 IF LCCM-NO-MSG DTSCS8B 00714 SET RESP-SEND-MAP TO TRUE DTSCS8B 00715 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS8B 00716 IF LCCM-READ-ONLY-88 DTSCS8B 00717 SET LCCM-INT-RDR-88 TO TRUE DTSCS8B 00718 ELSE DTSCS8B 00719 SET LCCM-UPDATE-OLA-88 TO TRUE DTSCS8B 00720 END-IF DTSCS8B 00721 ELSE DTSCS8B 00722 SET LCCM-SEND-MAP-88 TO TRUE DTSCS8B 00723 PERFORM P6140-GET-PARM-TYPE THRU P6140-EXIT DTSCS8B 00724 PERFORM P6900-READY-TO-LINK THRU P6900-EXIT DTSCS8B 00725 END-IF DTSCS8B 00726 DTSCS8B 00727 PERFORM P6800-CONSTRUCT-SCREEN THRU P6800-EXIT. DTSCS8B 00728 P7000-EXIT. DTSCS8B 00729 EXIT. DTSCS8B 00730 DTSCS8B 00731 DTSCS8B 00732 P6800-CONSTRUCT-SCREEN. DTSCS8B 00733 *JMO SET LCCM-SCR-INQUIRE TO TRUE DTSCS8B 00734 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME DTSCS8B 00735 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE DTSCS8B 00736 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME DTSCS8B 00737 MOVE LCCM-REPORT-NAME TO WRK-JOB-MAP-NAME DTSCS8B 00738 MOVE LCCM-REPORT-DESC TO WRK-JOB-MAP-DESC DTSCS8B 00739 MOVE WRK-JOB-MAP TO MAP-JOB-DESC DTSCS8B 00740 DTSCS8B 00741 PERFORM DTSCS8B 00742 VARYING WRK-SUB DTSCS8B 00743 FROM 1 BY 1 DTSCS8B 00744 UNTIL WRK-SUB > WRK-MAX-PARMS OR DTSCS8B 00745 LCCM-PARM-LENGTH(WRK-SUB) = ZEROS DTSCS8B 00746 DTSCS8B 00747 MOVE SPACES TO MAP-LINE-DATA(WRK-SUB) DTSCS8B 00748 MOVE WRK-SUB TO MAP-LINE-NO(WRK-SUB) DTSCS8B 00749 PERFORM P6810-FORMAT-PARM-FOR-MAP THRU P6810-EXIT DTSCS8B 00750 MOVE WRK-PARM TO MAP-PARM-VALUE(WRK-SUB) DTSCS8B 00751 MOVE LCCM-PARM-DESC(WRK-SUB) DTSCS8B 00752 TO MAP-PARM-DESC(WRK-SUB) DTSCS8B 00753 END-PERFORM. DTSCS8B 00754 P6800-EXIT. DTSCS8B 00755 EXIT. DTSCS8B 00756 DTSCS8B 00757 P6810-FORMAT-PARM-FOR-MAP. DTSCS8B 00758 MOVE LCCM-PARM-TYPE(WRK-SUB) TO WRK-PARM-TYPE DTSCS8B 00759 DTSCS8B 00760 EVALUATE TRUE DTSCS8B 00761 WHEN WRK-PARM-TYPE-DATE-88 DTSCS8B 00762 MOVE LCCM-PARM-VALUE(WRK-SUB) TO WRK-PARM DTSCS8B 00763 IF WRK-PARM NOT = SPACES AND DTSCS8B 00764 WRK-PARM NOT = LOW-VALUES DTSCS8B 00765 MOVE WRK-PARM(1:2) TO WRK-PARM-DATE-MMDTSCS8B 00766 MOVE WRK-PARM(3:2) TO WRK-PARM-DATE-DDDTSCS8B 00767 MOVE WRK-PARM(5:2) TO WRK-PARM-DATE-YYDTSCS8B 00768 MOVE WRK-PARM-DATE TO WRK-PARM DTSCS8B 00769 ELSE DTSCS8B 00770 MOVE SPACES TO WRK-PARM DTSCS8B 00771 END-IF DTSCS8B 00772 WHEN WRK-PARM-TYPE-QTR-88 DTSCS8B 00773 MOVE LCCM-PARM-VALUE(WRK-SUB) TO WRK-PARM DTSCS8B 00774 WHEN WRK-PARM-TYPE-UID-88 DTSCS8B 00775 MOVE LCCM-PARM-VALUE(WRK-SUB) TO WRK-PARM DTSCS8B 00776 WHEN WRK-PARM-TYPE-TEXT-88 DTSCS8B 00777 MOVE LCCM-PARM-VALUE(WRK-SUB) TO WRK-PARM DTSCS8B 00778 END-EVALUATE. DTSCS8B 00779 P6810-EXIT. DTSCS8B 00780 EXIT. DTSCS8B 00781 DTSCS8B 00782 P6900-READY-TO-LINK. DTSCS8B 00783 EXEC CICS DTSCS8B 00784 LINK DTSCS8B 00785 PROGRAM (WRK-LINK-TO-PGM) DTSCS8B 00786 COMMAREA (DFHCOMMAREA) DTSCS8B 00787 RESP (WRK-RESP-CD) DTSCS8B 00788 END-EXEC DTSCS8B 00789 DTSCS8B 00790 IF WRK-RESP-CD = 0 DTSCS8B 00791 IF NOT LCCM-GET-DEFAULTS-88 DTSCS8B 00792 MOVE WRK-CFKD-SUBMIT TO MAP-KEY-SUBMIT DTSCS8B 00793 END-IF DTSCS8B 00794 END-IF. DTSCS8B 00795 P6900-EXIT. DTSCS8B 00796 EXIT. DTSCS8B 00797 DTSCS8B 00798 DTSCS8B 00799 P8000-PROCESS-UPDATE. DTSCS8B 00800 IF LCCM-UPDATE-OLA-88 DTSCS8B 00801 PERFORM P8991-INITIALIZE-T070 THRU P8991-EXIT DTSCS8B 00802 PERFORM S825-WRITE-T070 THRU S825-EXIT DTSCS8B 00803 ELSE DTSCS8B 00804 PERFORM P8500-WRITE-JCL THRU P8500-EXIT DTSCS8B 00805 END-IF DTSCS8B 00806 DTSCS8B 00807 MOVE WRK-JOB-SUBMITTED-MSG TO LCCM-MSG-TEXT DTSCS8B 00808 SET LCCM-ERROR-MSG TO TRUE DTSCS8B 00809 SET RESP-SEND-MAP TO TRUE. DTSCS8B 00810 P8000-EXIT. DTSCS8B 00811 EXIT. DTSCS8B 00812 DTSCS8B 00813 P8500-WRITE-JCL. DTSCS8B 00814 PERFORM P8510-BUILD-PARM THRU P8510-EXIT DTSCS8B 00815 EXEC CICS DTSCS8B 00816 ENQ DTSCS8B 00817 RESOURCE (WRK-QUEUE-NAME) DTSCS8B 00818 END-EXEC DTSCS8B 00819 DTSCS8B 00820 PERFORM VARYING DTSCS8B 00821 WRK-SUB FROM 1 BY 1 DTSCS8B 00822 UNTIL WRK-SUB > WRK-MAX-JCL-CARDS DTSCS8B 00823 EXEC CICS DTSCS8B 00824 WRITEQ TD DTSCS8B 00825 QUEUE (WRK-QUEUE-NAME) DTSCS8B 00826 FROM (IKJEFT01-RDR-CARD(WRK-SUB)) DTSCS8B 00827 LENGTH (WRK-QUEUE-LEN) DTSCS8B 00828 END-EXEC DTSCS8B 00829 END-PERFORM DTSCS8B 00830 DTSCS8B 00831 EXEC CICS DTSCS8B 00832 DEQ DTSCS8B 00833 RESOURCE (WRK-QUEUE-NAME) DTSCS8B 00834 END-EXEC. DTSCS8B 00835 P8500-EXIT. DTSCS8B 00836 EXIT. DTSCS8B 00837 DTSCS8B 00838 P8510-BUILD-PARM. DTSCS8B 00839 INITIALIZE RDR-SYSTSIN-PARM DTSCS8B 00840 DTSCS8B 00841 IF LCCM-CICS-REGION-NAME = 'H10CICS9' DTSCS8B 00842 MOVE 'P' TO RDR-SYSTSIN-PARM(1:1) DTSCS8B 00843 MOVE WRK-JOBNAME-PROD TO RDR-JOBCARD-NAME DTSCS8B 00844 MOVE 'ECNTPRD' TO RDR-JOBCARD-USER DTSCS8B 00845 ELSE DTSCS8B 00846 MOVE 'D' TO RDR-SYSTSIN-PARM(1:1) DTSCS8B 00847 MOVE WRK-JOBNAME-DEVL TO RDR-JOBCARD-NAME DTSCS8B 00848 END-IF. DTSCS8B 00849 MOVE ',' TO RDR-SYSTSIN-PARM(2:1) DTSCS8B 00850 DTSCS8B 00851 MOVE LCCM-REPORT-NAME(6:3) TO RDR-SYSTSIN-PARM(3:3) DTSCS8B 00852 MOVE 6 TO WRK-PARM-START DTSCS8B 00853 PERFORM VARYING WRK-SUB DTSCS8B 00854 FROM 1 BY 1 DTSCS8B 00855 UNTIL LCCM-PARM-LENGTH(WRK-SUB) = ZERO DTSCS8B 00856 MOVE 1 TO WRK-PARM-LEN DTSCS8B 00857 MOVE ',' TO DTSCS8B 00858 RDR-SYSTSIN-PARM(WRK-PARM-START:WRK-PARM-LEN) DTSCS8B 00859 ADD WRK-PARM-LEN TO WRK-PARM-START DTSCS8B 00860 MOVE LCCM-PARM-LENGTH(WRK-SUB) TO WRK-PARM-LEN DTSCS8B 00861 MOVE LCCM-PARM-VALUE(WRK-SUB) TO DTSCS8B 00862 RDR-SYSTSIN-PARM(WRK-PARM-START:WRK-PARM-LEN) DTSCS8B 00863 ADD WRK-PARM-LEN TO WRK-PARM-START DTSCS8B 00864 END-PERFORM. DTSCS8B 00865 P8510-EXIT. DTSCS8B 00866 EXIT. DTSCS8B 00867 DTSCS8B 00868 P8991-INITIALIZE-T070. DTSCS8B 00869 MOVE LCCM-REPORT-NAME TO T070-JOB-NAME DTSCS8B 00870 MOVE LCCM-REPORT-TYPE TO T070-JOB-TYPE DTSCS8B 00871 INITIALIZE T070-PARM-CNT DTSCS8B 00872 PERFORM VARYING WRK-SUB DTSCS8B 00873 FROM 1 BY 1 DTSCS8B 00874 UNTIL LCCM-PARM-LENGTH(WRK-SUB) = ZERO DTSCS8B 00875 MOVE LCCM-PARM-VALUE(WRK-SUB) TO T070-PARM(WRK-SUB) DTSCS8B 00876 COMPUTE T070-PARM-CNT = T070-PARM-CNT + 1 DTSCS8B 00877 END-PERFORM. DTSCS8B 00878 P8991-EXIT. DTSCS8B 00879 EXIT. DTSCS8B 00880 DTSCS8B 00881 DTSCS8B 00882 P9000-PROCESS-SCREEN. DTSCS8B 00883 PERFORM P6800-CONSTRUCT-SCREEN THRU P6800-EXIT DTSCS8B 00884 *JMO PERFORM S5900-SET-ATTRB THRU S5900-EXIT DTSCS8B 00885 INITIALIZE LCCM-REPORT-REQUEST DTSCS8B 00886 SET RESP-SEND-MAP TO TRUE. DTSCS8B 00887 P9000-EXIT. DTSCS8B 00888 EXIT. DTSCS8B 00889 DTSCS8B 00890 /*****************************************************************DTSCS8B 00891 * LINKS TO UTILITY MODULES DTSCS8B 00892 ******************************************************************DTSCS8B 00893 SKIP1 DTSCS8B 00894 S013-SCREEN-COUNT. DTSCS8B 00895 EXEC CICS LINK DTSCS8B 00896 PROGRAM ('DTSCU013') DTSCS8B 00897 COMMAREA (L013-COMM-AREA) DTSCS8B 00898 END-EXEC. DTSCS8B 00899 S013-EXIT. DTSCS8B 00900 EXIT. DTSCS8B 00901 EJECT DTSCS8B 00902 S803-REQ-SCR-ID-EDIT. DTSCS8B 00903 EXEC CICS LINK DTSCS8B 00904 PROGRAM ('DTSCU803') DTSCS8B 00905 COMMAREA (DFHCOMMAREA) DTSCS8B 00906 END-EXEC. DTSCS8B 00907 S803-EXIT. DTSCS8B 00908 EXIT. DTSCS8B 00909 SKIP3 DTSCS8B 00910 S804-INVALID-KEY. DTSCS8B 00911 EXEC CICS LINK DTSCS8B 00912 PROGRAM ('DTSCU804') DTSCS8B 00913 COMMAREA (DFHCOMMAREA) DTSCS8B 00914 END-EXEC. DTSCS8B 00915 S804-EXIT. DTSCS8B 00916 EXIT. DTSCS8B 00917 SKIP3 DTSCS8B 00918 S805-MSG-AREA. DTSCS8B 00919 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS8B 00920 SKIP1 DTSCS8B 00921 EXEC CICS LINK DTSCS8B 00922 PROGRAM ('DTSCU805') DTSCS8B 00923 COMMAREA (L805-COMM-AREA) DTSCS8B 00924 END-EXEC. DTSCS8B 00925 DTSCS8B 00926 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS8B 00927 S805-EXIT. DTSCS8B 00928 EXIT. DTSCS8B 00929 DTSCS8B 00930 SKIP3 DTSCS8B 00931 S851-SCREEN-PROCESSING. DTSCS8B 00932 EXEC CICS LINK DTSCS8B 00933 PROGRAM ('DTSCU851') DTSCS8B 00934 COMMAREA (L851-COMM-AREA) DTSCS8B 00935 END-EXEC. DTSCS8B 00936 S851-EXIT. DTSCS8B 00937 EXIT. DTSCS8B 00938 SKIP3 DTSCS8B 00939 S899-ABEND. DTSCS8B 00940 EXEC CICS ABEND DTSCS8B 00941 ABCODE(WRK-ABEND-CD) DTSCS8B 00942 END-EXEC. DTSCS8B 00943 *S899-EXIT. DTSCS8B 00944 * EXIT. DTSCS8B 00945 S1101-ERROR. DTSCS8B 00946 SET RESP-SEND-MSGONLY TO TRUE DTSCS8B 00947 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA. DTSCS8B 00948 S1101-EXIT. DTSCS8B 00949 EXIT. DTSCS8B 00950 DTSCS8B 00951 S5100-SET-LOCK-ATTRB. DTSCS8B 00952 MOVE CATB-PROT-BRT-MDTOFF TO MAP-SELECT-LINE-NO-A DTSCS8B 00953 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A DTSCS8B 00954 MOVE CATB-PROT-NORM-MDTON TO MAP-JOB-DESC-A DTSCS8B 00955 PERFORM DTSCS8B 00956 VARYING WRK-SUB DTSCS8B 00957 FROM 1 BY 1 DTSCS8B 00958 UNTIL WRK-SUB > WRK-MAX-PARMS DTSCS8B 00959 MOVE CATB-PROT-BRT-MDTON TO MAP-LINE-A(WRK-SUB) DTSCS8B 00960 END-PERFORM. DTSCS8B 00961 S5100-EXIT. DTSCS8B 00962 EXIT. DTSCS8B 00963 DTSCS8B 00964 S5900-SET-ATTRB. DTSCS8B 00965 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SELECT-LINE-NO-A DTSCS8B 00966 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A DTSCS8B 00967 MOVE CATB-PROT-NORM-MDTON TO MAP-JOB-DESC-A DTSCS8B 00968 PERFORM DTSCS8B 00969 VARYING WRK-SUB DTSCS8B 00970 FROM 1 BY 1 DTSCS8B 00971 UNTIL WRK-SUB > WRK-MAX-PARMS DTSCS8B 00972 MOVE CATB-PROT-NORM-MDTON TO MAP-LINE-A(WRK-SUB) DTSCS8B 00973 END-PERFORM. DTSCS8B 00974 S5900-EXIT. DTSCS8B 00975 EXIT. DTSCS8B 00976 DTSCS8B 00977 DTSCS8B 00978 /*****************************************************************DTSCS8B 00979 * MAP ROUTINES *DTSCS8B 00980 ******************************************************************DTSCS8B 00981 S9100-RECEIVE. DTSCS8B 00982 SET L851-RECEIVE-88 TO TRUE. DTSCS8B 00983 SKIP1 DTSCS8B 00984 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS8B 00985 SKIP1 DTSCS8B 00986 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS8B 00987 SKIP1 DTSCS8B 00988 MOVE L851-AID TO LCCM-AID. DTSCS8B 00989 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS8B 00990 S9100-EXIT. DTSCS8B 00991 EXIT. DTSCS8B 00992 SKIP3 DTSCS8B 00993 S9200-SEND-DATAONLY. DTSCS8B 00994 MOVE LOW-VALUES TO MAP-AREA. DTSCS8B 00995 SKIP1 DTSCS8B 00996 IF LCCM-NO-MSG DTSCS8B 00997 NEXT SENTENCE DTSCS8B 00998 ELSE DTSCS8B 00999 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS8B 01000 SKIP1 DTSCS8B 01001 IF CURSOR-SET-GOTO DTSCS8B 01002 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS8B 01003 ELSE DTSCS8B 01004 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L DTSCS8B 01005 SKIP1 DTSCS8B 01006 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS8B 01007 SKIP1 DTSCS8B 01008 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS8B 01009 SKIP1 DTSCS8B 01010 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS8B 01011 S9200-EXIT. DTSCS8B 01012 EXIT. DTSCS8B 01013 SKIP3 DTSCS8B 01014 S9300-SEND-MAP. DTSCS8B 01015 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS8B 01016 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS8B 01017 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS8B 01018 SKIP1 DTSCS8B 01019 IF LCCM-F09-88 DTSCS8B 01020 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS8B 01021 ELSE DTSCS8B 01022 PERFORM S5900-SET-ATTRB THRU S5900-EXIT DTSCS8B 01023 END-IF DTSCS8B 01024 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS8B 01025 SKIP1 DTSCS8B 01026 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS8B 01027 SKIP1 DTSCS8B 01028 IF CURSOR-SET-NO DTSCS8B 01029 MOVE CATB-CURSOR TO MAP-SELECT-LINE-NO-L. DTSCS8B 01030 SKIP1 DTSCS8B 01031 SET L851-SEND-88 TO TRUE. DTSCS8B 01032 SKIP1 DTSCS8B 01033 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS8B 01034 SKIP1 DTSCS8B 01035 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS8B 01036 S9300-EXIT. DTSCS8B 01037 EXIT. DTSCS8B 01038 DTSCS8B 01039 S9320-INQUIRY-FKEYS. DTSCS8B 01040 IF LCCM-F09-88 AND LCCM-NO-MSG DTSCS8B 01041 INITIALIZE MAP-KEY-SUBMIT DTSCS8B 01042 SET LCCM-ERROR-MSG TO TRUE DTSCS8B 01043 MOVE WRK-CONFIRM-MSG TO LCCM-MSG-TEXT DTSCS8B 01044 END-IF. DTSCS8B 01045 S9320-EXIT. DTSCS8B 01046 EXIT. DTSCS8B 01047 DTSCS8B 01048 S9900-PREPARE-SEND. DTSCS8B 01049 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS8B 01050 LCCM-SCR-ID. DTSCS8B 01051 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS8B 01052 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS8B 01053 S9900-EXIT. DTSCS8B 01054 EXIT. DTSCS8B 01055 DTSCS8B 01056 S825-WRITE-T070. DTSCS8B 01057 MOVE LENGTH OF T070-REC TO T070-LENGTH DTSCS8B 01058 MOVE T070-REC TO RSKL-REC DTSCS8B 01059 SET L825-WRITE-88 TO TRUE DTSCS8B 01060 DTSCS8B 01061 EXEC CICS LINK DTSCS8B 01062 PROGRAM ('DTSCU825') DTSCS8B 01063 COMMAREA (L825-COMM-AREA) DTSCS8B 01064 END-EXEC. DTSCS8B 01065 DTSCS8B 01066 IF L825-FILE-CLOSED-88 DTSCS8B 01067 MOVE L825-MSG-AREA TO LCCM-MSG-AREA DTSCS8B 01068 END-IF. DTSCS8B 01069 S825-EXIT. DTSCS8B 01070 EXIT. DTSCS8B