00001 IDENTIFICATION DIVISION. 08/19/99 00002 PROGRAM-ID. DTSCS78. DTSCS78 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV005 00004 DATE-WRITTEN. MAY 1994. DTSCS78 00005 DATE-COMPILED. DTSCS78 00006 SKIP3 DTSCS78 00007 ***** DTSCS78 00008 * DTSCS78 00009 * FUNCTION: CORRESPONDENCE QUEUE INQUIRY/UPDATE DTSCS78 00010 * SCREEN PROCESSOR. DTSCS78 00011 * DTSCS78 00012 * DTSCS78 00013 * MODIFICATION LOG: DTSCS78 00014 * CL**2 00015 * 10/05/98 INITIAL DEVELOPMENT. COPIED FROM MACCS78 CL**2 00016 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00017 * DTSCS78 00018 * 08/19/1999 IN DC, F23 IS DELETE KEY - NOT F11. CL**5 00019 * REFERENCE: CODE REVIEW PROGRAMMER: EHH CL**5 00020 * CL**5 00021 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5 00022 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX CL**5 00023 * REFERENCE: XXXXXXXXXXXXXXXXXX PROGRAMMER: XXX CL**5 00024 * DTSCS78 00025 * DTSCS78 00026 * DESCRIPTION: DTSCS78 00027 * DTSCS78 00028 * CLEAR: DTSCS78 00029 * DTSCS78 00030 * FIELD DISPLAYED: NONE. DTSCS78 00031 * DTSCS78 00032 * DTSCS78 00033 * JUMP: DTSCS78 00034 * DTSCS78 00035 * NONE. DTSCS78 00036 * DTSCS78 00037 * DTSCS78 00038 * INQUIRY: DTSCS78 00039 * DTSCS78 00040 * CONTROL FIELD(S): MAP-QUEUE-ID. DTSCS78 00041 * DTSCS78 00042 * JUMP IN: DISPLAY RECORD FROM THE CORRESPONDENCE QUEUE DTSCS78 00043 * INDICATED BY LCCM-RESP-OP-ID. DTSCS78 00044 * DTSCS78 00045 * ENTER, F05, F06, F07, F08: STANDARD PAGING. DTSCS78 00046 * DTSCS78 00047 * DISPLAY SEQUENCE: ASCENDING ON VCOR-ESTB-ABSTIME. DTSCS78 00048 * DTSCS78 00049 * PAGE INITIALLY DISPLAYED: FIRST. DTSCS78 00050 * DTSCS78 00051 * DTSCS78 00052 * JUMP OUT: STANDARD LCCM-RESP-OP-ID MAINTENANCE. DTSCS78 00053 * DTSCS78 00054 * DTSCS78 00055 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS78 00056 * DTSCS78 00057 * DTSCS78 00058 * UPDATE: DTSCS78 00059 * DTSCS78 00060 * DEL DTSCS78 00061 * DTSCS78 00062 * DELETE VERIFICATION FUNCTION IS DISABLED. DTSCS78 00063 * DTSCS78 00064 * FOLLOWING A SUCCESSFUL DELETE, DISPLAY THE NEXT DTSCS78 00065 * CORRESPONDENCE QUEUE RECORD (THE NEXT CORRESPONDENCE DTSCS78 00066 * QUEUE RECORD WITH VCOR-QUEUE-ID EQUAL TO MAP-QUEUE-ID). DTSCS78 00067 * DTSCS78 00068 * DTSCS78 00069 * RECORDS READ: DTSCS78 00070 * DTSCS78 00071 * MASTER: DTSCS78 00072 * DTSCS78 00073 * NONE. DTSCS78 00074 * DTSCS78 00075 * DTSCS78 00076 * ALTERNATE INDEX: DTSCS78 00077 * DTSCS78 00078 * NONE. DTSCS78 00079 * DTSCS78 00080 * DTSCS78 00081 * REFERENCE: DTSCS78 00082 * DTSCS78 00083 * NONE. DTSCS78 00084 * DTSCS78 00085 * DTSCS78 00086 * ACCOUNTING TRANSACTION COLLECTION: DTSCS78 00087 * DTSCS78 00088 * NONE. DTSCS78 00089 * DTSCS78 00090 * DTSCS78 00091 * VSAM KSDS WORK: DTSCS78 00092 * DTSCS78 00093 * VCOR DTSCS78 00094 * DTSCS78 00095 * DTSCS78 00096 * RECORDS UPDATED: DTSCS78 00097 * DTSCS78 00098 * MASTER: DTSCS78 00099 * DTSCS78 00100 * NONE. DTSCS78 00101 * DTSCS78 00102 * DTSCS78 00103 * REFERENCE: DTSCS78 00104 * DTSCS78 00105 * NONE. DTSCS78 00106 * DTSCS78 00107 * DTSCS78 00108 * ACCOUNTING TRANSACTION COLLECTION: DTSCS78 00109 * DTSCS78 00110 * NONE. DTSCS78 00111 * DTSCS78 00112 * DTSCS78 00113 * VSAM KSDS WORK: DTSCS78 00114 * DTSCS78 00115 * VCOR DTSCS78 00116 * DTSCS78 00117 * DTSCS78 00118 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS78 00119 * DTSCS78 00120 * NONE. DTSCS78 00121 * DTSCS78 00122 * DTSCS78 00123 * TEMPORARY STORAGE USAGE: DTSCS78 00124 * DTSCS78 00125 * NONE DTSCS78 00126 * DTSCS78 00127 * DTSCS78 00128 * MODULES LINKED TO: DTSCS78 00129 * DTSCS78 00130 * DTSCU082 OPERATOR ID EDIT/LOOKUP. CL**2 00131 * DTSCU827 VSAM KSDS WORK FILE INPUT/OUTPUT. CL**2 00132 * DTSCS78 00133 * DTSCS78 00134 * VERMONT REFERENCE: DTSCS78 00135 * DTSCS78 00136 * NONE. DTSCS78 00137 * DTSCS78 00138 ***** DTSCS78 00139 SKIP3 DTSCS78 00140 ENVIRONMENT DIVISION. DTSCS78 00141 SKIP3 DTSCS78 00142 DATA DIVISION. DTSCS78 00143 SKIP3 DTSCS78 00144 WORKING-STORAGE SECTION. DTSCS78 001445 77 PAN-VALET PICTURE X(24) VALUE '005DTSCS78 08/19/99'. DTSCS78 00145 SKIP3 DTSCS78 00146 01 WRK-AREA. DTSCS78 00147 05 WRK-ABEND-CD PIC X(04) VALUE 'S78 '. DTSCS78 00148 SKIP1 DTSCS78 00149 05 WRK-SCR-ID. DTSCS78 00150 10 WRK-SCR-ID-N PIC 9(02) VALUE 78. DTSCS78 00151 SKIP1 DTSCS78 00152 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS78 00153 SKIP1 DTSCS78 00154 05 WRK-LINE-MAX PIC S9(04) COMP VALUE +20. DTSCS78 00155 SKIP1 DTSCS78 00156 05 WRK-LINE-LENGTH PIC S9(04) COMP VALUE +79. DTSCS78 00157 SKIP3 DTSCS78 00158 05 SCR-ACCESS-IND PIC X(01). DTSCS78 00159 88 SCR-ACCESS-INQ VALUE '1'. DTSCS78 00160 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS78 00161 SKIP1 DTSCS78 00162 05 CURSOR-SET-IND PIC X(01). DTSCS78 00163 88 CURSOR-SET-YES VALUE 'Y'. DTSCS78 00164 88 CURSOR-SET-NO VALUE 'N'. DTSCS78 00165 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS78 00166 SKIP1 DTSCS78 00167 05 REQ-IND PIC X(01). DTSCS78 00168 88 REQ-ERROR VALUE 'O'. DTSCS78 00169 88 REQ-JUMP VALUE 'J'. DTSCS78 00170 88 REQ-INQUIRE VALUE 'I'. DTSCS78 00171 88 REQ-CLEAR VALUE 'C'. DTSCS78 00172 88 REQ-EDIT VALUE 'E'. DTSCS78 00173 *********88 REQ-UPDATE VALUE 'U'. DTSCS78 00174 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS78 00175 SKIP1 DTSCS78 00176 05 RESP-IND PIC X(01). DTSCS78 00177 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS78 00178 88 RESP-SEND-MAP VALUE 'M'. DTSCS78 00179 88 RESP-JUMP VALUE 'J'. DTSCS78 00180 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS78 00181 SKIP1 DTSCS78 00182 05 WRK-MSG-AREA PIC X(64). DTSCS78 00183 SKIP1 DTSCS78 00184 05 WRK-ATB-AN PIC X(01). DTSCS78 00185 05 WRK-ATB-NUM PIC X(01). DTSCS78 00186 SKIP1 DTSCS78 00187 05 WRK-QUEUE-ID PIC X(08). DTSCS78 00188 SKIP3 DTSCS78 00189 05 WRK-DISPLAY PIC 9(11). DTSCS78 00190 SKIP1 DTSCS78 00191 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78 00192 10 FILLER PIC X(05). DTSCS78 00193 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS78 00194 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS78 00195 SKIP1 DTSCS78 00196 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78 00197 10 FILLER PIC X(05). DTSCS78 00198 10 WRK-DISPLAY-YR PIC X(02). DTSCS78 00199 10 WRK-DISPLAY-MO PIC X(02). DTSCS78 00200 10 WRK-DISPLAY-DA PIC X(02). DTSCS78 00201 SKIP1 DTSCS78 00202 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78 00203 10 FILLER PIC X(08). DTSCS78 00204 10 WRK-DISPLAY-QTR-YR PIC X(02). DTSCS78 00205 10 WRK-DISPLAY-QTR-Q PIC X(01). DTSCS78 00206 SKIP1 DTSCS78 00207 05 FILLER REDEFINES WRK-DISPLAY. DTSCS78 00208 10 FILLER PIC X(08). DTSCS78 00209 10 WRK-DISPLAY-ID-NO PIC X(03). DTSCS78 00210 SKIP3 DTSCS78 00211 05 INQUIRY-CONTROL-AREA. DTSCS78 00212 10 LAST-REC-NUM PIC S9(08) COMP. DTSCS78 00213 10 WS-REC-NUM PIC S9(08) COMP. DTSCS78 00214 SKIP1 DTSCS78 00215 10 SCR-REC-KEY-AREA PIC X(32). DTSCS78 00216 SKIP1 DTSCS78 00217 10 WRK-REC-KEY-AREA PIC X(32). DTSCS78 00218 SKIP1 DTSCS78 00219 10 LAST-REC-KEY-AREA PIC X(32). DTSCS78 00220 SKIP1 DTSCS78 00221 10 WS-REC-FOUND-IND PIC X(01). DTSCS78 00222 SKIP3 DTSCS78 00223 05 COR-START PIC S9(04) COMP. DTSCS78 00224 05 LINE-SUB PIC S9(04) COMP. DTSCS78 00225 *****EJECT DTSCS78 00226 *01 MSG-LITERALS. DTSCS78 00227 *****05 MSG-E781-AREA. DTSCS78 00228 ***** 10 FILLER PIC X(04) VALUE 'E781'. DTSCS78 00229 ***** 10 FILLER PIC X(30) DTSCS78 00230 ***** VALUE ' '. DTSCS78 00231 ***** 10 FILLER PIC X(30) DTSCS78 00232 ***** VALUE ' '. DTSCS78 00233 EJECT DTSCS78 00234 01 L082-COMM-AREA. DTSCS78 00235 ++INCLUDE DTSIL082 CL**2 00236 EJECT DTSCS78 00237 01 L805-COMM-AREA. DTSCS78 00238 ++INCLUDE DTSIL805 CL**2 00239 EJECT DTSCS78 00240 01 L827-COMM-AREA. DTSCS78 00241 05 L827-CONTROL-BLOCK. DTSCS78 00242 ++INCLUDE DTSIL827 CL**2 00243 EJECT DTSCS78 00244 05 VSKL-REC. DTSCS78 00245 ++INCLUDE DTSIVSKL CL**2 00246 EJECT DTSCS78 00247 01 VCOR-REC. DTSCS78 00248 ++INCLUDE DTSIVCOR CL**2 00249 EJECT DTSCS78 00250 01 L851-COMM-AREA. DTSCS78 00251 ++INCLUDE DTSIL851 CL**2 00252 SKIP3 DTSCS78 00253 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS78 00254 ++INCLUDE DTSIS78 CL**2 00255 EJECT DTSCS78 00256 01 CATB-LITERALS. DTSCS78 00257 ++INCLUDE DTSICATB CL**2 00258 SKIP3 DTSCS78 00259 01 CFKD-LITERALS. DTSCS78 00260 ++INCLUDE DTSICFKD CL**2 00261 SKIP3 DTSCS78 00262 01 CECD-LITERALS. DTSCS78 00263 ++INCLUDE DTSICECD CL**2 00264 SKIP3 DTSCS78 00265 01 CPCD-LITERALS. DTSCS78 00266 ++INCLUDE DTSICPCD CL**2 00267 EJECT DTSCS78 00268 LINKAGE SECTION. DTSCS78 00269 SKIP3 DTSCS78 00270 01 DFHCOMMAREA. DTSCS78 00271 ++INCLUDE DTSILCCM CL**2 00272 EJECT DTSCS78 00273 ******************************************************************DTSCS78 00274 * *DTSCS78 00275 ******************************************************************DTSCS78 00276 SKIP1 DTSCS78 00277 PROCEDURE DIVISION. DTSCS78 00278 SKIP2 DTSCS78 00279 MOVE LOW-VALUES TO MAP-AREA. DTSCS78 00280 MOVE SPACES TO WRK-QUEUE-ID. DTSCS78 00281 SKIP1 DTSCS78 00282 SET CURSOR-SET-NO TO TRUE. DTSCS78 00283 SKIP1 DTSCS78 00284 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS78 00285 TO SCR-ACCESS-IND. DTSCS78 00286 SKIP3 DTSCS78 00287 MOVE SPACE TO REQ-IND. DTSCS78 00288 SKIP1 DTSCS78 00289 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS78 00290 SKIP1 DTSCS78 00291 *----------------------------------------------------- DTSCS78 00292 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS78 00293 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS78 00294 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS78 00295 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS78 00296 * DTSCS78 00297 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS78 00298 * PROCESSED. DTSCS78 00299 * DTSCS78 00300 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS78 00301 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS78 00302 * WORK STATION OPERATOR. DTSCS78 00303 *----------------------------------------------------- DTSCS78 00304 SKIP1 DTSCS78 00305 MOVE SPACE TO RESP-IND. DTSCS78 00306 SKIP1 DTSCS78 00307 IF REQ-ERROR DTSCS78 00308 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS78 00309 ELSE DTSCS78 00310 IF REQ-JUMP DTSCS78 00311 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS78 00312 ELSE DTSCS78 00313 IF REQ-CLEAR DTSCS78 00314 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS78 00315 ELSE DTSCS78 00316 IF REQ-CURSOR-TO-GOTO DTSCS78 00317 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS78 00318 ELSE DTSCS78 00319 IF REQ-INQUIRE DTSCS78 00320 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS78 00321 ELSE DTSCS78 00322 IF REQ-EDIT DTSCS78 00323 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS78 00324 ELSE DTSCS78 00325 *****IF REQ-UPDATE DTSCS78 00326 ***** PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS78 00327 *****ELSE DTSCS78 00328 GO TO S899-ABEND. DTSCS78 00329 SKIP3 DTSCS78 00330 *----------------------------------------------------- DTSCS78 00331 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS78 00332 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS78 00333 *----------------------------------------------------- DTSCS78 00334 SKIP1 DTSCS78 00335 IF RESP-SEND-MAP DTSCS78 00336 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS78 00337 SET LCCM-END-TASK-88 TO TRUE DTSCS78 00338 ELSE DTSCS78 00339 IF RESP-SEND-MSGONLY DTSCS78 00340 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS78 00341 SET LCCM-END-TASK-88 TO TRUE DTSCS78 00342 ELSE DTSCS78 00343 IF RESP-JUMP DTSCS78 00344 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS78 00345 ELSE DTSCS78 00346 IF RESP-CURSOR-TO-GOTO DTSCS78 00347 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS78 00348 SET LCCM-END-TASK-88 TO TRUE DTSCS78 00349 ELSE DTSCS78 00350 GO TO S899-ABEND. DTSCS78 00351 SKIP3 DTSCS78 00352 MAINLINE-EXIT. DTSCS78 00353 SKIP1 DTSCS78 00354 EXEC CICS DTSCS78 00355 RETURN DTSCS78 00356 END-EXEC. DTSCS78 00357 SKIP2 DTSCS78 00358 GOBACK. DTSCS78 00359 EJECT DTSCS78 00360 /*****************************************************************DTSCS78 00361 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS78 00362 ******************************************************************DTSCS78 00363 P1000-ANALYZE-REQUEST. DTSCS78 00364 SKIP1 DTSCS78 00365 *----------------------------------------------------- DTSCS78 00366 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS78 00367 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS78 00368 * REPLACED WITH ENTER) DTSCS78 00369 *----------------------------------------------------- DTSCS78 00370 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS78 00371 SET LCCM-ENTER-88 TO TRUE DTSCS78 00372 SET REQ-INQUIRE TO TRUE DTSCS78 00373 MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID DTSCS78 00374 GO TO P1000-EXIT. DTSCS78 00375 SKIP3 DTSCS78 00376 *----------------------------------------------------- DTSCS78 00377 * MAP IS RECEIVED DTSCS78 00378 *----------------------------------------------------- DTSCS78 00379 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS78 00380 SKIP3 DTSCS78 00381 *----------------------------------------------------- DTSCS78 00382 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS78 00383 * WORK STATION DTSCS78 00384 *----------------------------------------------------- DTSCS78 00385 IF LCCM-CLEAR-88 DTSCS78 00386 SET REQ-CLEAR TO TRUE DTSCS78 00387 GO TO P1000-EXIT. DTSCS78 00388 SKIP3 DTSCS78 00389 *----------------------------------------------------- DTSCS78 00390 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS78 00391 *----------------------------------------------------- DTSCS78 00392 IF LCCM-PA2-88 DTSCS78 00393 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS78 00394 GO TO P1000-EXIT. DTSCS78 00395 SKIP3 DTSCS78 00396 *----------------------------------------------------- DTSCS78 00397 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS78 00398 *----------------------------------------------------- DTSCS78 00399 IF LCCM-PA-88 DTSCS78 00400 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS78 00401 SET REQ-ERROR TO TRUE DTSCS78 00402 GO TO P1000-EXIT. DTSCS78 00403 SKIP3 DTSCS78 00404 *----------------------------------------------------- CL**2 00405 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS CL**2 00406 * CLEAR SCREEN CL**2 00407 *----------------------------------------------------- CL**2 00408 IF LCCM-F12-88 CL**2 00409 MOVE LOW-VALUES TO MAP-AREA CL**2 00410 SET REQ-CLEAR TO TRUE CL**2 00411 GO TO P1000-EXIT. CL**2 00412 SKIP3 CL**2 00413 *----------------------------------------------------- DTSCS78 00414 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS78 00415 *----------------------------------------------------- DTSCS78 00416 IF LCCM-F03-88 DTSCS78 00417 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS78 00418 SET REQ-JUMP TO TRUE DTSCS78 00419 GO TO P1000-EXIT. DTSCS78 00420 SKIP3 DTSCS78 00421 *----------------------------------------------------- DTSCS78 00422 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS78 00423 *----------------------------------------------------- DTSCS78 00424 IF LCCM-F04-88 DTSCS78 00425 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS78 00426 SET REQ-JUMP TO TRUE DTSCS78 00427 GO TO P1000-EXIT. DTSCS78 00428 SKIP3 DTSCS78 00429 *----------------------------------------------------- DTSCS78 00430 * IF F14 IS PRESSED, THE HLAPI IS CONFUSED. DTSCS78 00431 * HUMOR IT BY PRETENDING THAT THE ENTER KEY WAS PRESSED. DTSCS78 00432 *----------------------------------------------------- DTSCS78 00433 IF LCCM-F14-88 CL**4 00434 SET LCCM-ENTER-88 TO TRUE CL**4 00435 SET REQ-INQUIRE TO TRUE CL**4 00436 GO TO P1000-EXIT. CL**4 00437 SKIP3 CL**4 00438 *----------------------------------------------------- DTSCS78 00439 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS78 00440 * REQUESTED SCREEN TYPE DTSCS78 00441 *----------------------------------------------------- DTSCS78 00442 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS78 00443 NEXT SENTENCE DTSCS78 00444 ELSE DTSCS78 00445 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS78 00446 SET REQ-JUMP TO TRUE DTSCS78 00447 GO TO P1000-EXIT. DTSCS78 00448 SKIP3 DTSCS78 00449 *----------------------------------------------------- DTSCS78 00450 * IF REQUEST TO UPDATE THE DATA (DEL) DTSCS78 00451 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS78 00452 *----------------------------------------------------- DTSCS78 00453 IF LCCM-F23-88 CL**5 00454 IF SCR-ACCESS-UPDATE DTSCS78 00455 SET REQ-EDIT TO TRUE DTSCS78 00456 GO TO P1000-EXIT DTSCS78 00457 ELSE DTSCS78 00458 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS78 00459 SET REQ-ERROR TO TRUE DTSCS78 00460 GO TO P1000-EXIT. DTSCS78 00461 SKIP3 DTSCS78 00462 *----------------------------------------------------- DTSCS78 00463 * IF INQUIRY TYPE KEY PRESSED (ENTER, F5, F6, F7, DTSCS78 00464 * OR F8), INDICATE INQUIRY REQUEST DTSCS78 00465 *----------------------------------------------------- DTSCS78 00466 IF LCCM-INQUIRY-88 DTSCS78 00467 SET REQ-INQUIRE TO TRUE DTSCS78 00468 GO TO P1000-EXIT. DTSCS78 00469 SKIP3 DTSCS78 00470 *----------------------------------------------------- DTSCS78 00471 * ANY OTHER KEY IS INVALID DTSCS78 00472 *----------------------------------------------------- DTSCS78 00473 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS78 00474 SET REQ-ERROR TO TRUE. DTSCS78 00475 P1000-EXIT. DTSCS78 00476 EXIT. DTSCS78 00477 /*****************************************************************DTSCS78 00478 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS78 00479 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS78 00480 ******************************************************************DTSCS78 00481 SKIP1 DTSCS78 00482 P2000-REQUEST-ERROR. DTSCS78 00483 IF LCCM-MSG DTSCS78 00484 SET RESP-SEND-MSGONLY TO TRUE DTSCS78 00485 ELSE DTSCS78 00486 GO TO S899-ABEND. DTSCS78 00487 P2000-EXIT. DTSCS78 00488 EXIT. DTSCS78 00489 /*****************************************************************DTSCS78 00490 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS78 00491 ******************************************************************DTSCS78 00492 SKIP1 DTSCS78 00493 P3000-REQUEST-JUMP. DTSCS78 00494 *----------------------------------------------------- DTSCS78 00495 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS78 00496 * BY USER DTSCS78 00497 *----------------------------------------------------- DTSCS78 00498 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS78 00499 SKIP3 DTSCS78 00500 *----------------------------------------------------- DTSCS78 00501 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS78 00502 *----------------------------------------------------- DTSCS78 00503 IF LCCM-MSG DTSCS78 00504 SET RESP-SEND-MSGONLY TO TRUE DTSCS78 00505 SET CURSOR-SET-GOTO TO TRUE DTSCS78 00506 GO TO P3000-EXIT. DTSCS78 00507 SKIP3 DTSCS78 00508 *----------------------------------------------------- DTSCS78 00509 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS78 00510 *----------------------------------------------------- DTSCS78 00511 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS78 00512 LCCM-SCR-HOLD-AREA. DTSCS78 00513 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS78 00514 SET RESP-JUMP TO TRUE. DTSCS78 00515 P3000-EXIT. DTSCS78 00516 EXIT. DTSCS78 00517 /*****************************************************************DTSCS78 00518 * CLEAR KEY WAS PRESSED *DTSCS78 00519 ******************************************************************DTSCS78 00520 SKIP1 DTSCS78 00521 P4000-REQUEST-CLEAR. DTSCS78 00522 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS78 00523 SKIP3 DTSCS78 00524 *----------------------------------------------------- DTSCS78 00525 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS78 00526 * FIELDS FROM EARLIER REQUESTS DTSCS78 00527 *----------------------------------------------------- DTSCS78 00528 SKIP1 DTSCS78 00529 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS78 00530 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS78 00531 SET LCCM-SCR-CLEAR TO TRUE. DTSCS78 00532 SET RESP-SEND-MAP TO TRUE. DTSCS78 00533 P4000-EXIT. DTSCS78 00534 EXIT. DTSCS78 00535 /*****************************************************************DTSCS78 00536 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS78 00537 ******************************************************************DTSCS78 00538 SKIP1 DTSCS78 00539 P5000-CURSOR-TO-GOTO. DTSCS78 00540 SET CURSOR-SET-GOTO TO TRUE. DTSCS78 00541 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS78 00542 P5000-EXIT. DTSCS78 00543 EXIT. DTSCS78 00544 /*****************************************************************DTSCS78 00545 * INQUIRY WAS REQUESTED *DTSCS78 00546 ******************************************************************DTSCS78 00547 SKIP1 DTSCS78 00548 P6000-REQUEST-INQUIRE. DTSCS78 00549 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID. DTSCS78 00550 MOVE LOW-VALUES TO MAP-AREA. DTSCS78 00551 MOVE L082-OP-ID TO MAP-QUEUE-OP-ID. DTSCS78 00552 SKIP1 DTSCS78 00553 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS78 00554 SKIP1 DTSCS78 00555 SET LCCM-SCR-CLEAR TO TRUE. DTSCS78 00556 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS78 00557 SKIP1 DTSCS78 00558 SET RESP-SEND-MAP TO TRUE. DTSCS78 00559 SKIP1 DTSCS78 00560 MOVE LCCM-SCR-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS78 00561 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS78 00562 SKIP1 DTSCS78 00563 INSPECT MAP-QUEUE-OP-ID DTSCS78 00564 CONVERTING LOW-VALUES TO SPACES. DTSCS78 00565 IF MAP-QUEUE-OP-ID = SPACES DTSCS78 00566 MOVE LCCM-CORR-QUEUE-OP-ID TO MAP-QUEUE-OP-ID. DTSCS78 00567 SKIP1 DTSCS78 00568 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS78 00569 IF LCCM-MSG DTSCS78 00570 GO TO P6000-EXIT. DTSCS78 00571 SKIP1 DTSCS78 00572 MOVE LOW-VALUES TO VCOR-KEY-AREA. DTSCS78 00573 SET VCOR-COR-88 TO TRUE. DTSCS78 00574 MOVE WRK-QUEUE-ID TO VCOR-QUEUE-ID. DTSCS78 00575 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78 00576 PERFORM S827-START-BROWSE THRU S827-EXIT. DTSCS78 00577 SKIP1 DTSCS78 00578 MOVE +0 TO LAST-REC-NUM. DTSCS78 00579 PERFORM P6010-SCAN-VCOR THRU P6010-EXIT DTSCS78 00580 UNTIL L827-NO-REC-88. DTSCS78 00581 IF LAST-REC-NUM = +0 DTSCS78 00582 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00583 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00584 GO TO P6000-EXIT. DTSCS78 00585 SKIP1 DTSCS78 00586 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS78 00587 IF LCCM-MSG DTSCS78 00588 GO TO P6000-EXIT. DTSCS78 00589 SKIP1 DTSCS78 00590 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS78 00591 SKIP1 DTSCS78 00592 MOVE VCOR-KEY-AREA TO LCCM-SCR-HOLD-AREA. DTSCS78 00593 SKIP1 DTSCS78 00594 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS78 00595 P6000-EXIT. DTSCS78 00596 EXIT. DTSCS78 00597 SKIP3 DTSCS78 00598 P6010-SCAN-VCOR. DTSCS78 00599 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00600 IF WRK-QUEUE-ID = VCOR-QUEUE-ID DTSCS78 00601 NEXT SENTENCE DTSCS78 00602 ELSE DTSCS78 00603 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78 00604 SET L827-NO-REC-88 TO TRUE DTSCS78 00605 GO TO P6010-EXIT. DTSCS78 00606 SKIP1 DTSCS78 00607 ADD +1 TO LAST-REC-NUM. DTSCS78 00608 MOVE VCOR-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS78 00609 SKIP1 DTSCS78 00610 PERFORM S827-READ-NEXT THRU S827-EXIT. DTSCS78 00611 P6010-EXIT. DTSCS78 00612 EXIT. DTSCS78 00613 EJECT DTSCS78 00614 P6100-LOCATE-REC. DTSCS78 00615 *------------------------------------------------------------ DTSCS78 00616 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS78 00617 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS78 00618 * SCREEN, THEN BASE THE PAGING LOGIC ON THE LAST RECORD DTSCS78 00619 * DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS78 00620 * FIRST VCOR RECORD WITH VCOR-QUEUE-ID EQUAL TO DTSCS78 00621 * MAP-QUEUE-OP-ID. DTSCS78 00622 *------------------------------------------------------------ DTSCS78 00623 SKIP1 DTSCS78 00624 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS78 00625 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78 00626 GO TO P6100-EXIT. DTSCS78 00627 SKIP1 DTSCS78 00628 MOVE SCR-REC-KEY-AREA TO VCOR-KEY-AREA. DTSCS78 00629 SKIP1 DTSCS78 00630 IF WRK-QUEUE-ID = VCOR-QUEUE-ID DTSCS78 00631 NEXT SENTENCE DTSCS78 00632 ELSE DTSCS78 00633 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78 00634 GO TO P6100-EXIT. DTSCS78 00635 SKIP3 DTSCS78 00636 IF LCCM-F05-88 DTSCS78 00637 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78 00638 GO TO P6100-EXIT. DTSCS78 00639 SKIP1 DTSCS78 00640 IF LCCM-F06-88 DTSCS78 00641 PERFORM P6140-LAST-REC THRU P6140-EXIT DTSCS78 00642 GO TO P6100-EXIT. DTSCS78 00643 SKIP3 DTSCS78 00644 MOVE LOW-VALUES TO VCOR-KEY-AREA. DTSCS78 00645 SET VCOR-COR-88 TO TRUE. DTSCS78 00646 MOVE WRK-QUEUE-ID TO VCOR-QUEUE-ID. DTSCS78 00647 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78 00648 PERFORM S827-START-BROWSE THRU S827-EXIT. DTSCS78 00649 IF L827-NO-REC-88 DTSCS78 00650 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00651 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00652 GO TO P6100-EXIT. DTSCS78 00653 SKIP1 DTSCS78 00654 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00655 SKIP1 DTSCS78 00656 IF VCOR-QUEUE-ID = WRK-QUEUE-ID DTSCS78 00657 NEXT SENTENCE DTSCS78 00658 ELSE DTSCS78 00659 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78 00660 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00661 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00662 GO TO P6100-EXIT. DTSCS78 00663 SKIP1 DTSCS78 00664 MOVE +0 TO WS-REC-NUM. DTSCS78 00665 MOVE 'N' TO WS-REC-FOUND-IND. DTSCS78 00666 PERFORM P6190-BROWSE-VCOR THRU P6190-EXIT DTSCS78 00667 UNTIL (L827-NO-REC-88) DTSCS78 00668 OR DTSCS78 00669 (WS-REC-FOUND-IND = 'Y'). DTSCS78 00670 SKIP1 DTSCS78 00671 IF L827-NO-REC-88 DTSCS78 00672 PERFORM P6110-FIRST-REC THRU P6110-EXIT DTSCS78 00673 GO TO P6100-EXIT. DTSCS78 00674 SKIP3 DTSCS78 00675 IF LCCM-ENTER-88 DTSCS78 00676 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78 00677 GO TO P6100-EXIT. DTSCS78 00678 SKIP1 DTSCS78 00679 IF LCCM-F07-88 DTSCS78 00680 PERFORM P6120-PREV-REC THRU P6120-EXIT DTSCS78 00681 GO TO P6100-EXIT. DTSCS78 00682 SKIP1 DTSCS78 00683 IF LCCM-F08-88 DTSCS78 00684 PERFORM P6130-NEXT-REC THRU P6130-EXIT DTSCS78 00685 GO TO P6100-EXIT. DTSCS78 00686 SKIP3 DTSCS78 00687 GO TO S899-ABEND. DTSCS78 00688 P6100-EXIT. DTSCS78 00689 EXIT. DTSCS78 00690 SKIP3 DTSCS78 00691 P6110-FIRST-REC. DTSCS78 00692 MOVE LOW-VALUES TO VCOR-KEY-AREA. DTSCS78 00693 SET VCOR-COR-88 TO TRUE. DTSCS78 00694 MOVE WRK-QUEUE-ID TO VCOR-QUEUE-ID. DTSCS78 00695 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78 00696 PERFORM S827-START-BROWSE THRU S827-EXIT. DTSCS78 00697 IF L827-NO-REC-88 DTSCS78 00698 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00699 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00700 GO TO P6110-EXIT. DTSCS78 00701 SKIP1 DTSCS78 00702 PERFORM S827-END-BROWSE THRU S827-EXIT. DTSCS78 00703 SKIP1 DTSCS78 00704 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00705 SKIP1 DTSCS78 00706 IF WRK-QUEUE-ID = VCOR-QUEUE-ID DTSCS78 00707 NEXT SENTENCE DTSCS78 00708 ELSE DTSCS78 00709 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00710 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00711 GO TO P6110-EXIT. DTSCS78 00712 SKIP1 DTSCS78 00713 MOVE +1 TO WS-REC-NUM. DTSCS78 00714 P6110-EXIT. DTSCS78 00715 EXIT. DTSCS78 00716 SKIP3 DTSCS78 00717 P6120-PREV-REC. DTSCS78 00718 PERFORM S827-READ-PREV THRU S827-EXIT. DTSCS78 00719 IF L827-NO-REC-88 DTSCS78 00720 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00721 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00722 GO TO P6120-EXIT. DTSCS78 00723 SKIP1 DTSCS78 00724 PERFORM S827-READ-PREV THRU S827-EXIT. DTSCS78 00725 IF L827-NO-REC-88 DTSCS78 00726 GO TO P6120-EXIT. DTSCS78 00727 SKIP1 DTSCS78 00728 PERFORM S827-END-BROWSE THRU S827-EXIT. DTSCS78 00729 SKIP1 DTSCS78 00730 IF WRK-QUEUE-ID = VSKL-KEY-AREA (3:8) DTSCS78 00731 NEXT SENTENCE DTSCS78 00732 ELSE DTSCS78 00733 GO TO P6120-EXIT. DTSCS78 00734 SKIP1 DTSCS78 00735 SUBTRACT 1 FROM WS-REC-NUM. DTSCS78 00736 SKIP1 DTSCS78 00737 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00738 P6120-EXIT. DTSCS78 00739 EXIT. DTSCS78 00740 SKIP3 DTSCS78 00741 P6130-NEXT-REC. DTSCS78 00742 IF VCOR-KEY-AREA > SCR-REC-KEY-AREA DTSCS78 00743 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78 00744 GO TO P6130-EXIT. DTSCS78 00745 SKIP1 DTSCS78 00746 PERFORM S827-READ-NEXT THRU S827-EXIT. DTSCS78 00747 SKIP1 DTSCS78 00748 IF L827-NO-REC-88 DTSCS78 00749 GO TO P6130-EXIT. DTSCS78 00750 SKIP1 DTSCS78 00751 PERFORM S827-END-BROWSE THRU S827-EXIT. DTSCS78 00752 SKIP1 DTSCS78 00753 IF WRK-QUEUE-ID = VSKL-KEY-AREA (3:8) DTSCS78 00754 NEXT SENTENCE DTSCS78 00755 ELSE DTSCS78 00756 GO TO P6130-EXIT. DTSCS78 00757 SKIP1 DTSCS78 00758 ADD +1 TO WS-REC-NUM. DTSCS78 00759 SKIP1 DTSCS78 00760 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00761 P6130-EXIT. DTSCS78 00762 EXIT. DTSCS78 00763 SKIP3 DTSCS78 00764 P6140-LAST-REC. DTSCS78 00765 MOVE LAST-REC-KEY-AREA TO VSKL-KEY-AREA. DTSCS78 00766 PERFORM S827-READ THRU S827-EXIT. DTSCS78 00767 IF L827-NO-REC-88 DTSCS78 00768 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS78 00769 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00770 GO TO P6140-EXIT. DTSCS78 00771 SKIP1 DTSCS78 00772 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00773 SKIP1 DTSCS78 00774 MOVE LAST-REC-NUM TO WS-REC-NUM. DTSCS78 00775 P6140-EXIT. DTSCS78 00776 EXIT. DTSCS78 00777 SKIP3 DTSCS78 00778 P6190-BROWSE-VCOR. DTSCS78 00779 MOVE VSKL-REC TO VCOR-REC. DTSCS78 00780 SKIP1 DTSCS78 00781 IF VCOR-QUEUE-ID = WRK-QUEUE-ID DTSCS78 00782 NEXT SENTENCE DTSCS78 00783 ELSE DTSCS78 00784 PERFORM S827-END-BROWSE THRU S827-EXIT DTSCS78 00785 SET L827-NO-REC-88 TO TRUE DTSCS78 00786 GO TO P6190-EXIT. DTSCS78 00787 SKIP1 DTSCS78 00788 ADD +1 TO WS-REC-NUM. DTSCS78 00789 SKIP1 DTSCS78 00790 IF VCOR-KEY-AREA NOT < SCR-REC-KEY-AREA DTSCS78 00791 MOVE 'Y' TO WS-REC-FOUND-IND DTSCS78 00792 ELSE DTSCS78 00793 PERFORM S827-READ-NEXT THRU S827-EXIT. DTSCS78 00794 P6190-EXIT. DTSCS78 00795 EXIT. DTSCS78 00796 /*****************************************************************DTSCS78 00797 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS78 00798 ******************************************************************DTSCS78 00799 SKIP1 DTSCS78 00800 P6900-CONSTRUCT-SCREEN. DTSCS78 00801 PERFORM P6910-FROM-VCOR THRU P6910-EXIT. DTSCS78 00802 SKIP1 DTSCS78 00803 PERFORM P6990-PAGE-NUMBER THRU P6990-EXIT. DTSCS78 00804 P6900-EXIT. DTSCS78 00805 EXIT. DTSCS78 00806 SKIP3 DTSCS78 00807 P6910-FROM-VCOR. DTSCS78 00808 PERFORM P6911-DATA THRU P6911-EXIT DTSCS78 00809 VARYING LINE-SUB FROM 1 BY 1 DTSCS78 00810 UNTIL LINE-SUB > WRK-LINE-MAX. DTSCS78 00811 P6910-EXIT. DTSCS78 00812 EXIT. DTSCS78 00813 SKIP3 DTSCS78 00814 P6911-DATA. DTSCS78 00815 COMPUTE COR-START DTSCS78 00816 = ((LINE-SUB - 1) * WRK-LINE-LENGTH) + 1. DTSCS78 00817 SKIP1 DTSCS78 00818 MOVE VCOR-DATA (COR-START:WRK-LINE-LENGTH) DTSCS78 00819 TO MAP-DATA (LINE-SUB). DTSCS78 00820 P6911-EXIT. DTSCS78 00821 EXIT. DTSCS78 00822 SKIP3 DTSCS78 00823 P6990-PAGE-NUMBER. DTSCS78 00824 MOVE WS-REC-NUM TO MAP-CURR-PAGE. DTSCS78 00825 MOVE LAST-REC-NUM TO MAP-LAST-PAGE. DTSCS78 00826 SKIP1 DTSCS78 00827 IF WS-REC-NUM = +1 DTSCS78 00828 IF LAST-REC-NUM = +1 DTSCS78 00829 MOVE PMSG-ONLY-PAGE TO LCCM-MSG-AREA DTSCS78 00830 ELSE DTSCS78 00831 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS78 00832 ELSE DTSCS78 00833 IF WS-REC-NUM = LAST-REC-NUM DTSCS78 00834 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS78 00835 P6990-EXIT. DTSCS78 00836 EXIT. DTSCS78 00837 /*****************************************************************DTSCS78 00838 * FUNCTION KEY TO MOD THE RECORD WAS PRESSED. *DTSCS78 00839 ******************************************************************DTSCS78 00840 SKIP1 DTSCS78 00841 P7000-REQUEST-EDIT. DTSCS78 00842 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS78 00843 SKIP1 DTSCS78 00844 IF LCCM-F23-88 CL**5 00845 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS78 00846 ELSE DTSCS78 00847 GO TO S899-ABEND. DTSCS78 00848 SKIP3 DTSCS78 00849 SET RESP-SEND-MAP TO TRUE. DTSCS78 00850 P7000-EXIT. DTSCS78 00851 EXIT. DTSCS78 00852 /*****************************************************************DTSCS78 00853 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS78 00854 ******************************************************************DTSCS78 00855 SKIP1 DTSCS78 00856 P7300-EDIT-DEL. DTSCS78 00857 *----------------------------------------------------- DTSCS78 00858 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS78 00859 * INQUIRED DTSCS78 00860 *----------------------------------------------------- DTSCS78 00861 IF NOT LCCM-SCR-INQUIRE DTSCS78 00862 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS78 00863 GO TO P7300-EXIT. DTSCS78 00864 SKIP3 DTSCS78 00865 *----------------------------------------------------- DTSCS78 00866 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS78 00867 *----------------------------------------------------- DTSCS78 00868 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS78 00869 IF LCCM-MSG DTSCS78 00870 GO TO P7300-EXIT. DTSCS78 00871 SKIP1 DTSCS78 00872 MOVE LCCM-SCR-HOLD-AREA TO VCOR-KEY-AREA. DTSCS78 00873 IF VCOR-QUEUE-ID = WRK-QUEUE-ID DTSCS78 00874 NEXT SENTENCE DTSCS78 00875 ELSE DTSCS78 00876 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS78 00877 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 00878 GO TO P7300-EXIT. DTSCS78 00879 SKIP1 DTSCS78 00880 MOVE VCOR-KEY-AREA TO VSKL-KEY-AREA. DTSCS78 00881 PERFORM S827-READ THRU S827-EXIT. DTSCS78 00882 IF L827-OK-88 DTSCS78 00883 PERFORM S827-DELETE THRU S827-EXIT. DTSCS78 00884 SKIP1 DTSCS78 00885 SET LCCM-F08-88 TO TRUE. DTSCS78 00886 SKIP1 DTSCS78 00887 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS78 00888 P7300-EXIT. DTSCS78 00889 EXIT. DTSCS78 00890 /*****************************************************************DTSCS78 00891 * LINKS TO UTILITY MODULES DTSCS78 00892 ******************************************************************DTSCS78 00893 SKIP1 DTSCS78 00894 S082-OP-ID-LOOKUP. DTSCS78 00895 EXEC CICS LINK DTSCS78 00896 PROGRAM('DTSCU082') CL**2 00897 COMMAREA(L082-COMM-AREA) DTSCS78 00898 END-EXEC. DTSCS78 00899 SKIP1 DTSCS78 00900 IF L082-FILE-CLOSED DTSCS78 00901 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS78 00902 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS78 00903 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS78 00904 GO TO MAINLINE-EXIT. DTSCS78 00905 S082-EXIT. DTSCS78 00906 EXIT. DTSCS78 00907 SKIP3 DTSCS78 00908 S803-REQ-SCR-ID-EDIT. DTSCS78 00909 EXEC CICS LINK DTSCS78 00910 PROGRAM('DTSCU803') CL**2 00911 COMMAREA(DFHCOMMAREA) DTSCS78 00912 END-EXEC. DTSCS78 00913 S803-EXIT. DTSCS78 00914 EXIT. DTSCS78 00915 SKIP3 DTSCS78 00916 S804-INVALID-KEY. DTSCS78 00917 EXEC CICS LINK DTSCS78 00918 PROGRAM('DTSCU804') CL**2 00919 COMMAREA(DFHCOMMAREA) DTSCS78 00920 END-EXEC. DTSCS78 00921 S804-EXIT. DTSCS78 00922 EXIT. DTSCS78 00923 SKIP3 DTSCS78 00924 S805-MSG-AREA. DTSCS78 00925 MOVE LCCM-MSG-AREA TO L805-MSG-AREA. DTSCS78 00926 SKIP1 DTSCS78 00927 EXEC CICS LINK DTSCS78 00928 PROGRAM('DTSCU805') CL**2 00929 COMMAREA(L805-COMM-AREA) DTSCS78 00930 END-EXEC. DTSCS78 00931 SKIP1 DTSCS78 00932 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS78 00933 S805-EXIT. DTSCS78 00934 EXIT. DTSCS78 00935 EJECT DTSCS78 00936 S827-READ. DTSCS78 00937 SET L827-READ-88 TO TRUE. DTSCS78 00938 GO TO S827-IO. DTSCS78 00939 SKIP1 DTSCS78 00940 S827-START-BROWSE. DTSCS78 00941 SET L827-START-BROWSE-88 TO TRUE. DTSCS78 00942 GO TO S827-IO. DTSCS78 00943 SKIP1 DTSCS78 00944 S827-READ-NEXT. DTSCS78 00945 SET L827-READ-NEXT-88 TO TRUE. DTSCS78 00946 GO TO S827-IO. DTSCS78 00947 SKIP1 DTSCS78 00948 S827-READ-PREV. DTSCS78 00949 SET L827-READ-PREV-88 TO TRUE. DTSCS78 00950 GO TO S827-IO. DTSCS78 00951 SKIP1 DTSCS78 00952 S827-END-BROWSE. DTSCS78 00953 SET L827-END-BROWSE-88 TO TRUE. DTSCS78 00954 GO TO S827-IO. DTSCS78 00955 SKIP1 DTSCS78 00956 S827-REWRITE. DTSCS78 00957 SET L827-REWRITE-88 TO TRUE. DTSCS78 00958 GO TO S827-IO. DTSCS78 00959 SKIP1 DTSCS78 00960 S827-WRITE. DTSCS78 00961 SET L827-WRITE-88 TO TRUE. DTSCS78 00962 GO TO S827-IO. DTSCS78 00963 SKIP1 DTSCS78 00964 S827-DELETE. DTSCS78 00965 SET L827-DELETE-88 TO TRUE. DTSCS78 00966 GO TO S827-IO. DTSCS78 00967 SKIP1 DTSCS78 00968 S827-IO. DTSCS78 00969 SKIP1 DTSCS78 00970 EXEC CICS LINK DTSCS78 00971 PROGRAM ('DTSCU827') CL**2 00972 COMMAREA (L827-COMM-AREA) DTSCS78 00973 END-EXEC. DTSCS78 00974 SKIP1 DTSCS78 00975 IF L827-FILE-CLOSED-88 DTSCS78 00976 MOVE L827-MSG-AREA TO LCCM-MSG-AREA DTSCS78 00977 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS78 00978 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS78 00979 GO TO MAINLINE-EXIT. DTSCS78 00980 S827-EXIT. DTSCS78 00981 EXIT. DTSCS78 00982 EJECT DTSCS78 00983 S851-SCREEN-PROCESSING. DTSCS78 00984 EXEC CICS LINK DTSCS78 00985 PROGRAM ('DTSCU851') CL**3 00986 COMMAREA (L851-COMM-AREA) DTSCS78 00987 END-EXEC. DTSCS78 00988 S851-EXIT. DTSCS78 00989 EXIT. DTSCS78 00990 SKIP3 DTSCS78 00991 S899-ABEND. DTSCS78 00992 EXEC CICS ABEND DTSCS78 00993 ABCODE(WRK-ABEND-CD) DTSCS78 00994 END-EXEC. DTSCS78 00995 S899-EXIT. DTSCS78 00996 EXIT. DTSCS78 00997 EJECT DTSCS78 00998 S1100-EDIT-KEY. DTSCS78 00999 PERFORM S1110-QUEUE-ID THRU S1110-EXIT. DTSCS78 01000 S1100-EXIT. EXIT. DTSCS78 01001 /*****************************************************************DTSCS78 01002 * DTSCS78 01003 ******************************************************************DTSCS78 01004 S1110-QUEUE-ID. DTSCS78 01005 INSPECT MAP-QUEUE-OP-ID DTSCS78 01006 CONVERTING LOW-VALUES TO SPACES. DTSCS78 01007 SKIP1 DTSCS78 01008 IF MAP-QUEUE-OP-ID = SPACES DTSCS78 01009 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS78 01010 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS78 01011 GO TO S1110-EXIT. DTSCS78 01012 SKIP1 DTSCS78 01013 IF MAP-QUEUE-OP-ID = LCCM-CORR-QUEUE-OP-ID DTSCS78 01014 MOVE MAP-QUEUE-OP-ID TO WRK-QUEUE-ID DTSCS78 01015 GO TO S1110-EXIT. DTSCS78 01016 SKIP1 DTSCS78 01017 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID. DTSCS78 01018 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS78 01019 IF L082-VALID-OP DTSCS78 01020 MOVE MAP-QUEUE-OP-ID TO WRK-QUEUE-ID DTSCS78 01021 LCCM-CORR-QUEUE-OP-ID DTSCS78 01022 ELSE DTSCS78 01023 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS78 01024 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS78 01025 S1110-EXIT. EXIT. DTSCS78 01026 SKIP3 DTSCS78 01027 S1199-ERROR. DTSCS78 01028 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-QUEUE-OP-ID-A. DTSCS78 01029 IF LCCM-NO-MSG DTSCS78 01030 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS78 01031 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L DTSCS78 01032 SET CURSOR-SET-YES TO TRUE. DTSCS78 01033 S1199-EXIT. EXIT. DTSCS78 01034 /*****************************************************************DTSCS78 01035 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS78 01036 ******************************************************************DTSCS78 01037 *S5100-SET-LOCK-ATTRB. DTSCS78 01038 *****MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS78 01039 ***** WRK-ATB-NUM. DTSCS78 01040 *****SKIP1 DTSCS78 01041 *****PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS78 01042 *****SKIP1 DTSCS78 01043 *****MOVE CATB-ASKIP-BRT-MDTON TO MAP-QUEUE-OP-ID-A DTSCS78 01044 ***** MAP-GOTO-A. DTSCS78 01045 *S5100-EXIT. DTSCS78 01046 *****EXIT. DTSCS78 01047 *****SKIP3 DTSCS78 01048 ******************************************************************DTSCS78 01049 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS78 01050 ******************************************************************DTSCS78 01051 *S5200-SET-UPDATE-ATTRB. DTSCS78 01052 *****MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS78 01053 *****MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS78 01054 *****SKIP1 DTSCS78 01055 *****PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS78 01056 *S5200-EXIT. DTSCS78 01057 *****EXIT. DTSCS78 01058 *****SKIP3 DTSCS78 01059 ******************************************************************DTSCS78 01060 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS78 01061 ******************************************************************DTSCS78 01062 S5300-SET-INQ-ATTRB. DTSCS78 01063 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS78 01064 WRK-ATB-NUM. DTSCS78 01065 SKIP1 DTSCS78 01066 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS78 01067 S5300-EXIT. DTSCS78 01068 EXIT. DTSCS78 01069 SKIP3 DTSCS78 01070 S5900-SET-ATTRB. DTSCS78 01071 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CURR-PAGE-A DTSCS78 01072 MAP-LAST-PAGE-A. DTSCS78 01073 SKIP1 DTSCS78 01074 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-QUEUE-OP-ID-A. DTSCS78 01075 SKIP1 DTSCS78 01076 PERFORM S5910-DATA THRU S5910-EXIT DTSCS78 01077 VARYING MAP-DATA-IDX FROM 1 BY 1 DTSCS78 01078 UNTIL MAP-DATA-IDX > WRK-LINE-MAX. DTSCS78 01079 SKIP1 DTSCS78 01080 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS78 01081 S5900-EXIT. DTSCS78 01082 EXIT. DTSCS78 01083 SKIP3 DTSCS78 01084 S5910-DATA. DTSCS78 01085 MOVE CATB-ASKIP-BRT-MDTON TO MAP-DATA-A (MAP-DATA-IDX). DTSCS78 01086 S5910-EXIT. DTSCS78 01087 EXIT. DTSCS78 01088 /*****************************************************************DTSCS78 01089 * MAP ROUTINES *DTSCS78 01090 ******************************************************************DTSCS78 01091 S9100-RECEIVE. DTSCS78 01092 SET L851-RECEIVE-88 TO TRUE. DTSCS78 01093 SKIP1 DTSCS78 01094 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS78 01095 SKIP1 DTSCS78 01096 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS78 01097 SKIP1 DTSCS78 01098 MOVE L851-AID TO LCCM-AID. DTSCS78 01099 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS78 01100 S9100-EXIT. DTSCS78 01101 EXIT. DTSCS78 01102 SKIP3 DTSCS78 01103 S9200-SEND-DATAONLY. DTSCS78 01104 MOVE LOW-VALUES TO MAP-AREA. DTSCS78 01105 SKIP1 DTSCS78 01106 IF LCCM-NO-MSG DTSCS78 01107 NEXT SENTENCE DTSCS78 01108 ELSE DTSCS78 01109 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS78 01110 SKIP1 DTSCS78 01111 IF CURSOR-SET-GOTO DTSCS78 01112 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS78 01113 ELSE DTSCS78 01114 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L. DTSCS78 01115 SKIP1 DTSCS78 01116 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS78 01117 SKIP1 DTSCS78 01118 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS78 01119 SKIP1 DTSCS78 01120 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS78 01121 S9200-EXIT. DTSCS78 01122 EXIT. DTSCS78 01123 SKIP3 DTSCS78 01124 S9300-SEND-MAP. DTSCS78 01125 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS78 01126 MOVE SPACES TO MAP-SYS-TIME. DTSCS78 01127 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS78 01128 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS78 01129 SKIP1 DTSCS78 01130 IF SCR-ACCESS-UPDATE DTSCS78 01131 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS78 01132 ELSE DTSCS78 01133 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS78 01134 SKIP1 DTSCS78 01135 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS78 01136 SKIP1 DTSCS78 01137 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS78 01138 SKIP1 DTSCS78 01139 IF CURSOR-SET-NO DTSCS78 01140 MOVE CATB-CURSOR TO MAP-QUEUE-OP-ID-L. DTSCS78 01141 SKIP1 DTSCS78 01142 SET L851-SEND-88 TO TRUE. DTSCS78 01143 SKIP1 DTSCS78 01144 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS78 01145 SKIP1 DTSCS78 01146 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS78 01147 S9300-EXIT. DTSCS78 01148 EXIT. DTSCS78 01149 SKIP3 DTSCS78 01150 S9310-UPDATE-FKEYS. DTSCS78 01151 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS78 01152 SKIP1 DTSCS78 01153 MOVE 'F23=DELETE AND DISPLAY NEXT' TO MAP-KEY-DEL. CL**5 01154 SKIP1 DTSCS78 01155 IF LCCM-SCR-CLEAR DTSCS78 01156 MOVE LOW-VALUES TO MAP-KEY-DEL DTSCS78 01157 ELSE DTSCS78 01158 IF LCCM-SCR-INQUIRE DTSCS78 01159 NEXT SENTENCE DTSCS78 01160 *****ELSE DTSCS78 01161 *****IF LCCM-SCR-UPDATE-LOCKED DTSCS78 01162 ***** MOVE LOW-VALUES TO MAP-KEY-FIRST DTSCS78 01163 ***** MAP-KEY-LAST DTSCS78 01164 ***** MAP-KEY-BACK DTSCS78 01165 ***** MAP-KEY-FWRD DTSCS78 01166 ***** MAP-KEY-DEL DTSCS78 01167 ELSE DTSCS78 01168 NEXT SENTENCE. DTSCS78 01169 S9310-EXIT. DTSCS78 01170 EXIT. DTSCS78 01171 SKIP3 DTSCS78 01172 S9320-INQUIRY-FKEYS. DTSCS78 01173 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS78 01174 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS78 01175 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS78 01176 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS78 01177 SKIP1 DTSCS78 01178 MOVE LOW-VALUES TO MAP-KEY-DEL. DTSCS78 01179 SKIP1 DTSCS78 01180 PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS78 01181 S9320-EXIT. DTSCS78 01182 EXIT. DTSCS78 01183 SKIP3 DTSCS78 01184 S9321-JUMP-KEYS. DTSCS78 01185 S9321-EXIT. DTSCS78 01186 EXIT. DTSCS78 01187 SKIP3 DTSCS78 01188 S9330-DSCR-FIELDS. DTSCS78 01189 IF MAP-QUEUE-OP-ID = LOW-VALUES OR SPACES DTSCS78 01190 MOVE LOW-VALUES TO MAP-QUEUE-OP-ID-DESC DTSCS78 01191 ELSE DTSCS78 01192 IF MAP-QUEUE-OP-ID = LCCM-OP-ID DTSCS78 01193 MOVE LCCM-OP-NAME TO MAP-QUEUE-OP-ID-DESC DTSCS78 01194 ELSE DTSCS78 01195 MOVE MAP-QUEUE-OP-ID TO L082-OP-ID DTSCS78 01196 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS78 01197 MOVE L082-NAME TO MAP-QUEUE-OP-ID-DESC. DTSCS78 01198 S9330-EXIT. EXIT. DTSCS78 01199 SKIP3 DTSCS78 01200 S9900-PREPARE-SEND. DTSCS78 01201 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS78 01202 LCCM-SCR-ID. DTSCS78 01203 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS78 01204 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS78 01205 S9900-EXIT. DTSCS78 01206 EXIT. DTSCS78