00001 IDENTIFICATION DIVISION. 10/07/99 00002 PROGRAM-ID. DTSCS79. DTSCS79 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV032 00004 DATE-WRITTEN. JULY 1994. DTSCS79 00005 DATE-COMPILED. DTSCS79 00006 SKIP3 DTSCS79 00007 ***** DTSCS79 00008 * DTSCS79 00009 * FUNCTION: BENEFIT ADDRESS CL**2 00010 * SCREEN PROCESSOR. DTSCS79 00011 * DTSCS79 00012 * DTSCS79 00013 * MODIFICATION LOG: DTSCS79 00014 * DTSCS79 00015 * 10/02/98 INITIAL DEVELOPMENT. CLONED FROM MACCS79. CL**2 00016 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00017 * DTSCS79 00018 * XX/XX/XX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS79 00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS79 00020 * WORK ORDER: PROGRAMMER: XXX DTSCS79 00021 * DTSCS79 00022 * DTSCS79 00023 * DESCRIPTION: DTSCS79 00024 * DTSCS79 00025 * DTSCS79 00026 * CLEAR: DTSCS79 00027 * DTSCS79 00028 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS79 00029 * DTSCS79 00030 * DTSCS79 00031 * JUMP: DTSCS79 00032 * DTSCS79 00033 * F17 REGISTRATION INQUIRY (11). DTSCS79 00034 * F18 REGISTRATION SEARCHES (12). DTSCS79 00035 * DTSCS79 00036 * DTSCS79 00037 * INQUIRY: DTSCS79 00038 * DTSCS79 00039 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS79 00040 * DTSCS79 00041 * JUMP IN: IF LCCM-EMP-NO = LCCM-SCR79-MOLD-AREA EMP-NO CL*10 00042 * DISPLAY RECORD INDICATED BY DTSCS79 00043 * LCCM-SCR79-HOLD-AREA DTSCS79 00044 * ELSE DTSCS79 00045 * DISPLAY DEFAULT PAGE OF DATA ASSOCIATED WITH DTSCS79 00046 * LCCM-EMP-NO. DTSCS79 00047 * DTSCS79 00048 * ENTER, F5, F6, F7, F8: STANDARD PAGING. DTSCS79 00049 * DTSCS79 00050 * PAGE INITIALLY DISPLAYED: FIRST. DTSCS79 00051 * DTSCS79 00052 * DISPLAY SEQUENCE: ASCENDING ON MBAA-ID-NO. DTSCS79 00053 * DTSCS79 00054 * JUMP OUT: STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS79 00055 * DTSCS79 00056 * STORE INFORMATION REPRESENTING PAGE CURRENTLY DTSCS79 00057 * DISPLAYED IN LCCM-SCR79-HOLD-AREA. DTSCS79 00058 * DTSCS79 00059 * STORE PAGING CONTROL INFORMATION IN LCCM-SCR-HOLD-AREA. DTSCS79 00060 * DTSCS79 00061 * DTSCS79 00062 * UPDATE: DTSCS79 00063 * DTSCS79 00064 * ADD DTSCS79 00065 * MOD DTSCS79 00066 * DEL DTSCS79 00067 * COMPRESS MAP-BEN-ALT-ID'S BY EMPLOYER. DTSCS79 00068 * DTSCS79 00069 * SEE THE SCREEN DESCRIPTION FOR AN EXPLANATION OF THE DTSCS79 00070 * USE OF MAP-BEN-ALT-ID. DTSCS79 00071 * DTSCS79 00072 * DTSCS79 00073 * RECORDS READ: DTSCS79 00074 * DTSCS79 00075 * MASTER: DTSCS79 00076 * DTSCS79 00077 * MPRF DTSCS79 00078 * MBAA. DTSCS79 00079 * DTSCS79 00080 * ALTERNATE INDEX: DTSCS79 00081 * DTSCS79 00082 * N/A. DTSCS79 00083 * DTSCS79 00084 * REFERENCE: DTSCS79 00085 * DTSCS79 00086 * N/A. DTSCS79 00087 * DTSCS79 00088 * ACCOUNTING TRANSACTION COLLECTION: DTSCS79 00089 * DTSCS79 00090 * N/A. DTSCS79 00091 * DTSCS79 00092 * DTSCS79 00093 * RECORDS UPDATED: DTSCS79 00094 * DTSCS79 00095 * MASTER: DTSCS79 00096 * DTSCS79 00097 * MBAA (WRITE, REWRITE, DELETE). DTSCS79 00098 * DTSCS79 00099 * REFERENCE: DTSCS79 00100 * DTSCS79 00101 * N/A. DTSCS79 00102 * DTSCS79 00103 * ACCOUNTING TRANSACTION COLLECTION: DTSCS79 00104 * DTSCS79 00105 * N/A. DTSCS79 00106 * DTSCS79 00107 * DTSCS79 00108 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS79 00109 * DTSCS79 00110 * N/A. DTSCS79 00111 * DTSCS79 00112 * DTSCS79 00113 * TEMPORARY STORAGE USAGE: DTSCS79 00114 * DTSCS79 00115 * N/A. DTSCS79 00116 * DTSCS79 00117 * DTSCS79 00118 * MODULES LINKED TO: DTSCS79 00119 * DTSCS79 00120 * DTSCU005 FORMAT ABSTIME FOR SCREEN DISPLAY. CL*19 00121 * DTSCU013 COUNT FROM SCREEN (INTEGER) FORMAT/EDIT. CL*19 00122 * DTSCU018 EMPLOYER NUMBER FROM SCREEN FORMAT/EDIT. CL**2 00123 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. CL**2 00124 * DTSCU072 ADDRESS EDIT. CL**2 00125 * DTSCU073 TELEPHONE NUMBER EDIT. CL**2 00126 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. CL**2 00127 * DTSCU810 MASTER FILE INPUT/OUTPUT. CL**2 00128 * DTSCS79 00129 * DTSCS79 00130 * MAINTENANCE NOTES: DTSCS79 00131 * DTSCS79 00132 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS79 00133 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS79 00134 * ALTER PARAGRAPHS P6910, P8910, S5900, DTSCS79 00135 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS79 00136 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS79), CL**2 00137 * ALTER THE MAP (DTSM79) AND ASSEMBLE THE MAPSET (DTSMSET). CL**2 00138 * DTSCS79 00139 * DTSCS79 00140 ***** DTSCS79 00141 ENVIRONMENT DIVISION. DTSCS79 00142 DATA DIVISION. DTSCS79 00143 WORKING-STORAGE SECTION. DTSCS79 001435 77 PAN-VALET PICTURE X(24) VALUE '032DTSCS79 10/07/99'. DTSCS79 00144 SKIP1 DTSCS79 00145 01 WRK-AREA. DTSCS79 00146 05 WRK-ABEND-CD PIC X(04) VALUE 'S79 '. DTSCS79 00147 SKIP1 DTSCS79 00148 05 WRK-SCR-ID. DTSCS79 00149 10 WRK-SCR-ID-N PIC 9(02) VALUE 79. DTSCS79 00150 05 WRK-F03-SCR-ID PIC X(02) VALUE '70'. DTSCS79 00151 SKIP1 DTSCS79 00152 05 WRK-SUBSCRIPTS. DTSCS79 00153 10 WRK-PHONE PIC S9(04) COMP. DTSCS79 00154 SKIP1 DTSCS79 00155 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS79 00156 05 WRK-ID-NO PIC S9(03) COMP-3. DTSCS79 00157 05 WRK-TEMP-ID PIC X(03). DTSCS79 00158 SKIP1 DTSCS79 00159 05 WRK-NEW-ID PIC S9(03) COMP-3. DTSCS79 00160 05 WRK-HOLD-ID PIC S9(03) COMP-3. DTSCS79 00161 05 WRK-SCR-STATUS PIC X(01). DTSCS79 00162 88 WRK-SCR-MOD-LOCKED VALUE 'M'. DTSCS79 00163 88 WRK-SCR-COMPRESS-LOCKED VALUE 'S'. DTSCS79 00164 SKIP3 DTSCS79 00165 05 WRK-MSG-AREA PIC X(62). DTSCS79 00166 SKIP3 DTSCS79 00167 05 WRK-MPRF-IND PIC X(01). DTSCS79 00168 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS79 00169 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS79 00170 05 WRK-MBAA-IND PIC X(01). DTSCS79 00171 88 WRK-MBAA-YES-88 VALUE 'Y'. DTSCS79 00172 88 WRK-MBAA-NO-88 VALUE 'N'. DTSCS79 00173 SKIP1 DTSCS79 00174 05 WRK-BROWSE-IND PIC X(01). DTSCS79 00175 88 WRK-BROWSE-FOUND-88 VALUE 'Y'. DTSCS79 00176 88 WRK-BROWSE-NOT-FOUND-88 VALUE 'N'. DTSCS79 00177 SKIP1 DTSCS79 00178 05 HOLD-ATTRB-AREA. DTSCS79 00179 10 HOLD-ATTN-A PIC X(01). DTSCS79 00180 10 HOLD-DLV1-A PIC X(01). CL*10 00181 10 HOLD-DLV2-A PIC X(01). CL*10 00182 10 HOLD-CITY-A PIC X(01). DTSCS79 00183 10 HOLD-STAT-A PIC X(01). DTSCS79 00184 10 HOLD-ZIPC-A PIC X(01). DTSCS79 00185 SKIP1 DTSCS79 00186 05 WRK-MAP-ADDR-IND PIC X(01). DTSCS79 00187 88 WRK-MAP-ADDR-HAS-DATA VALUE 'Y'. DTSCS79 00188 88 WRK-MAP-ADDR-BLANK VALUE 'N'. DTSCS79 00189 05 WRK-MAP-PHON-IND PIC X(01). DTSCS79 00190 88 WRK-MAP-PHON-HAS-DATA VALUE 'Y'. DTSCS79 00191 88 WRK-MAP-PHON-BLANK VALUE 'N'. DTSCS79 00192 SKIP1 DTSCS79 00193 05 WRK-MBAA-PHONE-NUMBERS. DTSCS79 00194 10 WRK-MBAA-PHONE OCCURS 3. DTSCS79 00195 15 WRK-MBAA-PHONE-A-CD PIC X(03). DTSCS79 00196 15 WRK-MBAA-PHONE-PREF PIC X(03). DTSCS79 00197 15 WRK-MBAA-PHONE-SUFF PIC X(04). DTSCS79 00198 15 WRK-MBAA-PHONE-EXT PIC X(05). CL**2 00199 SKIP3 DTSCS79 00200 05 WRK-DISPLAY PIC 9(11). DTSCS79 00201 05 FILLER REDEFINES WRK-DISPLAY. DTSCS79 00202 10 FILLER PIC X(05). DTSCS79 00203 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS79 00204 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS79 00205 EJECT DTSCS79 00206 01 SCREEN-CONTROL. DTSCS79 00207 05 SCR-ACCESS-IND PIC X(01). DTSCS79 00208 88 SCR-ACCESS-INQ VALUE '1'. DTSCS79 00209 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS79 00210 SKIP1 DTSCS79 00211 05 CURSOR-SET-IND PIC X(01). DTSCS79 00212 88 CURSOR-SET-YES VALUE 'Y'. DTSCS79 00213 88 CURSOR-SET-NO VALUE 'N'. DTSCS79 00214 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS79 00215 SKIP1 DTSCS79 00216 05 REQ-IND PIC X(01). DTSCS79 00217 88 REQ-ERROR VALUE 'O'. DTSCS79 00218 88 REQ-JUMP VALUE 'J'. DTSCS79 00219 88 REQ-CLEAR VALUE 'C'. DTSCS79 00220 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS79 00221 88 REQ-INQUIRE VALUE 'I'. DTSCS79 00222 88 REQ-EDIT VALUE 'E'. DTSCS79 00223 88 REQ-UPDATE VALUE 'U'. DTSCS79 00224 SKIP1 DTSCS79 00225 05 RESP-IND PIC X(01). DTSCS79 00226 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS79 00227 88 RESP-SEND-MAP VALUE 'M'. DTSCS79 00228 88 RESP-JUMP VALUE 'J'. DTSCS79 00229 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS79 00230 SKIP1 DTSCS79 00231 05 SCR-ATB-AN PIC X(01). DTSCS79 00232 05 SCR-ATB-NUM PIC X(01). DTSCS79 00233 SKIP1 DTSCS79 00234 05 PAGING-CONTROL-AREA. DTSCS79 00235 10 CURR-REC-NUM PIC S9(09) COMP. DTSCS79 00236 10 LAST-REC-NUM PIC S9(09) COMP. DTSCS79 00237 10 SCR-REC-KEY-AREA PIC X(16). DTSCS79 00238 10 LAST-REC-KEY-AREA PIC X(16). DTSCS79 00239 EJECT CL*19 00240 01 L005-COMM-AREA. CL*19 00241 ++INCLUDE DTSIL005 CL*19 00242 EJECT DTSCS79 00243 01 L013-COMM-AREA. DTSCS79 00244 ++INCLUDE DTSIL013 CL**2 00245 EJECT DTSCS79 00246 01 L018-COMM-AREA. DTSCS79 00247 ++INCLUDE DTSIL018 CL**2 00248 EJECT DTSCS79 00249 01 L021-COMM-AREA. DTSCS79 00250 ++INCLUDE DTSIL021 CL**2 00251 EJECT DTSCS79 00252 01 L072-COMM-AREA. DTSCS79 00253 ++INCLUDE DTSIL072 CL**2 00254 EJECT DTSCS79 00255 01 L073-COMM-AREA. DTSCS79 00256 ++INCLUDE DTSIL073 CL**2 00257 EJECT DTSCS79 00258 01 L221-COMM-AREA. DTSCS79 00259 ++INCLUDE DTSIL221 CL**2 00260 EJECT DTSCS79 00261 01 L331-COMM-AREA. CL*26 00262 ++INCLUDE DTSIL331 CL*26 00263 EJECT CL*26 00264 01 L805-COMM-AREA. DTSCS79 00265 ++INCLUDE DTSIL805 CL**2 00266 EJECT DTSCS79 00267 01 L810-COMM-AREA. DTSCS79 00268 05 L810-CONTROL-BLOCK. DTSCS79 00269 ++INCLUDE DTSIL810 CL**2 00270 EJECT DTSCS79 00271 05 MSKL-REC. DTSCS79 00272 ++INCLUDE DTSIMSKL CL**2 00273 EJECT DTSCS79 00274 01 MPRF-REC. DTSCS79 00275 ++INCLUDE DTSIMPRF CL**2 00276 EJECT DTSCS79 00277 01 MBAA-REC. DTSCS79 00278 ++INCLUDE DTSIMBAA CL**2 00279 EJECT DTSCS79 00280 01 L851-COMM-AREA. DTSCS79 00281 ++INCLUDE DTSIL851 CL*10 00282 SKIP3 DTSCS79 00283 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS79 00284 ++INCLUDE DTSIS79 CL**2 00285 EJECT DTSCS79 00286 01 CATB-LITERALS. DTSCS79 00287 ++INCLUDE DTSICATB CL**2 00288 SKIP3 DTSCS79 00289 01 CFKD-LITERALS. DTSCS79 00290 ++INCLUDE DTSICFKD CL**2 00291 EJECT DTSCS79 00292 01 CECD-LITERALS. DTSCS79 00293 ++INCLUDE DTSICECD CL**2 00294 EJECT DTSCS79 00295 01 CPCD-LITERALS. DTSCS79 00296 ++INCLUDE DTSICPCD CL**2 00297 EJECT DTSCS79 00298 LINKAGE SECTION. DTSCS79 00299 SKIP3 DTSCS79 00300 01 DFHCOMMAREA. DTSCS79 00301 ++INCLUDE DTSILCCM CL**2 00302 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS79 00303 20 LCCM-HOLD-ADDRESS-79 PIC X(171). CL*16 00304 EJECT DTSCS79 00305 ******************************************************************DTSCS79 00306 * *DTSCS79 00307 ******************************************************************DTSCS79 00308 SKIP1 DTSCS79 00309 PROCEDURE DIVISION. DTSCS79 00310 SKIP1 DTSCS79 00311 MOVE +0 TO WRK-EMP-NO DTSCS79 00312 WRK-ID-NO. DTSCS79 00313 SET WRK-MPRF-NO-88 TO TRUE. DTSCS79 00314 SKIP1 DTSCS79 00315 MOVE LOW-VALUES TO MAP-AREA. DTSCS79 00316 SET CURSOR-SET-NO TO TRUE. DTSCS79 00317 SKIP1 DTSCS79 00318 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS79 00319 TO SCR-ACCESS-IND. DTSCS79 00320 SKIP1 DTSCS79 00321 MOVE SPACE TO REQ-IND. DTSCS79 00322 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS79 00323 SKIP1 DTSCS79 00324 *----------------------------------------------------- DTSCS79 00325 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS79 00326 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS79 00327 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS79 00328 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS79 00329 * DTSCS79 00330 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS79 00331 * PROCESSED. DTSCS79 00332 * DTSCS79 00333 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS79 00334 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS79 00335 * WORK STATION OPERATOR. DTSCS79 00336 *----------------------------------------------------- DTSCS79 00337 SKIP1 DTSCS79 00338 MOVE SPACE TO RESP-IND. DTSCS79 00339 SKIP1 DTSCS79 00340 IF REQ-ERROR DTSCS79 00341 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS79 00342 ELSE DTSCS79 00343 IF REQ-JUMP DTSCS79 00344 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS79 00345 ELSE DTSCS79 00346 IF REQ-CLEAR DTSCS79 00347 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS79 00348 ELSE DTSCS79 00349 IF REQ-CURSOR-TO-GOTO DTSCS79 00350 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS79 00351 ELSE DTSCS79 00352 IF REQ-INQUIRE DTSCS79 00353 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS79 00354 ELSE DTSCS79 00355 IF REQ-EDIT DTSCS79 00356 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS79 00357 ELSE DTSCS79 00358 IF REQ-UPDATE DTSCS79 00359 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS79 00360 ELSE DTSCS79 00361 GO TO S899-ABEND. DTSCS79 00362 SKIP3 DTSCS79 00363 *----------------------------------------------------- DTSCS79 00364 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS79 00365 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS79 00366 *----------------------------------------------------- DTSCS79 00367 SKIP1 DTSCS79 00368 IF RESP-SEND-MAP DTSCS79 00369 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS79 00370 SET LCCM-END-TASK-88 TO TRUE DTSCS79 00371 ELSE DTSCS79 00372 IF RESP-SEND-MSGONLY DTSCS79 00373 OR RESP-CURSOR-TO-GOTO DTSCS79 00374 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS79 00375 SET LCCM-END-TASK-88 TO TRUE DTSCS79 00376 ELSE DTSCS79 00377 IF RESP-JUMP DTSCS79 00378 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS79 00379 ELSE DTSCS79 00380 GO TO S899-ABEND. DTSCS79 00381 SKIP3 DTSCS79 00382 MAINLINE-EXIT. DTSCS79 00383 SKIP1 DTSCS79 00384 EXEC CICS DTSCS79 00385 RETURN DTSCS79 00386 END-EXEC. DTSCS79 00387 SKIP1 DTSCS79 00388 * GOBACK. DTSCS79 00389 /*****************************************************************DTSCS79 00390 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS79 00391 ******************************************************************DTSCS79 00392 P1000-ANALYZE-REQUEST. DTSCS79 00393 SKIP1 DTSCS79 00394 *----------------------------------------------------- DTSCS79 00395 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS79 00396 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS79 00397 * REPLACED WITH ENTER) DTSCS79 00398 *----------------------------------------------------- DTSCS79 00399 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS79 00400 SET LCCM-ENTER-88 TO TRUE DTSCS79 00401 IF LCCM-EMP-NO > ZERO DTSCS79 00402 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS79 00403 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS79 00404 END-IF DTSCS79 00405 SET REQ-INQUIRE TO TRUE DTSCS79 00406 GO TO P1000-EXIT. DTSCS79 00407 SKIP3 DTSCS79 00408 *----------------------------------------------------- DTSCS79 00409 * MAP IS RECEIVED DTSCS79 00410 *----------------------------------------------------- DTSCS79 00411 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS79 00412 SKIP3 DTSCS79 00413 *----------------------------------------------------- DTSCS79 00414 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS79 00415 * WORK STATION DTSCS79 00416 *----------------------------------------------------- DTSCS79 00417 IF LCCM-CLEAR-88 DTSCS79 00418 SET REQ-CLEAR TO TRUE DTSCS79 00419 GO TO P1000-EXIT. DTSCS79 00420 SKIP3 DTSCS79 00421 *----------------------------------------------------- DTSCS79 00422 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS79 00423 *----------------------------------------------------- DTSCS79 00424 IF LCCM-SCR-UPDATE-LOCKED DTSCS79 00425 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS79 00426 GO TO P1000-EXIT. DTSCS79 00427 SKIP3 DTSCS79 00428 *----------------------------------------------------- DTSCS79 00429 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS79 00430 *----------------------------------------------------- DTSCS79 00431 IF LCCM-PA2-88 DTSCS79 00432 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS79 00433 GO TO P1000-EXIT. DTSCS79 00434 SKIP3 DTSCS79 00435 *----------------------------------------------------- DTSCS79 00436 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS79 00437 *----------------------------------------------------- DTSCS79 00438 IF LCCM-PA-88 DTSCS79 00439 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS79 00440 SET REQ-ERROR TO TRUE DTSCS79 00441 GO TO P1000-EXIT. DTSCS79 00442 SKIP3 DTSCS79 00443 *----------------------------------------------------- CL**2 00444 * IF PF12 IS PRESSED AND UPDATE NOT IN PROGRESS CL**2 00445 * CLEAR SCREEN CL**2 00446 *----------------------------------------------------- CL**2 00447 IF LCCM-F12-88 CL**6 00448 MOVE LOW-VALUES TO MAP-AREA CL**4 00449 SET REQ-CLEAR TO TRUE CL**2 00450 GO TO P1000-EXIT. CL**2 00451 SKIP3 CL**2 00452 *----------------------------------------------------- DTSCS79 00453 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS79 00454 *----------------------------------------------------- DTSCS79 00455 IF LCCM-F03-88 DTSCS79 00456 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS79 00457 SET REQ-JUMP TO TRUE DTSCS79 00458 GO TO P1000-EXIT. DTSCS79 00459 SKIP3 DTSCS79 00460 *----------------------------------------------------- DTSCS79 00461 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS79 00462 *----------------------------------------------------- DTSCS79 00463 IF LCCM-F04-88 DTSCS79 00464 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS79 00465 SET REQ-JUMP TO TRUE DTSCS79 00466 GO TO P1000-EXIT. DTSCS79 00467 SKIP3 DTSCS79 00468 *----------------------------------------------------- DTSCS79 00469 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS79 00470 * CORRESPONDENCE SCREEN DTSCS79 00471 *----------------------------------------------------- DTSCS79 00472 IF LCCM-F14-88 CL*24 00473 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID CL*24 00474 SET REQ-JUMP TO TRUE CL*24 00475 GO TO P1000-EXIT. CL*24 00476 SKIP3 CL*24 00477 *----------------------------------------------------- DTSCS79 00478 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS79 00479 * REQUESTED SCREEN TYPE DTSCS79 00480 *----------------------------------------------------- DTSCS79 00481 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS79 00482 NEXT SENTENCE DTSCS79 00483 ELSE DTSCS79 00484 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS79 00485 SET REQ-JUMP TO TRUE DTSCS79 00486 GO TO P1000-EXIT. DTSCS79 00487 SKIP3 DTSCS79 00488 *----------------------------------------------------- DTSCS79 00489 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DELETE, COMPRESS) DTSCS79 00490 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS79 00491 *----------------------------------------------------- DTSCS79 00492 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 CL**5 00493 IF SCR-ACCESS-UPDATE DTSCS79 00494 SET REQ-EDIT TO TRUE DTSCS79 00495 GO TO P1000-EXIT DTSCS79 00496 ELSE DTSCS79 00497 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS79 00498 SET REQ-ERROR TO TRUE DTSCS79 00499 GO TO P1000-EXIT. DTSCS79 00500 SKIP3 DTSCS79 00501 *----------------------------------------------------- DTSCS79 00502 * IF INQUIRY TYPE KEY PRESSED (ENTER) INDICATE CL*13 00503 * INQUIRY REQUEST CL*13 00504 *----------------------------------------------------- DTSCS79 00505 IF LCCM-ENTER-88 CL*13 00506 SET REQ-INQUIRE TO TRUE DTSCS79 00507 GO TO P1000-EXIT. DTSCS79 00508 SKIP3 DTSCS79 00509 *----------------------------------------------------- DTSCS79 00510 * ANY OTHER KEY IS INVALID DTSCS79 00511 *----------------------------------------------------- DTSCS79 00512 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS79 00513 SET REQ-ERROR TO TRUE. DTSCS79 00514 P1000-EXIT. EXIT. DTSCS79 00515 SKIP3 DTSCS79 00516 ******************************************************************DTSCS79 00517 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS79 00518 ******************************************************************DTSCS79 00519 SKIP1 DTSCS79 00520 P1100-UPDATE-LOCKED. DTSCS79 00521 *----------------------------------------------------- DTSCS79 00522 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS79 00523 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS79 00524 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS79 00525 *----------------------------------------------------- DTSCS79 00526 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS79 00527 SET REQ-UPDATE TO TRUE DTSCS79 00528 ELSE DTSCS79 00529 SET REQ-ERROR TO TRUE DTSCS79 00530 IF LCCM-SCR-ADD-LOCKED DTSCS79 00531 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS79 00532 ELSE DTSCS79 00533 ********IF LCCM-SCR-MOD-LOCKED OR LCCM-SCR-COMPRESS-LOCKED CL*25 00534 IF LCCM-SCR-MOD-LOCKED CL*25 00535 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS79 00536 ELSE DTSCS79 00537 IF LCCM-SCR-DEL-LOCKED DTSCS79 00538 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA DTSCS79 00539 ELSE DTSCS79 00540 GO TO S899-ABEND. DTSCS79 00541 P1100-EXIT. EXIT. DTSCS79 00542 /*****************************************************************DTSCS79 00543 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS79 00544 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS79 00545 ******************************************************************DTSCS79 00546 SKIP1 DTSCS79 00547 P2000-REQUEST-ERROR. DTSCS79 00548 IF LCCM-MSG DTSCS79 00549 SET RESP-SEND-MSGONLY TO TRUE DTSCS79 00550 ELSE DTSCS79 00551 GO TO S899-ABEND. DTSCS79 00552 P2000-EXIT. EXIT. DTSCS79 00553 /*****************************************************************DTSCS79 00554 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS79 00555 ******************************************************************DTSCS79 00556 SKIP1 DTSCS79 00557 P3000-REQUEST-JUMP. DTSCS79 00558 *----------------------------------------------------- DTSCS79 00559 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS79 00560 * BY USER DTSCS79 00561 *----------------------------------------------------- DTSCS79 00562 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS79 00563 SKIP3 DTSCS79 00564 *----------------------------------------------------- DTSCS79 00565 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS79 00566 *----------------------------------------------------- DTSCS79 00567 IF LCCM-MSG DTSCS79 00568 SET CURSOR-SET-GOTO TO TRUE DTSCS79 00569 SET RESP-SEND-MSGONLY TO TRUE DTSCS79 00570 GO TO P3000-EXIT. DTSCS79 00571 SKIP3 DTSCS79 00572 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS79 00573 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT. DTSCS79 00574 IF L018-VALID DTSCS79 00575 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS79 00576 SKIP3 DTSCS79 00577 *----------------------------------------------------- DTSCS79 00578 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS79 00579 *----------------------------------------------------- DTSCS79 00580 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS79 00581 LCCM-SCR-HOLD-AREA. DTSCS79 00582 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS79 00583 SET RESP-JUMP TO TRUE. DTSCS79 00584 P3000-EXIT. EXIT. DTSCS79 00585 /*****************************************************************DTSCS79 00586 * CLEAR KEY WAS PRESSED *DTSCS79 00587 ******************************************************************DTSCS79 00588 SKIP1 DTSCS79 00589 P4000-REQUEST-CLEAR. DTSCS79 00590 SET LCCM-SCR-CLEAR TO TRUE. DTSCS79 00591 SKIP1 DTSCS79 00592 IF SCR-ACCESS-UPDATE DTSCS79 00593 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS79 00594 ELSE DTSCS79 00595 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS79 00596 SKIP3 DTSCS79 00597 *----------------------------------------------------- DTSCS79 00598 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS79 00599 * FIELDS FROM EARLIER REQUESTS DTSCS79 00600 *----------------------------------------------------- DTSCS79 00601 IF LCCM-EMP-NO > ZERO DTSCS79 00602 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS79 00603 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS79 00604 MOVE ZERO TO LCCM-EMP-NO. DTSCS79 00605 SKIP1 DTSCS79 00606 MOVE LOW-VALUES TO LCCM-SCR79-HOLD-AREA. DTSCS79 00607 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS79 00608 SET RESP-SEND-MAP TO TRUE. DTSCS79 00609 P4000-EXIT. EXIT. DTSCS79 00610 /*****************************************************************DTSCS79 00611 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS79 00612 ******************************************************************DTSCS79 00613 SKIP1 DTSCS79 00614 P5000-CURSOR-TO-GOTO. DTSCS79 00615 SET CURSOR-SET-GOTO TO TRUE. DTSCS79 00616 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS79 00617 P5000-EXIT. EXIT. DTSCS79 00618 /*****************************************************************DTSCS79 00619 * INQUIRY WAS REQUESTED *DTSCS79 00620 ******************************************************************DTSCS79 00621 SKIP1 DTSCS79 00622 P6000-REQUEST-INQUIRE. DTSCS79 00623 SET RESP-SEND-MAP TO TRUE. DTSCS79 00624 SKIP1 DTSCS79 00625 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS79 00626 MOVE LOW-VALUES TO MAP-AREA. DTSCS79 00627 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS79 00628 SKIP1 DTSCS79 00629 IF SCR-ACCESS-UPDATE DTSCS79 00630 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS79 00631 ELSE DTSCS79 00632 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS79 00633 SKIP1 DTSCS79 00634 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS79 00635 SKIP1 DTSCS79 00636 MOVE LCCM-SCR79-HOLD-AREA TO SCR-REC-KEY-AREA. DTSCS79 00637 MOVE LOW-VALUES TO LCCM-SCR79-HOLD-AREA. DTSCS79 00638 SKIP3 DTSCS79 00639 SET LCCM-SCR-CLEAR TO TRUE. DTSCS79 00640 SKIP1 DTSCS79 00641 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS79 00642 IF LCCM-MSG DTSCS79 00643 GO TO P6000-EXIT. DTSCS79 00644 SKIP1 DTSCS79 00645 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS79 00646 IF L810-NO-REC-88 DTSCS79 00647 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS79 00648 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00649 GO TO P6000-EXIT. DTSCS79 00650 SKIP1 DTSCS79 00651 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS79 00652 SKIP1 DTSCS79 00653 PERFORM P6100-COUNT-AND-STORE-LAST THRU P6100-EXIT. DTSCS79 00654 IF LCCM-MSG DTSCS79 00655 GO TO P6000-EXIT. DTSCS79 00656 SKIP1 DTSCS79 00657 SKIP1 DTSCS79 00658 PERFORM P6200-LOCATE-REC THRU P6200-EXIT. DTSCS79 00659 IF LCCM-MSG DTSCS79 00660 GO TO P6000-EXIT. DTSCS79 00661 MOVE MSKL-REC TO MBAA-REC. DTSCS79 00662 SKIP1 DTSCS79 00663 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS79 00664 MOVE MBAA-KEY-AREA TO LCCM-SCR79-HOLD-AREA. DTSCS79 00665 SKIP1 DTSCS79 00666 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS79 00667 P6000-EXIT. EXIT. DTSCS79 00668 EJECT DTSCS79 00669 P6100-COUNT-AND-STORE-LAST. DTSCS79 00670 PERFORM S8220-MBAA-COUNT THRU S8220-EXIT. DTSCS79 00671 SKIP1 DTSCS79 00672 IF L810-RECORD-CNT = +0 DTSCS79 00673 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS79 00674 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00675 ELSE DTSCS79 00676 MOVE L810-RECORD-CNT TO LAST-REC-NUM DTSCS79 00677 MOVE MSKL-KEY-AREA TO LAST-REC-KEY-AREA. DTSCS79 00678 P6100-EXIT. EXIT. DTSCS79 00679 SKIP3 DTSCS79 00680 P6200-LOCATE-REC. DTSCS79 00681 *------------------------------------------------------------ DTSCS79 00682 * IF, AT THE LAST USE OF THIS SCREEN, A RECORD FOR DTSCS79 00683 * EMPLOYER NUMBER LCCM-EMP-NO WAS DISPLAYED ON THE DTSCS79 00684 * SCREEN, THEN BASE THE PAGING LOGIC ON THE RECORD THAT DTSCS79 00685 * WAS DISPLAYED ON THIS SCREEN; OTHERWISE, DISPLAY THE DTSCS79 00686 * RECORD WITH THE LEAST MBAA-ID-NO (THE "FIRST" ASSOCIATED DTSCS79 00687 * WITH WRK-EMP-NO). DTSCS79 00688 *------------------------------------------------------------ DTSCS79 00689 SKIP1 DTSCS79 00690 IF SCR-REC-KEY-AREA = LOW-VALUES DTSCS79 00691 PERFORM P6201-DEFAULT-PAGE THRU P6201-EXIT DTSCS79 00692 GO TO P6200-EXIT. DTSCS79 00693 SKIP3 DTSCS79 00694 MOVE SCR-REC-KEY-AREA TO MBAA-KEY-AREA. DTSCS79 00695 SKIP1 DTSCS79 00696 IF WRK-EMP-NO NOT = MBAA-EMP-NO DTSCS79 00697 PERFORM P6201-DEFAULT-PAGE THRU P6201-EXIT DTSCS79 00698 GO TO P6200-EXIT. DTSCS79 00699 SKIP3 DTSCS79 00700 * IF LCCM-F05-88 CL**6 00701 * PERFORM P6210-FIRST-REC THRU P6210-EXIT CL**6 00702 * GO TO P6200-EXIT. CL**6 00703 * SKIP1 CL**6 00704 * IF LCCM-F06-88 CL**6 00705 * PERFORM P6240-LAST-REC THRU P6240-EXIT CL**6 00706 * GO TO P6200-EXIT. CL**6 00707 SKIP3 DTSCS79 00708 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS79 00709 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS79 00710 SET MSKL-BAA-88 TO TRUE. DTSCS79 00711 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS79 00712 IF L810-NO-REC-88 DTSCS79 00713 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS79 00714 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00715 GO TO P6200-EXIT. DTSCS79 00716 SKIP1 DTSCS79 00717 MOVE +0 TO CURR-REC-NUM. DTSCS79 00718 SET WRK-BROWSE-NOT-FOUND-88 TO TRUE. DTSCS79 00719 PERFORM P6290-BROWSE-MBAA THRU P6290-EXIT DTSCS79 00720 UNTIL WRK-BROWSE-FOUND-88 DTSCS79 00721 OR L810-NO-REC-88. DTSCS79 00722 IF L810-NO-REC-88 DTSCS79 00723 PERFORM P6201-DEFAULT-PAGE THRU P6201-EXIT DTSCS79 00724 GO TO P6200-EXIT. DTSCS79 00725 SKIP3 DTSCS79 00726 IF LCCM-ENTER-88 DTSCS79 00727 PERFORM S810-END-BROWSE THRU S810-EXIT DTSCS79 00728 ELSE DTSCS79 00729 * IF LCCM-F07-88 CL**6 00730 * PERFORM P6220-PREV-REC THRU P6220-EXIT CL**6 00731 * ELSE CL**6 00732 * IF LCCM-F08-88 CL**6 00733 * PERFORM P6230-NEXT-REC THRU P6230-EXIT CL**6 00734 * ELSE CL*10 00735 GO TO S899-ABEND. DTSCS79 00736 P6200-EXIT. EXIT. DTSCS79 00737 SKIP3 DTSCS79 00738 P6201-DEFAULT-PAGE. DTSCS79 00739 PERFORM P6210-FIRST-REC THRU P6210-EXIT. DTSCS79 00740 P6201-EXIT. EXIT. DTSCS79 00741 EJECT DTSCS79 00742 P6210-FIRST-REC. DTSCS79 00743 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS79 00744 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS79 00745 SET MSKL-BAA-88 TO TRUE. DTSCS79 00746 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS79 00747 IF L810-NO-REC-88 DTSCS79 00748 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS79 00749 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00750 GO TO P6210-EXIT. DTSCS79 00751 SKIP1 DTSCS79 00752 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS79 00753 SKIP1 DTSCS79 00754 MOVE +1 TO CURR-REC-NUM. DTSCS79 00755 P6210-EXIT. EXIT. DTSCS79 00756 SKIP3 DTSCS79 00757 *P6220-PREV-REC. CL**6 00758 * PERFORM S810-READ-PREV THRU S810-EXIT. CL**6 00759 * IF L810-NO-REC-88 CL**6 00760 * MOVE EMSG-NO-RECORD TO WRK-MSG-AREA CL**6 00761 * PERFORM S1101-ERROR THRU S1101-EXIT CL**6 00762 * GO TO P6220-EXIT. CL**6 00763 * SKIP1 CL**6 00764 * PERFORM S810-READ-PREV THRU S810-EXIT. CL**6 00765 * IF L810-NO-REC-88 CL**6 00766 * GO TO P6220-EXIT. CL**6 00767 * SKIP1 CL**6 00768 * PERFORM S810-END-BROWSE THRU S810-EXIT. CL**6 00769 * SKIP1 CL**6 00770 * SUBTRACT 1 FROM CURR-REC-NUM. CL**6 00771 *P6220-EXIT. EXIT. CL**6 00772 * SKIP3 CL**6 00773 *P6230-NEXT-REC. CL**6 00774 * IF MBAA-KEY-AREA > SCR-REC-KEY-AREA CL**6 00775 * PERFORM S810-END-BROWSE THRU S810-EXIT CL**6 00776 * GO TO P6230-EXIT. CL**6 00777 * SKIP1 CL**6 00778 * PERFORM S810-READ-NEXT THRU S810-EXIT. CL**6 00779 * SKIP1 CL**6 00780 * IF L810-NO-REC-88 CL**6 00781 * GO TO P6230-EXIT. CL**6 00782 * SKIP1 CL**6 00783 * PERFORM S810-END-BROWSE THRU S810-EXIT. CL**6 00784 * SKIP1 CL**6 00785 * ADD +1 TO CURR-REC-NUM. CL**6 00786 *P6230-EXIT. EXIT. CL**6 00787 * SKIP3 CL**6 00788 *P6240-LAST-REC. CL**6 00789 * MOVE LAST-REC-KEY-AREA TO MSKL-KEY-AREA. CL**6 00790 * PERFORM S810-READ THRU S810-EXIT. CL**6 00791 * SKIP1 CL**6 00792 *------------------------------------------------------------ DTSCS79 00793 * IF THE RECORD WAS JUST DELETED, TRY ONE MORE TIME DTSCS79 00794 *------------------------------------------------------------ DTSCS79 00795 * IF L810-NO-REC-88 CL**6 00796 * PERFORM P6100-COUNT-AND-STORE-LAST THRU P6100-EXIT CL**6 00797 * IF LCCM-MSG CL**6 00798 * GO TO P6240-EXIT. CL**6 00799 * SKIP1 CL**6 00800 * MOVE LAST-REC-NUM TO CURR-REC-NUM. CL**6 00801 *P6240-EXIT. EXIT. CL**6 00802 * SKIP3 CL**6 00803 P6290-BROWSE-MBAA. DTSCS79 00804 IF MSKL-KEY-AREA < SCR-REC-KEY-AREA DTSCS79 00805 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS79 00806 ELSE DTSCS79 00807 SET WRK-BROWSE-FOUND-88 TO TRUE. DTSCS79 00808 SKIP1 DTSCS79 00809 ADD +1 TO CURR-REC-NUM. DTSCS79 00810 P6290-EXIT. EXIT. DTSCS79 00811 /*****************************************************************DTSCS79 00812 * FORMAT AND PLACE ALL FIELDS ONTO THE SCREEN (EXCEPT EMPNO) *DTSCS79 00813 ******************************************************************DTSCS79 00814 SKIP1 DTSCS79 00815 P6900-CONSTRUCT-SCREEN. DTSCS79 00816 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. CL*21 00817 PERFORM P6920-FROM-MBAA THRU P6920-EXIT. CL*21 00818 SKIP1 DTSCS79 00819 P6900-EXIT. EXIT. DTSCS79 00820 SKIP3 DTSCS79 00821 P6910-FROM-MPRF. CL*21 00822 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. CL*21 00823 P6910-EXIT. EXIT. CL*22 00824 SKIP1 CL*21 00825 P6920-FROM-MBAA. CL*21 00826 MOVE MBAA-NAME TO MAP-ALT-NAME. CL**9 00827 MOVE MBAA-ATTN-LINE TO MAP-ATTN. DTSCS79 00828 MOVE MBAA-DELIV-LINE-1 TO MAP-DLV1. CL**8 00829 MOVE MBAA-DELIV-LINE-2 TO MAP-DLV2. CL**8 00830 MOVE MBAA-CITY TO MAP-CITY. DTSCS79 00831 MOVE MBAA-ST TO MAP-STAT. DTSCS79 00832 MOVE MBAA-ZIP TO MAP-ZIPC. CL*11 00833 MOVE MBAA-VOICE-1-AREA-CD TO MAP-PHONE-A-CD (1). CL*11 00834 MOVE MBAA-VOICE-1-PREFIX TO MAP-PHONE-PREF (1). CL*11 00835 MOVE MBAA-VOICE-1-SUFFIX TO MAP-PHONE-SUFF (1). CL*11 00836 MOVE MBAA-VOICE-1-EXT TO MAP-PHONE-EXT (1). CL*11 00837 MOVE MBAA-VOICE-2-AREA-CD TO MAP-PHONE-A-CD (2). CL*11 00838 MOVE MBAA-VOICE-2-PREFIX TO MAP-PHONE-PREF (2). CL*11 00839 MOVE MBAA-VOICE-2-SUFFIX TO MAP-PHONE-SUFF (2). CL*11 00840 MOVE MBAA-VOICE-2-EXT TO MAP-PHONE-EXT (2). CL*11 00841 MOVE MBAA-FAX-AREA-CD TO MAP-PHONE-A-CD (3). CL*11 00842 MOVE MBAA-FAX-PREFIX TO MAP-PHONE-PREF (3). CL*11 00843 MOVE MBAA-FAX-SUFFIX TO MAP-PHONE-SUFF (3). CL*11 00844 MOVE MBAA-FAX-EXT TO MAP-PHONE-EXT (3). CL*11 00845 MOVE MBAA-EMAIL-ADDRESS TO MAP-EMAIL. CL**4 00846 MOVE MBAA-ESTB-ABSTIME TO L005-ABSTIME. CL*18 00847 SET L005-FROM-ABSTIME TO TRUE CL*18 00848 PERFORM S005-CDATE-TIME THRU S005-EXIT. CL*18 00849 MOVE L005-DATE-8-SLASH-TIME TO MAP-CREATE-DATE-TIME. CL*18 00850 P6920-EXIT. EXIT. CL*21 00851 SKIP3 DTSCS79 00852 /*****************************************************************DTSCS79 00853 * FUNCTION KEY TO UPDATE THE FILE WAS PRESSED. *DTSCS79 00854 ******************************************************************DTSCS79 00855 SKIP1 DTSCS79 00856 P7000-REQUEST-EDIT. DTSCS79 00857 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS79 00858 SKIP1 DTSCS79 00859 IF LCCM-F09-88 DTSCS79 00860 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS79 00861 ELSE DTSCS79 00862 IF LCCM-F10-88 CL*20 00863 *****OR LCCM-F22-88 CL*20 00864 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS79 00865 ELSE DTSCS79 00866 IF LCCM-F23-88 DTSCS79 00867 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS79 00868 ELSE DTSCS79 00869 GO TO S899-ABEND. DTSCS79 00870 SKIP1 DTSCS79 00871 *------------------------------------------------------ DTSCS79 00872 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS79 00873 * IN ORDER TO CONTINUE TO ATTEMPT AN UPDATE THE SCREEN DTSCS79 00874 * MUST REMAIN IN 'INQUIRE' STATUS. DTSCS79 00875 *------------------------------------------------------ DTSCS79 00876 SKIP1 DTSCS79 00877 IF LCCM-NO-MSG DTSCS79 00878 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS79 00879 IF LCCM-F09-88 DTSCS79 00880 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS79 00881 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS79 00882 ELSE DTSCS79 00883 IF LCCM-F10-88 DTSCS79 00884 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS79 00885 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS79 00886 ELSE DTSCS79 00887 IF LCCM-F23-88 DTSCS79 00888 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS79 00889 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA. CL*13 00890 * ELSE CL*13 00891 * IF LCCM-F22-88 CL*13 00892 * SET LCCM-SCR-COMPRESS-LOCKED TO TRUE CL*13 00893 * MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA. CL*13 00894 SKIP1 DTSCS79 00895 SET RESP-SEND-MAP TO TRUE. DTSCS79 00896 P7000-EXIT. EXIT. DTSCS79 00897 /*****************************************************************DTSCS79 00898 * ADD FUNCTION WAS REQUESTED *DTSCS79 00899 ******************************************************************DTSCS79 00900 SKIP1 DTSCS79 00901 P7100-EDIT-ADD. DTSCS79 00902 *----------------------------------------------------- DTSCS79 00903 * ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE DTSCS79 00904 *----------------------------------------------------- DTSCS79 00905 IF NOT LCCM-SCR-CLEAR DTSCS79 00906 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-AREA DTSCS79 00907 GO TO P7100-EXIT. DTSCS79 00908 SKIP1 DTSCS79 00909 *----------------------------------------------------- DTSCS79 00910 * MAP-EMP-NO IS REQUIRED DTSCS79 00911 *----------------------------------------------------- DTSCS79 00912 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS79 00913 IF LCCM-MSG DTSCS79 00914 GO TO P7100-EXIT. DTSCS79 00915 SKIP1 DTSCS79 00916 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS79 00917 IF L810-NO-REC-88 DTSCS79 00918 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS79 00919 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00920 GO TO P7100-EXIT. DTSCS79 00921 SKIP1 DTSCS79 00922 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS79 00923 IF LCCM-MSG DTSCS79 00924 GO TO P7100-EXIT. DTSCS79 00925 SKIP1 DTSCS79 00926 * IF WRK-ID-NO = +0 CL**6 00927 * PERFORM S8220-MBAA-COUNT THRU S8220-EXIT CL**6 00928 * IF L810-RECORD-CNT = +0 CL**6 00929 * MOVE +1 TO MAP-BEN-ALT-ID-N CL**6 00930 * ELSE CL**6 00931 * MOVE MSKL-KEY-AREA TO MBAA-KEY-AREA CL**6 00932 * IF MBAA-ID-NO = +999 CL**6 00933 * MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA CL**6 00934 * PERFORM S2101-ERROR THROUGH S2101-EXIT CL**6 00935 * ELSE CL**6 00936 * ADD +1, MBAA-ID-NO GIVING MAP-BEN-ALT-ID-N CL**6 00937 * ELSE CL**6 00938 PERFORM S8210-READ-MBAA THRU S8210-EXIT DTSCS79 00939 IF L810-OK-88 DTSCS79 00940 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS79 00941 PERFORM S1101-ERROR THROUGH S1101-EXIT CL*25 00942 GO TO P7100-EXIT. DTSCS79 00943 P7100-EXIT. EXIT. DTSCS79 00944 /*****************************************************************DTSCS79 00945 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS79 00946 ******************************************************************DTSCS79 00947 SKIP1 DTSCS79 00948 P7200-EDIT-MOD. DTSCS79 00949 *----------------------------------------------------- DTSCS79 00950 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS79 00951 * INQUIRED DTSCS79 00952 *----------------------------------------------------- DTSCS79 00953 IF NOT LCCM-SCR-INQUIRE DTSCS79 00954 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS79 00955 GO TO P7200-EXIT. DTSCS79 00956 SKIP1 DTSCS79 00957 *----------------------------------------------------- DTSCS79 00958 * KEYS MAY NOT BE CHANGED DURING THE MOD DTSCS79 00959 *----------------------------------------------------- DTSCS79 00960 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS79 00961 IF LCCM-MSG DTSCS79 00962 GO TO P7200-EXIT. DTSCS79 00963 SKIP1 DTSCS79 00964 IF LCCM-EMP-NO = WRK-EMP-NO DTSCS79 00965 MOVE LCCM-SCR79-HOLD-AREA TO MBAA-KEY-AREA DTSCS79 00966 IF WRK-ID-NO = MBAA-ID-NO DTSCS79 00967 NEXT SENTENCE DTSCS79 00968 ELSE DTSCS79 00969 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS79 00970 PERFORM S1101-ERROR THRU S1101-EXIT CL*25 00971 GO TO P7200-EXIT DTSCS79 00972 ELSE DTSCS79 00973 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS79 00974 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00975 GO TO P7200-EXIT. DTSCS79 00976 SKIP1 DTSCS79 00977 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS79 00978 IF L810-NO-REC-88 DTSCS79 00979 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS79 00980 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 00981 GO TO P7200-EXIT. DTSCS79 00982 SKIP1 DTSCS79 00983 MOVE LCCM-SCR79-HOLD-AREA TO MSKL-KEY-AREA. DTSCS79 00984 PERFORM S810-READ THRU S810-EXIT. DTSCS79 00985 IF L810-OK-88 DTSCS79 00986 MOVE MSKL-REC TO MBAA-REC DTSCS79 00987 ELSE DTSCS79 00988 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS79 00989 PERFORM S1101-ERROR THROUGH S1101-EXIT CL*25 00990 GO TO P7200-EXIT. DTSCS79 00991 SKIP1 DTSCS79 00992 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS79 00993 P7200-EXIT. EXIT. DTSCS79 00994 /*****************************************************************DTSCS79 00995 * DELETE FUNCTION WAS REQUESTED *DTSCS79 00996 ******************************************************************DTSCS79 00997 SKIP1 DTSCS79 00998 P7300-EDIT-DEL. DTSCS79 00999 *----------------------------------------------------- DTSCS79 01000 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS79 01001 * INQUIRED DTSCS79 01002 *----------------------------------------------------- DTSCS79 01003 IF NOT LCCM-SCR-INQUIRE DTSCS79 01004 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-AREA DTSCS79 01005 GO TO P7300-EXIT. DTSCS79 01006 SKIP1 DTSCS79 01007 *----------------------------------------------------- DTSCS79 01008 * KEYS MAY NOT BE CHANGED DURING THE DELETE DTSCS79 01009 *----------------------------------------------------- DTSCS79 01010 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS79 01011 IF LCCM-MSG DTSCS79 01012 GO TO P7300-EXIT. DTSCS79 01013 SKIP1 DTSCS79 01014 IF LCCM-EMP-NO = WRK-EMP-NO DTSCS79 01015 MOVE LCCM-SCR79-HOLD-AREA TO MBAA-KEY-AREA DTSCS79 01016 IF WRK-ID-NO = MBAA-ID-NO DTSCS79 01017 NEXT SENTENCE DTSCS79 01018 ELSE DTSCS79 01019 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS79 01020 PERFORM S1101-ERROR THRU S1101-EXIT CL*25 01021 GO TO P7300-EXIT DTSCS79 01022 ELSE DTSCS79 01023 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS79 01024 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 01025 GO TO P7300-EXIT. DTSCS79 01026 SKIP1 DTSCS79 01027 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS79 01028 IF L810-NO-REC-88 DTSCS79 01029 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS79 01030 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 01031 GO TO P7300-EXIT. DTSCS79 01032 SKIP1 DTSCS79 01033 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSCS79 01034 PERFORM S810-READ THRU S810-EXIT. DTSCS79 01035 IF L810-NO-REC-88 DTSCS79 01036 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA CL*25 01037 PERFORM S1101-ERROR THRU S1101-EXIT. CL*25 01038 P7300-EXIT. EXIT. DTSCS79 01039 /*****************************************************************DTSCS79 01040 * THE ADD/MODIFY/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS79 01041 ******************************************************************DTSCS79 01042 SKIP1 DTSCS79 01043 P8000-REQUEST-UPDATE. DTSCS79 01044 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS79 01045 SKIP1 DTSCS79 01046 IF LCCM-SCR-ADD-LOCKED DTSCS79 01047 PERFORM P8100-ADD THRU P8100-EXIT DTSCS79 01048 ELSE DTSCS79 01049 *****IF LCCM-SCR-MOD-LOCKED OR LCCM-SCR-COMPRESS-LOCKED CL*25 01050 IF LCCM-SCR-MOD-LOCKED CL*25 01051 PERFORM P8200-MOD THRU P8200-EXIT DTSCS79 01052 ELSE DTSCS79 01053 IF LCCM-SCR-DEL-LOCKED DTSCS79 01054 PERFORM P8300-DEL THRU P8300-EXIT DTSCS79 01055 ELSE DTSCS79 01056 GO TO S899-ABEND. DTSCS79 01057 SKIP1 DTSCS79 01058 SET RESP-SEND-MAP TO TRUE. DTSCS79 01059 P8000-EXIT. EXIT. DTSCS79 01060 /*****************************************************************DTSCS79 01061 * DTSCS79 01062 ******************************************************************DTSCS79 01063 SKIP1 DTSCS79 01064 P8100-ADD. DTSCS79 01065 SET LCCM-SCR-CLEAR TO TRUE. DTSCS79 01066 SKIP1 DTSCS79 01067 IF LCCM-F12-88 DTSCS79 01068 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-AREA DTSCS79 01069 GO TO P8100-EXIT. DTSCS79 01070 SKIP1 DTSCS79 01071 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS79 01072 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS79 01073 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS79 01074 IF LCCM-MSG DTSCS79 01075 GO TO P8100-EXIT. DTSCS79 01076 PERFORM S8210-READ-MBAA THRU S8210-EXIT. DTSCS79 01077 IF L810-NO-REC-88 DTSCS79 01078 PERFORM P8110-ADD-MBAA THRU P8110-EXIT DTSCS79 01079 PERFORM P8120-MODIFY-MPRF THRU P8120-EXIT CL*25 01080 ELSE DTSCS79 01081 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS79 01082 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS79 01083 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS79 01084 IF LCCM-MSG DTSCS79 01085 GO TO P8100-EXIT. DTSCS79 01086 SKIP1 DTSCS79 01087 MOVE MBAA-KEY-AREA TO LCCM-SCR79-HOLD-AREA. DTSCS79 01088 SKIP1 DTSCS79 01089 SET LCCM-ENTER-88 TO TRUE. DTSCS79 01090 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS79 01091 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS79 01092 SKIP1 DTSCS79 01093 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS79 01094 P8100-EXIT. EXIT. DTSCS79 01095 EJECT DTSCS79 01096 P8110-ADD-MBAA. DTSCS79 01097 MOVE +0 TO MBAA-PURGE-DATE. DTSCS79 01098 MOVE LOW-VALUE TO MBAA-DATA-AREA. DTSCS79 01099 INITIALIZE MBAA-DATA-AREA. DTSCS79 01100 SET MBAA-NOT-CONVERTED-88 TO TRUE. DTSCS79 01101 MOVE LCCM-TASK-START-ABSTIME TO MBAA-ESTB-ABSTIME. CL*18 01102 MOVE LCCM-CURR-RUN-DATE TO MBAA-ESTB-DATE CL*18 01103 MBAA-CHNG-DATE. DTSCS79 01104 SKIP1 DTSCS79 01105 PERFORM P8910-UPDATE-MBAA THRU P8910-EXIT. DTSCS79 01106 MOVE MBAA-REC TO MSKL-REC. DTSCS79 01107 PERFORM S810-WRITE THRU S810-EXIT. DTSCS79 01108 P8110-EXIT. EXIT. DTSCS79 01109 CL*25 01110 CL*25 01111 CL*25 01112 P8120-MODIFY-MPRF. CL*25 01113 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*25 01114 CL*25 01115 MOVE WRK-EMP-NO TO MSKL-EMP-NO. CL*25 01116 CL*25 01117 SET MSKL-PRF-88 TO TRUE. CL*25 01118 CL*25 01119 PERFORM S810-READ THRU S810-EXIT. CL*25 01120 CL*25 01121 IF L810-NO-REC-88 CL*25 01122 GO TO P8120-EXIT. CL*25 01123 CL*25 01124 MOVE MSKL-REC TO MPRF-REC. CL*25 01125 CL*25 01126 SET MPRF-BEN-MAIL-ADDR-YES-88 TO TRUE. CL*25 01127 CL*25 01128 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. CL*25 01129 CL*25 01130 MOVE MPRF-REC TO MSKL-REC. CL*25 01131 CL*25 01132 PERFORM S810-REWRITE THRU S810-EXIT. CL*25 01133 P8120-EXIT. CL*25 01134 EXIT. CL*25 01135 /*****************************************************************DTSCS79 01136 * DTSCS79 01137 ******************************************************************DTSCS79 01138 SKIP1 DTSCS79 01139 P8200-MOD. DTSCS79 01140 * IF LCCM-SCR-COMPRESS-LOCKED CL*13 01141 * SET WRK-SCR-COMPRESS-LOCKED TO TRUE CL*13 01142 * ELSE CL*13 01143 SET WRK-SCR-MOD-LOCKED TO TRUE. DTSCS79 01144 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS79 01145 SKIP1 DTSCS79 01146 IF LCCM-F12-88 DTSCS79 01147 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS79 01148 GO TO P8200-EXIT. DTSCS79 01149 SKIP1 DTSCS79 01150 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS79 01151 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS79 01152 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS79 01153 IF LCCM-MSG DTSCS79 01154 GO TO P8200-EXIT. DTSCS79 01155 PERFORM S8210-READ-MBAA THRU S8210-EXIT. DTSCS79 01156 IF L810-OK-88 DTSCS79 01157 PERFORM P8210-MOD-MBAA THRU P8210-EXIT DTSCS79 01158 ELSE DTSCS79 01159 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS79 01160 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS79 01161 * IF WRK-SCR-COMPRESS-LOCKED CL**6 01162 * PERFORM P8220-COMPRESS-IDS THRU P8220-EXIT. CL**6 01163 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS79 01164 IF LCCM-MSG DTSCS79 01165 GO TO P8200-EXIT. DTSCS79 01166 SKIP1 DTSCS79 01167 MOVE MBAA-KEY-AREA TO LCCM-SCR79-HOLD-AREA. DTSCS79 01168 SKIP1 DTSCS79 01169 SET LCCM-ENTER-88 TO TRUE. DTSCS79 01170 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT. DTSCS79 01171 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS79 01172 SKIP1 DTSCS79 01173 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS79 01174 P8200-EXIT. EXIT. DTSCS79 01175 SKIP3 DTSCS79 01176 SKIP3 DTSCS79 01177 P8210-MOD-MBAA. DTSCS79 01178 PERFORM P8910-UPDATE-MBAA THRU P8910-EXIT. DTSCS79 01179 MOVE MBAA-REC TO MSKL-REC. DTSCS79 01180 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS79 01181 P8210-EXIT. EXIT. DTSCS79 01182 EJECT DTSCS79 01183 *P8220-COMPRESS-IDS. CL**6 01184 * MOVE MBAA-ID-NO TO WRK-HOLD-ID. CL**6 01185 * SKIP1 CL**6 01186 * MOVE LOW-VALUE TO MSKL-KEY-AREA. CL**6 01187 * MOVE WRK-EMP-NO TO MSKL-EMP-NO. CL**6 01188 * SET MSKL-BAA-88 TO TRUE. CL**6 01189 * PERFORM S810-START-BROWSE THRU S810-EXIT. CL**6 01190 * PERFORM VARYING WRK-NEW-ID FROM 1 BY 1 CL**6 01191 * UNTIL L810-NO-REC-88 CL**6 01192 * PERFORM P8221-REPLACE-BAA-RECORD THRU P8221-EXIT CL**6 01193 * PERFORM S810-READ-NEXT THRU S810-EXIT CL**6 01194 * END-PERFORM. CL**6 01195 * SKIP1 CL**6 01196 * MOVE WRK-HOLD-ID TO MBAA-ID-NO. CL**6 01197 *P8220-EXIT. EXIT. CL**6 01198 * SKIP3 CL**6 01199 SKIP3 DTSCS79 01200 *P8221-REPLACE-BAA-RECORD. CL**9 01201 * MOVE MSKL-REC TO MBAA-REC. CL**9 01202 * IF MBAA-ID-NO = WRK-NEW-ID CL**9 01203 * GO TO P8221-EXIT. CL**9 01204 * SKIP3 CL**9 01205 * IF MBAA-ID-NO = WRK-HOLD-ID CL**9 01206 * MOVE WRK-NEW-ID TO WRK-HOLD-ID. CL**9 01207 * SKIP1 CL**9 01208 * PERFORM S810-END-BROWSE THRU S810-EXIT. CL**9 01209 * PERFORM S810-DELETE THRU S810-EXIT. CL**9 01210 * SKIP1 CL**9 01211 * MOVE WRK-NEW-ID TO MBAA-ID-NO. CL**9 01212 * MOVE MBAA-REC TO MSKL-REC. CL**9 01213 * PERFORM S810-WRITE THRU S810-EXIT. CL**9 01214 * PERFORM S810-START-BROWSE THRU S810-EXIT. CL**9 01215 *P8221-EXIT. EXIT. CL**9 01216 /*****************************************************************DTSCS79 01217 * DTSCS79 01218 ******************************************************************DTSCS79 01219 SKIP1 DTSCS79 01220 P8300-DEL. DTSCS79 01221 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS79 01222 SKIP1 DTSCS79 01223 IF LCCM-F12-88 DTSCS79 01224 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-AREA DTSCS79 01225 GO TO P8300-EXIT. DTSCS79 01226 SKIP1 DTSCS79 01227 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS79 01228 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS79 01229 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS79 01230 IF LCCM-MSG DTSCS79 01231 GO TO P8300-EXIT. DTSCS79 01232 PERFORM S8210-READ-MBAA THRU S8210-EXIT. DTSCS79 01233 IF L810-NO-REC-88 DTSCS79 01234 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS79 01235 PERFORM S1101-ERROR THRU S1101-EXIT CL*25 01236 ELSE DTSCS79 01237 PERFORM P8310-DEL-MBAA THRU P8310-EXIT CL*25 01238 PERFORM P8320-MODIFY-MPRF THRU P8320-EXIT. CL*25 01239 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS79 01240 IF LCCM-MSG DTSCS79 01241 GO TO P8300-EXIT. DTSCS79 01242 SKIP1 DTSCS79 01243 SET LCCM-SCR-CLEAR TO TRUE. DTSCS79 01244 MOVE LOW-VALUES TO MAP-AREA. DTSCS79 01245 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS79 01246 SKIP1 DTSCS79 01247 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS79 01248 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS79 01249 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS79 01250 * MOVE WRK-ID-NO TO MAP-BEN-ALT-ID-N. CL*10 01251 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS79 01252 SKIP1 DTSCS79 01253 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS79 01254 P8300-EXIT. EXIT. DTSCS79 01255 EJECT DTSCS79 01256 P8310-DEL-MBAA. DTSCS79 01257 PERFORM S810-DELETE THRU S810-EXIT. DTSCS79 01258 CL*30 01259 CL*30 01260 PERFORM P8330-MLOG-PROCESSING THRU P8330-EXIT. CL*30 01261 P8310-EXIT. CL*30 01262 EXIT. CL*30 01263 CL*25 01264 CL*30 01265 CL*25 01266 P8320-MODIFY-MPRF. CL*25 01267 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*25 01268 CL*25 01269 MOVE WRK-EMP-NO TO MSKL-EMP-NO. CL*25 01270 CL*25 01271 SET MSKL-PRF-88 TO TRUE. CL*25 01272 CL*25 01273 PERFORM S810-READ THRU S810-EXIT. CL*25 01274 CL*25 01275 IF L810-NO-REC-88 CL*25 01276 GO TO P8320-EXIT. CL*25 01277 CL*25 01278 MOVE MSKL-REC TO MPRF-REC. CL*25 01279 CL*25 01280 SET MPRF-BEN-MAIL-ADDR-NO-88 TO TRUE. CL*25 01281 CL*25 01282 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. CL*25 01283 CL*25 01284 MOVE MPRF-REC TO MSKL-REC. CL*25 01285 CL*25 01286 PERFORM S810-REWRITE THRU S810-EXIT. CL*25 01287 P8320-EXIT. CL*25 01288 EXIT. CL*25 01289 CL*30 01290 CL*30 01291 CL*30 01292 P8330-MLOG-PROCESSING. CL*30 01293 MOVE WRK-EMP-NO TO L331-EMP-NO. CL*30 01294 CL*30 01295 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. CL*30 01296 CL*30 01297 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. CL*30 01298 CL*30 01299 MOVE LCCM-OP-ID TO L331-OP-ID. CL*30 01300 CL*30 01301 MOVE MBAA-ESTB-ABSTIME TO L005-ABSTIME. CL*30 01302 CL*30 01303 SET L005-FROM-ABSTIME TO TRUE CL*30 01304 CL*30 01305 PERFORM S005-CDATE-TIME THRU S005-EXIT. CL*30 01306 CL*30 01307 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. CL*30 01308 CL*30 01309 CL*30 01310 IF MBAA-NAME NOT = SPACES CL*30 01311 MOVE 'MBAA-NAME' TO L331-FIELD-NAME CL*30 01312 MOVE MBAA-NAME TO L331-FROM-VALUE CL*30 01313 MOVE SPACES TO L331-TO-VALUE CL*30 01314 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01315 CL*30 01316 CL*30 01317 IF MBAA-ATTN-LINE NOT = SPACES CL*30 01318 MOVE 'MBAA-ATTN-LINE' TO L331-FIELD-NAME CL*30 01319 MOVE MBAA-ATTN-LINE TO L331-FROM-VALUE CL*30 01320 MOVE SPACES TO L331-TO-VALUE CL*30 01321 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01322 CL*30 01323 CL*30 01324 IF MBAA-DELIV-LINE-1 NOT = SPACES CL*30 01325 MOVE 'MBAA-DELIV-LINE-1' TO L331-FIELD-NAME CL*30 01326 MOVE MBAA-DELIV-LINE-1 TO L331-FROM-VALUE CL*30 01327 MOVE SPACES TO L331-TO-VALUE CL*30 01328 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01329 CL*30 01330 CL*30 01331 IF MBAA-DELIV-LINE-2 NOT = SPACES CL*30 01332 MOVE 'MBAA-DELIV-LINE-2' TO L331-FIELD-NAME CL*30 01333 MOVE MBAA-DELIV-LINE-2 TO L331-FROM-VALUE CL*30 01334 MOVE SPACES TO L331-TO-VALUE CL*30 01335 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01336 CL*30 01337 CL*30 01338 IF MBAA-CITY NOT = SPACES CL*30 01339 MOVE 'MBAA-CITY' TO L331-FIELD-NAME CL*30 01340 MOVE MBAA-CITY TO L331-FROM-VALUE CL*30 01341 MOVE SPACES TO L331-TO-VALUE CL*30 01342 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01343 CL*30 01344 CL*30 01345 IF MBAA-ST NOT = SPACES CL*30 01346 MOVE 'MBAA-ST' TO L331-FIELD-NAME CL*30 01347 MOVE MBAA-ST TO L331-FROM-VALUE CL*30 01348 MOVE SPACES TO L331-TO-VALUE CL*30 01349 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01350 CL*30 01351 CL*30 01352 IF MBAA-ZIP NOT = SPACES CL*30 01353 MOVE 'MBAA-ZIP' TO L331-FIELD-NAME CL*30 01354 MOVE MBAA-ZIP TO L331-FROM-VALUE CL*30 01355 MOVE SPACES TO L331-TO-VALUE CL*30 01356 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01357 CL*30 01358 CL*30 01359 IF MBAA-VOICE-1 NOT = SPACES CL*30 01360 MOVE 'MBAA-VOICE-1' TO L331-FIELD-NAME CL*30 01361 MOVE SPACES TO L331-FROM-VALUE CL*30 01362 L331-TO-VALUE CL*30 01363 STRING MBAA-VOICE-1-AREA-CD CL*30 01364 ' ' CL*30 01365 MBAA-VOICE-1-PREFIX CL*30 01366 ' ' CL*30 01367 MBAA-VOICE-1-SUFFIX CL*30 01368 ' ' CL*30 01369 MBAA-VOICE-1-EXT DELIMITED BY SIZE CL*30 01370 INTO L331-FROM-VALUE CL*30 01371 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01372 CL*30 01373 CL*30 01374 IF MBAA-VOICE-2 NOT = SPACES CL*30 01375 MOVE 'MBAA-VOICE-2' TO L331-FIELD-NAME CL*30 01376 MOVE SPACES TO L331-FROM-VALUE CL*30 01377 L331-TO-VALUE CL*30 01378 STRING MBAA-VOICE-2-AREA-CD CL*30 01379 ' ' CL*30 01380 MBAA-VOICE-2-PREFIX CL*30 01381 ' ' CL*30 01382 MBAA-VOICE-2-SUFFIX CL*30 01383 ' ' CL*30 01384 MBAA-VOICE-2-EXT DELIMITED BY SIZE CL*30 01385 INTO L331-FROM-VALUE CL*30 01386 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01387 CL*30 01388 CL*30 01389 IF MBAA-FAX NOT = SPACES CL*30 01390 MOVE 'MBAA-FAX' TO L331-FIELD-NAME CL*30 01391 MOVE SPACES TO L331-FROM-VALUE CL*30 01392 L331-TO-VALUE CL*30 01393 STRING MBAA-FAX-AREA-CD CL*30 01394 ' ' CL*30 01395 MBAA-FAX-PREFIX CL*30 01396 ' ' CL*30 01397 MBAA-FAX-SUFFIX CL*30 01398 ' ' CL*30 01399 MBAA-FAX-EXT DELIMITED BY SIZE CL*30 01400 INTO L331-FROM-VALUE CL*30 01401 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01402 CL*30 01403 CL*30 01404 IF MBAA-EMAIL-ADDRESS NOT = SPACES CL*30 01405 MOVE 'MBAA-EMAIL-ADDRESS' TO L331-FIELD-NAME CL*31 01406 MOVE MBAA-EMAIL-ADDRESS TO L331-FROM-VALUE CL*30 01407 MOVE SPACES TO L331-TO-VALUE CL*30 01408 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*30 01409 P8330-EXIT. CL*30 01410 EXIT. CL*30 01411 /*****************************************************************DTSCS79 01412 * *DTSCS79 01413 ******************************************************************DTSCS79 01414 P8800-LOCK-EMPLOYER. DTSCS79 01415 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS79 01416 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS79 01417 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS79 01418 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS79 01419 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS79 01420 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. CL**4 01421 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS79 01422 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS79 01423 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS79 01424 SKIP1 DTSCS79 01425 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS79 01426 P8800-EXIT. EXIT. DTSCS79 01427 /*****************************************************************DTSCS79 01428 * MOVE ALL NON-KEY SCREEN FIELDS TO FILE RECORD LAYOUT *DTSCS79 01429 ******************************************************************DTSCS79 01430 P8910-UPDATE-MBAA. DTSCS79 01431 MOVE MBAA-VOICE-1 TO WRK-MBAA-PHONE(1). CL*26 01432 CL*27 01433 MOVE MBAA-VOICE-2 TO WRK-MBAA-PHONE(2). CL*26 01434 CL*27 01435 MOVE MBAA-FAX TO WRK-MBAA-PHONE (3). CL*26 01436 CL*27 01437 PERFORM P8911-UPDATE-PHONES THRU P8911-EXIT CL*26 01438 VARYING WRK-PHONE FROM 1 BY 1 CL*27 01439 UNTIL WRK-PHONE GREATER THAN 3. CL*27 01440 CL*27 01441 CL*27 01442 MOVE LCCM-HOLD-ADDRESS-79 TO L072-ADDRESS. CL*27 01443 CL*27 01444 CL*27 01445 PERFORM P8920-MLOG-PROCESSING THRU P8920-EXIT. CL*27 01446 CL*27 01447 CL*27 01448 MOVE MAP-ALT-NAME TO MBAA-NAME. CL**9 01449 CL*27 01450 CL*27 01451 MOVE L072-ATTN-LINE TO MBAA-ATTN-LINE. CL*27 01452 CL*27 01453 MOVE L072-DELIV-LINE-1 TO MBAA-DELIV-LINE-1. CL*27 01454 CL*27 01455 MOVE L072-DELIV-LINE-2 TO MBAA-DELIV-LINE-2. CL*27 01456 CL*27 01457 MOVE L072-CITY TO MBAA-CITY. CL*27 01458 CL*27 01459 MOVE L072-ST TO MBAA-ST. CL*27 01460 CL*27 01461 MOVE L072-ZIP TO MBAA-ZIP. CL*27 01462 CL*27 01463 MOVE L072-ADVANCED-BARCODE TO MBAA-ADVANCED-BARCODE CL**8 01464 CL*27 01465 CL*27 01466 MOVE WRK-MBAA-PHONE (1) TO MBAA-VOICE-1. CL**8 01467 CL*27 01468 MOVE WRK-MBAA-PHONE (2) TO MBAA-VOICE-2. CL**8 01469 CL*27 01470 MOVE WRK-MBAA-PHONE (3) TO MBAA-FAX. DTSCS79 01471 CL*27 01472 CL*27 01473 MOVE MAP-EMAIL TO MBAA-EMAIL-ADDRESS. CL*27 01474 P8910-EXIT. CL*27 01475 EXIT. CL*27 01476 CL*27 01477 CL*27 01478 CL*27 01479 P8911-UPDATE-PHONES. DTSCS79 01480 MOVE MAP-PHONE-AREA (WRK-PHONE) TO L021-S-TNO-AREA. DTSCS79 01481 CL*27 01482 PERFORM S021-SCREEN-PHONE THRU S021-EXIT. DTSCS79 01483 CL*27 01484 MOVE L021-TNO TO WRK-MBAA-PHONE (WRK-PHONE). DTSCS79 01485 P8911-EXIT. CL*27 01486 EXIT. CL*27 01487 CL*27 01488 CL*27 01489 CL*27 01490 P8920-MLOG-PROCESSING. CL*26 01491 MOVE WRK-EMP-NO TO L331-EMP-NO. CL*26 01492 CL*26 01493 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. CL*26 01494 CL*26 01495 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. CL*26 01496 CL*26 01497 MOVE LCCM-OP-ID TO L331-OP-ID. CL*26 01498 CL*27 01499 MOVE MBAA-ESTB-ABSTIME TO L005-ABSTIME. CL*27 01500 CL*27 01501 SET L005-FROM-ABSTIME TO TRUE CL*27 01502 CL*27 01503 PERFORM S005-CDATE-TIME THRU S005-EXIT. CL*27 01504 CL*27 01505 MOVE L005-DATE-8-SLASH-TIME TO L331-REC-OCC-ID. CL*27 01506 CL*27 01507 CL*27 01508 IF MAP-ALT-NAME NOT = MBAA-NAME CL*28 01509 MOVE 'MBAA-NAME' TO L331-FIELD-NAME CL*28 01510 MOVE MBAA-NAME TO L331-FROM-VALUE CL*28 01511 MOVE MAP-ALT-NAME TO L331-TO-VALUE CL*28 01512 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01513 CL*28 01514 CL*28 01515 IF L072-ATTN-LINE NOT = MBAA-ATTN-LINE CL*28 01516 MOVE 'MBAA-ATTN-LINE' TO L331-FIELD-NAME CL*28 01517 MOVE MBAA-ATTN-LINE TO L331-FROM-VALUE CL*28 01518 MOVE L072-ATTN-LINE TO L331-TO-VALUE CL*28 01519 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01520 CL*28 01521 CL*28 01522 IF L072-DELIV-LINE-1 NOT = MBAA-DELIV-LINE-1 CL*28 01523 MOVE 'MBAA-DELIV-LINE-1' TO L331-FIELD-NAME CL*28 01524 MOVE MBAA-DELIV-LINE-1 TO L331-FROM-VALUE CL*28 01525 MOVE L072-DELIV-LINE-1 TO L331-TO-VALUE CL*28 01526 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01527 CL*28 01528 CL*28 01529 IF L072-DELIV-LINE-2 NOT = MBAA-DELIV-LINE-2 CL*28 01530 MOVE 'MBAA-DELIV-LINE-2' TO L331-FIELD-NAME CL*28 01531 MOVE MBAA-DELIV-LINE-2 TO L331-FROM-VALUE CL*28 01532 MOVE L072-DELIV-LINE-2 TO L331-TO-VALUE CL*28 01533 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01534 CL*28 01535 CL*28 01536 IF L072-CITY NOT = MBAA-CITY CL*28 01537 MOVE 'MBAA-CITY' TO L331-FIELD-NAME CL*28 01538 MOVE MBAA-CITY TO L331-FROM-VALUE CL*28 01539 MOVE L072-CITY TO L331-TO-VALUE CL*28 01540 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01541 CL*28 01542 CL*28 01543 IF L072-ST NOT = MBAA-ST CL*28 01544 MOVE 'MBAA-ST' TO L331-FIELD-NAME CL*28 01545 MOVE MBAA-ST TO L331-FROM-VALUE CL*28 01546 MOVE L072-ST TO L331-TO-VALUE CL*28 01547 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01548 CL*28 01549 CL*28 01550 IF L072-ZIP NOT = MBAA-ZIP CL*28 01551 MOVE 'MBAA-ZIP' TO L331-FIELD-NAME CL*28 01552 MOVE MBAA-ZIP TO L331-FROM-VALUE CL*28 01553 MOVE L072-ZIP TO L331-TO-VALUE CL*28 01554 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01555 CL*28 01556 CL*29 01557 IF WRK-MBAA-PHONE (1) NOT = MBAA-VOICE-1 CL*29 01558 MOVE 'MBAA-VOICE-1' TO L331-FIELD-NAME CL*29 01559 MOVE SPACES TO L331-FROM-VALUE CL*29 01560 L331-TO-VALUE CL*29 01561 STRING MBAA-VOICE-1-AREA-CD CL*29 01562 ' ' CL*29 01563 MBAA-VOICE-1-PREFIX CL*29 01564 ' ' CL*29 01565 MBAA-VOICE-1-SUFFIX CL*29 01566 ' ' CL*29 01567 MBAA-VOICE-1-EXT DELIMITED BY SIZE CL*29 01568 INTO L331-FROM-VALUE CL*29 01569 STRING WRK-MBAA-PHONE-A-CD (1) CL*29 01570 ' ' CL*29 01571 WRK-MBAA-PHONE-PREF (1) CL*29 01572 ' ' CL*29 01573 WRK-MBAA-PHONE-SUFF (1) CL*29 01574 ' ' CL*29 01575 WRK-MBAA-PHONE-EXT (1) DELIMITED BY SIZE CL*29 01576 INTO L331-TO-VALUE CL*29 01577 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*29 01578 CL*29 01579 CL*29 01580 IF WRK-MBAA-PHONE (2) NOT = MBAA-VOICE-2 CL*29 01581 MOVE 'MBAA-VOICE-2' TO L331-FIELD-NAME CL*29 01582 MOVE SPACES TO L331-FROM-VALUE CL*29 01583 L331-TO-VALUE CL*29 01584 STRING MBAA-VOICE-2-AREA-CD CL*29 01585 ' ' CL*29 01586 MBAA-VOICE-2-PREFIX CL*29 01587 ' ' CL*29 01588 MBAA-VOICE-2-SUFFIX CL*29 01589 ' ' CL*29 01590 MBAA-VOICE-2-EXT DELIMITED BY SIZE CL*29 01591 INTO L331-FROM-VALUE CL*29 01592 STRING WRK-MBAA-PHONE-A-CD (2) CL*29 01593 ' ' CL*29 01594 WRK-MBAA-PHONE-PREF (2) CL*29 01595 ' ' CL*29 01596 WRK-MBAA-PHONE-SUFF (2) CL*29 01597 ' ' CL*29 01598 WRK-MBAA-PHONE-EXT (2) DELIMITED BY SIZE CL*29 01599 INTO L331-TO-VALUE CL*29 01600 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*29 01601 CL*29 01602 CL*29 01603 IF WRK-MBAA-PHONE (3) NOT = MBAA-FAX CL*29 01604 MOVE 'MBAA-FAX' TO L331-FIELD-NAME CL*29 01605 MOVE SPACES TO L331-FROM-VALUE CL*29 01606 L331-TO-VALUE CL*29 01607 STRING MBAA-FAX-AREA-CD CL*29 01608 ' ' CL*29 01609 MBAA-FAX-PREFIX CL*29 01610 ' ' CL*29 01611 MBAA-FAX-SUFFIX CL*29 01612 ' ' CL*29 01613 MBAA-FAX-EXT DELIMITED BY SIZE CL*29 01614 INTO L331-FROM-VALUE CL*29 01615 STRING WRK-MBAA-PHONE-A-CD (3) CL*29 01616 ' ' CL*29 01617 WRK-MBAA-PHONE-PREF (3) CL*29 01618 ' ' CL*29 01619 WRK-MBAA-PHONE-SUFF (3) CL*29 01620 ' ' CL*29 01621 WRK-MBAA-PHONE-EXT (3) DELIMITED BY SIZE CL*29 01622 INTO L331-TO-VALUE CL*29 01623 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*29 01624 CL*29 01625 CL*28 01626 IF MAP-EMAIL NOT = MBAA-EMAIL-ADDRESS CL*28 01627 MOVE 'MBAA-EMAIL-ADDRESS' TO L331-FIELD-NAME CL*31 01628 MOVE MBAA-EMAIL-ADDRESS TO L331-FROM-VALUE CL*28 01629 MOVE MAP-EMAIL TO L331-TO-VALUE CL*28 01630 PERFORM S331-WRITE-MLOG THRU S331-EXIT. CL*28 01631 P8920-EXIT. CL*26 01632 EXIT. CL*26 01633 /*****************************************************************DTSCS79 01634 * LINKS TO UTILITY MODULES DTSCS79 01635 ******************************************************************DTSCS79 01636 SKIP1 CL*18 01637 S005-CDATE-TIME. CL*18 01638 EXEC CICS LINK CL*18 01639 PROGRAM ('DTSCU005') CL*18 01640 COMMAREA (L005-COMM-AREA) CL*18 01641 END-EXEC. CL*18 01642 S005-EXIT. CL*18 01643 EXIT. CL*18 01644 SKIP1 DTSCS79 01645 S013-SCREEN-COUNT. DTSCS79 01646 EXEC CICS LINK DTSCS79 01647 PROGRAM ('DTSCU013') CL**2 01648 COMMAREA (L013-COMM-AREA) DTSCS79 01649 END-EXEC. DTSCS79 01650 S013-EXIT. DTSCS79 01651 EXIT. DTSCS79 01652 SKIP3 DTSCS79 01653 S018-SCREEN-EMPNO. DTSCS79 01654 EXEC CICS LINK DTSCS79 01655 PROGRAM ('DTSCU018') CL**2 01656 COMMAREA (L018-COMM-AREA) DTSCS79 01657 END-EXEC. DTSCS79 01658 S018-EXIT. DTSCS79 01659 EXIT. DTSCS79 01660 SKIP3 DTSCS79 01661 S021-SCREEN-PHONE. DTSCS79 01662 EXEC CICS LINK DTSCS79 01663 PROGRAM ('DTSCU021') CL**2 01664 COMMAREA (L021-COMM-AREA) DTSCS79 01665 END-EXEC. DTSCS79 01666 S021-EXIT. DTSCS79 01667 EXIT. DTSCS79 01668 SKIP3 DTSCS79 01669 S072-EDIT-ADDRESS. DTSCS79 01670 EXEC CICS LINK DTSCS79 01671 PROGRAM ('DTSCU072') CL**2 01672 COMMAREA (L072-COMM-AREA) DTSCS79 01673 END-EXEC. DTSCS79 01674 S072-EXIT. DTSCS79 01675 EXIT. DTSCS79 01676 SKIP3 DTSCS79 01677 S073-EDIT-PHONE. DTSCS79 01678 EXEC CICS LINK DTSCS79 01679 PROGRAM ('DTSCU073') CL**2 01680 COMMAREA (L073-COMM-AREA) DTSCS79 01681 END-EXEC. DTSCS79 01682 S073-EXIT. DTSCS79 01683 EXIT. DTSCS79 01684 SKIP3 DTSCS79 01685 S221-EMP-LOCK. DTSCS79 01686 SET L221-START-UPDATE TO TRUE. DTSCS79 01687 GO TO S221-EMP-LOCK-UNLOCK. DTSCS79 01688 SKIP1 DTSCS79 01689 S221-EMP-UNLOCK. DTSCS79 01690 SET L221-END-UPDATE TO TRUE. DTSCS79 01691 GO TO S221-EMP-LOCK-UNLOCK. DTSCS79 01692 SKIP1 DTSCS79 01693 S221-EMP-LOCK-UNLOCK. DTSCS79 01694 EXEC CICS LINK DTSCS79 01695 PROGRAM ('DTSCU221') CL**2 01696 COMMAREA (L221-COMM-AREA) DTSCS79 01697 END-EXEC. DTSCS79 01698 SKIP1 DTSCS79 01699 IF L221-FILE-CLOSED DTSCS79 01700 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS79 01701 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS79 01702 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS79 01703 GO TO MAINLINE-EXIT. DTSCS79 01704 SKIP1 DTSCS79 01705 IF L221-NOT-OK DTSCS79 01706 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS79 01707 S221-EXIT. DTSCS79 01708 EXIT. DTSCS79 01709 SKIP3 DTSCS79 01710 S331-WRITE-MLOG. CL*26 01711 EXEC CICS CL*26 01712 LINK CL*26 01713 PROGRAM ('DTSCU331') CL*26 01714 COMMAREA (L331-COMM-AREA) CL*26 01715 END-EXEC. CL*26 01716 CL*26 01717 IF L331-FILE-CLOSED CL*26 01718 MOVE L331-MSG-AREA TO LCCM-MSG-AREA CL*26 01719 SET LCCM-REQ-SCR-SF-88 TO TRUE CL*26 01720 SET LCCM-LINK-SCREEN-88 TO TRUE CL*26 01721 GO TO MAINLINE-EXIT. CL*26 01722 S331-EXIT. CL*26 01723 EXIT. CL*26 01724 SKIP3 CL*26 01725 S803-REQ-SCR-ID-EDIT. DTSCS79 01726 EXEC CICS LINK DTSCS79 01727 PROGRAM ('DTSCU803') CL**2 01728 COMMAREA (DFHCOMMAREA) DTSCS79 01729 END-EXEC. DTSCS79 01730 S803-EXIT. DTSCS79 01731 EXIT. DTSCS79 01732 SKIP3 DTSCS79 01733 S804-INVALID-KEY. DTSCS79 01734 EXEC CICS LINK DTSCS79 01735 PROGRAM ('DTSCU804') CL**2 01736 COMMAREA (DFHCOMMAREA) DTSCS79 01737 END-EXEC. DTSCS79 01738 S804-EXIT. DTSCS79 01739 EXIT. DTSCS79 01740 SKIP3 DTSCS79 01741 S805-MSG-AREA. DTSCS79 01742 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS79 01743 SKIP1 DTSCS79 01744 EXEC CICS LINK DTSCS79 01745 PROGRAM ('DTSCU805') CL**2 01746 COMMAREA (L805-COMM-AREA) DTSCS79 01747 END-EXEC. DTSCS79 01748 SKIP1 DTSCS79 01749 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS79 01750 S805-EXIT. DTSCS79 01751 EXIT. DTSCS79 01752 EJECT DTSCS79 01753 S810-READ. DTSCS79 01754 SET L810-READ-88 TO TRUE. DTSCS79 01755 GO TO S810-IO. DTSCS79 01756 SKIP1 DTSCS79 01757 S810-START-BROWSE. DTSCS79 01758 SET L810-START-BROWSE-88 TO TRUE. DTSCS79 01759 GO TO S810-IO. DTSCS79 01760 SKIP1 DTSCS79 01761 S810-READ-NEXT. DTSCS79 01762 SET L810-READ-NEXT-88 TO TRUE. DTSCS79 01763 GO TO S810-IO. DTSCS79 01764 SKIP1 DTSCS79 01765 S810-READ-PREV. DTSCS79 01766 SET L810-READ-PREV-88 TO TRUE. DTSCS79 01767 GO TO S810-IO. DTSCS79 01768 SKIP1 DTSCS79 01769 S810-END-BROWSE. DTSCS79 01770 SET L810-END-BROWSE-88 TO TRUE. DTSCS79 01771 GO TO S810-IO. DTSCS79 01772 SKIP1 DTSCS79 01773 S810-COUNT. DTSCS79 01774 SET L810-COUNT-88 TO TRUE. DTSCS79 01775 GO TO S810-IO. DTSCS79 01776 SKIP1 DTSCS79 01777 S810-REWRITE. DTSCS79 01778 SET L810-REWRITE-88 TO TRUE. DTSCS79 01779 GO TO S810-IO. DTSCS79 01780 SKIP1 DTSCS79 01781 S810-WRITE. DTSCS79 01782 SET L810-WRITE-88 TO TRUE. DTSCS79 01783 GO TO S810-IO. DTSCS79 01784 SKIP1 DTSCS79 01785 S810-DELETE. DTSCS79 01786 SET L810-DELETE-88 TO TRUE. DTSCS79 01787 GO TO S810-IO. DTSCS79 01788 SKIP1 DTSCS79 01789 S810-IO. DTSCS79 01790 SKIP1 DTSCS79 01791 EXEC CICS LINK DTSCS79 01792 PROGRAM ('DTSCU810') CL**2 01793 COMMAREA (L810-COMM-AREA) DTSCS79 01794 END-EXEC. DTSCS79 01795 SKIP1 DTSCS79 01796 IF L810-FILE-CLOSED-88 DTSCS79 01797 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS79 01798 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS79 01799 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS79 01800 GO TO MAINLINE-EXIT. DTSCS79 01801 S810-EXIT. DTSCS79 01802 EXIT. DTSCS79 01803 SKIP3 DTSCS79 01804 S851-SCREEN-PROCESSING. DTSCS79 01805 EXEC CICS LINK DTSCS79 01806 PROGRAM ('DTSCU851') CL**2 01807 COMMAREA (L851-COMM-AREA) DTSCS79 01808 END-EXEC. DTSCS79 01809 S851-EXIT. DTSCS79 01810 EXIT. DTSCS79 01811 SKIP3 DTSCS79 01812 S899-ABEND. DTSCS79 01813 EXEC CICS ABEND DTSCS79 01814 ABCODE(WRK-ABEND-CD) DTSCS79 01815 END-EXEC. DTSCS79 01816 *S899-EXIT. DTSCS79 01817 * EXIT. DTSCS79 01818 /*****************************************************************DTSCS79 01819 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS79 01820 ******************************************************************DTSCS79 01821 SKIP1 DTSCS79 01822 S1001-SCREEN-KEY-EDITS. DTSCS79 01823 SKIP1 DTSCS79 01824 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS79 01825 * PERFORM S2100-BEN-ALT-ID THRU S2100-EXIT. CL**8 01826 SKIP1 DTSCS79 01827 S1001-EXIT. EXIT. DTSCS79 01828 SKIP3 DTSCS79 01829 S1002-SCREEN-DATA-EDITS. DTSCS79 01830 SKIP1 DTSCS79 01831 *****MOVE LOW-VALUE TO MAP-CASS. CL*25 01832 SKIP1 DTSCS79 01833 PERFORM S1200-NAME THRU S1200-EXIT. DTSCS79 01834 SKIP1 DTSCS79 01835 PERFORM S1300-ADDRESS THRU S1300-EXIT. DTSCS79 01836 IF WRK-MAP-PHON-BLANK DTSCS79 01837 GO TO S1002-EXIT. DTSCS79 01838 SKIP1 DTSCS79 01839 MOVE MAP-STAT TO L073-ST. DTSCS79 01840 MOVE MAP-ZIPC TO L073-ZIP. DTSCS79 01841 PERFORM S1400-PHONE THRU S1400-EXIT DTSCS79 01842 VARYING WRK-PHONE FROM 1 BY 1 DTSCS79 01843 UNTIL WRK-PHONE GREATER THAN 3. DTSCS79 01844 SKIP1 DTSCS79 01845 IF MAP-EMAIL = LOW-VALUES CL*27 01846 MOVE SPACES TO MAP-EMAIL. CL*27 01847 S1002-EXIT. EXIT. DTSCS79 01848 /*****************************************************************DTSCS79 01849 * DTSCS79 01850 ******************************************************************DTSCS79 01851 S1100-EMP-NO. DTSCS79 01852 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS79 01853 PERFORM S018-SCREEN-EMPNO THRU S018-EXIT. DTSCS79 01854 SKIP1 DTSCS79 01855 IF L018-NO-ENTRY DTSCS79 01856 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS79 01857 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 01858 ELSE DTSCS79 01859 IF L018-NOT-VALID DTSCS79 01860 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS79 01861 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS79 01862 ELSE DTSCS79 01863 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS79 01864 S1100-EXIT. EXIT. DTSCS79 01865 SKIP3 DTSCS79 01866 S1101-ERROR. DTSCS79 01867 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS79 01868 MAP-EMP-NO-2-A. DTSCS79 01869 IF LCCM-NO-MSG DTSCS79 01870 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS79 01871 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS79 01872 SET CURSOR-SET-YES TO TRUE. DTSCS79 01873 S1101-EXIT. EXIT. DTSCS79 01874 /*****************************************************************DTSCS79 01875 * DTSCS79 01876 ******************************************************************DTSCS79 01877 S1200-NAME. DTSCS79 01878 INSPECT MAP-ALT-NAME CONVERTING LOW-VALUE TO SPACE. DTSCS79 01879 SKIP1 DTSCS79 01880 IF MAP-ALT-NAME = SPACE DTSCS79 01881 NEXT SENTENCE CL*21 01882 ELSE DTSCS79 01883 IF MAP-ALT-NAME (1:1) = SPACE DTSCS79 01884 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS79 01885 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS79 01886 S1200-EXIT. EXIT. DTSCS79 01887 DTSCS79 01888 S1201-ERROR. DTSCS79 01889 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ALT-NAME-A. DTSCS79 01890 IF LCCM-NO-MSG DTSCS79 01891 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS79 01892 MOVE CATB-CURSOR TO MAP-ALT-NAME-L DTSCS79 01893 SET CURSOR-SET-YES TO TRUE. DTSCS79 01894 S1201-EXIT. EXIT. DTSCS79 01895 /*****************************************************************DTSCS79 01896 * *DTSCS79 01897 ******************************************************************DTSCS79 01898 S1300-ADDRESS. DTSCS79 01899 IF MAP-ATTN = SPACE OR LOW-VALUE DTSCS79 01900 MOVE SPACE TO MAP-ATTN. CL*17 01901 IF MAP-CIND = SPACE OR LOW-VALUE CL**8 01902 MOVE SPACE TO MAP-CIND. CL*25 01903 IF MAP-DLV1 = SPACE OR LOW-VALUE CL**8 01904 MOVE SPACE TO MAP-DLV1. CL**8 01905 IF MAP-DLV2 = SPACE OR LOW-VALUE CL**8 01906 MOVE SPACE TO MAP-DLV2. CL**8 01907 IF MAP-CITY = SPACE OR LOW-VALUE DTSCS79 01908 MOVE SPACE TO MAP-CITY. DTSCS79 01909 IF MAP-STAT = SPACE OR LOW-VALUE DTSCS79 01910 MOVE SPACE TO MAP-STAT. DTSCS79 01911 IF MAP-ZIPC = SPACE OR LOW-VALUE DTSCS79 01912 MOVE SPACE TO MAP-ZIPC. DTSCS79 01913 SKIP1 DTSCS79 01914 PERFORM S1310-IS-MAP-ADDRPHON-BLANK THRU S1310-EXIT. DTSCS79 01915 IF WRK-MAP-ADDR-HAS-DATA DTSCS79 01916 MOVE SPACE TO L072-ADDRESS DTSCS79 01917 PERFORM S1320-ADDR THRU S1320-EXIT DTSCS79 01918 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-79 CL*15 01919 ELSE DTSCS79 01920 MOVE EMSG-FIELD-REQUIRED TO L072-MSG-AREA DTSCS79 01921 PERFORM S1321-ERROR THRU S1321-EXIT. DTSCS79 01922 SKIP1 DTSCS79 01923 S1300-EXIT. EXIT. DTSCS79 01924 SKIP3 DTSCS79 01925 *S1301-ERROR. CL*25 01926 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CIND-A. CL*25 01927 *****IF LCCM-NO-MSG CL*25 01928 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL*25 01929 *********MOVE CATB-CURSOR TO MAP-CIND-L CL*25 01930 *********SET CURSOR-SET-YES TO TRUE. CL*25 01931 *S1301-EXIT. EXIT. CL*25 01932 /*****************************************************************DTSCS79 01933 * *DTSCS79 01934 ******************************************************************DTSCS79 01935 S1310-IS-MAP-ADDRPHON-BLANK. DTSCS79 01936 IF MAP-ATTN = SPACE DTSCS79 01937 AND MAP-DLV1 = SPACE CL**8 01938 AND MAP-DLV2 = SPACE CL**8 01939 AND MAP-CITY = SPACE DTSCS79 01940 AND MAP-STAT = SPACE DTSCS79 01941 AND MAP-ZIPC = SPACE DTSCS79 01942 MOVE SPACE TO MAP-CASS CL**8 01943 MAP-CIND DTSCS79 01944 SET WRK-MAP-ADDR-BLANK TO TRUE DTSCS79 01945 ELSE DTSCS79 01946 SET WRK-MAP-ADDR-HAS-DATA TO TRUE. DTSCS79 01947 DTSCS79 01948 PERFORM S1311-INSPECT-PHONE THRU S1311-EXIT DTSCS79 01949 VARYING WRK-PHONE FROM 1 BY 1 DTSCS79 01950 UNTIL WRK-PHONE > +3. CL*25 01951 DTSCS79 01952 IF (MAP-PHONE-A-CD (1) = SPACE) DTSCS79 01953 AND (MAP-PHONE-PREF (1) = SPACE) DTSCS79 01954 AND (MAP-PHONE-SUFF (1) = SPACE) DTSCS79 01955 AND (MAP-PHONE-EXT (1) = SPACE) CL**3 01956 AND (MAP-PHONE-A-CD (2) = SPACE) DTSCS79 01957 AND (MAP-PHONE-PREF (2) = SPACE) DTSCS79 01958 AND (MAP-PHONE-SUFF (2) = SPACE) DTSCS79 01959 AND (MAP-PHONE-EXT (2) = SPACE) CL**3 01960 AND (MAP-PHONE-A-CD (3) = SPACE) DTSCS79 01961 AND (MAP-PHONE-PREF (3) = SPACE) DTSCS79 01962 AND (MAP-PHONE-SUFF (3) = SPACE) DTSCS79 01963 AND (MAP-PHONE-EXT (3) = SPACE) CL**3 01964 SET WRK-MAP-PHON-BLANK TO TRUE DTSCS79 01965 ELSE DTSCS79 01966 SET WRK-MAP-PHON-HAS-DATA TO TRUE. DTSCS79 01967 S1310-EXIT. EXIT. DTSCS79 01968 SKIP3 DTSCS79 01969 S1311-INSPECT-PHONE. DTSCS79 01970 INSPECT MAP-PHONE-A-CD (WRK-PHONE) DTSCS79 01971 CONVERTING LOW-VALUES TO SPACES. DTSCS79 01972 DTSCS79 01973 INSPECT MAP-PHONE-PREF (WRK-PHONE) DTSCS79 01974 CONVERTING LOW-VALUES TO SPACES. DTSCS79 01975 DTSCS79 01976 INSPECT MAP-PHONE-SUFF (WRK-PHONE) DTSCS79 01977 CONVERTING LOW-VALUES TO SPACES. DTSCS79 01978 CL**3 01979 INSPECT MAP-PHONE-EXT (WRK-PHONE) CL**3 01980 CONVERTING LOW-VALUES TO SPACES. CL**3 01981 S1311-EXIT. EXIT. DTSCS79 01982 /*****************************************************************DTSCS79 01983 * *DTSCS79 01984 ******************************************************************DTSCS79 01985 S1320-ADDR. DTSCS79 01986 MOVE MAP-CIND TO L072-CASS-IND. DTSCS79 01987 SET L072-MBAA-88 TO TRUE. DTSCS79 01988 MOVE MAP-ALT-NAME TO L072-NAME. DTSCS79 01989 MOVE MAP-ATTN TO L072-ATTN-LINE. DTSCS79 01990 MOVE MAP-DLV1 TO L072-DELIV-LINE-1. CL**8 01991 MOVE MAP-DLV2 TO L072-DELIV-LINE-2. CL**8 01992 MOVE MAP-CITY TO L072-CITY. DTSCS79 01993 MOVE MAP-STAT TO L072-ST. DTSCS79 01994 MOVE MAP-ZIPC TO L072-ZIP. DTSCS79 01995 SKIP1 DTSCS79 01996 *------------------------------------------------------------ DTSCS79 01997 * DEFAULT L072-CASS-IND IS BLANK, SO 'Y' IS DELIBERATE. DTSCS79 01998 *------------------------------------------------------------ DTSCS79 01999 IF L072-CASS-IND = 'Y' CL*25 02000 OR WRK-MBAA-NO-88 CL*25 02001 NEXT SENTENCE CL*25 02002 ELSE CL*25 02003 IF L072-ATTN-LINE = MBAA-ATTN-LINE CL*25 02004 AND L072-DELIV-LINE-1 = MBAA-DELIV-LINE-1 CL*25 02005 AND L072-DELIV-LINE-2 = MBAA-DELIV-LINE-2 CL*25 02006 AND L072-CITY = MBAA-CITY CL*25 02007 AND L072-ST = MBAA-ST CL*25 02008 AND L072-ZIP = MBAA-ZIP CL*25 02009 MOVE MBAA-ADVANCED-BARCODE CL*25 02010 TO L072-ADVANCED-BARCODE CL*25 02011 GO TO S1320-EXIT. CL*25 02012 SKIP1 DTSCS79 02013 PERFORM S072-EDIT-ADDRESS THRU S072-EXIT. DTSCS79 02014 SKIP1 DTSCS79 02015 MOVE L072-CASS-IND TO MAP-CIND. DTSCS79 02016 MOVE L072-CASS-RETURN-CODES TO MAP-CASS. DTSCS79 02017 SKIP3 DTSCS79 02018 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS79 02019 PERFORM S1321-ERROR THRU S1321-EXIT DTSCS79 02020 ELSE DTSCS79 02021 MOVE L072-ATTN-LINE TO MAP-ATTN DTSCS79 02022 IF L072-ATTN-LINE-CHANGED-88 DTSCS79 02023 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A. DTSCS79 02024 SKIP1 DTSCS79 02025 IF L072-DELIV-LINE-1-NOT-VALID-88 CL**8 02026 PERFORM S1322-ERROR THRU S1322-EXIT CL**8 02027 ELSE DTSCS79 02028 MOVE L072-DELIV-LINE-1 TO MAP-DLV1 CL**9 02029 IF L072-DELIV-LINE-1-CHANGED-88 CL**8 02030 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A. CL**8 02031 SKIP1 DTSCS79 02032 IF L072-DELIV-LINE-2-NOT-VALID-88 CL**8 02033 PERFORM S1323-ERROR THRU S1323-EXIT CL**8 02034 ELSE CL**8 02035 MOVE L072-DELIV-LINE-2 TO MAP-DLV2 CL**9 02036 IF L072-DELIV-LINE-2-CHANGED-88 CL**8 02037 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A. CL**8 02038 SKIP1 CL**8 02039 IF L072-CITY-NOT-VALID-88 DTSCS79 02040 PERFORM S1324-ERROR THRU S1324-EXIT DTSCS79 02041 ELSE DTSCS79 02042 MOVE L072-CITY TO MAP-CITY DTSCS79 02043 IF L072-CITY-CHANGED-88 DTSCS79 02044 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A. DTSCS79 02045 SKIP1 DTSCS79 02046 IF L072-ST-NOT-VALID-88 DTSCS79 02047 PERFORM S1325-ERROR THRU S1325-EXIT DTSCS79 02048 ELSE DTSCS79 02049 MOVE L072-ST TO MAP-STAT DTSCS79 02050 IF L072-ST-CHANGED-88 DTSCS79 02051 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STAT-A. DTSCS79 02052 SKIP1 DTSCS79 02053 IF L072-ZIP-NOT-VALID-88 DTSCS79 02054 PERFORM S1326-ERROR THRU S1326-EXIT DTSCS79 02055 ELSE DTSCS79 02056 MOVE L072-ZIP TO MAP-ZIPC DTSCS79 02057 IF L072-ZIP-CHANGED-88 DTSCS79 02058 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIPC-A. DTSCS79 02059 SKIP3 DTSCS79 02060 IF L072-ADDRESS-NOT-VALID-88 DTSCS79 02061 IF LCCM-NO-MSG DTSCS79 02062 PERFORM S1321-ERROR THRU S1321-EXIT. DTSCS79 02063 SKIP1 DTSCS79 02064 S1320-EXIT. EXIT. DTSCS79 02065 SKIP3 DTSCS79 02066 S1321-ERROR. DTSCS79 02067 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A. DTSCS79 02068 IF LCCM-NO-MSG DTSCS79 02069 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02070 MOVE CATB-CURSOR TO MAP-ATTN-L DTSCS79 02071 SET CURSOR-SET-YES TO TRUE. DTSCS79 02072 S1321-EXIT. EXIT. DTSCS79 02073 SKIP3 DTSCS79 02074 S1322-ERROR. DTSCS79 02075 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A. CL**8 02076 IF LCCM-NO-MSG DTSCS79 02077 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02078 MOVE CATB-CURSOR TO MAP-DLV1-L CL**8 02079 SET CURSOR-SET-YES TO TRUE. DTSCS79 02080 S1322-EXIT. EXIT. DTSCS79 02081 SKIP3 DTSCS79 02082 S1323-ERROR. DTSCS79 02083 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A. CL**8 02084 IF LCCM-NO-MSG DTSCS79 02085 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02086 MOVE CATB-CURSOR TO MAP-DLV2-L CL**8 02087 SET CURSOR-SET-YES TO TRUE. DTSCS79 02088 S1323-EXIT. EXIT. DTSCS79 02089 SKIP3 DTSCS79 02090 S1324-ERROR. DTSCS79 02091 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A. DTSCS79 02092 IF LCCM-NO-MSG DTSCS79 02093 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02094 MOVE CATB-CURSOR TO MAP-CITY-L DTSCS79 02095 SET CURSOR-SET-YES TO TRUE. DTSCS79 02096 S1324-EXIT. EXIT. DTSCS79 02097 SKIP3 DTSCS79 02098 S1325-ERROR. DTSCS79 02099 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STAT-A. DTSCS79 02100 IF LCCM-NO-MSG DTSCS79 02101 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02102 MOVE CATB-CURSOR TO MAP-STAT-L DTSCS79 02103 SET CURSOR-SET-YES TO TRUE. DTSCS79 02104 S1325-EXIT. EXIT. DTSCS79 02105 SKIP3 DTSCS79 02106 S1326-ERROR. DTSCS79 02107 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIPC-A. DTSCS79 02108 IF LCCM-NO-MSG DTSCS79 02109 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02110 MOVE CATB-CURSOR TO MAP-ZIPC-L DTSCS79 02111 SET CURSOR-SET-YES TO TRUE. DTSCS79 02112 S1326-EXIT. EXIT. DTSCS79 02113 SKIP3 DTSCS79 02114 /*****************************************************************DTSCS79 02115 * *DTSCS79 02116 ******************************************************************DTSCS79 02117 S1400-PHONE. DTSCS79 02118 MOVE MAP-PHONE-AREA (WRK-PHONE) TO L021-S-TNO-AREA. DTSCS79 02119 PERFORM S021-SCREEN-PHONE THRU S021-EXIT. DTSCS79 02120 IF L021-NOT-VALID DTSCS79 02121 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS79 02122 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS79 02123 ELSE DTSCS79 02124 IF L021-VALID DTSCS79 02125 MOVE L021-TNO TO L073-TELEPHONE DTSCS79 02126 PERFORM S073-EDIT-PHONE THRU S073-EXIT DTSCS79 02127 IF L073-NOT-VALID DTSCS79 02128 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS79 02129 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS79 02130 ELSE DTSCS79 02131 MOVE L073-AREA-CD TO MAP-PHONE-A-CD (WRK-PHONE) DTSCS79 02132 MOVE L073-PREFIX TO MAP-PHONE-PREF (WRK-PHONE) DTSCS79 02133 MOVE L073-SUFFIX TO MAP-PHONE-SUFF (WRK-PHONE) CL**9 02134 MOVE L073-EXT TO MAP-PHONE-EXT (WRK-PHONE). CL**9 02135 S1400-EXIT. EXIT. DTSCS79 02136 SKIP3 DTSCS79 02137 S1401-ERROR. DTSCS79 02138 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS79 02139 TO MAP-PHONE-A-CD-A (WRK-PHONE) DTSCS79 02140 MAP-PHONE-PREF-A (WRK-PHONE) DTSCS79 02141 MAP-PHONE-SUFF-A (WRK-PHONE) CL*10 02142 MAP-PHONE-EXT-A (WRK-PHONE). CL**9 02143 IF LCCM-NO-MSG DTSCS79 02144 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS79 02145 MOVE CATB-CURSOR TO MAP-PHONE-A-CD-L (WRK-PHONE) DTSCS79 02146 SET CURSOR-SET-YES TO TRUE. DTSCS79 02147 S1401-EXIT. EXIT. DTSCS79 02148 /*****************************************************************DTSCS79 02149 * DTSCS79 02150 ******************************************************************DTSCS79 02151 *S2100-BEN-ALT-ID. CL**8 02152 * MOVE MAP-BEN-ALT-ID-AREA TO L013-S-CNT-AREA. CL**8 02153 * MOVE +1 TO L013-MIN-CNT. CL**8 02154 * MOVE +999 TO L013-MAX-CNT. CL**8 02155 * PERFORM S013-SCREEN-COUNT THRU S013-EXIT. CL**8 02156 * SKIP1 CL**8 02157 * IF L013-NO-ENTRY CL**8 02158 * MOVE +0 TO WRK-ID-NO CL**8 02159 * ELSE CL**8 02160 * IF L013-VALID CL**8 02161 * MOVE L013-CNT TO WRK-ID-NO CL**8 02162 * MAP-BEN-ALT-ID-N CL**8 02163 * ELSE CL**8 02164 * MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA CL**8 02165 * PERFORM S2101-ERROR THRU S2101-EXIT. CL**8 02166 *S2100-EXIT. EXIT. CL**8 02167 * SKIP3 CL**8 02168 *S2101-ERROR. CL**9 02169 * MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BEN-ALT-ID-A. CL**9 02170 * IF LCCM-NO-MSG CL**9 02171 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL**9 02172 * MOVE CATB-CURSOR TO MAP-BEN-ALT-ID-L CL**9 02173 * SET CURSOR-SET-YES TO TRUE. CL**9 02174 *S2101-EXIT. EXIT. CL**9 02175 /*****************************************************************DTSCS79 02176 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS79 02177 ******************************************************************DTSCS79 02178 S5100-SET-LOCK-ATTRB. DTSCS79 02179 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS79 02180 SCR-ATB-NUM. DTSCS79 02181 SKIP1 DTSCS79 02182 PERFORM S5110-HOLD-ATTRB THRU S5110-EXIT. DTSCS79 02183 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS79 02184 PERFORM S5120-RESTORE-ATTRB THRU S5120-EXIT. DTSCS79 02185 SKIP1 DTSCS79 02186 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS79 02187 MAP-EMP-NO-2-A DTSCS79 02188 MAP-GOTO-A. DTSCS79 02189 S5100-EXIT. EXIT. DTSCS79 02190 SKIP3 DTSCS79 02191 S5110-HOLD-ATTRB. DTSCS79 02192 MOVE MAP-ATTN-A TO HOLD-ATTN-A. DTSCS79 02193 MOVE MAP-DLV1-A TO HOLD-DLV1-A. CL**9 02194 MOVE MAP-DLV2-A TO HOLD-DLV2-A. CL**9 02195 MOVE MAP-CITY-A TO HOLD-CITY-A. DTSCS79 02196 MOVE MAP-STAT-A TO HOLD-STAT-A. DTSCS79 02197 MOVE MAP-ZIPC-A TO HOLD-ZIPC-A. DTSCS79 02198 S5110-EXIT. EXIT. DTSCS79 02199 SKIP3 DTSCS79 02200 S5120-RESTORE-ATTRB. DTSCS79 02201 IF HOLD-ATTN-A = CATB-UNPROT-NORM-AN-MDTON DTSCS79 02202 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-A. DTSCS79 02203 IF HOLD-DLV1-A = CATB-UNPROT-NORM-AN-MDTON CL**9 02204 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV1-A. CL**9 02205 IF HOLD-DLV2-A = CATB-UNPROT-NORM-AN-MDTON CL**9 02206 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV2-A. CL**9 02207 IF HOLD-CITY-A = CATB-UNPROT-NORM-AN-MDTON DTSCS79 02208 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A. DTSCS79 02209 IF HOLD-STAT-A = CATB-UNPROT-NORM-AN-MDTON DTSCS79 02210 MOVE CATB-ASKIP-NORM-MDTON TO MAP-STAT-A. DTSCS79 02211 IF HOLD-ZIPC-A = CATB-UNPROT-NORM-AN-MDTON DTSCS79 02212 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIPC-A. DTSCS79 02213 S5120-EXIT. EXIT. DTSCS79 02214 EJECT DTSCS79 02215 ******************************************************************DTSCS79 02216 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS79 02217 ******************************************************************DTSCS79 02218 S5200-SET-UPDATE-ATTRB. DTSCS79 02219 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS79 02220 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS79 02221 SKIP1 DTSCS79 02222 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS79 02223 S5200-EXIT. EXIT. DTSCS79 02224 SKIP3 DTSCS79 02225 ******************************************************************DTSCS79 02226 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS79 02227 ******************************************************************DTSCS79 02228 S5300-SET-INQ-ATTRB. DTSCS79 02229 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS79 02230 SCR-ATB-NUM. DTSCS79 02231 SKIP1 DTSCS79 02232 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS79 02233 S5300-EXIT. EXIT. DTSCS79 02234 /*****************************************************************DTSCS79 02235 * DO IT *DTSCS79 02236 ******************************************************************DTSCS79 02237 S5900-SET-ATTRB. DTSCS79 02238 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS79 02239 MAP-EMP-NO-2-A. DTSCS79 02240 SKIP1 DTSCS79 02241 MOVE SCR-ATB-AN TO MAP-ALT-NAME-A CL*23 02242 MAP-ATTN-A DTSCS79 02243 MAP-DLV1-A CL**9 02244 MAP-DLV2-A CL**9 02245 MAP-CIND-A DTSCS79 02246 MAP-CITY-A DTSCS79 02247 MAP-STAT-A DTSCS79 02248 MAP-ZIPC-A CL*12 02249 MAP-EMAIL-A. CL*12 02250 SKIP1 DTSCS79 02251 MOVE SCR-ATB-NUM TO MAP-PHONE-A-CD-A (1) DTSCS79 02252 MAP-PHONE-PREF-A (1) DTSCS79 02253 MAP-PHONE-SUFF-A (1) DTSCS79 02254 MAP-PHONE-EXT-A (1) CL**9 02255 MAP-PHONE-A-CD-A (2) DTSCS79 02256 MAP-PHONE-PREF-A (2) DTSCS79 02257 MAP-PHONE-SUFF-A (2) DTSCS79 02258 MAP-PHONE-EXT-A (2) CL**9 02259 MAP-PHONE-A-CD-A (3) DTSCS79 02260 MAP-PHONE-PREF-A (3) DTSCS79 02261 MAP-PHONE-SUFF-A (3) CL**9 02262 MAP-PHONE-EXT-A (3). CL**9 02263 SKIP1 DTSCS79 02264 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PRIMARY-NAME-A CL*32 02265 MAP-CREATE-DATE-TIME-A. CL*32 02266 SKIP1 DTSCS79 02267 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS79 02268 S5900-EXIT. EXIT. DTSCS79 02269 /*****************************************************************DTSCS79 02270 * PREPARE THEN READ *DTSCS79 02271 ******************************************************************DTSCS79 02272 S8100-READ-MPRF. DTSCS79 02273 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS79 02274 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS79 02275 SET MPRF-PRF-88 TO TRUE. DTSCS79 02276 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS79 02277 PERFORM S810-READ THRU S810-EXIT. DTSCS79 02278 IF L810-OK-88 DTSCS79 02279 MOVE MSKL-REC TO MPRF-REC DTSCS79 02280 SET WRK-MPRF-YES-88 TO TRUE DTSCS79 02281 ELSE DTSCS79 02282 SET WRK-MPRF-NO-88 TO TRUE. DTSCS79 02283 S8100-EXIT. EXIT. DTSCS79 02284 SKIP3 DTSCS79 02285 S8210-READ-MBAA. DTSCS79 02286 MOVE LOW-VALUES TO MBAA-KEY-AREA. DTSCS79 02287 MOVE WRK-EMP-NO TO MBAA-EMP-NO. DTSCS79 02288 SET MBAA-BAA-88 TO TRUE. DTSCS79 02289 MOVE WRK-ID-NO TO MBAA-ID-NO. DTSCS79 02290 MOVE MBAA-KEY-AREA TO MSKL-KEY-AREA. DTSCS79 02291 PERFORM S810-READ THRU S810-EXIT. DTSCS79 02292 IF L810-OK-88 DTSCS79 02293 MOVE MSKL-REC TO MBAA-REC DTSCS79 02294 SET WRK-MBAA-YES-88 TO TRUE DTSCS79 02295 ELSE DTSCS79 02296 SET WRK-MBAA-NO-88 TO TRUE. DTSCS79 02297 S8210-EXIT. EXIT. DTSCS79 02298 SKIP1 DTSCS79 02299 S8220-MBAA-COUNT. DTSCS79 02300 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSCS79 02301 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS79 02302 SET MSKL-BAA-88 TO TRUE. DTSCS79 02303 PERFORM S810-COUNT THRU S810-EXIT. DTSCS79 02304 S8220-EXIT. EXIT. DTSCS79 02305 /*****************************************************************DTSCS79 02306 * MAP ROUTINES *DTSCS79 02307 ******************************************************************DTSCS79 02308 S9100-RECEIVE. DTSCS79 02309 SKIP1 DTSCS79 02310 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS79 02311 SKIP1 DTSCS79 02312 SET L851-RECEIVE-88 TO TRUE. DTSCS79 02313 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS79 02314 SKIP1 DTSCS79 02315 MOVE L851-AID TO LCCM-AID. DTSCS79 02316 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS79 02317 S9100-EXIT. EXIT. DTSCS79 02318 SKIP3 DTSCS79 02319 ******************************************************************DTSCS79 02320 * *DTSCS79 02321 ******************************************************************DTSCS79 02322 S9200-SEND-DATAONLY. DTSCS79 02323 MOVE LOW-VALUES TO MAP-AREA. DTSCS79 02324 SKIP1 DTSCS79 02325 IF LCCM-MSG DTSCS79 02326 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS79 02327 SKIP1 DTSCS79 02328 IF CURSOR-SET-GOTO DTSCS79 02329 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS79 02330 ELSE DTSCS79 02331 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS79 02332 SKIP1 DTSCS79 02333 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS79 02334 SKIP1 DTSCS79 02335 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS79 02336 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS79 02337 S9200-EXIT. EXIT. DTSCS79 02338 SKIP3 DTSCS79 02339 ******************************************************************DTSCS79 02340 * *DTSCS79 02341 ******************************************************************DTSCS79 02342 S9300-SEND-MAP. DTSCS79 02343 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS79 02344 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS79 02345 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS79 02346 SKIP1 DTSCS79 02347 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS79 02348 IF SCR-ACCESS-UPDATE DTSCS79 02349 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT. DTSCS79 02350 SKIP1 DTSCS79 02351 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS79 02352 SKIP1 DTSCS79 02353 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS79 02354 SKIP1 DTSCS79 02355 IF CURSOR-SET-NO DTSCS79 02356 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS79 02357 SKIP1 DTSCS79 02358 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS79 02359 SKIP1 DTSCS79 02360 SET L851-SEND-88 TO TRUE. DTSCS79 02361 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS79 02362 S9300-EXIT. EXIT. DTSCS79 02363 SKIP3 DTSCS79 02364 S9310-UPDATE-FKEYS. DTSCS79 02365 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS79 02366 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS79 02367 MOVE CFKD-DEL TO MAP-KEY-DEL. CL*10 02368 SKIP1 DTSCS79 02369 IF LCCM-SCR-CLEAR DTSCS79 02370 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS79 02371 MAP-KEY-DEL DTSCS79 02372 ELSE DTSCS79 02373 IF LCCM-SCR-INQUIRE DTSCS79 02374 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS79 02375 ELSE DTSCS79 02376 IF LCCM-SCR-UPDATE-LOCKED DTSCS79 02377 MOVE LOW-VALUES TO MAP-KEY-ADD CL**4 02378 MAP-KEY-MOD DTSCS79 02379 MAP-KEY-DEL. CL**4 02380 S9310-EXIT. EXIT. DTSCS79 02381 SKIP3 DTSCS79 02382 S9320-INQUIRY-FKEYS. DTSCS79 02383 SKIP1 DTSCS79 02384 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS79 02385 MAP-KEY-MOD DTSCS79 02386 MAP-KEY-DEL. CL**4 02387 SKIP1 DTSCS79 02388 S9320-EXIT. EXIT. DTSCS79 02389 SKIP3 DTSCS79 02390 S9330-DSCR-FIELDS. DTSCS79 02391 IF WRK-MPRF-YES-88 DTSCS79 02392 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME CL*21 02393 ELSE DTSCS79 02394 MOVE LOW-VALUE TO MAP-PRIMARY-NAME. CL*21 02395 S9330-EXIT. EXIT. DTSCS79 02396 SKIP3 DTSCS79 02397 S9900-PREPARE-SEND. DTSCS79 02398 MOVE WRK-SCR-ID TO LCCM-SCR-ID DTSCS79 02399 L851-SCR-ID. DTSCS79 02400 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS79 02401 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS79 02402 S9900-EXIT. EXIT. DTSCS79