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

2820 lines
221 KiB
COBOL
Raw Blame History

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