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