giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
c99f490664479f7d28c575be3d5068507007c38d
DUTAS/CICS/DTSCS84.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

1963 lines
153 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink