00001 IDENTIFICATION DIVISION. 11/11/02 00002 PROGRAM-ID. DTSCS80. DTSCS80 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCS80 00005 DATE-COMPILED. DTSCS80 00006 SKIP3 DTSCS80 00007 ***** DTSCS80 00008 * DTSCS80 00009 * FUNCTION: REFERENCE MENU SCREEN PROCESSOR. DTSCS80 00010 * DTSCS80 00011 * DTSCS80 00012 * MODIFICATION LOG: DTSCS80 00013 * DTSCS80 00014 * 11/06/91 INITIAL DEVELOPMENT. DTSCS80 00015 * WORK ORDER: PROGRAMMER: TCL DTSCS80 00016 * DTSCS80 00017 * 04/11/94 MODIFIED FOR MONTANA. DTSCS80 00018 * WORK ORDER: PROGRAMMER: RHC DTSCS80 00019 * DTSCS80 00020 * 08/13/1998 REVIEWED AND MODIFIED FOR DC. DTSCS80 00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS80 00022 * DTSCS80 00023 * 06/12/2000 MODIFIED TO DISPLAY SCREEN 88. DTSCS80 00024 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCS80 00025 * DTSCS80 00026 * 11/14/2001 MODIFIED TO DISPLAY SCREEN 8A/8B. DTSCS80 00027 * REFERENCE: OJR IMPLEMENTATION PROGRAMMER: JMO' DTSCS80 00028 * DTSCS80 00029 * DTSCS80 00030 * 05/12/2002 MODIFIED TO DISPLAY SCREEN 89. DTSCS80 00031 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCS80 00032 * DTSCS80 00033 * DTSCS80 00034 * 06/07/2002 MODIFIED TO REMOVE SCREEN 8B (NOT USER SCREEN) DTSCS80 00035 * 8B CAN ONLY BE CALLED FROM 8A. DTSCS80 00036 * REFERENCE: OJR IMPLEMENTATION PROGRAMMER: ZL1' DTSCS80 00037 * DTSCS80 00038 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS80 00039 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS80 00040 * DTSCS80 00041 * DTSCS80 00042 * DESCRIPTION: DTSCS80 00043 * DTSCS80 00044 * IF SCREEN '80' NOT CURRENTLY DISPLAYED DTSCS80 00045 * SEND SCREEN 80 (WITH PMSG-KEY-OPTION MESSAGE) DTSCS80 00046 * RETURN TO DRIVER. DTSCS80 00047 * DTSCS80 00048 * RECEIVE SCREEN '80'. DTSCS80 00049 * DTSCS80 00050 * IF CLEAR KEY PRESSED DTSCS80 00051 * SEND SCREEN 80 (WITH PMSG-KEY-OPTION MESSAGE) DTSCS80 00052 * SET LCCM-END-TASK-88 TO TRUE DTSCS80 00053 * RETURN TO DRIVER. DTSCS80 00054 * DTSCS80 00055 * IF PA2 KEY PRESSED DTSCS80 00056 * SEND SCREEN 80 (DATA ONLY) DTSCS80 00057 * SET LCCM-END-TASK-88 TO TRUE DTSCS80 00058 * RETURN TO DRIVER. DTSCS80 00059 * DTSCS80 00060 * IF F3 KEY PRESSED DTSCS80 00061 * MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS80 00062 * SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS80 00063 * RETURN TO DRIVER. DTSCS80 00064 * DTSCS80 00065 * IF F4 KEY PRESSED DTSCS80 00066 * MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS80 00067 * SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS80 00068 * RETURN TO DRIVER. DTSCS80 00069 * DTSCS80 00070 * IF NOT ENTER KEY PRESSED DTSCS80 00071 * BUILD INVALID KEY MESSAGE (VIA LINK TO DTSCU804) DTSCS80 00072 * SEND SCREEN 80 (WITH THE INVALID KEY PRESSED MESSAGE) DTSCS80 00073 * SET LCCM-END-TASK-88 TO TRUE DTSCS80 00074 * RETURN TO DRIVER. DTSCS80 00075 * DTSCS80 00076 * DTSCS80 00077 * IF MAP-OPT = SPACES OR LOW-VALUES OR '80' DTSCS80 00078 * SEND SCREEN 00 (WITH THE PMSG-KEY-OPTION MESSAGE) DTSCS80 00079 * SET LCCM-END-TASK-88 TO TRUE DTSCS80 00080 * RETURN TO DRIVER. DTSCS80 00081 * DTSCS80 00082 * CONVERT MAP-OPT INTO A SCREEN IDENTIFIER, PLACING THE DTSCS80 00083 * RESULT IN LCCM-REQ-SCR-ID. DTSCS80 00084 * DTSCS80 00085 * EDIT LCCM-REQ-SCR-ID FOR VALIDITY (VIA A CALL TO DTSIU803). DTSCS80 00086 * DTSCS80 00087 * IF LCCM-REQ-SCR-ID VALID (LCCM-NO-MSG) DTSCS80 00088 * SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS80 00089 * RETURN TO DRIVER DTSCS80 00090 * ELSE DTSCS80 00091 * SEND SCREEN 80 (WITH ERROR MESSAGE) DTSCS80 00092 * SET LCCM-END-TASK-88 TO TRUE DTSCS80 00093 * RETURN TO DRIVER. DTSCS80 00094 * DTSCS80 00095 * DTSCS80 00096 ***** DTSCS80 00097 SKIP3 DTSCS80 00098 ENVIRONMENT DIVISION. DTSCS80 00099 SKIP3 DTSCS80 00100 DATA DIVISION. DTSCS80 00101 SKIP3 DTSCS80 00102 WORKING-STORAGE SECTION. DTSCS80 001025 77 PAN-VALET PICTURE X(24) VALUE '009DTSCS80 11/11/02'. DTSCS80 00103 SKIP3 DTSCS80 00104 01 WRK-AREA. DTSCS80 00105 05 WRK-ABEND-CD PIC X(04) VALUE 'S80 '. DTSCS80 00106 05 WRK-RESP-CD PIC S9(08) COMP. DTSCS80 00107 DTSCS80 00108 05 WRK-SCR-ID PIC X(02) VALUE '80'. DTSCS80 00109 05 WRK-F03-SCR-ID PIC X(02) VALUE '00'. DTSCS80 00110 DTSCS80 00111 05 RESP-IND PIC X(01). DTSCS80 00112 88 RESP-CURSOR-TO-OPT-88 VALUE 'C'. DTSCS80 00113 88 RESP-MSGONLY-88 VALUE 'M'. DTSCS80 00114 88 RESP-SCREEN-88 VALUE 'S'. DTSCS80 00115 88 RESP-JUMP-88 VALUE 'J'. DTSCS80 00116 DTSCS80 00117 05 CURSOR-IND PIC X(01). DTSCS80 00118 88 CURSOR-SET-88 VALUE 'Y'. DTSCS80 00119 DTSCS80 00120 05 WRK-DATE-AREA. DTSCS80 00121 10 WRK-DATE PIC X(08). DTSCS80 00122 10 FILLER PIC X(01) VALUE '.'. DTSCS80 00123 EJECT DTSCS80 00124 01 L851-COMM-AREA. DTSCS80 00125 ++INCLUDE DTSIL851 DTSCS80 00126 SKIP3 DTSCS80 00127 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS80 00128 ++INCLUDE DTSISSM DTSCS80 00129 EJECT DTSCS80 00130 01 L805-COMM-AREA. DTSCS80 00131 ++INCLUDE DTSIL805 DTSCS80 00132 EJECT DTSCS80 00133 01 CATB-LITERALS. DTSCS80 00134 ++INCLUDE DTSICATB DTSCS80 00135 SKIP3 DTSCS80 00136 01 EMSG-LITERALS. DTSCS80 00137 ++INCLUDE DTSICECD DTSCS80 00138 SKIP3 DTSCS80 00139 01 PMSG-LITERALS. DTSCS80 00140 ++INCLUDE DTSICPCD DTSCS80 00141 EJECT DTSCS80 00142 LINKAGE SECTION. DTSCS80 00143 SKIP3 DTSCS80 00144 01 DFHCOMMAREA. DTSCS80 00145 ++INCLUDE DTSILCCM DTSCS80 00146 EJECT DTSCS80 00147 PROCEDURE DIVISION. DTSCS80 00148 SKIP2 DTSCS80 00149 MOVE LOW-VALUES TO MAP-AREA. DTSCS80 00150 DTSCS80 00151 MOVE 'N' TO CURSOR-IND. DTSCS80 00152 SKIP2 DTSCS80 00153 MOVE SPACE TO RESP-IND. DTSCS80 00154 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS80 00155 SKIP2 DTSCS80 00156 IF RESP-MSGONLY-88 DTSCS80 00157 MOVE LOW-VALUES TO MAP-AREA DTSCS80 00158 PERFORM S805-MSG-AREA THRU S805-EXIT DTSCS80 00159 PERFORM S2200-SEND-DATAONLY THRU S2200-EXIT DTSCS80 00160 SET LCCM-END-TASK-88 TO TRUE DTSCS80 00161 ELSE DTSCS80 00162 IF RESP-SCREEN-88 DTSCS80 00163 PERFORM P2000-CONSTRUCT-S-AREA THRU P2000-EXIT DTSCS80 00164 PERFORM S2100-SEND THRU S2100-EXIT DTSCS80 00165 SET LCCM-END-TASK-88 TO TRUE DTSCS80 00166 ELSE DTSCS80 00167 IF RESP-JUMP-88 DTSCS80 00168 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS80 00169 ELSE DTSCS80 00170 IF RESP-CURSOR-TO-OPT-88 DTSCS80 00171 MOVE LOW-VALUES TO MAP-AREA DTSCS80 00172 MOVE CATB-CURSOR TO MAP-OPT-L DTSCS80 00173 SET CURSOR-SET-88 TO TRUE DTSCS80 00174 PERFORM S2200-SEND-DATAONLY THRU S2200-EXIT DTSCS80 00175 SET LCCM-END-TASK-88 TO TRUE DTSCS80 00176 ELSE DTSCS80 00177 PERFORM S899-ABEND THRU S899-EXIT. DTSCS80 00178 SKIP2 DTSCS80 00179 EXEC CICS DTSCS80 00180 RETURN DTSCS80 00181 END-EXEC. DTSCS80 00182 SKIP2 DTSCS80 00183 GOBACK. DTSCS80 00184 EJECT DTSCS80 00185 P1000-ANALYZE-REQUEST. DTSCS80 00186 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS80 00187 MOVE PMSG-KEY-OPTION TO LCCM-MSG-AREA DTSCS80 00188 SET RESP-SCREEN-88 TO TRUE DTSCS80 00189 GO TO P1000-EXIT. DTSCS80 00190 DTSCS80 00191 PERFORM S1100-RECEIVE THRU S1100-EXIT. DTSCS80 00192 DTSCS80 00193 IF LCCM-CLEAR-88 OR LCCM-F12-88 DTSCS80 00194 MOVE LOW-VALUES TO MAP-AREA DTSCS80 00195 MOVE PMSG-KEY-OPTION TO LCCM-MSG-AREA DTSCS80 00196 SET RESP-SCREEN-88 TO TRUE DTSCS80 00197 GO TO P1000-EXIT. DTSCS80 00198 DTSCS80 00199 IF LCCM-PA2-88 DTSCS80 00200 SET RESP-CURSOR-TO-OPT-88 TO TRUE DTSCS80 00201 GO TO P1000-EXIT. DTSCS80 00202 DTSCS80 00203 IF LCCM-ENTER-88 OR LCCM-F03-88 OR LCCM-F04-88 OR LCCM-F14-88DTSCS80 00204 NEXT SENTENCE DTSCS80 00205 ELSE DTSCS80 00206 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS80 00207 SET RESP-MSGONLY-88 TO TRUE DTSCS80 00208 GO TO P1000-EXIT. DTSCS80 00209 DTSCS80 00210 IF LCCM-F03-88 DTSCS80 00211 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS80 00212 SET RESP-JUMP-88 TO TRUE DTSCS80 00213 GO TO P1000-EXIT. DTSCS80 00214 DTSCS80 00215 IF LCCM-F04-88 DTSCS80 00216 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS80 00217 SET RESP-JUMP-88 TO TRUE DTSCS80 00218 GO TO P1000-EXIT. DTSCS80 00219 DTSCS80 00220 IF LCCM-F14-88 DTSCS80 00221 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS80 00222 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT DTSCS80 00223 IF LCCM-MSG DTSCS80 00224 SET RESP-SCREEN-88 TO TRUE DTSCS80 00225 GO TO P1000-EXIT DTSCS80 00226 ELSE DTSCS80 00227 SET RESP-JUMP-88 TO TRUE DTSCS80 00228 GO TO P1000-EXIT. DTSCS80 00229 DTSCS80 00230 IF MAP-OPT = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS80 00231 MOVE PMSG-KEY-OPTION TO LCCM-MSG-AREA DTSCS80 00232 SET RESP-SCREEN-88 TO TRUE DTSCS80 00233 GO TO P1000-EXIT. DTSCS80 00234 DTSCS80 00235 IF MAP-OPT = '1 ' OR ' 1' DTSCS80 00236 MOVE '81' TO LCCM-REQ-SCR-ID DTSCS80 00237 ELSE DTSCS80 00238 IF MAP-OPT = '2 ' OR ' 2' DTSCS80 00239 MOVE '82' TO LCCM-REQ-SCR-ID DTSCS80 00240 ELSE DTSCS80 00241 IF MAP-OPT = '3 ' OR ' 3' DTSCS80 00242 MOVE '83' TO LCCM-REQ-SCR-ID DTSCS80 00243 ELSE DTSCS80 00244 IF MAP-OPT = '4 ' OR ' 4' DTSCS80 00245 MOVE '84' TO LCCM-REQ-SCR-ID DTSCS80 00246 ELSE DTSCS80 00247 IF MAP-OPT = '5 ' OR ' 5' DTSCS80 00248 MOVE '85' TO LCCM-REQ-SCR-ID DTSCS80 00249 ELSE DTSCS80 00250 IF MAP-OPT = '6 ' OR ' 6' DTSCS80 00251 MOVE '86' TO LCCM-REQ-SCR-ID DTSCS80 00252 ELSE DTSCS80 00253 IF MAP-OPT = '7 ' OR ' 7' DTSCS80 00254 MOVE '87' TO LCCM-REQ-SCR-ID DTSCS80 00255 ELSE DTSCS80 00256 IF MAP-OPT = '8 ' OR ' 8' DTSCS80 00257 MOVE '88' TO LCCM-REQ-SCR-ID DTSCS80 00258 ELSE DTSCS80 00259 IF MAP-OPT = '9 ' OR ' 9' DTSCS80 00260 MOVE '89' TO LCCM-REQ-SCR-ID DTSCS80 00261 ELSE DTSCS80 00262 IF MAP-OPT = 'A ' OR ' A' DTSCS80 00263 MOVE '8A' TO LCCM-REQ-SCR-ID DTSCS80 00264 ELSE DTSCS80 00265 MOVE MAP-OPT TO LCCM-REQ-SCR-ID. DTSCS80 00266 DTSCS80 00267 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS80 00268 IF LCCM-MSG DTSCS80 00269 SET RESP-SCREEN-88 TO TRUE DTSCS80 00270 ELSE DTSCS80 00271 SET RESP-JUMP-88 TO TRUE. DTSCS80 00272 P1000-EXIT. DTSCS80 00273 EXIT. DTSCS80 00274 EJECT DTSCS80 00275 P2000-CONSTRUCT-S-AREA. DTSCS80 00276 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS80 00277 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS80 00278 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS80 00279 DTSCS80 00280 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS80 00281 P2000-EXIT. DTSCS80 00282 EXIT. DTSCS80 00283 EJECT DTSCS80 00284 S803-REQ-SCR-ID-EDIT. DTSCS80 00285 DTSCS80 00286 EXEC CICS DTSCS80 00287 LINK DTSCS80 00288 PROGRAM ('DTSCU803') DTSCS80 00289 COMMAREA (DFHCOMMAREA) DTSCS80 00290 END-EXEC. DTSCS80 00291 DTSCS80 00292 S803-EXIT. DTSCS80 00293 EXIT. DTSCS80 00294 SKIP3 DTSCS80 00295 S804-INVALID-KEY. DTSCS80 00296 DTSCS80 00297 EXEC CICS DTSCS80 00298 LINK DTSCS80 00299 PROGRAM ('DTSCU804') DTSCS80 00300 COMMAREA (DFHCOMMAREA) DTSCS80 00301 END-EXEC. DTSCS80 00302 DTSCS80 00303 S804-EXIT. DTSCS80 00304 EXIT. DTSCS80 00305 SKIP3 DTSCS80 00306 S805-MSG-AREA. DTSCS80 00307 MOVE LCCM-MSG-AREA TO L805-MSG-AREA. DTSCS80 00308 DTSCS80 00309 EXEC CICS DTSCS80 00310 LINK DTSCS80 00311 PROGRAM ('DTSCU805') DTSCS80 00312 COMMAREA (L805-COMM-AREA) DTSCS80 00313 END-EXEC. DTSCS80 00314 DTSCS80 00315 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS80 00316 S805-EXIT. DTSCS80 00317 EXIT. DTSCS80 00318 SKIP3 DTSCS80 00319 S851-SCREEN-PROCESSING. DTSCS80 00320 EXEC CICS DTSCS80 00321 LINK DTSCS80 00322 PROGRAM ('DTSCU851') DTSCS80 00323 COMMAREA (L851-COMM-AREA) DTSCS80 00324 END-EXEC. DTSCS80 00325 S851-EXIT. DTSCS80 00326 EXIT. DTSCS80 00327 SKIP3 DTSCS80 00328 S899-ABEND. DTSCS80 00329 DTSCS80 00330 EXEC CICS DTSCS80 00331 ABEND DTSCS80 00332 ABCODE (WRK-ABEND-CD) DTSCS80 00333 END-EXEC. DTSCS80 00334 DTSCS80 00335 S899-EXIT. DTSCS80 00336 EXIT. DTSCS80 00337 EJECT DTSCS80 00338 S1100-RECEIVE. DTSCS80 00339 SET L851-RECEIVE-88 TO TRUE. DTSCS80 00340 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS80 00341 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS80 00342 MOVE L851-AID TO LCCM-AID. DTSCS80 00343 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS80 00344 S1100-EXIT. DTSCS80 00345 EXIT. DTSCS80 00346 SKIP3 DTSCS80 00347 S2100-SEND. DTSCS80 00348 SET L851-SEND-88 TO TRUE. DTSCS80 00349 PERFORM S2900-PREPARE-SEND THRU S2900-EXIT. DTSCS80 00350 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS80 00351 S2100-EXIT. DTSCS80 00352 EXIT. DTSCS80 00353 SKIP3 DTSCS80 00354 S2200-SEND-DATAONLY. DTSCS80 00355 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS80 00356 PERFORM S2900-PREPARE-SEND THRU S2900-EXIT. DTSCS80 00357 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS80 00358 S2200-EXIT. DTSCS80 00359 EXIT. DTSCS80 00360 SKIP3 DTSCS80 00361 S2900-PREPARE-SEND. DTSCS80 00362 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS80 00363 LCCM-SCR-ID. DTSCS80 00364 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS80 00365 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS80 00366 IF CURSOR-SET-88 DTSCS80 00367 NEXT SENTENCE DTSCS80 00368 ELSE DTSCS80 00369 MOVE CATB-CURSOR TO MAP-OPT-L. DTSCS80 00370 S2900-EXIT. DTSCS80 00371 EXIT. DTSCS80