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