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
