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