2844 lines
222 KiB
COBOL
2844 lines
222 KiB
COBOL
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
|