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