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