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