DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
843
CICS/DTSCS8A.cob
Normal file
843
CICS/DTSCS8A.cob
Normal file
@ -0,0 +1,843 @@
|
||||
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
|
||||
Reference in New Issue
Block a user