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