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