00001 IDENTIFICATION DIVISION. 07/18/00 00002 PROGRAM-ID. DTSCS84. DTSCS84 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV015 00004 DATE-WRITTEN. SEPTEMBER 1998. DTSCS84 00005 DATE-COMPILED. DTSCS84 00006 SKIP3 DTSCS84 00007 ***** DTSCS84 00008 * DTSCS84 00009 * FUNCTION: FIELD REPRESENTATIVE INQUIRY/UPDATE DTSCS84 00010 * SCREEN PROCESSOR. DTSCS84 00011 * DTSCS84 00012 * DTSCS84 00013 * MODIFICATION LOG: DTSCS84 00014 * DTSCS84 00015 * 09/08/1998 INITIAL DEVELOPMENT. MODIFIED FROM MACCS84. DTSCS84 00016 * WORK ORDER: PROGRAMMER: GD DTSCS84 00017 * DTSCS84 00018 * 05/31/2000 MODIFICATION: FAX NUMBER IS REQUIRED WHEN ADDING DTSCS84 00019 * FIELD REPS. DTSCS84 00020 * WORK ORDER: E003 PROGRAMMER: ZL1 DTSCS84 00021 * DTSCS84 00022 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS84 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS84 00024 * WORK ORDER: PROGRAMMER: XXX DTSCS84 00025 * DTSCS84 00026 * DTSCS84 00027 * DESCRIPTION: DTSCS84 00028 * DTSCS84 00029 * CLEAR: DTSCS84 00030 * DTSCS84 00031 * DATA FIELDS DISPLAYED: NONE. DTSCS84 00032 * MESSAGE: NONE (OTHER THAN "DELETE SUCCESSFUL"). DTSCS84 00033 * MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS84 00034 * DTSCS84 00035 * DTSCS84 00036 * INQUIRY: DTSCS84 00037 * DTSCS84 00038 * CONTROL FIELD(S): FLD-REP-ID DTSCS84 00039 * DTSCS84 00040 * JUMP IN: USE CLEAR LOGIC. DTSCS84 00041 * DTSCS84 00042 * ENTER: DISPLAY FFID RECORD ASSOCIATED WITH THE CONTROL DTSCS84 00043 * FIELDS. DTSCS84 00044 * DTSCS84 00045 * PRIOR: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS84 00046 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS84 00047 * EMP-NO). DTSCS84 00048 * DTSCS84 00049 * NEXT: STANDARD PAGING LOGIC, EXCEPT BASED ON USER DTSCS84 00050 * MODIFICATION TO CONTROL FIELDS (RATHER THAN DTSCS84 00051 * EMP-NO). DTSCS84 00052 * DTSCS84 00053 * WHILE PAGING, CONSIDER THE BREAK TO BE A BREAK IN REC-TYPE.DTSCS84 00054 * DO NOT "WRAP" PAGING. DTSCS84 00055 * DTSCS84 00056 * A SUCCESSFUL DISPLAY RESULTS IN STORAGE OF THE DTSCS84 00057 * FFID-KEY-AREA OF THE DISPLAYED FFID RECORD IN DTSCS84 00058 * LCCM-SCR-KEY-AREA. DTSCS84 00059 * DTSCS84 00060 * DTSCS84 00061 * UPDATE: DTSCS84 00062 * DTSCS84 00063 * ADD DTSCS84 00064 * MOD DTSCS84 00065 * DEL DTSCS84 00066 * DTSCS84 00067 * DTSCS84 00068 * RECORDS READ: DTSCS84 00069 * DTSCS84 00070 * MASTER: DTSCS84 00071 * DTSCS84 00072 * NONE. DTSCS84 00073 * DTSCS84 00074 * DTSCS84 00075 * ALTERNATE INDEX: DTSCS84 00076 * DTSCS84 00077 * NONE. DTSCS84 00078 * DTSCS84 00079 * DTSCS84 00080 * REFERENCE: DTSCS84 00081 * DTSCS84 00082 * FFID. DTSCS84 00083 * DTSCS84 00084 * DTSCS84 00085 * ACCOUNTING TRANSACTION COLLECTION: DTSCS84 00086 * DTSCS84 00087 * NONE. DTSCS84 00088 * DTSCS84 00089 * DTSCS84 00090 * RECORDS UPDATED: DTSCS84 00091 * DTSCS84 00092 * MASTER: DTSCS84 00093 * DTSCS84 00094 * NONE. DTSCS84 00095 * DTSCS84 00096 * DTSCS84 00097 * REFERENCE: DTSCS84 00098 * DTSCS84 00099 * FFID (ADD, MOD, DEL). DTSCS84 00100 * DTSCS84 00101 * DTSCS84 00102 * ACCOUNTING TRANSACTION COLLECTION: DTSCS84 00103 * DTSCS84 00104 * NONE. DTSCS84 00105 * DTSCS84 00106 * DTSCS84 00107 * ON-LINE EVENT FILE RECORDS WRITTEN: DTSCS84 00108 * DTSCS84 00109 * NONE. DTSCS84 00110 * DTSCS84 00111 * DTSCS84 00112 * MODULES (OTHER THAN STANDARD SCREEN PROCESSING DTSCS84 00113 * UTILITY MODULES) LINKED TO: DTSCS84 00114 * DTSCS84 00115 * DTSCU001 DATE EDIT/CONVERSION. DTSCS84 00116 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. DTSCS84 00117 * DTSCU071 NAME EDIT/CONVERSION. DTSCS84 00118 * DTSCU072 ADDRESS EDIT. DTSCS84 00119 * DTSCU073 TELEPHONE NUMBER EDIT. DTSCS84 00120 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS84 00121 * DTSCU831 REFERENCE FILE I/O. DTSCS84 00122 * DTSCS84 00123 * DTSCS84 00124 * MAINTENANCE NOTES: DTSCS84 00125 * DTSCS84 00126 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS84 00127 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS84 00128 * ALTER PARAGRAPHS P6900, P8900, S5900, DTSCS84 00129 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS84 00130 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS84), DTSCS84 00131 * ALTER THE MAP (DTSM84) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS84 00132 * DTSCS84 00133 ***** DTSCS84 00134 SKIP3 DTSCS84 00135 ENVIRONMENT DIVISION. DTSCS84 00136 EJECT DTSCS84 00137 DATA DIVISION. DTSCS84 00138 WORKING-STORAGE SECTION. DTSCS84 001385 77 PAN-VALET PICTURE X(24) VALUE '015DTSCS84 07/18/00'. DTSCS84 00139 SKIP3 DTSCS84 00140 01 WRK-AREA. DTSCS84 00141 05 WRK-ABEND-CD PIC X(04) VALUE 'S84 '. DTSCS84 00142 SKIP1 DTSCS84 00143 05 WRK-SCR-ID. DTSCS84 00144 10 WRK-SCR-ID-9 PIC 9(02) VALUE 84. DTSCS84 00145 05 WRK-F03-SCR-ID PIC X(02) VALUE '80'. DTSCS84 00146 DTSCS84 00147 05 WRK-LIT-U PIC X(01) VALUE 'U'. DTSCS84 00148 DTSCS84 00149 05 WRK-LIT-L PIC X(01) VALUE 'L'. DTSCS84 00150 SKIP3 DTSCS84 00151 05 WRK-KEY-AREA. DTSCS84 00152 10 WRK-REC-TYPE PIC S9(04) COMP. DTSCS84 00153 10 WRK-FLD-REP-ID PIC X(02). DTSCS84 00154 10 FILLER PIC X(12). DTSCS84 00155 SKIP1 DTSCS84 00156 05 WRK-MSG-AREA PIC X(64). DTSCS84 00157 SKIP1 DTSCS84 00158 05 WRK-HOLD-REP-ID PIC X(02). DTSCS84 00159 SKIP1 DTSCS84 00160 05 PHONE PIC S9(04) COMP. DTSCS84 00161 88 PHONE-VOICE1 VALUE +1. DTSCS84 00162 88 PHONE-VOICE2 VALUE +2. DTSCS84 00163 88 PHONE-FAX VALUE +3. DTSCS84 00164 05 SUB-VOICE1 PIC S9(04) COMP VALUE +1. DTSCS84 00165 05 SUB-VOICE2 PIC S9(04) COMP VALUE +2. DTSCS84 00166 05 SUB-FAX PIC S9(04) COMP VALUE +3. DTSCS84 00167 SKIP1 DTSCS84 00168 05 ADDR PIC S9(04) COMP. DTSCS84 00169 88 ADDR-MAILING VALUE +1. DTSCS84 00170 88 ADDR-PHYSICAL VALUE +2. DTSCS84 00171 05 SUB-MAILING PIC S9(04) COMP VALUE +1. DTSCS84 00172 05 SUB-PHYSICAL PIC S9(04) COMP VALUE +2. DTSCS84 00173 SKIP1 DTSCS84 00174 05 WRK-FFID-ADDR. DTSCS84 00175 10 WRK-ATTN PIC X(40). DTSCS84 00176 10 WRK-DLV1 PIC X(40). DTSCS84 00177 10 WRK-DLV2 PIC X(40). DTSCS84 00178 10 WRK-CITY PIC X(25). DTSCS84 00179 10 WRK-STATE PIC X(02). DTSCS84 00180 10 WRK-ZIP PIC X(10). DTSCS84 00181 10 WRK-BARCODE PIC X(14). DTSCS84 00182 SKIP1 DTSCS84 00183 05 HOLD-MAIL-ADDR-A. DTSCS84 00184 10 HOLD-MAIL-ATTN-A PIC X(01). DTSCS84 00185 10 HOLD-MAIL-DLV1-A PIC X(01). DTSCS84 00186 10 HOLD-MAIL-DLV2-A PIC X(01). DTSCS84 00187 10 HOLD-MAIL-CITY-A PIC X(01). DTSCS84 00188 10 HOLD-MAIL-STATE-A PIC X(01). DTSCS84 00189 10 HOLD-MAIL-ZIP-A PIC X(01). DTSCS84 00190 05 HOLD-PHYS-ADDR-A. DTSCS84 00191 10 HOLD-PHYS-ATTN-A PIC X(01). DTSCS84 00192 10 HOLD-PHYS-DLV1-A PIC X(01). DTSCS84 00193 10 HOLD-PHYS-DLV2-A PIC X(01). DTSCS84 00194 10 HOLD-PHYS-CITY-A PIC X(01). DTSCS84 00195 10 HOLD-PHYS-STATE-A PIC X(01). DTSCS84 00196 10 HOLD-PHYS-ZIP-A PIC X(01). DTSCS84 00197 EJECT DTSCS84 00198 01 MSG-LITERALS. DTSCS84 00199 05 MSG-E841-AREA. DTSCS84 00200 10 FILLER PIC X(04) VALUE 'E841'. DTSCS84 00201 10 FILLER PIC X(60) VALUE DTSCS84 00202 'FIELD REP ID ??, FD, AND AD MAY NOT BE DELETED'. DTSCS84 00203 DTSCS84 00204 05 MSG-E842-AREA. DTSCS84 00205 10 FILLER PIC X(04) VALUE 'E842'. DTSCS84 00206 10 FILLER PIC X(60) VALUE DTSCS84 00207 'FIELD REP ID ASSIGNED A TERRITORY DELETE NOT VALID'. DTSCS84 00208 EJECT DTSCS84 00209 01 SCREEN-CONTROL. DTSCS84 00210 05 SCR-ACCESS-IND PIC X(01). DTSCS84 00211 88 SCR-ACCESS-INQ VALUE '1'. DTSCS84 00212 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS84 00213 SKIP1 DTSCS84 00214 05 CURSOR-SET-IND PIC X(01). DTSCS84 00215 88 CURSOR-SET-YES VALUE 'Y'. DTSCS84 00216 88 CURSOR-SET-NO VALUE 'N'. DTSCS84 00217 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS84 00218 SKIP1 DTSCS84 00219 05 REQ-IND PIC X(01). DTSCS84 00220 88 REQ-ERROR VALUE 'O'. DTSCS84 00221 88 REQ-JUMP VALUE 'J'. DTSCS84 00222 88 REQ-INQUIRE VALUE 'I'. DTSCS84 00223 88 REQ-CLEAR VALUE 'C'. DTSCS84 00224 88 REQ-EDIT VALUE 'E'. DTSCS84 00225 88 REQ-UPDATE VALUE 'U'. DTSCS84 00226 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS84 00227 SKIP1 DTSCS84 00228 05 RESP-IND PIC X(01). DTSCS84 00229 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS84 00230 88 RESP-SEND-MAP VALUE 'M'. DTSCS84 00231 88 RESP-JUMP VALUE 'J'. DTSCS84 00232 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS84 00233 SKIP1 DTSCS84 00234 05 SCR-NEW-KEY-IND PIC X(01). DTSCS84 00235 SKIP1 DTSCS84 00236 05 SCR-ATB-AN PIC X(01). DTSCS84 00237 05 SCR-ATB-NUM PIC X(01). DTSCS84 00238 EJECT DTSCS84 00239 01 L001-COMM-AREA. DTSCS84 00240 ++INCLUDE DTSIL001 DTSCS84 00241 EJECT DTSCS84 00242 01 L009-COMM-AREA. DTSCS84 00243 ++INCLUDE DTSIL009 DTSCS84 00244 EJECT DTSCS84 00245 01 L021-COMM-AREA. DTSCS84 00246 ++INCLUDE DTSIL021 DTSCS84 00247 EJECT DTSCS84 00248 01 L071-COMM-AREA. DTSCS84 00249 ++INCLUDE DTSIL071 DTSCS84 00250 EJECT DTSCS84 00251 01 L072-COMM-AREA. DTSCS84 00252 ++INCLUDE DTSIL072 DTSCS84 00253 EJECT DTSCS84 00254 01 L073-COMM-AREA. DTSCS84 00255 ++INCLUDE DTSIL073 DTSCS84 00256 EJECT DTSCS84 00257 01 L082-COMM-AREA. DTSCS84 00258 ++INCLUDE DTSIL082 DTSCS84 00259 EJECT DTSCS84 00260 * ERROR MSG MODULE DTSCS84 00261 01 L805-COMM-AREA. DTSCS84 00262 ++INCLUDE DTSIL805 DTSCS84 00263 EJECT DTSCS84 00264 * REFERENCE FILE I-O LINKAGE DTSCS84 00265 01 L831-COMM-AREA. DTSCS84 00266 05 L831-CONTROL-BLOCK. DTSCS84 00267 ++INCLUDE DTSIL831 DTSCS84 00268 SKIP3 DTSCS84 00269 * COMMON SKELETAL RECORD DTSCS84 00270 05 FSKL-REC. DTSCS84 00271 ++INCLUDE DTSIFSKL DTSCS84 00272 EJECT DTSCS84 00273 * FIELD REP ID RECORD LAYOUT DTSCS84 00274 01 FFID-REC. DTSCS84 00275 ++INCLUDE DTSIFFID DTSCS84 00276 EJECT DTSCS84 00277 * FIELD REP TERRITORY RECORD LAYOUT DTSCS84 00278 01 FFAZ-REC. DTSCS84 00279 ++INCLUDE DTSIFFAZ DTSCS84 00280 EJECT DTSCS84 00281 * MAP DEFINITION DTSCS84 00282 01 L851-COMM-AREA. DTSCS84 00283 ++INCLUDE DTSIL851 DTSCS84 00284 SKIP3 DTSCS84 00285 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS84 00286 ++INCLUDE DTSIS84 DTSCS84 00287 EJECT DTSCS84 00288 * ATTRIBUTE LITERALS DTSCS84 00289 01 CATB-LITERALS. DTSCS84 00290 ++INCLUDE DTSICATB DTSCS84 00291 SKIP3 DTSCS84 00292 * FUNCTION KEY DESCRIPTION LITERALS DTSCS84 00293 01 CFKD-LITERALS. DTSCS84 00294 ++INCLUDE DTSICFKD DTSCS84 00295 SKIP3 DTSCS84 00296 * ERROR CODE MESSAGE LITERALS DTSCS84 00297 01 CECD-LITERALS. DTSCS84 00298 ++INCLUDE DTSICECD DTSCS84 00299 SKIP3 DTSCS84 00300 * PROMPT CODE MESSAGE LITERALS DTSCS84 00301 01 CPCD-LITERALS. DTSCS84 00302 ++INCLUDE DTSICPCD DTSCS84 00303 EJECT DTSCS84 00304 LINKAGE SECTION. DTSCS84 00305 SKIP3 DTSCS84 00306 01 DFHCOMMAREA. DTSCS84 00307 ++INCLUDE DTSILCCM DTSCS84 00308 SKIP3 DTSCS84 00309 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS84 00310 20 LCCM-SCR-KEY-AREA PIC X(16). DTSCS84 00311 20 LCCM-HOLD-ADDR PIC X(171) OCCURS 2. DTSCS84 00312 EJECT DTSCS84 00313 ******************************************************************DTSCS84 00314 * *DTSCS84 00315 ******************************************************************DTSCS84 00316 SKIP1 DTSCS84 00317 PROCEDURE DIVISION. DTSCS84 00318 SKIP2 DTSCS84 00319 SET CURSOR-SET-NO TO TRUE. DTSCS84 00320 SKIP1 DTSCS84 00321 MOVE LOW-VALUES TO MAP-AREA. DTSCS84 00322 SKIP1 DTSCS84 00323 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS84 00324 TO SCR-ACCESS-IND. DTSCS84 00325 SKIP3 DTSCS84 00326 MOVE SPACE TO REQ-IND. DTSCS84 00327 SKIP1 DTSCS84 00328 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS84 00329 SKIP1 DTSCS84 00330 *----------------------------------------------------- DTSCS84 00331 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS84 00332 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS84 00333 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS84 00334 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS84 00335 * DTSCS84 00336 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS84 00337 * PROCESSED. DTSCS84 00338 * DTSCS84 00339 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS84 00340 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS84 00341 * WORK STATION OPERATOR. DTSCS84 00342 *----------------------------------------------------- DTSCS84 00343 SKIP1 DTSCS84 00344 MOVE SPACE TO RESP-IND. DTSCS84 00345 SKIP1 DTSCS84 00346 IF REQ-ERROR DTSCS84 00347 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS84 00348 ELSE DTSCS84 00349 IF REQ-JUMP DTSCS84 00350 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS84 00351 ELSE DTSCS84 00352 IF REQ-CLEAR DTSCS84 00353 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS84 00354 ELSE DTSCS84 00355 IF REQ-CURSOR-TO-GOTO DTSCS84 00356 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS84 00357 ELSE DTSCS84 00358 IF REQ-INQUIRE DTSCS84 00359 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS84 00360 ELSE DTSCS84 00361 IF REQ-EDIT DTSCS84 00362 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS84 00363 ELSE DTSCS84 00364 IF REQ-UPDATE DTSCS84 00365 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS84 00366 ELSE DTSCS84 00367 GO TO S899-ABEND. DTSCS84 00368 SKIP3 DTSCS84 00369 *----------------------------------------------------- DTSCS84 00370 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS84 00371 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS84 00372 *----------------------------------------------------- DTSCS84 00373 SKIP1 DTSCS84 00374 IF RESP-SEND-MAP DTSCS84 00375 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS84 00376 SET LCCM-END-TASK-88 TO TRUE DTSCS84 00377 ELSE DTSCS84 00378 IF RESP-SEND-MSGONLY DTSCS84 00379 OR RESP-CURSOR-TO-GOTO DTSCS84 00380 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS84 00381 SET LCCM-END-TASK-88 TO TRUE DTSCS84 00382 ELSE DTSCS84 00383 IF RESP-JUMP DTSCS84 00384 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS84 00385 ELSE DTSCS84 00386 GO TO S899-ABEND. DTSCS84 00387 SKIP3 DTSCS84 00388 MAINLINE-EXIT. DTSCS84 00389 SKIP1 DTSCS84 00390 EXEC CICS DTSCS84 00391 RETURN DTSCS84 00392 END-EXEC. DTSCS84 00393 SKIP2 DTSCS84 00394 * GOBACK. DTSCS84 00395 /*****************************************************************DTSCS84 00396 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS84 00397 ******************************************************************DTSCS84 00398 P1000-ANALYZE-REQUEST. DTSCS84 00399 SKIP1 DTSCS84 00400 *----------------------------------------------------- DTSCS84 00401 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS84 00402 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS84 00403 * REPLACED WITH ENTER) DTSCS84 00404 * DTSCS84 00405 * FFID-NAME AND FFID-CASUAL NAME MUST BE STORED IN DTSCS84 00406 * MIXED MODE. THUS, AT ENTRY TO THIS SCREEN, UPPER DTSCS84 00407 * CASE TRANSLATION IS TURNED OFF AND REMAINS OFF DTSCS84 00408 * UNTIL THIS SCREEN IS EXITED. DTSCS84 00409 *----------------------------------------------------- DTSCS84 00410 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS84 00411 SET LCCM-ENTER-88 TO TRUE DTSCS84 00412 SET REQ-CLEAR TO TRUE DTSCS84 00413 PERFORM SUCTRAN-OFF THRU SUCTRAN-EXIT DTSCS84 00414 GO TO P1000-EXIT. DTSCS84 00415 SKIP3 DTSCS84 00416 *----------------------------------------------------- DTSCS84 00417 * MAP IS RECEIVED DTSCS84 00418 *----------------------------------------------------- DTSCS84 00419 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS84 00420 SKIP3 DTSCS84 00421 *----------------------------------------------------- DTSCS84 00422 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS84 00423 * WORK STATION DTSCS84 00424 *----------------------------------------------------- DTSCS84 00425 IF LCCM-CLEAR-88 DTSCS84 00426 SET REQ-CLEAR TO TRUE DTSCS84 00427 GO TO P1000-EXIT. DTSCS84 00428 SKIP3 DTSCS84 00429 *----------------------------------------------------- DTSCS84 00430 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS84 00431 *----------------------------------------------------- DTSCS84 00432 IF LCCM-SCR-UPDATE-LOCKED DTSCS84 00433 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS84 00434 GO TO P1000-EXIT. DTSCS84 00435 SKIP3 DTSCS84 00436 *----------------------------------------------------- DTSCS84 00437 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS84 00438 *----------------------------------------------------- DTSCS84 00439 IF LCCM-PA2-88 DTSCS84 00440 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS84 00441 GO TO P1000-EXIT. DTSCS84 00442 SKIP3 DTSCS84 00443 *----------------------------------------------------- DTSCS84 00444 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS84 00445 *----------------------------------------------------- DTSCS84 00446 IF LCCM-PA-88 DTSCS84 00447 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS84 00448 SET REQ-ERROR TO TRUE DTSCS84 00449 GO TO P1000-EXIT. DTSCS84 00450 SKIP3 DTSCS84 00451 *----------------------------------------------------- DTSCS84 00452 * F12 PRESSED WHEN UPDATE NOT ACTIVE IS A REQUEST DTSCS84 00453 * TO CLEAR THE SCREEN DTSCS84 00454 *----------------------------------------------------- DTSCS84 00455 IF LCCM-F12-88 DTSCS84 00456 MOVE LOW-VALUES TO MAP-AREA DTSCS84 00457 SET REQ-CLEAR TO TRUE DTSCS84 00458 GO TO P1000-EXIT. DTSCS84 00459 SKIP3 DTSCS84 00460 *----------------------------------------------------- DTSCS84 00461 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS84 00462 *----------------------------------------------------- DTSCS84 00463 IF LCCM-F03-88 DTSCS84 00464 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS84 00465 SET REQ-JUMP TO TRUE DTSCS84 00466 GO TO P1000-EXIT. DTSCS84 00467 SKIP3 DTSCS84 00468 *----------------------------------------------------- DTSCS84 00469 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS84 00470 *----------------------------------------------------- DTSCS84 00471 IF LCCM-F04-88 DTSCS84 00472 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS84 00473 SET REQ-JUMP TO TRUE DTSCS84 00474 GO TO P1000-EXIT. DTSCS84 00475 SKIP3 DTSCS84 00476 *----------------------------------------------------- DTSCS84 00477 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS84 00478 * CORRESPONDENCE SCREEN DTSCS84 00479 *----------------------------------------------------- DTSCS84 00480 IF LCCM-F14-88 DTSCS84 00481 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS84 00482 SET REQ-JUMP TO TRUE DTSCS84 00483 GO TO P1000-EXIT. DTSCS84 00484 SKIP3 DTSCS84 00485 *----------------------------------------------------- DTSCS84 00486 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS84 00487 * REQUESTED SCREEN TYPE DTSCS84 00488 *----------------------------------------------------- DTSCS84 00489 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS84 00490 NEXT SENTENCE DTSCS84 00491 ELSE DTSCS84 00492 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS84 00493 SET REQ-JUMP TO TRUE DTSCS84 00494 GO TO P1000-EXIT. DTSCS84 00495 SKIP3 DTSCS84 00496 *----------------------------------------------------- DTSCS84 00497 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS84 00498 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS84 00499 *----------------------------------------------------- DTSCS84 00500 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS84 00501 IF SCR-ACCESS-UPDATE DTSCS84 00502 SET REQ-EDIT TO TRUE DTSCS84 00503 GO TO P1000-EXIT DTSCS84 00504 ELSE DTSCS84 00505 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS84 00506 SET REQ-ERROR TO TRUE DTSCS84 00507 GO TO P1000-EXIT. DTSCS84 00508 SKIP3 DTSCS84 00509 *----------------------------------------------------- DTSCS84 00510 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS84 00511 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS84 00512 *----------------------------------------------------- DTSCS84 00513 IF LCCM-ENTER-88 OR LCCM-F07-88 OR LCCM-F08-88 DTSCS84 00514 SET REQ-INQUIRE TO TRUE DTSCS84 00515 GO TO P1000-EXIT. DTSCS84 00516 SKIP3 DTSCS84 00517 *----------------------------------------------------- DTSCS84 00518 * ANY OTHER KEY IS INVALID DTSCS84 00519 *----------------------------------------------------- DTSCS84 00520 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS84 00521 SET REQ-ERROR TO TRUE. DTSCS84 00522 P1000-EXIT. DTSCS84 00523 EXIT. DTSCS84 00524 SKIP3 DTSCS84 00525 ******************************************************************DTSCS84 00526 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS84 00527 ******************************************************************DTSCS84 00528 SKIP1 DTSCS84 00529 P1100-UPDATE-LOCKED. DTSCS84 00530 *----------------------------------------------------- DTSCS84 00531 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS84 00532 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS84 00533 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS84 00534 *----------------------------------------------------- DTSCS84 00535 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS84 00536 SET REQ-UPDATE TO TRUE DTSCS84 00537 ELSE DTSCS84 00538 SET REQ-ERROR TO TRUE DTSCS84 00539 IF LCCM-SCR-ADD-LOCKED DTSCS84 00540 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS84 00541 ELSE DTSCS84 00542 IF LCCM-SCR-MOD-LOCKED DTSCS84 00543 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS84 00544 ELSE DTSCS84 00545 IF LCCM-SCR-DEL-LOCKED DTSCS84 00546 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA DTSCS84 00547 ELSE DTSCS84 00548 GO TO S899-ABEND. DTSCS84 00549 P1100-EXIT. DTSCS84 00550 EXIT. DTSCS84 00551 /*****************************************************************DTSCS84 00552 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS84 00553 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS84 00554 ******************************************************************DTSCS84 00555 SKIP1 DTSCS84 00556 P2000-REQUEST-ERROR. DTSCS84 00557 IF LCCM-MSG DTSCS84 00558 SET RESP-SEND-MSGONLY TO TRUE DTSCS84 00559 ELSE DTSCS84 00560 GO TO S899-ABEND. DTSCS84 00561 P2000-EXIT. DTSCS84 00562 EXIT. DTSCS84 00563 /*****************************************************************DTSCS84 00564 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS84 00565 ******************************************************************DTSCS84 00566 SKIP1 DTSCS84 00567 P3000-REQUEST-JUMP. DTSCS84 00568 *----------------------------------------------------- DTSCS84 00569 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS84 00570 * BY USER DTSCS84 00571 *----------------------------------------------------- DTSCS84 00572 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS84 00573 SKIP3 DTSCS84 00574 *----------------------------------------------------- DTSCS84 00575 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS84 00576 *----------------------------------------------------- DTSCS84 00577 IF LCCM-MSG DTSCS84 00578 SET RESP-SEND-MSGONLY TO TRUE DTSCS84 00579 SET CURSOR-SET-GOTO TO TRUE DTSCS84 00580 GO TO P3000-EXIT. DTSCS84 00581 SKIP3 DTSCS84 00582 *----------------------------------------------------- DTSCS84 00583 * TURN UPPER CASE TRANSLATION BACK ON DTSCS84 00584 *----------------------------------------------------- DTSCS84 00585 PERFORM SUCTRAN-ON THRU SUCTRAN-EXIT. DTSCS84 00586 SKIP3 DTSCS84 00587 *----------------------------------------------------- DTSCS84 00588 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS84 00589 *----------------------------------------------------- DTSCS84 00590 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS84 00591 LCCM-SCR-HOLD-AREA. DTSCS84 00592 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS84 00593 SET RESP-JUMP TO TRUE. DTSCS84 00594 P3000-EXIT. DTSCS84 00595 EXIT. DTSCS84 00596 /*****************************************************************DTSCS84 00597 * CLEAR KEY WAS PRESSED *DTSCS84 00598 ******************************************************************DTSCS84 00599 SKIP1 DTSCS84 00600 P4000-REQUEST-CLEAR. DTSCS84 00601 IF SCR-ACCESS-UPDATE DTSCS84 00602 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS84 00603 ELSE DTSCS84 00604 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS84 00605 SKIP3 DTSCS84 00606 *----------------------------------------------------- DTSCS84 00607 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS84 00608 * FIELDS FROM EARLIER REQUESTS DTSCS84 00609 *----------------------------------------------------- DTSCS84 00610 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS84 00611 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS84 00612 SET LCCM-SCR-CLEAR TO TRUE. DTSCS84 00613 SET RESP-SEND-MAP TO TRUE. DTSCS84 00614 P4000-EXIT. DTSCS84 00615 EXIT. DTSCS84 00616 /*****************************************************************DTSCS84 00617 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS84 00618 ******************************************************************DTSCS84 00619 SKIP1 DTSCS84 00620 P5000-CURSOR-TO-GOTO. DTSCS84 00621 SET CURSOR-SET-GOTO TO TRUE. DTSCS84 00622 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS84 00623 P5000-EXIT. DTSCS84 00624 EXIT. DTSCS84 00625 /*****************************************************************DTSCS84 00626 * INQUIRY WAS REQUESTED *DTSCS84 00627 ******************************************************************DTSCS84 00628 SKIP1 DTSCS84 00629 P6000-REQUEST-INQUIRE. DTSCS84 00630 MOVE LOW-VALUES TO FFID-KEY-AREA. DTSCS84 00631 SET FFID-FID-88 TO TRUE. DTSCS84 00632 SKIP1 DTSCS84 00633 MOVE MAP-REP-ID TO WRK-HOLD-REP-ID. DTSCS84 00634 MOVE LOW-VALUES TO MAP-AREA. DTSCS84 00635 MOVE WRK-HOLD-REP-ID TO MAP-REP-ID. DTSCS84 00636 SKIP1 DTSCS84 00637 INSPECT MAP-REP-ID CONVERTING LOW-VALUE TO SPACE. DTSCS84 00638 MOVE MAP-REP-ID TO FFID-FLD-REP-ID. DTSCS84 00639 SKIP1 DTSCS84 00640 IF LCCM-SCR-INQUIRE DTSCS84 00641 AND FFID-KEY-AREA = LCCM-SCR-KEY-AREA DTSCS84 00642 MOVE 'N' TO SCR-NEW-KEY-IND DTSCS84 00643 ELSE DTSCS84 00644 MOVE 'Y' TO SCR-NEW-KEY-IND. DTSCS84 00645 SKIP1 DTSCS84 00646 IF SCR-ACCESS-UPDATE DTSCS84 00647 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS84 00648 ELSE DTSCS84 00649 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS84 00650 SKIP1 DTSCS84 00651 SET LCCM-SCR-CLEAR TO TRUE. DTSCS84 00652 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS84 00653 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS84 00654 SKIP1 DTSCS84 00655 IF LCCM-MSG DTSCS84 00656 NEXT SENTENCE DTSCS84 00657 ELSE DTSCS84 00658 IF LCCM-ENTER-88 DTSCS84 00659 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS84 00660 ELSE DTSCS84 00661 IF LCCM-F07-88 DTSCS84 00662 PERFORM P6200-PAGE-BACK THRU P6200-EXIT DTSCS84 00663 ELSE DTSCS84 00664 IF LCCM-F08-88 DTSCS84 00665 PERFORM P6300-PAGE-NEXT THRU P6300-EXIT DTSCS84 00666 ELSE DTSCS84 00667 GO TO S899-ABEND. DTSCS84 00668 SKIP1 DTSCS84 00669 SET RESP-SEND-MAP TO TRUE. DTSCS84 00670 P6000-EXIT. DTSCS84 00671 EXIT. DTSCS84 00672 EJECT DTSCS84 00673 P6100-NO-PAGE. DTSCS84 00674 IF MAP-REP-ID = SPACE DTSCS84 00675 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 00676 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00677 GO TO P6100-EXIT. DTSCS84 00678 SKIP1 DTSCS84 00679 MOVE FFID-KEY-AREA TO FSKL-KEY-AREA. DTSCS84 00680 PERFORM S831-READ THRU S831-EXIT. DTSCS84 00681 IF L831-NO-REC-88 DTSCS84 00682 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 00683 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00684 GO TO P6100-EXIT. DTSCS84 00685 SKIP1 DTSCS84 00686 MOVE FSKL-REC TO FFID-REC. DTSCS84 00687 SKIP1 DTSCS84 00688 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS84 00689 P6100-EXIT. DTSCS84 00690 EXIT. DTSCS84 00691 EJECT DTSCS84 00692 P6200-PAGE-BACK. DTSCS84 00693 MOVE FFID-KEY-AREA TO FSKL-KEY-AREA. DTSCS84 00694 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS84 00695 IF L831-NO-REC-88 DTSCS84 00696 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 00697 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00698 GO TO P6200-EXIT. DTSCS84 00699 SKIP1 DTSCS84 00700 IF (SCR-NEW-KEY-IND = 'Y') DTSCS84 00701 AND DTSCS84 00702 (FSKL-KEY-AREA = FFID-KEY-AREA) DTSCS84 00703 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS84 00704 MOVE FSKL-REC TO FFID-REC DTSCS84 00705 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS84 00706 GO TO P6200-EXIT. DTSCS84 00707 SKIP1 DTSCS84 00708 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS84 00709 IF L831-NO-REC-88 DTSCS84 00710 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 00711 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00712 GO TO P6200-EXIT. DTSCS84 00713 SKIP1 DTSCS84 00714 PERFORM S831-READ-PREV THRU S831-EXIT. DTSCS84 00715 IF L831-NO-REC-88 DTSCS84 00716 MOVE FSKL-REC TO FFID-REC DTSCS84 00717 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS84 00718 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS84 00719 ELSE DTSCS84 00720 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS84 00721 MOVE FSKL-REC TO FFID-REC DTSCS84 00722 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS84 00723 P6200-EXIT. DTSCS84 00724 EXIT. DTSCS84 00725 EJECT DTSCS84 00726 P6300-PAGE-NEXT. DTSCS84 00727 MOVE FFID-KEY-AREA TO FSKL-KEY-AREA. DTSCS84 00728 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS84 00729 IF L831-NO-REC-88 DTSCS84 00730 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 00731 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00732 GO TO P6300-EXIT. DTSCS84 00733 SKIP1 DTSCS84 00734 IF (SCR-NEW-KEY-IND = 'N') DTSCS84 00735 AND DTSCS84 00736 (FSKL-KEY-AREA = FFID-KEY-AREA) DTSCS84 00737 NEXT SENTENCE DTSCS84 00738 ELSE DTSCS84 00739 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS84 00740 MOVE FSKL-REC TO FFID-REC DTSCS84 00741 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS84 00742 GO TO P6300-EXIT. DTSCS84 00743 SKIP1 DTSCS84 00744 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS84 00745 IF L831-NO-REC-88 DTSCS84 00746 MOVE FSKL-REC TO FFID-REC DTSCS84 00747 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS84 00748 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA DTSCS84 00749 ELSE DTSCS84 00750 PERFORM S831-END-BROWSE THRU S831-EXIT DTSCS84 00751 MOVE FSKL-REC TO FFID-REC DTSCS84 00752 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS84 00753 P6300-EXIT. DTSCS84 00754 EXIT. DTSCS84 00755 /*****************************************************************DTSCS84 00756 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS84 00757 ******************************************************************DTSCS84 00758 SKIP1 DTSCS84 00759 P6900-CONSTRUCT-SCREEN. DTSCS84 00760 MOVE FFID-FLD-REP-ID TO MAP-REP-ID. DTSCS84 00761 MOVE FFID-OP-ID TO MAP-REP-OP-ID. DTSCS84 00762 MOVE FFID-ACCOUNTING-TECH-CD DTSCS84 00763 TO MAP-ACCT-TECH. DTSCS84 00764 MOVE FFID-NAME TO MAP-REP-NAME. DTSCS84 00765 MOVE FFID-CASUAL-NAME TO MAP-CASUAL. DTSCS84 00766 MOVE FFID-MAIL-ATTN-LINE TO MAP-ATTN (SUB-MAILING). DTSCS84 00767 MOVE FFID-MAIL-DELIV-LINE-1 DTSCS84 00768 TO MAP-DLV1 (SUB-MAILING). DTSCS84 00769 MOVE FFID-MAIL-DELIV-LINE-2 DTSCS84 00770 TO MAP-DLV2 (SUB-MAILING). DTSCS84 00771 MOVE FFID-MAIL-CITY TO MAP-CITY (SUB-MAILING). DTSCS84 00772 MOVE FFID-MAIL-ST TO MAP-STATE (SUB-MAILING). DTSCS84 00773 MOVE FFID-MAIL-ZIP TO MAP-ZIP (SUB-MAILING). DTSCS84 00774 MOVE FFID-PHYS-ATTN-LINE TO MAP-ATTN (SUB-PHYSICAL). DTSCS84 00775 MOVE FFID-PHYS-DELIV-LINE-1 DTSCS84 00776 TO MAP-DLV1 (SUB-PHYSICAL). DTSCS84 00777 MOVE FFID-PHYS-DELIV-LINE-2 DTSCS84 00778 TO MAP-DLV2 (SUB-PHYSICAL). DTSCS84 00779 MOVE FFID-PHYS-CITY TO MAP-CITY (SUB-PHYSICAL). DTSCS84 00780 MOVE FFID-PHYS-ST TO MAP-STATE (SUB-PHYSICAL). DTSCS84 00781 MOVE FFID-PHYS-ZIP TO MAP-ZIP (SUB-PHYSICAL). DTSCS84 00782 MOVE FFID-VOICE-1-AREA-CD TO MAP-PHONE-AREA-CD (SUB-VOICE1).DTSCS84 00783 MOVE FFID-VOICE-1-PREFIX TO MAP-PHONE-PREFIX (SUB-VOICE1).DTSCS84 00784 MOVE FFID-VOICE-1-SUFFIX TO MAP-PHONE-SUFFIX (SUB-VOICE1).DTSCS84 00785 MOVE FFID-VOICE-1-EXT TO MAP-PHONE-EXT (SUB-VOICE1).DTSCS84 00786 MOVE FFID-VOICE-2-AREA-CD TO MAP-PHONE-AREA-CD (SUB-VOICE2).DTSCS84 00787 MOVE FFID-VOICE-2-PREFIX TO MAP-PHONE-PREFIX (SUB-VOICE2).DTSCS84 00788 MOVE FFID-VOICE-2-SUFFIX TO MAP-PHONE-SUFFIX (SUB-VOICE2).DTSCS84 00789 MOVE FFID-VOICE-2-EXT TO MAP-PHONE-EXT (SUB-VOICE2).DTSCS84 00790 MOVE FFID-FAX-AREA-CD TO MAP-PHONE-AREA-CD (SUB-FAX). DTSCS84 00791 MOVE FFID-FAX-PREFIX TO MAP-PHONE-PREFIX (SUB-FAX). DTSCS84 00792 MOVE FFID-FAX-SUFFIX TO MAP-PHONE-SUFFIX (SUB-FAX). DTSCS84 00793 MOVE FFID-FAX-EXT TO MAP-PHONE-EXT (SUB-FAX). DTSCS84 00794 MOVE FFID-EMAIL-ADDRESS TO MAP-EMAIL. DTSCS84 00795 MOVE LOW-VALUE TO MAP-CASS-IND (SUB-MAILING) DTSCS84 00796 MAP-CASS-CD (SUB-MAILING) DTSCS84 00797 MAP-CASS-IND (SUB-PHYSICAL) DTSCS84 00798 MAP-CASS-CD (SUB-PHYSICAL). DTSCS84 00799 SKIP1 DTSCS84 00800 IF FFID-ESTB-DATE NOT = +0 DTSCS84 00801 MOVE FFID-ESTB-DATE TO L001-FED-8-DATE-9 DTSCS84 00802 SET L001-FROM-FED-8 TO TRUE DTSCS84 00803 PERFORM S001-DATE THRU S001-EXIT DTSCS84 00804 MOVE L001-SLASH-DATE TO MAP-ESTB-DATE. DTSCS84 00805 SKIP1 DTSCS84 00806 IF FFID-CHNG-DATE NOT = +0 DTSCS84 00807 MOVE FFID-CHNG-DATE TO L001-FED-8-DATE-9 DTSCS84 00808 SET L001-FROM-FED-8 TO TRUE DTSCS84 00809 PERFORM S001-DATE THRU S001-EXIT DTSCS84 00810 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS84 00811 SKIP1 DTSCS84 00812 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS84 00813 MOVE FFID-KEY-AREA TO LCCM-SCR-KEY-AREA. DTSCS84 00814 P6900-EXIT. DTSCS84 00815 EXIT. DTSCS84 00816 /*****************************************************************DTSCS84 00817 * FUNCTION KEY WAS PRESSED TO ADD, MOD OR DEL THE RECORD. *DTSCS84 00818 ******************************************************************DTSCS84 00819 SKIP1 DTSCS84 00820 P7000-REQUEST-EDIT. DTSCS84 00821 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS84 00822 SKIP1 DTSCS84 00823 IF LCCM-F09-88 DTSCS84 00824 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS84 00825 ELSE DTSCS84 00826 IF LCCM-F10-88 DTSCS84 00827 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS84 00828 ELSE DTSCS84 00829 IF LCCM-F23-88 DTSCS84 00830 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS84 00831 ELSE DTSCS84 00832 GO TO S899-ABEND. DTSCS84 00833 SKIP3 DTSCS84 00834 *------------------------------------------------------ DTSCS84 00835 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS84 00836 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS84 00837 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS84 00838 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS84 00839 *------------------------------------------------------ DTSCS84 00840 SKIP1 DTSCS84 00841 IF LCCM-MSG DTSCS84 00842 NEXT SENTENCE DTSCS84 00843 ELSE DTSCS84 00844 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS84 00845 IF LCCM-F09-88 DTSCS84 00846 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS84 00847 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-AREA DTSCS84 00848 ELSE DTSCS84 00849 IF LCCM-F10-88 DTSCS84 00850 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS84 00851 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS84 00852 ELSE DTSCS84 00853 IF LCCM-F23-88 DTSCS84 00854 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS84 00855 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-AREA. DTSCS84 00856 SKIP1 DTSCS84 00857 SET RESP-SEND-MAP TO TRUE. DTSCS84 00858 P7000-EXIT. DTSCS84 00859 EXIT. DTSCS84 00860 /*****************************************************************DTSCS84 00861 * ADD FUNCTION WAS REQUESTED *DTSCS84 00862 ******************************************************************DTSCS84 00863 SKIP1 DTSCS84 00864 P7100-EDIT-ADD. DTSCS84 00865 *------------------------------------------------------ DTSCS84 00866 * ADD REQUIRES THAT THE SCREEN WAS IN THE CLEAR STATE DTSCS84 00867 *------------------------------------------------------ DTSCS84 00868 IF NOT LCCM-SCR-CLEAR DTSCS84 00869 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-AREA DTSCS84 00870 GO TO P7100-EXIT. DTSCS84 00871 SKIP1 DTSCS84 00872 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS84 00873 SKIP1 DTSCS84 00874 IF LCCM-NO-MSG DTSCS84 00875 PERFORM S8010-READ-FFID THRU S8010-EXIT DTSCS84 00876 IF L831-OK-88 DTSCS84 00877 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS84 00878 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00879 ELSE DTSCS84 00880 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS84 00881 P7100-EXIT. DTSCS84 00882 EXIT. DTSCS84 00883 /*****************************************************************DTSCS84 00884 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS84 00885 ******************************************************************DTSCS84 00886 SKIP1 DTSCS84 00887 P7200-EDIT-MOD. DTSCS84 00888 *----------------------------------------------------- DTSCS84 00889 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS84 00890 * INQUIRED DTSCS84 00891 *----------------------------------------------------- DTSCS84 00892 IF NOT LCCM-SCR-INQUIRE DTSCS84 00893 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS84 00894 GO TO P7200-EXIT. DTSCS84 00895 SKIP3 DTSCS84 00896 *----------------------------------------------------- DTSCS84 00897 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING THE MOD DTSCS84 00898 *----------------------------------------------------- DTSCS84 00899 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS84 00900 IF MAP-REP-ID NOT = WRK-FLD-REP-ID DTSCS84 00901 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS84 00902 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00903 GO TO P7200-EXIT. DTSCS84 00904 SKIP1 DTSCS84 00905 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS84 00906 SKIP1 DTSCS84 00907 IF LCCM-NO-MSG DTSCS84 00908 PERFORM S8010-READ-FFID THRU S8010-EXIT DTSCS84 00909 IF L831-NO-REC-88 DTSCS84 00910 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 00911 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00912 ELSE DTSCS84 00913 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS84 00914 P7200-EXIT. DTSCS84 00915 EXIT. DTSCS84 00916 /*****************************************************************DTSCS84 00917 * DELETE FUNCTION WAS REQUESTED *DTSCS84 00918 ******************************************************************DTSCS84 00919 SKIP1 DTSCS84 00920 P7300-EDIT-DEL. DTSCS84 00921 *----------------------------------------------------- DTSCS84 00922 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS84 00923 * INQUIRED DTSCS84 00924 *----------------------------------------------------- DTSCS84 00925 IF NOT LCCM-SCR-INQUIRE DTSCS84 00926 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-AREA DTSCS84 00927 GO TO P7300-EXIT. DTSCS84 00928 SKIP3 DTSCS84 00929 *----------------------------------------------------- DTSCS84 00930 * CONTROL FIELD(S) MAY NOT BE CHANGED DURING A DELETE DTSCS84 00931 *----------------------------------------------------- DTSCS84 00932 MOVE LCCM-SCR-KEY-AREA TO WRK-KEY-AREA. DTSCS84 00933 IF MAP-REP-ID NOT = WRK-FLD-REP-ID DTSCS84 00934 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS84 00935 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00936 GO TO P7300-EXIT. DTSCS84 00937 SKIP1 DTSCS84 00938 PERFORM P7310-DELETE-EDITS THRU P7310-EXIT. DTSCS84 00939 SKIP1 DTSCS84 00940 IF LCCM-MSG DTSCS84 00941 GO TO P7300-EXIT. DTSCS84 00942 SKIP1 DTSCS84 00943 IF LCCM-NO-MSG DTSCS84 00944 PERFORM S8010-READ-FFID THRU S8010-EXIT DTSCS84 00945 IF L831-NO-REC-88 DTSCS84 00946 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 00947 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS84 00948 P7300-EXIT. DTSCS84 00949 EXIT. DTSCS84 00950 SKIP3 DTSCS84 00951 P7310-DELETE-EDITS. DTSCS84 00952 MOVE MAP-REP-ID TO FFID-FLD-REP-ID. DTSCS84 00953 IF FFID-FIELD-DESK-88 OR FFID-ACCOUNTING-DESK-88 DTSCS84 00954 MOVE MSG-E841-AREA TO WRK-MSG-AREA DTSCS84 00955 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 00956 GO TO P7310-EXIT. DTSCS84 00957 DTSCS84 00958 MOVE LOW-VALUES TO FFAZ-KEY-AREA. DTSCS84 00959 SET FFAZ-FAZ-88 TO TRUE. DTSCS84 00960 MOVE FFAZ-KEY-AREA TO FSKL-KEY-AREA. DTSCS84 00961 PERFORM S831-START-BROWSE THRU S831-EXIT. DTSCS84 00962 PERFORM P7311-SCAN-FFAZ THRU P7311-EXIT DTSCS84 00963 UNTIL L831-NO-REC-88. DTSCS84 00964 P7310-EXIT. DTSCS84 00965 EXIT. DTSCS84 00966 SKIP3 DTSCS84 00967 P7311-SCAN-FFAZ. DTSCS84 00968 MOVE FSKL-REC TO FFAZ-REC. DTSCS84 00969 DTSCS84 00970 IF FFAZ-SINGLE-REP DTSCS84 00971 PERFORM P7311A-SINGLE-REP THRU P7311A-EXIT DTSCS84 00972 ELSE DTSCS84 00973 PERFORM P7311B-MULTIPLE-REP THRU P7311B-EXIT. DTSCS84 00974 DTSCS84 00975 PERFORM S831-READ-NEXT THRU S831-EXIT. DTSCS84 00976 P7311-EXIT. DTSCS84 00977 EXIT. DTSCS84 00978 SKIP3 DTSCS84 00979 P7311A-SINGLE-REP. DTSCS84 00980 IF FFAZ-FLD-REP-ID (1) = MAP-REP-ID DTSCS84 00981 MOVE MSG-E842-AREA TO WRK-MSG-AREA DTSCS84 00982 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS84 00983 P7311A-EXIT. DTSCS84 00984 EXIT. DTSCS84 00985 SKIP3 DTSCS84 00986 P7311B-MULTIPLE-REP. DTSCS84 00987 IF (FFAZ-FLD-REP-ID (1) = MAP-REP-ID) DTSCS84 00988 OR (FFAZ-FLD-REP-ID (2) = MAP-REP-ID) DTSCS84 00989 OR (FFAZ-FLD-REP-ID (3) = MAP-REP-ID) DTSCS84 00990 OR (FFAZ-FLD-REP-ID (4) = MAP-REP-ID) DTSCS84 00991 OR (FFAZ-FLD-REP-ID (5) = MAP-REP-ID) DTSCS84 00992 OR (FFAZ-FLD-REP-ID (6) = MAP-REP-ID) DTSCS84 00993 OR (FFAZ-FLD-REP-ID (7) = MAP-REP-ID) DTSCS84 00994 OR (FFAZ-FLD-REP-ID (8) = MAP-REP-ID) DTSCS84 00995 OR (FFAZ-FLD-REP-ID (9) = MAP-REP-ID) DTSCS84 00996 OR (FFAZ-FLD-REP-ID (10) = MAP-REP-ID) DTSCS84 00997 MOVE MSG-E842-AREA TO WRK-MSG-AREA DTSCS84 00998 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS84 00999 P7311B-EXIT. DTSCS84 01000 EXIT. DTSCS84 01001 /*****************************************************************DTSCS84 01002 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS84 01003 ******************************************************************DTSCS84 01004 SKIP1 DTSCS84 01005 P8000-REQUEST-UPDATE. DTSCS84 01006 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS84 01007 SKIP1 DTSCS84 01008 IF LCCM-SCR-ADD-LOCKED DTSCS84 01009 PERFORM P8100-ADD THRU P8100-EXIT DTSCS84 01010 ELSE DTSCS84 01011 IF LCCM-SCR-MOD-LOCKED DTSCS84 01012 PERFORM P8200-MOD THRU P8200-EXIT DTSCS84 01013 ELSE DTSCS84 01014 IF LCCM-SCR-DEL-LOCKED DTSCS84 01015 PERFORM P8300-DEL THRU P8300-EXIT DTSCS84 01016 ELSE DTSCS84 01017 GO TO S899-ABEND. DTSCS84 01018 SKIP1 DTSCS84 01019 SET RESP-SEND-MAP TO TRUE. DTSCS84 01020 P8000-EXIT. DTSCS84 01021 EXIT. DTSCS84 01022 /*****************************************************************DTSCS84 01023 * *DTSCS84 01024 ******************************************************************DTSCS84 01025 SKIP1 DTSCS84 01026 P8100-ADD. DTSCS84 01027 SET LCCM-SCR-CLEAR TO TRUE. DTSCS84 01028 SKIP1 DTSCS84 01029 IF LCCM-F12-88 DTSCS84 01030 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-AREA DTSCS84 01031 GO TO P8100-EXIT. DTSCS84 01032 SKIP1 DTSCS84 01033 PERFORM S8010-READ-FFID THRU S8010-EXIT. DTSCS84 01034 IF L831-OK-88 DTSCS84 01035 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS84 01036 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 01037 GO TO P8100-EXIT. DTSCS84 01038 SKIP1 DTSCS84 01039 MOVE LOW-VALUES TO FFID-DATA-AREA. DTSCS84 01040 SKIP1 DTSCS84 01041 PERFORM P8900-CONSTRUCT-FFID THRU P8900-EXIT. DTSCS84 01042 SKIP1 DTSCS84 01043 MOVE LCCM-CURR-RUN-DATE TO FFID-ESTB-DATE. DTSCS84 01044 MOVE LCCM-CURR-RUN-DATE TO FFID-CHNG-DATE. DTSCS84 01045 SKIP1 DTSCS84 01046 MOVE FFID-REC TO FSKL-REC. DTSCS84 01047 SKIP1 DTSCS84 01048 PERFORM S831-WRITE THRU S831-EXIT. DTSCS84 01049 SKIP1 DTSCS84 01050 MOVE LOW-VALUES TO MAP-AREA. DTSCS84 01051 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS84 01052 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS84 01053 P8100-EXIT. DTSCS84 01054 EXIT. DTSCS84 01055 /*****************************************************************DTSCS84 01056 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS84 01057 ******************************************************************DTSCS84 01058 SKIP1 DTSCS84 01059 P8200-MOD. DTSCS84 01060 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS84 01061 SKIP1 DTSCS84 01062 IF LCCM-F12-88 DTSCS84 01063 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS84 01064 GO TO P8200-EXIT. DTSCS84 01065 SKIP1 DTSCS84 01066 PERFORM S8010-READ-FFID THRU S8010-EXIT. DTSCS84 01067 IF L831-NO-REC-88 DTSCS84 01068 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 01069 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 01070 GO TO P8200-EXIT. DTSCS84 01071 SKIP1 DTSCS84 01072 PERFORM P8900-CONSTRUCT-FFID THRU P8900-EXIT. DTSCS84 01073 SKIP1 DTSCS84 01074 MOVE LCCM-CURR-RUN-DATE TO FFID-CHNG-DATE. DTSCS84 01075 SKIP1 DTSCS84 01076 MOVE FFID-REC TO FSKL-REC. DTSCS84 01077 SKIP1 DTSCS84 01078 PERFORM S831-REWRITE THRU S831-EXIT. DTSCS84 01079 SKIP1 DTSCS84 01080 MOVE FFID-CHNG-DATE TO L001-FED-8-DATE-9. DTSCS84 01081 SET L001-FROM-FED-8 TO TRUE. DTSCS84 01082 PERFORM S001-DATE THRU S001-EXIT. DTSCS84 01083 MOVE L001-SLASH-DATE TO MAP-CHNG-DATE. DTSCS84 01084 SKIP1 DTSCS84 01085 MOVE LOW-VALUE TO MAP-CASS-IND (1) DTSCS84 01086 MAP-CASS-CD (1) DTSCS84 01087 MAP-CASS-IND (2) DTSCS84 01088 MAP-CASS-CD (2). DTSCS84 01089 SKIP1 DTSCS84 01090 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS84 01091 P8200-EXIT. DTSCS84 01092 EXIT. DTSCS84 01093 /*****************************************************************DTSCS84 01094 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS84 01095 ******************************************************************DTSCS84 01096 SKIP1 DTSCS84 01097 P8300-DEL. DTSCS84 01098 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS84 01099 SKIP1 DTSCS84 01100 IF LCCM-F12-88 DTSCS84 01101 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-AREA DTSCS84 01102 GO TO P8300-EXIT. DTSCS84 01103 SKIP1 DTSCS84 01104 PERFORM S8010-READ-FFID THRU S8010-EXIT. DTSCS84 01105 IF NOT L831-OK-88 DTSCS84 01106 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS84 01107 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS84 01108 GO TO P8300-EXIT. DTSCS84 01109 SKIP1 DTSCS84 01110 MOVE FFID-KEY-AREA TO FSKL-KEY-AREA. DTSCS84 01111 SKIP1 DTSCS84 01112 PERFORM S831-DELETE THRU S831-EXIT. DTSCS84 01113 SKIP1 DTSCS84 01114 MOVE LOW-VALUES TO LCCM-SCR-KEY-AREA. DTSCS84 01115 SET LCCM-SCR-CLEAR TO TRUE. DTSCS84 01116 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS84 01117 SKIP1 DTSCS84 01118 MOVE LOW-VALUES TO MAP-AREA. DTSCS84 01119 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS84 01120 SKIP1 DTSCS84 01121 MOVE FFID-FLD-REP-ID TO MAP-REP-ID. DTSCS84 01122 SKIP1 DTSCS84 01123 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS84 01124 P8300-EXIT. DTSCS84 01125 EXIT. DTSCS84 01126 EJECT DTSCS84 01127 P8900-CONSTRUCT-FFID. DTSCS84 01128 SKIP1 DTSCS84 01129 MOVE MAP-REP-OP-ID TO FFID-OP-ID. DTSCS84 01130 MOVE MAP-ACCT-TECH TO FFID-ACCOUNTING-TECH-CD. DTSCS84 01131 MOVE MAP-REP-NAME TO FFID-NAME. DTSCS84 01132 MOVE MAP-CASUAL TO FFID-CASUAL-NAME. DTSCS84 01133 MOVE LCCM-HOLD-ADDR (SUB-MAILING) TO FFID-MAIL-ADDR. DTSCS84 01134 MOVE LCCM-HOLD-ADDR (SUB-PHYSICAL) TO FFID-PHYSICAL-ADDR. DTSCS84 01135 SKIP1 DTSCS84 01136 MOVE MAP-PHONE-AREA (SUB-VOICE1) TO L021-S-TNO-AREA. DTSCS84 01137 PERFORM S021-SCREEN-PHONE THRU S021-EXIT. DTSCS84 01138 MOVE L021-TNO TO FFID-VOICE-1. DTSCS84 01139 SKIP1 DTSCS84 01140 MOVE MAP-PHONE-AREA (SUB-VOICE2) TO L021-S-TNO-AREA. DTSCS84 01141 PERFORM S021-SCREEN-PHONE THRU S021-EXIT. DTSCS84 01142 MOVE L021-TNO TO FFID-VOICE-2. DTSCS84 01143 SKIP1 DTSCS84 01144 MOVE MAP-PHONE-AREA (SUB-FAX) TO L021-S-TNO-AREA. DTSCS84 01145 PERFORM S021-SCREEN-PHONE THRU S021-EXIT. DTSCS84 01146 MOVE L021-TNO TO FFID-FAX. DTSCS84 01147 SKIP1 DTSCS84 01148 P8900-EXIT. DTSCS84 01149 EXIT. DTSCS84 01150 /*****************************************************************DTSCS84 01151 * LINKS TO UTILITY MODULES DTSCS84 01152 ******************************************************************DTSCS84 01153 SKIP1 DTSCS84 01154 S001-DATE. DTSCS84 01155 EXEC CICS LINK DTSCS84 01156 PROGRAM ('DTSCU001') DTSCS84 01157 COMMAREA (L001-COMM-AREA) DTSCS84 01158 END-EXEC. DTSCS84 01159 S001-EXIT. DTSCS84 01160 EXIT. DTSCS84 01161 SKIP3 DTSCS84 01162 S009-TO-UPPER-CASE. DTSCS84 01163 EXEC CICS LINK DTSCS84 01164 PROGRAM ('DTSCU009') DTSCS84 01165 COMMAREA (L009-COMM-AREA) DTSCS84 01166 END-EXEC. DTSCS84 01167 S009-EXIT. DTSCS84 01168 EXIT. DTSCS84 01169 SKIP3 DTSCS84 01170 S021-SCREEN-PHONE. DTSCS84 01171 EXEC CICS LINK DTSCS84 01172 PROGRAM ('DTSCU021') DTSCS84 01173 COMMAREA (L021-COMM-AREA) DTSCS84 01174 END-EXEC. DTSCS84 01175 S021-EXIT. DTSCS84 01176 EXIT. DTSCS84 01177 SKIP3 DTSCS84 01178 S071-EDIT-NAME. DTSCS84 01179 EXEC CICS LINK DTSCS84 01180 PROGRAM ('DTSCU071') DTSCS84 01181 COMMAREA (L071-COMM-AREA) DTSCS84 01182 END-EXEC. DTSCS84 01183 S071-EXIT. DTSCS84 01184 EXIT. DTSCS84 01185 SKIP3 DTSCS84 01186 S072-EDIT-ADDRESS. DTSCS84 01187 EXEC CICS LINK DTSCS84 01188 PROGRAM ('DTSCU072') DTSCS84 01189 COMMAREA (L072-COMM-AREA) DTSCS84 01190 END-EXEC. DTSCS84 01191 S072-EXIT. DTSCS84 01192 EXIT. DTSCS84 01193 SKIP3 DTSCS84 01194 S073-EDIT-PHONE. DTSCS84 01195 EXEC CICS LINK DTSCS84 01196 PROGRAM ('DTSCU073') DTSCS84 01197 COMMAREA (L073-COMM-AREA) DTSCS84 01198 END-EXEC. DTSCS84 01199 S073-EXIT. DTSCS84 01200 EXIT. DTSCS84 01201 SKIP3 DTSCS84 01202 S082-EDIT-OP-ID. DTSCS84 01203 EXEC CICS LINK DTSCS84 01204 PROGRAM ('DTSCU082') DTSCS84 01205 COMMAREA (L082-COMM-AREA) DTSCS84 01206 END-EXEC. DTSCS84 01207 SKIP1 DTSCS84 01208 IF L082-FILE-CLOSED DTSCS84 01209 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01210 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS84 01211 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS84 01212 GO TO MAINLINE-EXIT. DTSCS84 01213 S082-EXIT. DTSCS84 01214 EXIT. DTSCS84 01215 EJECT DTSCS84 01216 S803-REQ-SCR-ID-EDIT. DTSCS84 01217 EXEC CICS LINK DTSCS84 01218 PROGRAM ('DTSCU803') DTSCS84 01219 COMMAREA (DFHCOMMAREA) DTSCS84 01220 END-EXEC. DTSCS84 01221 S803-EXIT. DTSCS84 01222 EXIT. DTSCS84 01223 SKIP3 DTSCS84 01224 S804-INVALID-KEY. DTSCS84 01225 EXEC CICS LINK DTSCS84 01226 PROGRAM ('DTSCU804') DTSCS84 01227 COMMAREA (DFHCOMMAREA) DTSCS84 01228 END-EXEC. DTSCS84 01229 S804-EXIT. DTSCS84 01230 EXIT. DTSCS84 01231 SKIP3 DTSCS84 01232 S805-MSG-AREA. DTSCS84 01233 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS84 01234 SKIP1 DTSCS84 01235 EXEC CICS LINK DTSCS84 01236 PROGRAM ('DTSCU805') DTSCS84 01237 COMMAREA (L805-COMM-AREA) DTSCS84 01238 END-EXEC. DTSCS84 01239 SKIP1 DTSCS84 01240 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS84 01241 S805-EXIT. DTSCS84 01242 EXIT. DTSCS84 01243 EJECT DTSCS84 01244 S831-READ. DTSCS84 01245 SET L831-READ-88 TO TRUE. DTSCS84 01246 GO TO S831-IO. DTSCS84 01247 SKIP1 DTSCS84 01248 S831-START-BROWSE. DTSCS84 01249 SET L831-START-BROWSE-88 TO TRUE. DTSCS84 01250 GO TO S831-IO. DTSCS84 01251 SKIP1 DTSCS84 01252 S831-READ-NEXT. DTSCS84 01253 SET L831-READ-NEXT-88 TO TRUE. DTSCS84 01254 GO TO S831-IO. DTSCS84 01255 SKIP1 DTSCS84 01256 S831-READ-PREV. DTSCS84 01257 SET L831-READ-PREV-88 TO TRUE. DTSCS84 01258 GO TO S831-IO. DTSCS84 01259 SKIP1 DTSCS84 01260 S831-END-BROWSE. DTSCS84 01261 SET L831-END-BROWSE-88 TO TRUE. DTSCS84 01262 GO TO S831-IO. DTSCS84 01263 SKIP1 DTSCS84 01264 S831-REWRITE. DTSCS84 01265 SET L831-REWRITE-88 TO TRUE. DTSCS84 01266 GO TO S831-IO. DTSCS84 01267 SKIP1 DTSCS84 01268 S831-WRITE. DTSCS84 01269 SET L831-WRITE-88 TO TRUE. DTSCS84 01270 GO TO S831-IO. DTSCS84 01271 SKIP1 DTSCS84 01272 S831-DELETE. DTSCS84 01273 SET L831-DELETE-88 TO TRUE. DTSCS84 01274 GO TO S831-IO. DTSCS84 01275 SKIP1 DTSCS84 01276 S831-IO. DTSCS84 01277 SKIP1 DTSCS84 01278 EXEC CICS LINK DTSCS84 01279 PROGRAM ('DTSCU831') DTSCS84 01280 COMMAREA (L831-COMM-AREA) DTSCS84 01281 END-EXEC. DTSCS84 01282 SKIP1 DTSCS84 01283 IF L831-FILE-CLOSED-88 DTSCS84 01284 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01285 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS84 01286 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS84 01287 GO TO MAINLINE-EXIT. DTSCS84 01288 S831-EXIT. DTSCS84 01289 EXIT. DTSCS84 01290 SKIP3 DTSCS84 01291 S851-SCREEN-PROCESSING. DTSCS84 01292 EXEC CICS LINK DTSCS84 01293 PROGRAM ('DTSCU851') DTSCS84 01294 COMMAREA (L851-COMM-AREA) DTSCS84 01295 END-EXEC. DTSCS84 01296 S851-EXIT. DTSCS84 01297 EXIT. DTSCS84 01298 SKIP3 DTSCS84 01299 S899-ABEND. DTSCS84 01300 EXEC CICS ABEND DTSCS84 01301 ABCODE(WRK-ABEND-CD) DTSCS84 01302 END-EXEC. DTSCS84 01303 *S899-EXIT. DTSCS84 01304 * EXIT. DTSCS84 01305 SKIP3 DTSCS84 01306 SUCTRAN-OFF. DTSCS84 01307 EXEC CICS DTSCS84 01308 LINK DTSCS84 01309 PROGRAM ('UCTRAN41') DTSCS84 01310 COMMAREA (WRK-LIT-L) DTSCS84 01311 LENGTH (+1) DTSCS84 01312 END-EXEC. DTSCS84 01313 DTSCS84 01314 GO TO SUCTRAN-EXIT. DTSCS84 01315 DTSCS84 01316 SUCTRAN-ON. DTSCS84 01317 EXEC CICS DTSCS84 01318 LINK DTSCS84 01319 PROGRAM ('UCTRAN41') DTSCS84 01320 COMMAREA (WRK-LIT-U) DTSCS84 01321 LENGTH (+1) DTSCS84 01322 END-EXEC. DTSCS84 01323 DTSCS84 01324 GO TO SUCTRAN-EXIT. DTSCS84 01325 DTSCS84 01326 SUCTRAN-EXIT. DTSCS84 01327 EXIT. DTSCS84 01328 /*****************************************************************DTSCS84 01329 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS84 01330 ******************************************************************DTSCS84 01331 SKIP1 DTSCS84 01332 S1001-SCREEN-KEY-EDITS. DTSCS84 01333 SKIP1 DTSCS84 01334 PERFORM S1100-REP-ID THRU S1100-EXIT. DTSCS84 01335 SKIP1 DTSCS84 01336 S1001-EXIT. DTSCS84 01337 EXIT. DTSCS84 01338 SKIP3 DTSCS84 01339 S1002-SCREEN-DATA-EDITS. DTSCS84 01340 SKIP1 DTSCS84 01341 MOVE LOW-VALUE TO MAP-CASS-CD (1) DTSCS84 01342 MAP-CASS-CD (2). DTSCS84 01343 SKIP1 DTSCS84 01344 PERFORM S1200-OPERATOR THRU S1200-EXIT. DTSCS84 01345 PERFORM S1250-ACCT-TECH-CD THRU S1250-EXIT. DTSCS84 01346 PERFORM S1300-NAME THRU S1300-EXIT. DTSCS84 01347 PERFORM S1400-NICK-NAME THRU S1400-EXIT. DTSCS84 01348 SKIP1 DTSCS84 01349 SET ADDR-MAILING TO TRUE. DTSCS84 01350 IF LCCM-F09-88 DTSCS84 01351 MOVE LOW-VALUE TO WRK-FFID-ADDR DTSCS84 01352 ELSE DTSCS84 01353 MOVE FFID-MAIL-ADDR TO WRK-FFID-ADDR. DTSCS84 01354 PERFORM S1500-ADDRESS THRU S1500-EXIT. DTSCS84 01355 SKIP1 DTSCS84 01356 SET ADDR-PHYSICAL TO TRUE. DTSCS84 01357 IF LCCM-F09-88 DTSCS84 01358 MOVE LOW-VALUE TO WRK-FFID-ADDR DTSCS84 01359 ELSE DTSCS84 01360 MOVE FFID-PHYSICAL-ADDR TO WRK-FFID-ADDR. DTSCS84 01361 PERFORM S1500-ADDRESS THRU S1500-EXIT. DTSCS84 01362 SKIP1 DTSCS84 01363 IF MAP-STATE (SUB-PHYSICAL) = SPACE DTSCS84 01364 MOVE MAP-STATE (SUB-MAILING) TO L073-ST DTSCS84 01365 MOVE MAP-ZIP (SUB-MAILING) TO L073-ZIP DTSCS84 01366 ELSE DTSCS84 01367 MOVE MAP-STATE (SUB-PHYSICAL) TO L073-ST DTSCS84 01368 MOVE MAP-ZIP (SUB-PHYSICAL) TO L073-ZIP. DTSCS84 01369 SET PHONE-VOICE1 TO TRUE. DTSCS84 01370 PERFORM S1600-PHONE THRU S1600-EXIT. DTSCS84 01371 SKIP1 DTSCS84 01372 SET PHONE-VOICE2 TO TRUE. DTSCS84 01373 PERFORM S1600-PHONE THRU S1600-EXIT. DTSCS84 01374 SKIP1 DTSCS84 01375 SET PHONE-FAX TO TRUE. DTSCS84 01376 PERFORM S1600-PHONE THRU S1600-EXIT. DTSCS84 01377 SKIP1 DTSCS84 01378 S1002-EXIT. DTSCS84 01379 EXIT. DTSCS84 01380 EJECT DTSCS84 01381 S1100-REP-ID. DTSCS84 01382 INSPECT MAP-REP-ID CONVERTING LOW-VALUE TO SPACE. DTSCS84 01383 DTSCS84 01384 IF MAP-REP-ID = SPACE DTSCS84 01385 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 01386 PERFORM S1101-ERROR THRU S1101-EXIT. DTSCS84 01387 S1100-EXIT. DTSCS84 01388 EXIT. DTSCS84 01389 SKIP3 DTSCS84 01390 S1101-ERROR. DTSCS84 01391 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-ID-A. DTSCS84 01392 IF LCCM-NO-MSG DTSCS84 01393 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01394 MOVE CATB-CURSOR TO MAP-REP-ID-L DTSCS84 01395 SET CURSOR-SET-YES TO TRUE. DTSCS84 01396 S1101-EXIT. DTSCS84 01397 EXIT. DTSCS84 01398 EJECT DTSCS84 01399 S1200-OPERATOR. DTSCS84 01400 DTSCS84 01401 MOVE MAP-REP-OP-ID TO L009-DATA. DTSCS84 01402 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01403 MOVE L009-DATA TO MAP-REP-OP-ID. DTSCS84 01404 DTSCS84 01405 IF MAP-REP-OP-ID = SPACE OR LOW-VALUE DTSCS84 01406 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 01407 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS84 01408 ELSE DTSCS84 01409 MOVE MAP-REP-OP-ID TO L082-OP-ID DTSCS84 01410 PERFORM S082-EDIT-OP-ID THRU S082-EXIT. DTSCS84 01411 *& THE FOLLOWING LINES COMMENTED OUT FOR TESTING - GD 9/9/1998 DTSCS84 01412 *& IF L082-NOT-VALID-OP DTSCS84 01413 *& OR L082-INTERNAL-88 DTSCS84 01414 *& MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS84 01415 *& PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS84 01416 S1200-EXIT. DTSCS84 01417 EXIT. DTSCS84 01418 SKIP3 DTSCS84 01419 S1201-ERROR. DTSCS84 01420 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-OP-ID-A. DTSCS84 01421 IF LCCM-NO-MSG DTSCS84 01422 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01423 MOVE CATB-CURSOR TO MAP-REP-OP-ID-L DTSCS84 01424 SET CURSOR-SET-YES TO TRUE. DTSCS84 01425 S1201-EXIT. DTSCS84 01426 EXIT. DTSCS84 01427 EJECT DTSCS84 01428 S1250-ACCT-TECH-CD. DTSCS84 01429 DTSCS84 01430 MOVE MAP-ACCT-TECH TO L009-DATA. DTSCS84 01431 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01432 MOVE L009-DATA TO MAP-ACCT-TECH. DTSCS84 01433 DTSCS84 01434 IF MAP-ACCT-TECH = SPACE OR LOW-VALUE DTSCS84 01435 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 01436 PERFORM S1251-ERROR THRU S1251-EXIT DTSCS84 01437 GO TO S1250-EXIT. DTSCS84 01438 DTSCS84 01439 S1250-EXIT. DTSCS84 01440 EXIT. DTSCS84 01441 SKIP3 DTSCS84 01442 S1251-ERROR. DTSCS84 01443 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ACCT-TECH-A. DTSCS84 01444 IF LCCM-NO-MSG DTSCS84 01445 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01446 MOVE CATB-CURSOR TO MAP-ACCT-TECH-L DTSCS84 01447 SET CURSOR-SET-YES TO TRUE. DTSCS84 01448 S1251-EXIT. DTSCS84 01449 EXIT. DTSCS84 01450 EJECT DTSCS84 01451 S1300-NAME. DTSCS84 01452 IF MAP-REP-NAME = SPACE OR LOW-VALUE DTSCS84 01453 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 01454 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS84 01455 ELSE DTSCS84 01456 MOVE MAP-REP-NAME TO L071-NAM DTSCS84 01457 SET L071-FROM-LAST-NAME-FIRST TO TRUE DTSCS84 01458 PERFORM S071-EDIT-NAME THRU S071-EXIT DTSCS84 01459 IF L071-NAME-INVALID DTSCS84 01460 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS84 01461 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS84 01462 S1300-EXIT. DTSCS84 01463 EXIT. DTSCS84 01464 SKIP3 DTSCS84 01465 S1301-ERROR. DTSCS84 01466 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REP-NAME-A. DTSCS84 01467 IF LCCM-NO-MSG DTSCS84 01468 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01469 MOVE CATB-CURSOR TO MAP-REP-NAME-L DTSCS84 01470 SET CURSOR-SET-YES TO TRUE. DTSCS84 01471 S1301-EXIT. DTSCS84 01472 EXIT. DTSCS84 01473 EJECT DTSCS84 01474 S1400-NICK-NAME. DTSCS84 01475 INSPECT MAP-CASUAL CONVERTING LOW-VALUE TO SPACE. DTSCS84 01476 IF MAP-CASUAL = SPACE DTSCS84 01477 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 01478 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS84 01479 S1400-EXIT. DTSCS84 01480 EXIT. DTSCS84 01481 SKIP3 DTSCS84 01482 S1401-ERROR. DTSCS84 01483 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CASUAL-A. DTSCS84 01484 IF LCCM-NO-MSG DTSCS84 01485 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01486 MOVE CATB-CURSOR TO MAP-CASUAL-L DTSCS84 01487 SET CURSOR-SET-YES TO TRUE. DTSCS84 01488 S1401-EXIT. DTSCS84 01489 EXIT. DTSCS84 01490 EJECT DTSCS84 01491 S1500-ADDRESS. DTSCS84 01492 SKIP1 DTSCS84 01493 DTSCS84 01494 MOVE MAP-ATTN (ADDR) TO L009-DATA. DTSCS84 01495 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01496 MOVE L009-DATA TO MAP-ATTN (ADDR). DTSCS84 01497 DTSCS84 01498 MOVE MAP-DLV1 (ADDR) TO L009-DATA. DTSCS84 01499 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01500 MOVE L009-DATA TO MAP-DLV1 (ADDR). DTSCS84 01501 DTSCS84 01502 MOVE MAP-DLV2 (ADDR) TO L009-DATA. DTSCS84 01503 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01504 MOVE L009-DATA TO MAP-DLV2 (ADDR). DTSCS84 01505 DTSCS84 01506 MOVE MAP-CASS-IND (ADDR) TO L009-DATA. DTSCS84 01507 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01508 MOVE L009-DATA TO MAP-CASS-IND (ADDR). DTSCS84 01509 DTSCS84 01510 MOVE MAP-CITY (ADDR) TO L009-DATA. DTSCS84 01511 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01512 MOVE L009-DATA TO MAP-CITY (ADDR). DTSCS84 01513 DTSCS84 01514 MOVE MAP-STATE (ADDR) TO L009-DATA. DTSCS84 01515 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01516 MOVE L009-DATA TO MAP-STATE (ADDR). DTSCS84 01517 DTSCS84 01518 MOVE MAP-ZIP (ADDR) TO L009-DATA. DTSCS84 01519 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01520 MOVE L009-DATA TO MAP-ZIP (ADDR). DTSCS84 01521 DTSCS84 01522 IF MAP-ATTN (ADDR) = SPACES OR LOW-VALUES DTSCS84 01523 MOVE SPACES TO MAP-ATTN (ADDR). DTSCS84 01524 IF MAP-DLV1 (ADDR) = SPACES OR LOW-VALUES DTSCS84 01525 MOVE SPACES TO MAP-DLV1 (ADDR). DTSCS84 01526 IF MAP-DLV2 (ADDR) = SPACES OR LOW-VALUES DTSCS84 01527 MOVE SPACES TO MAP-DLV2 (ADDR). DTSCS84 01528 IF MAP-CASS-IND (ADDR) = SPACES OR LOW-VALUES DTSCS84 01529 MOVE SPACES TO MAP-CASS-IND (ADDR). DTSCS84 01530 IF MAP-CITY (ADDR) = SPACES OR LOW-VALUES DTSCS84 01531 MOVE SPACES TO MAP-CITY (ADDR). DTSCS84 01532 IF MAP-STATE (ADDR) = SPACES OR LOW-VALUES DTSCS84 01533 MOVE SPACES TO MAP-STATE (ADDR). DTSCS84 01534 IF MAP-ZIP (ADDR) = SPACES OR LOW-VALUES DTSCS84 01535 MOVE SPACES TO MAP-ZIP (ADDR). DTSCS84 01536 SKIP1 DTSCS84 01537 MOVE MAP-CASS-IND (ADDR) TO L072-CASS-IND. DTSCS84 01538 SET L072-FFID-88 TO TRUE. DTSCS84 01539 MOVE MAP-REP-NAME TO L072-NAME. DTSCS84 01540 MOVE SPACES TO L072-ADDRESS. DTSCS84 01541 MOVE MAP-ATTN (ADDR) TO L072-ATTN-LINE. DTSCS84 01542 MOVE MAP-DLV1 (ADDR) TO L072-DELIV-LINE-1. DTSCS84 01543 MOVE MAP-DLV2 (ADDR) TO L072-DELIV-LINE-2. DTSCS84 01544 MOVE MAP-CITY (ADDR) TO L072-CITY. DTSCS84 01545 MOVE MAP-STATE (ADDR) TO L072-ST. DTSCS84 01546 MOVE MAP-ZIP (ADDR) TO L072-ZIP. DTSCS84 01547 SKIP1 DTSCS84 01548 IF (L072-ATTN-LINE = WRK-ATTN) DTSCS84 01549 AND DTSCS84 01550 (L072-DELIV-LINE-1 = WRK-DLV1) DTSCS84 01551 AND DTSCS84 01552 (L072-DELIV-LINE-2 = WRK-DLV2) DTSCS84 01553 AND DTSCS84 01554 (L072-CITY = WRK-CITY) DTSCS84 01555 AND DTSCS84 01556 (L072-ST = WRK-STATE) DTSCS84 01557 AND DTSCS84 01558 (L072-ZIP = WRK-ZIP) DTSCS84 01559 MOVE WRK-BARCODE TO L072-ADVANCED-BARCODE DTSCS84 01560 MOVE L072-ADDRESS TO LCCM-HOLD-ADDR (ADDR) DTSCS84 01561 GO TO S1500-EXIT. DTSCS84 01562 SKIP1 DTSCS84 01563 PERFORM S072-EDIT-ADDRESS THRU S072-EXIT. DTSCS84 01564 SKIP1 DTSCS84 01565 MOVE L072-CASS-IND TO MAP-CASS-IND (ADDR). DTSCS84 01566 MOVE L072-CASS-RETURN-CODES TO MAP-CASS-CD (ADDR). DTSCS84 01567 SKIP1 DTSCS84 01568 MOVE L072-ADDRESS TO LCCM-HOLD-ADDR (ADDR). DTSCS84 01569 SKIP1 DTSCS84 01570 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS84 01571 PERFORM S1591-ERROR THRU S1591-EXIT DTSCS84 01572 ELSE DTSCS84 01573 MOVE L072-ATTN-LINE TO MAP-ATTN (ADDR) DTSCS84 01574 IF L072-ATTN-LINE-CHANGED-88 DTSCS84 01575 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A (ADDR). DTSCS84 01576 SKIP1 DTSCS84 01577 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS84 01578 PERFORM S1592-ERROR THRU S1592-EXIT DTSCS84 01579 ELSE DTSCS84 01580 MOVE L072-DELIV-LINE-1 TO MAP-DLV1 (ADDR) DTSCS84 01581 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS84 01582 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (ADDR). DTSCS84 01583 SKIP1 DTSCS84 01584 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS84 01585 PERFORM S1593-ERROR THRU S1593-EXIT DTSCS84 01586 ELSE DTSCS84 01587 MOVE L072-DELIV-LINE-2 TO MAP-DLV2 (ADDR) DTSCS84 01588 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS84 01589 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (ADDR). DTSCS84 01590 SKIP1 DTSCS84 01591 IF L072-CITY-NOT-VALID-88 DTSCS84 01592 PERFORM S1594-ERROR THRU S1594-EXIT DTSCS84 01593 ELSE DTSCS84 01594 MOVE L072-CITY TO MAP-CITY (ADDR) DTSCS84 01595 IF L072-CITY-CHANGED-88 DTSCS84 01596 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A (ADDR). DTSCS84 01597 SKIP1 DTSCS84 01598 IF L072-ST-NOT-VALID-88 DTSCS84 01599 PERFORM S1595-ERROR THRU S1595-EXIT DTSCS84 01600 ELSE DTSCS84 01601 MOVE L072-ST TO MAP-STATE (ADDR) DTSCS84 01602 IF L072-ST-CHANGED-88 DTSCS84 01603 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATE-A (ADDR).DTSCS84 01604 SKIP1 DTSCS84 01605 IF L072-ZIP-NOT-VALID-88 DTSCS84 01606 PERFORM S1596-ERROR THRU S1596-EXIT DTSCS84 01607 ELSE DTSCS84 01608 MOVE L072-ZIP TO MAP-ZIP (ADDR) DTSCS84 01609 IF L072-ZIP-CHANGED-88 DTSCS84 01610 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A (ADDR). DTSCS84 01611 SKIP1 DTSCS84 01612 IF L072-ADDRESS-NOT-VALID-88 DTSCS84 01613 IF LCCM-NO-MSG DTSCS84 01614 PERFORM S1591-ERROR THRU S1591-EXIT. DTSCS84 01615 S1500-EXIT. DTSCS84 01616 EXIT. DTSCS84 01617 SKIP3 DTSCS84 01618 S1591-ERROR. DTSCS84 01619 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A (ADDR). DTSCS84 01620 IF LCCM-NO-MSG DTSCS84 01621 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01622 MOVE CATB-CURSOR TO MAP-ATTN-L (ADDR) DTSCS84 01623 SET CURSOR-SET-YES TO TRUE. DTSCS84 01624 S1591-EXIT. DTSCS84 01625 EXIT. DTSCS84 01626 SKIP3 DTSCS84 01627 S1592-ERROR. DTSCS84 01628 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (ADDR). DTSCS84 01629 IF LCCM-NO-MSG DTSCS84 01630 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01631 MOVE CATB-CURSOR TO MAP-DLV1-L (ADDR) DTSCS84 01632 SET CURSOR-SET-YES TO TRUE. DTSCS84 01633 S1592-EXIT. DTSCS84 01634 EXIT. DTSCS84 01635 SKIP3 DTSCS84 01636 S1593-ERROR. DTSCS84 01637 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (ADDR). DTSCS84 01638 IF LCCM-NO-MSG DTSCS84 01639 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01640 MOVE CATB-CURSOR TO MAP-DLV2-L (ADDR) DTSCS84 01641 SET CURSOR-SET-YES TO TRUE. DTSCS84 01642 S1593-EXIT. DTSCS84 01643 EXIT. DTSCS84 01644 SKIP3 DTSCS84 01645 S1594-ERROR. DTSCS84 01646 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A (ADDR). DTSCS84 01647 IF LCCM-NO-MSG DTSCS84 01648 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01649 MOVE CATB-CURSOR TO MAP-CITY-L (ADDR) DTSCS84 01650 SET CURSOR-SET-YES TO TRUE. DTSCS84 01651 S1594-EXIT. DTSCS84 01652 EXIT. DTSCS84 01653 SKIP3 DTSCS84 01654 S1595-ERROR. DTSCS84 01655 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STATE-A (ADDR). DTSCS84 01656 IF LCCM-NO-MSG DTSCS84 01657 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01658 MOVE CATB-CURSOR TO MAP-STATE-L (ADDR) DTSCS84 01659 SET CURSOR-SET-YES TO TRUE. DTSCS84 01660 S1595-EXIT. DTSCS84 01661 EXIT. DTSCS84 01662 SKIP3 DTSCS84 01663 S1596-ERROR. DTSCS84 01664 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A (ADDR). DTSCS84 01665 IF LCCM-NO-MSG DTSCS84 01666 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01667 MOVE CATB-CURSOR TO MAP-ZIP-L (ADDR) DTSCS84 01668 SET CURSOR-SET-YES TO TRUE. DTSCS84 01669 S1596-EXIT. DTSCS84 01670 EXIT. DTSCS84 01671 EJECT DTSCS84 01672 S1600-PHONE. DTSCS84 01673 DTSCS84 01674 MOVE MAP-PHONE-AREA-CD (PHONE) TO L009-DATA. DTSCS84 01675 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01676 MOVE L009-DATA TO MAP-PHONE-AREA-CD (PHONE). DTSCS84 01677 DTSCS84 01678 MOVE MAP-PHONE-PREFIX (PHONE) TO L009-DATA. DTSCS84 01679 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01680 MOVE L009-DATA TO MAP-PHONE-PREFIX (PHONE). DTSCS84 01681 DTSCS84 01682 MOVE MAP-PHONE-SUFFIX (PHONE) TO L009-DATA. DTSCS84 01683 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01684 MOVE L009-DATA TO MAP-PHONE-SUFFIX (PHONE). DTSCS84 01685 DTSCS84 01686 MOVE MAP-PHONE-EXT (PHONE) TO L009-DATA. DTSCS84 01687 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01688 MOVE L009-DATA TO MAP-PHONE-EXT (PHONE). DTSCS84 01689 DTSCS84 01690 MOVE MAP-PHONE-AREA (PHONE) TO L021-S-TNO-AREA. DTSCS84 01691 PERFORM S021-SCREEN-PHONE THRU S021-EXIT. DTSCS84 01692 IF L021-NOT-VALID DTSCS84 01693 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS84 01694 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS84 01695 ELSE DTSCS84 01696 IF L021-VALID DTSCS84 01697 MOVE L021-TNO TO L073-TELEPHONE DTSCS84 01698 PERFORM S073-EDIT-PHONE THRU S073-EXIT DTSCS84 01699 IF L073-NOT-VALID DTSCS84 01700 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS84 01701 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS84 01702 ELSE DTSCS84 01703 MOVE L073-AREA-CD TO MAP-PHONE-AREA-CD (PHONE) DTSCS84 01704 MOVE L073-PREFIX TO MAP-PHONE-PREFIX (PHONE) DTSCS84 01705 MOVE L073-SUFFIX TO MAP-PHONE-SUFFIX (PHONE) DTSCS84 01706 MOVE L073-EXT TO MAP-PHONE-EXT (PHONE) DTSCS84 01707 ELSE DTSCS84 01708 IF PHONE-VOICE1 OR PHONE-FAX DTSCS84 01709 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS84 01710 PERFORM S1601-ERROR THRU S1601-EXIT. DTSCS84 01711 S1600-EXIT. DTSCS84 01712 EXIT. DTSCS84 01713 SKIP3 DTSCS84 01714 S1601-ERROR. DTSCS84 01715 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS84 01716 TO MAP-PHONE-AREA-CD-A (PHONE) DTSCS84 01717 MAP-PHONE-PREFIX-A (PHONE) DTSCS84 01718 MAP-PHONE-SUFFIX-A (PHONE) DTSCS84 01719 MAP-PHONE-EXT-A (PHONE). DTSCS84 01720 IF LCCM-NO-MSG DTSCS84 01721 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS84 01722 MOVE CATB-CURSOR TO MAP-PHONE-AREA-CD-L (PHONE) DTSCS84 01723 SET CURSOR-SET-YES TO TRUE. DTSCS84 01724 S1601-EXIT. DTSCS84 01725 EXIT. DTSCS84 01726 /*****************************************************************DTSCS84 01727 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS84 01728 ******************************************************************DTSCS84 01729 S5100-SET-LOCK-ATTRB. DTSCS84 01730 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS84 01731 SCR-ATB-NUM. DTSCS84 01732 SKIP1 DTSCS84 01733 MOVE MAP-ATTN-A (1) TO HOLD-MAIL-ATTN-A. DTSCS84 01734 MOVE MAP-DLV1-A (1) TO HOLD-MAIL-DLV1-A. DTSCS84 01735 MOVE MAP-DLV2-A (1) TO HOLD-MAIL-DLV2-A. DTSCS84 01736 MOVE MAP-CITY-A (1) TO HOLD-MAIL-CITY-A. DTSCS84 01737 MOVE MAP-STATE-A (1) TO HOLD-MAIL-STATE-A. DTSCS84 01738 MOVE MAP-ZIP-A (1) TO HOLD-MAIL-ZIP-A. DTSCS84 01739 MOVE MAP-ATTN-A (2) TO HOLD-PHYS-ATTN-A. DTSCS84 01740 MOVE MAP-DLV1-A (2) TO HOLD-PHYS-DLV1-A. DTSCS84 01741 MOVE MAP-DLV2-A (2) TO HOLD-PHYS-DLV2-A. DTSCS84 01742 MOVE MAP-CITY-A (2) TO HOLD-PHYS-CITY-A. DTSCS84 01743 MOVE MAP-STATE-A (2) TO HOLD-PHYS-STATE-A. DTSCS84 01744 MOVE MAP-ZIP-A (2) TO HOLD-PHYS-ZIP-A. DTSCS84 01745 SKIP1 DTSCS84 01746 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS84 01747 SKIP1 DTSCS84 01748 IF HOLD-MAIL-ATTN-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01749 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-A (1). DTSCS84 01750 IF HOLD-MAIL-DLV1-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01751 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV1-A (1). DTSCS84 01752 IF HOLD-MAIL-DLV2-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01753 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV2-A (1). DTSCS84 01754 IF HOLD-MAIL-CITY-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01755 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A (1). DTSCS84 01756 IF HOLD-MAIL-STATE-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01757 MOVE CATB-ASKIP-NORM-MDTON TO MAP-STATE-A (1). DTSCS84 01758 IF HOLD-MAIL-ZIP-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01759 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIP-A (1). DTSCS84 01760 IF HOLD-PHYS-ATTN-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01761 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-A (2). DTSCS84 01762 IF HOLD-PHYS-DLV1-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01763 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV1-A (2). DTSCS84 01764 IF HOLD-PHYS-DLV2-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01765 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV2-A (2). DTSCS84 01766 IF HOLD-PHYS-CITY-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01767 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A (2). DTSCS84 01768 IF HOLD-PHYS-STATE-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01769 MOVE CATB-ASKIP-NORM-MDTON TO MAP-STATE-A (2). DTSCS84 01770 IF HOLD-PHYS-ZIP-A = CATB-UNPROT-NORM-AN-MDTON DTSCS84 01771 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIP-A (2). DTSCS84 01772 SKIP1 DTSCS84 01773 MOVE CATB-ASKIP-BRT-MDTON TO MAP-REP-ID-A DTSCS84 01774 MAP-GOTO-A. DTSCS84 01775 S5100-EXIT. DTSCS84 01776 EXIT. DTSCS84 01777 SKIP3 DTSCS84 01778 ******************************************************************DTSCS84 01779 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS84 01780 ******************************************************************DTSCS84 01781 S5200-SET-UPDATE-ATTRB. DTSCS84 01782 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS84 01783 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS84 01784 SKIP1 DTSCS84 01785 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS84 01786 S5200-EXIT. DTSCS84 01787 EXIT. DTSCS84 01788 SKIP3 DTSCS84 01789 ******************************************************************DTSCS84 01790 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS84 01791 ******************************************************************DTSCS84 01792 S5300-SET-INQ-ATTRB. DTSCS84 01793 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS84 01794 SCR-ATB-NUM. DTSCS84 01795 SKIP1 DTSCS84 01796 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS84 01797 S5300-EXIT. DTSCS84 01798 EXIT. DTSCS84 01799 SKIP3 DTSCS84 01800 ******************************************************************DTSCS84 01801 * DO IT *DTSCS84 01802 ******************************************************************DTSCS84 01803 S5900-SET-ATTRB. DTSCS84 01804 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-REP-ID-A. DTSCS84 01805 SKIP1 DTSCS84 01806 MOVE SCR-ATB-AN TO MAP-REP-OP-ID-A DTSCS84 01807 MAP-ACCT-TECH-A DTSCS84 01808 MAP-REP-NAME-A DTSCS84 01809 MAP-CASUAL-A DTSCS84 01810 MAP-EMAIL-A DTSCS84 01811 MAP-ATTN-A (SUB-MAILING) DTSCS84 01812 MAP-DLV1-A (SUB-MAILING) DTSCS84 01813 MAP-DLV2-A (SUB-MAILING) DTSCS84 01814 MAP-CASS-IND-A (SUB-MAILING) DTSCS84 01815 MAP-CITY-A (SUB-MAILING) DTSCS84 01816 MAP-STATE-A (SUB-MAILING) DTSCS84 01817 MAP-ZIP-A (SUB-MAILING) DTSCS84 01818 MAP-ATTN-A (SUB-PHYSICAL) DTSCS84 01819 MAP-DLV1-A (SUB-PHYSICAL) DTSCS84 01820 MAP-DLV2-A (SUB-PHYSICAL) DTSCS84 01821 MAP-CASS-IND-A (SUB-PHYSICAL) DTSCS84 01822 MAP-CITY-A (SUB-PHYSICAL) DTSCS84 01823 MAP-STATE-A (SUB-PHYSICAL) DTSCS84 01824 MAP-ZIP-A (SUB-PHYSICAL). DTSCS84 01825 MOVE SCR-ATB-NUM TO MAP-PHONE-AREA-CD-A (SUB-VOICE1) DTSCS84 01826 MAP-PHONE-PREFIX-A (SUB-VOICE1) DTSCS84 01827 MAP-PHONE-SUFFIX-A (SUB-VOICE1) DTSCS84 01828 MAP-PHONE-EXT-A (SUB-VOICE1) DTSCS84 01829 MAP-PHONE-AREA-CD-A (SUB-VOICE2) DTSCS84 01830 MAP-PHONE-PREFIX-A (SUB-VOICE2) DTSCS84 01831 MAP-PHONE-SUFFIX-A (SUB-VOICE2) DTSCS84 01832 MAP-PHONE-EXT-A (SUB-VOICE2) DTSCS84 01833 MAP-PHONE-AREA-CD-A (SUB-FAX) DTSCS84 01834 MAP-PHONE-PREFIX-A (SUB-FAX) DTSCS84 01835 MAP-PHONE-SUFFIX-A (SUB-FAX) DTSCS84 01836 MAP-PHONE-EXT-A (SUB-FAX). DTSCS84 01837 SKIP1 DTSCS84 01838 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ESTB-DATE-A DTSCS84 01839 MAP-CHNG-DATE-A. DTSCS84 01840 SKIP1 DTSCS84 01841 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS84 01842 S5900-EXIT. DTSCS84 01843 EXIT. DTSCS84 01844 /*****************************************************************DTSCS84 01845 * READ PREPARATION ROUTINES *DTSCS84 01846 ******************************************************************DTSCS84 01847 S8010-READ-FFID. DTSCS84 01848 MOVE LOW-VALUES TO FFID-KEY-AREA. DTSCS84 01849 SET FFID-FID-88 TO TRUE. DTSCS84 01850 MOVE MAP-REP-ID TO FFID-FLD-REP-ID. DTSCS84 01851 MOVE FFID-KEY-AREA TO FSKL-KEY-AREA. DTSCS84 01852 PERFORM S831-READ THRU S831-EXIT. DTSCS84 01853 IF L831-OK-88 DTSCS84 01854 MOVE FSKL-REC TO FFID-REC. DTSCS84 01855 S8010-EXIT. DTSCS84 01856 EXIT. DTSCS84 01857 /*****************************************************************DTSCS84 01858 * MAP ROUTINES *DTSCS84 01859 ******************************************************************DTSCS84 01860 S9100-RECEIVE. DTSCS84 01861 SET L851-RECEIVE-88 TO TRUE. DTSCS84 01862 SKIP1 DTSCS84 01863 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS84 01864 SKIP1 DTSCS84 01865 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS84 01866 DTSCS84 01867 MOVE MAP-REP-ID TO L009-DATA. DTSCS84 01868 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01869 MOVE L009-DATA TO MAP-REP-ID. DTSCS84 01870 DTSCS84 01871 MOVE MAP-GOTO TO L009-DATA. DTSCS84 01872 PERFORM S009-TO-UPPER-CASE THRU S009-EXIT. DTSCS84 01873 MOVE L009-DATA TO MAP-GOTO. DTSCS84 01874 DTSCS84 01875 MOVE L851-AID TO LCCM-AID. DTSCS84 01876 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS84 01877 S9100-EXIT. DTSCS84 01878 EXIT. DTSCS84 01879 SKIP3 DTSCS84 01880 S9200-SEND-DATAONLY. DTSCS84 01881 MOVE LOW-VALUES TO MAP-AREA. DTSCS84 01882 SKIP1 DTSCS84 01883 IF LCCM-NO-MSG DTSCS84 01884 NEXT SENTENCE DTSCS84 01885 ELSE DTSCS84 01886 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS84 01887 SKIP1 DTSCS84 01888 IF CURSOR-SET-GOTO DTSCS84 01889 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS84 01890 ELSE DTSCS84 01891 MOVE CATB-CURSOR TO MAP-REP-ID-L. DTSCS84 01892 SKIP1 DTSCS84 01893 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS84 01894 SKIP1 DTSCS84 01895 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS84 01896 SKIP1 DTSCS84 01897 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS84 01898 S9200-EXIT. DTSCS84 01899 EXIT. DTSCS84 01900 SKIP3 DTSCS84 01901 S9300-SEND-MAP. DTSCS84 01902 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS84 01903 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS84 01904 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS84 01905 SKIP1 DTSCS84 01906 IF SCR-ACCESS-UPDATE DTSCS84 01907 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS84 01908 ELSE DTSCS84 01909 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS84 01910 SKIP1 DTSCS84 01911 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS84 01912 SKIP1 DTSCS84 01913 IF CURSOR-SET-NO DTSCS84 01914 MOVE CATB-CURSOR TO MAP-REP-ID-L. DTSCS84 01915 SKIP1 DTSCS84 01916 SET L851-SEND-88 TO TRUE. DTSCS84 01917 SKIP1 DTSCS84 01918 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS84 01919 SKIP1 DTSCS84 01920 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS84 01921 S9300-EXIT. DTSCS84 01922 EXIT. DTSCS84 01923 SKIP3 DTSCS84 01924 S9310-UPDATE-FKEYS. DTSCS84 01925 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS84 01926 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS84 01927 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS84 01928 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS84 01929 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS84 01930 SKIP1 DTSCS84 01931 IF LCCM-SCR-CLEAR DTSCS84 01932 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS84 01933 MAP-KEY-DEL DTSCS84 01934 ELSE DTSCS84 01935 IF LCCM-SCR-UPDATE-LOCKED DTSCS84 01936 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS84 01937 MAP-KEY-FWRD DTSCS84 01938 MAP-KEY-ADD DTSCS84 01939 MAP-KEY-MOD DTSCS84 01940 MAP-KEY-DEL DTSCS84 01941 ELSE DTSCS84 01942 MOVE LOW-VALUES TO MAP-KEY-ADD. DTSCS84 01943 S9310-EXIT. DTSCS84 01944 EXIT. DTSCS84 01945 SKIP3 DTSCS84 01946 S9320-INQUIRY-FKEYS. DTSCS84 01947 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS84 01948 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS84 01949 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS84 01950 MAP-KEY-MOD DTSCS84 01951 MAP-KEY-DEL. DTSCS84 01952 S9320-EXIT. DTSCS84 01953 EXIT. DTSCS84 01954 EJECT DTSCS84 01955 S9900-PREPARE-SEND. DTSCS84 01956 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS84 01957 LCCM-SCR-ID. DTSCS84 01958 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS84 01959 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS84 01960 S9900-EXIT. DTSCS84 01961 EXIT. DTSCS84