1072 lines
84 KiB
COBOL
1072 lines
84 KiB
COBOL
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
|