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