00001 IDENTIFICATION DIVISION. 12/08/21 00002 PROGRAM-ID. DTSCS1A. DTSCS1A 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV108 00004 DATE-WRITTEN. APRIL 1994. DTSCS1A 00005 DATE-COMPILED. DTSCS1A 00006 DTSCS1A 00007 ****** DTSCS1A 00008 * DTSCS1A 00009 * FUNCTION: INITIAL REGISTRATION / CYCLE A INQUIRY/UPDATE DTSCS1A 00010 * SCREEN PROCESSOR. DTSCS1A 00011 * DTSCS1A 00012 * DTSCS1A 00013 * MODIFICATION LOG: DTSCS1A 00014 * DTSCS1A 00015 * 12/14/94 REPLACE THE SINGLE DEFAULT FOR LETTER-1-CD WITH DTSCS1A 00016 * THREE POSSIBLE DEFAULTS DEPENDING ON SOURCE-CD. DTSCS1A 00017 * WORK ORDER: CR029 PROGRAMMER: RHC DTSCS1A 00018 * DTSCS1A 00019 * 03/26/95 MODIFY CYCLE A, ADDING THE LETTER 3 TICKLER STEP. DTSCS1A 00020 * WORK ORDER: CR065 PROGRAMMER: EHH DTSCS1A 00021 * DTSCS1A 00022 * 03/31/95 CHANGE DATA PHONE NUMBER TO VOICE2 PHONE NUMBER. DTSCS1A 00023 * WORK ORDER: CR068 PROGRAMMER: RHC DTSCS1A 00024 * DTSCS1A 00025 * 09/18/95 INITIALIZE TWO NEW MPRF DATA ELEMENTS. MPRF-WH- DTSCS1A 00026 * OFLT-SEIN AND MPRF-WH-OFLT-MAIL-ADDR-IND DTSCS1A 00027 * WORK ORDER: JR PROGRAMMER: EHH DTSCS1A 00028 * DTSCS1A 00029 * 09/30/95 JOINT REGISTRATION PROCESSING. DURING MODIFY DTSCS1A 00030 * PROCESSING, IF UI EMPLOYER IS "CONNECTED" TO DTSCS1A 00031 * A WH/OFLT EMPLOYER, THEN UPDATE THE WH/OFLT DTSCS1A 00032 * EMPLOYER REGISTRATION INFORMATION. ALSO, IF DTSCS1A 00033 * UI EMPLOYER IS "CONNECTED" TO A WH/OFLT EMPLOYER, DTSCS1A 00034 * THEN DO NOT ALLOW EMPLOYER DELETE. DTSCS1A 00035 * WORK ORDER: JR PROGRAMMER: EHH DTSCS1A 00036 * DTSCS1A 00037 * 06/13/96 RE-COMPILED TO INCORPORATE MELF RECORD INTO DTSCS1A 00038 * DTSIMLEN AND DTSIMSKL. DTSCS1A 00039 * REFERENCE RFP: #WARP II PROGRAMMER: MJA DTSCS1A 00040 * DTSCS1A 00041 * 07/31/97 MODIFY LOGIC TO ALLOW DELETE FUNCTION TO BE DTSCS1A 00042 * PERFORMED USING FUNCTION KEY 23 INSTEAD OF 11. DTSCS1A 00043 * REFERENCE RFP: TCL 096 PROGRAMMER: FLS DTSCS1A 00044 * DTSCS1A 00045 * 09/10/1998 REVIEWED AND MODIFIED FOR DC. DTSCS1A 00046 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCS1A 00047 * DTSCS1A 00048 * 05/13/1999 INITIALIZE MPRF-LAST-ARCHIVED-YRQ TO LCCM- DTSCS1A 00049 * PICKUP-YRQ (RATHER THAN 00000). DTSCS1A 00050 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSCS1A 00051 * DTSCS1A 00052 * 10/10/1999 IF MERA-SOURCE-CD = '14', THEN DEFAULT DTSCS1A 00053 * MERA-LETTER-1-CD TO '04'. DTSCS1A 00054 * REFERENCE: PER LYNNETTE PROGRAMMER: EHH DTSCS1A 00055 * DTSCS1A 00056 * 05/26/2000 ADDED CODE TO VALIDATE AND DISPLAY FISCAL DTSCS1A 00057 * AGENT CODE AND ADDRESS. DTSCS1A 00058 * REFERENCE: SPEC019 PROGRAMMER: ZL1 DTSCS1A 00059 * DTSCS1A 00060 * 10/16/2001 MODIFIED FOR HOUSEHOLD -- ADD PENDING MFSC DTSCS1A 00061 * AGENT CODE AND ADDRESS. DTSCS1A 00062 * REFERENCE: PROGRAMMER: GD1 DTSCS1A 00063 * DTSCS1A 00064 * 12/09/2002 MODIFIED TO USE OPERATOR ID OF USER CURRENTLY DTSCS1A 00065 * SIGNED ON AS 'RESPONSIBLE OP ID,' UNLESS THE DTSCS1A 00066 * USER HAS SPECIFICALLY ENTERED A DIFFERENT ID DTSCS1A 00067 * IN THE MAP-RESP-OP-ID FIELD. DTSCS1A 00068 * REFERENCE: REQUEST FROM STATUS PROGRAMMER: GD DTSCS1A 00069 * DTSCS1A 00070 * 11/25/2003 MODIFIED P8930-MERA-UPDATE, S1800, S2200, DTSCS1A 00071 * S2600, S2800. IF NO MERA EXISTS, DTSCS1A 00072 * DO NOT ADD AN MERA IF THE EMPLOYER IS DTSCS1A 00073 * CONVERTED. THE PROGRAM WAS INCORRECTLY DTSCS1A 00074 * ADDING MERA RECORDS FOR CONVERTED (AND LIABLE) DTSCS1A 00075 * EMPLOYERS WHENEVER THE 1A SCREEN WAS UPDATED. DTSCS1A 00076 * AS A RESULT THE SYSTEM WAS SENDING CYCLE A DTSCS1A 00077 * LETTERS TO LIABLE EMPLOYERS. DTSCS1A 00078 * REFERENCE: PRODUCTION PROBLEM. PROGRAMMER: GD DTSCS1A 00079 * DTSCS1A 00080 * 06/29/2004 MODIFIED FOR ELIG CODE 17 - DOMESTIC VIOLENCE DTSCS1A 00081 * REFERENCE: PROGRAMMER: GD DTSCS1A 00082 * DTSCS1A 00083 * 07/16/2004 ADDED CODE IN S1400 AND S1500 TO CHECK FOR DTSCS1A 00084 * DUPLICATE NAMES. IF A DUPLICATE IS FOUND, A DTSCS1A 00085 * SUPERVISOR (FIELD DESK OR ACCOUNTING DESK) DTSCS1A 00086 * MAY OVERRIDE THE EDIT. DTSCS1A 00087 * REFERENCE: PROGRAMMER: GD DTSCS1A 00088 * DTSCS1A 00089 * 07/28/2004 MODIFIED P8930-MERA-UPDATE TO CHECK CYCLE A DTSCS1A 00090 * STATUS WHEN AN FR500 RECEIVED DATE IS ENTERED. DTSCS1A 00091 * IF CYCLE A IS ACTIVE, SET THE CYLE A STATUS DTSCS1A 00092 * TO EITHER LIABLE OR NOT LIABLE BASED ON MPRF DTSCS1A 00093 * STATUS. DTSCS1A 00094 * MODIFIED S3000 TO ALLOW ENTRY OF FR500 DTSCS1A 00095 * RECEIVED DATE WHILE CYCLE A IS ACTIVE. DTSCS1A 00096 * REFERENCE: PROGRAMMER: GD DTSCS1A 00097 * DTSCS1A 00098 * 08/11/2004 ADDED TEST FOR DC ADDRESS WHEN EMPLOYER IS DTSCS1A 00099 * LIABLE AND AN FR500 RECEIVED DATE IS ENTERED. DTSCS1A 00100 * REFERENCE: PROGRAMMER: GD DTSCS1A 00101 * DTSCS1A 00102 * 09/01/2004 MODIFIED DUPLICATE NAME EDIT TO IGNORE DUPLICATE DTSCS1A 00103 * IF EMPLOYER IS NOT ACTIVE. DTSCS1A 00104 * REFERENCE: PROGRAMMER: GD DTSCS1A 00105 * DTSCS1A 00106 * 03/08/2005 MODIFIED FOR ELIG CODE 18 - EDUCATIONAL DTSCS1A 00107 * STEPLADDER PROGRAM DTSCS1A 00108 * REFERENCE: PROGRAMMER: GD DTSCS1A 00109 * DTSCS1A 00110 * 02/01/2006 MODIFIED TO INITIALIZE RETURN MAIL INDICATOR DTSCS1A 00111 * REFERENCE: PROGRAMMER: GD DTSCS1A 00112 * DTSCS1A 00113 * 11/07/2007 RECOMPILED WITH MODIFIED COPY OF DTSICENO - DTSCS1A 00114 * THE NEW VERSION RESERVES A RANGE OF ACCOUNT DTSCS1A 00115 * NUMBERS TO BE USED FOR WEB REGISTRATION. DTSCS1A 00116 * REFERENCE: PROGRAMMER: GD DTSCS1A 00117 * DTSCS1A 00118 * 07/15/2008 MODIFIED FOR ELIG CODE 19 - EUC08 - 2008 DTSCS1A 00119 * EXTENDED BENEFITS PROGRAM DTSCS1A 00120 * REFERENCE: PROGRAMMER: GD DTSCS1A 00121 * DTSCS1A 00122 * 02/26/2009 MODIFIED FOR ELIG CODE 20 - FAC - 2009 TEMP DTSCS1A 00123 * FEDERAL ADDITIONAL COMPENSATION. DTSCS1A 00124 * REFERENCE: PROGRAMMER: GD DTSCS1A 00125 * DTSCS1A 00126 * 07/14/2009 MODIFIED FOR ADDITIONAL BENEFITS AND DTSCS1A 00127 * DEPENDENCY ALLOWANCE. SEE S1300. DTSCS1A 00128 * REFERENCE: PROGRAMMER: GD DTSCS1A 00129 * DTSCS1A 00130 * 07/17/2009 MODIFIED P8120 TO INITIALIZE POWER OF ATTORNEY DTSCS1A 00131 * DATE. DTSCS1A 00132 * REFERENCE: PROGRAMMER: GD DTSCS1A 00133 * DTSCS1A 00134 * 07/30/2009 MODIFIED FOR TRAINING EXTENSION BENEFITS DTSCS1A 00135 * PROGRAM. SEE S1300. DTSCS1A 00136 * REFERENCE: PROGRAMMER: GD DTSCS1A 00137 * DTSCS1A 00138 * 11/17/2009 MODIFIED FOR EUC 2008 TIERS 3 AND 4. DTSCS1A 00139 * SEE S1300. DTSCS1A 00140 * REFERENCE: PROGRAMMER: GD DTSCS1A 00141 * DTSCS1A 00142 * 03/31/2010 MODIFIED FOR SPECIAL PAYMENTS ELIG CODE. DTSCS1A 00143 * SEE S1300. DTSCS1A 00144 * REFERENCE: PROGRAMMER: GD DTSCS1A 00145 * DTSCS1A 00146 * 09/26/2014 MODIFIED FOR UCPIA ELIG CODE. DTSCS1A 00147 * SEE S1300. DTSCS1A 00148 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00149 * DTSCS1A 00150 * DTSCS1A 00151 * 03/26/2015 MODIFIED FOR DUA AND GPA ELIG CODE DTSCS1A 00152 * SEE S1300. DTSCS1A 00153 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00154 * DTSCS1A 00155 * DTSCS1A 00156 * 04/07/2020 MODIFIED FOR FPUC AND FRUR CODE DTSCS1A 00157 * SEE S1300. DTSCS1A 00158 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00159 * DTSCS1A 00160 * DTSCS1A 00161 * 04/24/2020 MODIFIED FOR PEUC DTSCS1A 00162 * SEE S1300. DTSCS1A 00163 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00164 * DTSCS1A 00165 * 05/08/2020 MODIFIED FOR REUR - RATED EMPLOYERS UNEMPLOYMENT DTSCS1A 00166 * RELIEF SEE S1300. DTSCS1A 00167 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00168 * DTSCS1A 00169 * 09/02/2020 MODIFIED FOR LWA DTSCS1A 00170 * SEE S1300. DTSCS1A 00171 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00172 * DTSCS1A 00173 * DTSCS1A 00174 * 12/05/2020 MODIFIED FOR PUA STIMULUS DTSCS1A 00175 * SEE S1300. DTSCS1A 00176 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00177 * DTSCS1A 00178 * 02/16/2021 MODIFIED FOR MEUC DTSCS1A 00179 * SEE S1300. DTSCS1A 00180 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00181 * DTSCS1A 00182 * DTSCS1A 00183 * 12/06/2021 MODIFIED FOR DUC DTSCS1A 00184 * SEE S1300. DTSCS1A 00185 * REFERENCE: PROGRAMMER: ZL1 DTSCS1A 00186 * DTSCS1A 00187 * DTSCS1A 00188 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS1A 00189 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS1A 00190 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS1A 00191 * DTSCS1A 00192 * DTSCS1A 00193 * DESCRIPTION: DTSCS1A 00194 * DTSCS1A 00195 * DTSCS1A 00196 * CLEAR: DTSCS1A 00197 * DTSCS1A 00198 * FIELDS DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS1A 00199 * DTSCS1A 00200 * DTSCS1A 00201 * INQUIRY: DTSCS1A 00202 * DTSCS1A 00203 * CONTROL FIELD(S): MAP-EMP-NO DTSCS1A 00204 * DTSCS1A 00205 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS1A 00206 * DTSCS1A 00207 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS1A 00208 * DTSCS1A 00209 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS1A 00210 * DTSCS1A 00211 * DTSCS1A 00212 * UPDATE: DTSCS1A 00213 * DTSCS1A 00214 * ADD: THIS MODULE IS UNIQUE IN THAT AN "ADD" CAUSES AN DTSCS1A 00215 * MPRF RECORD TO BE ADDED. IF "CHARGING ONLY" DTSCS1A 00216 * EMPLOYER, THEN USE MAP-EMP-NO AS KEY. IF NOT DTSCS1A 00217 * "CHARGING ONLY" EMPLOYER, THEN SYSTEM DETERMINES DTSCS1A 00218 * EMP-NO FROM MHDR RECORD. DTSCS1A 00219 * DTSCS1A 00220 * IF MAP-SOURCE-CD IS EQUAL TO 'NA', THEN DO NOT DTSCS1A 00221 * WRITE A MERA RECORD. DTSCS1A 00222 * DTSCS1A 00223 * IF MAP-SOURCE-CD IS NOT EQUAL TO 'NA', THEN DO DTSCS1A 00224 * NOT WRITE A MERA RECORD. DTSCS1A 00225 * DTSCS1A 00226 * THE MERA RECORD HAS NO MEANING FOR A "CHARGING ONLY" DTSCS1A 00227 * EMPLOYER. WHEN PROCESSING (ADDING) A "CHARGING DTSCS1A 00228 * ONLY" EMPLOYER, DO NOT ADD A MERA RECORD. DTSCS1A 00229 * DTSCS1A 00230 * DTSCS1A 00231 * MOD: IF NOT MERA RECORD EXISTS, THEN WRITE A MERA RECORD. DTSCS1A 00232 * DTSCS1A 00233 * DTSCS1A 00234 * DEL: IF MAP-DELETE-EMP IS EQUAL TO 'Y', THE DELETE DTSCS1A 00235 * ALL RECORDS ASSOCIATED WITH MAP-EMP-NO. DTSCS1A 00236 * DTSCS1A 00237 * IF ANY RECORD WITH MLEN-DEL-MPRF-NOT-OK-88 DTSCS1A 00238 * (DTSIMLEN) EXISTS, THEN DO NOT PERMIT THE MPRF DTSCS1A 00239 * RECORD TO BE DELETED. DTSCS1A 00240 * DTSCS1A 00241 * BEFORE DELETING A MPRF RECORD, DELETE ALL M* RECORDS DTSCS1A 00242 * ASSOCIATED WITH THE MPRF RECORD. DTSCS1A 00243 * DTSCS1A 00244 * IF MAP-DELETE-EMP IS NOT EQUAL TO 'Y', THEN JUST DTSCS1A 00245 * DELETE THE MERA RECORD. DTSCS1A 00246 * DTSCS1A 00247 * IF A MERA RECORD IS WRITTEN OR REWRITTEN (DURING AN ADD DTSCS1A 00248 * OR A MOD), THEN WRITE A MTCK RECORD WITH DTSCS1A 00249 * MTCK-TYPE-CYCLE-A-88. DTSCS1A 00250 * DTSCS1A 00251 * DTSCS1A 00252 * RECORDS READ: DTSCS1A 00253 * DTSCS1A 00254 * MASTER: DTSCS1A 00255 * DTSCS1A 00256 * MHDR DTSCS1A 00257 * MPRF DTSCS1A 00258 * MTAD DTSCS1A 00259 * MERA DTSCS1A 00260 * MFAE DTSCS1A 00261 * MFIS DTSCS1A 00262 * ALL OTHER RECORD TYPES ARE READ AS PART DTSCS1A 00263 * OF THE PROCESS OF DELETING A MPRF RECORD. DTSCS1A 00264 * DTSCS1A 00265 * DTSCS1A 00266 * ALTERNATE INDEX: DTSCS1A 00267 * DTSCS1A 00268 * NONE. DTSCS1A 00269 * DTSCS1A 00270 * DTSCS1A 00271 * REFERENCE: DTSCS1A 00272 * DTSCS1A 00273 * NONE. DTSCS1A 00274 * DTSCS1A 00275 * DTSCS1A 00276 * ACCOUNTING TRANSACTION COLLECTION: DTSCS1A 00277 * DTSCS1A 00278 * NONE. DTSCS1A 00279 * DTSCS1A 00280 * DTSCS1A 00281 * RECORDS UPDATED: DTSCS1A 00282 * DTSCS1A 00283 * MASTER: DTSCS1A 00284 * DTSCS1A 00285 * MHDR (REWRITE, DURING AN "ADD") DTSCS1A 00286 * MPRF (WRITE, REWRITE, DELETE) DTSCS1A 00287 * MTAD (WRITE, REWRITE, DELETE) DTSCS1A 00288 * MERA (WRITE, REWRITE, DELETE) DTSCS1A 00289 * MTCK (WRITE) DTSCS1A 00290 * MEVL (WRITE) DTSCS1A 00291 * DTSCS1A 00292 * DTSCS1A 00293 * IF A MERA RECORD IS ADDED OR MODIFIED, THEN WRITE A MTCK DTSCS1A 00294 * IF A MPRF RECORD IS WRITTEN, THEN WRITE A MEVL DTSCS1A 00295 * RECORD COMMEMORATING THE EVENT. DTSCS1A 00296 * DTSCS1A 00297 * DTSCS1A 00298 * REFERENCE: DTSCS1A 00299 * DTSCS1A 00300 * NONE. DTSCS1A 00301 * DTSCS1A 00302 * DTSCS1A 00303 * ACCOUNTING TRANSACTION COLLECTION: DTSCS1A 00304 * DTSCS1A 00305 * NONE. DTSCS1A 00306 * DTSCS1A 00307 * DTSCS1A 00308 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS1A 00309 * DTSCS1A 00310 * NONE. DTSCS1A 00311 * DTSCS1A 00312 * DTSCS1A 00313 * TEMPORARY STORAGE USAGE: DTSCS1A 00314 * DTSCS1A 00315 * NONE. DTSCS1A 00316 * DTSCS1A 00317 * DTSCS1A 00318 * MODULES LINKED TO: DTSCS1A 00319 * DTSCS1A 00320 * DTSCU001 DATE EDIT/CONVERSION. DTSCS1A 00321 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS1A 00322 * DTSCU017 FEIN FROM SCREEN FORMAT/EDIT. DTSCS1A 00323 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS1A 00324 * DTSCU020 SSN FROM SCREEN FORMAT/EDIT. DTSCS1A 00325 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. DTSCS1A 00326 * DTSCU031 EMPLOYER REGISTRATION CODES EDIT/DESCRIPTION. DTSCS1A 00327 * DTSCU061 FIELD ZIP/FIELD REP ID. DTSCS1A 00328 * DTSCU062 FIELD REP ID EDIT/DESCRIPTION. DTSCS1A 00329 * DTSCU071 INDIVIDUAL'S NAME EDIT/CONVERSION. DTSCS1A 00330 * DTSCU072 ADDRESS EDIT. DTSCS1A 00331 * DTSCU073 TELEPHONE NUMBER EDIT. DTSCS1A 00332 * DTSCU074 DUPLICATE FEIN EDIT. DTSCS1A 00333 * DTSCU081 CLAIMANT NAME LOOKUP. DTSCS1A 00334 * DTSCU082 OPERATOR ID EDIT/LOOKUP. DTSCS1A 00335 * DTSCU201 DETERMINE EMPLOYER CLASS. DTSCS1A 00336 * DTSCU202 DETERMINE EMPLOYER ELIGIBLE CODE DTSCS1A 00337 * DTSCU203 DETERMINE FIELD ZIP CODE AND JS ZIP CODE. DTSCS1A 00338 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS1A 00339 * DTSCU331 WRITE MODIFICATION LOG RECORD. DTSCS1A 00340 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS1A 00341 * DTSCU831 REFERENCE FILE I-O. DTSCS1A 00342 * DTSCS1A 00343 ***** DTSCS1A 00344 SKIP3 DTSCS1A 00345 ENVIRONMENT DIVISION. DTSCS1A 00346 SKIP3 DTSCS1A 00347 DATA DIVISION. DTSCS1A 00348 SKIP3 DTSCS1A 00349 WORKING-STORAGE SECTION. DTSCS1A 003495 77 PAN-VALET PICTURE X(24) VALUE '108DTSCS1A 12/08/21'. DTSCS1A 00350 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 12/07/21'. DTSCS1A 00351 77 PAN-VALET PICTURE X(24) VALUE '106DTSCS1A 02/16/21'. DTSCS1A 00352 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 02/16/21'. DTSCS1A 00353 77 PAN-VALET PICTURE X(24) VALUE '104DTSCS1A 12/07/20'. DTSCS1A 00354 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1A 12/07/20'. DTSCS1A 00355 77 PAN-VALET PICTURE X(24) VALUE '102DTSCS1A 05/08/20'. DTSCS1A 00356 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 05/08/20'. DTSCS1A 00357 77 PAN-VALET PICTURE X(24) VALUE '100DTSCS1A 04/27/20'. DTSCS1A 00358 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1A 04/25/20'. DTSCS1A 00359 77 PAN-VALET PICTURE X(24) VALUE '098DTSCS1A 03/25/15'. DTSCS1A 00360 77 PAN-VALET PICTURE X(24) VALUE '002DTSCS1A 03/25/15'. DTSCS1A 00361 77 PAN-VALET PICTURE X(24) VALUE '096DTSCS1A 10/01/14'. DTSCS1A 00362 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS1A 09/26/14'. DTSCS1A 00363 77 PAN-VALET PICTURE X(24) VALUE '094DTSCS1A 03/31/10'. DTSCS1A 00364 SKIP3 DTSCS1A 00365 01 WRK-AREA. DTSCS1A 00366 05 WRK-ABEND-CD PIC X(04) VALUE 'S1A '. DTSCS1A 00367 DTSCS1A 00368 05 WRK-SCR-ID PIC X(02) VALUE '1A'. DTSCS1A 00369 DTSCS1A 00370 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS1A 00371 SKIP3 DTSCS1A 00372 05 SCR-ACCESS-IND PIC X(01). DTSCS1A 00373 88 SCR-ACCESS-INQ VALUE '1'. DTSCS1A 00374 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS1A 00375 DTSCS1A 00376 05 CURSOR-SET-IND PIC X(01). DTSCS1A 00377 88 CURSOR-SET-YES VALUE 'Y'. DTSCS1A 00378 88 CURSOR-SET-NO VALUE 'N'. DTSCS1A 00379 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS1A 00380 DTSCS1A 00381 05 REQ-IND PIC X(01). DTSCS1A 00382 88 REQ-ERROR VALUE 'O'. DTSCS1A 00383 88 REQ-JUMP VALUE 'J'. DTSCS1A 00384 88 REQ-INQUIRE VALUE 'I'. DTSCS1A 00385 88 REQ-CLEAR VALUE 'C'. DTSCS1A 00386 88 REQ-EDIT VALUE 'E'. DTSCS1A 00387 88 REQ-UPDATE VALUE 'U'. DTSCS1A 00388 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS1A 00389 DTSCS1A 00390 05 RESP-IND PIC X(01). DTSCS1A 00391 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS1A 00392 88 RESP-SEND-MAP VALUE 'M'. DTSCS1A 00393 88 RESP-JUMP VALUE 'J'. DTSCS1A 00394 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS1A 00395 DTSCS1A 00396 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS1A 00397 DTSCS1A 00398 05 WRK-HOLD-EMP-NO PIC S9(07) COMP-3. DTSCS1A 00399 DTSCS1A 00400 05 WRK-EMP-CHG-ONLY-IND PIC X(01). DTSCS1A 00401 88 WRK-EMP-CHG-ONLY-88 VALUE 'Y'. DTSCS1A 00402 88 WRK-EMP-NOT-CHG-ONLY-88 VALUE 'N'. DTSCS1A 00403 DTSCS1A 00404 05 WRK-MFAE-IND PIC X(01). DTSCS1A 00405 88 WRK-MFAE-YES-88 VALUE 'Y'. DTSCS1A 00406 88 WRK-MFAE-NO-88 VALUE 'N'. DTSCS1A 00407 DTSCS1A 00408 05 WRK-MPRF-IND PIC X(01). DTSCS1A 00409 88 WRK-MPRF-YES-88 VALUE 'Y'. DTSCS1A 00410 88 WRK-MPRF-NO-88 VALUE 'N'. DTSCS1A 00411 DTSCS1A 00412 05 WRK-MERA-IND PIC X(01). DTSCS1A 00413 88 WRK-MERA-YES-88 VALUE 'Y'. DTSCS1A 00414 88 WRK-MERA-NO-88 VALUE 'N'. DTSCS1A 00415 DTSCS1A 00416 05 WRK-UPD-MERA-IND PIC X(01). DTSCS1A 00417 88 WRK-UPD-MERA-YES-88 VALUE 'Y'. DTSCS1A 00418 88 WRK-UPD-MERA-NO-88 VALUE 'N'. DTSCS1A 00419 DTSCS1A 00420 05 WRK-MTAD-IND PIC X(01). DTSCS1A 00421 88 WRK-MTAD-YES-88 VALUE 'Y'. DTSCS1A 00422 88 WRK-MTAD-NO-88 VALUE 'N'. DTSCS1A 00423 DTSCS1A 00424 05 WRK-FISC-AGNT-ERROR-IND PIC X(01). DTSCS1A 00425 88 WRK-FISC-AGNT-ERROR-YES-88 VALUE 'Y'. DTSCS1A 00426 88 WRK-FISC-AGNT-ERROR-NO-88 VALUE 'N'. DTSCS1A 00427 DTSCS1A 00428 05 WRK-VALID-SOURCE-CD-IND PIC X(01). DTSCS1A 00429 88 WRK-VALID-SOURCE-CD-YES VALUE 'Y'. DTSCS1A 00430 88 WRK-VALID-SOURCE-CD-NO VALUE 'N'. DTSCS1A 00431 DTSCS1A 00432 05 WRK-NEXT-EMP-NO-FOUND-IND PIC X(01). DTSCS1A 00433 88 WRK-NEXT-EMP-NO-FOUND-NO-88 VALUE 'N'. DTSCS1A 00434 88 WRK-NEXT-EMP-NO-FOUND-YES-88 VALUE 'Y'. DTSCS1A 00435 DTSCS1A 00436 05 WRK-EMP-NO-UNUSED-IND PIC X(01). DTSCS1A 00437 88 WRK-EMP-NO-UNUSED-NO-88 VALUE 'N'. DTSCS1A 00438 88 WRK-EMP-NO-UNUSED-YES-88 VALUE 'Y'. DTSCS1A 00439 DTSCS1A 00440 05 WRK-DC-ADDR-IND PIC X(01). DTSCS1A 00441 88 WRK-DC-ADDR-YES-88 VALUE 'Y'. DTSCS1A 00442 88 WRK-DC-ADDR-NO-88 VALUE 'N'. DTSCS1A 00443 05 WRK-PO-BOX-IND PIC X(01). DTSCS1A 00444 88 WRK-PO-BOX-YES-88 VALUE 'Y'. DTSCS1A 00445 88 WRK-PO-BOX-NO-88 VALUE 'N'. DTSCS1A 00446 DTSCS1A 00447 05 WRK-FR500-RCVD-DATE PIC S9(09) COMP-3 DTSCS1A 00448 VALUE +0. DTSCS1A 00449 DTSCS1A 00450 05 WRK-MSG-AREA. DTSCS1A 00451 10 WRK-MSG-ID PIC X(04). DTSCS1A 00452 10 WRK-MSG-FILLER PIC X(60). DTSCS1A 00453 DTSCS1A 00454 05 WRK-ATB-AN PIC X(01). DTSCS1A 00455 DTSCS1A 00456 05 WRK-ATB-NUM PIC X(01). DTSCS1A 00457 DTSCS1A 00458 05 WRK-NAME PIC X(40). DTSCS1A 00459 DTSCS1A 00460 05 WRK-DISPLAY PIC 9(11). DTSCS1A 00461 DTSCS1A 00462 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A 00463 10 FILLER PIC X(05). DTSCS1A 00464 10 WRK-DISPLAY-EMP-NO-1 PIC X(03). DTSCS1A 00465 10 WRK-DISPLAY-EMP-NO-2 PIC X(03). DTSCS1A 00466 DTSCS1A 00467 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A 00468 10 FILLER PIC X(05). DTSCS1A 00469 10 WRK-DISPLAY-YR PIC X(02). DTSCS1A 00470 10 WRK-DISPLAY-MO PIC X(02). DTSCS1A 00471 10 WRK-DISPLAY-DA PIC X(02). DTSCS1A 00472 DTSCS1A 00473 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A 00474 10 FILLER PIC X(02). DTSCS1A 00475 10 WRK-DISPLAY-FEIN-1 PIC X(02). DTSCS1A 00476 10 WRK-DISPLAY-FEIN-2 PIC X(07). DTSCS1A 00477 DTSCS1A 00478 05 FILLER REDEFINES WRK-DISPLAY. DTSCS1A 00479 10 FILLER PIC X(02). DTSCS1A 00480 10 WRK-DISPLAY-SSN-1 PIC X(03). DTSCS1A 00481 10 WRK-DISPLAY-SSN-2 PIC X(02). DTSCS1A 00482 10 WRK-DISPLAY-SSN-3 PIC X(04). DTSCS1A 00483 DTSCS1A 00484 DTSCS1A 00485 05 HOLD-ATTRB-AREA. DTSCS1A 00486 10 HOLD-ATTN-LINE-A PIC X(01). DTSCS1A 00487 10 HOLD-DELIV-LINE-1-A PIC X(01). DTSCS1A 00488 10 HOLD-DELIV-LINE-2-A PIC X(01). DTSCS1A 00489 10 HOLD-CITY-A PIC X(01). DTSCS1A 00490 10 HOLD-ST-A PIC X(01). DTSCS1A 00491 10 HOLD-ZIP-A PIC X(01). DTSCS1A 00492 EJECT DTSCS1A 00493 01 MSG-LITERALS. DTSCS1A 00494 05 MSG-E1A1-AREA. DTSCS1A 00495 10 FILLER PIC X(04) VALUE 'E1A1'. DTSCS1A 00496 10 FILLER PIC X(30) DTSCS1A 00497 VALUE 'DELETE NOT ALLOWED FOR THIS EM'. DTSCS1A 00498 10 FILLER PIC X(30) DTSCS1A 00499 VALUE 'PLOYER '. DTSCS1A 00500 DTSCS1A 00501 05 MSG-E1A2-AREA. DTSCS1A 00502 10 FILLER PIC X(04) VALUE 'E1A2'. DTSCS1A 00503 10 FILLER PIC X(30) DTSCS1A 00504 VALUE 'NOT ALLOWED - PRIMARY NAME IS '. DTSCS1A 00505 10 FILLER PIC X(30) DTSCS1A 00506 VALUE 'ENTITY NAME '. DTSCS1A 00507 DTSCS1A 00508 05 MSG-E1A3-AREA. DTSCS1A 00509 10 FILLER PIC X(04) VALUE 'E1A3'. DTSCS1A 00510 10 FILLER PIC X(30) DTSCS1A 00511 VALUE 'NOT ALLOWED - PRIMARY AND ENTI'. DTSCS1A 00512 10 FILLER PIC X(30) DTSCS1A 00513 VALUE 'TY NAMES CANNOT BE IDENTICAL '. DTSCS1A 00514 DTSCS1A 00515 05 MSG-E1A4-AREA. DTSCS1A 00516 10 FILLER PIC X(04) VALUE 'E1A4'. DTSCS1A 00517 10 FILLER PIC X(30) DTSCS1A 00518 VALUE 'NOT ALLOWED - INITIAL HOUSEHOL'. DTSCS1A 00519 10 FILLER PIC X(30) DTSCS1A 00520 VALUE 'D NOTICES ALREADY SENT '. DTSCS1A 00521 DTSCS1A 00522 05 MSG-E1A5-AREA. DTSCS1A 00523 10 FILLER PIC X(04) VALUE 'E1A5'. DTSCS1A 00524 10 FILLER PIC X(30) DTSCS1A 00525 VALUE 'NOT ALLOWED - DETERMINATION CO'. DTSCS1A 00526 10 FILLER PIC X(30) DTSCS1A 00527 VALUE 'MPLETE '. DTSCS1A 00528 DTSCS1A 00529 05 MSG-E1A6-AREA. DTSCS1A 00530 10 FILLER PIC X(04) VALUE 'E1A6'. DTSCS1A 00531 10 FILLER PIC X(60) VALUE DTSCS1A 00532 'DUPLICATE NAME - VERIFY TO CONTINUE. '. DTSCS1A 00533 DTSCS1A 00534 05 MSG-E1A7-AREA. DTSCS1A 00535 10 FILLER PIC X(04) VALUE 'E1A7'. DTSCS1A 00536 10 FILLER PIC X(50) VALUE DTSCS1A 00537 'NO DC ADDRESS - VERIFY TO CONTINUE. '. DTSCS1A 00538 DTSCS1A 00539 05 MSG-E1A8-AREA. DTSCS1A 00540 10 FILLER PIC X(04) VALUE 'E1A8'. DTSCS1A 00541 10 FILLER PIC X(50) VALUE DTSCS1A 00542 'PO BOX - VERIFY TO CONTINUE. '. DTSCS1A 00543 DTSCS1A 00544 05 MSG-SUCCESSFUL-ADD-TEXT. DTSCS1A 00545 10 FILLER PIC X(17) DTSCS1A 00546 VALUE 'EMPLOYER ACCOUNT '. DTSCS1A 00547 10 MSG-EMP-NO-1 PIC X(03). DTSCS1A 00548 10 FILLER PIC X(01) VALUE ' '. DTSCS1A 00549 10 MSG-EMP-NO-2 PIC X(03). DTSCS1A 00550 10 FILLER PIC X(19) DTSCS1A 00551 VALUE ' SUCCESSFULLY ADDED'. DTSCS1A 00552 EJECT DTSCS1A 00553 01 L001-COMM-AREA. DTSCS1A 00554 ++INCLUDE DTSIL001 DTSCS1A 00555 EJECT DTSCS1A 00556 01 L015-COMM-AREA. DTSCS1A 00557 ++INCLUDE DTSIL015 DTSCS1A 00558 EJECT DTSCS1A 00559 01 L017-COMM-AREA. DTSCS1A 00560 ++INCLUDE DTSIL017 DTSCS1A 00561 EJECT DTSCS1A 00562 01 L018-COMM-AREA. DTSCS1A 00563 ++INCLUDE DTSIL018 DTSCS1A 00564 EJECT DTSCS1A 00565 01 L020-COMM-AREA. DTSCS1A 00566 ++INCLUDE DTSIL020 DTSCS1A 00567 EJECT DTSCS1A 00568 01 L021-COMM-AREA. DTSCS1A 00569 ++INCLUDE DTSIL021 DTSCS1A 00570 EJECT DTSCS1A 00571 01 L031-COMM-AREA. DTSCS1A 00572 ++INCLUDE DTSIL031 DTSCS1A 00573 EJECT DTSCS1A 00574 01 L061-COMM-AREA. DTSCS1A 00575 ++INCLUDE DTSIL061 DTSCS1A 00576 EJECT DTSCS1A 00577 01 L062-COMM-AREA. DTSCS1A 00578 ++INCLUDE DTSIL062 DTSCS1A 00579 EJECT DTSCS1A 00580 01 L071-COMM-AREA. DTSCS1A 00581 ++INCLUDE DTSIL071 DTSCS1A 00582 EJECT DTSCS1A 00583 01 L072-COMM-AREA. DTSCS1A 00584 ++INCLUDE DTSIL072 DTSCS1A 00585 EJECT DTSCS1A 00586 01 L073-COMM-AREA. DTSCS1A 00587 ++INCLUDE DTSIL073 DTSCS1A 00588 EJECT DTSCS1A 00589 01 L074-COMM-AREA. DTSCS1A 00590 ++INCLUDE DTSIL074 DTSCS1A 00591 EJECT DTSCS1A 00592 01 L081-COMM-AREA. DTSCS1A 00593 ++INCLUDE DTSIL081 DTSCS1A 00594 EJECT DTSCS1A 00595 01 L082-COMM-AREA. DTSCS1A 00596 ++INCLUDE DTSIL082 DTSCS1A 00597 EJECT DTSCS1A 00598 01 L203-COMM-AREA. DTSCS1A 00599 ++INCLUDE DTSIL203 DTSCS1A 00600 EJECT DTSCS1A 00601 01 L221-COMM-AREA. DTSCS1A 00602 ++INCLUDE DTSIL221 DTSCS1A 00603 EJECT DTSCS1A 00604 01 L331-COMM-AREA. DTSCS1A 00605 ++INCLUDE DTSIL331 DTSCS1A 00606 EJECT DTSCS1A 00607 01 L400-COMM-AREA. DTSCS1A 00608 ++INCLUDE DTSIL400 DTSCS1A 00609 EJECT DTSCS1A 00610 01 L805-COMM-AREA. DTSCS1A 00611 ++INCLUDE DTSIL805 DTSCS1A 00612 EJECT DTSCS1A 00613 01 L810-COMM-AREA. DTSCS1A 00614 05 L810-CONTROL-BLOCK. DTSCS1A 00615 ++INCLUDE DTSIL810 DTSCS1A 00616 EJECT DTSCS1A 00617 05 MSKL-REC. DTSCS1A 00618 ++INCLUDE DTSIMSKL DTSCS1A 00619 EJECT DTSCS1A 00620 01 L831-COMM-AREA. DTSCS1A 00621 05 L831-CONTROL-BLOCK. DTSCS1A 00622 ++INCLUDE DTSIL831 DTSCS1A 00623 EJECT DTSCS1A 00624 05 FSKL-REC. DTSCS1A 00625 ++INCLUDE DTSIFSKL DTSCS1A 00626 EJECT DTSCS1A 00627 05 MFAE-REC. DTSCS1A 00628 ++INCLUDE DTSIMFAE DTSCS1A 00629 EJECT DTSCS1A 00630 05 FFIS-REC. DTSCS1A 00631 ++INCLUDE DTSIFFIS DTSCS1A 00632 EJECT DTSCS1A 00633 01 MHDR-REC. DTSCS1A 00634 ++INCLUDE DTSIMHDR DTSCS1A 00635 EJECT DTSCS1A 00636 01 MPRF-REC. DTSCS1A 00637 ++INCLUDE DTSIMPRF DTSCS1A 00638 EJECT DTSCS1A 00639 01 MERA-REC. DTSCS1A 00640 ++INCLUDE DTSIMERA DTSCS1A 00641 EJECT DTSCS1A 00642 01 MTAD-REC. DTSCS1A 00643 ++INCLUDE DTSIMTAD DTSCS1A 00644 EJECT DTSCS1A 00645 01 MTCK-REC. DTSCS1A 00646 ++INCLUDE DTSIMTCK DTSCS1A 00647 EJECT DTSCS1A 00648 01 MEVL-REC. DTSCS1A 00649 ++INCLUDE DTSIMEVL DTSCS1A 00650 EJECT DTSCS1A 00651 01 L821-COMM-AREA. DTSCS1A 00652 05 L821-CONTROL-BLOCK. DTSCS1A 00653 ++INCLUDE DTSIL821 DTSCS1A 00654 SKIP3 DTSCS1A 00655 05 ISKL-REC. DTSCS1A 00656 ++INCLUDE DTSIISKL DTSCS1A 00657 DTSCS1A 00658 01 IBTB-REC. DTSCS1A 00659 ++INCLUDE DTSIIBTB DTSCS1A 00660 DTSCS1A 00661 * MAP DEFINITION DTSCS1A 00662 01 L851-COMM-AREA. DTSCS1A 00663 ++INCLUDE DTSIL851 DTSCS1A 00664 SKIP3 DTSCS1A 00665 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS1A 00666 ++INCLUDE DTSIS1A DTSCS1A 00667 EJECT DTSCS1A 00668 01 CATB-LITERALS. DTSCS1A 00669 ++INCLUDE DTSICATB DTSCS1A 00670 SKIP3 DTSCS1A 00671 01 CFKD-LITERALS. DTSCS1A 00672 ++INCLUDE DTSICFKD DTSCS1A 00673 SKIP3 DTSCS1A 00674 01 CECD-LITERALS. DTSCS1A 00675 ++INCLUDE DTSICECD DTSCS1A 00676 SKIP3 DTSCS1A 00677 01 CPCD-LITERALS. DTSCS1A 00678 ++INCLUDE DTSICPCD DTSCS1A 00679 EJECT DTSCS1A 00680 01 MLEN-LITERALS. DTSCS1A 00681 ++INCLUDE DTSIMLEN DTSCS1A 00682 EJECT DTSCS1A 00683 01 CENO-LITERALS. DTSCS1A 00684 ++INCLUDE DTSICENO DTSCS1A 00685 EJECT DTSCS1A 00686 LINKAGE SECTION. DTSCS1A 00687 SKIP3 DTSCS1A 00688 01 DFHCOMMAREA. DTSCS1A 00689 ++INCLUDE DTSILCCM DTSCS1A 00690 SKIP3 DTSCS1A 00691 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS1A 00692 20 LCCM-HOLD-ADDRESS-1 PIC X(171). DTSCS1A 00693 EJECT DTSCS1A 00694 PROCEDURE DIVISION. DTSCS1A 00695 SKIP2 DTSCS1A 00696 MOVE +0 TO WRK-EMP-NO DTSCS1A 00697 WRK-HOLD-EMP-NO. DTSCS1A 00698 DTSCS1A 00699 SET WRK-EMP-NOT-CHG-ONLY-88 TO TRUE. DTSCS1A 00700 DTSCS1A 00701 SET WRK-MPRF-NO-88 TO TRUE. DTSCS1A 00702 DTSCS1A 00703 SET WRK-MERA-NO-88 TO TRUE. DTSCS1A 00704 DTSCS1A 00705 SET WRK-MTAD-NO-88 TO TRUE. DTSCS1A 00706 DTSCS1A 00707 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A 00708 DTSCS1A 00709 SET CURSOR-SET-NO TO TRUE. DTSCS1A 00710 DTSCS1A 00711 SET SCR-ACCESS-INQ TO TRUE. DTSCS1A 00712 DTSCS1A 00713 PERFORM P0100-ACCESS-SEARCH THRU P0100-EXIT DTSCS1A 00714 VARYING LCCM-NONUM-IDX FROM 1 BY 1 DTSCS1A 00715 UNTIL LCCM-NONUM-IDX > LCCM-SCR-NONUM-CNT. DTSCS1A 00716 DTSCS1A 00717 DTSCS1A 00718 MOVE SPACE TO REQ-IND. DTSCS1A 00719 DTSCS1A 00720 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS1A 00721 DTSCS1A 00722 DTSCS1A 00723 *----------------------------------------------------- DTSCS1A 00724 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS1A 00725 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS1A 00726 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS1A 00727 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS1A 00728 * DTSCS1A 00729 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS1A 00730 * PROCESSED. DTSCS1A 00731 * DTSCS1A 00732 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS1A 00733 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS1A 00734 * WORK STATION OPERATOR. DTSCS1A 00735 *----------------------------------------------------- DTSCS1A 00736 DTSCS1A 00737 MOVE SPACE TO RESP-IND. DTSCS1A 00738 DTSCS1A 00739 IF REQ-ERROR DTSCS1A 00740 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS1A 00741 ELSE DTSCS1A 00742 IF REQ-JUMP DTSCS1A 00743 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS1A 00744 ELSE DTSCS1A 00745 IF REQ-CLEAR DTSCS1A 00746 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS1A 00747 ELSE DTSCS1A 00748 IF REQ-CURSOR-TO-GOTO DTSCS1A 00749 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS1A 00750 ELSE DTSCS1A 00751 IF REQ-INQUIRE DTSCS1A 00752 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS1A 00753 ELSE DTSCS1A 00754 IF REQ-EDIT DTSCS1A 00755 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS1A 00756 ELSE DTSCS1A 00757 IF REQ-UPDATE DTSCS1A 00758 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS1A 00759 ELSE DTSCS1A 00760 GO TO S899-ABEND. DTSCS1A 00761 DTSCS1A 00762 DTSCS1A 00763 *----------------------------------------------------- DTSCS1A 00764 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS1A 00765 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS1A 00766 *----------------------------------------------------- DTSCS1A 00767 DTSCS1A 00768 IF RESP-SEND-MAP DTSCS1A 00769 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS1A 00770 SET LCCM-END-TASK-88 TO TRUE DTSCS1A 00771 ELSE DTSCS1A 00772 IF RESP-SEND-MSGONLY DTSCS1A 00773 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS1A 00774 SET LCCM-END-TASK-88 TO TRUE DTSCS1A 00775 ELSE DTSCS1A 00776 IF RESP-JUMP DTSCS1A 00777 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 00778 ELSE DTSCS1A 00779 IF RESP-CURSOR-TO-GOTO DTSCS1A 00780 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS1A 00781 SET LCCM-END-TASK-88 TO TRUE DTSCS1A 00782 ELSE DTSCS1A 00783 GO TO S899-ABEND. DTSCS1A 00784 DTSCS1A 00785 DTSCS1A 00786 MAINLINE-EXIT. DTSCS1A 00787 DTSCS1A 00788 EXEC CICS DTSCS1A 00789 RETURN DTSCS1A 00790 END-EXEC. DTSCS1A 00791 DTSCS1A 00792 GOBACK. DTSCS1A 00793 EJECT DTSCS1A 00794 P0100-ACCESS-SEARCH. DTSCS1A 00795 IF LCCM-SCR-NONUM-ID (LCCM-NONUM-IDX) = WRK-SCR-ID DTSCS1A 00796 MOVE LCCM-SCR-NONUM-ACCESS-IND (LCCM-NONUM-IDX) DTSCS1A 00797 TO SCR-ACCESS-IND. DTSCS1A 00798 P0100-EXIT. DTSCS1A 00799 EXIT. DTSCS1A 00800 /*****************************************************************DTSCS1A 00801 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS1A 00802 ******************************************************************DTSCS1A 00803 P1000-ANALYZE-REQUEST. DTSCS1A 00804 DTSCS1A 00805 *----------------------------------------------------- DTSCS1A 00806 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS1A 00807 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS1A 00808 * REPLACED WITH ENTER) DTSCS1A 00809 *----------------------------------------------------- DTSCS1A 00810 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS1A 00811 SET LCCM-ENTER-88 TO TRUE DTSCS1A 00812 SET REQ-INQUIRE TO TRUE DTSCS1A 00813 IF LCCM-EMP-NO > ZERO DTSCS1A 00814 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS1A 00815 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS1A 00816 END-IF DTSCS1A 00817 GO TO P1000-EXIT. DTSCS1A 00818 DTSCS1A 00819 DTSCS1A 00820 *----------------------------------------------------- DTSCS1A 00821 * MAP IS RECEIVED DTSCS1A 00822 *----------------------------------------------------- DTSCS1A 00823 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS1A 00824 DTSCS1A 00825 DTSCS1A 00826 *----------------------------------------------------- DTSCS1A 00827 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS1A 00828 * WORK STATION DTSCS1A 00829 *----------------------------------------------------- DTSCS1A 00830 IF LCCM-CLEAR-88 DTSCS1A 00831 SET REQ-CLEAR TO TRUE DTSCS1A 00832 GO TO P1000-EXIT. DTSCS1A 00833 DTSCS1A 00834 DTSCS1A 00835 *----------------------------------------------------- DTSCS1A 00836 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS1A 00837 *----------------------------------------------------- DTSCS1A 00838 IF LCCM-SCR-UPDATE-LOCKED DTSCS1A 00839 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS1A 00840 GO TO P1000-EXIT. DTSCS1A 00841 DTSCS1A 00842 DTSCS1A 00843 *----------------------------------------------------- DTSCS1A 00844 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS1A 00845 *----------------------------------------------------- DTSCS1A 00846 IF LCCM-PA2-88 DTSCS1A 00847 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS1A 00848 GO TO P1000-EXIT. DTSCS1A 00849 DTSCS1A 00850 DTSCS1A 00851 *----------------------------------------------------- DTSCS1A 00852 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS1A 00853 *----------------------------------------------------- DTSCS1A 00854 IF LCCM-PA-88 DTSCS1A 00855 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS1A 00856 SET REQ-ERROR TO TRUE DTSCS1A 00857 GO TO P1000-EXIT. DTSCS1A 00858 DTSCS1A 00859 DTSCS1A 00860 *----------------------------------------------------- DTSCS1A 00861 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS1A 00862 * REQUES TO CLEAR THE SCREEN. DTSCS1A 00863 *----------------------------------------------------- DTSCS1A 00864 IF LCCM-F12-88 DTSCS1A 00865 MOVE LOW-VALUES TO MAP-AREA DTSCS1A 00866 SET REQ-CLEAR TO TRUE DTSCS1A 00867 GO TO P1000-EXIT. DTSCS1A 00868 DTSCS1A 00869 DTSCS1A 00870 *----------------------------------------------------- DTSCS1A 00871 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS1A 00872 *----------------------------------------------------- DTSCS1A 00873 IF LCCM-F03-88 DTSCS1A 00874 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1A 00875 SET REQ-JUMP TO TRUE DTSCS1A 00876 GO TO P1000-EXIT. DTSCS1A 00877 DTSCS1A 00878 DTSCS1A 00879 *----------------------------------------------------- DTSCS1A 00880 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS1A 00881 *----------------------------------------------------- DTSCS1A 00882 IF LCCM-F04-88 DTSCS1A 00883 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1A 00884 SET REQ-JUMP TO TRUE DTSCS1A 00885 GO TO P1000-EXIT. DTSCS1A 00886 DTSCS1A 00887 DTSCS1A 00888 *----------------------------------------------------- DTSCS1A 00889 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS1A 00890 * CORRESPONDENCE SCREEN DTSCS1A 00891 *----------------------------------------------------- DTSCS1A 00892 IF LCCM-F14-88 DTSCS1A 00893 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS1A 00894 SET REQ-JUMP TO TRUE DTSCS1A 00895 GO TO P1000-EXIT. DTSCS1A 00896 DTSCS1A 00897 DTSCS1A 00898 *----------------------------------------------------- DTSCS1A 00899 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS1A 00900 * REQUESTED SCREEN TYPE DTSCS1A 00901 *----------------------------------------------------- DTSCS1A 00902 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS1A 00903 NEXT SENTENCE DTSCS1A 00904 ELSE DTSCS1A 00905 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS1A 00906 SET REQ-JUMP TO TRUE DTSCS1A 00907 GO TO P1000-EXIT. DTSCS1A 00908 DTSCS1A 00909 DTSCS1A 00910 *----------------------------------------------------- DTSCS1A 00911 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS1A 00912 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS1A 00913 *----------------------------------------------------- DTSCS1A 00914 IF LCCM-F09-88 OR LCCM-F10-88 OR LCCM-F23-88 DTSCS1A 00915 IF SCR-ACCESS-UPDATE DTSCS1A 00916 SET REQ-EDIT TO TRUE DTSCS1A 00917 GO TO P1000-EXIT DTSCS1A 00918 ELSE DTSCS1A 00919 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS1A 00920 SET REQ-ERROR TO TRUE DTSCS1A 00921 GO TO P1000-EXIT. DTSCS1A 00922 DTSCS1A 00923 DTSCS1A 00924 *----------------------------------------------------- DTSCS1A 00925 * IF INQUIRY TYPE KEY PRESSED (ENTER), INDICATE DTSCS1A 00926 * INQUIRY REQUEST DTSCS1A 00927 *----------------------------------------------------- DTSCS1A 00928 IF LCCM-ENTER-88 DTSCS1A 00929 SET REQ-INQUIRE TO TRUE DTSCS1A 00930 GO TO P1000-EXIT. DTSCS1A 00931 DTSCS1A 00932 DTSCS1A 00933 *----------------------------------------------------- DTSCS1A 00934 * ANY OTHER KEY IS INVALID DTSCS1A 00935 *----------------------------------------------------- DTSCS1A 00936 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS1A 00937 DTSCS1A 00938 SET REQ-ERROR TO TRUE. DTSCS1A 00939 P1000-EXIT. DTSCS1A 00940 EXIT. DTSCS1A 00941 SKIP3 DTSCS1A 00942 ******************************************************************DTSCS1A 00943 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS1A 00944 ******************************************************************DTSCS1A 00945 DTSCS1A 00946 P1100-UPDATE-LOCKED. DTSCS1A 00947 *----------------------------------------------------- DTSCS1A 00948 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS1A 00949 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS1A 00950 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS1A 00951 *----------------------------------------------------- DTSCS1A 00952 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS1A 00953 SET REQ-UPDATE TO TRUE DTSCS1A 00954 ELSE DTSCS1A 00955 SET REQ-ERROR TO TRUE DTSCS1A 00956 IF LCCM-SCR-ADD-LOCKED DTSCS1A 00957 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS1A 00958 ELSE DTSCS1A 00959 IF LCCM-SCR-MOD-LOCKED DTSCS1A 00960 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS1A 00961 ELSE DTSCS1A 00962 IF LCCM-SCR-DEL-LOCKED DTSCS1A 00963 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS1A 00964 ELSE DTSCS1A 00965 GO TO S899-ABEND. DTSCS1A 00966 P1100-EXIT. DTSCS1A 00967 EXIT. DTSCS1A 00968 /*****************************************************************DTSCS1A 00969 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS1A 00970 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS1A 00971 ******************************************************************DTSCS1A 00972 DTSCS1A 00973 P2000-REQUEST-ERROR. DTSCS1A 00974 IF LCCM-MSG DTSCS1A 00975 SET RESP-SEND-MSGONLY TO TRUE DTSCS1A 00976 ELSE DTSCS1A 00977 GO TO S899-ABEND. DTSCS1A 00978 P2000-EXIT. DTSCS1A 00979 EXIT. DTSCS1A 00980 /*****************************************************************DTSCS1A 00981 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS1A 00982 ******************************************************************DTSCS1A 00983 DTSCS1A 00984 P3000-REQUEST-JUMP. DTSCS1A 00985 *----------------------------------------------------- DTSCS1A 00986 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS1A 00987 * BY USER DTSCS1A 00988 *----------------------------------------------------- DTSCS1A 00989 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS1A 00990 DTSCS1A 00991 DTSCS1A 00992 *----------------------------------------------------- DTSCS1A 00993 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS1A 00994 *----------------------------------------------------- DTSCS1A 00995 IF LCCM-MSG DTSCS1A 00996 SET RESP-SEND-MSGONLY TO TRUE DTSCS1A 00997 SET CURSOR-SET-GOTO TO TRUE DTSCS1A 00998 GO TO P3000-EXIT. DTSCS1A 00999 DTSCS1A 01000 DTSCS1A 01001 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 01002 DTSCS1A 01003 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A 01004 DTSCS1A 01005 IF L018-VALID DTSCS1A 01006 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS1A 01007 DTSCS1A 01008 DTSCS1A 01009 *----------------------------------------------------- DTSCS1A 01010 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS1A 01011 *----------------------------------------------------- DTSCS1A 01012 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS1A 01013 LCCM-SCR-HOLD-AREA. DTSCS1A 01014 DTSCS1A 01015 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS1A 01016 DTSCS1A 01017 SET RESP-JUMP TO TRUE. DTSCS1A 01018 P3000-EXIT. DTSCS1A 01019 EXIT. DTSCS1A 01020 /*****************************************************************DTSCS1A 01021 * CLEAR KEY WAS PRESSED *DTSCS1A 01022 ******************************************************************DTSCS1A 01023 DTSCS1A 01024 P4000-REQUEST-CLEAR. DTSCS1A 01025 IF SCR-ACCESS-UPDATE DTSCS1A 01026 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS1A 01027 ELSE DTSCS1A 01028 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS1A 01029 DTSCS1A 01030 DTSCS1A 01031 *----------------------------------------------------- DTSCS1A 01032 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS1A 01033 * FIELDS FROM EARLIER REQUESTS DTSCS1A 01034 *----------------------------------------------------- DTSCS1A 01035 IF LCCM-EMP-NO > ZERO DTSCS1A 01036 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS1A 01037 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS1A 01038 DTSCS1A 01039 MOVE ZERO TO LCCM-EMP-NO. DTSCS1A 01040 DTSCS1A 01041 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS1A 01042 DTSCS1A 01043 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A 01044 DTSCS1A 01045 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1A 01046 DTSCS1A 01047 SET RESP-SEND-MAP TO TRUE. DTSCS1A 01048 P4000-EXIT. DTSCS1A 01049 EXIT. DTSCS1A 01050 /*****************************************************************DTSCS1A 01051 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS1A 01052 ******************************************************************DTSCS1A 01053 DTSCS1A 01054 P5000-CURSOR-TO-GOTO. DTSCS1A 01055 SET CURSOR-SET-GOTO TO TRUE. DTSCS1A 01056 DTSCS1A 01057 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS1A 01058 P5000-EXIT. DTSCS1A 01059 EXIT. DTSCS1A 01060 /*****************************************************************DTSCS1A 01061 * INQUIRY WAS REQUESTED *DTSCS1A 01062 ******************************************************************DTSCS1A 01063 DTSCS1A 01064 P6000-REQUEST-INQUIRE. DTSCS1A 01065 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 01066 DTSCS1A 01067 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A 01068 DTSCS1A 01069 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS1A 01070 DTSCS1A 01071 IF SCR-ACCESS-UPDATE DTSCS1A 01072 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS1A 01073 ELSE DTSCS1A 01074 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS1A 01075 DTSCS1A 01076 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1A 01077 DTSCS1A 01078 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A 01079 DTSCS1A 01080 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A 01081 DTSCS1A 01082 IF LCCM-MSG DTSCS1A 01083 NEXT SENTENCE DTSCS1A 01084 ELSE DTSCS1A 01085 IF LCCM-ENTER-88 DTSCS1A 01086 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS1A 01087 ELSE DTSCS1A 01088 GO TO S899-ABEND. DTSCS1A 01089 DTSCS1A 01090 SET RESP-SEND-MAP TO TRUE. DTSCS1A 01091 P6000-EXIT. DTSCS1A 01092 EXIT. DTSCS1A 01093 EJECT DTSCS1A 01094 P6100-NO-PAGE. DTSCS1A 01095 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A 01096 DTSCS1A 01097 IF LCCM-MSG DTSCS1A 01098 GO TO P6100-EXIT. DTSCS1A 01099 DTSCS1A 01100 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS1A 01101 P6100-EXIT. DTSCS1A 01102 EXIT. DTSCS1A 01103 /*****************************************************************DTSCS1A 01104 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS1A 01105 ******************************************************************DTSCS1A 01106 DTSCS1A 01107 P6900-CONSTRUCT-SCREEN. DTSCS1A 01108 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCS1A 01109 DTSCS1A 01110 PERFORM P6920-FROM-MTAD THRU P6920-EXIT. DTSCS1A 01111 DTSCS1A 01112 PERFORM P6930-FROM-MERA THRU P6930-EXIT. DTSCS1A 01113 DTSCS1A 01114 PERFORM P6940-FROM-MFAE THRU P6940-EXIT. DTSCS1A 01115 DTSCS1A 01116 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1A 01117 DTSCS1A 01118 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS1A 01119 P6900-EXIT. DTSCS1A 01120 EXIT. DTSCS1A 01121 SKIP3 DTSCS1A 01122 P6910-FROM-MPRF. DTSCS1A 01123 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS1A 01124 DTSCS1A 01125 MOVE MPRF-ENTITY-NAME-IND TO MAP-ENTITY-NAME-IND. DTSCS1A 01126 DTSCS1A 01127 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. DTSCS1A 01128 DTSCS1A 01129 IF MPRF-FEIN > 0 DTSCS1A 01130 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS1A 01131 MOVE WRK-DISPLAY-FEIN-1 TO MAP-FEIN-1 DTSCS1A 01132 MOVE WRK-DISPLAY-FEIN-2 TO MAP-FEIN-2. DTSCS1A 01133 P6910-EXIT. DTSCS1A 01134 EXIT. DTSCS1A 01135 SKIP3 DTSCS1A 01136 P6920-FROM-MTAD. DTSCS1A 01137 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS1A 01138 DTSCS1A 01139 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A 01140 DTSCS1A 01141 SET MTAD-TAD-88 TO TRUE. DTSCS1A 01142 DTSCS1A 01143 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS1A 01144 DTSCS1A 01145 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 01146 DTSCS1A 01147 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 01148 DTSCS1A 01149 IF L810-NO-REC-88 DTSCS1A 01150 GO TO P6920-EXIT. DTSCS1A 01151 DTSCS1A 01152 MOVE MSKL-REC TO MTAD-REC. DTSCS1A 01153 DTSCS1A 01154 MOVE MTAD-ATTN-LINE TO MAP-ATTN-LINE. DTSCS1A 01155 DTSCS1A 01156 MOVE MTAD-DELIV-LINE-1 TO MAP-DELIV-LINE-1. DTSCS1A 01157 DTSCS1A 01158 MOVE MTAD-DELIV-LINE-2 TO MAP-DELIV-LINE-2. DTSCS1A 01159 DTSCS1A 01160 MOVE MTAD-CITY TO MAP-CITY. DTSCS1A 01161 DTSCS1A 01162 MOVE MTAD-ST TO MAP-ST. DTSCS1A 01163 DTSCS1A 01164 MOVE MTAD-ZIP TO MAP-ZIP. DTSCS1A 01165 DTSCS1A 01166 IF MTAD-VOICE-1 NOT = SPACES DTSCS1A 01167 MOVE MTAD-VOICE-1-AREA-CD TO MAP-VOICE-1-AREA-CD DTSCS1A 01168 MOVE MTAD-VOICE-1-PREFIX TO MAP-VOICE-1-PREFIX DTSCS1A 01169 MOVE MTAD-VOICE-1-SUFFIX TO MAP-VOICE-1-SUFFIX DTSCS1A 01170 MOVE MTAD-VOICE-1-EXT TO MAP-VOICE-1-EXT. DTSCS1A 01171 DTSCS1A 01172 IF MTAD-VOICE-2 NOT = SPACES DTSCS1A 01173 MOVE MTAD-VOICE-2-AREA-CD TO MAP-VOICE-2-AREA-CD DTSCS1A 01174 MOVE MTAD-VOICE-2-PREFIX TO MAP-VOICE-2-PREFIX DTSCS1A 01175 MOVE MTAD-VOICE-2-SUFFIX TO MAP-VOICE-2-SUFFIX DTSCS1A 01176 MOVE MTAD-VOICE-2-EXT TO MAP-VOICE-2-EXT. DTSCS1A 01177 DTSCS1A 01178 IF MTAD-FAX NOT = SPACES DTSCS1A 01179 MOVE MTAD-FAX-AREA-CD TO MAP-FAX-AREA-CD DTSCS1A 01180 MOVE MTAD-FAX-PREFIX TO MAP-FAX-PREFIX DTSCS1A 01181 MOVE MTAD-FAX-SUFFIX TO MAP-FAX-SUFFIX DTSCS1A 01182 MOVE MTAD-FAX-EXT TO MAP-FAX-EXT. DTSCS1A 01183 P6920-EXIT. DTSCS1A 01184 EXIT. DTSCS1A 01185 SKIP3 DTSCS1A 01186 P6930-FROM-MERA. DTSCS1A 01187 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A 01188 DTSCS1A 01189 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A 01190 DTSCS1A 01191 SET MERA-ERA-88 TO TRUE. DTSCS1A 01192 DTSCS1A 01193 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 01194 DTSCS1A 01195 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 01196 DTSCS1A 01197 IF L810-NO-REC-88 DTSCS1A 01198 GO TO P6930-EXIT. DTSCS1A 01199 DTSCS1A 01200 MOVE MSKL-REC TO MERA-REC. DTSCS1A 01201 DTSCS1A 01202 MOVE MERA-SOURCE-CD TO MAP-SOURCE-CD. DTSCS1A 01203 DTSCS1A 01204 IF MERA-CLAIMANT-SSN NOT = +0 DTSCS1A 01205 MOVE MERA-CLAIMANT-SSN TO WRK-DISPLAY DTSCS1A 01206 MOVE WRK-DISPLAY-SSN-1 TO MAP-CLAIMANT-SSN-1 DTSCS1A 01207 MOVE WRK-DISPLAY-SSN-2 TO MAP-CLAIMANT-SSN-2 DTSCS1A 01208 MOVE WRK-DISPLAY-SSN-3 TO MAP-CLAIMANT-SSN-3. DTSCS1A 01209 DTSCS1A 01210 MOVE MERA-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS1A 01211 DTSCS1A 01212 IF MERA-POT-PRED-EMP-NO NOT = +0 DTSCS1A 01213 MOVE MERA-POT-PRED-EMP-NO TO WRK-DISPLAY DTSCS1A 01214 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-PRED-EMP-NO-1 DTSCS1A 01215 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-PRED-EMP-NO-2. DTSCS1A 01216 DTSCS1A 01217 MOVE MERA-RESPONSIBLE-OP-ID TO MAP-RESP-OP-ID. DTSCS1A 01218 DTSCS1A 01219 MOVE MERA-NOTE TO MAP-NOTE. DTSCS1A 01220 DTSCS1A 01221 MOVE MERA-STATUS-CD TO MAP-STATUS-CD. DTSCS1A 01222 DTSCS1A 01223 IF MERA-MAIL-DATE-1 NOT = +0 DTSCS1A 01224 MOVE MERA-MAIL-DATE-1 TO WRK-DISPLAY DTSCS1A 01225 MOVE WRK-DISPLAY-MO TO MAP-MAIL-1-MO DTSCS1A 01226 MOVE WRK-DISPLAY-DA TO MAP-MAIL-1-DA DTSCS1A 01227 MOVE WRK-DISPLAY-YR TO MAP-MAIL-1-YR. DTSCS1A 01228 DTSCS1A 01229 MOVE MERA-LETTER-1-CD TO MAP-LETTER-1-CD. DTSCS1A 01230 DTSCS1A 01231 IF MERA-MAIL-DATE-2 NOT = +0 DTSCS1A 01232 MOVE MERA-MAIL-DATE-2 TO WRK-DISPLAY DTSCS1A 01233 MOVE WRK-DISPLAY-MO TO MAP-MAIL-2-MO DTSCS1A 01234 MOVE WRK-DISPLAY-DA TO MAP-MAIL-2-DA DTSCS1A 01235 MOVE WRK-DISPLAY-YR TO MAP-MAIL-2-YR. DTSCS1A 01236 DTSCS1A 01237 IF MERA-RECEIVED-DATE NOT = +0 DTSCS1A 01238 MOVE MERA-RECEIVED-DATE TO WRK-DISPLAY DTSCS1A 01239 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-MO DTSCS1A 01240 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DA DTSCS1A 01241 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-YR. DTSCS1A 01242 DTSCS1A 01243 IF MERA-COOP-AGENCY-REQ-DATE NOT = +0 DTSCS1A 01244 MOVE MERA-COOP-AGENCY-REQ-DATE TO WRK-DISPLAY DTSCS1A 01245 MOVE WRK-DISPLAY-MO TO MAP-COOP-AGENCY-REQ-MO DTSCS1A 01246 MOVE WRK-DISPLAY-DA TO MAP-COOP-AGENCY-REQ-DA DTSCS1A 01247 MOVE WRK-DISPLAY-YR TO MAP-COOP-AGENCY-REQ-YR. DTSCS1A 01248 DTSCS1A 01249 IF MERA-DETER-NOTSUB-DATE NOT = +0 DTSCS1A 01250 MOVE MERA-DETER-NOTSUB-DATE TO WRK-DISPLAY DTSCS1A 01251 MOVE WRK-DISPLAY-MO TO MAP-DETER-NOTSUB-MO DTSCS1A 01252 MOVE WRK-DISPLAY-DA TO MAP-DETER-NOTSUB-DA DTSCS1A 01253 MOVE WRK-DISPLAY-YR TO MAP-DETER-NOTSUB-YR. DTSCS1A 01254 DTSCS1A 01255 IF MERA-FIELD-ASSIGN-DATE NOT = +0 DTSCS1A 01256 MOVE MERA-FIELD-ASSIGN-DATE TO WRK-DISPLAY DTSCS1A 01257 MOVE WRK-DISPLAY-MO TO MAP-FIELD-ASSIGN-MO DTSCS1A 01258 MOVE WRK-DISPLAY-DA TO MAP-FIELD-ASSIGN-DA DTSCS1A 01259 MOVE WRK-DISPLAY-YR TO MAP-FIELD-ASSIGN-YR. DTSCS1A 01260 P6930-EXIT. DTSCS1A 01261 EXIT. DTSCS1A 01262 P6940-FROM-MFAE. DTSCS1A 01263 DTSCS1A 01264 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS1A 01265 DTSCS1A 01266 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS1A 01267 DTSCS1A 01268 SET MFAE-FAE-88 TO TRUE. DTSCS1A 01269 DTSCS1A 01270 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A 01271 DTSCS1A 01272 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 01273 DTSCS1A 01274 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 01275 DTSCS1A 01276 IF L810-OK-88 DTSCS1A 01277 MOVE MSKL-REC TO MFAE-REC DTSCS1A 01278 MOVE MFAE-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD DTSCS1A 01279 SET WRK-MFAE-YES-88 TO TRUE DTSCS1A 01280 MOVE CATB-ASKIP-BRT-MDTON TO MAP-FISC-AGNT-CD-A DTSCS1A 01281 MAP-ATTN-LINE-A DTSCS1A 01282 MAP-FISC-AGNT-CD-A DTSCS1A 01283 MAP-DELIV-LINE-1-A DTSCS1A 01284 MAP-DELIV-LINE-2-A DTSCS1A 01285 MAP-CITY-A DTSCS1A 01286 MAP-ST-A DTSCS1A 01287 MAP-ZIP-A DTSCS1A 01288 ELSE DTSCS1A 01289 GO TO P6940-EXIT. DTSCS1A 01290 DTSCS1A 01291 * MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS1A 01292 * MOVE MFAE-FISCAL-AGENT-CD TO FFIS-FISCAL-AGENT-CD DTSCS1A 01293 * MAP-FISC-AGNT-CD. DTSCS1A 01294 * MOVE MFAE-SERVICE-TYPE TO FFIS-SERVICE-TYPE. DTSCS1A 01295 * SET FFIS-FIS-88 TO TRUE. DTSCS1A 01296 * MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS1A 01297 * DTSCS1A 01298 * PERFORM S831-READ THRU S831-EXIT. DTSCS1A 01299 * DTSCS1A 01300 * IF NOT L831-OK-88 DTSCS1A 01301 * GO TO P6940-EXIT DTSCS1A 01302 * ELSE DTSCS1A 01303 * MOVE FSKL-REC TO FFIS-REC DTSCS1A 01304 * END-IF. DTSCS1A 01305 * DTSCS1A 01306 * MOVE FFIS-ATTN-LINE TO MAP-ATTN-LINE. DTSCS1A 01307 * MOVE FFIS-DELIV-LINE-1 TO MAP-DELIV-LINE-1. DTSCS1A 01308 * MOVE FFIS-DELIV-LINE-2 TO MAP-DELIV-LINE-2. DTSCS1A 01309 * MOVE FFIS-CITY TO MAP-CITY. DTSCS1A 01310 * MOVE FFIS-ST TO MAP-ST. DTSCS1A 01311 * MOVE FFIS-ZIP TO MAP-ZIP. DTSCS1A 01312 DTSCS1A 01313 DTSCS1A 01314 P6940-EXIT. DTSCS1A 01315 EXIT. DTSCS1A 01316 /*****************************************************************DTSCS1A 01317 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS1A 01318 ******************************************************************DTSCS1A 01319 DTSCS1A 01320 P7000-REQUEST-EDIT. DTSCS1A 01321 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A 01322 DTSCS1A 01323 IF LCCM-F09-88 DTSCS1A 01324 PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS1A 01325 ELSE DTSCS1A 01326 IF LCCM-F10-88 DTSCS1A 01327 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS1A 01328 ELSE DTSCS1A 01329 IF LCCM-F23-88 DTSCS1A 01330 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS1A 01331 ELSE DTSCS1A 01332 GO TO S899-ABEND. DTSCS1A 01333 DTSCS1A 01334 DTSCS1A 01335 *------------------------------------------------------ DTSCS1A 01336 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS1A 01337 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS1A 01338 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS1A 01339 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS1A 01340 *------------------------------------------------------ DTSCS1A 01341 DTSCS1A 01342 IF LCCM-MSG DTSCS1A 01343 NEXT SENTENCE DTSCS1A 01344 ELSE DTSCS1A 01345 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS1A 01346 IF LCCM-F09-88 DTSCS1A 01347 SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS1A 01348 MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS1A 01349 ELSE DTSCS1A 01350 IF LCCM-F10-88 DTSCS1A 01351 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS1A 01352 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS1A 01353 ELSE DTSCS1A 01354 IF LCCM-F23-88 DTSCS1A 01355 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS1A 01356 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS1A 01357 DTSCS1A 01358 SET RESP-SEND-MAP TO TRUE. DTSCS1A 01359 P7000-EXIT. DTSCS1A 01360 EXIT. DTSCS1A 01361 /*****************************************************************DTSCS1A 01362 * ADD FUNCTION WAS REQUESTED *DTSCS1A 01363 ******************************************************************DTSCS1A 01364 DTSCS1A 01365 P7100-EDIT-ADD. DTSCS1A 01366 *----------------------------------------------------- DTSCS1A 01367 * ADD REQUIRES THAT THE SCREEN WAS IN A CLEAR STATE DTSCS1A 01368 *----------------------------------------------------- DTSCS1A 01369 IF NOT LCCM-SCR-CLEAR DTSCS1A 01370 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-AREA DTSCS1A 01371 GO TO P7100-EXIT. DTSCS1A 01372 DTSCS1A 01373 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS1A 01374 DTSCS1A 01375 IF LCCM-NO-MSG DTSCS1A 01376 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 01377 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCS1A 01378 MOVE WRK-EMP-NO TO MPRF-EMP-NO DTSCS1A 01379 SET MPRF-PRF-88 TO TRUE DTSCS1A 01380 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSCS1A 01381 PERFORM S810-READ THRU S810-EXIT DTSCS1A 01382 IF L810-OK-88 DTSCS1A 01383 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS1A 01384 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS1A 01385 P7100-EXIT. DTSCS1A 01386 EXIT. DTSCS1A 01387 /*****************************************************************DTSCS1A 01388 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS1A 01389 ******************************************************************DTSCS1A 01390 DTSCS1A 01391 P7200-EDIT-MOD. DTSCS1A 01392 *----------------------------------------------------- DTSCS1A 01393 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS1A 01394 * INQUIRED DTSCS1A 01395 *----------------------------------------------------- DTSCS1A 01396 IF NOT LCCM-SCR-INQUIRE DTSCS1A 01397 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS1A 01398 GO TO P7200-EXIT. DTSCS1A 01399 DTSCS1A 01400 DTSCS1A 01401 *----------------------------------------------------- DTSCS1A 01402 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS1A 01403 *----------------------------------------------------- DTSCS1A 01404 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A 01405 DTSCS1A 01406 IF LCCM-MSG DTSCS1A 01407 GO TO P7200-EXIT. DTSCS1A 01408 DTSCS1A 01409 DTSCS1A 01410 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A 01411 DTSCS1A 01412 IF LCCM-MSG DTSCS1A 01413 GO TO P7200-EXIT. DTSCS1A 01414 DTSCS1A 01415 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS1A 01416 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS1A 01417 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 01418 GO TO P7200-EXIT. DTSCS1A 01419 DTSCS1A 01420 DTSCS1A 01421 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS1A 01422 P7200-EXIT. DTSCS1A 01423 EXIT. DTSCS1A 01424 /*****************************************************************DTSCS1A 01425 * DTSCS1A 01426 ******************************************************************DTSCS1A 01427 DTSCS1A 01428 P7300-EDIT-DEL. DTSCS1A 01429 *----------------------------------------------------- DTSCS1A 01430 * DELETE REQUIRES THAT A RECORD WAS SUCCESSFULLY INQUIRED. DTSCS1A 01431 *----------------------------------------------------- DTSCS1A 01432 IF NOT LCCM-SCR-INQUIRE DTSCS1A 01433 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS1A 01434 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS1A 01435 GO TO P7300-EXIT. DTSCS1A 01436 DTSCS1A 01437 DTSCS1A 01438 *----------------------------------------------------- DTSCS1A 01439 * MAP-OP-ID MAY NOT BE CHANGED DURING THE MOD DTSCS1A 01440 *----------------------------------------------------- DTSCS1A 01441 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A 01442 DTSCS1A 01443 IF LCCM-MSG DTSCS1A 01444 GO TO P7300-EXIT. DTSCS1A 01445 DTSCS1A 01446 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS1A 01447 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS1A 01448 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 01449 GO TO P7300-EXIT. DTSCS1A 01450 DTSCS1A 01451 DTSCS1A 01452 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A 01453 DTSCS1A 01454 IF LCCM-MSG DTSCS1A 01455 GO TO P7300-EXIT. DTSCS1A 01456 DTSCS1A 01457 DTSCS1A 01458 PERFORM S1200-DELETE-EMP THRU S1200-EXIT. DTSCS1A 01459 DTSCS1A 01460 IF LCCM-MSG DTSCS1A 01461 GO TO P7300-EXIT. DTSCS1A 01462 DTSCS1A 01463 DTSCS1A 01464 IF MAP-DELETE-EMP-YES-88 DTSCS1A 01465 SET MSKL-PRF-88 TO TRUE DTSCS1A 01466 ADD +1 TO MSKL-REC-TYPE DTSCS1A 01467 SET MLEN-IDX TO MSKL-REC-TYPE DTSCS1A 01468 PERFORM P7310-DELETE-EDIT THRU P7310-EXIT DTSCS1A 01469 VARYING MLEN-IDX FROM MLEN-IDX BY 1 DTSCS1A 01470 UNTIL (MLEN-IDX > MLEN-MAX-REC-TYPE) DTSCS1A 01471 OR DTSCS1A 01472 (LCCM-MSG) DTSCS1A 01473 ELSE DTSCS1A 01474 MOVE LOW-VALUES TO MERA-KEY-AREA DTSCS1A 01475 MOVE WRK-EMP-NO TO MERA-EMP-NO DTSCS1A 01476 SET MERA-ERA-88 TO TRUE DTSCS1A 01477 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA DTSCS1A 01478 PERFORM S810-READ THRU S810-EXIT DTSCS1A 01479 IF L810-NO-REC-88 DTSCS1A 01480 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS1A 01481 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS1A 01482 P7300-EXIT. DTSCS1A 01483 EXIT. DTSCS1A 01484 SKIP3 DTSCS1A 01485 P7310-DELETE-EDIT. DTSCS1A 01486 IF MLEN-FILE-ID (MLEN-IDX) = +0 DTSCS1A 01487 GO TO P7310-EXIT. DTSCS1A 01488 DTSCS1A 01489 IF MLEN-DEL-MPRF-OK-88 (MLEN-IDX) DTSCS1A 01490 GO TO P7310-EXIT. DTSCS1A 01491 DTSCS1A 01492 DTSCS1A 01493 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A 01494 DTSCS1A 01495 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS1A 01496 DTSCS1A 01497 SET MSKL-REC-TYPE TO MLEN-IDX. DTSCS1A 01498 DTSCS1A 01499 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1A 01500 DTSCS1A 01501 IF L810-NO-REC-88 DTSCS1A 01502 GO TO P7310-EXIT. DTSCS1A 01503 DTSCS1A 01504 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS1A 01505 DTSCS1A 01506 MOVE MSG-E1A1-AREA TO WRK-MSG-AREA. DTSCS1A 01507 DTSCS1A 01508 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS1A 01509 P7310-EXIT. DTSCS1A 01510 EXIT. DTSCS1A 01511 /*****************************************************************DTSCS1A 01512 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS1A 01513 ******************************************************************DTSCS1A 01514 DTSCS1A 01515 P8000-REQUEST-UPDATE. DTSCS1A 01516 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A 01517 DTSCS1A 01518 IF LCCM-SCR-ADD-LOCKED DTSCS1A 01519 PERFORM P8100-ADD THRU P8100-EXIT DTSCS1A 01520 ELSE DTSCS1A 01521 IF LCCM-SCR-MOD-LOCKED DTSCS1A 01522 PERFORM P8200-MOD THRU P8200-EXIT DTSCS1A 01523 ELSE DTSCS1A 01524 IF LCCM-SCR-DEL-LOCKED DTSCS1A 01525 PERFORM P8300-DEL THRU P8300-EXIT DTSCS1A 01526 ELSE DTSCS1A 01527 GO TO S899-ABEND. DTSCS1A 01528 DTSCS1A 01529 SET RESP-SEND-MAP TO TRUE. DTSCS1A 01530 P8000-EXIT. DTSCS1A 01531 EXIT. DTSCS1A 01532 /*****************************************************************DTSCS1A 01533 * DTSCS1A 01534 ******************************************************************DTSCS1A 01535 P8100-ADD. DTSCS1A 01536 SET LCCM-SCR-CLEAR TO TRUE. DTSCS1A 01537 DTSCS1A 01538 IF LCCM-F12-88 DTSCS1A 01539 MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID DTSCS1A 01540 GO TO P8100-EXIT. DTSCS1A 01541 DTSCS1A 01542 PERFORM P8110-GET-KEY THRU P8110-EXIT. DTSCS1A 01543 DTSCS1A 01544 PERFORM P8120-INITIALIZE-MPRF THRU P8120-EXIT. DTSCS1A 01545 DTSCS1A 01546 MOVE MPRF-REC TO MSKL-REC. DTSCS1A 01547 DTSCS1A 01548 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A 01549 DTSCS1A 01550 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS1A 01551 DTSCS1A 01552 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1A 01553 DTSCS1A 01554 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS1A 01555 DTSCS1A 01556 PERFORM P8920-MTAD-UPDATE THRU P8920-EXIT. DTSCS1A 01557 DTSCS1A 01558 PERFORM P8910-MPRF-UPDATE THRU P8910-EXIT. DTSCS1A 01559 DTSCS1A 01560 IF (WRK-EMP-CHG-ONLY-88) DTSCS1A 01561 OR DTSCS1A 01562 (MAP-SOURCE-CD-NA-88) DTSCS1A 01563 NEXT SENTENCE DTSCS1A 01564 ELSE DTSCS1A 01565 PERFORM P8930-MERA-UPDATE THRU P8930-EXIT DTSCS1A 01566 IF WRK-UPD-MERA-YES-88 DTSCS1A 01567 PERFORM S8000-TICKLE THRU S8000-EXIT. DTSCS1A 01568 DTSCS1A 01569 PERFORM P8130-MEVL-WRITE THRU P8130-EXIT. DTSCS1A 01570 DTSCS1A 01571 PERFORM P8140-MFAE-WRITE THRU P8140-EXIT. DTSCS1A 01572 DTSCS1A 01573 PERFORM P8950-POT-HOUSEHOLD THRU P8950-EXIT. DTSCS1A 01574 DTSCS1A 01575 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1A 01576 DTSCS1A 01577 DTSCS1A 01578 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A 01579 DTSCS1A 01580 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A 01581 DTSCS1A 01582 MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS1A 01583 DTSCS1A 01584 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS1A 01585 DTSCS1A 01586 MOVE WRK-DISPLAY-EMP-NO-1 TO MSG-EMP-NO-1. DTSCS1A 01587 DTSCS1A 01588 MOVE WRK-DISPLAY-EMP-NO-2 TO MSG-EMP-NO-2. DTSCS1A 01589 DTSCS1A 01590 MOVE MSG-SUCCESSFUL-ADD-TEXT TO LCCM-MSG-TEXT. DTSCS1A 01591 DTSCS1A 01592 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A 01593 P8100-EXIT. DTSCS1A 01594 EXIT. DTSCS1A 01595 SKIP3 DTSCS1A 01596 P8110-GET-KEY. DTSCS1A 01597 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 01598 DTSCS1A 01599 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A 01600 DTSCS1A 01601 IF L018-NO-ENTRY DTSCS1A 01602 NEXT SENTENCE DTSCS1A 01603 ELSE DTSCS1A 01604 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS1A 01605 LCCM-EMP-NO DTSCS1A 01606 IF ((WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A 01607 AND DTSCS1A 01608 (WRK-EMP-NO <= CENO-FED-END-EMP-NO)) DTSCS1A 01609 OR DTSCS1A 01610 ((WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A 01611 AND DTSCS1A 01612 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO)) DTSCS1A 01613 OR DTSCS1A 01614 ((WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A 01615 AND DTSCS1A 01616 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO)) DTSCS1A 01617 SET WRK-EMP-CHG-ONLY-88 TO TRUE DTSCS1A 01618 GO TO P8110-EXIT DTSCS1A 01619 ELSE DTSCS1A 01620 GO TO S899-ABEND. DTSCS1A 01621 DTSCS1A 01622 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSCS1A 01623 DTSCS1A 01624 MOVE +0 TO MHDR-EMP-NO. DTSCS1A 01625 DTSCS1A 01626 SET MHDR-HDR-88 TO TRUE. DTSCS1A 01627 DTSCS1A 01628 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 01629 DTSCS1A 01630 PERFORM S810-READ-UPDATE THRU S810-EXIT. DTSCS1A 01631 DTSCS1A 01632 IF L810-NO-REC-88 DTSCS1A 01633 GO TO S899-ABEND. DTSCS1A 01634 DTSCS1A 01635 DTSCS1A 01636 MOVE MSKL-REC TO MHDR-REC. DTSCS1A 01637 DTSCS1A 01638 SET WRK-NEXT-EMP-NO-FOUND-NO-88 TO TRUE. DTSCS1A 01639 DTSCS1A 01640 PERFORM P8111-FIND-NEXT-EMP-NO THRU P8111-EXIT DTSCS1A 01641 UNTIL WRK-NEXT-EMP-NO-FOUND-YES-88. DTSCS1A 01642 DTSCS1A 01643 MOVE MHDR-LAST-USED-EMP-NO TO LCCM-EMP-NO DTSCS1A 01644 WRK-EMP-NO. DTSCS1A 01645 DTSCS1A 01646 MOVE MHDR-REC TO MSKL-REC. DTSCS1A 01647 DTSCS1A 01648 PERFORM S810-REWRITE-UPDATE THRU S810-EXIT. DTSCS1A 01649 P8110-EXIT. DTSCS1A 01650 EXIT. DTSCS1A 01651 SKIP3 DTSCS1A 01652 P8111-FIND-NEXT-EMP-NO. DTSCS1A 01653 IF MHDR-LAST-USED-EMP-NO < 999999 DTSCS1A 01654 CONTINUE DTSCS1A 01655 ELSE DTSCS1A 01656 GO TO S899-ABEND. DTSCS1A 01657 DTSCS1A 01658 ADD +1 TO MHDR-LAST-USED-EMP-NO. DTSCS1A 01659 DTSCS1A 01660 IF (MHDR-LAST-USED-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A 01661 AND DTSCS1A 01662 (MHDR-LAST-USED-EMP-NO <= CENO-FED-END-EMP-NO) DTSCS1A 01663 GO TO P8111-EXIT. DTSCS1A 01664 DTSCS1A 01665 IF (MHDR-LAST-USED-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A 01666 AND DTSCS1A 01667 (MHDR-LAST-USED-EMP-NO <= CENO-CWC-END-EMP-NO) DTSCS1A 01668 GO TO P8111-EXIT. DTSCS1A 01669 DTSCS1A 01670 IF (MHDR-LAST-USED-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A 01671 AND DTSCS1A 01672 (MHDR-LAST-USED-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO) DTSCS1A 01673 GO TO P8111-EXIT. DTSCS1A 01674 DTSCS1A 01675 SET WRK-EMP-NO-UNUSED-NO-88 TO TRUE. DTSCS1A 01676 DTSCS1A 01677 PERFORM DTSCS1A 01678 VARYING CENO-AVAILABLE-IDX FROM 1 BY 1 DTSCS1A 01679 UNTIL (CENO-AVAILABLE-IDX > CENO-AVAILABLE-RANGE-CNT) DTSCS1A 01680 OR DTSCS1A 01681 (WRK-EMP-NO-UNUSED-YES-88) DTSCS1A 01682 IF (MHDR-LAST-USED-EMP-NO DTSCS1A 01683 >= CENO-AVAILABLE-START-EMP-NO DTSCS1A 01684 (CENO-AVAILABLE-IDX)) DTSCS1A 01685 AND DTSCS1A 01686 (MHDR-LAST-USED-EMP-NO DTSCS1A 01687 <= CENO-AVAILABLE-END-EMP-NO DTSCS1A 01688 (CENO-AVAILABLE-IDX)) DTSCS1A 01689 SET WRK-EMP-NO-UNUSED-YES-88 TO TRUE DTSCS1A 01690 END-IF DTSCS1A 01691 END-PERFORM. DTSCS1A 01692 DTSCS1A 01693 IF WRK-EMP-NO-UNUSED-NO-88 DTSCS1A 01694 GO TO P8111-EXIT. DTSCS1A 01695 DTSCS1A 01696 ***** DTSCS1A 01697 * DTSCS1A 01698 * BECAUSE THE MHDR RECORD IS IN THE SAME PHYSICAL VSAM DTSCS1A 01699 * FILE AS THE MPRF RECORDS AND THE MHDR RECORD WAS READ DTSCS1A 01700 * FOR UPDATE, THE COMMENTED OUT CODE CAUSES CICS TO ABEND DTSCS1A 01701 * WITH A POTENTIAL DEADLOCK ABEND. DTSCS1A 01702 * DTSCS1A 01703 * IF A PROPER JOB IS DONE POPULATING CENO-ALREADY-USED-RANGE DTSCS1A 01704 * -AREA IS DONE, THE COMMENTED OUT CODE WAS OVERKILL ANYWAY. DTSCS1A 01705 * DTSCS1A 01706 * IF IT TURNS OUT THE COMMENTED OUT CODE IS NEEDED, THEN IT DTSCS1A 01707 * WILL BE NECESSARY TO REVISE THE FUNCTION OF P8110 AND DTSCS1A 01708 * P8111 TO AVOID THE POTENTIAL DEADLOCK. ACTUALLY, AFTER DTSCS1A 01709 * A FEW RECORDS ARE IN MSTA AND THE MHDR RECORD IS IN A DTSCS1A 01710 * DIFFERENT CI THAN THE MPRF WE ARE ATTEMPTING TO READ, DTSCS1A 01711 * THE DEADLOCK MAY DISAPPEAR. DTSCS1A 01712 * DTSCS1A 01713 ***** DTSCS1A 01714 DTSCS1A 01715 *****MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A 01716 DTSCS1A 01717 *****MOVE MHDR-LAST-USED-EMP-NO TO MSKL-EMP-NO. DTSCS1A 01718 DTSCS1A 01719 *****SET MSKL-PRF-88 TO TRUE. DTSCS1A 01720 DTSCS1A 01721 *****PERFORM S810-READ THRU S810-EXIT. DTSCS1A 01722 DTSCS1A 01723 *****IF L810-NO-REC-88 DTSCS1A 01724 SET WRK-NEXT-EMP-NO-FOUND-YES-88 TO TRUE. DTSCS1A 01725 P8111-EXIT. DTSCS1A 01726 EXIT. DTSCS1A 01727 SKIP3 DTSCS1A 01728 P8120-INITIALIZE-MPRF. DTSCS1A 01729 MOVE LOW-VALUES TO MPRF-REC. DTSCS1A 01730 DTSCS1A 01731 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1A 01732 DTSCS1A 01733 SET MPRF-PRF-88 TO TRUE. DTSCS1A 01734 DTSCS1A 01735 MOVE +0 TO MPRF-PURGE-DATE. DTSCS1A 01736 DTSCS1A 01737 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 01738 SET MPRF-CLASS-CHG-ONLY-88 TO TRUE DTSCS1A 01739 ELSE DTSCS1A 01740 SET MPRF-CLASS-UNK-88 TO TRUE. DTSCS1A 01741 DTSCS1A 01742 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A 01743 SET MPRF-STATUS-NEVERSUB-88 TO TRUE DTSCS1A 01744 ELSE DTSCS1A 01745 SET MPRF-STATUS-UNK-88 TO TRUE. DTSCS1A 01746 DTSCS1A 01747 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A 01748 MOVE MAP-ELIGIBLE-CD TO L031-CD-3 DTSCS1A 01749 SET L031-MPRF-ELIGIBLE-CD TO TRUE DTSCS1A 01750 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A 01751 IF L031-VALID DTSCS1A 01752 MOVE MAP-ELIGIBLE-CD-9 TO MPRF-ELIGIBLE-CD DTSCS1A 01753 ELSE DTSCS1A 01754 GO TO S899-ABEND DTSCS1A 01755 ELSE DTSCS1A 01756 SET MPRF-ELIGIBLE-NOT-SUBJECT-88 TO TRUE. DTSCS1A 01757 DTSCS1A 01758 MOVE SPACES TO MPRF-PRIMARY-NAME. DTSCS1A 01759 DTSCS1A 01760 SET MPRF-PRIMARY-IS-NOT-ENTITY-88 TO TRUE. DTSCS1A 01761 DTSCS1A 01762 MOVE SPACES TO MPRF-ENTITY-NAME. DTSCS1A 01763 DTSCS1A 01764 SET MPRF-UC30-MASS-MAIL-YES-88 TO TRUE. DTSCS1A 01765 DTSCS1A 01766 SET MPRF-UC30-CREDIT-YES-88 TO TRUE. DTSCS1A 01767 DTSCS1A 01768 SET MPRF-FEIN-HARASS-YES-88 TO TRUE. DTSCS1A 01769 DTSCS1A 01770 SET MPRF-CHRG-STMT-PRINT-YES-88 TO TRUE. DTSCS1A 01771 DTSCS1A 01772 SET MPRF-DC-CONTRACTOR-NO-88 TO TRUE. DTSCS1A 01773 DTSCS1A 01774 SET MPRF-ORG-UNK-88 TO TRUE. DTSCS1A 01775 DTSCS1A 01776 SET MPRF-FISC-AG-NONE-88 TO TRUE. DTSCS1A 01777 DTSCS1A 01778 MOVE +0 TO MPRF-FEIN. DTSCS1A 01779 DTSCS1A 01780 MOVE +0 TO MPRF-DC-BUSINESS-TAX-ACCT-NO. DTSCS1A 01781 DTSCS1A 01782 SET MPRF-SUSPEND-COLL-NO-88 TO TRUE. DTSCS1A 01783 DTSCS1A 01784 SET MPRF-NOT-WRITTEN-OFF-88 TO TRUE. DTSCS1A 01785 DTSCS1A 01786 SET MPRF-PURGE-ALL-NO-88 TO TRUE. DTSCS1A 01787 DTSCS1A 01788 SET MPRF-SIC-CD-NONCLASSIF-88 TO TRUE. DTSCS1A 01789 DTSCS1A 01790 MOVE SPACES TO MPRF-OLD-SIC-CD. DTSCS1A 01791 DTSCS1A 01792 MOVE +0 TO MPRF-SIC-CHNG-DATE. DTSCS1A 01793 DTSCS1A 01794 SET MPRF-SIC-AUX-UNK-88 TO TRUE. DTSCS1A 01795 DTSCS1A 01796 SET MPRF-NAICS-CD-NONCLASSIF-88 TO TRUE. DTSCS1A 01797 DTSCS1A 01798 MOVE SPACES TO MPRF-OLD-NAICS-CD. DTSCS1A 01799 DTSCS1A 01800 MOVE +0 TO MPRF-NAICS-CHNG-DATE. DTSCS1A 01801 DTSCS1A 01802 SET MPRF-NAICS-AUX-UNK-88 TO TRUE. DTSCS1A 01803 DTSCS1A 01804 SET MPRF-OWN-CD-NONCLASSIF-88 TO TRUE. DTSCS1A 01805 DTSCS1A 01806 MOVE SPACES TO MPRF-OLD-OWN-CD. DTSCS1A 01807 DTSCS1A 01808 MOVE +0 TO MPRF-OWN-CHNG-DATE. DTSCS1A 01809 DTSCS1A 01810 SET MPRF-SINGLE-UNIT-88 TO TRUE. DTSCS1A 01811 DTSCS1A 01812 SET MPRF-WARD-UNKNOWN-88 TO TRUE. DTSCS1A 01813 DTSCS1A 01814 SET MPRF-RETURN-MAIL-NO-88 TO TRUE. DTSCS1A 01815 DTSCS1A 01816 MOVE +0 TO MPRF-PWR-OF-ATTORNEY-DT. DTSCS1A 01817 DTSCS1A 01818 MOVE +0 TO MPRF-PURSUED-RPT-CNT. DTSCS1A 01819 DTSCS1A 01820 MOVE +0 TO MPRF-TOT-BALANCE-AMT. DTSCS1A 01821 DTSCS1A 01822 MOVE +0 TO MPRF-TOT-CREDIT-AMT. DTSCS1A 01823 DTSCS1A 01824 SET MPRF-BANKRP-NOT-OPEN-88 TO TRUE. DTSCS1A 01825 DTSCS1A 01826 MOVE +0 TO MPRF-ARCHIVED-AUDIT-YRQ. DTSCS1A 01827 DTSCS1A 01828 MOVE LCCM-PICKUP-YRQ TO MPRF-LAST-ARCHIVED-YRQ. DTSCS1A 01829 DTSCS1A 01830 SET MPRF-TAX-REC-ADDR-NO-88 TO TRUE. DTSCS1A 01831 DTSCS1A 01832 SET MPRF-BEN-MAIL-ADDR-NO-88 TO TRUE. DTSCS1A 01833 DTSCS1A 01834 MOVE SPACES TO MPRF-FLD-ZIP-ST. DTSCS1A 01835 DTSCS1A 01836 SET MPRF-NO-MAPL-88 TO TRUE. DTSCS1A 01837 DTSCS1A 01838 SET MPRF-NO-MLIN-88 TO TRUE. DTSCS1A 01839 DTSCS1A 01840 SET MPRF-NO-MDPC-88 TO TRUE. DTSCS1A 01841 DTSCS1A 01842 SET MPRF-NO-MFAS-88 TO TRUE. DTSCS1A 01843 DTSCS1A 01844 SET MPRF-UPDATED-NEVER-88 TO TRUE. DTSCS1A 01845 DTSCS1A 01846 MOVE +0 TO MPRF-UPDATE-TASK-ID. DTSCS1A 01847 DTSCS1A 01848 MOVE SPACES TO MPRF-UPDATE-OP-ID. DTSCS1A 01849 DTSCS1A 01850 MOVE SPACES TO MPRF-UPDATE-TERMID. DTSCS1A 01851 DTSCS1A 01852 MOVE SPACES TO MPRF-UPDATE-NETNAME. DTSCS1A 01853 DTSCS1A 01854 MOVE +0 TO MPRF-UPDATE-START-DATE. DTSCS1A 01855 DTSCS1A 01856 MOVE +0 TO MPRF-UPDATE-START-TIME. DTSCS1A 01857 DTSCS1A 01858 MOVE SPACES TO MPRF-UPDATE-SCR-ID. DTSCS1A 01859 DTSCS1A 01860 MOVE SPACES TO MPRF-UPDATE-FUNCTION. DTSCS1A 01861 DTSCS1A 01862 SET MPRF-NOT-CONVERTED-88 TO TRUE. DTSCS1A 01863 DTSCS1A 01864 MOVE LCCM-CURR-RUN-DATE TO MPRF-ESTB-DATE DTSCS1A 01865 MPRF-CHNG-DATE. DTSCS1A 01866 P8120-EXIT. DTSCS1A 01867 EXIT. DTSCS1A 01868 SKIP3 DTSCS1A 01869 P8130-MEVL-WRITE. DTSCS1A 01870 MOVE LOW-VALUES TO MEVL-REC. DTSCS1A 01871 DTSCS1A 01872 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS1A 01873 DTSCS1A 01874 SET MEVL-EVL-88 TO TRUE. DTSCS1A 01875 DTSCS1A 01876 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS1A 01877 DTSCS1A 01878 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS1A 01879 DTSCS1A 01880 MOVE +0 TO MEVL-PURGE-DATE. DTSCS1A 01881 DTSCS1A 01882 MOVE 'INITIAL REGISTRATION' TO MEVL-TEXT. DTSCS1A 01883 DTSCS1A 01884 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS1A 01885 DTSCS1A 01886 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS1A 01887 DTSCS1A 01888 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS1A 01889 MEVL-CHNG-DATE. DTSCS1A 01890 DTSCS1A 01891 MOVE MEVL-REC TO MSKL-REC. DTSCS1A 01892 DTSCS1A 01893 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A 01894 P8130-EXIT. DTSCS1A 01895 EXIT. DTSCS1A 01896 DTSCS1A 01897 P8140-MFAE-WRITE. DTSCS1A 01898 DTSCS1A 01899 IF MAP-FISC-AGNT-CD = LOW-VALUES OR DTSCS1A 01900 MAP-FISC-AGNT-CD = SPACES DTSCS1A 01901 GO TO P8140-EXIT DTSCS1A 01902 END-IF. DTSCS1A 01903 DTSCS1A 01904 MOVE LOW-VALUES TO MFAE-REC. DTSCS1A 01905 DTSCS1A 01906 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS1A 01907 DTSCS1A 01908 SET MFAE-FAE-88 TO TRUE. DTSCS1A 01909 DTSCS1A 01910 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A 01911 DTSCS1A 01912 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS1A 01913 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID. DTSCS1A 01914 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS1A 01915 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS1A 01916 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS1A 01917 PERFORM S331-WRITE-MLOG THRU S331-EXIT. DTSCS1A 01918 DTSCS1A 01919 MOVE MAP-FISC-AGNT-CD TO MFAE-FISCAL-AGENT-CD. DTSCS1A 01920 DTSCS1A 01921 MOVE ZEROS TO MFAE-PURGE-DATE. DTSCS1A 01922 DTSCS1A 01923 SET MFAE-NOT-CONVERTED-88 TO TRUE. DTSCS1A 01924 DTSCS1A 01925 MOVE LCCM-CURR-RUN-DATE TO MFAE-ESTB-DATE DTSCS1A 01926 MFAE-CHNG-DATE. DTSCS1A 01927 DTSCS1A 01928 MOVE MFAE-REC TO MSKL-REC. DTSCS1A 01929 DTSCS1A 01930 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A 01931 DTSCS1A 01932 P8140-EXIT. DTSCS1A 01933 EXIT. DTSCS1A 01934 /*****************************************************************DTSCS1A 01935 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS1A 01936 ******************************************************************DTSCS1A 01937 DTSCS1A 01938 P8200-MOD. DTSCS1A 01939 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1A 01940 DTSCS1A 01941 IF LCCM-F12-88 DTSCS1A 01942 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS1A 01943 GO TO P8200-EXIT. DTSCS1A 01944 DTSCS1A 01945 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A 01946 DTSCS1A 01947 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS1A 01948 DTSCS1A 01949 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1A 01950 DTSCS1A 01951 IF LCCM-MSG DTSCS1A 01952 GO TO P8200-EXIT. DTSCS1A 01953 DTSCS1A 01954 PERFORM P8900-INITIALIZE-L331 THRU P8900-EXIT. DTSCS1A 01955 DTSCS1A 01956 PERFORM P8920-MTAD-UPDATE THRU P8920-EXIT. DTSCS1A 01957 DTSCS1A 01958 PERFORM P8910-MPRF-UPDATE THRU P8910-EXIT. DTSCS1A 01959 DTSCS1A 01960 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A 01961 NEXT SENTENCE DTSCS1A 01962 ELSE DTSCS1A 01963 PERFORM P8930-MERA-UPDATE THRU P8930-EXIT DTSCS1A 01964 IF WRK-UPD-MERA-YES-88 DTSCS1A 01965 PERFORM S8000-TICKLE THRU S8000-EXIT. DTSCS1A 01966 DTSCS1A 01967 PERFORM P8950-POT-HOUSEHOLD THRU P8950-EXIT. DTSCS1A 01968 DTSCS1A 01969 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1A 01970 DTSCS1A 01971 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS1A 01972 DTSCS1A 01973 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A 01974 DTSCS1A 01975 MOVE LOW-VALUES TO MAP-CASS-IND DTSCS1A 01976 MAP-CASS-CD. DTSCS1A 01977 DTSCS1A 01978 IF MAP-FISC-AGNT-CD > SPACES DTSCS1A 01979 MOVE CATB-ASKIP-BRT-MDTON TO MAP-ATTN-LINE-A DTSCS1A 01980 MAP-FISC-AGNT-CD-A DTSCS1A 01981 MAP-DELIV-LINE-1-A DTSCS1A 01982 MAP-DELIV-LINE-2-A DTSCS1A 01983 MAP-CITY-A DTSCS1A 01984 MAP-ST-A DTSCS1A 01985 MAP-ZIP-A. DTSCS1A 01986 P8200-EXIT. DTSCS1A 01987 EXIT. DTSCS1A 01988 /*****************************************************************DTSCS1A 01989 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS1A 01990 ******************************************************************DTSCS1A 01991 DTSCS1A 01992 P8300-DEL. DTSCS1A 01993 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS1A 01994 DTSCS1A 01995 IF LCCM-F12-88 DTSCS1A 01996 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS1A 01997 GO TO P8300-EXIT. DTSCS1A 01998 DTSCS1A 01999 PERFORM S1001-EDIT-KEY THRU S1001-EXIT. DTSCS1A 02000 DTSCS1A 02001 MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS1A 02002 DTSCS1A 02003 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS1A 02004 DTSCS1A 02005 IF LCCM-MSG DTSCS1A 02006 GO TO P8300-EXIT. DTSCS1A 02007 DTSCS1A 02008 DTSCS1A 02009 IF MAP-DELETE-EMP-YES-88 DTSCS1A 02010 PERFORM P8310-DELETE-ALL THRU P8310-EXIT DTSCS1A 02011 ELSE DTSCS1A 02012 PERFORM P8320-DELETE-MERA THRU P8320-EXIT. DTSCS1A 02013 DTSCS1A 02014 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS1A 02015 DTSCS1A 02016 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS1A 02017 DTSCS1A 02018 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS1A 02019 P8300-EXIT. DTSCS1A 02020 EXIT. DTSCS1A 02021 SKIP3 DTSCS1A 02022 P8310-DELETE-ALL. DTSCS1A 02023 SET MSKL-PRF-88 TO TRUE. DTSCS1A 02024 DTSCS1A 02025 ADD +1 TO MSKL-REC-TYPE. DTSCS1A 02026 DTSCS1A 02027 SET MLEN-IDX TO MSKL-REC-TYPE. DTSCS1A 02028 DTSCS1A 02029 PERFORM P8311-DELETE-REC-TYPE THRU P8311-EXIT DTSCS1A 02030 VARYING MLEN-IDX FROM MLEN-IDX BY 1 DTSCS1A 02031 UNTIL MLEN-IDX > MLEN-MAX-REC-TYPE. DTSCS1A 02032 DTSCS1A 02033 DTSCS1A 02034 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A 02035 DTSCS1A 02036 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1A 02037 DTSCS1A 02038 SET MPRF-PRF-88 TO TRUE. DTSCS1A 02039 DTSCS1A 02040 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 02041 DTSCS1A 02042 PERFORM S810-DELETE THRU S810-EXIT. DTSCS1A 02043 DTSCS1A 02044 DTSCS1A 02045 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A 02046 DTSCS1A 02047 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A 02048 DTSCS1A 02049 MOVE WRK-EMP-NO TO WRK-DISPLAY. DTSCS1A 02050 DTSCS1A 02051 MOVE WRK-DISPLAY-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS1A 02052 DTSCS1A 02053 MOVE WRK-DISPLAY-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS1A 02054 P8310-EXIT. DTSCS1A 02055 EXIT. DTSCS1A 02056 SKIP3 DTSCS1A 02057 P8311-DELETE-REC-TYPE. DTSCS1A 02058 IF MLEN-FILE-ID (MLEN-IDX) = +0 DTSCS1A 02059 GO TO P8311-EXIT. DTSCS1A 02060 DTSCS1A 02061 DTSCS1A 02062 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A 02063 DTSCS1A 02064 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS1A 02065 DTSCS1A 02066 SET MSKL-REC-TYPE TO MLEN-IDX. DTSCS1A 02067 DTSCS1A 02068 SET L810-OK-88 TO TRUE. DTSCS1A 02069 DTSCS1A 02070 PERFORM P8312-DELETE-LOOP THRU P8312-EXIT DTSCS1A 02071 UNTIL L810-NO-REC-88. DTSCS1A 02072 P8311-EXIT. DTSCS1A 02073 EXIT. DTSCS1A 02074 SKIP3 DTSCS1A 02075 P8312-DELETE-LOOP. DTSCS1A 02076 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS1A 02077 DTSCS1A 02078 IF L810-NO-REC-88 DTSCS1A 02079 GO TO P8312-EXIT. DTSCS1A 02080 DTSCS1A 02081 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS1A 02082 DTSCS1A 02083 PERFORM S810-DELETE THRU S810-EXIT. DTSCS1A 02084 P8312-EXIT. DTSCS1A 02085 EXIT. DTSCS1A 02086 SKIP3 DTSCS1A 02087 P8320-DELETE-MERA. DTSCS1A 02088 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A 02089 DTSCS1A 02090 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A 02091 DTSCS1A 02092 SET MERA-ERA-88 TO TRUE. DTSCS1A 02093 DTSCS1A 02094 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 02095 DTSCS1A 02096 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 02097 DTSCS1A 02098 IF L810-OK-88 DTSCS1A 02099 PERFORM S810-DELETE THRU S810-EXIT. DTSCS1A 02100 DTSCS1A 02101 DTSCS1A 02102 MOVE LOW-VALUES TO MAP-SOURCE-CD-AREA DTSCS1A 02103 MAP-CLAIMANT-SSN-AREA DTSCS1A 02104 MAP-CLAIMANT-NAME-AREA DTSCS1A 02105 MAP-PRED-EMP-NO-AREA DTSCS1A 02106 MAP-RESP-OP-ID-AREA DTSCS1A 02107 MAP-NOTE-AREA DTSCS1A 02108 MAP-STATUS-CD-AREA DTSCS1A 02109 MAP-MAIL-DATE-1-AREA DTSCS1A 02110 MAP-LETTER-1-CD-AREA DTSCS1A 02111 MAP-MAIL-DATE-2-AREA DTSCS1A 02112 MAP-RECEIVED-DATE-AREA DTSCS1A 02113 MAP-COOP-AGENCY-REQ-DATE-AREA DTSCS1A 02114 MAP-DETER-NOTSUB-DATE-AREA DTSCS1A 02115 MAP-FIELD-ASSIGN-DATE-AREA. DTSCS1A 02116 DTSCS1A 02117 MOVE LOW-VALUES TO MAP-CASS-IND-AREA DTSCS1A 02118 MAP-CASS-CD-AREA. DTSCS1A 02119 DTSCS1A 02120 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS1A 02121 P8320-EXIT. DTSCS1A 02122 EXIT. DTSCS1A 02123 EJECT DTSCS1A 02124 P8800-LOCK-EMPLOYER. DTSCS1A 02125 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS1A 02126 DTSCS1A 02127 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS1A 02128 DTSCS1A 02129 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS1A 02130 DTSCS1A 02131 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS1A 02132 DTSCS1A 02133 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS1A 02134 DTSCS1A 02135 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS1A 02136 DTSCS1A 02137 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS1A 02138 DTSCS1A 02139 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS1A 02140 DTSCS1A 02141 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS1A 02142 DTSCS1A 02143 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS1A 02144 P8800-EXIT. DTSCS1A 02145 EXIT. DTSCS1A 02146 EJECT DTSCS1A 02147 P8900-INITIALIZE-L331. DTSCS1A 02148 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS1A 02149 DTSCS1A 02150 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS1A 02151 DTSCS1A 02152 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS1A 02153 DTSCS1A 02154 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS1A 02155 P8900-EXIT. DTSCS1A 02156 EXIT. DTSCS1A 02157 EJECT DTSCS1A 02158 P8910-MPRF-UPDATE. DTSCS1A 02159 PERFORM S1190-READ-MPRF THRU S1190-EXIT. DTSCS1A 02160 DTSCS1A 02161 IF LCCM-MSG DTSCS1A 02162 GO TO S899-ABEND. DTSCS1A 02163 DTSCS1A 02164 DTSCS1A 02165 MOVE SPACES TO L331-REC-OCC-ID. DTSCS1A 02166 DTSCS1A 02167 DTSCS1A 02168 IF MAP-PRIMARY-NAME = MPRF-PRIMARY-NAME DTSCS1A 02169 NEXT SENTENCE DTSCS1A 02170 ELSE DTSCS1A 02171 MOVE 'MPRF-PRIMARY-NAME' TO L331-FIELD-NAME DTSCS1A 02172 MOVE MPRF-PRIMARY-NAME TO L331-FROM-VALUE DTSCS1A 02173 MOVE MAP-PRIMARY-NAME TO L331-TO-VALUE DTSCS1A 02174 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02175 MOVE MAP-PRIMARY-NAME TO MPRF-PRIMARY-NAME DTSCS1A 02176 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A 02177 DTSCS1A 02178 DTSCS1A 02179 IF MAP-ENTITY-NAME-IND = MPRF-ENTITY-NAME-IND DTSCS1A 02180 NEXT SENTENCE DTSCS1A 02181 ELSE DTSCS1A 02182 MOVE 'MPRF-ENTITY-NAME-IND' TO L331-FIELD-NAME DTSCS1A 02183 MOVE MPRF-ENTITY-NAME-IND TO L331-FROM-VALUE DTSCS1A 02184 MOVE MAP-ENTITY-NAME-IND TO L331-TO-VALUE DTSCS1A 02185 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02186 MOVE MAP-ENTITY-NAME-IND TO MPRF-ENTITY-NAME-IND DTSCS1A 02187 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A 02188 DTSCS1A 02189 DTSCS1A 02190 IF MAP-ENTITY-NAME = MPRF-ENTITY-NAME DTSCS1A 02191 NEXT SENTENCE DTSCS1A 02192 ELSE DTSCS1A 02193 MOVE 'MPRF-ENTITY-NAME' TO L331-FIELD-NAME DTSCS1A 02194 MOVE MPRF-ENTITY-NAME TO L331-FROM-VALUE DTSCS1A 02195 MOVE MAP-ENTITY-NAME TO L331-TO-VALUE DTSCS1A 02196 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02197 MOVE MAP-ENTITY-NAME TO MPRF-ENTITY-NAME DTSCS1A 02198 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A 02199 DTSCS1A 02200 DTSCS1A 02201 MOVE WRK-EMP-NO TO L203-EMP-NO. DTSCS1A 02202 DTSCS1A 02203 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSCS1A 02204 TO L203-TAX-REC-ADDR-EXISTS-IND. DTSCS1A 02205 DTSCS1A 02206 PERFORM S203-DETER-ZIPS THRU S203-EXIT. DTSCS1A 02207 DTSCS1A 02208 IF L203-FLD-ZIP NOT = MPRF-FLD-ZIP DTSCS1A 02209 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP DTSCS1A 02210 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A 02211 DTSCS1A 02212 IF L203-FLD-STATE NOT = MPRF-FLD-ST DTSCS1A 02213 MOVE L203-FLD-STATE TO MPRF-FLD-ST DTSCS1A 02214 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A 02215 DTSCS1A 02216 DTSCS1A 02217 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA. DTSCS1A 02218 DTSCS1A 02219 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT. DTSCS1A 02220 DTSCS1A 02221 IF L017-FEIN = MPRF-FEIN DTSCS1A 02222 NEXT SENTENCE DTSCS1A 02223 ELSE DTSCS1A 02224 MOVE 'MPRF-FEIN' TO L331-FIELD-NAME DTSCS1A 02225 MOVE SPACES TO L331-TO-VALUE DTSCS1A 02226 L331-FROM-VALUE DTSCS1A 02227 IF MPRF-FEIN NOT = +0 DTSCS1A 02228 MOVE MPRF-FEIN TO WRK-DISPLAY DTSCS1A 02229 STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE DTSCS1A 02230 ' ' DELIMITED BY SIZE DTSCS1A 02231 WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE DTSCS1A 02232 INTO L331-FROM-VALUE DTSCS1A 02233 END-IF DTSCS1A 02234 IF L017-FEIN NOT = +0 DTSCS1A 02235 MOVE L017-FEIN TO WRK-DISPLAY DTSCS1A 02236 STRING WRK-DISPLAY-FEIN-1 DELIMITED BY SIZE DTSCS1A 02237 ' ' DELIMITED BY SIZE DTSCS1A 02238 WRK-DISPLAY-FEIN-2 DELIMITED BY SIZE DTSCS1A 02239 INTO L331-TO-VALUE DTSCS1A 02240 END-IF DTSCS1A 02241 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02242 MOVE L017-FEIN TO MPRF-FEIN DTSCS1A 02243 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS1A 02244 DTSCS1A 02245 MOVE MPRF-REC TO MSKL-REC. DTSCS1A 02246 DTSCS1A 02247 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1A 02248 P8910-EXIT. DTSCS1A 02249 EXIT. DTSCS1A 02250 SKIP3 DTSCS1A 02251 P8920-MTAD-UPDATE. DTSCS1A 02252 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS1A 02253 DTSCS1A 02254 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A 02255 DTSCS1A 02256 SET MTAD-TAD-88 TO TRUE. DTSCS1A 02257 DTSCS1A 02258 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS1A 02259 DTSCS1A 02260 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 02261 DTSCS1A 02262 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 02263 DTSCS1A 02264 IF L810-NO-REC-88 DTSCS1A 02265 PERFORM P8921-MTAD-INITIALIZE THRU P8921-EXIT DTSCS1A 02266 PERFORM P8922-UPDATE THRU P8922-EXIT DTSCS1A 02267 MOVE MTAD-REC TO MSKL-REC DTSCS1A 02268 PERFORM S810-WRITE THRU S810-EXIT DTSCS1A 02269 ELSE DTSCS1A 02270 MOVE MSKL-REC TO MTAD-REC DTSCS1A 02271 PERFORM P8922-UPDATE THRU P8922-EXIT DTSCS1A 02272 MOVE MTAD-REC TO MSKL-REC DTSCS1A 02273 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1A 02274 P8920-EXIT. DTSCS1A 02275 EXIT. DTSCS1A 02276 SKIP3 DTSCS1A 02277 P8921-MTAD-INITIALIZE. DTSCS1A 02278 MOVE +0 TO MTAD-PURGE-DATE. DTSCS1A 02279 DTSCS1A 02280 MOVE LOW-VALUES TO MTAD-DATA-AREA. DTSCS1A 02281 DTSCS1A 02282 MOVE SPACES TO MTAD-ADDRESS. DTSCS1A 02283 DTSCS1A 02284 MOVE SPACES TO MTAD-PHONE-NUMBERS. DTSCS1A 02285 DTSCS1A 02286 MOVE SPACES TO MTAD-EMAIL-ADDRESS. DTSCS1A 02287 DTSCS1A 02288 SET MTAD-UC223-YES-88 TO TRUE. DTSCS1A 02289 DTSCS1A 02290 SET MTAD-MISSING-RPT-LTRS-YES-88 TO TRUE. DTSCS1A 02291 DTSCS1A 02292 SET MTAD-PHYSICAL-ADDRESS-NO-88 TO TRUE. DTSCS1A 02293 DTSCS1A 02294 SET MPRF-EFT-SOLICITED-NO-88 TO TRUE. DTSCS1A 02295 DTSCS1A 02296 SET MPRF-EFT-ENROLLED-NO-88 TO TRUE. DTSCS1A 02297 DTSCS1A 02298 SET MTAD-NOT-CONVERTED-88 TO TRUE. DTSCS1A 02299 DTSCS1A 02300 MOVE LCCM-CURR-RUN-DATE TO MTAD-ESTB-DATE DTSCS1A 02301 MTAD-CHNG-DATE. DTSCS1A 02302 P8921-EXIT. DTSCS1A 02303 EXIT. DTSCS1A 02304 SKIP3 DTSCS1A 02305 P8922-UPDATE. DTSCS1A 02306 MOVE 'MAILING ADDRESS' TO L331-REC-OCC-ID. DTSCS1A 02307 DTSCS1A 02308 MOVE LCCM-HOLD-ADDRESS-1 TO L072-ADDRESS. DTSCS1A 02309 DTSCS1A 02310 IF L072-ATTN-LINE = MTAD-ATTN-LINE DTSCS1A 02311 NEXT SENTENCE DTSCS1A 02312 ELSE DTSCS1A 02313 MOVE 'MTAD-ATTN-LINE' TO L331-FIELD-NAME DTSCS1A 02314 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE DTSCS1A 02315 MOVE L072-ATTN-LINE TO L331-TO-VALUE DTSCS1A 02316 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02317 MOVE L072-ATTN-LINE TO MTAD-ATTN-LINE DTSCS1A 02318 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02319 DTSCS1A 02320 IF L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1 DTSCS1A 02321 NEXT SENTENCE DTSCS1A 02322 ELSE DTSCS1A 02323 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME DTSCS1A 02324 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE DTSCS1A 02325 MOVE L072-DELIV-LINE-1 TO L331-TO-VALUE DTSCS1A 02326 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02327 MOVE L072-DELIV-LINE-1 TO MTAD-DELIV-LINE-1 DTSCS1A 02328 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02329 DTSCS1A 02330 IF L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2 DTSCS1A 02331 NEXT SENTENCE DTSCS1A 02332 ELSE DTSCS1A 02333 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME DTSCS1A 02334 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE DTSCS1A 02335 MOVE L072-DELIV-LINE-2 TO L331-TO-VALUE DTSCS1A 02336 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02337 MOVE L072-DELIV-LINE-2 TO MTAD-DELIV-LINE-2 DTSCS1A 02338 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02339 DTSCS1A 02340 IF L072-CITY = MTAD-CITY DTSCS1A 02341 NEXT SENTENCE DTSCS1A 02342 ELSE DTSCS1A 02343 MOVE 'MTAD-CITY' TO L331-FIELD-NAME DTSCS1A 02344 MOVE MTAD-CITY TO L331-FROM-VALUE DTSCS1A 02345 MOVE L072-CITY TO L331-TO-VALUE DTSCS1A 02346 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02347 MOVE L072-CITY TO MTAD-CITY DTSCS1A 02348 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02349 DTSCS1A 02350 IF L072-ST = MTAD-ST DTSCS1A 02351 NEXT SENTENCE DTSCS1A 02352 ELSE DTSCS1A 02353 MOVE 'MTAD-ST' TO L331-FIELD-NAME DTSCS1A 02354 MOVE MTAD-ST TO L331-FROM-VALUE DTSCS1A 02355 MOVE L072-ST TO L331-TO-VALUE DTSCS1A 02356 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02357 MOVE L072-ST TO MTAD-ST DTSCS1A 02358 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02359 DTSCS1A 02360 IF L072-ZIP = MTAD-ZIP DTSCS1A 02361 NEXT SENTENCE DTSCS1A 02362 ELSE DTSCS1A 02363 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME DTSCS1A 02364 MOVE MTAD-ZIP TO L331-FROM-VALUE DTSCS1A 02365 MOVE L072-ZIP TO L331-TO-VALUE DTSCS1A 02366 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02367 MOVE L072-ZIP TO MTAD-ZIP DTSCS1A 02368 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02369 DTSCS1A 02370 IF L072-ADVANCED-BARCODE = MTAD-ADVANCED-BARCODE DTSCS1A 02371 NEXT SENTENCE DTSCS1A 02372 ELSE DTSCS1A 02373 MOVE L072-ADVANCED-BARCODE TO MTAD-ADVANCED-BARCODE DTSCS1A 02374 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02375 DTSCS1A 02376 MOVE MAP-VOICE-1-AREA TO L021-S-TNO-AREA. DTSCS1A 02377 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A 02378 IF L021-TNO = MTAD-VOICE-1 DTSCS1A 02379 NEXT SENTENCE DTSCS1A 02380 ELSE DTSCS1A 02381 MOVE 'MTAD-VOICE-1' TO L331-FIELD-NAME DTSCS1A 02382 MOVE SPACE TO L331-FROM-VALUE DTSCS1A 02383 L331-TO-VALUE DTSCS1A 02384 STRING MTAD-VOICE-1-AREA-CD DELIMITED BY SIZE DTSCS1A 02385 ' ' DELIMITED BY SIZE DTSCS1A 02386 MTAD-VOICE-1-PREFIX DELIMITED BY SIZE DTSCS1A 02387 ' ' DELIMITED BY SIZE DTSCS1A 02388 MTAD-VOICE-1-SUFFIX DELIMITED BY SIZE DTSCS1A 02389 ' ' DELIMITED BY SIZE DTSCS1A 02390 MTAD-VOICE-1-EXT DELIMITED BY SIZE DTSCS1A 02391 INTO L331-FROM-VALUE DTSCS1A 02392 STRING L021-TNO-AREA-CD DELIMITED BY SIZE DTSCS1A 02393 ' ' DELIMITED BY SIZE DTSCS1A 02394 L021-TNO-PREFIX DELIMITED BY SIZE DTSCS1A 02395 ' ' DELIMITED BY SIZE DTSCS1A 02396 L021-TNO-SUFFIX DELIMITED BY SIZE DTSCS1A 02397 ' ' DELIMITED BY SIZE DTSCS1A 02398 L021-TNO-EXT DELIMITED BY SIZE DTSCS1A 02399 INTO L331-TO-VALUE DTSCS1A 02400 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02401 MOVE L021-TNO TO MTAD-VOICE-1 DTSCS1A 02402 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02403 DTSCS1A 02404 MOVE MAP-VOICE-2-AREA TO L021-S-TNO-AREA. DTSCS1A 02405 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A 02406 IF L021-TNO = MTAD-VOICE-2 DTSCS1A 02407 NEXT SENTENCE DTSCS1A 02408 ELSE DTSCS1A 02409 MOVE 'MTAD-VOICE-2' TO L331-FIELD-NAME DTSCS1A 02410 MOVE SPACE TO L331-FROM-VALUE DTSCS1A 02411 L331-TO-VALUE DTSCS1A 02412 STRING MTAD-VOICE-2-AREA-CD DELIMITED BY SIZE DTSCS1A 02413 ' ' DELIMITED BY SIZE DTSCS1A 02414 MTAD-VOICE-2-PREFIX DELIMITED BY SIZE DTSCS1A 02415 ' ' DELIMITED BY SIZE DTSCS1A 02416 MTAD-VOICE-2-SUFFIX DELIMITED BY SIZE DTSCS1A 02417 ' ' DELIMITED BY SIZE DTSCS1A 02418 MTAD-VOICE-2-EXT DELIMITED BY SIZE DTSCS1A 02419 INTO L331-FROM-VALUE DTSCS1A 02420 STRING L021-TNO-AREA-CD DELIMITED BY SIZE DTSCS1A 02421 ' ' DELIMITED BY SIZE DTSCS1A 02422 L021-TNO-PREFIX DELIMITED BY SIZE DTSCS1A 02423 ' ' DELIMITED BY SIZE DTSCS1A 02424 L021-TNO-SUFFIX DELIMITED BY SIZE DTSCS1A 02425 ' ' DELIMITED BY SIZE DTSCS1A 02426 L021-TNO-EXT DELIMITED BY SIZE DTSCS1A 02427 INTO L331-TO-VALUE DTSCS1A 02428 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02429 MOVE L021-TNO TO MTAD-VOICE-2 DTSCS1A 02430 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02431 DTSCS1A 02432 MOVE MAP-FAX-AREA TO L021-S-TNO-AREA. DTSCS1A 02433 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A 02434 IF L021-TNO = MTAD-FAX DTSCS1A 02435 NEXT SENTENCE DTSCS1A 02436 ELSE DTSCS1A 02437 MOVE 'MTAD-FAX' TO L331-FIELD-NAME DTSCS1A 02438 MOVE SPACE TO L331-FROM-VALUE DTSCS1A 02439 L331-TO-VALUE DTSCS1A 02440 STRING MTAD-FAX-AREA-CD DELIMITED BY SIZE DTSCS1A 02441 ' ' DELIMITED BY SIZE DTSCS1A 02442 MTAD-FAX-PREFIX DELIMITED BY SIZE DTSCS1A 02443 ' ' DELIMITED BY SIZE DTSCS1A 02444 MTAD-FAX-SUFFIX DELIMITED BY SIZE DTSCS1A 02445 ' ' DELIMITED BY SIZE DTSCS1A 02446 MTAD-FAX-EXT DELIMITED BY SIZE DTSCS1A 02447 INTO L331-FROM-VALUE DTSCS1A 02448 STRING L021-TNO-AREA-CD DELIMITED BY SIZE DTSCS1A 02449 ' ' DELIMITED BY SIZE DTSCS1A 02450 L021-TNO-PREFIX DELIMITED BY SIZE DTSCS1A 02451 ' ' DELIMITED BY SIZE DTSCS1A 02452 L021-TNO-SUFFIX DELIMITED BY SIZE DTSCS1A 02453 ' ' DELIMITED BY SIZE DTSCS1A 02454 L021-TNO-EXT DELIMITED BY SIZE DTSCS1A 02455 INTO L331-TO-VALUE DTSCS1A 02456 PERFORM S331-WRITE-MLOG THRU S331-EXIT DTSCS1A 02457 MOVE L021-TNO TO MTAD-FAX DTSCS1A 02458 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS1A 02459 P8922-EXIT. DTSCS1A 02460 EXIT. DTSCS1A 02461 SKIP3 DTSCS1A 02462 P8930-MERA-UPDATE. DTSCS1A 02463 SET WRK-UPD-MERA-YES-88 TO TRUE. DTSCS1A 02464 DTSCS1A 02465 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A 02466 DTSCS1A 02467 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A 02468 DTSCS1A 02469 SET MERA-ERA-88 TO TRUE. DTSCS1A 02470 DTSCS1A 02471 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 02472 DTSCS1A 02473 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 02474 DTSCS1A 02475 IF L810-NO-REC-88 DTSCS1A 02476 IF MPRF-CONVERTED-88 DTSCS1A 02477 SET WRK-UPD-MERA-NO-88 TO TRUE DTSCS1A 02478 ELSE DTSCS1A 02479 PERFORM P8931-MERA-INITIALIZE THRU P8931-EXIT DTSCS1A 02480 PERFORM P8932-UPDATE THRU P8932-EXIT DTSCS1A 02481 MOVE MERA-REC TO MSKL-REC DTSCS1A 02482 PERFORM S810-WRITE THRU S810-EXIT DTSCS1A 02483 END-IF DTSCS1A 02484 ELSE DTSCS1A 02485 MOVE MSKL-REC TO MERA-REC DTSCS1A 02486 PERFORM P8932-UPDATE THRU P8932-EXIT DTSCS1A 02487 MOVE MERA-REC TO MSKL-REC DTSCS1A 02488 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS1A 02489 P8930-EXIT. DTSCS1A 02490 EXIT. DTSCS1A 02491 SKIP3 DTSCS1A 02492 P8931-MERA-INITIALIZE. DTSCS1A 02493 MOVE +0 TO MERA-PURGE-DATE. DTSCS1A 02494 DTSCS1A 02495 MOVE LOW-VALUES TO MERA-DATA-AREA. DTSCS1A 02496 DTSCS1A 02497 SET MERA-SOURCE-UNK-88 TO TRUE. DTSCS1A 02498 DTSCS1A 02499 MOVE +0 TO MERA-CLAIMANT-SSN. DTSCS1A 02500 DTSCS1A 02501 MOVE SPACE TO MERA-CLAIMANT-NAME. DTSCS1A 02502 DTSCS1A 02503 MOVE SPACE TO MERA-RESPONSIBLE-OP-ID. DTSCS1A 02504 DTSCS1A 02505 MOVE +0 TO MERA-POT-PRED-EMP-NO. DTSCS1A 02506 DTSCS1A 02507 MOVE SPACE TO MERA-NOTE. DTSCS1A 02508 DTSCS1A 02509 SET MERA-LETTER-GENERIC-88 TO TRUE. DTSCS1A 02510 DTSCS1A 02511 SET MERA-FIRST-LABEL-NEEDED-88 TO TRUE. DTSCS1A 02512 DTSCS1A 02513 MOVE +1 TO MERA-LABEL-CNT. DTSCS1A 02514 DTSCS1A 02515 SET MERA-STATUS-SETUP-88 TO TRUE. DTSCS1A 02516 DTSCS1A 02517 MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE. DTSCS1A 02518 DTSCS1A 02519 MOVE +0 TO MERA-MAIL-DATE-1 DTSCS1A 02520 MERA-MAIL-DATE-2 DTSCS1A 02521 MERA-COOP-AGENCY-REQ-DATE DTSCS1A 02522 MERA-FIELD-ASSIGN-DATE DTSCS1A 02523 MERA-RECEIVED-DATE DTSCS1A 02524 MERA-DETER-NOTSUB-DATE. DTSCS1A 02525 DTSCS1A 02526 SET MERA-NOT-CONVERTED-88 TO TRUE. DTSCS1A 02527 DTSCS1A 02528 MOVE LCCM-CURR-RUN-DATE TO MERA-ESTB-DATE DTSCS1A 02529 MERA-CHNG-DATE. DTSCS1A 02530 P8931-EXIT. DTSCS1A 02531 EXIT. DTSCS1A 02532 SKIP3 DTSCS1A 02533 P8932-UPDATE. DTSCS1A 02534 IF MAP-SOURCE-CD = MERA-SOURCE-CD DTSCS1A 02535 NEXT SENTENCE DTSCS1A 02536 ELSE DTSCS1A 02537 MOVE MAP-SOURCE-CD TO MERA-SOURCE-CD DTSCS1A 02538 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02539 DTSCS1A 02540 DTSCS1A 02541 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS1A 02542 DTSCS1A 02543 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS1A 02544 DTSCS1A 02545 IF L020-SSN = MERA-CLAIMANT-SSN DTSCS1A 02546 NEXT SENTENCE DTSCS1A 02547 ELSE DTSCS1A 02548 MOVE L020-SSN TO MERA-CLAIMANT-SSN DTSCS1A 02549 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02550 DTSCS1A 02551 DTSCS1A 02552 IF MAP-CLAIMANT-NAME = MERA-CLAIMANT-NAME DTSCS1A 02553 NEXT SENTENCE DTSCS1A 02554 ELSE DTSCS1A 02555 MOVE MAP-CLAIMANT-NAME TO MERA-CLAIMANT-NAME DTSCS1A 02556 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02557 DTSCS1A 02558 DTSCS1A 02559 IF MAP-RESP-OP-ID = MERA-RESPONSIBLE-OP-ID DTSCS1A 02560 NEXT SENTENCE DTSCS1A 02561 ELSE DTSCS1A 02562 MOVE MAP-RESP-OP-ID TO MERA-RESPONSIBLE-OP-ID DTSCS1A 02563 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02564 DTSCS1A 02565 DTSCS1A 02566 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 02567 DTSCS1A 02568 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A 02569 DTSCS1A 02570 IF L018-EMP-NO = MERA-POT-PRED-EMP-NO DTSCS1A 02571 NEXT SENTENCE DTSCS1A 02572 ELSE DTSCS1A 02573 MOVE L018-EMP-NO TO MERA-POT-PRED-EMP-NO DTSCS1A 02574 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02575 DTSCS1A 02576 DTSCS1A 02577 IF MAP-NOTE = MERA-NOTE DTSCS1A 02578 NEXT SENTENCE DTSCS1A 02579 ELSE DTSCS1A 02580 MOVE MAP-NOTE TO MERA-NOTE DTSCS1A 02581 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02582 DTSCS1A 02583 DTSCS1A 02584 IF MAP-LETTER-1-CD = MERA-LETTER-1-CD DTSCS1A 02585 NEXT SENTENCE DTSCS1A 02586 ELSE DTSCS1A 02587 MOVE MAP-LETTER-1-CD TO MERA-LETTER-1-CD DTSCS1A 02588 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02589 DTSCS1A 02590 DTSCS1A 02591 IF MAP-STATUS-CD = MERA-STATUS-CD DTSCS1A 02592 NEXT SENTENCE DTSCS1A 02593 ELSE DTSCS1A 02594 MOVE MAP-STATUS-CD TO MERA-STATUS-CD DTSCS1A 02595 MOVE LCCM-CURR-RUN-DATE TO MERA-STATUS-CHNG-DATE DTSCS1A 02596 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE DTSCS1A 02597 IF MERA-STATUS-SETUP-88 DTSCS1A 02598 MOVE +1 TO MERA-LABEL-CNT. DTSCS1A 02599 DTSCS1A 02600 DTSCS1A 02601 MOVE MAP-MAIL-DATE-1-AREA TO L015-S-DATE-AREA. DTSCS1A 02602 DTSCS1A 02603 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 02604 DTSCS1A 02605 IF L015-DATE = MERA-MAIL-DATE-1 DTSCS1A 02606 NEXT SENTENCE DTSCS1A 02607 ELSE DTSCS1A 02608 MOVE L015-DATE TO MERA-MAIL-DATE-1 DTSCS1A 02609 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02610 DTSCS1A 02611 DTSCS1A 02612 MOVE MAP-MAIL-DATE-2-AREA TO L015-S-DATE-AREA. DTSCS1A 02613 DTSCS1A 02614 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 02615 DTSCS1A 02616 IF L015-DATE = MERA-MAIL-DATE-2 DTSCS1A 02617 NEXT SENTENCE DTSCS1A 02618 ELSE DTSCS1A 02619 MOVE L015-DATE TO MERA-MAIL-DATE-2 DTSCS1A 02620 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02621 DTSCS1A 02622 MOVE MAP-COOP-AGENCY-REQ-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 02623 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 02624 IF L015-DATE = MERA-COOP-AGENCY-REQ-DATE DTSCS1A 02625 NEXT SENTENCE DTSCS1A 02626 ELSE DTSCS1A 02627 MOVE L015-DATE TO MERA-COOP-AGENCY-REQ-DATE DTSCS1A 02628 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02629 DTSCS1A 02630 DTSCS1A 02631 MOVE MAP-FIELD-ASSIGN-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 02632 DTSCS1A 02633 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 02634 DTSCS1A 02635 IF L015-DATE = MERA-FIELD-ASSIGN-DATE DTSCS1A 02636 NEXT SENTENCE DTSCS1A 02637 ELSE DTSCS1A 02638 MOVE L015-DATE TO MERA-FIELD-ASSIGN-DATE DTSCS1A 02639 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02640 DTSCS1A 02641 DTSCS1A 02642 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 02643 DTSCS1A 02644 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 02645 DTSCS1A 02646 IF L015-DATE = MERA-RECEIVED-DATE DTSCS1A 02647 NEXT SENTENCE DTSCS1A 02648 ELSE DTSCS1A 02649 IF MERA-RECEIVED-DATE = ZERO DTSCS1A 02650 AND L015-VALID DTSCS1A 02651 PERFORM P8932A-CHK-CYCLE-A THRU P8932A-EXIT DTSCS1A 02652 END-IF DTSCS1A 02653 MOVE L015-DATE TO MERA-RECEIVED-DATE DTSCS1A 02654 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE DTSCS1A 02655 END-IF. DTSCS1A 02656 DTSCS1A 02657 DTSCS1A 02658 MOVE MAP-DETER-NOTSUB-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 02659 DTSCS1A 02660 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 02661 DTSCS1A 02662 IF L015-DATE = MERA-DETER-NOTSUB-DATE DTSCS1A 02663 NEXT SENTENCE DTSCS1A 02664 ELSE DTSCS1A 02665 MOVE L015-DATE TO MERA-DETER-NOTSUB-DATE DTSCS1A 02666 MOVE LCCM-CURR-RUN-DATE TO MERA-CHNG-DATE. DTSCS1A 02667 P8932-EXIT. DTSCS1A 02668 EXIT. DTSCS1A 02669 DTSCS1A 02670 P8932A-CHK-CYCLE-A. DTSCS1A 02671 IF MERA-STATUS-ACTIVE-88 DTSCS1A 02672 IF MPRF-STATUS-SUB-88 DTSCS1A 02673 SET MERA-STATUS-LIAB-88 TO TRUE DTSCS1A 02674 ELSE DTSCS1A 02675 IF MPRF-STATUS-UNK-88 DTSCS1A 02676 SET MERA-STATUS-RECD-88 TO TRUE DTSCS1A 02677 ELSE DTSCS1A 02678 SET MERA-STATUS-NOT-LIAB-88 TO TRUE DTSCS1A 02679 END-IF DTSCS1A 02680 END-IF DTSCS1A 02681 END-IF. DTSCS1A 02682 DTSCS1A 02683 P8932A-EXIT. DTSCS1A 02684 EXIT. DTSCS1A 02685 DTSCS1A 02686 P8950-POT-HOUSEHOLD. DTSCS1A 02687 IF MAP-POT-HOUSEHOLD-IND = 'Y' DTSCS1A 02688 NEXT SENTENCE DTSCS1A 02689 ELSE DTSCS1A 02690 GO TO P8950-EXIT. DTSCS1A 02691 DTSCS1A 02692 IF LCCM-SCR-ADD-LOCKED DTSCS1A 02693 SET L400-ADD-PENDING-1A-88 TO TRUE DTSCS1A 02694 ELSE DTSCS1A 02695 SET L400-DETERM-PENDING-88 TO TRUE. DTSCS1A 02696 MOVE WRK-EMP-NO TO L400-EMP-NO. DTSCS1A 02697 MOVE LCCM-CURR-RUN-DATE TO L400-CURR-RUN-DATE. DTSCS1A 02698 MOVE LCCM-OP-ID TO L400-OP-ID. DTSCS1A 02699 PERFORM S400-HOUSEHOLD THRU S400-EXIT. DTSCS1A 02700 DTSCS1A 02701 P8950-EXIT. DTSCS1A 02702 EXIT. DTSCS1A 02703 /*****************************************************************DTSCS1A 02704 * LINKS TO UTILITY MODULES DTSCS1A 02705 ******************************************************************DTSCS1A 02706 DTSCS1A 02707 S001-DATE. DTSCS1A 02708 EXEC CICS LINK DTSCS1A 02709 PROGRAM('DTSCU001') DTSCS1A 02710 COMMAREA(L001-COMM-AREA) DTSCS1A 02711 END-EXEC. DTSCS1A 02712 S001-EXIT. DTSCS1A 02713 EXIT. DTSCS1A 02714 SKIP3 DTSCS1A 02715 S015-DATE-FROM-SCREEN. DTSCS1A 02716 EXEC CICS LINK DTSCS1A 02717 PROGRAM('DTSCU015') DTSCS1A 02718 COMMAREA(L015-COMM-AREA) DTSCS1A 02719 END-EXEC. DTSCS1A 02720 S015-EXIT. DTSCS1A 02721 EXIT. DTSCS1A 02722 SKIP3 DTSCS1A 02723 S017-FEIN-FROM-SCREEN. DTSCS1A 02724 EXEC CICS LINK DTSCS1A 02725 PROGRAM('DTSCU017') DTSCS1A 02726 COMMAREA(L017-COMM-AREA) DTSCS1A 02727 END-EXEC. DTSCS1A 02728 S017-EXIT. DTSCS1A 02729 EXIT. DTSCS1A 02730 SKIP3 DTSCS1A 02731 S018-EMP-NO-FROM-SCREEN. DTSCS1A 02732 EXEC CICS LINK DTSCS1A 02733 PROGRAM('DTSCU018') DTSCS1A 02734 COMMAREA(L018-COMM-AREA) DTSCS1A 02735 END-EXEC. DTSCS1A 02736 S018-EXIT. DTSCS1A 02737 EXIT. DTSCS1A 02738 SKIP3 DTSCS1A 02739 S020-SSN-FROM-SCREEN. DTSCS1A 02740 EXEC CICS LINK DTSCS1A 02741 PROGRAM('DTSCU020') DTSCS1A 02742 COMMAREA(L020-COMM-AREA) DTSCS1A 02743 END-EXEC. DTSCS1A 02744 S020-EXIT. DTSCS1A 02745 EXIT. DTSCS1A 02746 SKIP3 DTSCS1A 02747 S021-TELNO-FROM-SCREEN. DTSCS1A 02748 EXEC CICS LINK DTSCS1A 02749 PROGRAM('DTSCU021') DTSCS1A 02750 COMMAREA(L021-COMM-AREA) DTSCS1A 02751 END-EXEC. DTSCS1A 02752 S021-EXIT. DTSCS1A 02753 EXIT. DTSCS1A 02754 SKIP3 DTSCS1A 02755 S031-REG-CODES. DTSCS1A 02756 EXEC CICS LINK DTSCS1A 02757 PROGRAM('DTSCU031') DTSCS1A 02758 COMMAREA(L031-COMM-AREA) DTSCS1A 02759 END-EXEC. DTSCS1A 02760 S031-EXIT. DTSCS1A 02761 EXIT. DTSCS1A 02762 SKIP3 DTSCS1A 02763 S061-FLD-REP-FIND. DTSCS1A 02764 EXEC CICS LINK DTSCS1A 02765 PROGRAM('DTSCU061') DTSCS1A 02766 COMMAREA(L061-COMM-AREA) DTSCS1A 02767 END-EXEC. DTSCS1A 02768 DTSCS1A 02769 IF L061-FILE-CLOSED DTSCS1A 02770 MOVE L061-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02771 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02772 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02773 GO TO MAINLINE-EXIT. DTSCS1A 02774 S061-EXIT. DTSCS1A 02775 EXIT. DTSCS1A 02776 SKIP3 DTSCS1A 02777 S062-FLD-REP-LOOKUP. DTSCS1A 02778 EXEC CICS LINK DTSCS1A 02779 PROGRAM('DTSCU062') DTSCS1A 02780 COMMAREA(L062-COMM-AREA) DTSCS1A 02781 END-EXEC. DTSCS1A 02782 DTSCS1A 02783 IF L062-FILE-CLOSED DTSCS1A 02784 MOVE L062-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02785 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02786 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02787 GO TO MAINLINE-EXIT. DTSCS1A 02788 S062-EXIT. DTSCS1A 02789 EXIT. DTSCS1A 02790 SKIP3 DTSCS1A 02791 S071-NAME-EDIT. DTSCS1A 02792 EXEC CICS LINK DTSCS1A 02793 PROGRAM('DTSCU071') DTSCS1A 02794 COMMAREA(L071-COMM-AREA) DTSCS1A 02795 END-EXEC. DTSCS1A 02796 S071-EXIT. DTSCS1A 02797 EXIT. DTSCS1A 02798 SKIP3 DTSCS1A 02799 S072-ADDRESS-EDIT. DTSCS1A 02800 EXEC CICS LINK DTSCS1A 02801 PROGRAM('DTSCU072') DTSCS1A 02802 COMMAREA(L072-COMM-AREA) DTSCS1A 02803 END-EXEC. DTSCS1A 02804 S072-EXIT. DTSCS1A 02805 EXIT. DTSCS1A 02806 SKIP3 DTSCS1A 02807 S073-TELNO-EDIT. DTSCS1A 02808 EXEC CICS LINK DTSCS1A 02809 PROGRAM('DTSCU073') DTSCS1A 02810 COMMAREA(L073-COMM-AREA) DTSCS1A 02811 END-EXEC. DTSCS1A 02812 S073-EXIT. DTSCS1A 02813 EXIT. DTSCS1A 02814 SKIP3 DTSCS1A 02815 S074-DUP-FEIN-EDIT. DTSCS1A 02816 EXEC CICS LINK DTSCS1A 02817 PROGRAM('DTSCU074') DTSCS1A 02818 COMMAREA(L074-COMM-AREA) DTSCS1A 02819 END-EXEC. DTSCS1A 02820 DTSCS1A 02821 IF L074-FILE-CLOSED-88 DTSCS1A 02822 MOVE L074-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02823 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02824 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02825 GO TO MAINLINE-EXIT. DTSCS1A 02826 S074-EXIT. DTSCS1A 02827 EXIT. DTSCS1A 02828 SKIP3 DTSCS1A 02829 S081-CLAIMANT-NAME-LOOKUP. DTSCS1A 02830 EXEC CICS LINK DTSCS1A 02831 PROGRAM('DTSCU081') DTSCS1A 02832 COMMAREA(L081-COMM-AREA) DTSCS1A 02833 END-EXEC. DTSCS1A 02834 DTSCS1A 02835 IF L081-FILE-CLOSED DTSCS1A 02836 MOVE L081-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02837 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02838 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02839 GO TO MAINLINE-EXIT. DTSCS1A 02840 S081-EXIT. DTSCS1A 02841 EXIT. DTSCS1A 02842 SKIP3 DTSCS1A 02843 S082-OP-ID-LOOKUP. DTSCS1A 02844 EXEC CICS LINK DTSCS1A 02845 PROGRAM('DTSCU082') DTSCS1A 02846 COMMAREA(L082-COMM-AREA) DTSCS1A 02847 END-EXEC. DTSCS1A 02848 DTSCS1A 02849 IF L082-FILE-CLOSED DTSCS1A 02850 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02851 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02852 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02853 GO TO MAINLINE-EXIT. DTSCS1A 02854 S082-EXIT. DTSCS1A 02855 EXIT. DTSCS1A 02856 SKIP3 DTSCS1A 02857 S203-DETER-ZIPS. DTSCS1A 02858 EXEC CICS LINK DTSCS1A 02859 PROGRAM('DTSCU203') DTSCS1A 02860 COMMAREA(L203-COMM-AREA) DTSCS1A 02861 END-EXEC. DTSCS1A 02862 DTSCS1A 02863 IF L203-FILE-CLOSED-88 DTSCS1A 02864 MOVE L203-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02865 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02866 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02867 GO TO MAINLINE-EXIT. DTSCS1A 02868 S203-EXIT. DTSCS1A 02869 EXIT. DTSCS1A 02870 SKIP3 DTSCS1A 02871 S221-EMP-LOCK. DTSCS1A 02872 SET L221-START-UPDATE TO TRUE. DTSCS1A 02873 GO TO S221-EMP-LOCK-UNLOCK. DTSCS1A 02874 DTSCS1A 02875 S221-EMP-UNLOCK. DTSCS1A 02876 SET L221-END-UPDATE TO TRUE. DTSCS1A 02877 GO TO S221-EMP-LOCK-UNLOCK. DTSCS1A 02878 DTSCS1A 02879 S221-EMP-LOCK-UNLOCK. DTSCS1A 02880 EXEC CICS LINK DTSCS1A 02881 PROGRAM('DTSCU221') DTSCS1A 02882 COMMAREA(L221-COMM-AREA) DTSCS1A 02883 END-EXEC. DTSCS1A 02884 DTSCS1A 02885 IF L221-FILE-CLOSED DTSCS1A 02886 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02887 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02888 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02889 GO TO MAINLINE-EXIT. DTSCS1A 02890 DTSCS1A 02891 IF L221-END-UPDATE DTSCS1A 02892 AND DTSCS1A 02893 L221-NO-REC DTSCS1A 02894 GO TO S221-EXIT. DTSCS1A 02895 DTSCS1A 02896 IF L221-NOT-OK DTSCS1A 02897 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS1A 02898 S221-EXIT. DTSCS1A 02899 EXIT. DTSCS1A 02900 SKIP3 DTSCS1A 02901 S331-WRITE-MLOG. DTSCS1A 02902 EXEC CICS LINK DTSCS1A 02903 PROGRAM('DTSCU331') DTSCS1A 02904 COMMAREA(L331-COMM-AREA) DTSCS1A 02905 END-EXEC. DTSCS1A 02906 DTSCS1A 02907 IF L331-FILE-CLOSED DTSCS1A 02908 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 02909 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 02910 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 02911 GO TO MAINLINE-EXIT. DTSCS1A 02912 S331-EXIT. DTSCS1A 02913 EXIT. DTSCS1A 02914 SKIP3 DTSCS1A 02915 S400-HOUSEHOLD. DTSCS1A 02916 MOVE ZERO TO L400-FIRST-LIAB-YRQ. DTSCS1A 02917 MOVE SPACES TO L400-ORG-TYPE DTSCS1A 02918 L400-FILING-SCHED. DTSCS1A 02919 DTSCS1A 02920 EXEC CICS LINK DTSCS1A 02921 PROGRAM('DTSCU400') DTSCS1A 02922 COMMAREA(L400-COMM-AREA) DTSCS1A 02923 END-EXEC. DTSCS1A 02924 DTSCS1A 02925 S400-EXIT. DTSCS1A 02926 EXIT. DTSCS1A 02927 SKIP3 DTSCS1A 02928 S803-REQ-SCR-ID-EDIT. DTSCS1A 02929 EXEC CICS LINK DTSCS1A 02930 PROGRAM ('DTSCU803') DTSCS1A 02931 COMMAREA (DFHCOMMAREA) DTSCS1A 02932 END-EXEC. DTSCS1A 02933 S803-EXIT. DTSCS1A 02934 EXIT. DTSCS1A 02935 SKIP3 DTSCS1A 02936 S804-INVALID-KEY. DTSCS1A 02937 EXEC CICS LINK DTSCS1A 02938 PROGRAM ('DTSCU804') DTSCS1A 02939 COMMAREA (DFHCOMMAREA) DTSCS1A 02940 END-EXEC. DTSCS1A 02941 S804-EXIT. DTSCS1A 02942 EXIT. DTSCS1A 02943 SKIP3 DTSCS1A 02944 S805-MSG-AREA. DTSCS1A 02945 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS1A 02946 DTSCS1A 02947 EXEC CICS LINK DTSCS1A 02948 PROGRAM ('DTSCU805') DTSCS1A 02949 COMMAREA (L805-COMM-AREA) DTSCS1A 02950 END-EXEC. DTSCS1A 02951 DTSCS1A 02952 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS1A 02953 S805-EXIT. DTSCS1A 02954 EXIT. DTSCS1A 02955 EJECT DTSCS1A 02956 S810-READ. DTSCS1A 02957 SET L810-READ-88 TO TRUE. DTSCS1A 02958 GO TO S810-IO. DTSCS1A 02959 DTSCS1A 02960 S810-START-BROWSE. DTSCS1A 02961 SET L810-START-BROWSE-88 TO TRUE. DTSCS1A 02962 GO TO S810-IO. DTSCS1A 02963 DTSCS1A 02964 S810-READ-NEXT. DTSCS1A 02965 SET L810-READ-NEXT-88 TO TRUE. DTSCS1A 02966 GO TO S810-IO. DTSCS1A 02967 DTSCS1A 02968 S810-READ-PREV. DTSCS1A 02969 SET L810-READ-PREV-88 TO TRUE. DTSCS1A 02970 GO TO S810-IO. DTSCS1A 02971 DTSCS1A 02972 S810-END-BROWSE. DTSCS1A 02973 SET L810-END-BROWSE-88 TO TRUE. DTSCS1A 02974 GO TO S810-IO. DTSCS1A 02975 DTSCS1A 02976 S810-REWRITE. DTSCS1A 02977 SET L810-REWRITE-88 TO TRUE. DTSCS1A 02978 GO TO S810-IO. DTSCS1A 02979 DTSCS1A 02980 S810-WRITE. DTSCS1A 02981 SET L810-WRITE-88 TO TRUE. DTSCS1A 02982 GO TO S810-IO. DTSCS1A 02983 DTSCS1A 02984 S810-DELETE. DTSCS1A 02985 SET L810-DELETE-88 TO TRUE. DTSCS1A 02986 GO TO S810-IO. DTSCS1A 02987 DTSCS1A 02988 S810-READ-UPDATE. DTSCS1A 02989 SET L810-READ-UPDATE-88 TO TRUE. DTSCS1A 02990 GO TO S810-IO. DTSCS1A 02991 DTSCS1A 02992 S810-REWRITE-UPDATE. DTSCS1A 02993 SET L810-REWRITE-UPDATE-88 TO TRUE. DTSCS1A 02994 GO TO S810-IO. DTSCS1A 02995 DTSCS1A 02996 S810-IO. DTSCS1A 02997 DTSCS1A 02998 EXEC CICS LINK DTSCS1A 02999 PROGRAM ('DTSCU810') DTSCS1A 03000 COMMAREA (L810-COMM-AREA) DTSCS1A 03001 END-EXEC. DTSCS1A 03002 DTSCS1A 03003 IF L810-FILE-CLOSED-88 DTSCS1A 03004 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03005 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 03006 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 03007 GO TO MAINLINE-EXIT. DTSCS1A 03008 S810-EXIT. DTSCS1A 03009 EXIT. DTSCS1A 03010 EJECT DTSCS1A 03011 S821-START-BROWSE. DTSCS1A 03012 SET L821-START-BROWSE-88 TO TRUE. DTSCS1A 03013 GO TO S821-I. DTSCS1A 03014 S821-READ-NEXT. DTSCS1A 03015 SET L821-READ-NEXT-88 TO TRUE. DTSCS1A 03016 GO TO S821-I. DTSCS1A 03017 DTSCS1A 03018 S821-END-BROWSE. DTSCS1A 03019 SET L821-END-BROWSE-88 TO TRUE. DTSCS1A 03020 GO TO S821-I. DTSCS1A 03021 DTSCS1A 03022 S821-I. DTSCS1A 03023 EXEC CICS LINK DTSCS1A 03024 PROGRAM ('DTSCU821') DTSCS1A 03025 COMMAREA (L821-COMM-AREA) DTSCS1A 03026 END-EXEC. DTSCS1A 03027 IF L821-FILE-CLOSED-88 DTSCS1A 03028 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03029 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 03030 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 03031 GO TO MAINLINE-EXIT. DTSCS1A 03032 S821-EXIT. DTSCS1A 03033 EXIT. DTSCS1A 03034 DTSCS1A 03035 S831-READ. DTSCS1A 03036 SET L831-READ-88 TO TRUE. DTSCS1A 03037 SKIP1 DTSCS1A 03038 EXEC CICS LINK DTSCS1A 03039 PROGRAM ('DTSCU831') DTSCS1A 03040 COMMAREA (L831-COMM-AREA) DTSCS1A 03041 END-EXEC. DTSCS1A 03042 SKIP1 DTSCS1A 03043 IF L831-FILE-CLOSED-88 DTSCS1A 03044 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03045 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS1A 03046 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS1A 03047 GO TO MAINLINE-EXIT. DTSCS1A 03048 S831-EXIT. DTSCS1A 03049 EXIT. DTSCS1A 03050 EJECT DTSCS1A 03051 S851-SCREEN-PROCESSING. DTSCS1A 03052 EXEC CICS LINK DTSCS1A 03053 PROGRAM ('DTSCU851') DTSCS1A 03054 COMMAREA (L851-COMM-AREA) DTSCS1A 03055 END-EXEC. DTSCS1A 03056 S851-EXIT. DTSCS1A 03057 EXIT. DTSCS1A 03058 SKIP3 DTSCS1A 03059 S899-ABEND. DTSCS1A 03060 EXEC CICS ABEND DTSCS1A 03061 ABCODE(WRK-ABEND-CD) DTSCS1A 03062 END-EXEC. DTSCS1A 03063 S899-EXIT. DTSCS1A 03064 EXIT. DTSCS1A 03065 /*****************************************************************DTSCS1A 03066 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS1A 03067 ******************************************************************DTSCS1A 03068 DTSCS1A 03069 S1000-SCREEN-EDITS. DTSCS1A 03070 MOVE LOW-VALUES TO MAP-CASS-CD. DTSCS1A 03071 DTSCS1A 03072 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS1A 03073 DTSCS1A 03074 IF LCCM-MSG DTSCS1A 03075 GO TO S1000-EXIT. DTSCS1A 03076 DTSCS1A 03077 DTSCS1A 03078 PERFORM S1010-READ-MERA THRU S1010-EXIT. DTSCS1A 03079 DTSCS1A 03080 PERFORM S1020-READ-MTAD THRU S1020-EXIT. DTSCS1A 03081 DTSCS1A 03082 PERFORM S1030-READ-MFAE THRU S1030-EXIT. DTSCS1A 03083 DTSCS1A 03084 DTSCS1A 03085 PERFORM S1200-DELETE-EMP THRU S1200-EXIT. DTSCS1A 03086 DTSCS1A 03087 PERFORM S1300-ELIGIBLE-CD THRU S1300-EXIT. DTSCS1A 03088 DTSCS1A 03089 PERFORM S1400-PRIMARY-NAME THRU S1400-EXIT. DTSCS1A 03090 DTSCS1A 03091 PERFORM S1410-ENTITY-IND THRU S1410-EXIT. DTSCS1A 03092 DTSCS1A 03093 PERFORM S1500-ENTITY-NAME THRU S1500-EXIT. DTSCS1A 03094 DTSCS1A 03095 PERFORM S1600-EDIT-ADDRESS THRU S1600-EXIT. DTSCS1A 03096 DTSCS1A 03097 PERFORM S1710-VOICE-1 THRU S1710-EXIT. DTSCS1A 03098 DTSCS1A 03099 PERFORM S1720-VOICE-2 THRU S1720-EXIT. DTSCS1A 03100 DTSCS1A 03101 PERFORM S1730-FAX THRU S1730-EXIT. DTSCS1A 03102 DTSCS1A 03103 PERFORM S1800-SOURCE-CD THRU S1800-EXIT. DTSCS1A 03104 DTSCS1A 03105 PERFORM S1900-FEIN THRU S1900-EXIT. DTSCS1A 03106 DTSCS1A 03107 PERFORM S1950-POT-HOUSEHOLD THRU S1950-EXIT. DTSCS1A 03108 DTSCS1A 03109 PERFORM S2000-CLAIMANT-SSN THRU S2000-EXIT. DTSCS1A 03110 DTSCS1A 03111 PERFORM S2010-CLAIMANT-NAME THRU S2010-EXIT. DTSCS1A 03112 DTSCS1A 03113 PERFORM S2100-POT-PRED-EMP-NO THRU S2100-EXIT. DTSCS1A 03114 DTSCS1A 03115 PERFORM S2200-RESPONSIBLE-OP-ID THRU S2200-EXIT. DTSCS1A 03116 DTSCS1A 03117 PERFORM S2300-NOTE THRU S2300-EXIT. DTSCS1A 03118 DTSCS1A 03119 PERFORM S2600-STATUS-CD THRU S2600-EXIT. DTSCS1A 03120 DTSCS1A 03121 PERFORM S2700-MAIL-DATE-1 THRU S2700-EXIT. DTSCS1A 03122 DTSCS1A 03123 PERFORM S2800-LETTER-1-CD THRU S2800-EXIT. DTSCS1A 03124 DTSCS1A 03125 PERFORM S2900-MAIL-DATE-2 THRU S2900-EXIT. DTSCS1A 03126 DTSCS1A 03127 PERFORM S3000-RECEIVED-DATE THRU S3000-EXIT. DTSCS1A 03128 DTSCS1A 03129 PERFORM S3100-COOP-AGENCY-REQ-DATE THRU S3100-EXIT. DTSCS1A 03130 DTSCS1A 03131 PERFORM S3200-DETER-NOTSUB-DATE THRU S3200-EXIT. DTSCS1A 03132 DTSCS1A 03133 PERFORM S3300-FIELD-ASSIGN-DATE THRU S3300-EXIT. DTSCS1A 03134 DTSCS1A 03135 PERFORM S4000-CHK-FOR-DC-ADDR THRU S4000-EXIT. DTSCS1A 03136 S1000-EXIT. DTSCS1A 03137 EXIT. DTSCS1A 03138 SKIP3 DTSCS1A 03139 S1001-EDIT-KEY. DTSCS1A 03140 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS1A 03141 S1001-EXIT. DTSCS1A 03142 EXIT. DTSCS1A 03143 SKIP3 DTSCS1A 03144 S1010-READ-MERA. DTSCS1A 03145 MOVE LOW-VALUES TO MERA-KEY-AREA. DTSCS1A 03146 DTSCS1A 03147 MOVE WRK-EMP-NO TO MERA-EMP-NO. DTSCS1A 03148 DTSCS1A 03149 SET MERA-ERA-88 TO TRUE. DTSCS1A 03150 DTSCS1A 03151 MOVE MERA-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 03152 DTSCS1A 03153 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 03154 DTSCS1A 03155 IF L810-OK-88 DTSCS1A 03156 MOVE MSKL-REC TO MERA-REC DTSCS1A 03157 SET WRK-MERA-YES-88 TO TRUE. DTSCS1A 03158 S1010-EXIT. DTSCS1A 03159 EXIT. DTSCS1A 03160 SKIP3 DTSCS1A 03161 S1020-READ-MTAD. DTSCS1A 03162 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS1A 03163 DTSCS1A 03164 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A 03165 DTSCS1A 03166 SET MTAD-TAD-88 TO TRUE. DTSCS1A 03167 DTSCS1A 03168 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSCS1A 03169 DTSCS1A 03170 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 03171 DTSCS1A 03172 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 03173 DTSCS1A 03174 IF L810-OK-88 DTSCS1A 03175 MOVE MSKL-REC TO MTAD-REC DTSCS1A 03176 SET WRK-MTAD-YES-88 TO TRUE. DTSCS1A 03177 S1020-EXIT. DTSCS1A 03178 EXIT. DTSCS1A 03179 EJECT DTSCS1A 03180 S1030-READ-MFAE. DTSCS1A 03181 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS1A 03182 DTSCS1A 03183 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS1A 03184 DTSCS1A 03185 SET MFAE-FAE-88 TO TRUE. DTSCS1A 03186 DTSCS1A 03187 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A 03188 DTSCS1A 03189 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 03190 DTSCS1A 03191 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 03192 DTSCS1A 03193 IF L810-OK-88 DTSCS1A 03194 MOVE MSKL-REC TO MFAE-REC DTSCS1A 03195 SET WRK-MFAE-YES-88 TO TRUE. DTSCS1A 03196 S1030-EXIT. DTSCS1A 03197 EXIT. DTSCS1A 03198 EJECT DTSCS1A 03199 S1100-EMP-NO. DTSCS1A 03200 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 03201 DTSCS1A 03202 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A 03203 DTSCS1A 03204 IF LCCM-F09-88 DTSCS1A 03205 PERFORM S1110-ADD THRU S1110-EXIT DTSCS1A 03206 GO TO S1100-EXIT. DTSCS1A 03207 DTSCS1A 03208 IF L018-NO-ENTRY DTSCS1A 03209 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 03210 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03211 ELSE DTSCS1A 03212 IF L018-NOT-VALID DTSCS1A 03213 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03214 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03215 ELSE DTSCS1A 03216 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS1A 03217 IF ((WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A 03218 AND DTSCS1A 03219 (WRK-EMP-NO <= CENO-FED-END-EMP-NO)) DTSCS1A 03220 OR DTSCS1A 03221 ((WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A 03222 AND DTSCS1A 03223 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO)) DTSCS1A 03224 OR DTSCS1A 03225 ((WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A 03226 AND DTSCS1A 03227 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO)) DTSCS1A 03228 SET WRK-EMP-CHG-ONLY-88 TO TRUE. DTSCS1A 03229 S1100-EXIT. DTSCS1A 03230 EXIT. DTSCS1A 03231 SKIP3 DTSCS1A 03232 S1110-ADD. DTSCS1A 03233 IF L018-NO-ENTRY DTSCS1A 03234 NEXT SENTENCE DTSCS1A 03235 ELSE DTSCS1A 03236 IF L018-NOT-VALID DTSCS1A 03237 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03238 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03239 ELSE DTSCS1A 03240 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS1A 03241 IF ((WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A 03242 AND DTSCS1A 03243 (WRK-EMP-NO <= CENO-FED-END-EMP-NO)) DTSCS1A 03244 OR DTSCS1A 03245 ((WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A 03246 AND DTSCS1A 03247 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO)) DTSCS1A 03248 OR DTSCS1A 03249 ((WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A 03250 AND DTSCS1A 03251 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO)) DTSCS1A 03252 SET WRK-EMP-CHG-ONLY-88 TO TRUE DTSCS1A 03253 ELSE DTSCS1A 03254 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03255 PERFORM S1199-ERROR THRU S1199-EXIT. DTSCS1A 03256 S1110-EXIT. DTSCS1A 03257 EXIT. DTSCS1A 03258 SKIP3 DTSCS1A 03259 S1190-READ-MPRF. DTSCS1A 03260 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A 03261 DTSCS1A 03262 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS1A 03263 DTSCS1A 03264 SET MPRF-PRF-88 TO TRUE. DTSCS1A 03265 DTSCS1A 03266 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 03267 DTSCS1A 03268 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 03269 DTSCS1A 03270 IF L810-NO-REC-88 DTSCS1A 03271 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS1A 03272 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03273 ELSE DTSCS1A 03274 SET WRK-MPRF-YES-88 TO TRUE DTSCS1A 03275 MOVE MSKL-REC TO MPRF-REC DTSCS1A 03276 IF MPRF-CLASS-CHG-ONLY-88 DTSCS1A 03277 SET WRK-EMP-CHG-ONLY-88 TO TRUE. DTSCS1A 03278 S1190-EXIT. DTSCS1A 03279 EXIT. DTSCS1A 03280 SKIP3 DTSCS1A 03281 S1199-ERROR. DTSCS1A 03282 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS1A 03283 MAP-EMP-NO-2-A. DTSCS1A 03284 DTSCS1A 03285 IF LCCM-NO-MSG DTSCS1A 03286 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03287 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS1A 03288 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03289 S1199-EXIT. DTSCS1A 03290 EXIT. DTSCS1A 03291 /*****************************************************************DTSCS1A 03292 * *DTSCS1A 03293 ******************************************************************DTSCS1A 03294 S1200-DELETE-EMP. DTSCS1A 03295 IF LCCM-F23-88 DTSCS1A 03296 NEXT SENTENCE DTSCS1A 03297 ELSE DTSCS1A 03298 MOVE SPACES TO MAP-DELETE-EMP-IND DTSCS1A 03299 GO TO S1200-EXIT. DTSCS1A 03300 DTSCS1A 03301 IF MAP-DELETE-EMP-IND = SPACES OR LOW-VALUES DTSCS1A 03302 SET MAP-DELETE-EMP-NO-88 TO TRUE. DTSCS1A 03303 DTSCS1A 03304 IF MAP-DELETE-EMP-VALID-88 DTSCS1A 03305 NEXT SENTENCE DTSCS1A 03306 ELSE DTSCS1A 03307 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03308 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS1A 03309 S1200-EXIT. EXIT. DTSCS1A 03310 DTSCS1A 03311 DTSCS1A 03312 DTSCS1A 03313 S1201-ERROR. DTSCS1A 03314 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELETE-EMP-IND-A. DTSCS1A 03315 DTSCS1A 03316 IF LCCM-NO-MSG DTSCS1A 03317 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03318 MOVE CATB-CURSOR TO MAP-DELETE-EMP-IND-L DTSCS1A 03319 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03320 S1201-EXIT. EXIT. DTSCS1A 03321 /*****************************************************************DTSCS1A 03322 * *DTSCS1A 03323 ******************************************************************DTSCS1A 03324 S1300-ELIGIBLE-CD. DTSCS1A 03325 IF MAP-ELIGIBLE-CD = LOW-VALUES DTSCS1A 03326 MOVE SPACES TO MAP-ELIGIBLE-CD. DTSCS1A 03327 DTSCS1A 03328 IF LCCM-F09-88 DTSCS1A 03329 NEXT SENTENCE DTSCS1A 03330 ELSE DTSCS1A 03331 MOVE SPACES TO MAP-ELIGIBLE-CD DTSCS1A 03332 GO TO S1300-EXIT. DTSCS1A 03333 DTSCS1A 03334 IF WRK-EMP-NO = +0 DTSCS1A 03335 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A 03336 GO TO S1300-EXIT DTSCS1A 03337 ELSE DTSCS1A 03338 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A 03339 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A 03340 GO TO S1300-EXIT. DTSCS1A 03341 DTSCS1A 03342 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A 03343 NEXT SENTENCE DTSCS1A 03344 ELSE DTSCS1A 03345 SET L031-MPRF-ELIGIBLE-CD TO TRUE DTSCS1A 03346 MOVE MAP-ELIGIBLE-CD TO L031-CD-3 DTSCS1A 03347 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A 03348 IF L031-VALID DTSCS1A 03349 NEXT SENTENCE DTSCS1A 03350 ELSE DTSCS1A 03351 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03352 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A 03353 GO TO S1300-EXIT. DTSCS1A 03354 DTSCS1A 03355 IF (WRK-EMP-NO >= CENO-FED-START-EMP-NO) DTSCS1A 03356 AND DTSCS1A 03357 (WRK-EMP-NO <= CENO-FED-END-EMP-NO) DTSCS1A 03358 PERFORM S1310-FED-CHG-ONLY THRU S1310-EXIT DTSCS1A 03359 ELSE DTSCS1A 03360 IF (WRK-EMP-NO >= CENO-CWC-START-EMP-NO) DTSCS1A 03361 AND DTSCS1A 03362 (WRK-EMP-NO <= CENO-CWC-END-EMP-NO) DTSCS1A 03363 PERFORM S1320-CWC-CHG-ONLY THRU S1320-EXIT DTSCS1A 03364 ELSE DTSCS1A 03365 IF (WRK-EMP-NO >= CENO-NEW-CHG-ONLY-START-EMP-NO) DTSCS1A 03366 AND DTSCS1A 03367 (WRK-EMP-NO <= CENO-NEW-CHG-ONLY-END-EMP-NO) DTSCS1A 03368 PERFORM S1330-POOL-CHG-ONLY THRU S1330-EXIT DTSCS1A 03369 ELSE DTSCS1A 03370 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A 03371 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A 03372 S1300-EXIT. EXIT. DTSCS1A 03373 DTSCS1A 03374 DTSCS1A 03375 DTSCS1A 03376 S1310-FED-CHG-ONLY. DTSCS1A 03377 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A 03378 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 03379 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A 03380 ELSE DTSCS1A 03381 IF MAP-ELIGIBLE-CD = '001' OR '002' DTSCS1A 03382 NEXT SENTENCE DTSCS1A 03383 ELSE DTSCS1A 03384 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1A 03385 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03386 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A 03387 S1310-EXIT. DTSCS1A 03388 EXIT. DTSCS1A 03389 DTSCS1A 03390 DTSCS1A 03391 DTSCS1A 03392 S1320-CWC-CHG-ONLY. DTSCS1A 03393 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A 03394 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 03395 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A 03396 ELSE DTSCS1A 03397 IF MAP-ELIGIBLE-CD = '004' DTSCS1A 03398 NEXT SENTENCE DTSCS1A 03399 ELSE DTSCS1A 03400 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1A 03401 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03402 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A 03403 S1320-EXIT. DTSCS1A 03404 EXIT. DTSCS1A 03405 DTSCS1A 03406 DTSCS1A 03407 DTSCS1A 03408 S1330-POOL-CHG-ONLY. DTSCS1A 03409 IF MAP-ELIGIBLE-CD = SPACES DTSCS1A 03410 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 03411 PERFORM S1399-ERROR THRU S1399-EXIT DTSCS1A 03412 ELSE DTSCS1A 03413 IF MAP-ELIGIBLE-CD = '005' OR '006' OR '007' OR '009' DTSCS1A 03414 OR '010' OR '015' OR '016' OR '017' DTSCS1A 03415 OR '018' OR '019' OR '020' OR '021' DTSCS1A 03416 OR '022' OR '023' OR '024' OR '025' DTSCS1A 03417 OR '026' OR '027' OR '028' OR '029' DTSCS1A 03418 OR '030' OR '032' OR '033' OR '034' DTSCS1A 03419 OR '035' OR '036' OR '037' OR '038' DTSCS1A 03420 OR '039' DTSCS1A 03421 NEXT SENTENCE DTSCS1A 03422 ELSE DTSCS1A 03423 MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA DTSCS1A 03424 PERFORM S1199-ERROR THRU S1199-EXIT DTSCS1A 03425 PERFORM S1399-ERROR THRU S1399-EXIT. DTSCS1A 03426 S1330-EXIT. DTSCS1A 03427 EXIT. DTSCS1A 03428 DTSCS1A 03429 DTSCS1A 03430 DTSCS1A 03431 S1399-ERROR. DTSCS1A 03432 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELIGIBLE-CD-A. DTSCS1A 03433 DTSCS1A 03434 IF LCCM-NO-MSG DTSCS1A 03435 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03436 MOVE CATB-CURSOR TO MAP-ELIGIBLE-CD-L DTSCS1A 03437 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03438 S1399-EXIT. EXIT. DTSCS1A 03439 /*****************************************************************DTSCS1A 03440 * *DTSCS1A 03441 ******************************************************************DTSCS1A 03442 S1400-PRIMARY-NAME. DTSCS1A 03443 IF MAP-PRIMARY-NAME = LOW-VALUES OR SPACES DTSCS1A 03444 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 03445 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS1A 03446 ELSE DTSCS1A 03447 IF MAP-PRIMARY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS1A 03448 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03449 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS1A 03450 ELSE DTSCS1A 03451 IF NOT MAP-VERIFY-YES-88 DTSCS1A 03452 MOVE MAP-PRIMARY-NAME TO WRK-NAME DTSCS1A 03453 PERFORM S1550-CHECK-DUP-NAME THRU S1550-EXIT DTSCS1A 03454 IF WRK-MSG-ID = 'E1A6' DTSCS1A 03455 PERFORM S1402-ERROR THRU S1402-EXIT DTSCS1A 03456 END-IF DTSCS1A 03457 END-IF DTSCS1A 03458 END-IF DTSCS1A 03459 END-IF. DTSCS1A 03460 DTSCS1A 03461 S1400-EXIT. EXIT. DTSCS1A 03462 DTSCS1A 03463 DTSCS1A 03464 DTSCS1A 03465 S1401-ERROR. DTSCS1A 03466 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A. DTSCS1A 03467 DTSCS1A 03468 IF LCCM-NO-MSG DTSCS1A 03469 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03470 MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L DTSCS1A 03471 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03472 S1401-EXIT. EXIT. DTSCS1A 03473 DTSCS1A 03474 S1402-ERROR. DTSCS1A 03475 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS1A 03476 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A 03477 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A 03478 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A 03479 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A. DTSCS1A 03480 IF LCCM-NO-MSG DTSCS1A 03481 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03482 MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L DTSCS1A 03483 SET CURSOR-SET-YES TO TRUE DTSCS1A 03484 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS1A 03485 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS1A 03486 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A 03487 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A 03488 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A 03489 END-IF. DTSCS1A 03490 S1402-EXIT. DTSCS1A 03491 EXIT. DTSCS1A 03492 DTSCS1A 03493 /*****************************************************************DTSCS1A 03494 * *DTSCS1A 03495 ******************************************************************DTSCS1A 03496 S1410-ENTITY-IND. DTSCS1A 03497 IF MAP-ENTITY-NAME-IND = LOW-VALUES OR SPACES DTSCS1A 03498 SET MAP-ENTITY-NAME-NO-88 TO TRUE. DTSCS1A 03499 DTSCS1A 03500 IF MAP-ENTITY-NAME-VALID-88 DTSCS1A 03501 NEXT SENTENCE DTSCS1A 03502 ELSE DTSCS1A 03503 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03504 PERFORM S1411-ERROR THRU S1411-EXIT. DTSCS1A 03505 S1410-EXIT. EXIT. DTSCS1A 03506 DTSCS1A 03507 DTSCS1A 03508 DTSCS1A 03509 S1411-ERROR. DTSCS1A 03510 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-IND-A. DTSCS1A 03511 DTSCS1A 03512 IF LCCM-NO-MSG DTSCS1A 03513 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03514 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-IND-L DTSCS1A 03515 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03516 S1411-EXIT. EXIT. DTSCS1A 03517 /*****************************************************************DTSCS1A 03518 * *DTSCS1A 03519 ******************************************************************DTSCS1A 03520 S1500-ENTITY-NAME. DTSCS1A 03521 IF MAP-ENTITY-NAME = LOW-VALUES OR SPACES DTSCS1A 03522 MOVE SPACES TO MAP-ENTITY-NAME DTSCS1A 03523 GO TO S1500-EXIT. DTSCS1A 03524 DTSCS1A 03525 IF MAP-ENTITY-NAME-YES-88 DTSCS1A 03526 IF MAP-ENTITY-NAME > SPACES DTSCS1A 03527 MOVE MSG-E1A2-AREA TO WRK-MSG-AREA DTSCS1A 03528 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS1A 03529 ELSE DTSCS1A 03530 GO TO S1500-EXIT DTSCS1A 03531 ELSE DTSCS1A 03532 IF MAP-PRIMARY-NAME = MAP-ENTITY-NAME DTSCS1A 03533 MOVE MSG-E1A3-AREA TO WRK-MSG-AREA DTSCS1A 03534 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS1A 03535 GO TO S1500-EXIT. DTSCS1A 03536 DTSCS1A 03537 IF MAP-ENTITY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS1A 03538 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03539 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS1A 03540 DTSCS1A 03541 IF NOT MAP-VERIFY-YES-88 DTSCS1A 03542 MOVE MAP-ENTITY-NAME TO WRK-NAME DTSCS1A 03543 PERFORM S1550-CHECK-DUP-NAME THRU S1550-EXIT DTSCS1A 03544 IF WRK-MSG-ID = 'E1A6' DTSCS1A 03545 PERFORM S1502-ERROR THRU S1502-EXIT DTSCS1A 03546 END-IF DTSCS1A 03547 END-IF. DTSCS1A 03548 S1500-EXIT. EXIT. DTSCS1A 03549 DTSCS1A 03550 S1501-ERROR. DTSCS1A 03551 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-A. DTSCS1A 03552 DTSCS1A 03553 IF LCCM-NO-MSG DTSCS1A 03554 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03555 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-L DTSCS1A 03556 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03557 S1501-EXIT. EXIT. DTSCS1A 03558 DTSCS1A 03559 S1502-ERROR. DTSCS1A 03560 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-A. DTSCS1A 03561 IF LCCM-NO-MSG DTSCS1A 03562 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03563 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-L DTSCS1A 03564 SET CURSOR-SET-YES TO TRUE DTSCS1A 03565 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS1A 03566 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS1A 03567 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A 03568 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A 03569 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A 03570 END-IF. DTSCS1A 03571 S1502-EXIT. DTSCS1A 03572 EXIT. DTSCS1A 03573 DTSCS1A 03574 S1550-CHECK-DUP-NAME. DTSCS1A 03575 MOVE LOW-VALUES TO IBTB-REC. DTSCS1A 03576 SET IBTB-BTB-88 TO TRUE. DTSCS1A 03577 MOVE WRK-NAME TO IBTB-NAME. DTSCS1A 03578 MOVE IBTB-KEY-AREA TO ISKL-KEY-AREA. DTSCS1A 03579 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS1A 03580 IF L821-NO-REC-88 DTSCS1A 03581 NEXT SENTENCE DTSCS1A 03582 ELSE DTSCS1A 03583 IF ISKL-BTB-88 DTSCS1A 03584 MOVE ISKL-REC TO IBTB-REC DTSCS1A 03585 PERFORM S1551-VERIFY-DUP THRU S1551-EXIT DTSCS1A 03586 END-IF DTSCS1A 03587 END-IF. DTSCS1A 03588 PERFORM S821-END-BROWSE THRU S821-EXIT. DTSCS1A 03589 S1550-EXIT. DTSCS1A 03590 EXIT. DTSCS1A 03591 DTSCS1A 03592 S1551-VERIFY-DUP. DTSCS1A 03593 IF (IBTB-NAME = WRK-NAME DTSCS1A 03594 AND IBTB-EMP-NO NOT = WRK-EMP-NO) DTSCS1A 03595 NEXT SENTENCE DTSCS1A 03596 ELSE DTSCS1A 03597 GO TO S1551-EXIT DTSCS1A 03598 END-IF. DTSCS1A 03599 DTSCS1A 03600 IF WRK-MPRF-YES-88 DTSCS1A 03601 MOVE MPRF-EMP-NO TO WRK-HOLD-EMP-NO DTSCS1A 03602 END-IF. DTSCS1A 03603 DTSCS1A 03604 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A 03605 MOVE IBTB-EMP-NO TO MPRF-EMP-NO. DTSCS1A 03606 SET MPRF-PRF-88 TO TRUE. DTSCS1A 03607 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 03608 DTSCS1A 03609 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 03610 IF L810-OK-88 DTSCS1A 03611 MOVE MSKL-REC TO MPRF-REC DTSCS1A 03612 IF MPRF-STATUS-ACT-88 DTSCS1A 03613 MOVE MSG-E1A6-AREA TO WRK-MSG-AREA DTSCS1A 03614 END-IF DTSCS1A 03615 END-IF. DTSCS1A 03616 DTSCS1A 03617 IF WRK-MPRF-YES-88 DTSCS1A 03618 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS1A 03619 MOVE WRK-HOLD-EMP-NO TO MPRF-EMP-NO. DTSCS1A 03620 SET MPRF-PRF-88 TO TRUE. DTSCS1A 03621 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 03622 DTSCS1A 03623 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 03624 IF L810-OK-88 DTSCS1A 03625 MOVE MSKL-REC TO MPRF-REC DTSCS1A 03626 END-IF. DTSCS1A 03627 DTSCS1A 03628 S1551-EXIT. DTSCS1A 03629 EXIT. DTSCS1A 03630 DTSCS1A 03631 /*****************************************************************DTSCS1A 03632 * *DTSCS1A 03633 ******************************************************************DTSCS1A 03634 S1600-EDIT-ADDRESS. DTSCS1A 03635 DTSCS1A 03636 PERFORM S1610-EDIT-FISCAL-AGENT THRU S1610-EXIT. DTSCS1A 03637 DTSCS1A 03638 IF WRK-FISC-AGNT-ERROR-YES-88 DTSCS1A 03639 GO TO S1600-EXIT. DTSCS1A 03640 DTSCS1A 03641 IF MAP-ATTN-LINE = SPACES OR LOW-VALUES DTSCS1A 03642 MOVE SPACES TO MAP-ATTN-LINE. DTSCS1A 03643 DTSCS1A 03644 IF MAP-DELIV-LINE-1 = SPACES OR LOW-VALUES DTSCS1A 03645 MOVE SPACES TO MAP-DELIV-LINE-1. DTSCS1A 03646 DTSCS1A 03647 IF MAP-DELIV-LINE-2 = SPACES OR LOW-VALUES DTSCS1A 03648 MOVE SPACES TO MAP-DELIV-LINE-2. DTSCS1A 03649 DTSCS1A 03650 IF MAP-CASS-IND = SPACES OR LOW-VALUES DTSCS1A 03651 MOVE SPACES TO MAP-CASS-IND. DTSCS1A 03652 DTSCS1A 03653 IF MAP-CITY = SPACES OR LOW-VALUES DTSCS1A 03654 MOVE SPACES TO MAP-CITY. DTSCS1A 03655 DTSCS1A 03656 IF MAP-ST = SPACES OR LOW-VALUES DTSCS1A 03657 MOVE SPACES TO MAP-ST. DTSCS1A 03658 DTSCS1A 03659 IF MAP-ZIP = SPACES OR LOW-VALUES DTSCS1A 03660 MOVE SPACES TO MAP-ZIP. DTSCS1A 03661 DTSCS1A 03662 DTSCS1A 03663 MOVE MAP-CASS-IND TO L072-CASS-IND. DTSCS1A 03664 DTSCS1A 03665 SET L072-MTAD-88 TO TRUE. DTSCS1A 03666 DTSCS1A 03667 MOVE MAP-PRIMARY-NAME TO L072-NAME. DTSCS1A 03668 DTSCS1A 03669 MOVE SPACES TO L072-ADDRESS. DTSCS1A 03670 DTSCS1A 03671 MOVE MAP-ATTN-LINE TO L072-ATTN-LINE. DTSCS1A 03672 DTSCS1A 03673 MOVE MAP-DELIV-LINE-1 TO L072-DELIV-LINE-1. DTSCS1A 03674 DTSCS1A 03675 MOVE MAP-DELIV-LINE-2 TO L072-DELIV-LINE-2. DTSCS1A 03676 DTSCS1A 03677 MOVE MAP-CITY TO L072-CITY. DTSCS1A 03678 DTSCS1A 03679 MOVE MAP-ST TO L072-ST. DTSCS1A 03680 DTSCS1A 03681 MOVE MAP-ZIP TO L072-ZIP. DTSCS1A 03682 DTSCS1A 03683 DTSCS1A 03684 IF (WRK-MTAD-YES-88) DTSCS1A 03685 AND DTSCS1A 03686 (L072-ATTN-LINE = MTAD-ATTN-LINE) DTSCS1A 03687 AND DTSCS1A 03688 (L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1) DTSCS1A 03689 AND DTSCS1A 03690 (L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2) DTSCS1A 03691 AND DTSCS1A 03692 (L072-CITY = MTAD-CITY) DTSCS1A 03693 AND DTSCS1A 03694 (L072-ST = MTAD-ST) DTSCS1A 03695 AND DTSCS1A 03696 (L072-ZIP = MTAD-ZIP) DTSCS1A 03697 MOVE MTAD-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE DTSCS1A 03698 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-1 DTSCS1A 03699 GO TO S1600-EXIT. DTSCS1A 03700 DTSCS1A 03701 DTSCS1A 03702 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. DTSCS1A 03703 DTSCS1A 03704 DTSCS1A 03705 MOVE L072-CASS-IND TO MAP-CASS-IND. DTSCS1A 03706 DTSCS1A 03707 MOVE L072-CASS-RETURN-CODES TO MAP-CASS-CD. DTSCS1A 03708 DTSCS1A 03709 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS-1. DTSCS1A 03710 DTSCS1A 03711 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS1A 03712 PERFORM S1691-ERROR THRU S1691-EXIT DTSCS1A 03713 ELSE DTSCS1A 03714 MOVE L072-ATTN-LINE TO MAP-ATTN-LINE DTSCS1A 03715 IF L072-ATTN-LINE-CHANGED-88 DTSCS1A 03716 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-LINE-A. DTSCS1A 03717 DTSCS1A 03718 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS1A 03719 PERFORM S1692-ERROR THRU S1692-EXIT DTSCS1A 03720 ELSE DTSCS1A 03721 MOVE L072-DELIV-LINE-1 TO MAP-DELIV-LINE-1 DTSCS1A 03722 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS1A 03723 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-1-A.DTSCS1A 03724 DTSCS1A 03725 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS1A 03726 PERFORM S1693-ERROR THRU S1693-EXIT DTSCS1A 03727 ELSE DTSCS1A 03728 MOVE L072-DELIV-LINE-2 TO MAP-DELIV-LINE-2 DTSCS1A 03729 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS1A 03730 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-2-A.DTSCS1A 03731 DTSCS1A 03732 IF L072-CITY-NOT-VALID-88 DTSCS1A 03733 PERFORM S1694-ERROR THRU S1694-EXIT DTSCS1A 03734 ELSE DTSCS1A 03735 MOVE L072-CITY TO MAP-CITY DTSCS1A 03736 IF L072-CITY-CHANGED-88 DTSCS1A 03737 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A. DTSCS1A 03738 DTSCS1A 03739 IF L072-ST-NOT-VALID-88 DTSCS1A 03740 PERFORM S1695-ERROR THRU S1695-EXIT DTSCS1A 03741 ELSE DTSCS1A 03742 MOVE L072-ST TO MAP-ST DTSCS1A 03743 IF L072-ST-CHANGED-88 DTSCS1A 03744 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ST-A. DTSCS1A 03745 DTSCS1A 03746 IF L072-ZIP-NOT-VALID-88 DTSCS1A 03747 PERFORM S1696-ERROR THRU S1696-EXIT DTSCS1A 03748 ELSE DTSCS1A 03749 MOVE L072-ZIP TO MAP-ZIP DTSCS1A 03750 IF L072-ZIP-CHANGED-88 DTSCS1A 03751 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A. DTSCS1A 03752 DTSCS1A 03753 IF L072-ADDRESS-NOT-VALID-88 DTSCS1A 03754 IF LCCM-NO-MSG DTSCS1A 03755 PERFORM S1691-ERROR THRU S1691-EXIT. DTSCS1A 03756 S1600-EXIT. EXIT. DTSCS1A 03757 SKIP3 DTSCS1A 03758 S1610-EDIT-FISCAL-AGENT. DTSCS1A 03759 SET WRK-FISC-AGNT-ERROR-NO-88 TO TRUE. DTSCS1A 03760 DTSCS1A 03761 IF WRK-MFAE-YES-88 DTSCS1A 03762 MOVE MFAE-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD DTSCS1A 03763 END-IF. DTSCS1A 03764 DTSCS1A 03765 IF MAP-FISC-AGNT-CD = LOW-VALUE OR DTSCS1A 03766 MAP-FISC-AGNT-CD = SPACES DTSCS1A 03767 GO TO S1610-EXIT DTSCS1A 03768 END-IF. DTSCS1A 03769 DTSCS1A 03770 IF LCCM-F09-88 DTSCS1A 03771 NEXT SENTENCE DTSCS1A 03772 ELSE DTSCS1A 03773 GO TO S1610-EXIT. DTSCS1A 03774 DTSCS1A 03775 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS1A 03776 MOVE MAP-FISC-AGNT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS1A 03777 SET FFIS-SERVICE-CORRESPOND-88 TO TRUE. DTSCS1A 03778 SET FFIS-FIS-88 TO TRUE. DTSCS1A 03779 MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS1A 03780 DTSCS1A 03781 PERFORM S831-READ THRU S831-EXIT. DTSCS1A 03782 DTSCS1A 03783 IF NOT L831-OK-88 DTSCS1A 03784 SET WRK-FISC-AGNT-ERROR-YES-88 TO TRUE DTSCS1A 03785 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03786 PERFORM S1611-ERROR THRU S1611-EXIT DTSCS1A 03787 GO TO S1610-EXIT DTSCS1A 03788 ELSE DTSCS1A 03789 MOVE FSKL-REC TO FFIS-REC DTSCS1A 03790 END-IF. DTSCS1A 03791 DTSCS1A 03792 MOVE FFIS-ATTN-LINE TO MAP-ATTN-LINE. DTSCS1A 03793 MOVE FFIS-DELIV-LINE-1 TO MAP-DELIV-LINE-1. DTSCS1A 03794 MOVE FFIS-DELIV-LINE-2 TO MAP-DELIV-LINE-2. DTSCS1A 03795 MOVE FFIS-CITY TO MAP-CITY. DTSCS1A 03796 MOVE FFIS-ST TO MAP-ST. DTSCS1A 03797 MOVE FFIS-ZIP TO MAP-ZIP. DTSCS1A 03798 DTSCS1A 03799 IF FFIS-BUSINESS-VOICE NOT = SPACES DTSCS1A 03800 MOVE FFIS-BUSINESS-VOICE-AREA-CD TO MAP-VOICE-1-AREA-CD DTSCS1A 03801 MOVE FFIS-BUSINESS-VOICE-PREFIX TO MAP-VOICE-1-PREFIX DTSCS1A 03802 MOVE FFIS-BUSINESS-VOICE-SUFFIX TO MAP-VOICE-1-SUFFIX DTSCS1A 03803 MOVE FFIS-BUSINESS-VOICE-EXT TO MAP-VOICE-1-EXT. DTSCS1A 03804 DTSCS1A 03805 DTSCS1A 03806 S1610-EXIT. DTSCS1A 03807 EXIT. DTSCS1A 03808 S1611-ERROR. DTSCS1A 03809 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-CD-A. DTSCS1A 03810 DTSCS1A 03811 IF LCCM-NO-MSG DTSCS1A 03812 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03813 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L DTSCS1A 03814 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03815 S1611-EXIT. DTSCS1A 03816 EXIT. DTSCS1A 03817 SKIP3 DTSCS1A 03818 S1691-ERROR. DTSCS1A 03819 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-LINE-A. DTSCS1A 03820 DTSCS1A 03821 IF LCCM-NO-MSG DTSCS1A 03822 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03823 MOVE CATB-CURSOR TO MAP-ATTN-LINE-L DTSCS1A 03824 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03825 S1691-EXIT. DTSCS1A 03826 EXIT. DTSCS1A 03827 SKIP3 DTSCS1A 03828 S1692-ERROR. DTSCS1A 03829 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-1-A. DTSCS1A 03830 DTSCS1A 03831 IF LCCM-NO-MSG DTSCS1A 03832 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03833 MOVE CATB-CURSOR TO MAP-DELIV-LINE-1-L DTSCS1A 03834 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03835 S1692-EXIT. DTSCS1A 03836 EXIT. DTSCS1A 03837 SKIP3 DTSCS1A 03838 S1693-ERROR. DTSCS1A 03839 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DELIV-LINE-2-A. DTSCS1A 03840 DTSCS1A 03841 IF LCCM-NO-MSG DTSCS1A 03842 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03843 MOVE CATB-CURSOR TO MAP-DELIV-LINE-2-L DTSCS1A 03844 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03845 S1693-EXIT. DTSCS1A 03846 EXIT. DTSCS1A 03847 SKIP3 DTSCS1A 03848 S1694-ERROR. DTSCS1A 03849 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A. DTSCS1A 03850 DTSCS1A 03851 IF LCCM-NO-MSG DTSCS1A 03852 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03853 MOVE CATB-CURSOR TO MAP-CITY-L DTSCS1A 03854 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03855 S1694-EXIT. DTSCS1A 03856 EXIT. DTSCS1A 03857 SKIP3 DTSCS1A 03858 S1695-ERROR. DTSCS1A 03859 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ST-A. DTSCS1A 03860 DTSCS1A 03861 IF LCCM-NO-MSG DTSCS1A 03862 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03863 MOVE CATB-CURSOR TO MAP-ST-L DTSCS1A 03864 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03865 S1695-EXIT. DTSCS1A 03866 EXIT. DTSCS1A 03867 SKIP3 DTSCS1A 03868 S1696-ERROR. DTSCS1A 03869 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIP-A. DTSCS1A 03870 DTSCS1A 03871 IF LCCM-NO-MSG DTSCS1A 03872 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03873 MOVE CATB-CURSOR TO MAP-ZIP-L DTSCS1A 03874 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03875 S1696-EXIT. DTSCS1A 03876 EXIT. DTSCS1A 03877 /*****************************************************************DTSCS1A 03878 * *DTSCS1A 03879 ******************************************************************DTSCS1A 03880 S1710-VOICE-1. DTSCS1A 03881 MOVE MAP-VOICE-1-AREA TO L021-S-TNO-AREA. DTSCS1A 03882 DTSCS1A 03883 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A 03884 DTSCS1A 03885 IF L021-NOT-VALID DTSCS1A 03886 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03887 PERFORM S1711-ERROR THRU S1711-EXIT DTSCS1A 03888 ELSE DTSCS1A 03889 IF L021-VALID DTSCS1A 03890 MOVE L021-TNO TO L073-TELEPHONE DTSCS1A 03891 MOVE MAP-ST TO L073-ST DTSCS1A 03892 MOVE MAP-ZIP TO L073-ZIP DTSCS1A 03893 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS1A 03894 IF L073-NOT-VALID DTSCS1A 03895 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03896 PERFORM S1711-ERROR THRU S1711-EXIT DTSCS1A 03897 ELSE DTSCS1A 03898 MOVE L073-AREA-CD TO MAP-VOICE-1-AREA-CD DTSCS1A 03899 MOVE L073-PREFIX TO MAP-VOICE-1-PREFIX DTSCS1A 03900 MOVE L073-SUFFIX TO MAP-VOICE-1-SUFFIX DTSCS1A 03901 MOVE L073-EXT TO MAP-VOICE-1-EXT. DTSCS1A 03902 S1710-EXIT. EXIT. DTSCS1A 03903 DTSCS1A 03904 DTSCS1A 03905 DTSCS1A 03906 S1711-ERROR. DTSCS1A 03907 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VOICE-1-AREA-CD-A DTSCS1A 03908 MAP-VOICE-1-PREFIX-A DTSCS1A 03909 MAP-VOICE-1-SUFFIX-A DTSCS1A 03910 MAP-VOICE-1-EXT-A. DTSCS1A 03911 DTSCS1A 03912 IF LCCM-NO-MSG DTSCS1A 03913 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03914 MOVE CATB-CURSOR TO MAP-VOICE-1-AREA-CD-L DTSCS1A 03915 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03916 S1711-EXIT. EXIT. DTSCS1A 03917 /*****************************************************************DTSCS1A 03918 * *DTSCS1A 03919 ******************************************************************DTSCS1A 03920 S1720-VOICE-2. DTSCS1A 03921 MOVE MAP-VOICE-2-AREA TO L021-S-TNO-AREA. DTSCS1A 03922 DTSCS1A 03923 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A 03924 DTSCS1A 03925 IF L021-NOT-VALID DTSCS1A 03926 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03927 PERFORM S1721-ERROR THRU S1721-EXIT DTSCS1A 03928 ELSE DTSCS1A 03929 IF L021-VALID DTSCS1A 03930 MOVE L021-TNO TO L073-TELEPHONE DTSCS1A 03931 MOVE MAP-ST TO L073-ST DTSCS1A 03932 MOVE MAP-ZIP TO L073-ZIP DTSCS1A 03933 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS1A 03934 IF L073-NOT-VALID DTSCS1A 03935 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03936 PERFORM S1721-ERROR THRU S1721-EXIT DTSCS1A 03937 ELSE DTSCS1A 03938 MOVE L073-AREA-CD TO MAP-VOICE-2-AREA-CD DTSCS1A 03939 MOVE L073-PREFIX TO MAP-VOICE-2-PREFIX DTSCS1A 03940 MOVE L073-SUFFIX TO MAP-VOICE-2-SUFFIX DTSCS1A 03941 MOVE L073-EXT TO MAP-VOICE-2-EXT. DTSCS1A 03942 S1720-EXIT. EXIT. DTSCS1A 03943 DTSCS1A 03944 DTSCS1A 03945 DTSCS1A 03946 S1721-ERROR. DTSCS1A 03947 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-VOICE-2-AREA-CD-A DTSCS1A 03948 MAP-VOICE-2-PREFIX-A DTSCS1A 03949 MAP-VOICE-2-SUFFIX-A DTSCS1A 03950 MAP-VOICE-2-EXT-A. DTSCS1A 03951 IF LCCM-NO-MSG DTSCS1A 03952 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03953 MOVE CATB-CURSOR TO MAP-VOICE-2-AREA-CD-L DTSCS1A 03954 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03955 S1721-EXIT. EXIT. DTSCS1A 03956 /*****************************************************************DTSCS1A 03957 * *DTSCS1A 03958 ******************************************************************DTSCS1A 03959 S1730-FAX. DTSCS1A 03960 MOVE MAP-FAX-AREA TO L021-S-TNO-AREA. DTSCS1A 03961 DTSCS1A 03962 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS1A 03963 DTSCS1A 03964 IF L021-NOT-VALID DTSCS1A 03965 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03966 PERFORM S1731-ERROR THRU S1731-EXIT DTSCS1A 03967 ELSE DTSCS1A 03968 IF L021-VALID DTSCS1A 03969 MOVE L021-TNO TO L073-TELEPHONE DTSCS1A 03970 MOVE MAP-ST TO L073-ST DTSCS1A 03971 MOVE MAP-ZIP TO L073-ZIP DTSCS1A 03972 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS1A 03973 IF L073-NOT-VALID DTSCS1A 03974 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 03975 PERFORM S1731-ERROR THRU S1731-EXIT DTSCS1A 03976 ELSE DTSCS1A 03977 MOVE L073-AREA-CD TO MAP-FAX-AREA-CD DTSCS1A 03978 MOVE L073-PREFIX TO MAP-FAX-PREFIX DTSCS1A 03979 MOVE L073-SUFFIX TO MAP-FAX-SUFFIX DTSCS1A 03980 MOVE L073-EXT TO MAP-FAX-EXT. DTSCS1A 03981 S1730-EXIT. EXIT. DTSCS1A 03982 DTSCS1A 03983 DTSCS1A 03984 DTSCS1A 03985 S1731-ERROR. DTSCS1A 03986 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FAX-AREA-CD-A DTSCS1A 03987 MAP-FAX-PREFIX-A DTSCS1A 03988 MAP-FAX-SUFFIX-A DTSCS1A 03989 MAP-FAX-EXT-A. DTSCS1A 03990 DTSCS1A 03991 IF LCCM-NO-MSG DTSCS1A 03992 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 03993 MOVE CATB-CURSOR TO MAP-FAX-AREA-CD-L DTSCS1A 03994 SET CURSOR-SET-YES TO TRUE. DTSCS1A 03995 S1731-EXIT. EXIT. DTSCS1A 03996 /*****************************************************************DTSCS1A 03997 * *DTSCS1A 03998 ******************************************************************DTSCS1A 03999 S1800-SOURCE-CD. DTSCS1A 04000 SET WRK-VALID-SOURCE-CD-YES TO TRUE. DTSCS1A 04001 DTSCS1A 04002 IF WRK-MPRF-YES-88 DTSCS1A 04003 IF MPRF-CONVERTED-88 DTSCS1A 04004 MOVE SPACES TO MAP-SOURCE-CD DTSCS1A 04005 GO TO S1800-EXIT. DTSCS1A 04006 DTSCS1A 04007 IF MAP-SOURCE-CD = LOW-VALUES OR SPACES DTSCS1A 04008 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04009 MOVE SPACES TO MAP-SOURCE-CD DTSCS1A 04010 ELSE DTSCS1A 04011 MOVE '99' TO MAP-SOURCE-CD DTSCS1A 04012 ELSE DTSCS1A 04013 MOVE MAP-SOURCE-CD TO L031-CD-2 DTSCS1A 04014 SET L031-MERA-SOURCE-CD TO TRUE DTSCS1A 04015 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A 04016 IF L031-NOT-VALID DTSCS1A 04017 SET WRK-VALID-SOURCE-CD-NO TO TRUE DTSCS1A 04018 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04019 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS1A 04020 ELSE DTSCS1A 04021 IF MAP-SOURCE-CD-NA-88 DTSCS1A 04022 IF LCCM-F09-88 DTSCS1A 04023 NEXT SENTENCE DTSCS1A 04024 ELSE DTSCS1A 04025 SET WRK-VALID-SOURCE-CD-NO TO TRUE DTSCS1A 04026 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04027 PERFORM S1801-ERROR THRU S1801-EXIT. DTSCS1A 04028 S1800-EXIT. EXIT. DTSCS1A 04029 DTSCS1A 04030 DTSCS1A 04031 DTSCS1A 04032 S1801-ERROR. DTSCS1A 04033 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-SOURCE-CD-A. DTSCS1A 04034 DTSCS1A 04035 IF LCCM-NO-MSG DTSCS1A 04036 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04037 MOVE CATB-CURSOR TO MAP-SOURCE-CD-L DTSCS1A 04038 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04039 S1801-EXIT. EXIT. DTSCS1A 04040 /*****************************************************************DTSCS1A 04041 * *DTSCS1A 04042 ******************************************************************DTSCS1A 04043 S1900-FEIN. DTSCS1A 04044 MOVE MAP-FEIN-AREA TO L017-S-FEIN-AREA. DTSCS1A 04045 DTSCS1A 04046 PERFORM S017-FEIN-FROM-SCREEN THRU S017-EXIT. DTSCS1A 04047 DTSCS1A 04048 IF L017-NOT-VALID DTSCS1A 04049 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04050 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS1A 04051 GO TO S1900-EXIT. DTSCS1A 04052 DTSCS1A 04053 IF L017-NO-ENTRY DTSCS1A 04054 GO TO S1900-EXIT. DTSCS1A 04055 DTSCS1A 04056 IF WRK-MPRF-YES-88 DTSCS1A 04057 IF L017-FEIN NOT = MPRF-FEIN DTSCS1A 04058 IF MPRF-STATUS-ACT-88 DTSCS1A 04059 SET L074-ACTIVE-DUP-88 TO TRUE DTSCS1A 04060 MOVE WRK-EMP-NO TO L074-EMP-NO DTSCS1A 04061 MOVE L017-FEIN TO L074-FEIN DTSCS1A 04062 MOVE +0 TO L074-INACTIVE-EMP-NO DTSCS1A 04063 PERFORM S074-DUP-FEIN-EDIT THRU S074-EXIT DTSCS1A 04064 IF L074-DUP-NOT-OK-88 DTSCS1A 04065 MOVE EMSG-DUPLICATE-FEIN TO WRK-MSG-AREA DTSCS1A 04066 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS1A 04067 S1900-EXIT. EXIT. DTSCS1A 04068 DTSCS1A 04069 S1901-ERROR. DTSCS1A 04070 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FEIN-1-A DTSCS1A 04071 MAP-FEIN-2-A. DTSCS1A 04072 DTSCS1A 04073 IF LCCM-NO-MSG DTSCS1A 04074 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04075 MOVE CATB-CURSOR TO MAP-FEIN-1-L DTSCS1A 04076 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04077 S1901-EXIT. EXIT. DTSCS1A 04078 /*****************************************************************DTSCS1A 04079 * *DTSCS1A 04080 ******************************************************************DTSCS1A 04081 S1950-POT-HOUSEHOLD. DTSCS1A 04082 IF MAP-POT-HOUSEHOLD-IND = SPACES OR LOW-VALUES DTSCS1A 04083 MOVE 'N' TO MAP-POT-HOUSEHOLD-IND DTSCS1A 04084 GO TO S1950-EXIT DTSCS1A 04085 ELSE DTSCS1A 04086 IF MAP-POT-HOUSEHOLD-IND = 'Y' OR 'N' DTSCS1A 04087 NEXT SENTENCE DTSCS1A 04088 ELSE DTSCS1A 04089 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04090 PERFORM S1951-ERROR THRU S1951-EXIT DTSCS1A 04091 GO TO S1950-EXIT. DTSCS1A 04092 DTSCS1A 04093 IF MAP-POT-HOUSEHOLD-IND = 'Y' DTSCS1A 04094 AND WRK-EMP-NO > ZERO DTSCS1A 04095 IF MPRF-STATUS-ACT-88 DTSCS1A 04096 MOVE MSG-E1A5-AREA TO WRK-MSG-AREA DTSCS1A 04097 PERFORM S1951-ERROR THRU S1951-EXIT DTSCS1A 04098 GO TO S1950-EXIT DTSCS1A 04099 ELSE DTSCS1A 04100 SET L400-FIND-PRIOR-88 TO TRUE DTSCS1A 04101 MOVE WRK-EMP-NO TO L400-EMP-NO DTSCS1A 04102 MOVE ZERO TO L400-CURR-RUN-DATE DTSCS1A 04103 MOVE SPACES TO L400-OP-ID DTSCS1A 04104 PERFORM S400-HOUSEHOLD THRU S400-EXIT DTSCS1A 04105 IF L400-NOTICE-SENT-YES-88 DTSCS1A 04106 MOVE MSG-E1A4-AREA TO WRK-MSG-AREA DTSCS1A 04107 PERFORM S1951-ERROR THRU S1951-EXIT DTSCS1A 04108 GO TO S1950-EXIT. DTSCS1A 04109 DTSCS1A 04110 S1950-EXIT. EXIT. DTSCS1A 04111 DTSCS1A 04112 S1951-ERROR. DTSCS1A 04113 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-POT-HOUSEHOLD-A. DTSCS1A 04114 DTSCS1A 04115 IF LCCM-NO-MSG DTSCS1A 04116 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04117 MOVE CATB-CURSOR TO MAP-POT-HOUSEHOLD-L DTSCS1A 04118 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04119 S1951-EXIT. EXIT. DTSCS1A 04120 /*****************************************************************DTSCS1A 04121 * *DTSCS1A 04122 ******************************************************************DTSCS1A 04123 S2000-CLAIMANT-SSN. DTSCS1A 04124 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04125 OR DTSCS1A 04126 MAP-SOURCE-CD-NA-88 DTSCS1A 04127 MOVE SPACES TO MAP-CLAIMANT-SSN-1 DTSCS1A 04128 MOVE SPACES TO MAP-CLAIMANT-SSN-2 DTSCS1A 04129 MOVE SPACES TO MAP-CLAIMANT-SSN-3 DTSCS1A 04130 GO TO S2000-EXIT. DTSCS1A 04131 DTSCS1A 04132 MOVE MAP-CLAIMANT-SSN-AREA TO L020-S-SSN-AREA. DTSCS1A 04133 DTSCS1A 04134 PERFORM S020-SSN-FROM-SCREEN THRU S020-EXIT. DTSCS1A 04135 DTSCS1A 04136 IF L020-NO-ENTRY DTSCS1A 04137 IF MAP-LETTER-1-CD = '05' OR MAP-SOURCE-CD = '05' DTSCS1A 04138 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 04139 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS1A 04140 ELSE DTSCS1A 04141 NEXT SENTENCE DTSCS1A 04142 ELSE DTSCS1A 04143 IF L020-NOT-VALID DTSCS1A 04144 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04145 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS1A 04146 DTSCS1A 04147 S2000-EXIT. EXIT. DTSCS1A 04148 DTSCS1A 04149 DTSCS1A 04150 DTSCS1A 04151 S2001-ERROR. DTSCS1A 04152 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-CLAIMANT-SSN-1-A DTSCS1A 04153 MAP-CLAIMANT-SSN-2-A DTSCS1A 04154 MAP-CLAIMANT-SSN-3-A. DTSCS1A 04155 DTSCS1A 04156 IF LCCM-NO-MSG DTSCS1A 04157 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04158 MOVE CATB-CURSOR TO MAP-CLAIMANT-SSN-1-L DTSCS1A 04159 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04160 S2001-EXIT. EXIT. DTSCS1A 04161 /*****************************************************************DTSCS1A 04162 * *DTSCS1A 04163 ******************************************************************DTSCS1A 04164 S2010-CLAIMANT-NAME. DTSCS1A 04165 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04166 OR DTSCS1A 04167 MAP-SOURCE-CD-NA-88 DTSCS1A 04168 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS1A 04169 GO TO S2010-EXIT. DTSCS1A 04170 DTSCS1A 04171 IF MAP-CLAIMANT-NAME = LOW-VALUES OR SPACES DTSCS1A 04172 MOVE SPACES TO MAP-CLAIMANT-NAME DTSCS1A 04173 IF L020-NO-ENTRY DTSCS1A 04174 GO TO S2010-EXIT. DTSCS1A 04175 DTSCS1A 04176 IF L020-NOT-VALID DTSCS1A 04177 GO TO S2010-EXIT. DTSCS1A 04178 DTSCS1A 04179 IF L020-NO-ENTRY DTSCS1A 04180 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A 04181 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS1A 04182 GO TO S2010-EXIT. DTSCS1A 04183 DTSCS1A 04184 IF MAP-CLAIMANT-NAME = SPACES DTSCS1A 04185 MOVE L020-SSN TO L081-CLAIMANT-SSN DTSCS1A 04186 PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT DTSCS1A 04187 IF L081-NAME-FOUND DTSCS1A 04188 MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME. DTSCS1A 04189 DTSCS1A 04190 IF MAP-CLAIMANT-NAME = SPACES DTSCS1A 04191 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 04192 PERFORM S2011-ERROR THRU S2011-EXIT DTSCS1A 04193 ELSE DTSCS1A 04194 SET L071-FROM-LAST-NAME-FIRST TO TRUE DTSCS1A 04195 MOVE MAP-CLAIMANT-NAME TO L071-NAM DTSCS1A 04196 PERFORM S071-NAME-EDIT THRU S071-EXIT DTSCS1A 04197 IF L071-NAME-INVALID DTSCS1A 04198 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04199 PERFORM S2011-ERROR THRU S2011-EXIT. DTSCS1A 04200 DTSCS1A 04201 S2010-EXIT. EXIT. DTSCS1A 04202 DTSCS1A 04203 DTSCS1A 04204 DTSCS1A 04205 S2011-ERROR. DTSCS1A 04206 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CLAIMANT-NAME-A. DTSCS1A 04207 DTSCS1A 04208 IF LCCM-NO-MSG DTSCS1A 04209 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04210 MOVE CATB-CURSOR TO MAP-CLAIMANT-NAME-L DTSCS1A 04211 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04212 S2011-EXIT. EXIT. DTSCS1A 04213 /*****************************************************************DTSCS1A 04214 * *DTSCS1A 04215 ******************************************************************DTSCS1A 04216 S2100-POT-PRED-EMP-NO. DTSCS1A 04217 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04218 OR DTSCS1A 04219 MAP-SOURCE-CD-NA-88 DTSCS1A 04220 MOVE SPACES TO MAP-PRED-EMP-NO-1 DTSCS1A 04221 MAP-PRED-EMP-NO-2 DTSCS1A 04222 GO TO S2100-EXIT. DTSCS1A 04223 DTSCS1A 04224 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 04225 DTSCS1A 04226 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A 04227 DTSCS1A 04228 IF L018-NO-ENTRY DTSCS1A 04229 IF MAP-SOURCE-CD = '04' DTSCS1A 04230 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 04231 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS1A 04232 ELSE DTSCS1A 04233 NEXT SENTENCE DTSCS1A 04234 ELSE DTSCS1A 04235 IF L018-NOT-VALID DTSCS1A 04236 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04237 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS1A 04238 ELSE DTSCS1A 04239 IF L018-EMP-NO EQUAL WRK-EMP-NO DTSCS1A 04240 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04241 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS1A 04242 ELSE DTSCS1A 04243 PERFORM S2110-CHECK-EMP THRU S2110-EXIT. DTSCS1A 04244 S2100-EXIT. EXIT. DTSCS1A 04245 DTSCS1A 04246 DTSCS1A 04247 DTSCS1A 04248 S2101-ERROR. DTSCS1A 04249 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-PRED-EMP-NO-1-A DTSCS1A 04250 MAP-PRED-EMP-NO-2-A. DTSCS1A 04251 DTSCS1A 04252 IF LCCM-NO-MSG DTSCS1A 04253 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04254 MOVE CATB-CURSOR TO MAP-PRED-EMP-NO-1-L DTSCS1A 04255 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04256 S2101-EXIT. EXIT. DTSCS1A 04257 DTSCS1A 04258 DTSCS1A 04259 DTSCS1A 04260 S2110-CHECK-EMP. DTSCS1A 04261 IF WRK-MERA-YES-88 DTSCS1A 04262 AND DTSCS1A 04263 L018-EMP-NO = MERA-POT-PRED-EMP-NO DTSCS1A 04264 GO TO S2110-EXIT. DTSCS1A 04265 DTSCS1A 04266 DTSCS1A 04267 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS1A 04268 DTSCS1A 04269 MOVE L018-EMP-NO TO MSKL-EMP-NO. DTSCS1A 04270 DTSCS1A 04271 SET MSKL-PRF-88 TO TRUE. DTSCS1A 04272 DTSCS1A 04273 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 04274 DTSCS1A 04275 IF L810-NO-REC-88 DTSCS1A 04276 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS1A 04277 PERFORM S2101-ERROR THRU S2101-EXIT. DTSCS1A 04278 S2110-EXIT. EXIT. DTSCS1A 04279 /*****************************************************************DTSCS1A 04280 * *DTSCS1A 04281 ******************************************************************DTSCS1A 04282 S2200-RESPONSIBLE-OP-ID. DTSCS1A 04283 ** MODIFIED TO SET RESP-OP-ID TO USER CURRENTLY SIGNED ON, DTSCS1A 04284 ** UNLESS USER HAS SET MAP-RESP-OP-ID. DTSCS1A 04285 ** REQUEST FROM STATUS UNIT. 12/09/2002 GD DTSCS1A 04286 DTSCS1A 04287 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04288 OR DTSCS1A 04289 MAP-SOURCE-CD-NA-88 DTSCS1A 04290 MOVE SPACES TO MAP-RESP-OP-ID DTSCS1A 04291 GO TO S2200-EXIT. DTSCS1A 04292 DTSCS1A 04293 IF WRK-MPRF-YES-88 DTSCS1A 04294 IF MPRF-CONVERTED-88 DTSCS1A 04295 MOVE SPACES TO MAP-RESP-OP-ID DTSCS1A 04296 GO TO S2200-EXIT. DTSCS1A 04297 DTSCS1A 04298 IF MAP-RESP-OP-ID = LOW-VALUES OR SPACES DTSCS1A 04299 ******** MOVE LCCM-RESP-OP-ID TO MAP-RESP-OP-ID. DTSCS1A 04300 MOVE LCCM-OP-ID TO MAP-RESP-OP-ID. DTSCS1A 04301 DTSCS1A 04302 IF MAP-RESP-OP-ID = LCCM-OP-ID DTSCS1A 04303 MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID DTSCS1A 04304 GO TO S2200-EXIT. DTSCS1A 04305 DTSCS1A 04306 MOVE MAP-RESP-OP-ID TO L082-OP-ID. DTSCS1A 04307 DTSCS1A 04308 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS1A 04309 DTSCS1A 04310 IF L082-VALID-OP AND L082-EXTERNAL-88 DTSCS1A 04311 MOVE MAP-RESP-OP-ID TO LCCM-RESP-OP-ID DTSCS1A 04312 ELSE DTSCS1A 04313 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04314 PERFORM S2201-ERROR THRU S2201-EXIT. DTSCS1A 04315 S2200-EXIT. EXIT. DTSCS1A 04316 DTSCS1A 04317 DTSCS1A 04318 DTSCS1A 04319 S2201-ERROR. DTSCS1A 04320 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESP-OP-ID-A. DTSCS1A 04321 DTSCS1A 04322 IF LCCM-NO-MSG DTSCS1A 04323 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04324 MOVE CATB-CURSOR TO MAP-RESP-OP-ID-L DTSCS1A 04325 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04326 S2201-EXIT. EXIT. DTSCS1A 04327 /*****************************************************************DTSCS1A 04328 * *DTSCS1A 04329 ******************************************************************DTSCS1A 04330 S2300-NOTE. DTSCS1A 04331 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04332 OR DTSCS1A 04333 MAP-SOURCE-CD-NA-88 DTSCS1A 04334 MOVE SPACES TO MAP-NOTE DTSCS1A 04335 GO TO S2300-EXIT. DTSCS1A 04336 DTSCS1A 04337 IF MAP-NOTE = LOW-VALUES OR SPACES DTSCS1A 04338 MOVE SPACES TO MAP-NOTE. DTSCS1A 04339 S2300-EXIT. EXIT. DTSCS1A 04340 DTSCS1A 04341 DTSCS1A 04342 DTSCS1A 04343 S2301-ERROR. DTSCS1A 04344 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NOTE-A. DTSCS1A 04345 DTSCS1A 04346 IF LCCM-NO-MSG DTSCS1A 04347 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04348 MOVE CATB-CURSOR TO MAP-NOTE-L DTSCS1A 04349 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04350 S2301-EXIT. EXIT. DTSCS1A 04351 /*****************************************************************DTSCS1A 04352 * *DTSCS1A 04353 ******************************************************************DTSCS1A 04354 S2600-STATUS-CD. DTSCS1A 04355 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04356 OR DTSCS1A 04357 MAP-SOURCE-CD-NA-88 DTSCS1A 04358 MOVE SPACES TO MAP-STATUS-CD DTSCS1A 04359 GO TO S2600-EXIT. DTSCS1A 04360 DTSCS1A 04361 IF WRK-MPRF-YES-88 DTSCS1A 04362 IF MPRF-CONVERTED-88 DTSCS1A 04363 MOVE SPACES TO MAP-STATUS-CD DTSCS1A 04364 GO TO S2600-EXIT. DTSCS1A 04365 DTSCS1A 04366 IF MAP-STATUS-CD = LOW-VALUES OR SPACES DTSCS1A 04367 ********IF MAP-SOURCE-CD = '07' DTSCS1A 04368 ***********MOVE '11' TO MAP-STATUS-CD DTSCS1A 04369 ********ELSE DTSCS1A 04370 MOVE '00' TO MAP-STATUS-CD. DTSCS1A 04371 DTSCS1A 04372 MOVE MAP-STATUS-CD TO L031-CD-2. DTSCS1A 04373 DTSCS1A 04374 SET L031-MERA-STATUS-CD TO TRUE. DTSCS1A 04375 DTSCS1A 04376 PERFORM S031-REG-CODES THRU S031-EXIT. DTSCS1A 04377 DTSCS1A 04378 IF L031-NOT-VALID DTSCS1A 04379 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04380 PERFORM S2601-ERROR THRU S2601-EXIT DTSCS1A 04381 GO TO S2600-EXIT. DTSCS1A 04382 DTSCS1A 04383 MOVE MAP-STATUS-CD TO MERA-STATUS-CD. DTSCS1A 04384 S2600-EXIT. EXIT. DTSCS1A 04385 DTSCS1A 04386 DTSCS1A 04387 DTSCS1A 04388 S2601-ERROR. DTSCS1A 04389 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STATUS-CD-A. DTSCS1A 04390 DTSCS1A 04391 IF LCCM-NO-MSG DTSCS1A 04392 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04393 MOVE CATB-CURSOR TO MAP-STATUS-CD-L DTSCS1A 04394 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04395 S2601-EXIT. EXIT. DTSCS1A 04396 /*****************************************************************DTSCS1A 04397 * *DTSCS1A 04398 ******************************************************************DTSCS1A 04399 S2700-MAIL-DATE-1. DTSCS1A 04400 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04401 OR DTSCS1A 04402 MAP-SOURCE-CD-NA-88 DTSCS1A 04403 MOVE SPACES TO MAP-MAIL-1-MO DTSCS1A 04404 MAP-MAIL-1-DA DTSCS1A 04405 MAP-MAIL-1-YR DTSCS1A 04406 GO TO S2700-EXIT. DTSCS1A 04407 DTSCS1A 04408 DTSCS1A 04409 MOVE MAP-MAIL-DATE-1-AREA TO L015-S-DATE-AREA. DTSCS1A 04410 DTSCS1A 04411 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 04412 DTSCS1A 04413 IF L015-NOT-VALID DTSCS1A 04414 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04415 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS1A 04416 S2700-EXIT. EXIT. DTSCS1A 04417 DTSCS1A 04418 DTSCS1A 04419 DTSCS1A 04420 S2701-ERROR. DTSCS1A 04421 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-1-MO-A DTSCS1A 04422 MAP-MAIL-1-DA-A DTSCS1A 04423 MAP-MAIL-1-YR-A. DTSCS1A 04424 DTSCS1A 04425 IF LCCM-NO-MSG DTSCS1A 04426 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04427 MOVE CATB-CURSOR TO MAP-MAIL-1-MO-L DTSCS1A 04428 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04429 S2701-EXIT. EXIT. DTSCS1A 04430 /*****************************************************************DTSCS1A 04431 * *DTSCS1A 04432 ******************************************************************DTSCS1A 04433 S2800-LETTER-1-CD. DTSCS1A 04434 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04435 OR DTSCS1A 04436 MAP-SOURCE-CD-NA-88 DTSCS1A 04437 MOVE SPACES TO MAP-LETTER-1-CD DTSCS1A 04438 GO TO S2800-EXIT. DTSCS1A 04439 DTSCS1A 04440 IF WRK-MPRF-YES-88 DTSCS1A 04441 IF MPRF-CONVERTED-88 DTSCS1A 04442 MOVE SPACES TO MAP-LETTER-1-CD DTSCS1A 04443 GO TO S2800-EXIT. DTSCS1A 04444 DTSCS1A 04445 DTSCS1A 04446 IF MAP-LETTER-1-CD = LOW-VALUES OR SPACES DTSCS1A 04447 IF WRK-VALID-SOURCE-CD-NO DTSCS1A 04448 GO TO S2800-EXIT DTSCS1A 04449 ELSE DTSCS1A 04450 IF MAP-SOURCE-CD = '05' DTSCS1A 04451 MOVE '05' TO MAP-LETTER-1-CD DTSCS1A 04452 ELSE DTSCS1A 04453 IF MAP-SOURCE-CD = '01' OR '02' DTSCS1A 04454 MOVE '02' TO MAP-LETTER-1-CD DTSCS1A 04455 ELSE DTSCS1A 04456 IF MAP-SOURCE-CD = '14' DTSCS1A 04457 MOVE '04' TO MAP-LETTER-1-CD DTSCS1A 04458 ELSE DTSCS1A 04459 MOVE '01' TO MAP-LETTER-1-CD. DTSCS1A 04460 DTSCS1A 04461 MOVE MAP-LETTER-1-CD TO L031-CD-2. DTSCS1A 04462 DTSCS1A 04463 SET L031-MERA-LETTER-1-CD TO TRUE. DTSCS1A 04464 DTSCS1A 04465 PERFORM S031-REG-CODES THRU S031-EXIT. DTSCS1A 04466 DTSCS1A 04467 IF L031-NOT-VALID DTSCS1A 04468 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04469 PERFORM S2801-ERROR THRU S2801-EXIT. DTSCS1A 04470 S2800-EXIT. EXIT. DTSCS1A 04471 DTSCS1A 04472 DTSCS1A 04473 DTSCS1A 04474 S2801-ERROR. DTSCS1A 04475 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-LETTER-1-CD-A. DTSCS1A 04476 DTSCS1A 04477 IF LCCM-NO-MSG DTSCS1A 04478 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04479 MOVE CATB-CURSOR TO MAP-LETTER-1-CD-L DTSCS1A 04480 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04481 S2801-EXIT. EXIT. DTSCS1A 04482 /*****************************************************************DTSCS1A 04483 * *DTSCS1A 04484 ******************************************************************DTSCS1A 04485 S2900-MAIL-DATE-2. DTSCS1A 04486 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04487 OR DTSCS1A 04488 MAP-SOURCE-CD-NA-88 DTSCS1A 04489 MOVE SPACES TO MAP-MAIL-2-MO DTSCS1A 04490 MAP-MAIL-2-DA DTSCS1A 04491 MAP-MAIL-2-YR DTSCS1A 04492 GO TO S2900-EXIT. DTSCS1A 04493 DTSCS1A 04494 DTSCS1A 04495 MOVE MAP-MAIL-DATE-2-AREA TO L015-S-DATE-AREA. DTSCS1A 04496 DTSCS1A 04497 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 04498 DTSCS1A 04499 IF L015-NOT-VALID DTSCS1A 04500 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04501 PERFORM S2901-ERROR THRU S2901-EXIT. DTSCS1A 04502 S2900-EXIT. EXIT. DTSCS1A 04503 DTSCS1A 04504 DTSCS1A 04505 DTSCS1A 04506 S2901-ERROR. DTSCS1A 04507 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAIL-2-MO-A DTSCS1A 04508 MAP-MAIL-2-DA-A DTSCS1A 04509 MAP-MAIL-2-YR-A. DTSCS1A 04510 DTSCS1A 04511 IF LCCM-NO-MSG DTSCS1A 04512 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04513 MOVE CATB-CURSOR TO MAP-MAIL-2-MO-L DTSCS1A 04514 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04515 S2901-EXIT. EXIT. DTSCS1A 04516 /*****************************************************************DTSCS1A 04517 * *DTSCS1A 04518 ******************************************************************DTSCS1A 04519 S3000-RECEIVED-DATE. DTSCS1A 04520 MOVE ZERO TO WRK-FR500-RCVD-DATE. DTSCS1A 04521 DTSCS1A 04522 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04523 OR DTSCS1A 04524 MAP-SOURCE-CD-NA-88 DTSCS1A 04525 MOVE SPACES TO MAP-RECEIVED-MO DTSCS1A 04526 MAP-RECEIVED-DA DTSCS1A 04527 MAP-RECEIVED-YR DTSCS1A 04528 GO TO S3000-EXIT. DTSCS1A 04529 DTSCS1A 04530 DTSCS1A 04531 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 04532 DTSCS1A 04533 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 04534 DTSCS1A 04535 IF L015-NOT-VALID DTSCS1A 04536 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04537 PERFORM S3001-ERROR THRU S3001-EXIT DTSCS1A 04538 ELSE DTSCS1A 04539 IF L015-NO-ENTRY DTSCS1A 04540 IF MAP-STATUS-CD = '11' DTSCS1A 04541 MOVE LCCM-CURR-RUN-DATE TO WRK-DISPLAY DTSCS1A 04542 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-YR DTSCS1A 04543 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-MO DTSCS1A 04544 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DA DTSCS1A 04545 END-IF DTSCS1A 04546 END-IF DTSCS1A 04547 END-IF. DTSCS1A 04548 DTSCS1A 04549 IF L015-VALID DTSCS1A 04550 MOVE L015-DATE TO WRK-FR500-RCVD-DATE DTSCS1A 04551 END-IF. DTSCS1A 04552 DTSCS1A 04553 * ELSE DTSCS1A 04554 * NEXT SENTENCE DTSCS1A 04555 * ELSE DTSCS1A 04556 * IF MAP-STATUS-CD < '11' DTSCS1A 04557 * MOVE SPACES TO MAP-RECEIVED-MO DTSCS1A 04558 * MAP-RECEIVED-DA DTSCS1A 04559 * MAP-RECEIVED-YR. DTSCS1A 04560 S3000-EXIT. EXIT. DTSCS1A 04561 DTSCS1A 04562 DTSCS1A 04563 DTSCS1A 04564 S3001-ERROR. DTSCS1A 04565 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-RECEIVED-MO-A DTSCS1A 04566 MAP-RECEIVED-DA-A DTSCS1A 04567 MAP-RECEIVED-YR-A. DTSCS1A 04568 DTSCS1A 04569 IF LCCM-NO-MSG DTSCS1A 04570 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04571 MOVE CATB-CURSOR TO MAP-RECEIVED-MO-L DTSCS1A 04572 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04573 S3001-EXIT. EXIT. DTSCS1A 04574 /*****************************************************************DTSCS1A 04575 * *DTSCS1A 04576 ******************************************************************DTSCS1A 04577 S3100-COOP-AGENCY-REQ-DATE. DTSCS1A 04578 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04579 OR DTSCS1A 04580 MAP-SOURCE-CD-NA-88 DTSCS1A 04581 MOVE SPACES TO MAP-COOP-AGENCY-REQ-MO DTSCS1A 04582 MAP-COOP-AGENCY-REQ-DA DTSCS1A 04583 MAP-COOP-AGENCY-REQ-YR DTSCS1A 04584 GO TO S3100-EXIT. DTSCS1A 04585 DTSCS1A 04586 DTSCS1A 04587 MOVE MAP-COOP-AGENCY-REQ-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 04588 DTSCS1A 04589 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 04590 DTSCS1A 04591 IF L015-NOT-VALID DTSCS1A 04592 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04593 PERFORM S3101-ERROR THRU S3101-EXIT. DTSCS1A 04594 S3100-EXIT. EXIT. DTSCS1A 04595 DTSCS1A 04596 DTSCS1A 04597 DTSCS1A 04598 S3101-ERROR. DTSCS1A 04599 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS1A 04600 TO MAP-COOP-AGENCY-REQ-MO-A DTSCS1A 04601 MAP-COOP-AGENCY-REQ-DA-A DTSCS1A 04602 MAP-COOP-AGENCY-REQ-YR-A. DTSCS1A 04603 DTSCS1A 04604 IF LCCM-NO-MSG DTSCS1A 04605 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04606 MOVE CATB-CURSOR TO MAP-COOP-AGENCY-REQ-MO-L DTSCS1A 04607 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04608 S3101-EXIT. EXIT. DTSCS1A 04609 /*****************************************************************DTSCS1A 04610 * *DTSCS1A 04611 ******************************************************************DTSCS1A 04612 S3200-DETER-NOTSUB-DATE. DTSCS1A 04613 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04614 OR DTSCS1A 04615 MAP-SOURCE-CD-NA-88 DTSCS1A 04616 MOVE SPACES TO MAP-DETER-NOTSUB-MO DTSCS1A 04617 MAP-DETER-NOTSUB-DA DTSCS1A 04618 MAP-DETER-NOTSUB-YR DTSCS1A 04619 GO TO S3200-EXIT. DTSCS1A 04620 DTSCS1A 04621 DTSCS1A 04622 MOVE MAP-DETER-NOTSUB-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 04623 DTSCS1A 04624 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 04625 DTSCS1A 04626 IF L015-NOT-VALID DTSCS1A 04627 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04628 PERFORM S3201-ERROR THRU S3201-EXIT DTSCS1A 04629 ELSE DTSCS1A 04630 IF L015-NO-ENTRY DTSCS1A 04631 AND (MAP-STATUS-CD = '21') DTSCS1A 04632 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS1A 04633 PERFORM S3201-ERROR THRU S3201-EXIT DTSCS1A 04634 ELSE DTSCS1A 04635 IF L015-VALID DTSCS1A 04636 IF MAP-STATUS-CD = '21' DTSCS1A 04637 NEXT SENTENCE DTSCS1A 04638 ELSE DTSCS1A 04639 MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS1A 04640 PERFORM S3201-ERROR THRU S3201-EXIT. DTSCS1A 04641 S3200-EXIT. EXIT. DTSCS1A 04642 DTSCS1A 04643 DTSCS1A 04644 DTSCS1A 04645 S3201-ERROR. DTSCS1A 04646 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-DETER-NOTSUB-MO-A DTSCS1A 04647 MAP-DETER-NOTSUB-DA-A DTSCS1A 04648 MAP-DETER-NOTSUB-YR-A. DTSCS1A 04649 DTSCS1A 04650 IF LCCM-NO-MSG DTSCS1A 04651 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04652 MOVE CATB-CURSOR TO MAP-DETER-NOTSUB-MO-L DTSCS1A 04653 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04654 S3201-EXIT. EXIT. DTSCS1A 04655 /*****************************************************************DTSCS1A 04656 * *DTSCS1A 04657 ******************************************************************DTSCS1A 04658 S3300-FIELD-ASSIGN-DATE. DTSCS1A 04659 IF WRK-EMP-CHG-ONLY-88 DTSCS1A 04660 OR DTSCS1A 04661 MAP-SOURCE-CD-NA-88 DTSCS1A 04662 MOVE SPACES TO MAP-FIELD-ASSIGN-MO DTSCS1A 04663 MAP-FIELD-ASSIGN-DA DTSCS1A 04664 MAP-FIELD-ASSIGN-YR DTSCS1A 04665 GO TO S3300-EXIT. DTSCS1A 04666 DTSCS1A 04667 DTSCS1A 04668 MOVE MAP-FIELD-ASSIGN-DATE-AREA TO L015-S-DATE-AREA. DTSCS1A 04669 DTSCS1A 04670 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS1A 04671 DTSCS1A 04672 IF L015-NOT-VALID DTSCS1A 04673 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS1A 04674 PERFORM S3301-ERROR THRU S3301-EXIT. DTSCS1A 04675 S3300-EXIT. EXIT. DTSCS1A 04676 DTSCS1A 04677 DTSCS1A 04678 DTSCS1A 04679 S3301-ERROR. DTSCS1A 04680 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS1A 04681 TO MAP-FIELD-ASSIGN-MO-A DTSCS1A 04682 MAP-FIELD-ASSIGN-DA-A DTSCS1A 04683 MAP-FIELD-ASSIGN-YR-A. DTSCS1A 04684 DTSCS1A 04685 IF LCCM-NO-MSG DTSCS1A 04686 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04687 MOVE CATB-CURSOR TO MAP-FIELD-ASSIGN-MO-L DTSCS1A 04688 SET CURSOR-SET-YES TO TRUE. DTSCS1A 04689 S3301-EXIT. EXIT. DTSCS1A 04690 EJECT DTSCS1A 04691 /*****************************************************************DTSCS1A 04692 * ENSURE THAT A LOCAL DC ADDRESS IS ON FILE BEFORE ALLOWING *DTSCS1A 04693 * A LIABLE DETERMINATION, IF THAT DETERMINATION IS BASED ON *DTSCS1A 04694 * AN FR-500. *DTSCS1A 04695 ******************************************************************DTSCS1A 04696 S4000-CHK-FOR-DC-ADDR. DTSCS1A 04697 SET WRK-DC-ADDR-NO-88 TO TRUE. DTSCS1A 04698 SET WRK-PO-BOX-NO-88 TO TRUE. DTSCS1A 04699 DTSCS1A 04700 IF MAP-VERIFY-YES-88 DTSCS1A 04701 * AND (LCCM-OP-IS-FLD-DESK-88 DTSCS1A 04702 * OR LCCM-OP-IS-ACCOUNTING-DESK-88) DTSCS1A 04703 GO TO S4000-EXIT DTSCS1A 04704 END-IF. DTSCS1A 04705 DTSCS1A 04706 IF NOT MPRF-STATUS-ACT-88 DTSCS1A 04707 GO TO S4000-EXIT DTSCS1A 04708 END-IF. DTSCS1A 04709 DTSCS1A 04710 IF WRK-MERA-NO-88 DTSCS1A 04711 GO TO S4000-EXIT DTSCS1A 04712 ELSE DTSCS1A 04713 IF WRK-FR500-RCVD-DATE > ZERO DTSCS1A 04714 AND MERA-RECEIVED-DATE = ZERO DTSCS1A 04715 NEXT SENTENCE DTSCS1A 04716 ELSE DTSCS1A 04717 GO TO S4000-EXIT DTSCS1A 04718 END-IF DTSCS1A 04719 END-IF. DTSCS1A 04720 DTSCS1A 04721 IF MTAD-ST = 'DC' DTSCS1A 04722 SET WRK-DC-ADDR-YES-88 TO TRUE DTSCS1A 04723 IF MTAD-DELIV-LINE-1(1:6) = 'PO BOX' DTSCS1A 04724 OR MTAD-DELIV-LINE-2(1:6) = 'PO BOX' DTSCS1A 04725 OR MTAD-DELIV-LINE-1(1:7) = 'P O BOX' DTSCS1A 04726 OR MTAD-DELIV-LINE-2(1:7) = 'P O BOX' DTSCS1A 04727 SET WRK-PO-BOX-YES-88 TO TRUE DTSCS1A 04728 ELSE DTSCS1A 04729 GO TO S4000-EXIT DTSCS1A 04730 END-IF DTSCS1A 04731 END-IF. DTSCS1A 04732 DTSCS1A 04733 MOVE LOW-VALUES TO DTSCS1A 04734 MTAD-KEY-AREA. DTSCS1A 04735 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS1A 04736 SET MTAD-TAD-88 TO TRUE. DTSCS1A 04737 SET MTAD-ID-TAX-RECORDS-ADDR-88 TO TRUE. DTSCS1A 04738 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS1A 04739 PERFORM S810-READ THRU S810-EXIT. DTSCS1A 04740 IF L810-NO-REC-88 DTSCS1A 04741 IF WRK-DC-ADDR-NO-88 DTSCS1A 04742 MOVE MSG-E1A7-AREA TO WRK-MSG-AREA DTSCS1A 04743 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A 04744 GO TO S4000-EXIT DTSCS1A 04745 ELSE DTSCS1A 04746 IF WRK-PO-BOX-YES-88 DTSCS1A 04747 MOVE MSG-E1A8-AREA TO WRK-MSG-AREA DTSCS1A 04748 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A 04749 GO TO S4000-EXIT DTSCS1A 04750 END-IF DTSCS1A 04751 END-IF DTSCS1A 04752 END-IF. DTSCS1A 04753 DTSCS1A 04754 MOVE MSKL-REC TO MTAD-REC. DTSCS1A 04755 IF MTAD-ST = 'DC' DTSCS1A 04756 IF MTAD-DELIV-LINE-1(1:6) = 'PO BOX' DTSCS1A 04757 OR MTAD-DELIV-LINE-2(1:6) = 'PO BOX' DTSCS1A 04758 OR MTAD-DELIV-LINE-1(1:7) = 'P O BOX' DTSCS1A 04759 OR MTAD-DELIV-LINE-2(1:7) = 'P O BOX' DTSCS1A 04760 MOVE MSG-E1A8-AREA TO WRK-MSG-AREA DTSCS1A 04761 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A 04762 ELSE DTSCS1A 04763 GO TO S4000-EXIT DTSCS1A 04764 END-IF DTSCS1A 04765 ELSE DTSCS1A 04766 MOVE MSG-E1A7-AREA TO WRK-MSG-AREA DTSCS1A 04767 PERFORM S4001-ERROR THRU S4001-EXIT DTSCS1A 04768 END-IF. DTSCS1A 04769 DTSCS1A 04770 S4000-EXIT. EXIT. DTSCS1A 04771 DTSCS1A 04772 S4001-ERROR. DTSCS1A 04773 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS1A 04774 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A 04775 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A 04776 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A 04777 DTSCS1A 04778 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RECEIVED-MO-A. DTSCS1A 04779 DTSCS1A 04780 IF LCCM-NO-MSG DTSCS1A 04781 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS1A 04782 MOVE CATB-CURSOR TO MAP-RECEIVED-MO-L DTSCS1A 04783 SET CURSOR-SET-YES TO TRUE DTSCS1A 04784 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS1A 04785 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS1A 04786 * MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS1A 04787 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS1A 04788 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS1A 04789 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS1A 04790 END-IF. DTSCS1A 04791 S4001-EXIT. EXIT. DTSCS1A 04792 DTSCS1A 04793 ******************************************************************DTSCS1A 04794 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS1A 04795 ******************************************************************DTSCS1A 04796 S5100-SET-LOCK-ATTRB. DTSCS1A 04797 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS1A 04798 WRK-ATB-NUM. DTSCS1A 04799 DTSCS1A 04800 DTSCS1A 04801 MOVE MAP-ATTN-LINE-A TO HOLD-ATTN-LINE-A. DTSCS1A 04802 DTSCS1A 04803 MOVE MAP-DELIV-LINE-1-A TO HOLD-DELIV-LINE-1-A. DTSCS1A 04804 DTSCS1A 04805 MOVE MAP-DELIV-LINE-2-A TO HOLD-DELIV-LINE-2-A. DTSCS1A 04806 DTSCS1A 04807 MOVE MAP-CITY-A TO HOLD-CITY-A. DTSCS1A 04808 DTSCS1A 04809 MOVE MAP-ST-A TO HOLD-ST-A. DTSCS1A 04810 DTSCS1A 04811 MOVE MAP-ZIP-A TO HOLD-ZIP-A. DTSCS1A 04812 DTSCS1A 04813 DTSCS1A 04814 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1A 04815 DTSCS1A 04816 DTSCS1A 04817 IF HOLD-ATTN-LINE-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A 04818 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-LINE-A. DTSCS1A 04819 DTSCS1A 04820 IF HOLD-DELIV-LINE-1-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A 04821 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DELIV-LINE-1-A. DTSCS1A 04822 DTSCS1A 04823 IF HOLD-DELIV-LINE-2-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A 04824 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DELIV-LINE-2-A. DTSCS1A 04825 DTSCS1A 04826 IF HOLD-CITY-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A 04827 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A. DTSCS1A 04828 DTSCS1A 04829 IF HOLD-ST-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A 04830 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ST-A. DTSCS1A 04831 DTSCS1A 04832 IF HOLD-ZIP-A = CATB-UNPROT-NORM-AN-MDTON DTSCS1A 04833 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIP-A. DTSCS1A 04834 DTSCS1A 04835 DTSCS1A 04836 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS1A 04837 MAP-EMP-NO-2-A DTSCS1A 04838 MAP-GOTO-A. DTSCS1A 04839 S5100-EXIT. DTSCS1A 04840 EXIT. DTSCS1A 04841 SKIP3 DTSCS1A 04842 ******************************************************************DTSCS1A 04843 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS1A 04844 ******************************************************************DTSCS1A 04845 S5200-SET-UPDATE-ATTRB. DTSCS1A 04846 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS1A 04847 DTSCS1A 04848 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS1A 04849 DTSCS1A 04850 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1A 04851 S5200-EXIT. DTSCS1A 04852 EXIT. DTSCS1A 04853 SKIP3 DTSCS1A 04854 ******************************************************************DTSCS1A 04855 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS1A 04856 ******************************************************************DTSCS1A 04857 S5300-SET-INQ-ATTRB. DTSCS1A 04858 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS1A 04859 WRK-ATB-NUM. DTSCS1A 04860 DTSCS1A 04861 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS1A 04862 S5300-EXIT. DTSCS1A 04863 EXIT. DTSCS1A 04864 SKIP3 DTSCS1A 04865 S5900-SET-ATTRB. DTSCS1A 04866 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS1A 04867 MAP-EMP-NO-2-A. DTSCS1A 04868 DTSCS1A 04869 MOVE WRK-ATB-AN TO MAP-DELETE-EMP-IND-A DTSCS1A 04870 MAP-ELIGIBLE-CD-A DTSCS1A 04871 MAP-PRIMARY-NAME-A DTSCS1A 04872 MAP-ENTITY-NAME-IND-A DTSCS1A 04873 MAP-ENTITY-NAME-A DTSCS1A 04874 MAP-CASS-IND-A DTSCS1A 04875 MAP-ATTN-LINE-A DTSCS1A 04876 MAP-ATTN-LINE-A DTSCS1A 04877 MAP-FISC-AGNT-CD-A DTSCS1A 04878 MAP-DELIV-LINE-1-A DTSCS1A 04879 MAP-DELIV-LINE-2-A DTSCS1A 04880 MAP-CITY-A DTSCS1A 04881 MAP-ST-A DTSCS1A 04882 MAP-ZIP-A DTSCS1A 04883 MAP-SOURCE-CD-A DTSCS1A 04884 MAP-POT-HOUSEHOLD-A DTSCS1A 04885 MAP-CLAIMANT-NAME-A DTSCS1A 04886 MAP-RESP-OP-ID-A DTSCS1A 04887 MAP-NOTE-A. DTSCS1A 04888 DTSCS1A 04889 MOVE WRK-ATB-NUM TO MAP-VOICE-1-AREA-CD-A DTSCS1A 04890 MAP-VOICE-1-PREFIX-A DTSCS1A 04891 MAP-VOICE-1-SUFFIX-A DTSCS1A 04892 MAP-VOICE-1-EXT-A DTSCS1A 04893 MAP-VOICE-2-AREA-CD-A DTSCS1A 04894 MAP-VOICE-2-PREFIX-A DTSCS1A 04895 MAP-VOICE-2-SUFFIX-A DTSCS1A 04896 MAP-VOICE-2-EXT-A DTSCS1A 04897 MAP-FAX-AREA-CD-A DTSCS1A 04898 MAP-FAX-PREFIX-A DTSCS1A 04899 MAP-FAX-SUFFIX-A DTSCS1A 04900 MAP-FAX-EXT-A DTSCS1A 04901 MAP-FEIN-1-A DTSCS1A 04902 MAP-FEIN-2-A DTSCS1A 04903 MAP-CLAIMANT-SSN-1-A DTSCS1A 04904 MAP-CLAIMANT-SSN-2-A DTSCS1A 04905 MAP-CLAIMANT-SSN-3-A DTSCS1A 04906 MAP-PRED-EMP-NO-1-A DTSCS1A 04907 MAP-PRED-EMP-NO-2-A DTSCS1A 04908 MAP-STATUS-CD-A DTSCS1A 04909 MAP-LETTER-1-CD-A DTSCS1A 04910 MAP-MAIL-1-MO-A DTSCS1A 04911 MAP-MAIL-1-DA-A DTSCS1A 04912 MAP-MAIL-1-YR-A DTSCS1A 04913 MAP-MAIL-2-MO-A DTSCS1A 04914 MAP-MAIL-2-DA-A DTSCS1A 04915 MAP-MAIL-2-YR-A DTSCS1A 04916 MAP-RECEIVED-MO-A DTSCS1A 04917 MAP-RECEIVED-DA-A DTSCS1A 04918 MAP-RECEIVED-YR-A DTSCS1A 04919 MAP-COOP-AGENCY-REQ-MO-A DTSCS1A 04920 MAP-COOP-AGENCY-REQ-DA-A DTSCS1A 04921 MAP-COOP-AGENCY-REQ-YR-A DTSCS1A 04922 MAP-DETER-NOTSUB-MO-A DTSCS1A 04923 MAP-DETER-NOTSUB-DA-A DTSCS1A 04924 MAP-DETER-NOTSUB-YR-A DTSCS1A 04925 MAP-FIELD-ASSIGN-MO-A DTSCS1A 04926 MAP-FIELD-ASSIGN-DA-A DTSCS1A 04927 MAP-FIELD-ASSIGN-YR-A. DTSCS1A 04928 DTSCS1A 04929 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-FLD-REP-ID-A. DTSCS1A 04930 DTSCS1A 04931 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-A. DTSCS1A 04932 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-LIT-A. DTSCS1A 04933 DTSCS1A 04934 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS1A 04935 S5900-EXIT. DTSCS1A 04936 EXIT. DTSCS1A 04937 EJECT DTSCS1A 04938 S8000-TICKLE. DTSCS1A 04939 MOVE LOW-VALUES TO MTCK-REC. DTSCS1A 04940 DTSCS1A 04941 MOVE WRK-EMP-NO TO MTCK-EMP-NO. DTSCS1A 04942 DTSCS1A 04943 SET MTCK-TCK-88 TO TRUE. DTSCS1A 04944 DTSCS1A 04945 MOVE LCCM-TASK-START-ABSTIME TO MTCK-ESTB-ABSTIME. DTSCS1A 04946 DTSCS1A 04947 MOVE ZEROS TO MTCK-PURGE-DATE DTSCS1A 04948 DTSCS1A 04949 SET MTCK-TYPE-CYCLE-A-88 TO TRUE. DTSCS1A 04950 DTSCS1A 04951 MOVE LCCM-CURR-RUN-DATE TO MTCK-TRIGGER-DATE DTSCS1A 04952 DTSCS1A 04953 MOVE ZEROS TO MTCK-ACKNOWLEDGED-DATE. DTSCS1A 04954 DTSCS1A 04955 MOVE 'SYSTEM' TO MTCK-SOURCE-OP-ID. DTSCS1A 04956 DTSCS1A 04957 MOVE 'SYSTEM' TO MTCK-DEST-OP-ID. DTSCS1A 04958 DTSCS1A 04959 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSCS1A 04960 DTSCS1A 04961 MOVE LCCM-CURR-RUN-DATE TO MTCK-ESTB-DATE. DTSCS1A 04962 DTSCS1A 04963 MOVE LCCM-CURR-RUN-DATE TO MTCK-CHNG-DATE. DTSCS1A 04964 DTSCS1A 04965 MOVE ZEROS TO MTCK-TEXT-CNT. DTSCS1A 04966 DTSCS1A 04967 MOVE MTCK-REC TO MSKL-REC. DTSCS1A 04968 DTSCS1A 04969 PERFORM S810-WRITE THRU S810-EXIT. DTSCS1A 04970 S8000-EXIT. EXIT. DTSCS1A 04971 /*****************************************************************DTSCS1A 04972 * MAP ROUTINES *DTSCS1A 04973 ******************************************************************DTSCS1A 04974 S9100-RECEIVE. DTSCS1A 04975 SET L851-RECEIVE-88 TO TRUE. DTSCS1A 04976 DTSCS1A 04977 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS1A 04978 DTSCS1A 04979 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1A 04980 DTSCS1A 04981 MOVE L851-AID TO LCCM-AID. DTSCS1A 04982 DTSCS1A 04983 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS1A 04984 S9100-EXIT. DTSCS1A 04985 EXIT. DTSCS1A 04986 SKIP3 DTSCS1A 04987 S9200-SEND-DATAONLY. DTSCS1A 04988 MOVE LOW-VALUES TO MAP-AREA. DTSCS1A 04989 DTSCS1A 04990 IF LCCM-NO-MSG DTSCS1A 04991 NEXT SENTENCE DTSCS1A 04992 ELSE DTSCS1A 04993 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS1A 04994 DTSCS1A 04995 IF CURSOR-SET-GOTO DTSCS1A 04996 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS1A 04997 ELSE DTSCS1A 04998 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS1A 04999 DTSCS1A 05000 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS1A 05001 DTSCS1A 05002 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS1A 05003 DTSCS1A 05004 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1A 05005 S9200-EXIT. DTSCS1A 05006 EXIT. DTSCS1A 05007 SKIP3 DTSCS1A 05008 S9300-SEND-MAP. DTSCS1A 05009 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS1A 05010 DTSCS1A 05011 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS1A 05012 DTSCS1A 05013 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS1A 05014 DTSCS1A 05015 IF SCR-ACCESS-UPDATE DTSCS1A 05016 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS1A 05017 ELSE DTSCS1A 05018 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS1A 05019 DTSCS1A 05020 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS1A 05021 DTSCS1A 05022 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS1A 05023 DTSCS1A 05024 IF CURSOR-SET-NO DTSCS1A 05025 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS1A 05026 DTSCS1A 05027 SET L851-SEND-88 TO TRUE. DTSCS1A 05028 DTSCS1A 05029 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS1A 05030 DTSCS1A 05031 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS1A 05032 S9300-EXIT. DTSCS1A 05033 EXIT. DTSCS1A 05034 SKIP3 DTSCS1A 05035 S9310-UPDATE-FKEYS. DTSCS1A 05036 MOVE CFKD-ADD TO MAP-KEY-ADD. DTSCS1A 05037 DTSCS1A 05038 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS1A 05039 DTSCS1A 05040 MOVE CFKD-DEL TO MAP-KEY-DEL. DTSCS1A 05041 DTSCS1A 05042 IF LCCM-SCR-CLEAR DTSCS1A 05043 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS1A 05044 MAP-KEY-DEL DTSCS1A 05045 ELSE DTSCS1A 05046 IF LCCM-SCR-INQUIRE DTSCS1A 05047 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS1A 05048 ELSE DTSCS1A 05049 IF LCCM-SCR-UPDATE-LOCKED DTSCS1A 05050 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS1A 05051 MAP-KEY-MOD DTSCS1A 05052 MAP-KEY-DEL DTSCS1A 05053 ELSE DTSCS1A 05054 NEXT SENTENCE. DTSCS1A 05055 S9310-EXIT. DTSCS1A 05056 EXIT. DTSCS1A 05057 SKIP3 DTSCS1A 05058 S9320-INQUIRY-FKEYS. DTSCS1A 05059 MOVE LOW-VALUES TO MAP-KEY-ADD DTSCS1A 05060 MAP-KEY-MOD DTSCS1A 05061 MAP-KEY-DEL. DTSCS1A 05062 S9320-EXIT. DTSCS1A 05063 EXIT. DTSCS1A 05064 SKIP3 DTSCS1A 05065 S9330-DSCR-FIELDS. DTSCS1A 05066 IF MAP-SOURCE-CD EQUAL LOW-VALUES OR SPACES DTSCS1A 05067 MOVE LOW-VALUES TO MAP-SOURCE-DESC DTSCS1A 05068 ELSE DTSCS1A 05069 MOVE MAP-SOURCE-CD TO L031-CD-2 DTSCS1A 05070 SET L031-MERA-SOURCE-CD TO TRUE DTSCS1A 05071 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A 05072 MOVE L031-SHORT-DSCR TO MAP-SOURCE-DESC. DTSCS1A 05073 DTSCS1A 05074 DTSCS1A 05075 IF MAP-RESP-OP-ID EQUAL LOW-VALUES OR SPACES DTSCS1A 05076 MOVE LOW-VALUES TO MAP-RESP-OP-ID-DESC DTSCS1A 05077 ELSE DTSCS1A 05078 IF MAP-RESP-OP-ID = LCCM-OP-ID DTSCS1A 05079 MOVE LCCM-OP-NAME TO MAP-RESP-OP-ID-DESC DTSCS1A 05080 ELSE DTSCS1A 05081 MOVE MAP-RESP-OP-ID TO L082-OP-ID DTSCS1A 05082 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT DTSCS1A 05083 MOVE L082-NAME TO MAP-RESP-OP-ID-DESC. DTSCS1A 05084 DTSCS1A 05085 DTSCS1A 05086 IF (WRK-MPRF-YES-88) AND (NOT LCCM-SCR-CLEAR) DTSCS1A 05087 MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST DTSCS1A 05088 MOVE WRK-EMP-NO TO L061-EMP-NO DTSCS1A 05089 PERFORM S061-FLD-REP-FIND THRU S061-EXIT DTSCS1A 05090 MOVE L061-FLD-REP-ID TO MAP-FLD-REP-ID DTSCS1A 05091 L062-FLD-REP-ID DTSCS1A 05092 PERFORM S062-FLD-REP-LOOKUP THRU S062-EXIT DTSCS1A 05093 MOVE L062-NAME TO MAP-FLD-REP-DESC DTSCS1A 05094 ELSE DTSCS1A 05095 MOVE LOW-VALUES TO MAP-FLD-REP-ID DTSCS1A 05096 MAP-FLD-REP-DESC. DTSCS1A 05097 DTSCS1A 05098 DTSCS1A 05099 IF MAP-STATUS-CD EQUAL LOW-VALUES OR SPACES DTSCS1A 05100 MOVE LOW-VALUES TO MAP-STATUS-DESC DTSCS1A 05101 ELSE DTSCS1A 05102 MOVE MAP-STATUS-CD TO L031-CD-2 DTSCS1A 05103 SET L031-MERA-STATUS-CD TO TRUE DTSCS1A 05104 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A 05105 MOVE L031-SHORT-DSCR TO MAP-STATUS-DESC. DTSCS1A 05106 DTSCS1A 05107 DTSCS1A 05108 IF MAP-LETTER-1-CD EQUAL LOW-VALUES OR SPACES DTSCS1A 05109 MOVE LOW-VALUES TO MAP-LETTER-1-DESC DTSCS1A 05110 ELSE DTSCS1A 05111 MOVE MAP-LETTER-1-CD TO L031-CD-2 DTSCS1A 05112 SET L031-MERA-LETTER-1-CD TO TRUE DTSCS1A 05113 PERFORM S031-REG-CODES THRU S031-EXIT DTSCS1A 05114 MOVE L031-SHORT-DSCR TO MAP-LETTER-1-DESC. DTSCS1A 05115 DTSCS1A 05116 DTSCS1A 05117 MOVE MAP-PRED-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS1A 05118 DTSCS1A 05119 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS1A 05120 DTSCS1A 05121 IF L018-VALID DTSCS1A 05122 MOVE LOW-VALUES TO MPRF-KEY-AREA DTSCS1A 05123 MOVE L018-EMP-NO TO MPRF-EMP-NO DTSCS1A 05124 SET MPRF-PRF-88 TO TRUE DTSCS1A 05125 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA DTSCS1A 05126 PERFORM S810-READ THRU S810-EXIT DTSCS1A 05127 IF L810-OK-88 DTSCS1A 05128 MOVE MSKL-REC TO MPRF-REC DTSCS1A 05129 MOVE MPRF-PRIMARY-NAME TO MAP-PRED-NAME DTSCS1A 05130 ELSE DTSCS1A 05131 MOVE 'NAME NOT AVAILABLE' TO MAP-PRED-NAME DTSCS1A 05132 ELSE DTSCS1A 05133 MOVE LOW-VALUES TO MAP-PRED-NAME. DTSCS1A 05134 S9330-EXIT. EXIT. DTSCS1A 05135 SKIP3 DTSCS1A 05136 S9900-PREPARE-SEND. DTSCS1A 05137 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS1A 05138 LCCM-SCR-ID. DTSCS1A 05139 DTSCS1A 05140 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS1A 05141 DTSCS1A 05142 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS1A 05143 S9900-EXIT. DTSCS1A 05144 EXIT. DTSCS1A