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