00001  IDENTIFICATION DIVISION.                                         05/07/25
00002  PROGRAM-ID.             DTSCS76.                                 DTSCS76
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV001
00004  DATE-WRITTEN.           MAY 1994.                                DTSCS76
00005  DATE-COMPILED.                                                   DTSCS76
00006                                                                   DTSCS76
00007 *****                                                             DTSCS76
00008 *                                                                 DTSCS76
00009 *    FUNCTION:  MISCELLANEOUS BATCH/ONLINE REQUEST                DTSCS76
00010 *               SCREEN PROCESSOR.                                 DTSCS76
00011 *                                                                 DTSCS76
00012 *                                                                 DTSCS76
00013 *    MODIFICATION LOG:                                            DTSCS76
00014 *                                                                 DTSCS76
00015 *    10/04/98  INITIAL DEVELOPMENT.      COPIED FROM MACCS76.     DTSCS76
00016 *              REFERENCE RFP:                   PROGRAMMER: ZL1   DTSCS76
00017 *                                                                 DTSCS76
00018 *    11/01/02  MODIFIED SCREEN TO ALLOW FOR EMPLOYER WAGE REQUEST.DTSCS76
00019 *              IR751 RECORD IS GENERATED.  THE USER SPECIFIES AN  DTSCS76
00020 *              SSN AND THE QUARTER(S) OF THE WAGE REQUEST.        DTSCS76
00021 *              THIS MODIFICATION EDITS THE WAGE REQUEST           DTSCS76
00022 *              SCREEN DATA AND WRITES THE DTSIR751 REPORT RECORD. DTSCS76
00023 *              DTSBR751 PRINTS THE WAGE REQUEST.                  DTSCS76
00024 *                                                                 DTSCS76
00025 *    09/04/05  MODIFIED SCREEN TO ALLOW FOR PRINTING STATEMENT OF DTSCS76
00026 *              ACCOUNTS OVERNIGHT.         THE USER SPECIFIES AN  DTSCS76
00027 *              THE QUARTER(S) OF THE ACCOUNT TO PRINT.            DTSCS76
00028 *              THIS MODIFICATION EDITS THE PRINT REQUEST          DTSCS76
00029 *              SCREEN DATA AND WRITES THE T011  TRANSACTION RECORDDTSCS76
00030 *              DTSBD327 READS THE T011 AND BIULDS A IR414 RECORD. DTSCS76
00031 *                                                                 DTSCS76
00032 *              REFERENCE RFP:                   PROGRAMMER: ZL1   DTSCS76
00033 *    XX/XX/XX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS76
00034 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCS76
00035 *              REFERENCE RFP: #***              PROGRAMMER: XXX   DTSCS76
00036 *                                                                 DTSCS76
00037 *                                                                 DTSCS76
00038 *  DESCRIPTION:                                                   DTSCS76
00039 *                                                                 DTSCS76
00040 *                                                                 DTSCS76
00041 *    CLEAR:                                                       DTSCS76
00042 *                                                                 DTSCS76
00043 *      FIELD DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO).            DTSCS76
00044 *                                                                 DTSCS76
00045 *                                                                 DTSCS76
00046 *    JUMP:                                                        DTSCS76
00047 *                                                                 DTSCS76
00048 *      NONE.                                                      DTSCS76
00049 *                                                                 DTSCS76
00050 *                                                                 DTSCS76
00051 *    INQUIRY:                                                     DTSCS76
00052 *                                                                 DTSCS76
00053 *      CONTROL FIELD(S): MAP-EMP-NO.                              DTSCS76
00054 *                                                                 DTSCS76
00055 *      JUMP IN: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO. DTSCS76
00056 *                                                                 DTSCS76
00057 *      ENTER: DISPLAY PRIMARY NAME ASSOCIATED WITH LCCM-EMP-NO.   DTSCS76
00058 *                                                                 DTSCS76
00059 *      STANDARD LCCM-EMP-NO.                                      DTSCS76
00060 *                                                                 DTSCS76
00061 *                                                                 DTSCS76
00062 *    UPDATE:                                                      DTSCS76
00063 *                                                                 DTSCS76
00064 *      ADD                                                        DTSCS76
00065 *                                                                 DTSCS76
00066 *        DOES NOT UPDATE THE MASTER FILE.  RATHER, WRITES ONE     DTSCS76
00067 *        OR MORE RECORDS TO THE ON-LINE ACTIVITY FILE.            DTSCS76
00068 *                                                                 DTSCS76
00069 *        OPERATION SHOULD BE SIMILAR TO 'ADD' FUNCTION ON         DTSCS76
00070 *        OTHER SCREENS (F09, CONFIRM OR CANCEL).                  DTSCS76
00071 *                                                                 DTSCS76
00072 *        ELECTRONIC FILER(MELF) REMOVED ZL1.                      DTSCS76
00073 *    RECORDS READ:                                                DTSCS76
00074 *                                                                 DTSCS76
00075 *      MASTER:                                                    DTSCS76
00076 *                                                                 DTSCS76
00077 *        MPRF                                                     DTSCS76
00078 *        MSOL                                                     DTSCS76
00079 *        MRTE                                                     DTSCS76
00080 *        MQTR                                                     DTSCS76
00081 *        MRPT                                                     DTSCS76
00082 *                                                                 DTSCS76
00083 *                                                                 DTSCS76
00084 *                                                                 DTSCS76
00085 *      ALTERNATE INDEX:                                           DTSCS76
00086 *                                                                 DTSCS76
00087 *        NONE.                                                    DTSCS76
00088 *                                                                 DTSCS76
00089 *                                                                 DTSCS76
00090 *      REFERENCE:                                                 DTSCS76
00091 *                                                                 DTSCS76
00092 *        NONE.                                                    DTSCS76
00093 *                                                                 DTSCS76
00094 *                                                                 DTSCS76
00095 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS76
00096 *                                                                 DTSCS76
00097 *        NONE.                                                    DTSCS76
00098 *                                                                 DTSCS76
00099 *                                                                 DTSCS76
00100 *    RECORDS UPDATED:                                             DTSCS76
00101 *                                                                 DTSCS76
00102 *      MASTER:                                                    DTSCS76
00103 *                                                                 DTSCS76
00104 *        NONE.                                                    DTSCS76
00105 *                                                                 DTSCS76
00106 *                                                                 DTSCS76
00107 *      REFERENCE:                                                 DTSCS76
00108 *                                                                 DTSCS76
00109 *        NONE.                                                    DTSCS76
00110 *                                                                 DTSCS76
00111 *                                                                 DTSCS76
00112 *      ACCOUNTING TRANSACTION COLLECTION:                         DTSCS76
00113 *                                                                 DTSCS76
00114 *        NONE.                                                    DTSCS76
00115 *                                                                 DTSCS76
00116 *                                                                 DTSCS76
00117 *    ON-LINE ACTIVITY FILE RECORDS WRITTEN:                       DTSCS76
00118 *                                                                 DTSCS76
00119 *      IF MAP-LABEL-CNT NOT = 0                                   DTSCS76
00120 *                                                                 DTSCS76
00121 *          WRITE A MACIR901 RECORD (R901-ON-REQUEST-88).          DTSCS76
00122 *                                                                 DTSCS76
00123 *                                                                 DTSCS76
00124 *      IF MAP-ELF-LABEL-IND = 'Y' AND MAP-ELF-LABEL-CNT NOT = 0   DTSCS76
00125 *                                                                 DTSCS76
00126 *          WRITE A MACIR901 RECORD (R901-ON-REQUEST-88).          DTSCS76
00127 *                                                                 DTSCS76
00128 *     NOTE:  USERS MUST BE ABLE TO REQUEST MAILING LABELS AND     DTSCS76
00129 *            ELECTRONIC FILER (ELF) MAILING LABELS FOR A GIVEN    DTSCS76
00130 *            EMPLOYER.  WRITE TWO MACIR901 RECORDS IN SUCH CASES. DTSCS76
00131 *                                                                 DTSCS76
00132 *                                                                 DTSCS76
00133 *      IF MAP-START-RPT-YRQ NOT = SPACES OR LOW-VALUES            DTSCS76
00134 *                                                                 DTSCS76
00135 *          WRITE A MACIT036 RECORD WITH T036-TRN-CD = '02'        DTSCS76
00136 *            AND T036-FORCE-PRINT-IND EQUAL TO MAP-FORCE-PRINT    DTSCS76
00137 *            -IND.  THE T036-WAIVE-* FIELDS SHOULD BE ZEROS.      DTSCS76
00138 *            T036-ADDR-TYPE AND T036-ADDR-NO SHOULD BE TAKEN      DTSCS76
00139 *            FROM MAP-ADDR-TYPE AND MAP-ADDR-NO.                  DTSCS76
00140 *                                                                 DTSCS76
00141 *          THE EDITS IN HERE SHOULD BE SIMILAR TO VERMONT.        DTSCS76
00142 *          MAY USE IN INFAMOUS DTSCU381 TO VERIFY LIABILITY       DTSCS76
00143 *          AND THE EXISTENCE OF A RATE.  IF MAP-FORCE-IND         DTSCS76
00144 *          IS EQUAL TO 'N', WILL NEED TO READ THE MQTR            DTSCS76
00145 *          RECORDS AND IF MQTR RECORD EXISTS AND MQTR-CURR        DTSCS76
00146 *          RCVD-88, DISPLAY E763.                                 DTSCS76
00147 *                                                                 DTSCS76
00148 *                                                                 DTSCS76
00149 *      IF MAP-5E-START-RPT-YRQ NOT = SPACES OR LOW-VALUES         DTSCS76
00150 *                                                                 DTSCS76
00151 *          WRITE A MACIT036 RECORD WITH T036-TRN-CD = '02'        DTSCS76
00152 *            AND T036-FORCE-PRINT-IND EQUAL TO MAP-5E-FORCE-PRINT DTSCS76
00153 *            -IND.  THE T036-WAIVE-* FIELDS SHOULD BE ZEROS.      DTSCS76
00154 *            T036-ADDR-TYPE AND T036-ADDR-NO SHOULD BE TAKEN      DTSCS76
00155 *            FROM MAP-ADDR-TYPE AND MAP-ADDR-NO.                  DTSCS76
00156 *                                                                 DTSCS76
00157 *          USE THE SAME EDITS AS FOR THE REGULAR UI-5'S ABOVE.    DTSCS76
00158 *          VERIFY LIABILITY AND THE EXISTENCE OF A RATE.  IF      DTSCS76
00159 *          MAP-5E-FORCE-IND IS EQUAL TO 'N', WILL NEED TO READ    DTSCS76
00160 *          THE MQTR RECORDS AND IF MQTR RECORD EXISTS AND MQTR-   DTSCS76
00161 *          CURR-RCVD-88, DISPLAY E769.                            DTSCS76
00162 *                                                                 DTSCS76
00163 *     NOTE:  USERS MUST BE ABLE TO REQUEST BOTH UI-5(S) AND       DTSCS76
00164 *            UI-5E(S) AS LONG AS THE QUARTER RANGES DO NOT OVER-  DTSCS76
00165 *            LAP.  WRITE TWO T036 RECORDS IN SUCH CASES, SETTING  DTSCS76
00166 *            T036-UI-5E-REQ APPROPRIATELY.                        DTSCS76
00167 *                                                                 DTSCS76
00168 *                                                                 DTSCS76
00169 *      IF MAP-NOTICE-OF-COVERAGE-CNT NOT = 0                      DTSCS76
00170 *                                                                 DTSCS76
00171 *          WRITE MAP-NOTICE-OF-COVERAGE-CNT MACIR111 RECORDS.     DTSCS76
00172 *                                                                 DTSCS76
00173 *                                                                 DTSCS76
00174 *      IF MAP-NOTICE-OF-SUBJECT-IND = 'Y'                         DTSCS76
00175 *                                                                 DTSCS76
00176 *          WRITE A MACIR112 RECORD FOR THE LAST MSOL RECORD       DTSCS76
00177 *          ASSOCIATED WITH THE EMPLOYER.  SEE MACBD311 FOR        DTSCS76
00178 *          SAMPLE MACIR112 GENERATING CODE.                       DTSCS76
00179 *                                                                 DTSCS76
00180 *                                                                 DTSCS76
00181 *      IF MAP-REQUEST-FOR-FEIN-IND = 'Y'                          DTSCS76
00182 *                                                                 DTSCS76
00183 *          WRITE A MACIR903 RECORD.                               DTSCS76
00184 *                                                                 DTSCS76
00185 *                                                                 DTSCS76
00186 *      IF MAP-AR-AUDIT-TRAIL-IND = 'Y'                            DTSCS76
00187 *                                                                 DTSCS76
00188 *          SCAN MQTR RECORDS.  FOR EACH MQTR RECORD:              DTSCS76
00189 *                                                                 DTSCS76
00190 *          IF THE MQTR RECORD HAS ONE OR MORE                     DTSCS76
00191 *              MQTR-BALANCE-AMT (N) OCCURRENCE GREATER THAN       DTSCS76
00192 *              ZERO                                               DTSCS76
00193 *                                                                 DTSCS76
00194 *                SCAN THE MRPT RECORDS ASSOCIATED WITH THE        DTSCS76
00195 *                QUARTER (THOSE MRPT RECORDS WITH MRPT-YRQ        DTSCS76
00196 *                EQUAL TO MQTR-YRQ) AND FOR EACH SUCH MRPT        DTSCS76
00197 *                RECORD ENCOUNTERED WRITE AN R432 RECORD.         DTSCS76
00198 *                                                                 DTSCS76
00199 *                                                                 DTSCS76
00200 *      IF MAP-COMBINE-IND = 'Y'                                   DTSCS76
00201 *                                                                 DTSCS76
00202 *          WRITE A DTSIR733 RECORD.                               DTSCS76
00203 *                                                                 DTSCS76
00204 *                                                                 DTSCS76
00205 *    TEMPORARY STORAGE USAGE:                                     DTSCS76
00206 *                                                                 DTSCS76
00207 *      NONE.                                                      DTSCS76
00208 *                                                                 DTSCS76
00209 *                                                                 DTSCS76
00210 *    MODULES LINKED TO:                                           DTSCS76
00211 *                                                                 DTSCS76
00212 *      DTSCU004  QUARTER EDIT/CONVERSION.                         DTSCS76
00213 *      DTSCU013  COUNT FROM SCREEN (INTEGER) FORMAT/EDIT.         DTSCS76
00214 *      DTSCU016  QUARTER/YEAR FROM SCREEN FORMAT/EDIT.            DTSCS76
00215 *      DTSCU018  EMP NO FROM SCREEN FORMAT/EDIT.                  DTSCS76
00216 *      DTSCU082  OPERATOR ID EDIT/LOOKUP.                         DTSCS76
00217 *      DTSCU111  ADDRESS LOOKUP.                                  DTSCS76
00218 *      DTSCU112  FORMAT ADDRESS FOR MAILING.                      DTSCS76
00219 *      DTSCU381  FIND LIABILITY AND RATE FOR A QUARTER.           DTSCS76
00220 *      DTSCU810  MASTER FILE INPUT/OUTPUT.                        DTSCS76
00221 *      DTSCU825  ON-LINE ACTIVITY FILE OUTPUT.                    DTSCS76
00222 *                                                                 DTSCS76
00223 *****                                                             DTSCS76
00224                                                                   DTSCS76
00225  ENVIRONMENT DIVISION.                                            DTSCS76
00226                                                                   DTSCS76
00227  DATA DIVISION.                                                   DTSCS76
00228                                                                   DTSCS76
00229  WORKING-STORAGE SECTION.                                         DTSCS76
002295 77  PAN-VALET PICTURE X(24) VALUE '001DTSCS76   05/07/25'.       DTSCS76
00230  77  PAN-VALET PICTURE X(24) VALUE '056DTSCS76   09/14/05'.       DTSCS76
00231                                                                   DTSCS76
00232  01  SW-AREA.                                                     DTSCS76
00233      05  WRK-ABEND-CD                PIC  X(04)  VALUE 'S76 '.    DTSCS76
00234                                                                   DTSCS76
00235      05  WRK-SCR-ID.                                              DTSCS76
00236          10  WRK-SCR-ID-N            PIC  9(02)  VALUE 76.        DTSCS76
00237                                                                   DTSCS76
00238      05  WRK-F03-SCR-ID              PIC  X(02)  VALUE '70'.      DTSCS76
00239                                                                   DTSCS76
00240      05  SCR-ACCESS-IND              PIC X(01).                   DTSCS76
00241          88  SCR-ACCESS-INQ                  VALUE '1'.           DTSCS76
00242          88  SCR-ACCESS-UPDATE               VALUE '2'.           DTSCS76
00243                                                                   DTSCS76
00244      05  CURSOR-SET-IND              PIC X(01).                   DTSCS76
00245          88  CURSOR-SET-YES                  VALUE 'Y'.           DTSCS76
00246          88  CURSOR-SET-NO                   VALUE 'N'.           DTSCS76
00247          88  CURSOR-SET-GOTO                 VALUE 'G'.           DTSCS76
00248                                                                   DTSCS76
00249      05  REQ-IND                     PIC X(01).                   DTSCS76
00250          88  REQ-CURSOR-TO-GOTO              VALUE 'G'.           DTSCS76
00251          88  REQ-ERROR                       VALUE 'O'.           DTSCS76
00252          88  REQ-JUMP                        VALUE 'J'.           DTSCS76
00253          88  REQ-UPDATE                      VALUE 'U'.           DTSCS76
00254          88  REQ-INQUIRE                     VALUE 'I'.           DTSCS76
00255          88  REQ-CLEAR                       VALUE 'C'.           DTSCS76
00256          88  REQ-EDIT                        VALUE 'E'.           DTSCS76
00257                                                                   DTSCS76
00258      05  RESP-IND                    PIC X(01).                   DTSCS76
00259          88  RESP-SEND-MSGONLY               VALUE 'O'.           DTSCS76
00260          88  RESP-SEND-MAP                   VALUE 'M'.           DTSCS76
00261          88  RESP-JUMP                       VALUE 'J'.           DTSCS76
00262          88  RESP-CURSOR-TO-GOTO             VALUE 'G'.           DTSCS76
00263                                                                   DTSCS76
00264      05  WRK-MSG-AREA                PIC  X(64).                  DTSCS76
00265                                                                   DTSCS76
00266      05  WRK-ATB-AN                  PIC  X(01).                  DTSCS76
00267                                                                   DTSCS76
00268      05  WRK-ATB-NUM                 PIC  X(01).                  DTSCS76
00269                                                                   DTSCS76
00270      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSCS76
00271                                                                   DTSCS76
00272 *****05  WRK-5E-REQ-IND              PIC  X(01).                  DTSCS76
00273 *********88  WRK-5E-REQ-YES-88              VALUE 'Y'.            DTSCS76
00274 *********88  WRK-5E-REQ-NO-88               VALUE 'N'.            DTSCS76
00275                                                                   DTSCS76
00276      05  WRK-FROM-YRQ                PIC S9(05)  COMP-3.          DTSCS76
00277      05  WRK-TO-YRQ                  PIC S9(05)  COMP-3.          DTSCS76
00278                                                                   DTSCS76
00279      05  WRK-STMT-FROM-YRQ           PIC S9(05)  COMP-3.          DTSCS76
00280      05  WRK-STMT-TO-YRQ             PIC S9(05)  COMP-3.          DTSCS76
00281                                                                   DTSCS76
00282                                                                   DTSCS76
00283                                                                   DTSCS76
00284      05  WRK-R751-IND                PIC X(01).                   DTSCS76
00285          88  WRK-R751-YES-88              VALUE 'Y'.              DTSCS76
00286          88  WRK-R751-NO-88               VALUE 'N'.              DTSCS76
00287                                                                   DTSCS76
00288      05  WRK-WAIVE-EXT-DATE          PIC S9(09)  COMP-3.          DTSCS76
00289                                                                   DTSCS76
00290 *****05  WRK-5E-WAIVE-EXT-DATE       PIC S9(09)  COMP-3.          DTSCS76
00291                                                                   DTSCS76
00292      05  WRK-MPRF-IND                PIC  X(01).                  DTSCS76
00293          88  WRK-MPRF-NONE-88               VALUE ' '.            DTSCS76
00294          88  WRK-MPRF-YES-88                VALUE 'Y'.            DTSCS76
00295          88  WRK-MPRF-NO-88                 VALUE 'N'.            DTSCS76
00296                                                                   DTSCS76
00297      05  WRK-ANN-LIABLE-IND          PIC  X(01).                  DTSCS76
00298          88  WRK-ANN-LIABLE-YES-88          VALUE 'Y'.            DTSCS76
00299          88  WRK-ANN-LIABLE-NO-88           VALUE 'N'.            DTSCS76
00300                                                                   DTSCS76
00301      05  WRK-ANN-FILER-IND           PIC  X(01).                  DTSCS76
00302          88  WRK-ANN-FILER-YES-88           VALUE 'Y'.            DTSCS76
00303          88  WRK-ANN-FILER-NO-88            VALUE 'N'.            DTSCS76
00304                                                                   DTSCS76
00305 *****05  WRK-MELF-IND                PIC  X(01).                  DTSCS76
00306 *********88  WRK-MELF-NONE-88               VALUE ' '.            DTSCS76
00307 *********88  WRK-MELF-YES-88                VALUE 'Y'.            DTSCS76
00308 *********88  WRK-MELF-NO-88                 VALUE 'N'.            DTSCS76
00309                                                                   DTSCS76
00310      05  WRK-MAILING-ADDRESS-AREA.                                DTSCS76
00311          10  WRK-MAILING-ADDRESS.                                 DTSCS76
00312              15  FILLER   OCCURS 5       PIC  X(40).              DTSCS76
00313          10  WRK-ZIP                     PIC  X(10).              DTSCS76
00314 *********10  WRK-DELIV-POINT             PIC  X(02).              DTSCS76
00315 *********10  WRK-CHECK-DIGIT             PIC  X(01).              DTSCS76
00316          10  WRK-ADVANCED-BARCODE        PIC  X(14).              DTSCS76
00317                                                                   DTSCS76
00318 *****05  WRK-ELF-ADDRESS-AREA.                                    DTSCS76
00319 *********10  WRK-ELF-ADDRESS.                                     DTSCS76
00320 *************15  FILLER   OCCURS 5       PIC  X(40).              DTSCS76
00321 *********10  WRK-ELF-ZIP                 PIC  X(10).              DTSCS76
00322 *********10  WRK-ELF-DELIV-POINT         PIC  X(02).              DTSCS76
00323 *********10  WRK-ELF-CHECK-DIGIT         PIC  X(01).              DTSCS76
00324                                                                   DTSCS76
00325                                                                   DTSCS76
00326                                                                   DTSCS76
00327      05  WRK-DISPLAY                 PIC 9(11).                   DTSCS76
00328                                                                   DTSCS76
00329      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS76
00330          10  FILLER                  PIC X(05).                   DTSCS76
00331          10  WRK-DISPLAY-EMP-NO-1    PIC X(03).                   DTSCS76
00332          10  WRK-DISPLAY-EMP-NO-2    PIC X(03).                   DTSCS76
00333                                                                   DTSCS76
00334      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS76
00335          10  FILLER                  PIC X(05).                   DTSCS76
00336          10  WRK-DISPLAY-YR          PIC X(02).                   DTSCS76
00337          10  WRK-DISPLAY-MO          PIC X(02).                   DTSCS76
00338          10  WRK-DISPLAY-DA          PIC X(02).                   DTSCS76
00339                                                                   DTSCS76
00340      05  FILLER REDEFINES WRK-DISPLAY.                            DTSCS76
00341          10  FILLER                 PIC X(06).                    DTSCS76
00342          10  WRK-DISPLAY-YRQ        PIC X(05).                    DTSCS76
00343          10  FILLER REDEFINES WRK-DISPLAY-YRQ.                    DTSCS76
00344              15  FILLER PIC XX.                                   DTSCS76
00345              15  WRK-DISPLAY-YRQ-Y  PIC 99.                       DTSCS76
00346              15  WRK-DISPLAY-YRQ-Q  PIC 9.                        DTSCS76
00347                                                                   DTSCS76
00348                                                                   DTSCS76
00349      05  WRK-RATE-CTR                PIC S9(04)        COMP.      DTSCS76
00350                                                                   DTSCS76
00351 *****05  WRK-OCC                     PIC S9(04)        COMP.      DTSCS76
00352                                                                   DTSCS76
00353      05  BALANCE-DUE-IND             PIC  X(01).                  DTSCS76
00354      EJECT                                                        DTSCS76
00355  01  MSG-LITERALS.                                                DTSCS76
00356      05  MSG-E761-AREA.                                           DTSCS76
00357          10  FILLER                  PIC  X(04)  VALUE 'E761'.    DTSCS76
00358          10  FILLER                  PIC  X(13)                   DTSCS76
00359                VALUE 'THE RATE FOR '.                             DTSCS76
00360          10  MSG-E761-SLASH-QTR      PIC  X(04).                  DTSCS76
00361          10  FILLER                  PIC  X(15)                   DTSCS76
00362                VALUE ' IS NOT ON FILE'.                           DTSCS76
00363                                                                   DTSCS76
00364      05  MSG-E762-AREA.                                           DTSCS76
00365          10  FILLER                  PIC  X(04)  VALUE 'E762'.    DTSCS76
00366          10  FILLER                  PIC  X(30)                   DTSCS76
00367                VALUE 'NO BALANCE DUE                '.            DTSCS76
00368          10  FILLER                  PIC  X(30)                   DTSCS76
00369                VALUE '                              '.            DTSCS76
00370                                                                   DTSCS76
00371      05  MSG-E763-AREA.                                           DTSCS76
00372          10  FILLER                  PIC  X(04)  VALUE 'E763'.    DTSCS76
00373          10  FILLER                  PIC  X(30)                   DTSCS76
00374                VALUE 'EMPLOYER REPORT IS ON FILE. FO'.            DTSCS76
00375          10  FILLER                  PIC  X(30)                   DTSCS76
00376                VALUE 'RCE PRINT?                    '.            DTSCS76
00377                                                                   DTSCS76
00378      05  MSG-E764-AREA.                                           DTSCS76
00379          10  FILLER                  PIC  X(04)  VALUE 'E764'.    DTSCS76
00380          10  FILLER                  PIC  X(30)                   DTSCS76
00381                VALUE 'NOTHING TO DO                 '.            DTSCS76
00382          10  FILLER                  PIC  X(30)                   DTSCS76
00383                VALUE '                              '.            DTSCS76
00384                                                                   DTSCS76
00385      05  MSG-E765-AREA.                                           DTSCS76
00386          10  FILLER                  PIC  X(04)  VALUE 'E765'.    DTSCS76
00387          10  FILLER                  PIC  X(30)                   DTSCS76
00388                VALUE 'EMPLOYER IS NOT SUBJECT       '.            DTSCS76
00389          10  FILLER                  PIC  X(30)                   DTSCS76
00390                VALUE '                              '.            DTSCS76
00391                                                                   DTSCS76
00392      05  MSG-E766-AREA.                                           DTSCS76
00393          10  FILLER                  PIC  X(04)  VALUE 'E766'.    DTSCS76
00394          10  FILLER                  PIC  X(26)                   DTSCS76
00395                VALUE 'EMPLOYER IS NOT LIABLE IN '.                DTSCS76
00396          10  MSG-E766-SLASH-QTR      PIC  X(04).                  DTSCS76
00397                                                                   DTSCS76
00398 *****05  MSG-E767-AREA.                                           DTSCS76
00399 *********10  FILLER                  PIC  X(04)  VALUE 'E767'.    DTSCS76
00400 *********10  FILLER                  PIC  X(30)                   DTSCS76
00401 ***************VALUE 'EMPLOYER IS NOT ACTIVE        '.            DTSCS76
00402 *********10  FILLER                  PIC  X(30)                   DTSCS76
00403 ***************VALUE '                              '.            DTSCS76
00404                                                                   DTSCS76
00405      05  MSG-E768-AREA.                                           DTSCS76
00406          10  FILLER                  PIC  X(04)  VALUE 'E768'.    DTSCS76
00407          10  FILLER                  PIC  X(30)                   DTSCS76
00408                VALUE 'EMPLOYER IS CHARGING ONLY     '.            DTSCS76
00409          10  FILLER                  PIC  X(30)                   DTSCS76
00410                VALUE '                              '.            DTSCS76
00411                                                                   DTSCS76
00412 *****05  MSG-E769-AREA.                                           DTSCS76
00413 *********10  FILLER                  PIC  X(04)  VALUE 'E769'.    DTSCS76
00414 *********10  FILLER                  PIC  X(30)                   DTSCS76
00415 ***************VALUE 'REPORT EXISTS.  FORCE PRINT? C'.            DTSCS76
00416 *********10  FILLER                  PIC  X(30)                   DTSCS76
00417 ***************VALUE 'ONSIDER UI-5 OR UI-5G.        '.            DTSCS76
00418                                                                   DTSCS76
00419 *****05  MSG-E76A-AREA.                                           DTSCS76
00420 *********10  FILLER                  PIC  X(04)  VALUE 'E76A'.    DTSCS76
00421 *********10  FILLER                  PIC  X(30)                   DTSCS76
00422 ***************VALUE 'EMPLOYER IS NOT AN ELECTRONIC '.            DTSCS76
00423 *********10  FILLER                  PIC  X(30)                   DTSCS76
00424 ***************VALUE 'FILER.                        '.            DTSCS76
00425                                                                   DTSCS76
00426 *****05  MSG-E76B-AREA.                                           DTSCS76
00427 *********10  FILLER                  PIC  X(04)  VALUE 'E76B'.    DTSCS76
00428 *********10  FILLER                  PIC  X(30)                   DTSCS76
00429 ***************VALUE 'EMPLOYER IS NOT AN ELECTRONIC '.            DTSCS76
00430 *********10  FILLER                  PIC  X(30)                   DTSCS76
00431 ***************VALUE 'FILER FOR TAX REPORTS.        '.            DTSCS76
00432                                                                   DTSCS76
00433 *****05  MSG-E76C-AREA.                                           DTSCS76
00434 *********10  FILLER                  PIC  X(04)  VALUE 'E76C'.    DTSCS76
00435 *********10  FILLER                  PIC  X(30)                   DTSCS76
00436 ***************VALUE 'ELF? MUST = Y FOR NUMBER OF LA'.            DTSCS76
00437 *********10  FILLER                  PIC  X(30)                   DTSCS76
00438 ***************VALUE 'BELS TO BE ENTERED.           '.            DTSCS76
00439                                                                   DTSCS76
00440 *****05  MSG-E76D-AREA.                                           DTSCS76
00441 *********10  FILLER                  PIC  X(04)  VALUE 'E76D'.    DTSCS76
00442 *********10  FILLER                  PIC  X(30)                   DTSCS76
00443 ***************VALUE 'UI-5E QUARTER RANGE OVERLAPS U'.            DTSCS76
00444 *********10  FILLER                  PIC  X(30)                   DTSCS76
00445 ***************VALUE 'I-5 QUARTER RANGE.            '.            DTSCS76
00446                                                                   DTSCS76
00447 *****05  MSG-E76E-AREA.                                           DTSCS76
00448 *********10  FILLER                  PIC  X(04)  VALUE 'E76E'.    DTSCS76
00449 *********10  FILLER                  PIC  X(30)                   DTSCS76
00450 ***************VALUE 'ELF ADDRESS NOT DELIVERABLE.  '.            DTSCS76
00451 *********10  FILLER                  PIC  X(30)                   DTSCS76
00452 ***************VALUE '                              '.            DTSCS76
00453                                                                   DTSCS76
00454      05  MSG-E76F-AREA.                                           DTSCS76
00455          10  FILLER                  PIC  X(04)  VALUE 'E76F'.    DTSCS76
00456          10  FILLER                  PIC  X(30)                   DTSCS76
00457                VALUE 'ANNUAL UC30H REQUESTED. QUARTE'.            DTSCS76
00458          10  FILLER                  PIC  X(30)                   DTSCS76
00459                VALUE 'R RANGE MUST BE 1 THROUGH 4.  '.            DTSCS76
00460                                                                   DTSCS76
00461      05  MSG-E76G-AREA.                                           DTSCS76
00462          10  FILLER                  PIC  X(04)  VALUE 'E76F'.    DTSCS76
00463          10  FILLER                  PIC  X(30)                   DTSCS76
00464                VALUE 'SSN NOT IN CLAIMANT FILE; RE-E'.            DTSCS76
00465          10  FILLER                  PIC  X(30)                   DTSCS76
00466                VALUE 'NTER.                         '.            DTSCS76
00467                                                                   DTSCS76
00468      05  MSG-E76H-AREA.                                           DTSCS76
00469          10  FILLER                  PIC  X(04)  VALUE 'E76H'.    DTSCS76
00470          10  FILLER                  PIC  X(30)                   DTSCS76
00471                VALUE 'MASS MAILING HAS NOT OCCURED F'.            DTSCS76
00472          10  FILLER                  PIC  X(30)                   DTSCS76
00473                VALUE 'OR QUARTER. FORCE PRINT?      '.            DTSCS76
00474                                                                   DTSCS76
00475      EJECT                                                        DTSCS76
00476  01  L001-COMM-AREA.                                              DTSCS76
00477  ++INCLUDE DTSIL001                                               DTSCS76
00478      EJECT                                                        DTSCS76
00479  01  L004-COMM-AREA.                                              DTSCS76
00480  ++INCLUDE DTSIL004                                               DTSCS76
00481      EJECT                                                        DTSCS76
00482  01  L006-COMM-AREA.                                              DTSCS76
00483  ++INCLUDE DTSIL006                                               DTSCS76
00484      EJECT                                                        DTSCS76
00485  01  L013-COMM-AREA.                                              DTSCS76
00486  ++INCLUDE DTSIL013                                               DTSCS76
00487      EJECT                                                        DTSCS76
00488  01  L015-COMM-AREA.                                              DTSCS76
00489  ++INCLUDE DTSIL015                                               DTSCS76
00490      EJECT                                                        DTSCS76
00491  01  L016-COMM-AREA.                                              DTSCS76
00492  ++INCLUDE DTSIL016                                               DTSCS76
00493      EJECT                                                        DTSCS76
00494  01  L018-COMM-AREA.                                              DTSCS76
00495  ++INCLUDE DTSIL018                                               DTSCS76
00496      EJECT                                                        DTSCS76
00497  01  L020-COMM-AREA.                                              DTSCS76
00498  ++INCLUDE DTSIL020                                               DTSCS76
00499      EJECT                                                        DTSCS76
00500  01  L081-COMM-AREA.                                              DTSCS76
00501  ++INCLUDE DTSIL081                                               DTSCS76
00502      EJECT                                                        DTSCS76
00503  01  L082-COMM-AREA.                                              DTSCS76
00504  ++INCLUDE DTSIL082                                               DTSCS76
00505      EJECT                                                        DTSCS76
00506  01  L111-COMM-AREA.                                              DTSCS76
00507  ++INCLUDE DTSIL111                                               DTSCS76
00508      EJECT                                                        DTSCS76
00509  01  L112-COMM-AREA.                                              DTSCS76
00510  ++INCLUDE DTSIL112                                               DTSCS76
00511      EJECT                                                        DTSCS76
00512  01  L381-COMM-AREA.                                              DTSCS76
00513  ++INCLUDE DTSIL381                                               DTSCS76
00514      EJECT                                                        DTSCS76
00515  01  L410-COMM-AREA.                                              DTSCS76
00516  ++INCLUDE DTSIL410                                               DTSCS76
00517      EJECT                                                        DTSCS76
00518  01  L415-COMM-AREA.                                              DTSCS76
00519  ++INCLUDE DTSIL415                                               DTSCS76
00520      EJECT                                                        DTSCS76
00521  01  L805-COMM-AREA.                                              DTSCS76
00522  ++INCLUDE DTSIL805                                               DTSCS76
00523      EJECT                                                        DTSCS76
00524  01  L810-COMM-AREA.                                              DTSCS76
00525      05  L810-CONTROL-BLOCK.                                      DTSCS76
00526  ++INCLUDE DTSIL810                                               DTSCS76
00527      EJECT                                                        DTSCS76
00528      05  MSKL-REC.                                                DTSCS76
00529  ++INCLUDE DTSIMSKL                                               DTSCS76
00530      EJECT                                                        DTSCS76
00531  01  MPRF-REC.                                                    DTSCS76
00532  ++INCLUDE DTSIMPRF                                               DTSCS76
00533      EJECT                                                        DTSCS76
00534  01  MRTE-REC.                                                    DTSCS76
00535  ++INCLUDE DTSIMRTE                                               DTSCS76
00536      EJECT                                                        DTSCS76
00537  01  MSOL-REC.                                                    DTSCS76
00538  ++INCLUDE DTSIMSOL                                               DTSCS76
00539      EJECT                                                        DTSCS76
00540  01  MQTR-REC.                                                    DTSCS76
00541  ++INCLUDE DTSIMQTR                                               DTSCS76
00542      EJECT                                                        DTSCS76
00543  01  MRPT-REC.                                                    DTSCS76
00544  ++INCLUDE DTSIMRPT                                               DTSCS76
00545      EJECT                                                        DTSCS76
00546  01  MOPO-REC.                                                    DTSCS76
00547  ++INCLUDE DTSIMOPO                                               DTSCS76
00548      EJECT                                                        DTSCS76
00549  01  MTAA-REC.                                                    DTSCS76
00550  ++INCLUDE DTSIMTAA                                               DTSCS76
00551      EJECT                                                        DTSCS76
00552 *01  MELF-REC.                                                    DTSCS76
00553 ***INCLUDE DTSIMELF                                               DTSCS76
00554      EJECT                                                        DTSCS76
00555  01  L851-COMM-AREA.                                              DTSCS76
00556  ++INCLUDE DTSIL851                                               DTSCS76
00557                                                                   DTSCS76
00558      05  MAP-AREA REDEFINES L851-MAP-AREA.                        DTSCS76
00559  ++INCLUDE DTSIS76                                                DTSCS76
00560      EJECT                                                        DTSCS76
00561  01  L825-COMM-AREA.                                              DTSCS76
00562      05  L825-CONTROL-BLOCK.                                      DTSCS76
00563  ++INCLUDE DTSIL825                                               DTSCS76
00564                                                                   DTSCS76
00565      05  RSKL-REC.                                                DTSCS76
00566  ++INCLUDE DTSIRSK1                                               DTSCS76
00567      EJECT                                                        DTSCS76
00568 *01  R111-REC.                                                    DTSCS76
00569 ***INCLUDE DTSIR111                                               DTSCS76
00570      EJECT                                                        DTSCS76
00571  01  R112-REC.                                                    DTSCS76
00572  ++INCLUDE DTSIR112                                               DTSCS76
00573      EJECT                                                        DTSCS76
00574  01  R432-REC.                                                    DTSCS76
00575  ++INCLUDE DTSIR432                                               DTSCS76
00576      EJECT                                                        DTSCS76
00577  01  R733-REC.                                                    DTSCS76
00578  ++INCLUDE DTSIR733                                               DTSCS76
00579      EJECT                                                        DTSCS76
00580  01  R751-REC.                                                    DTSCS76
00581  ++INCLUDE DTSIR751                                               DTSCS76
00582      EJECT                                                        DTSCS76
00583  01  R901-REC.                                                    DTSCS76
00584  ++INCLUDE DTSIR901                                               DTSCS76
00585      EJECT                                                        DTSCS76
00586  01  R903-REC.                                                    DTSCS76
00587  ++INCLUDE DTSIR903                                               DTSCS76
00588      EJECT                                                        DTSCS76
00589  01  T011-REC.                                                    DTSCS76
00590  ++INCLUDE DTSIT011                                               DTSCS76
00591      EJECT                                                        DTSCS76
00592  01  T031-REC.                                                    DTSCS76
00593  ++INCLUDE DTSIT031                                               DTSCS76
00594      EJECT                                                        DTSCS76
00595  01  T036-REC.                                                    DTSCS76
00596  ++INCLUDE DTSIT036                                               DTSCS76
00597      EJECT                                                        DTSCS76
00598  01  CATB-LITERALS.                                               DTSCS76
00599  ++INCLUDE DTSICATB                                               DTSCS76
00600                                                                   DTSCS76
00601                                                                   DTSCS76
00602                                                                   DTSCS76
00603  01  CFKD-LITERALS.                                               DTSCS76
00604  ++INCLUDE DTSICFKD                                               DTSCS76
00605                                                                   DTSCS76
00606                                                                   DTSCS76
00607                                                                   DTSCS76
00608  01  CECD-LITERALS.                                               DTSCS76
00609  ++INCLUDE DTSICECD                                               DTSCS76
00610                                                                   DTSCS76
00611                                                                   DTSCS76
00612                                                                   DTSCS76
00613  01  CPCD-LITERALS.                                               DTSCS76
00614  ++INCLUDE DTSICPCD                                               DTSCS76
00615      EJECT                                                        DTSCS76
00616  LINKAGE SECTION.                                                 DTSCS76
00617                                                                   DTSCS76
00618  01  DFHCOMMAREA.                                                 DTSCS76
00619  ++INCLUDE DTSILCCM                                               DTSCS76
00620      EJECT                                                        DTSCS76
00621  PROCEDURE DIVISION.                                              DTSCS76
00622                                                                   DTSCS76
00623      MOVE +0 TO WRK-EMP-NO.                                       DTSCS76
00624                                                                   DTSCS76
00625      SET WRK-MPRF-NONE-88 TO TRUE.                                DTSCS76
00626 ***  SET WRK-R751-NO-88 TO TRUE.                                  DTSCS76
00627                                                                   DTSCS76
00628      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS76
00629                                                                   DTSCS76
00630      SET CURSOR-SET-NO TO TRUE.                                   DTSCS76
00631                                                                   DTSCS76
00632      MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N)                  DTSCS76
00633        TO SCR-ACCESS-IND.                                         DTSCS76
00634                                                                   DTSCS76
00635                                                                   DTSCS76
00636      MOVE SPACE TO REQ-IND.                                       DTSCS76
00637                                                                   DTSCS76
00638      PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT.               DTSCS76
00639                                                                   DTSCS76
00640                                                                   DTSCS76
00641 *-----------------------------------------------------            DTSCS76
00642 *    P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE           DTSCS76
00643 *    "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT             DTSCS76
00644 *    REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE             DTSCS76
00645 *    OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED.         DTSCS76
00646 *                                                                 DTSCS76
00647 *    THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE                DTSCS76
00648 *    PROCESSED.                                                   DTSCS76
00649 *                                                                 DTSCS76
00650 *    THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND,         DTSCS76
00651 *    INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE            DTSCS76
00652 *    WORK STATION OPERATOR.                                       DTSCS76
00653 *-----------------------------------------------------            DTSCS76
00654                                                                   DTSCS76
00655      MOVE SPACE TO RESP-IND.                                      DTSCS76
00656                                                                   DTSCS76
00657      IF REQ-ERROR                                                 DTSCS76
00658         PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT               DTSCS76
00659      ELSE                                                         DTSCS76
00660      IF REQ-JUMP                                                  DTSCS76
00661         PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT                DTSCS76
00662      ELSE                                                         DTSCS76
00663      IF REQ-CLEAR                                                 DTSCS76
00664         PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT               DTSCS76
00665      ELSE                                                         DTSCS76
00666      IF REQ-CURSOR-TO-GOTO                                        DTSCS76
00667         PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT              DTSCS76
00668      ELSE                                                         DTSCS76
00669      IF REQ-INQUIRE                                               DTSCS76
00670         PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT             DTSCS76
00671      ELSE                                                         DTSCS76
00672      IF REQ-EDIT                                                  DTSCS76
00673         PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT                DTSCS76
00674      ELSE                                                         DTSCS76
00675      IF REQ-UPDATE                                                DTSCS76
00676         PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT              DTSCS76
00677      ELSE                                                         DTSCS76
00678         GO TO S899-ABEND.                                         DTSCS76
00679                                                                   DTSCS76
00680                                                                   DTSCS76
00681 *-----------------------------------------------------            DTSCS76
00682 *    THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED             DTSCS76
00683 *    IN RESP-IND THE TYPE OF RESPONSE TO BE MADE.                 DTSCS76
00684 *-----------------------------------------------------            DTSCS76
00685                                                                   DTSCS76
00686      IF RESP-SEND-MAP                                             DTSCS76
00687          PERFORM S9300-SEND-MAP THRU S9300-EXIT                   DTSCS76
00688          SET LCCM-END-TASK-88 TO TRUE                             DTSCS76
00689      ELSE                                                         DTSCS76
00690      IF RESP-SEND-MSGONLY                                         DTSCS76
00691          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS76
00692          SET LCCM-END-TASK-88 TO TRUE                             DTSCS76
00693      ELSE                                                         DTSCS76
00694      IF RESP-JUMP                                                 DTSCS76
00695          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
00696      ELSE                                                         DTSCS76
00697      IF RESP-CURSOR-TO-GOTO                                       DTSCS76
00698          PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT              DTSCS76
00699          SET LCCM-END-TASK-88 TO TRUE                             DTSCS76
00700      ELSE                                                         DTSCS76
00701          GO TO S899-ABEND.                                        DTSCS76
00702                                                                   DTSCS76
00703  MAINLINE-EXIT.                                                   DTSCS76
00704                                                                   DTSCS76
00705      EXEC CICS                                                    DTSCS76
00706          RETURN                                                   DTSCS76
00707      END-EXEC.                                                    DTSCS76
00708                                                                   DTSCS76
00709      GOBACK.                                                      DTSCS76
00710      EJECT                                                        DTSCS76
00711 /*****************************************************************DTSCS76
00712 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION         *DTSCS76
00713 ******************************************************************DTSCS76
00714                                                                   DTSCS76
00715  P1000-ANALYZE-REQUEST.                                           DTSCS76
00716                                                                   DTSCS76
00717                                                                   DTSCS76
00718 *-----------------------------------------------------            DTSCS76
00719 *     IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE)         DTSCS76
00720 *     THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE               DTSCS76
00721 *     REPLACED WITH ENTER)                                        DTSCS76
00722 *-----------------------------------------------------            DTSCS76
00723                                                                   DTSCS76
00724      IF LCCM-SCR-ID NOT = WRK-SCR-ID                              DTSCS76
00725         SET LCCM-ENTER-88 TO TRUE                                 DTSCS76
00726         SET REQ-INQUIRE TO TRUE                                   DTSCS76
00727         IF LCCM-EMP-NO > ZERO                                     DTSCS76
00728             MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                    DTSCS76
00729             MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                    DTSCS76
00730         END-IF                                                    DTSCS76
00731         GO TO P1000-EXIT.                                         DTSCS76
00732                                                                   DTSCS76
00733                                                                   DTSCS76
00734 *-----------------------------------------------------            DTSCS76
00735 *    RECEIVE THE MAP                                              DTSCS76
00736 *-----------------------------------------------------            DTSCS76
00737                                                                   DTSCS76
00738      PERFORM S9100-RECEIVE THRU S9100-EXIT.                       DTSCS76
00739                                                                   DTSCS76
00740                                                                   DTSCS76
00741 *-----------------------------------------------------            DTSCS76
00742 *    CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE            DTSCS76
00743 *    WORK STATION                                                 DTSCS76
00744 *-----------------------------------------------------            DTSCS76
00745                                                                   DTSCS76
00746      IF LCCM-CLEAR-88                                             DTSCS76
00747         SET REQ-CLEAR TO TRUE                                     DTSCS76
00748         GO TO P1000-EXIT.                                         DTSCS76
00749                                                                   DTSCS76
00750                                                                   DTSCS76
00751 *-----------------------------------------------------            DTSCS76
00752 *    IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED             DTSCS76
00753 *-----------------------------------------------------            DTSCS76
00754                                                                   DTSCS76
00755      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS76
00756         PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT               DTSCS76
00757         GO TO P1000-EXIT.                                         DTSCS76
00758                                                                   DTSCS76
00759                                                                   DTSCS76
00760 *-----------------------------------------------------            DTSCS76
00761 *    PA2 IS A REQUEST TO POSITION CURSOR AT GO TO:                DTSCS76
00762 *-----------------------------------------------------            DTSCS76
00763                                                                   DTSCS76
00764      IF LCCM-PA2-88                                               DTSCS76
00765          SET REQ-CURSOR-TO-GOTO TO TRUE                           DTSCS76
00766          GO TO P1000-EXIT.                                        DTSCS76
00767                                                                   DTSCS76
00768                                                                   DTSCS76
00769 *-----------------------------------------------------            DTSCS76
00770 *    ALL OTHER PA KEYS ARE NOT ACTIVE                             DTSCS76
00771 *-----------------------------------------------------            DTSCS76
00772                                                                   DTSCS76
00773      IF LCCM-PA-88                                                DTSCS76
00774        PERFORM S804-INVALID-KEY THRU S804-EXIT                    DTSCS76
00775        SET REQ-ERROR TO TRUE                                      DTSCS76
00776        GO TO P1000-EXIT.                                          DTSCS76
00777                                                                   DTSCS76
00778                                                                   DTSCS76
00779 *-----------------------------------------------------            DTSCS76
00780 *    IF F12 KEY IS PRESSED AND UPDATE NOT IN PROGRESS             DTSCS76
00781 *    CLEAR SCREEN                                                 DTSCS76
00782 *-----------------------------------------------------            DTSCS76
00783                                                                   DTSCS76
00784      IF LCCM-F12-88                                               DTSCS76
00785         MOVE LOW-VALUES TO MAP-AREA                               DTSCS76
00786         SET REQ-CLEAR TO TRUE                                     DTSCS76
00787         GO TO P1000-EXIT.                                         DTSCS76
00788                                                                   DTSCS76
00789                                                                   DTSCS76
00790 *-----------------------------------------------------            DTSCS76
00791 *    IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION            DTSCS76
00792 *-----------------------------------------------------            DTSCS76
00793                                                                   DTSCS76
00794      IF LCCM-F03-88                                               DTSCS76
00795         MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID                    DTSCS76
00796         SET REQ-JUMP TO TRUE                                      DTSCS76
00797         GO TO P1000-EXIT.                                         DTSCS76
00798                                                                   DTSCS76
00799                                                                   DTSCS76
00800 *-----------------------------------------------------            DTSCS76
00801 *    IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN         DTSCS76
00802 *-----------------------------------------------------            DTSCS76
00803                                                                   DTSCS76
00804      IF LCCM-F04-88                                               DTSCS76
00805         MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID                 DTSCS76
00806         SET REQ-JUMP TO TRUE                                      DTSCS76
00807         GO TO P1000-EXIT.                                         DTSCS76
00808                                                                   DTSCS76
00809                                                                   DTSCS76
00810 *-----------------------------------------------------            DTSCS76
00811 *    IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO                DTSCS76
00812 *    CORRESPONDENCE SCREEN                                        DTSCS76
00813 *-----------------------------------------------------            DTSCS76
00814                                                                   DTSCS76
00815      IF LCCM-F14-88                                               DTSCS76
00816         MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID                  DTSCS76
00817         SET REQ-JUMP TO TRUE                                      DTSCS76
00818         GO TO P1000-EXIT.                                         DTSCS76
00819                                                                   DTSCS76
00820                                                                   DTSCS76
00821 *-----------------------------------------------------            DTSCS76
00822 *    IF JUMP KEY PRESSED, JUMP TO THE REQUESTED SCREEN            DTSCS76
00823 *-----------------------------------------------------            DTSCS76
00824                                                                   DTSCS76
00825 *****IF LCCM-F17-88                                               DTSCS76
00826 ********MOVE '11' TO LCCM-REQ-SCR-ID                              DTSCS76
00827 ********SET REQ-JUMP TO TRUE                                      DTSCS76
00828 ********GO TO P1000-EXIT.                                         DTSCS76
00829                                                                   DTSCS76
00830 *****IF LCCM-F18-88                                               DTSCS76
00831 ********MOVE '12' TO LCCM-REQ-SCR-ID                              DTSCS76
00832 ********SET REQ-JUMP TO TRUE                                      DTSCS76
00833 ********GO TO P1000-EXIT.                                         DTSCS76
00834                                                                   DTSCS76
00835 *****IF LCCM-F19-88                                               DTSCS76
00836 ********MOVE '31' TO LCCM-REQ-SCR-ID                              DTSCS76
00837 ********SET REQ-JUMP TO TRUE                                      DTSCS76
00838 ********GO TO P1000-EXIT.                                         DTSCS76
00839                                                                   DTSCS76
00840 *****IF LCCM-F20-88                                               DTSCS76
00841 ********MOVE '41' TO LCCM-REQ-SCR-ID                              DTSCS76
00842 ********SET REQ-JUMP TO TRUE                                      DTSCS76
00843 ********GO TO P1000-EXIT.                                         DTSCS76
00844                                                                   DTSCS76
00845                                                                   DTSCS76
00846 *-----------------------------------------------------            DTSCS76
00847 *    IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO               DTSCS76
00848 *    REQUESTED SCREEN TYPE                                        DTSCS76
00849 *-----------------------------------------------------            DTSCS76
00850                                                                   DTSCS76
00851      IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID             DTSCS76
00852         NEXT SENTENCE                                             DTSCS76
00853      ELSE                                                         DTSCS76
00854        MOVE MAP-GOTO TO LCCM-REQ-SCR-ID                           DTSCS76
00855        SET REQ-JUMP TO TRUE                                       DTSCS76
00856        GO TO P1000-EXIT.                                          DTSCS76
00857                                                                   DTSCS76
00858                                                                   DTSCS76
00859 *-----------------------------------------------------            DTSCS76
00860 *    IF REQUEST TO UPDATE THE DATA (ADD)                          DTSCS76
00861 *          VERIFY USER ACCESS TO PERFORM UPDATE                   DTSCS76
00862 *-----------------------------------------------------            DTSCS76
00863                                                                   DTSCS76
00864      IF LCCM-F09-88                                               DTSCS76
00865         IF SCR-ACCESS-UPDATE                                      DTSCS76
00866            SET REQ-EDIT TO TRUE                                   DTSCS76
00867            GO TO P1000-EXIT                                       DTSCS76
00868         ELSE                                                      DTSCS76
00869            PERFORM S804-INVALID-KEY THRU S804-EXIT                DTSCS76
00870            SET REQ-ERROR TO TRUE                                  DTSCS76
00871            GO TO P1000-EXIT.                                      DTSCS76
00872                                                                   DTSCS76
00873                                                                   DTSCS76
00874 *-----------------------------------------------------            DTSCS76
00875 *     IF INQUIRY KEY IS PRESSED (ENTER), INDICATE                 DTSCS76
00876 *     INQUIRY REQUESTED.                                          DTSCS76
00877 *-----------------------------------------------------            DTSCS76
00878                                                                   DTSCS76
00879      IF LCCM-ENTER-88                                             DTSCS76
00880          SET REQ-INQUIRE TO TRUE                                  DTSCS76
00881          GO TO P1000-EXIT.                                        DTSCS76
00882                                                                   DTSCS76
00883                                                                   DTSCS76
00884 *-----------------------------------------------------            DTSCS76
00885 *     ANY OTHER KEY IS INVALID                                    DTSCS76
00886 *-----------------------------------------------------            DTSCS76
00887                                                                   DTSCS76
00888      PERFORM S804-INVALID-KEY THRU S804-EXIT.                     DTSCS76
00889                                                                   DTSCS76
00890      SET REQ-ERROR TO TRUE.                                       DTSCS76
00891  P1000-EXIT.                                                      DTSCS76
00892      EXIT.                                                        DTSCS76
00893                                                                   DTSCS76
00894                                                                   DTSCS76
00895                                                                   DTSCS76
00896 ******************************************************************DTSCS76
00897 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS76
00898 ******************************************************************DTSCS76
00899                                                                   DTSCS76
00900  P1100-UPDATE-LOCKED.                                             DTSCS76
00901                                                                   DTSCS76
00902 *-----------------------------------------------------            DTSCS76
00903 *    IF THE SCREEN IS "LOCKED FOR UPDATE", THEN                   DTSCS76
00904 *    THE ONLY VALID OPERATOR REQUESTS ARE ENTER OR F9             DTSCS76
00905 *    (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE).              DTSCS76
00906 *-----------------------------------------------------            DTSCS76
00907                                                                   DTSCS76
00908      IF LCCM-ENTER-88 OR LCCM-F12-88 OR LCCM-F09-88               DTSCS76
00909         SET REQ-UPDATE TO TRUE                                    DTSCS76
00910         IF LCCM-F09-88                                            DTSCS76
00911            SET LCCM-ENTER-88 TO TRUE                              DTSCS76
00912         END-IF                                                    DTSCS76
00913      ELSE                                                         DTSCS76
00914         SET REQ-ERROR TO TRUE                                     DTSCS76
00915         IF LCCM-SCR-ADD-LOCKED                                    DTSCS76
00916            MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID                   DTSCS76
00917         ELSE                                                      DTSCS76
00918            GO TO S899-ABEND.                                      DTSCS76
00919  P1100-EXIT.                                                      DTSCS76
00920      EXIT.                                                        DTSCS76
00921 /*****************************************************************DTSCS76
00922 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS76
00923 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN.                      *DTSCS76
00924 ******************************************************************DTSCS76
00925                                                                   DTSCS76
00926  P2000-REQUEST-ERROR.                                             DTSCS76
00927      IF LCCM-MSG                                                  DTSCS76
00928         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS76
00929      ELSE                                                         DTSCS76
00930         GO TO S899-ABEND.                                         DTSCS76
00931  P2000-EXIT.                                                      DTSCS76
00932      EXIT.                                                        DTSCS76
00933 /*****************************************************************DTSCS76
00934 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED                  *DTSCS76
00935 ******************************************************************DTSCS76
00936                                                                   DTSCS76
00937  P3000-REQUEST-JUMP.                                              DTSCS76
00938                                                                   DTSCS76
00939 *-----------------------------------------------------            DTSCS76
00940 *    VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE    DTSCS76
00941 *    BY USER                                                      DTSCS76
00942 *-----------------------------------------------------            DTSCS76
00943                                                                   DTSCS76
00944      PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT.                 DTSCS76
00945                                                                   DTSCS76
00946                                                                   DTSCS76
00947 *-----------------------------------------------------            DTSCS76
00948 *    VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED               DTSCS76
00949 *-----------------------------------------------------            DTSCS76
00950                                                                   DTSCS76
00951      IF LCCM-MSG                                                  DTSCS76
00952         SET RESP-SEND-MSGONLY TO TRUE                             DTSCS76
00953         SET CURSOR-SET-GOTO TO TRUE                               DTSCS76
00954         GO TO P3000-EXIT.                                         DTSCS76
00955                                                                   DTSCS76
00956                                                                   DTSCS76
00957      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS76
00958                                                                   DTSCS76
00959      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS76
00960                                                                   DTSCS76
00961      IF L018-VALID                                                DTSCS76
00962          MOVE L018-EMP-NO TO LCCM-EMP-NO.                         DTSCS76
00963                                                                   DTSCS76
00964                                                                   DTSCS76
00965 *-----------------------------------------------------            DTSCS76
00966 *    CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING      DTSCS76
00967 *-----------------------------------------------------            DTSCS76
00968                                                                   DTSCS76
00969      MOVE LOW-VALUES TO LCCM-SCR-STATUS                           DTSCS76
00970                         LCCM-SCR-HOLD-AREA.                       DTSCS76
00971                                                                   DTSCS76
00972      MOVE +0 TO LCCM-SCR-ABSTIME.                                 DTSCS76
00973                                                                   DTSCS76
00974      SET RESP-JUMP TO TRUE.                                       DTSCS76
00975  P3000-EXIT.                                                      DTSCS76
00976      EXIT.                                                        DTSCS76
00977 /*****************************************************************DTSCS76
00978 * CLEAR KEY WAS PRESSED                                          *DTSCS76
00979 ******************************************************************DTSCS76
00980                                                                   DTSCS76
00981  P4000-REQUEST-CLEAR.                                             DTSCS76
00982      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS76
00983                                                                   DTSCS76
00984      IF SCR-ACCESS-UPDATE                                         DTSCS76
00985          PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT           DTSCS76
00986      ELSE                                                         DTSCS76
00987          PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT.             DTSCS76
00988                                                                   DTSCS76
00989                                                                   DTSCS76
00990 *-----------------------------------------------------            DTSCS76
00991 *   CLEAN UP INDICATORS AND PAGING STORAGE.  RESET KEY            DTSCS76
00992 *   FIELDS FROM EARLIER REQUESTS                                  DTSCS76
00993 *-----------------------------------------------------            DTSCS76
00994                                                                   DTSCS76
00995      IF LCCM-EMP-NO > ZERO                                        DTSCS76
00996          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS76
00997          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2.                      DTSCS76
00998                                                                   DTSCS76
00999      MOVE ZERO TO LCCM-EMP-NO.                                    DTSCS76
01000                                                                   DTSCS76
01001      MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA.                       DTSCS76
01002                                                                   DTSCS76
01003      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS76
01004                                                                   DTSCS76
01005      SET RESP-SEND-MAP TO TRUE.                                   DTSCS76
01006  P4000-EXIT.                                                      DTSCS76
01007      EXIT.                                                        DTSCS76
01008 /*****************************************************************DTSCS76
01009 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED                   *DTSCS76
01010 ******************************************************************DTSCS76
01011                                                                   DTSCS76
01012  P5000-CURSOR-TO-GOTO.                                            DTSCS76
01013      SET CURSOR-SET-GOTO TO TRUE.                                 DTSCS76
01014                                                                   DTSCS76
01015      SET RESP-CURSOR-TO-GOTO TO TRUE.                             DTSCS76
01016  P5000-EXIT.                                                      DTSCS76
01017      EXIT.                                                        DTSCS76
01018 /*****************************************************************DTSCS76
01019 * INQUIRY WAS REQUESTED                                          *DTSCS76
01020 ******************************************************************DTSCS76
01021                                                                   DTSCS76
01022  P6000-REQUEST-INQUIRE.                                           DTSCS76
01023      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS76
01024                                                                   DTSCS76
01025      MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME.            DTSCS76
01026                                                                   DTSCS76
01027      SET RESP-SEND-MAP TO TRUE.                                   DTSCS76
01028                                                                   DTSCS76
01029      IF SCR-ACCESS-UPDATE                                         DTSCS76
01030          PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT           DTSCS76
01031      ELSE                                                         DTSCS76
01032          PERFORM S8300-SET-INQ-ATTRB THRU S8300-EXIT.             DTSCS76
01033                                                                   DTSCS76
01034      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS76
01035                                                                   DTSCS76
01036      IF LCCM-MSG                                                  DTSCS76
01037          GO TO P6000-EXIT.                                        DTSCS76
01038                                                                   DTSCS76
01039      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS76
01040                                                                   DTSCS76
01041      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS76
01042                                                                   DTSCS76
01043      MOVE LCCM-RESP-OP-ID TO MAP-RESPONSIBLE-OP-ID.               DTSCS76
01044                                                                   DTSCS76
01045      SET LCCM-SCR-INQUIRE TO TRUE.                                DTSCS76
01046  P6000-EXIT.                                                      DTSCS76
01047      EXIT.                                                        DTSCS76
01048 /*****************************************************************DTSCS76
01049 * FUNCTION KEY TO ADD THE RECORD WAS PRESSED.                    *DTSCS76
01050 ******************************************************************DTSCS76
01051                                                                   DTSCS76
01052  P7000-REQUEST-EDIT.                                              DTSCS76
01053      PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT.              DTSCS76
01054                                                                   DTSCS76
01055      IF LCCM-F09-88                                               DTSCS76
01056         PERFORM P7100-EDIT-ADD THRU P7100-EXIT                    DTSCS76
01057      ELSE                                                         DTSCS76
01058         GO TO S899-ABEND.                                         DTSCS76
01059                                                                   DTSCS76
01060                                                                   DTSCS76
01061 *------------------------------------------------------           DTSCS76
01062 *  SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED.          DTSCS76
01063 *  IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST         DTSCS76
01064 *  REMAIN IN 'CLEAR' STATUS.                                      DTSCS76
01065 *------------------------------------------------------           DTSCS76
01066                                                                   DTSCS76
01067      IF LCCM-MSG                                                  DTSCS76
01068         NEXT SENTENCE                                             DTSCS76
01069      ELSE                                                         DTSCS76
01070         PERFORM S8100-SET-LOCK-ATTRB THRU S8100-EXIT              DTSCS76
01071         IF LCCM-F09-88                                            DTSCS76
01072            SET LCCM-SCR-ADD-LOCKED TO TRUE                        DTSCS76
01073            MOVE PMSG-ALT-ADD-CONFIRM TO LCCM-MSG-ID.              DTSCS76
01074                                                                   DTSCS76
01075      SET RESP-SEND-MAP TO TRUE.                                   DTSCS76
01076                                                                   DTSCS76
01077      IF MAP-CLAIMANT-NAME GREATER SPACES                          DTSCS76
01078         MOVE CATB-ASKIP-NORM-MDTON TO MAP-CLAIMANT-NAME-A.        DTSCS76
01079  P7000-EXIT.                                                      DTSCS76
01080      EXIT.                                                        DTSCS76
01081 /*****************************************************************DTSCS76
01082 * ADD FUNCTION WAS REQUESTED                                     *DTSCS76
01083 ******************************************************************DTSCS76
01084                                                                   DTSCS76
01085  P7100-EDIT-ADD.                                                  DTSCS76
01086 *-----------------------------------------------------            DTSCS76
01087 *    ADD REQUIRES THAT THE SCREEN BE IN A CLEARED STATE           DTSCS76
01088 *-----------------------------------------------------            DTSCS76
01089                                                                   DTSCS76
01090 *****IF NOT LCCM-SCR-CLEAR                                        DTSCS76
01091 ********MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID                     DTSCS76
01092 ********GO TO P7100-EXIT.                                         DTSCS76
01093                                                                   DTSCS76
01094                                                                   DTSCS76
01095 *-----------------------------------------------------            DTSCS76
01096 *    MAP-EMP-NO IS REQUIRED                                       DTSCS76
01097 *-----------------------------------------------------            DTSCS76
01098                                                                   DTSCS76
01099      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS76
01100                                                                   DTSCS76
01101      IF LCCM-MSG                                                  DTSCS76
01102          GO TO P7100-EXIT.                                        DTSCS76
01103                                                                   DTSCS76
01104                                                                   DTSCS76
01105      PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT.                  DTSCS76
01106  P7100-EXIT.                                                      DTSCS76
01107      EXIT.                                                        DTSCS76
01108 /*****************************************************************DTSCS76
01109 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED       *DTSCS76
01110 ******************************************************************DTSCS76
01111                                                                   DTSCS76
01112  P8000-REQUEST-UPDATE.                                            DTSCS76
01113      IF LCCM-SCR-ADD-LOCKED                                       DTSCS76
01114         PERFORM P8100-ADD THRU P8100-EXIT                         DTSCS76
01115      ELSE                                                         DTSCS76
01116         GO TO S899-ABEND.                                         DTSCS76
01117                                                                   DTSCS76
01118      SET RESP-SEND-MAP TO TRUE.                                   DTSCS76
01119  P8000-EXIT.                                                      DTSCS76
01120      EXIT.                                                        DTSCS76
01121 /*****************************************************************DTSCS76
01122 *                                                                *DTSCS76
01123 ******************************************************************DTSCS76
01124                                                                   DTSCS76
01125  P8100-ADD.                                                       DTSCS76
01126      SET LCCM-SCR-CLEAR TO TRUE.                                  DTSCS76
01127                                                                   DTSCS76
01128      PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT.              DTSCS76
01129                                                                   DTSCS76
01130      IF LCCM-F12-88                                               DTSCS76
01131         MOVE PMSG-ADD-CANCELED TO LCCM-MSG-ID                     DTSCS76
01132         GO TO P8100-EXIT.                                         DTSCS76
01133                                                                   DTSCS76
01134                                                                   DTSCS76
01135      PERFORM S1100-EDIT-KEY THRU S1100-EXIT.                      DTSCS76
01136                                                                   DTSCS76
01137      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS76
01138                                                                   DTSCS76
01139 *****PERFORM S1200-READ-MELF THRU S1200-EXIT.                     DTSCS76
01140                                                                   DTSCS76
01141      MOVE ALL '?' TO WRK-MAILING-ADDRESS-AREA.                    DTSCS76
01142                                                                   DTSCS76
01143      IF WRK-MPRF-YES-88                                           DTSCS76
01144         PERFORM P8110-FORMAT-ADDR THRU P8110-EXIT                 DTSCS76
01145         IF LCCM-MSG                                               DTSCS76
01146             GO TO P8100-EXIT.                                     DTSCS76
01147                                                                   DTSCS76
01148                                                                   DTSCS76
01149      MOVE MAP-MAILING-LABELS-AREA TO L013-S-CNT-AREA.             DTSCS76
01150                                                                   DTSCS76
01151      PERFORM S013-COPY-CNT THRU S013-EXIT.                        DTSCS76
01152                                                                   DTSCS76
01153      IF L013-CNT NOT = 0                                          DTSCS76
01154         PERFORM P8910-R901-RECORD THRU P8910-EXIT.                DTSCS76
01155                                                                   DTSCS76
01156                                                                   DTSCS76
01157 *****MOVE ALL '?' TO WRK-ELF-ADDRESS-AREA.                        DTSCS76
01158 *****IF WRK-MELF-YES-88                                           DTSCS76
01159 *********PERFORM P8210-FORMAT-ELF-ADDR THRU P8210-EXIT            DTSCS76
01160 *********IF LCCM-MSG                                              DTSCS76
01161 *************GO TO P8100-EXIT.                                    DTSCS76
01162                                                                   DTSCS76
01163 *****MOVE MAP-ELF-LABELS-AREA TO L013-S-CNT-AREA.                 DTSCS76
01164 *****PERFORM S013-COPY-CNT THRU S013-EXIT.                        DTSCS76
01165                                                                   DTSCS76
01166 *****IF L013-CNT NOT = 0                                          DTSCS76
01167 *********PERFORM P8915-ELF-R901-RECORD THRU P8915-EXIT            DTSCS76
01168 *****END-IF.                                                      DTSCS76
01169                                                                   DTSCS76
01170                                                                   DTSCS76
01171      MOVE MAP-FROM-YRQ-AREA TO L016-S-YRQ-AREA.                   DTSCS76
01172                                                                   DTSCS76
01173      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
01174                                                                   DTSCS76
01175      IF L016-NO-ENTRY                                             DTSCS76
01176         NEXT SENTENCE                                             DTSCS76
01177      ELSE                                                         DTSCS76
01178         PERFORM P8920-T036-RECORD THRU P8920-EXIT.                DTSCS76
01179                                                                   DTSCS76
01180                                                                   DTSCS76
01181 *****MOVE MAP-5E-FROM-YRQ-AREA TO L016-S-YRQ-AREA.                DTSCS76
01182 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
01183 *****IF L016-NO-ENTRY                                             DTSCS76
01184 *********NEXT SENTENCE                                            DTSCS76
01185 *****ELSE                                                         DTSCS76
01186 *********PERFORM P8925-5E-T036-RECORD THRU P8925-EXIT             DTSCS76
01187 *****END-IF.                                                      DTSCS76
01188                                                                   DTSCS76
01189 *****MOVE MAP-NOTICE-OF-COVERAGE-AREA TO L013-S-CNT-AREA.         DTSCS76
01190 *****PERFORM S013-COPY-CNT THRU S013-EXIT.                        DTSCS76
01191 *****IF L013-CNT > +0                                             DTSCS76
01192 ********PERFORM P8930-R111-RECORDS THRU P8930-EXIT                DTSCS76
01193 ************L013-CNT TIMES.                                       DTSCS76
01194                                                                   DTSCS76
01195                                                                   DTSCS76
01196      IF MAP-NOTICE-OF-SUBJECT-YES                                 DTSCS76
01197         PERFORM P8940-R112-RECORD THRU P8940-EXIT.                DTSCS76
01198                                                                   DTSCS76
01199                                                                   DTSCS76
01200      IF MAP-REQUEST-FOR-FEIN-YES                                  DTSCS76
01201         PERFORM P8950-R903-RECORD THRU P8950-EXIT.                DTSCS76
01202                                                                   DTSCS76
01203                                                                   DTSCS76
01204      IF MAP-AR-AUDIT-TRAIL-YES                                    DTSCS76
01205         PERFORM P8960-R432-RECORD THRU P8960-EXIT.                DTSCS76
01206                                                                   DTSCS76
01207                                                                   DTSCS76
01208      MOVE MAP-STMT-FROM-YRQ-AREA TO L016-S-YRQ-AREA.              DTSCS76
01209                                                                   DTSCS76
01210      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
01211                                                                   DTSCS76
01212      IF L016-NO-ENTRY                                             DTSCS76
01213         NEXT SENTENCE                                             DTSCS76
01214      ELSE                                                         DTSCS76
01215         PERFORM P8970-T011-RECORD THRU P8970-EXIT.                DTSCS76
01216                                                                   DTSCS76
01217      IF MAP-SSN-1 GREATER SPACES                                  DTSCS76
01218 ***     MOVE +1 TO L013-CNT                                       DTSCS76
01219 **      SET WRK-R751-YES-88 TO TRUE                               DTSCS76
01220 **      PERFORM P8910-R901-RECORD THRU P8910-EXIT                 DTSCS76
01221 ***     SET WRK-R751-NO-88 TO TRUE                                DTSCS76
01222         PERFORM P8980-R751-RECORD THRU P8980-EXIT.                DTSCS76
01223                                                                   DTSCS76
01224                                                                   DTSCS76
01225      IF LCCM-ENTER-88                                             DTSCS76
01226          MOVE LOW-VALUES TO MAP-AREA                              DTSCS76
01227          PERFORM S8200-SET-UPDATE-ATTRB THRU S8200-EXIT           DTSCS76
01228          MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1                       DTSCS76
01229          MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2                       DTSCS76
01230      ELSE                                                         DTSCS76
01231          MOVE LOW-VALUES TO MAP-EMP-NO-1                          DTSCS76
01232                             MAP-EMP-NO-2                          DTSCS76
01233                             MAP-PRIMARY-NAME.                     DTSCS76
01234                                                                   DTSCS76
01235      MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID.                     DTSCS76
01236  P8100-EXIT.                                                      DTSCS76
01237      EXIT.                                                        DTSCS76
01238                                                                   DTSCS76
01239                                                                   DTSCS76
01240                                                                   DTSCS76
01241  P8110-FORMAT-ADDR.                                               DTSCS76
01242      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS76
01243                                                                   DTSCS76
01244      IF MAP-ADDR-TAD-88                                           DTSCS76
01245          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS76
01246      ELSE                                                         DTSCS76
01247      IF MAP-ADDR-TAX-ALT-88                                       DTSCS76
01248          SET L111-LOOKUP-TAA-88 TO TRUE                           DTSCS76
01249      ELSE                                                         DTSCS76
01250      IF MAP-ADDR-OPO-88                                           DTSCS76
01251          SET L111-LOOKUP-OPO-88 TO TRUE                           DTSCS76
01252      ELSE                                                         DTSCS76
01253          GO TO P8110-EXIT.                                        DTSCS76
01254                                                                   DTSCS76
01255      IF MAP-ADDR-TAX-88                                           DTSCS76
01256          SET L111-ID-NO-TAD-MAIL-88 TO TRUE                       DTSCS76
01257      ELSE                                                         DTSCS76
01258      IF MAP-ADDR-PHY-88                                           DTSCS76
01259          SET L111-ID-NO-TAD-PHYS-88 TO TRUE                       DTSCS76
01260      ELSE                                                         DTSCS76
01261          MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA              DTSCS76
01262          PERFORM S013-ADDR-NUM THRU S013-EXIT                     DTSCS76
01263          IF L013-VALID                                            DTSCS76
01264              MOVE L013-CNT TO L111-ID-NO                          DTSCS76
01265          ELSE                                                     DTSCS76
01266              GO TO P8110-EXIT.                                    DTSCS76
01267                                                                   DTSCS76
01268      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS76
01269                                                                   DTSCS76
01270      IF L111-ADDR-NOT-FOUND-88                                    DTSCS76
01271          MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                     DTSCS76
01272          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS76
01273          GO TO P8110-EXIT.                                        DTSCS76
01274                                                                   DTSCS76
01275                                                                   DTSCS76
01276      MOVE L111-ADDR-TYPE TO L112-ADDR-TYPE.                       DTSCS76
01277                                                                   DTSCS76
01278      SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS76
01279                                                                   DTSCS76
01280      MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME.                 DTSCS76
01281                                                                   DTSCS76
01282      MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA.             DTSCS76
01283                                                                   DTSCS76
01284      PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS76
01285                                                                   DTSCS76
01286                                                                   DTSCS76
01287      MOVE L112-MAILING-ADDRESS TO WRK-MAILING-ADDRESS.            DTSCS76
01288                                                                   DTSCS76
01289      MOVE L112-ZIP TO WRK-ZIP.                                    DTSCS76
01290                                                                   DTSCS76
01291 *****MOVE L112-DELIV-POINT           TO WRK-DELIV-POINT.          DTSCS76
01292                                                                   DTSCS76
01293 *****MOVE L112-CHECK-DIGIT           TO WRK-CHECK-DIGIT.          DTSCS76
01294                                                                   DTSCS76
01295      MOVE L112-ADVANCED-BARCODE TO WRK-ADVANCED-BARCODE.          DTSCS76
01296  P8110-EXIT.                                                      DTSCS76
01297      EXIT.                                                        DTSCS76
01298                                                                   DTSCS76
01299                                                                   DTSCS76
01300                                                                   DTSCS76
01301 *P8210-FORMAT-ELF-ADDR.                                           DTSCS76
01302 **** SET L112-TAD-ADDR-88 TO TRUE.                                DTSCS76
01303 *****SET L112-ANCHOR-LAST-88 TO TRUE.                             DTSCS76
01304 *****MOVE MPRF-BUSINESS-NAME TO L112-BUSINESS-NAME.               DTSCS76
01305 *****MOVE MELF-MAIL-DELIV-IND TO L112-MAIL-DELIV-IND.             DTSCS76
01306 *****MOVE SPACES TO L112-NAME                                     DTSCS76
01307 ********************L112-TITLE.                                   DTSCS76
01308 *****MOVE MELF-ADDRESS TO L112-ADDRESS.                           DTSCS76
01309                                                                   DTSCS76
01310 *****PERFORM S112-ADDR-FORMAT THRU S112-EXIT.                     DTSCS76
01311                                                                   DTSCS76
01312 *****MOVE L112-MAILING-ADDRESS TO WRK-ELF-ADDRESS.                DTSCS76
01313 *****MOVE L112-ZIP             TO WRK-ELF-ZIP.                    DTSCS76
01314 *****MOVE L112-DELIV-POINT     TO WRK-ELF-DELIV-POINT.            DTSCS76
01315 *****MOVE L112-CHECK-DIGIT     TO WRK-ELF-CHECK-DIGIT.            DTSCS76
01316 *P8210-EXIT. EXIT.                                                DTSCS76
01317                                                                   DTSCS76
01318                                                                   DTSCS76
01319                                                                   DTSCS76
01320 *****                                                             DTSCS76
01321 *    MACIR901    LABEL REPORT RECORD.                             DTSCS76
01322 *****                                                             DTSCS76
01323                                                                   DTSCS76
01324  P8910-R901-RECORD.                                               DTSCS76
01325      SET R901-ON-REQUEST-88 TO TRUE.                              DTSCS76
01326                                                                   DTSCS76
01327      MOVE LOW-VALUES TO R901-SORT-VAR-AREA.                       DTSCS76
01328                                                                   DTSCS76
01329      MOVE L013-CNT TO R901-LABEL-CNT.                             DTSCS76
01330                                                                   DTSCS76
01331 *****SET R901-MAILING-LABEL TO TRUE.                              DTSCS76
01332                                                                   DTSCS76
01333 ***  IF WRK-R751-NO-88                                            DTSCS76
01334         MOVE MAP-RESPONSIBLE-OP-ID TO R901-GRP1-OP-ID             DTSCS76
01335 **   ELSE                                                         DTSCS76
01336 ***     MOVE 'RPT751R1'            TO R901-GRP1-OP-ID.            DTSCS76
01337                                                                   DTSCS76
01338      MOVE WRK-EMP-NO TO R901-GRP1-EMP-NO                          DTSCS76
01339                         R901-EMP-NO.                              DTSCS76
01340                                                                   DTSCS76
01341      MOVE WRK-MAILING-ADDRESS TO R901-FMT-ADDR.                   DTSCS76
01342                                                                   DTSCS76
01343      MOVE WRK-ZIP TO R901-ZIP.                                    DTSCS76
01344                                                                   DTSCS76
01345 *****MOVE WRK-DELIV-POINT            TO R901-DELIV-POINT.         DTSCS76
01346                                                                   DTSCS76
01347 *****MOVE WRK-CHECK-DIGIT            TO R901-CHECK-DIGIT.         DTSCS76
01348                                                                   DTSCS76
01349      MOVE WRK-ADVANCED-BARCODE TO R901-ADVANCED-BARCODE.          DTSCS76
01350                                                                   DTSCS76
01351                                                                   DTSCS76
01352      MOVE LENGTH OF R901-REC TO R901-LENGTH.                      DTSCS76
01353                                                                   DTSCS76
01354      MOVE R901-REC TO RSKL-REC.                                   DTSCS76
01355                                                                   DTSCS76
01356      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS76
01357  P8910-EXIT.                                                      DTSCS76
01358      EXIT.                                                        DTSCS76
01359                                                                   DTSCS76
01360                                                                   DTSCS76
01361 *****                                                             DTSCS76
01362 *    MACIR901    ELF LABEL REPORT RECORD.                         DTSCS76
01363 *****                                                             DTSCS76
01364                                                                   DTSCS76
01365 *P8915-ELF-R901-RECORD.                                           DTSCS76
01366 *****SET R901-ON-REQUEST-88          TO TRUE.                     DTSCS76
01367                                                                   DTSCS76
01368 *****MOVE LOW-VALUES TO R901-SORT-VAR-AREA.                       DTSCS76
01369                                                                   DTSCS76
01370 *****MOVE L013-CNT                   TO R901-LABEL-CNT.           DTSCS76
01371 *****MOVE MAP-RESPONSIBLE-OP-ID      TO R901-GRP1-OP-ID.          DTSCS76
01372                                                                   DTSCS76
01373 *****SET R901-ELF-LABEL TO TRUE.                                  DTSCS76
01374                                                                   DTSCS76
01375 *****MOVE WRK-EMP-NO                 TO R901-GRP1-EMP-NO          DTSCS76
01376 ****************************************R901-EMP-NO.              DTSCS76
01377                                                                   DTSCS76
01378 *****MOVE WRK-ELF-ADDRESS            TO R901-FMT-ADDR.            DTSCS76
01379 *****MOVE WRK-ELF-ZIP                TO R901-ZIP.                 DTSCS76
01380 *****MOVE WRK-ELF-DELIV-POINT        TO R901-DELIV-POINT.         DTSCS76
01381 *****MOVE WRK-ELF-CHECK-DIGIT        TO R901-CHECK-DIGIT.         DTSCS76
01382                                                                   DTSCS76
01383 *****MOVE R901-REC                   TO RSKL-REC.                 DTSCS76
01384 *****PERFORM S825-WRITE              THRU S825-EXIT.              DTSCS76
01385 *P8915-EXIT.                                                      DTSCS76
01386 *****EXIT.                                                        DTSCS76
01387                                                                   DTSCS76
01388                                                                   DTSCS76
01389                                                                   DTSCS76
01390 *****                                                             DTSCS76
01391 *              CREATE UC-30 TRANSACTION RECORD.                   DTSCS76
01392 *****                                                             DTSCS76
01393                                                                   DTSCS76
01394  P8920-T036-RECORD.                                               DTSCS76
01395      MOVE WRK-EMP-NO TO T036-EMP-NO.                              DTSCS76
01396                                                                   DTSCS76
01397      MOVE LCCM-OP-ID TO T036-OP-ID.                               DTSCS76
01398                                                                   DTSCS76
01399      MOVE WRK-SCR-ID TO T036-SCR-ID.                              DTSCS76
01400                                                                   DTSCS76
01401      MOVE LCCM-TASK-START-DATE TO T036-SYS-DATE.                  DTSCS76
01402                                                                   DTSCS76
01403      MOVE LCCM-TASK-START-TIME TO T036-SYS-TIME.                  DTSCS76
01404                                                                   DTSCS76
01405      SET  T036-REQUEST TO TRUE.                                   DTSCS76
01406                                                                   DTSCS76
01407      MOVE MAP-RESPONSIBLE-OP-ID TO T036-RESP-OP-ID.               DTSCS76
01408                                                                   DTSCS76
01409      MOVE MAP-FORCE-PRINT TO T036-FORCE-PRINT-IND.                DTSCS76
01410                                                                   DTSCS76
01411      MOVE L016-YRQ TO T036-START-YRQ.                             DTSCS76
01412                                                                   DTSCS76
01413      MOVE MAP-TO-YRQ-AREA TO L016-S-YRQ-AREA.                     DTSCS76
01414                                                                   DTSCS76
01415      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
01416                                                                   DTSCS76
01417      IF L016-VALID                                                DTSCS76
01418         MOVE L016-YRQ TO T036-END-YRQ                             DTSCS76
01419      ELSE                                                         DTSCS76
01420         MOVE T036-START-YRQ TO T036-END-YRQ.                      DTSCS76
01421                                                                   DTSCS76
01422      MOVE +0 TO T036-WAIVER-START-YRQ                             DTSCS76
01423                 T036-WAIVER-END-YRQ                               DTSCS76
01424                 T036-WAIVER-EXT-DATE.                             DTSCS76
01425                                                                   DTSCS76
01426      MOVE MAP-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA.            DTSCS76
01427                                                                   DTSCS76
01428      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS76
01429                                                                   DTSCS76
01430      IF L015-VALID                                                DTSCS76
01431          MOVE WRK-EMP-NO TO T031-EMP-NO                           DTSCS76
01432          MOVE LCCM-OP-ID TO T031-ORIGIN                           DTSCS76
01433          MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE               DTSCS76
01434          MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME               DTSCS76
01435          SET T031-AUTO-PROCESS TO TRUE                            DTSCS76
01436          MOVE T036-START-YRQ TO T031-START-YRQ                    DTSCS76
01437          MOVE T036-END-YRQ TO T031-END-YRQ                        DTSCS76
01438          MOVE T031-START-YRQ TO T031-WAIVER-START-YRQ             DTSCS76
01439          MOVE T031-END-YRQ TO T031-WAIVER-END-YRQ                 DTSCS76
01440          MOVE L015-DATE TO T031-WAIVER-EXT-DATE                   DTSCS76
01441          SET T031-TRANSFER-NO-88 TO TRUE                          DTSCS76
01442          MOVE +0 TO T031-TRANSFER-TO-EMP-NO                       DTSCS76
01443          MOVE LENGTH OF T031-REC TO T031-LENGTH                   DTSCS76
01444          MOVE T031-REC TO RSKL-REC                                DTSCS76
01445          PERFORM S825-WRITE THRU S825-EXIT                        DTSCS76
01446          MOVE T036-START-YRQ TO T036-WAIVER-START-YRQ             DTSCS76
01447          MOVE T036-END-YRQ TO T036-WAIVER-END-YRQ                 DTSCS76
01448          MOVE L015-DATE TO T036-WAIVER-EXT-DATE.                  DTSCS76
01449                                                                   DTSCS76
01450                                                                   DTSCS76
01451      MOVE MAP-ADDR-TYPE TO T036-ADDR-TYPE.                        DTSCS76
01452                                                                   DTSCS76
01453 *****MOVE MAP-ADDR-ID-NO-AREA  TO L013-S-CNT-AREA.                DTSCS76
01454                                                                   DTSCS76
01455 *****PERFORM S013-ADDR-NUM THRU S013-EXIT.                        DTSCS76
01456                                                                   DTSCS76
01457 *****MOVE L013-CNT                   TO T036-ADDR-NO.             DTSCS76
01458                                                                   DTSCS76
01459 *****SET T036-5E-REQ-NO-88 TO TRUE.                               DTSCS76
01460                                                                   DTSCS76
01461      MOVE +0 TO T036-ADDR-ESTB-ABSTIME.                           DTSCS76
01462                                                                   DTSCS76
01463      IF MAP-ADDR-OPO-88 OR MAP-ADDR-TAX-ALT-88                    DTSCS76
01464          NEXT SENTENCE                                            DTSCS76
01465      ELSE                                                         DTSCS76
01466          MOVE LENGTH OF T036-REC TO T036-LENGTH                   DTSCS76
01467          MOVE T036-REC TO RSKL-REC                                DTSCS76
01468          PERFORM S825-WRITE THRU S825-EXIT                        DTSCS76
01469          GO TO P8920-EXIT.                                        DTSCS76
01470                                                                   DTSCS76
01471      MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA.                 DTSCS76
01472                                                                   DTSCS76
01473      PERFORM S013-ADDR-NUM THRU S013-EXIT.                        DTSCS76
01474                                                                   DTSCS76
01475      IF L013-VALID                                                DTSCS76
01476          NEXT SENTENCE                                            DTSCS76
01477      ELSE                                                         DTSCS76
01478          GO TO P8920-EXIT.                                        DTSCS76
01479                                                                   DTSCS76
01480      IF MAP-ADDR-OPO-88                                           DTSCS76
01481          PERFORM P8921-OPO-ESTB-ABSTIME THRU P8921-EXIT           DTSCS76
01482      ELSE                                                         DTSCS76
01483          PERFORM P8922-TAA-ESTB-ABSTIME THRU P8922-EXIT.          DTSCS76
01484                                                                   DTSCS76
01485                                                                   DTSCS76
01486      MOVE LENGTH OF T036-REC TO T036-LENGTH.                      DTSCS76
01487                                                                   DTSCS76
01488      MOVE T036-REC TO RSKL-REC.                                   DTSCS76
01489                                                                   DTSCS76
01490      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS76
01491  P8920-EXIT.                                                      DTSCS76
01492      EXIT.                                                        DTSCS76
01493                                                                   DTSCS76
01494                                                                   DTSCS76
01495                                                                   DTSCS76
01496  P8921-OPO-ESTB-ABSTIME.                                          DTSCS76
01497      MOVE LOW-VALUES TO MOPO-KEY-AREA.                            DTSCS76
01498                                                                   DTSCS76
01499      MOVE WRK-EMP-NO TO MOPO-EMP-NO.                              DTSCS76
01500                                                                   DTSCS76
01501      SET MOPO-OPO-88 TO TRUE.                                     DTSCS76
01502                                                                   DTSCS76
01503      MOVE L013-CNT TO MOPO-ID-NO.                                 DTSCS76
01504                                                                   DTSCS76
01505      MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
01506                                                                   DTSCS76
01507      PERFORM S810-READ THRU S810-EXIT.                            DTSCS76
01508                                                                   DTSCS76
01509      IF L810-OK-88                                                DTSCS76
01510          MOVE MSKL-REC TO MOPO-REC                                DTSCS76
01511          MOVE MOPO-ESTB-ABSTIME TO T036-ADDR-ESTB-ABSTIME.        DTSCS76
01512  P8921-EXIT.                                                      DTSCS76
01513      EXIT.                                                        DTSCS76
01514                                                                   DTSCS76
01515                                                                   DTSCS76
01516                                                                   DTSCS76
01517  P8922-TAA-ESTB-ABSTIME.                                          DTSCS76
01518      MOVE LOW-VALUES TO MTAA-KEY-AREA.                            DTSCS76
01519                                                                   DTSCS76
01520      MOVE WRK-EMP-NO TO MTAA-EMP-NO.                              DTSCS76
01521                                                                   DTSCS76
01522      SET MTAA-TAA-88 TO TRUE.                                     DTSCS76
01523                                                                   DTSCS76
01524      MOVE L013-CNT TO MTAA-ID-NO.                                 DTSCS76
01525                                                                   DTSCS76
01526      MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
01527                                                                   DTSCS76
01528      PERFORM S810-READ THRU S810-EXIT.                            DTSCS76
01529                                                                   DTSCS76
01530      IF L810-OK-88                                                DTSCS76
01531          MOVE MSKL-REC TO MTAA-REC                                DTSCS76
01532          MOVE MTAA-ESTB-ABSTIME TO T036-ADDR-ESTB-ABSTIME.        DTSCS76
01533  P8922-EXIT.                                                      DTSCS76
01534      EXIT.                                                        DTSCS76
01535                                                                   DTSCS76
01536                                                                   DTSCS76
01537                                                                   DTSCS76
01538 *****                                                             DTSCS76
01539 *           CREATE UI-5E TRANSACTION RECORD.                      DTSCS76
01540 *****                                                             DTSCS76
01541                                                                   DTSCS76
01542 *P8925-5E-T036-RECORD.                                            DTSCS76
01543 *****MOVE WRK-EMP-NO                 TO T036-EMP-NO.              DTSCS76
01544 *****MOVE LCCM-OP-ID                 TO T036-OP-ID.               DTSCS76
01545 *****MOVE WRK-SCR-ID                 TO T036-SCR-ID.              DTSCS76
01546 *****MOVE LCCM-TASK-START-DATE       TO T036-SYS-DATE.            DTSCS76
01547 *****MOVE LCCM-TASK-START-TIME       TO T036-SYS-TIME.            DTSCS76
01548                                                                   DTSCS76
01549 *****SET  T036-REQUEST               TO TRUE.                     DTSCS76
01550                                                                   DTSCS76
01551 *****MOVE MAP-RESPONSIBLE-OP-ID      TO T036-RESP-OP-ID.          DTSCS76
01552 *****MOVE MAP-5E-FORCE-PRINT         TO T036-FORCE-PRINT-IND      DTSCS76
01553                                                                   DTSCS76
01554 *****MOVE L016-YRQ                   TO T036-START-YRQ.           DTSCS76
01555                                                                   DTSCS76
01556 *****MOVE MAP-5E-TO-YRQ-AREA         TO L016-S-YRQ-AREA.          DTSCS76
01557 *****PERFORM S016-YRQ-FROM-SCREEN    THRU S016-EXIT.              DTSCS76
01558                                                                   DTSCS76
01559 *****IF L016-VALID                                                DTSCS76
01560 ********MOVE L016-YRQ        TO T036-END-YRQ                      DTSCS76
01561 *****ELSE                                                         DTSCS76
01562 ********MOVE T036-START-YRQ  TO T036-END-YRQ                      DTSCS76
01563 *****END-IF.                                                      DTSCS76
01564                                                                   DTSCS76
01565 *****MOVE +0                         TO T036-WAIVE-START-YRQ      DTSCS76
01566 ****************************************T036-WAIVE-END-YRQ        DTSCS76
01567 ****************************************T036-WAIVE-EXT-DATE.      DTSCS76
01568                                                                   DTSCS76
01569 *****MOVE MAP-5E-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA.         DTSCS76
01570 *****PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS76
01571 *****IF L015-VALID                                                DTSCS76
01572 *********MOVE WRK-EMP-NO TO T031-EMP-NO                           DTSCS76
01573 *********MOVE LCCM-OP-ID TO T031-ORIGIN                           DTSCS76
01574 *********MOVE LCCM-TASK-START-DATE TO T031-SYS-DATE               DTSCS76
01575 *********MOVE LCCM-TASK-START-TIME TO T031-SYS-TIME               DTSCS76
01576 *********SET T031-AUTO-PROCESS TO TRUE                            DTSCS76
01577 *********MOVE T036-START-YRQ TO T031-START-YRQ                    DTSCS76
01578 *********MOVE T036-END-YRQ TO T031-END-YRQ                        DTSCS76
01579 *********MOVE T031-START-YRQ TO T031-WAIVE-START-YRQ              DTSCS76
01580 *********MOVE T031-END-YRQ TO T031-WAIVE-END-YRQ                  DTSCS76
01581 *********MOVE L015-DATE TO T031-WAIVE-EXT-DATE                    DTSCS76
01582 *********SET T031-TRANSFER-NO-88 TO TRUE                          DTSCS76
01583 *********MOVE +0 TO T031-TRANSFER-TO-EMP-NO                       DTSCS76
01584 *********MOVE T031-REC TO RSKL-REC                                DTSCS76
01585 *********PERFORM S825-WRITE THRU S825-EXIT                        DTSCS76
01586 *********MOVE T036-START-YRQ TO T036-WAIVE-START-YRQ              DTSCS76
01587 *********MOVE T036-END-YRQ TO T036-WAIVE-END-YRQ                  DTSCS76
01588 *********MOVE L015-DATE TO T036-WAIVE-EXT-DATE.                   DTSCS76
01589                                                                   DTSCS76
01590 *****MOVE MAP-ADDR-TYPE              TO T036-ADDR-TYPE.           DTSCS76
01591                                                                   DTSCS76
01592 *****MOVE MAP-ADDR-ID-NO-AREA  TO L013-S-CNT-AREA.                DTSCS76
01593                                                                   DTSCS76
01594 *****PERFORM S013-ADDR-NUM THRU S013-EXIT.                        DTSCS76
01595                                                                   DTSCS76
01596 *****MOVE L013-CNT                   TO T036-ADDR-NO.             DTSCS76
01597                                                                   DTSCS76
01598 *****SET T036-5E-REQ-YES-88 TO TRUE.                              DTSCS76
01599                                                                   DTSCS76
01600 *****MOVE T036-REC                   TO RSKL-REC.                 DTSCS76
01601 *****PERFORM S825-WRITE              THRU S825-EXIT.              DTSCS76
01602 *P8925-EXIT.                                                      DTSCS76
01603 *****EXIT.                                                        DTSCS76
01604                                                                   DTSCS76
01605                                                                   DTSCS76
01606                                                                   DTSCS76
01607 *****                                                             DTSCS76
01608 *    MACIR111    EMPLOYER REGISTRATION NOTIFICATION OF            DTSCS76
01609 *                COVERAGE REPORT RECORD.                          DTSCS76
01610 *****                                                             DTSCS76
01611                                                                   DTSCS76
01612 *P8930-R111-RECORDS.                                              DTSCS76
01613 *****MOVE MAP-RESPONSIBLE-OP-ID      TO R111-OP-ID.               DTSCS76
01614 *****MOVE WRK-EMP-NO                 TO R111-EMP-NO.              DTSCS76
01615                                                                   DTSCS76
01616 *****MOVE WRK-MAILING-ADDRESS        TO R111-FMT-ADDR.            DTSCS76
01617 *****MOVE WRK-ZIP                    TO R111-ZIP.                 DTSCS76
01618 *****MOVE WRK-DELIV-POINT            TO R111-DELIV-POINT.         DTSCS76
01619 *****MOVE WRK-CHECK-DIGIT            TO R111-CHECK-DIGIT.         DTSCS76
01620                                                                   DTSCS76
01621 *****MOVE R111-REC                   TO RSKL-REC.                 DTSCS76
01622 *****PERFORM S825-WRITE              THRU S825-EXIT.              DTSCS76
01623 *P8930-EXIT.                                                      DTSCS76
01624 *****EXIT.                                                        DTSCS76
01625                                                                   DTSCS76
01626                                                                   DTSCS76
01627                                                                   DTSCS76
01628 *****                                                             DTSCS76
01629 *    MACIR112    EMPLOYER REGISTRATION NOTICE OF SUBJECTIVITY     DTSCS76
01630 *                (UI-47) REPORT RECORD.                           DTSCS76
01631 *****                                                             DTSCS76
01632                                                                   DTSCS76
01633  P8940-R112-RECORD.                                               DTSCS76
01634      MOVE LOW-VALUES TO MSOL-KEY-AREA.                            DTSCS76
01635                                                                   DTSCS76
01636      MOVE WRK-EMP-NO TO MSOL-EMP-NO.                              DTSCS76
01637                                                                   DTSCS76
01638      SET MSOL-SOL-88 TO TRUE.                                     DTSCS76
01639                                                                   DTSCS76
01640      MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
01641                                                                   DTSCS76
01642      PERFORM S810-COUNT THRU S810-EXIT.                           DTSCS76
01643                                                                   DTSCS76
01644      IF L810-RECORD-CNT = 0                                       DTSCS76
01645         GO TO P8940-EXIT.                                         DTSCS76
01646                                                                   DTSCS76
01647                                                                   DTSCS76
01648      PERFORM S810-READ THRU S810-EXIT.                            DTSCS76
01649                                                                   DTSCS76
01650      MOVE MSKL-REC TO MSOL-REC.                                   DTSCS76
01651                                                                   DTSCS76
01652                                                                   DTSCS76
01653      INITIALIZE R112-DATA-AREA.                                   DTSCS76
01654                                                                   DTSCS76
01655                                                                   DTSCS76
01656      MOVE MAP-RESPONSIBLE-OP-ID TO R112-OP-ID.                    DTSCS76
01657                                                                   DTSCS76
01658      MOVE WRK-EMP-NO TO R112-EMP-NO.                              DTSCS76
01659                                                                   DTSCS76
01660      MOVE LCCM-CURR-RUN-DATE TO R112-RUN-DATE.                    DTSCS76
01661                                                                   DTSCS76
01662      MOVE WRK-MAILING-ADDRESS TO R112-FMT-ADDR.                   DTSCS76
01663                                                                   DTSCS76
01664      MOVE WRK-ZIP TO R112-ZIP.                                    DTSCS76
01665                                                                   DTSCS76
01666 *****MOVE WRK-DELIV-POINT TO R112-DELIV-POINT.                    DTSCS76
01667                                                                   DTSCS76
01668 *****MOVE WRK-CHECK-DIGIT TO R112-CHECK-DIGIT.                    DTSCS76
01669                                                                   DTSCS76
01670      MOVE WRK-ADVANCED-BARCODE TO R112-ADVANCED-BARCODE.          DTSCS76
01671                                                                   DTSCS76
01672      MOVE MSOL-FIRST-LIAB-YRQ TO R112-FIRST-LIAB-YRQ.             DTSCS76
01673                                                                   DTSCS76
01674      MOVE MSOL-LAST-LIAB-YRQ TO R112-LAST-LIAB-YRQ.               DTSCS76
01675                                                                   DTSCS76
01676      MOVE MPRF-EMP-CLASS TO R112-EMP-CLASS.                       DTSCS76
01677                                                                   DTSCS76
01678 *****MOVE MPRF-SIC-DIVISION TO R112-SIC-DIVISION.                 DTSCS76
01679                                                                   DTSCS76
01680      IF MPRF-CLASS-RATED-88                                       DTSCS76
01681         MOVE LCCM-LAST-RATE-END-YRQ  TO R112-LAST-RATE-END-YRQ.   DTSCS76
01682                                                                   DTSCS76
01683      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSCS76
01684                                                                   DTSCS76
01685      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSCS76
01686                                                                   DTSCS76
01687      SET MSKL-RTE-88 TO TRUE.                                     DTSCS76
01688                                                                   DTSCS76
01689      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS76
01690                                                                   DTSCS76
01691      MOVE +0 TO WRK-RATE-CTR.                                     DTSCS76
01692                                                                   DTSCS76
01693      PERFORM P8941-RATE-AREA THRU P8941-EXIT                      DTSCS76
01694          UNTIL L810-NO-REC-88.                                    DTSCS76
01695                                                                   DTSCS76
01696      MOVE WRK-RATE-CTR TO R112-RATE-CNT.                          DTSCS76
01697                                                                   DTSCS76
01698      MOVE LENGTH OF R112-REC TO R112-LENGTH.                      DTSCS76
01699                                                                   DTSCS76
01700      MOVE R112-REC TO RSKL-REC.                                   DTSCS76
01701                                                                   DTSCS76
01702      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS76
01703  P8940-EXIT.                                                      DTSCS76
01704      EXIT.                                                        DTSCS76
01705                                                                   DTSCS76
01706                                                                   DTSCS76
01707                                                                   DTSCS76
01708  P8941-RATE-AREA.                                                 DTSCS76
01709      ADD +1 TO WRK-RATE-CTR.                                      DTSCS76
01710                                                                   DTSCS76
01711      IF WRK-RATE-CTR > +6                                         DTSCS76
01712          MOVE R112-RATE-AREA (2) TO R112-RATE-AREA (1)            DTSCS76
01713          MOVE R112-RATE-AREA (3) TO R112-RATE-AREA (2)            DTSCS76
01714          MOVE R112-RATE-AREA (4) TO R112-RATE-AREA (3)            DTSCS76
01715          MOVE R112-RATE-AREA (5) TO R112-RATE-AREA (4)            DTSCS76
01716          MOVE R112-RATE-AREA (6) TO R112-RATE-AREA (5)            DTSCS76
01717          MOVE +6 TO WRK-RATE-CTR.                                 DTSCS76
01718                                                                   DTSCS76
01719                                                                   DTSCS76
01720      MOVE MSKL-REC TO MRTE-REC.                                   DTSCS76
01721                                                                   DTSCS76
01722                                                                   DTSCS76
01723      MOVE MRTE-EFF-YRQ TO R112-RATE-EFF-YRQ (WRK-RATE-CTR).       DTSCS76
01724                                                                   DTSCS76
01725      MOVE MRTE-END-YRQ TO R112-RATE-END-YRQ (WRK-RATE-CTR).       DTSCS76
01726                                                                   DTSCS76
01727 *****MOVE MRTE-UI-RATE-TYPE TO R112-UI-RATE-TYPE (WRK-RATE-CTR).  DTSCS76
01728                                                                   DTSCS76
01729      MOVE MRTE-UI-RATE TO R112-UI-RATE (WRK-RATE-CTR).            DTSCS76
01730                                                                   DTSCS76
01731      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS76
01732  P8941-EXIT.                                                      DTSCS76
01733      EXIT.                                                        DTSCS76
01734                                                                   DTSCS76
01735                                                                   DTSCS76
01736                                                                   DTSCS76
01737 *****                                                             DTSCS76
01738 *   MACIR903   REQUEST FOR FEDERAL ID (UI-15) REPORT RECORDS.     DTSCS76
01739 *****                                                             DTSCS76
01740                                                                   DTSCS76
01741  P8950-R903-RECORD.                                               DTSCS76
01742      MOVE MAP-RESPONSIBLE-OP-ID TO R903-OP-ID.                    DTSCS76
01743                                                                   DTSCS76
01744      MOVE WRK-EMP-NO TO R903-EMP-NO.                              DTSCS76
01745                                                                   DTSCS76
01746      MOVE LCCM-CURR-MAIL-DATE TO R903-MAIL-DATE.                  DTSCS76
01747                                                                   DTSCS76
01748      MOVE WRK-MAILING-ADDRESS TO R903-FMT-ADDR.                   DTSCS76
01749                                                                   DTSCS76
01750      MOVE WRK-ZIP TO R903-ZIP.                                    DTSCS76
01751                                                                   DTSCS76
01752 *****MOVE WRK-DELIV-POINT TO R903-DELIV-POINT.                    DTSCS76
01753                                                                   DTSCS76
01754 *****MOVE WRK-CHECK-DIGIT TO R903-CHECK-DIGIT.                    DTSCS76
01755                                                                   DTSCS76
01756      MOVE WRK-ADVANCED-BARCODE TO R903-ADVANCED-BARCODE.          DTSCS76
01757                                                                   DTSCS76
01758      MOVE LENGTH OF R903-REC TO R903-LENGTH.                      DTSCS76
01759                                                                   DTSCS76
01760      MOVE R903-REC TO RSKL-REC.                                   DTSCS76
01761                                                                   DTSCS76
01762      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS76
01763  P8950-EXIT.                                                      DTSCS76
01764      EXIT.                                                        DTSCS76
01765                                                                   DTSCS76
01766                                                                   DTSCS76
01767                                                                   DTSCS76
01768  P8960-R432-RECORD.                                               DTSCS76
01769      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCS76
01770                                                                   DTSCS76
01771      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS76
01772                                                                   DTSCS76
01773      SET MQTR-QTR-88 TO TRUE.                                     DTSCS76
01774                                                                   DTSCS76
01775      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
01776                                                                   DTSCS76
01777      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS76
01778                                                                   DTSCS76
01779      PERFORM P8961-PROCESS-EACH-MQTR THRU P8961-EXIT              DTSCS76
01780          UNTIL L810-NO-REC-88.                                    DTSCS76
01781  P8960-EXIT.                                                      DTSCS76
01782      EXIT.                                                        DTSCS76
01783                                                                   DTSCS76
01784                                                                   DTSCS76
01785                                                                   DTSCS76
01786  P8961-PROCESS-EACH-MQTR.                                         DTSCS76
01787      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS76
01788                                                                   DTSCS76
01789      MOVE 'N' TO BALANCE-DUE-IND.                                 DTSCS76
01790                                                                   DTSCS76
01791      PERFORM                                                      DTSCS76
01792        VARYING MQTR-ACCT-IDX FROM 1 BY 1                          DTSCS76
01793        UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT                        DTSCS76
01794          IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0                 DTSCS76
01795              MOVE 'Y' TO BALANCE-DUE-IND                          DTSCS76
01796          END-IF                                                   DTSCS76
01797      END-PERFORM.                                                 DTSCS76
01798                                                                   DTSCS76
01799      IF BALANCE-DUE-IND = 'N'                                     DTSCS76
01800          NEXT SENTENCE                                            DTSCS76
01801      ELSE                                                         DTSCS76
01802          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS76
01803          PERFORM P8965-READ-MRPT THRU P8965-EXIT                  DTSCS76
01804          MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA                      DTSCS76
01805          PERFORM S810-START-BROWSE THRU S810-EXIT                 DTSCS76
01806          IF L810-NO-REC-88                                        DTSCS76
01807              GO TO P8961-EXIT.                                    DTSCS76
01808                                                                   DTSCS76
01809      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS76
01810  P8961-EXIT.                                                      DTSCS76
01811      EXIT.                                                        DTSCS76
01812                                                                   DTSCS76
01813                                                                   DTSCS76
01814                                                                   DTSCS76
01815  P8965-READ-MRPT.                                                 DTSCS76
01816      MOVE LOW-VALUES TO MRPT-KEY-AREA.                            DTSCS76
01817                                                                   DTSCS76
01818      MOVE MQTR-EMP-NO TO MRPT-EMP-NO.                             DTSCS76
01819                                                                   DTSCS76
01820      SET MRPT-RPT-88 TO TRUE.                                     DTSCS76
01821                                                                   DTSCS76
01822      MOVE MQTR-YRQ TO MRPT-YRQ.                                   DTSCS76
01823                                                                   DTSCS76
01824      MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
01825                                                                   DTSCS76
01826      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS76
01827                                                                   DTSCS76
01828      PERFORM                                                      DTSCS76
01829        UNTIL L810-NO-REC-88                                       DTSCS76
01830         MOVE MSKL-REC TO MRPT-REC                                 DTSCS76
01831         IF MRPT-YRQ NOT = MQTR-YRQ                                DTSCS76
01832            PERFORM S810-END-BROWSE THRU S810-EXIT                 DTSCS76
01833            SET L810-NO-REC-88 TO TRUE                             DTSCS76
01834         ELSE                                                      DTSCS76
01835            PERFORM P8966-R432 THRU P8966-EXIT                     DTSCS76
01836            PERFORM S810-READ-NEXT THRU S810-EXIT                  DTSCS76
01837         END-IF                                                    DTSCS76
01838      END-PERFORM.                                                 DTSCS76
01839  P8965-EXIT.                                                      DTSCS76
01840      EXIT.                                                        DTSCS76
01841                                                                   DTSCS76
01842                                                                   DTSCS76
01843                                                                   DTSCS76
01844 *****                                                             DTSCS76
01845 *    MACIR432    ACCOUNTS RECEIVABLE AUDIT TRAIL REPORT RECORD.   DTSCS76
01846 *****                                                             DTSCS76
01847                                                                   DTSCS76
01848  P8966-R432.                                                      DTSCS76
01849      MOVE MRPT-BATCH-NO TO R432-BATCH-NO.                         DTSCS76
01850                                                                   DTSCS76
01851      MOVE MRPT-ITEM-NO TO R432-ITEM-NO.                           DTSCS76
01852                                                                   DTSCS76
01853      MOVE MRPT-EMP-NO TO R432-EMP-NO.                             DTSCS76
01854                                                                   DTSCS76
01855      MOVE MRPT-YRQ TO R432-YRQ.                                   DTSCS76
01856                                                                   DTSCS76
01857      MOVE MRPT-RPT-TYPE TO R432-RPT-TYPE.                         DTSCS76
01858                                                                   DTSCS76
01859      MOVE LENGTH OF R432-REC TO R432-LENGTH.                      DTSCS76
01860                                                                   DTSCS76
01861      MOVE R432-REC TO RSKL-REC.                                   DTSCS76
01862                                                                   DTSCS76
01863      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS76
01864  P8966-EXIT.                                                      DTSCS76
01865      EXIT.                                                        DTSCS76
01866                                                                   DTSCS76
01867                                                                   DTSCS76
01868  P8970-T011-RECORD.                                               DTSCS76
01869      MOVE WRK-EMP-NO TO T011-EMP-NO.                              DTSCS76
01870                                                                   DTSCS76
01871      MOVE LCCM-OP-ID TO T011-OP-ID                                DTSCS76
01872                         T011-RESP-OP-ID.                          DTSCS76
01873                                                                   DTSCS76
01874      MOVE WRK-SCR-ID TO T011-SCR-ID.                              DTSCS76
01875                                                                   DTSCS76
01876      MOVE LCCM-TASK-START-DATE TO T011-SYS-DATE.                  DTSCS76
01877                                                                   DTSCS76
01878      MOVE LCCM-TASK-START-TIME TO T011-SYS-TIME.                  DTSCS76
01879                                                                   DTSCS76
01880      SET  T011-STMT-OF-ACCT TO TRUE.                              DTSCS76
01881                                                                   DTSCS76
01882      MOVE L016-YRQ TO T011-START-YRQ.                             DTSCS76
01883                                                                   DTSCS76
01884      MOVE MAP-STMT-TO-YRQ-AREA TO L016-S-YRQ-AREA.                DTSCS76
01885                                                                   DTSCS76
01886      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
01887                                                                   DTSCS76
01888      IF L016-VALID                                                DTSCS76
01889         MOVE L016-YRQ TO T011-END-YRQ                             DTSCS76
01890      ELSE                                                         DTSCS76
01891         MOVE T011-START-YRQ TO T011-END-YRQ.                      DTSCS76
01892                                                                   DTSCS76
01893      MOVE LENGTH OF T011-REC TO T011-LENGTH                       DTSCS76
01894      MOVE +0 TO T011-ESTB-ABSTIME.                                DTSCS76
01895      MOVE LCCM-TASK-START-ABSTIME TO T011-ESTB-ABSTIME.           DTSCS76
01896      MOVE T011-REC TO RSKL-REC                                    DTSCS76
01897      PERFORM S825-WRITE THRU S825-EXIT.                           DTSCS76
01898                                                                   DTSCS76
01899                                                                   DTSCS76
01900  P8970-EXIT.                                                      DTSCS76
01901      EXIT.                                                        DTSCS76
01902                                                                   DTSCS76
01903                                                                   DTSCS76
01904                                                                   DTSCS76
01905  P8980-R751-RECORD.                                               DTSCS76
01906      MOVE WRK-EMP-NO         TO R751-EMP-NO.                      DTSCS76
01907      MOVE MPRF-PRIMARY-NAME  TO R751-EMP-PRIMARY-NAME.            DTSCS76
01908                                                                   DTSCS76
01909      MOVE MAP-SSN-AREA TO L020-S-SSN-AREA.                        DTSCS76
01910      PERFORM S020-SCREEN-SSN THRU S020-EXIT.                      DTSCS76
01911      MOVE L020-SSN  TO R751-SSN.                                  DTSCS76
01912                                                                   DTSCS76
01913      MOVE MAP-CLAIMANT-NAME TO R751-CLAIMANT-NAME.                DTSCS76
01914                                                                   DTSCS76
01915      MOVE LCCM-CURR-MAIL-DATE TO R751-MAIL-DATE.                  DTSCS76
01916                                                                   DTSCS76
01917      MOVE LENGTH OF R751-REC TO R751-LENGTH.                      DTSCS76
01918                                                                   DTSCS76
01919      IF MAP-WR-YRQ1-YR GREATER SPACES                             DTSCS76
01920         MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA                  DTSCS76
01921         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS76
01922         MOVE L016-YRQ TO R751-YRQ                                 DTSCS76
01923         MOVE R751-REC TO RSKL-REC                                 DTSCS76
01924         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS76
01925                                                                   DTSCS76
01926      IF MAP-WR-YRQ2-YR GREATER SPACES                             DTSCS76
01927         MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA                  DTSCS76
01928         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS76
01929         MOVE L016-YRQ TO R751-YRQ                                 DTSCS76
01930         MOVE R751-REC TO RSKL-REC                                 DTSCS76
01931         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS76
01932                                                                   DTSCS76
01933      IF MAP-WR-YRQ3-YR GREATER SPACES                             DTSCS76
01934         MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA                  DTSCS76
01935         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS76
01936         MOVE L016-YRQ TO R751-YRQ                                 DTSCS76
01937         MOVE R751-REC TO RSKL-REC                                 DTSCS76
01938         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS76
01939                                                                   DTSCS76
01940      IF MAP-WR-YRQ4-YR GREATER SPACES                             DTSCS76
01941         MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA                  DTSCS76
01942         PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT               DTSCS76
01943         MOVE L016-YRQ TO R751-YRQ                                 DTSCS76
01944         MOVE R751-REC TO RSKL-REC                                 DTSCS76
01945         PERFORM S825-WRITE THRU S825-EXIT.                        DTSCS76
01946                                                                   DTSCS76
01947  P8980-EXIT.                                                      DTSCS76
01948      EXIT.                                                        DTSCS76
01949 /*****************************************************************DTSCS76
01950 * LINKS TO UTILITY MODULES                                        DTSCS76
01951 ******************************************************************DTSCS76
01952                                                                   DTSCS76
01953  S001-FROM-FED-8.                                                 DTSCS76
01954      SET L001-FROM-FED-8 TO TRUE.                                 DTSCS76
01955      GO TO S001-LINK.                                             DTSCS76
01956                                                                   DTSCS76
01957  S001-FROM-ABS-DAY.                                               DTSCS76
01958      SET L001-FROM-ABS-DAY TO TRUE.                               DTSCS76
01959      GO TO S001-LINK.                                             DTSCS76
01960                                                                   DTSCS76
01961  S001-LINK.                                                       DTSCS76
01962      EXEC CICS LINK                                               DTSCS76
01963          PROGRAM  ('DTSCU001')                                    DTSCS76
01964          COMMAREA (L001-COMM-AREA)                                DTSCS76
01965      END-EXEC.                                                    DTSCS76
01966  S001-EXIT.                                                       DTSCS76
01967      EXIT.                                                        DTSCS76
01968                                                                   DTSCS76
01969                                                                   DTSCS76
01970                                                                   DTSCS76
01971  S004-FROM-5.                                                     DTSCS76
01972      SET L004-FROM-5 TO TRUE.                                     DTSCS76
01973      GO TO S004-LINK.                                             DTSCS76
01974                                                                   DTSCS76
01975  S004-FROM-DATE.                                                  DTSCS76
01976      SET L004-FROM-DATE TO TRUE.                                  DTSCS76
01977      GO TO S004-LINK.                                             DTSCS76
01978                                                                   DTSCS76
01979  S004-FROM-ABS.                                                   DTSCS76
01980      SET L004-FROM-ABS TO TRUE.                                   DTSCS76
01981      GO TO S004-LINK.                                             DTSCS76
01982                                                                   DTSCS76
01983  S004-LINK.                                                       DTSCS76
01984      EXEC CICS LINK                                               DTSCS76
01985          PROGRAM  ('DTSCU004')                                    DTSCS76
01986          COMMAREA (L004-COMM-AREA)                                DTSCS76
01987      END-EXEC.                                                    DTSCS76
01988  S004-EXIT.                                                       DTSCS76
01989      EXIT.                                                        DTSCS76
01990                                                                   DTSCS76
01991                                                                   DTSCS76
01992                                                                   DTSCS76
01993  S006-LINK.                                                       DTSCS76
01994      EXEC CICS LINK                                               DTSCS76
01995          PROGRAM ('DTSCU006')                                     DTSCS76
01996          COMMAREA (L006-COMM-AREA)                                DTSCS76
01997      END-EXEC.                                                    DTSCS76
01998  S006-EXIT.                                                       DTSCS76
01999      EXIT.                                                        DTSCS76
02000                                                                   DTSCS76
02001                                                                   DTSCS76
02002                                                                   DTSCS76
02003  S013-ADDR-NUM.                                                   DTSCS76
02004      MOVE +1 TO L013-MIN-CNT.                                     DTSCS76
02005      MOVE +999 TO L013-MAX-CNT.                                   DTSCS76
02006      GO TO S013-COUNT-FROM-SCREEN.                                DTSCS76
02007                                                                   DTSCS76
02008  S013-COPY-CNT.                                                   DTSCS76
02009      MOVE +1 TO L013-MIN-CNT.                                     DTSCS76
02010      MOVE +99 TO L013-MAX-CNT.                                    DTSCS76
02011      GO TO S013-COUNT-FROM-SCREEN.                                DTSCS76
02012                                                                   DTSCS76
02013  S013-COUNT-FROM-SCREEN.                                          DTSCS76
02014      EXEC CICS LINK                                               DTSCS76
02015          PROGRAM('DTSCU013')                                      DTSCS76
02016          COMMAREA(L013-COMM-AREA)                                 DTSCS76
02017      END-EXEC.                                                    DTSCS76
02018  S013-EXIT.                                                       DTSCS76
02019      EXIT.                                                        DTSCS76
02020                                                                   DTSCS76
02021                                                                   DTSCS76
02022                                                                   DTSCS76
02023  S015-DATE-FROM-SCREEN.                                           DTSCS76
02024      EXEC CICS LINK                                               DTSCS76
02025          PROGRAM('DTSCU015')                                      DTSCS76
02026          COMMAREA(L015-COMM-AREA)                                 DTSCS76
02027      END-EXEC.                                                    DTSCS76
02028  S015-EXIT.                                                       DTSCS76
02029      EXIT.                                                        DTSCS76
02030                                                                   DTSCS76
02031                                                                   DTSCS76
02032                                                                   DTSCS76
02033  S016-YRQ-FROM-SCREEN.                                            DTSCS76
02034      EXEC CICS LINK                                               DTSCS76
02035          PROGRAM('DTSCU016')                                      DTSCS76
02036          COMMAREA(L016-COMM-AREA)                                 DTSCS76
02037      END-EXEC.                                                    DTSCS76
02038  S016-EXIT.                                                       DTSCS76
02039      EXIT.                                                        DTSCS76
02040                                                                   DTSCS76
02041                                                                   DTSCS76
02042                                                                   DTSCS76
02043  S018-EMP-NO-FROM-SCREEN.                                         DTSCS76
02044      EXEC CICS LINK                                               DTSCS76
02045          PROGRAM('DTSCU018')                                      DTSCS76
02046          COMMAREA(L018-COMM-AREA)                                 DTSCS76
02047      END-EXEC.                                                    DTSCS76
02048  S018-EXIT.                                                       DTSCS76
02049      EXIT.                                                        DTSCS76
02050                                                                   DTSCS76
02051                                                                   DTSCS76
02052  S020-SCREEN-SSN.                                                 DTSCS76
02053      EXEC CICS LINK                                               DTSCS76
02054          PROGRAM  ('DTSCU020')                                    DTSCS76
02055          COMMAREA (L020-COMM-AREA)                                DTSCS76
02056      END-EXEC.                                                    DTSCS76
02057  S020-EXIT.                                                       DTSCS76
02058      EXIT.                                                        DTSCS76
02059                                                                   DTSCS76
02060                                                                   DTSCS76
02061  S081-CLAIMANT-NAME-LOOKUP.                                       DTSCS76
02062      EXEC CICS LINK                                               DTSCS76
02063          PROGRAM('DTSCU081')                                      DTSCS76
02064          COMMAREA(L081-COMM-AREA)                                 DTSCS76
02065      END-EXEC.                                                    DTSCS76
02066                                                                   DTSCS76
02067      IF L081-FILE-CLOSED                                          DTSCS76
02068          MOVE L081-MSG-AREA TO LCCM-MSG-AREA                      DTSCS76
02069          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS76
02070          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
02071          GO TO MAINLINE-EXIT.                                     DTSCS76
02072  S081-EXIT.                                                       DTSCS76
02073      EXIT.                                                        DTSCS76
02074      SKIP3                                                        DTSCS76
02075                                                                   DTSCS76
02076  S082-OP-ID-LOOKUP.                                               DTSCS76
02077      EXEC CICS LINK                                               DTSCS76
02078          PROGRAM('DTSCU082')                                      DTSCS76
02079          COMMAREA(L082-COMM-AREA)                                 DTSCS76
02080      END-EXEC.                                                    DTSCS76
02081                                                                   DTSCS76
02082      IF L082-FILE-CLOSED                                          DTSCS76
02083          MOVE L082-MSG-AREA TO LCCM-MSG-AREA                      DTSCS76
02084          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS76
02085          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
02086          GO TO MAINLINE-EXIT.                                     DTSCS76
02087  S082-EXIT.                                                       DTSCS76
02088      EXIT.                                                        DTSCS76
02089                                                                   DTSCS76
02090                                                                   DTSCS76
02091                                                                   DTSCS76
02092  S111-ADDR-LOOKUP.                                                DTSCS76
02093      EXEC CICS LINK                                               DTSCS76
02094          PROGRAM('DTSCU111')                                      DTSCS76
02095          COMMAREA(L111-COMM-AREA)                                 DTSCS76
02096      END-EXEC.                                                    DTSCS76
02097                                                                   DTSCS76
02098      IF L111-FILE-CLOSED-88                                       DTSCS76
02099          MOVE L111-MSG-AREA TO LCCM-MSG-AREA                      DTSCS76
02100          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS76
02101          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
02102          GO TO MAINLINE-EXIT.                                     DTSCS76
02103  S111-EXIT.                                                       DTSCS76
02104      EXIT.                                                        DTSCS76
02105                                                                   DTSCS76
02106                                                                   DTSCS76
02107                                                                   DTSCS76
02108  S112-ADDR-FORMAT.                                                DTSCS76
02109      EXEC CICS LINK                                               DTSCS76
02110          PROGRAM('DTSCU112')                                      DTSCS76
02111          COMMAREA(L112-COMM-AREA)                                 DTSCS76
02112      END-EXEC.                                                    DTSCS76
02113  S112-EXIT.                                                       DTSCS76
02114      EXIT.                                                        DTSCS76
02115                                                                   DTSCS76
02116                                                                   DTSCS76
02117                                                                   DTSCS76
02118  S381-DETERM-LIABILITY.                                           DTSCS76
02119      EXEC CICS LINK                                               DTSCS76
02120          PROGRAM  ('DTSCU381')                                    DTSCS76
02121          COMMAREA (L381-COMM-AREA)                                DTSCS76
02122      END-EXEC.                                                    DTSCS76
02123                                                                   DTSCS76
02124      IF L381-FILE-CLOSED-88                                       DTSCS76
02125          MOVE L381-MSG-AREA TO LCCM-MSG-AREA                      DTSCS76
02126          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS76
02127          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
02128          GO TO MAINLINE-EXIT.                                     DTSCS76
02129                                                                   DTSCS76
02130  S381-EXIT.                                                       DTSCS76
02131      EXIT.                                                        DTSCS76
02132                                                                   DTSCS76
02133  S410-FILING-SCHEDULE.                                            DTSCS76
02134                                                                   DTSCS76
02135      EXEC CICS LINK                                               DTSCS76
02136          PROGRAM('DTSCU410')                                      DTSCS76
02137          COMMAREA(L410-COMM-AREA)                                 DTSCS76
02138      END-EXEC.                                                    DTSCS76
02139                                                                   DTSCS76
02140  S410-EXIT.                                                       DTSCS76
02141      EXIT.                                                        DTSCS76
02142                                                                   DTSCS76
02143  S415-HOUSEHOLD-DATES.                                            DTSCS76
02144                                                                   DTSCS76
02145      EXEC CICS LINK                                               DTSCS76
02146          PROGRAM('DTSCU415')                                      DTSCS76
02147          COMMAREA(L415-COMM-AREA)                                 DTSCS76
02148      END-EXEC.                                                    DTSCS76
02149                                                                   DTSCS76
02150  S415-EXIT.                                                       DTSCS76
02151      EXIT.                                                        DTSCS76
02152                                                                   DTSCS76
02153  S803-REQ-SCR-ID-EDIT.                                            DTSCS76
02154      EXEC CICS LINK                                               DTSCS76
02155          PROGRAM ('DTSCU803')                                     DTSCS76
02156          COMMAREA (DFHCOMMAREA)                                   DTSCS76
02157      END-EXEC.                                                    DTSCS76
02158  S803-EXIT.                                                       DTSCS76
02159      EXIT.                                                        DTSCS76
02160                                                                   DTSCS76
02161                                                                   DTSCS76
02162                                                                   DTSCS76
02163  S804-INVALID-KEY.                                                DTSCS76
02164      EXEC CICS LINK                                               DTSCS76
02165          PROGRAM ('DTSCU804')                                     DTSCS76
02166          COMMAREA (DFHCOMMAREA)                                   DTSCS76
02167      END-EXEC.                                                    DTSCS76
02168  S804-EXIT.                                                       DTSCS76
02169      EXIT.                                                        DTSCS76
02170                                                                   DTSCS76
02171                                                                   DTSCS76
02172                                                                   DTSCS76
02173  S805-MSG-AREA.                                                   DTSCS76
02174      MOVE LCCM-MSG-AREA TO L805-MSG-AREA                          DTSCS76
02175                                                                   DTSCS76
02176      EXEC CICS LINK                                               DTSCS76
02177          PROGRAM ('DTSCU805')                                     DTSCS76
02178          COMMAREA (L805-COMM-AREA)                                DTSCS76
02179      END-EXEC.                                                    DTSCS76
02180                                                                   DTSCS76
02181      MOVE L805-S-MSG-AREA TO MAP-MSG-AREA.                        DTSCS76
02182  S805-EXIT.                                                       DTSCS76
02183      EXIT.                                                        DTSCS76
02184                                                                   DTSCS76
02185                                                                   DTSCS76
02186                                                                   DTSCS76
02187  S810-READ.                                                       DTSCS76
02188      SET L810-READ-88 TO TRUE.                                    DTSCS76
02189      GO TO S810-IO.                                               DTSCS76
02190                                                                   DTSCS76
02191  S810-START-BROWSE.                                               DTSCS76
02192      SET L810-START-BROWSE-88 TO TRUE.                            DTSCS76
02193      GO TO S810-IO.                                               DTSCS76
02194                                                                   DTSCS76
02195  S810-READ-NEXT.                                                  DTSCS76
02196      SET L810-READ-NEXT-88 TO TRUE.                               DTSCS76
02197      GO TO S810-IO.                                               DTSCS76
02198                                                                   DTSCS76
02199  S810-READ-PREV.                                                  DTSCS76
02200      SET L810-READ-PREV-88 TO TRUE.                               DTSCS76
02201      GO TO S810-IO.                                               DTSCS76
02202                                                                   DTSCS76
02203  S810-END-BROWSE.                                                 DTSCS76
02204      SET L810-END-BROWSE-88 TO TRUE.                              DTSCS76
02205      GO TO S810-IO.                                               DTSCS76
02206                                                                   DTSCS76
02207  S810-COUNT.                                                      DTSCS76
02208      SET L810-COUNT-88 TO TRUE.                                   DTSCS76
02209      GO TO S810-IO.                                               DTSCS76
02210                                                                   DTSCS76
02211 *S810-REWRITE.                                                    DTSCS76
02212 *****SET L810-REWRITE-88 TO TRUE.                                 DTSCS76
02213 *****GO TO S810-IO.                                               DTSCS76
02214 *****                                                             DTSCS76
02215 *S810-WRITE.                                                      DTSCS76
02216 *****SET L810-WRITE-88 TO TRUE.                                   DTSCS76
02217 *****GO TO S810-IO.                                               DTSCS76
02218 *****                                                             DTSCS76
02219 *S810-DELETE.                                                     DTSCS76
02220 *****SET L810-DELETE-88 TO TRUE.                                  DTSCS76
02221 *****GO TO S810-IO.                                               DTSCS76
02222                                                                   DTSCS76
02223  S810-IO.                                                         DTSCS76
02224                                                                   DTSCS76
02225      EXEC CICS LINK                                               DTSCS76
02226          PROGRAM ('DTSCU810')                                     DTSCS76
02227          COMMAREA (L810-COMM-AREA)                                DTSCS76
02228      END-EXEC.                                                    DTSCS76
02229                                                                   DTSCS76
02230      IF L810-FILE-CLOSED-88                                       DTSCS76
02231          MOVE L810-MSG-AREA TO LCCM-MSG-AREA                      DTSCS76
02232          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS76
02233          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
02234          GO TO MAINLINE-EXIT.                                     DTSCS76
02235                                                                   DTSCS76
02236  S810-EXIT.                                                       DTSCS76
02237      EXIT.                                                        DTSCS76
02238                                                                   DTSCS76
02239                                                                   DTSCS76
02240                                                                   DTSCS76
02241  S825-WRITE.                                                      DTSCS76
02242      SET L825-WRITE-88 TO TRUE.                                   DTSCS76
02243      GO TO S825-O.                                                DTSCS76
02244                                                                   DTSCS76
02245  S825-O.                                                          DTSCS76
02246                                                                   DTSCS76
02247      EXEC CICS LINK                                               DTSCS76
02248          PROGRAM ('DTSCU825')                                     DTSCS76
02249          COMMAREA (L825-COMM-AREA)                                DTSCS76
02250      END-EXEC.                                                    DTSCS76
02251                                                                   DTSCS76
02252      IF L825-FILE-CLOSED-88                                       DTSCS76
02253          MOVE L825-MSG-AREA TO LCCM-MSG-AREA                      DTSCS76
02254          SET LCCM-REQ-SCR-SF-88 TO TRUE                           DTSCS76
02255          SET LCCM-LINK-SCREEN-88 TO TRUE                          DTSCS76
02256          GO TO MAINLINE-EXIT.                                     DTSCS76
02257  S825-EXIT.                                                       DTSCS76
02258      EXIT.                                                        DTSCS76
02259                                                                   DTSCS76
02260                                                                   DTSCS76
02261                                                                   DTSCS76
02262  S851-SCREEN-PROCESSING.                                          DTSCS76
02263      EXEC CICS LINK                                               DTSCS76
02264          PROGRAM ('DTSCU851')                                     DTSCS76
02265          COMMAREA (L851-COMM-AREA)                                DTSCS76
02266      END-EXEC.                                                    DTSCS76
02267  S851-EXIT.                                                       DTSCS76
02268      EXIT.                                                        DTSCS76
02269                                                                   DTSCS76
02270                                                                   DTSCS76
02271                                                                   DTSCS76
02272  S899-ABEND.                                                      DTSCS76
02273      EXEC CICS ABEND                                              DTSCS76
02274          ABCODE(WRK-ABEND-CD)                                     DTSCS76
02275      END-EXEC.                                                    DTSCS76
02276  S899-EXIT.                                                       DTSCS76
02277      EXIT.                                                        DTSCS76
02278 /*****************************************************************DTSCS76
02279 *    EDIT THE INFORMATION ON THE SCREEN.                         *DTSCS76
02280 ******************************************************************DTSCS76
02281                                                                   DTSCS76
02282  S1000-SCREEN-EDITS.                                              DTSCS76
02283 *****SET WRK-5E-REQ-NO-88 TO TRUE.                                DTSCS76
02284                                                                   DTSCS76
02285      PERFORM S1110-READ-MPRF THRU S1110-EXIT.                     DTSCS76
02286                                                                   DTSCS76
02287      IF LCCM-MSG                                                  DTSCS76
02288          GO TO S1000-EXIT.                                        DTSCS76
02289                                                                   DTSCS76
02290                                                                   DTSCS76
02291      MOVE WRK-EMP-NO TO LCCM-EMP-NO.                              DTSCS76
02292                                                                   DTSCS76
02293                                                                   DTSCS76
02294      PERFORM S1300-MAILING-LABELS THRU S1300-EXIT.                DTSCS76
02295                                                                   DTSCS76
02296 *****PERFORM S1350-ELF-IND THRU S1350-EXIT.                       DTSCS76
02297                                                                   DTSCS76
02298 *****PERFORM S1375-ELF-LABELS THRU S1375-EXIT.                    DTSCS76
02299                                                                   DTSCS76
02300      PERFORM S1400-FROM-TO-YRQ THRU S1400-EXIT.                   DTSCS76
02301                                                                   DTSCS76
02302      PERFORM S1500-FORCE-PRINT THRU S1500-EXIT.                   DTSCS76
02303                                                                   DTSCS76
02304      PERFORM S1550-WAIVE-EXT-DATE THRU S1550-EXIT.                DTSCS76
02305                                                                   DTSCS76
02306 *****PERFORM S1600-OL-FROM-TO-YRQ THRU S1600-EXIT.                DTSCS76
02307                                                                   DTSCS76
02308 *****PERFORM S1700-OL-FORCE-PRINT THRU S1700-EXIT.                DTSCS76
02309                                                                   DTSCS76
02310 *****PERFORM S1750-OL-PRINTER-ID  THRU S1750-EXIT.                DTSCS76
02311                                                                   DTSCS76
02312 *****PERFORM S1800-NOTICE-OF-COVERAGE THRU S1800-EXIT.            DTSCS76
02313                                                                   DTSCS76
02314      PERFORM S1900-NOTICE-OF-SUBJECT THRU S1900-EXIT.             DTSCS76
02315                                                                   DTSCS76
02316      PERFORM S2000-REQUEST-FOR-FEIN THRU S2000-EXIT.              DTSCS76
02317                                                                   DTSCS76
02318      PERFORM S2100-ADDR-TYPE THRU S2100-EXIT.                     DTSCS76
02319                                                                   DTSCS76
02320      PERFORM S2200-ADDR-NBR THRU S2200-EXIT.                      DTSCS76
02321                                                                   DTSCS76
02322      PERFORM S2300-AR-AUDIT-TRAIL THRU S2300-EXIT.                DTSCS76
02323                                                                   DTSCS76
02324      PERFORM S2400-STMT-FROM-TO-YRQ THRU S2400-EXIT.              DTSCS76
02325                                                                   DTSCS76
02326      PERFORM S2500-RESPONSIBLE-OP-ID THRU S2500-EXIT.             DTSCS76
02327                                                                   DTSCS76
02328      PERFORM S2600-WAGE-REQUEST      THRU S2600-EXIT.             DTSCS76
02329                                                                   DTSCS76
02330      IF LCCM-MSG                                                  DTSCS76
02331          GO TO S1000-EXIT.                                        DTSCS76
02332                                                                   DTSCS76
02333                                                                   DTSCS76
02334      IF WRK-FROM-YRQ > +0                                         DTSCS76
02335          PERFORM S3000-RPTS-EDITS THRU S3000-EXIT.                DTSCS76
02336                                                                   DTSCS76
02337      IF LCCM-MSG                                                  DTSCS76
02338          GO TO S1000-EXIT.                                        DTSCS76
02339                                                                   DTSCS76
02340                                                                   DTSCS76
02341      IF WRK-WAIVE-EXT-DATE > +0                                   DTSCS76
02342          PERFORM S4000-WAIVE-EDITS THRU S4000-EXIT.               DTSCS76
02343                                                                   DTSCS76
02344      IF LCCM-MSG                                                  DTSCS76
02345          GO TO S1000-EXIT.                                        DTSCS76
02346                                                                   DTSCS76
02347                                                                   DTSCS76
02348 *****IF WRK-OL-FROM-YRQ > +0                                      DTSCS76
02349 *********SET WRK-OL-REQ-YES-88 TO TRUE                            DTSCS76
02350 *********PERFORM S3000-RPTS-EDITS THRU S3000-EXIT.                DTSCS76
02351                                                                   DTSCS76
02352 *****IF LCCM-MSG                                                  DTSCS76
02353 *********GO TO S1000-EXIT.                                        DTSCS76
02354                                                                   DTSCS76
02355 *****IF WRK-5E-WAIVE-EXT-DATE > +0                                DTSCS76
02356 *********PERFORM S4500-5E-WAIVE-EDITS THRU S4500-EXIT.            DTSCS76
02357                                                                   DTSCS76
02358 *****IF LCCM-MSG                                                  DTSCS76
02359 *********GO TO S1000-EXIT.                                        DTSCS76
02360                                                                   DTSCS76
02361                                                                   DTSCS76
02362      IF MAP-MAILING-LABELS = SPACES                               DTSCS76
02363 ********AND MAP-ELF-IND-NO                                        DTSCS76
02364 ********AND MAP-ELF-LABELS = SPACES                               DTSCS76
02365         AND WRK-FROM-YRQ = 0                                      DTSCS76
02366         AND WRK-TO-YRQ = 0                                        DTSCS76
02367 ********AND WRK-OL-FROM-YRQ = 0                                   DTSCS76
02368 ********AND WRK-OL-TO-YRQ = 0                                     DTSCS76
02369 ********AND MAP-NOTICE-OF-COVERAGE = SPACES                       DTSCS76
02370         AND MAP-NOTICE-OF-SUBJECT-NO                              DTSCS76
02371         AND MAP-REQUEST-FOR-FEIN-NO                               DTSCS76
02372         AND MAP-AR-AUDIT-TRAIL-NO                                 DTSCS76
02373         AND WRK-STMT-FROM-YRQ = 0                                 DTSCS76
02374         AND WRK-STMT-TO-YRQ = 0                                   DTSCS76
02375         AND MAP-SSN-1 NOT GREATER SPACES                          DTSCS76
02376            MOVE MSG-E764-AREA TO LCCM-MSG-AREA.                   DTSCS76
02377                                                                   DTSCS76
02378  S1000-EXIT.                                                      DTSCS76
02379      EXIT.                                                        DTSCS76
02380      EJECT                                                        DTSCS76
02381  S1100-EDIT-KEY.                                                  DTSCS76
02382      PERFORM S1101-EMP-NO THRU S1101-EXIT.                        DTSCS76
02383  S1100-EXIT.                                                      DTSCS76
02384      EXIT.                                                        DTSCS76
02385 /*****************************************************************DTSCS76
02386 *                                                                 DTSCS76
02387 ******************************************************************DTSCS76
02388  S1101-EMP-NO.                                                    DTSCS76
02389      MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA.                  DTSCS76
02390                                                                   DTSCS76
02391      PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT.              DTSCS76
02392                                                                   DTSCS76
02393      IF L018-NO-ENTRY                                             DTSCS76
02394         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS76
02395         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS76
02396         GO TO S1101-EXIT.                                         DTSCS76
02397                                                                   DTSCS76
02398      IF L018-NOT-VALID                                            DTSCS76
02399         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
02400         PERFORM S1199-ERROR THRU S1199-EXIT                       DTSCS76
02401         GO TO S1101-EXIT.                                         DTSCS76
02402                                                                   DTSCS76
02403      MOVE L018-EMP-NO TO WRK-EMP-NO.                              DTSCS76
02404  S1101-EXIT.                                                      DTSCS76
02405      EXIT.                                                        DTSCS76
02406                                                                   DTSCS76
02407                                                                   DTSCS76
02408                                                                   DTSCS76
02409  S1110-READ-MPRF.                                                 DTSCS76
02410      MOVE LOW-VALUES TO MPRF-KEY-AREA.                            DTSCS76
02411                                                                   DTSCS76
02412      MOVE WRK-EMP-NO TO MPRF-EMP-NO.                              DTSCS76
02413                                                                   DTSCS76
02414      SET MPRF-PRF-88 TO TRUE.                                     DTSCS76
02415                                                                   DTSCS76
02416      MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
02417                                                                   DTSCS76
02418      PERFORM S810-READ THRU S810-EXIT.                            DTSCS76
02419                                                                   DTSCS76
02420      IF L810-NO-REC-88                                            DTSCS76
02421         SET WRK-MPRF-NO-88 TO TRUE                                DTSCS76
02422      ELSE                                                         DTSCS76
02423          MOVE MSKL-REC TO MPRF-REC                                DTSCS76
02424          SET WRK-MPRF-YES-88 TO TRUE.                             DTSCS76
02425  S1110-EXIT.                                                      DTSCS76
02426      EXIT.                                                        DTSCS76
02427                                                                   DTSCS76
02428                                                                   DTSCS76
02429                                                                   DTSCS76
02430  S1199-ERROR.                                                     DTSCS76
02431      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A            DTSCS76
02432                                         MAP-EMP-NO-2-A.           DTSCS76
02433                                                                   DTSCS76
02434      IF LCCM-NO-MSG                                               DTSCS76
02435         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
02436         MOVE CATB-CURSOR TO MAP-EMP-NO-1-L                        DTSCS76
02437         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02438  S1199-EXIT.                                                      DTSCS76
02439      EXIT.                                                        DTSCS76
02440 /*****************************************************************DTSCS76
02441 *                                                                 DTSCS76
02442 ******************************************************************DTSCS76
02443 *S1200-READ-MELF.                                                 DTSCS76
02444 *****MOVE LOW-VALUES TO MELF-KEY-AREA.                            DTSCS76
02445 *****MOVE WRK-EMP-NO TO MELF-EMP-NO.                              DTSCS76
02446 *****SET MELF-ELF-88 TO TRUE.                                     DTSCS76
02447 *****MOVE MELF-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
02448                                                                   DTSCS76
02449 *****PERFORM S810-READ THRU S810-EXIT.                            DTSCS76
02450 *****IF L810-NO-REC-88                                            DTSCS76
02451 *********SET WRK-MELF-NO-88 TO TRUE                               DTSCS76
02452 *****ELSE                                                         DTSCS76
02453 *********SET WRK-MELF-YES-88 TO TRUE                              DTSCS76
02454 *********MOVE MSKL-REC TO MELF-REC.                               DTSCS76
02455 *S1200-EXIT. EXIT.                                                DTSCS76
02456 /*****************************************************************DTSCS76
02457 *                                                                 DTSCS76
02458 ******************************************************************DTSCS76
02459  S1300-MAILING-LABELS.                                            DTSCS76
02460      MOVE MAP-MAILING-LABELS-AREA TO L013-S-CNT-AREA.             DTSCS76
02461                                                                   DTSCS76
02462      PERFORM S013-COPY-CNT THRU S013-EXIT.                        DTSCS76
02463                                                                   DTSCS76
02464      IF L013-VALID                                                DTSCS76
02465         IF WRK-MPRF-NO-88                                         DTSCS76
02466         AND L013-CNT > 0                                          DTSCS76
02467            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02468            PERFORM S1301-ERROR THRU S1301-EXIT                    DTSCS76
02469         ELSE                                                      DTSCS76
02470            MOVE L013-CNT TO MAP-MAILING-LABELS-N                  DTSCS76
02471      ELSE                                                         DTSCS76
02472      IF L013-NO-ENTRY                                             DTSCS76
02473         MOVE SPACES TO MAP-MAILING-LABELS                         DTSCS76
02474      ELSE                                                         DTSCS76
02475      IF L013-INVALID-NEGATIVE                                     DTSCS76
02476         MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA                DTSCS76
02477         PERFORM S1301-ERROR THRU S1301-EXIT                       DTSCS76
02478      ELSE                                                         DTSCS76
02479      IF L013-EXCEEDS-MIN-MAX                                      DTSCS76
02480          MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS76
02481          PERFORM S1301-ERROR THRU S1301-EXIT                      DTSCS76
02482      ELSE                                                         DTSCS76
02483          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
02484          PERFORM S1301-ERROR THRU S1301-EXIT.                     DTSCS76
02485  S1300-EXIT.                                                      DTSCS76
02486      EXIT.                                                        DTSCS76
02487                                                                   DTSCS76
02488                                                                   DTSCS76
02489                                                                   DTSCS76
02490  S1301-ERROR.                                                     DTSCS76
02491      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-MAILING-LABELS-A.     DTSCS76
02492                                                                   DTSCS76
02493      IF LCCM-NO-MSG                                               DTSCS76
02494         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
02495         MOVE CATB-CURSOR TO MAP-MAILING-LABELS-L                  DTSCS76
02496         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02497  S1301-EXIT.                                                      DTSCS76
02498      EXIT.                                                        DTSCS76
02499 /*****************************************************************DTSCS76
02500 *                                                                 DTSCS76
02501 ******************************************************************DTSCS76
02502 *S1350-ELF-IND.                                                   DTSCS76
02503 *****IF MAP-ELF-IND = LOW-VALUES OR SPACES                        DTSCS76
02504 *********MOVE 'N' TO MAP-ELF-IND                                  DTSCS76
02505 *****ELSE                                                         DTSCS76
02506 *********IF NOT MAP-ELF-IND-VALID                                 DTSCS76
02507 ************MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA             DTSCS76
02508 ************PERFORM S1351-ERROR THRU S1351-EXIT                   DTSCS76
02509 *********ELSE                                                     DTSCS76
02510 ************IF MAP-ELF-IND-YES                                    DTSCS76
02511 ***************IF WRK-MPRF-NO-88                                  DTSCS76
02512 ******************MOVE EMSG-FIELD-NOT-ALLOWED STMT WRK-MSG-AREA   DTSCS76
02513 ******************PERFORM S1351-ERROR THRU S1351-EXIT             DTSCS76
02514 ***************ELSE                                               DTSCS76
02515 ******************IF WRK-MELF-NO-88                               DTSCS76
02516 *********************MOVE MSG-E76A-AREA TO WRK-MSG-AREA           DTSCS76
02517 *********************PERFORM S1351-ERROR THRU S1351-EXIT          DTSCS76
02518 ******************ELSE                                            DTSCS76
02519 *********************IF MELF-MAIL-NOT-DELIV-88                    DTSCS76
02520 *********************MOVE MSG-E76E-AREA TO WRK-MSG-AREA           DTSCS76
02521 *********************PERFORM S1351-ERROR THRU S1351-EXIT.         DTSCS76
02522 *S1350-EXIT.  EXIT.                                               DTSCS76
02523                                                                   DTSCS76
02524 *S1351-ERROR.                                                     DTSCS76
02525 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ELF-IND-A.             DTSCS76
02526 *****IF LCCM-NO-MSG                                               DTSCS76
02527 ********MOVE WRK-MSG-AREA        TO LCCM-MSG-AREA                 DTSCS76
02528 ********MOVE CATB-CURSOR         TO MAP-ELF-IND-L                 DTSCS76
02529 ********SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02530 *S1351-EXIT.  EXIT.                                               DTSCS76
02531                                                                   DTSCS76
02532 *S1375-ELF-LABELS.                                                DTSCS76
02533 *****MOVE MAP-ELF-LABELS-AREA TO L013-S-CNT-AREA.                 DTSCS76
02534 *****PERFORM S013-COPY-CNT THRU S013-EXIT.                        DTSCS76
02535                                                                   DTSCS76
02536 *****IF L013-VALID                                                DTSCS76
02537 *********IF L013-CNT > 0                                          DTSCS76
02538 ************IF WRK-MPRF-NO-88                                     DTSCS76
02539 ***************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA        DTSCS76
02540 ***************PERFORM S1376-ERROR THRU S1376-EXIT                DTSCS76
02541 ************ELSE                                                  DTSCS76
02542 ***************IF NOT MAP-ELF-IND-YES                             DTSCS76
02543 ******************MOVE MSG-E76C-AREA TO WRK-MSG-AREA              DTSCS76
02544 ******************PERFORM S1351-ERROR THRU S1351-EXIT             DTSCS76
02545 ***************ELSE                                               DTSCS76
02546 ******************MOVE L013-CNT TO MAP-ELF-LABELS-N               DTSCS76
02547 *********ELSE                                                     DTSCS76
02548 ************MOVE L013-CNT TO MAP-ELF-LABELS-N                     DTSCS76
02549 *****ELSE                                                         DTSCS76
02550 *****IF L013-NO-ENTRY                                             DTSCS76
02551 ********MOVE SPACES TO MAP-ELF-LABELS                             DTSCS76
02552 *****ELSE                                                         DTSCS76
02553 *****IF L013-INVALID-NEGATIVE                                     DTSCS76
02554 ********MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA                DTSCS76
02555 ********PERFORM S1376-ERROR THRU S1376-EXIT                       DTSCS76
02556 *****ELSE                                                         DTSCS76
02557 *****IF L013-EXCEEDS-MIN-MAX                                      DTSCS76
02558 *********MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS76
02559 *********PERFORM S1376-ERROR THRU S1376-EXIT                      DTSCS76
02560 *****ELSE                                                         DTSCS76
02561 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
02562 *********PERFORM S1376-ERROR THRU S1376-EXIT.                     DTSCS76
02563 *S1375-EXIT.  EXIT.                                               DTSCS76
02564                                                                   DTSCS76
02565 *S1376-ERROR.                                                     DTSCS76
02566 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ELF-LABELS-A.         DTSCS76
02567 *****IF LCCM-NO-MSG                                               DTSCS76
02568 ********MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS76
02569 ********MOVE CATB-CURSOR             TO MAP-ELF-LABELS-L          DTSCS76
02570 ********SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02571 *S1376-EXIT.  EXIT.                                               DTSCS76
02572 /*****************************************************************DTSCS76
02573 *                                                                 DTSCS76
02574 ******************************************************************DTSCS76
02575  S1400-FROM-TO-YRQ.                                               DTSCS76
02576      MOVE +0 TO WRK-FROM-YRQ                                      DTSCS76
02577                 WRK-TO-YRQ.                                       DTSCS76
02578                                                                   DTSCS76
02579                                                                   DTSCS76
02580      MOVE MAP-FROM-YRQ-AREA TO L016-S-YRQ-AREA.                   DTSCS76
02581                                                                   DTSCS76
02582      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
02583                                                                   DTSCS76
02584      IF L016-NO-ENTRY                                             DTSCS76
02585         NEXT SENTENCE                                             DTSCS76
02586      ELSE                                                         DTSCS76
02587      IF L016-NOT-VALID                                            DTSCS76
02588         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
02589         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS76
02590      ELSE                                                         DTSCS76
02591         IF WRK-MPRF-NO-88                                         DTSCS76
02592            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02593            PERFORM S1401-ERROR THRU S1401-EXIT                    DTSCS76
02594         ELSE                                                      DTSCS76
02595            MOVE L016-YRQ TO WRK-FROM-YRQ.                         DTSCS76
02596                                                                   DTSCS76
02597                                                                   DTSCS76
02598      MOVE MAP-TO-YRQ-AREA TO L016-S-YRQ-AREA.                     DTSCS76
02599                                                                   DTSCS76
02600      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
02601                                                                   DTSCS76
02602      IF L016-NO-ENTRY                                             DTSCS76
02603         MOVE WRK-FROM-YRQ TO WRK-TO-YRQ                           DTSCS76
02604      ELSE                                                         DTSCS76
02605      IF L016-NOT-VALID                                            DTSCS76
02606         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
02607         PERFORM S1402-ERROR THRU S1402-EXIT                       DTSCS76
02608         GO TO S1400-EXIT                                          DTSCS76
02609      ELSE                                                         DTSCS76
02610         IF WRK-MPRF-NO-88                                         DTSCS76
02611            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02612            PERFORM S1402-ERROR THRU S1402-EXIT                    DTSCS76
02613            GO TO S1400-EXIT                                       DTSCS76
02614         ELSE                                                      DTSCS76
02615            MOVE L016-YRQ TO WRK-TO-YRQ.                           DTSCS76
02616                                                                   DTSCS76
02617                                                                   DTSCS76
02618      IF WRK-TO-YRQ < WRK-FROM-YRQ                                 DTSCS76
02619         MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS76
02620         PERFORM S1401-ERROR THRU S1401-EXIT                       DTSCS76
02621         PERFORM S1402-ERROR THRU S1402-EXIT                       DTSCS76
02622         GO TO S1400-EXIT.                                         DTSCS76
02623                                                                   DTSCS76
02624                                                                   DTSCS76
02625      IF WRK-FROM-YRQ = +0                                         DTSCS76
02626          IF WRK-TO-YRQ > +0                                       DTSCS76
02627              MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                 DTSCS76
02628              PERFORM S1401-ERROR THRU S1401-EXIT                  DTSCS76
02629              PERFORM S1402-ERROR THRU S1402-EXIT                  DTSCS76
02630              GO TO S1400-EXIT.                                    DTSCS76
02631  S1400-EXIT.                                                      DTSCS76
02632      EXIT.                                                        DTSCS76
02633                                                                   DTSCS76
02634                                                                   DTSCS76
02635                                                                   DTSCS76
02636  S1401-ERROR.                                                     DTSCS76
02637      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FROM-YRQ-YR-A.        DTSCS76
02638                                                                   DTSCS76
02639      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-FROM-YRQ-Q-A.         DTSCS76
02640                                                                   DTSCS76
02641      IF LCCM-NO-MSG                                               DTSCS76
02642         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
02643         MOVE CATB-CURSOR TO MAP-FROM-YRQ-YR-L                     DTSCS76
02644         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02645  S1401-EXIT.                                                      DTSCS76
02646      EXIT.                                                        DTSCS76
02647                                                                   DTSCS76
02648  S1402-ERROR.                                                     DTSCS76
02649      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TO-YRQ-YR-A.          DTSCS76
02650                                                                   DTSCS76
02651      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-TO-YRQ-Q-A.           DTSCS76
02652                                                                   DTSCS76
02653      IF LCCM-NO-MSG                                               DTSCS76
02654         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
02655         MOVE CATB-CURSOR TO MAP-TO-YRQ-YR-L                       DTSCS76
02656         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02657  S1402-EXIT.                                                      DTSCS76
02658       EXIT.                                                       DTSCS76
02659 /*****************************************************************DTSCS76
02660 *                                                                 DTSCS76
02661 ******************************************************************DTSCS76
02662  S1500-FORCE-PRINT.                                               DTSCS76
02663      IF MAP-FORCE-PRINT = LOW-VALUES OR SPACES                    DTSCS76
02664         MOVE 'N' TO MAP-FORCE-PRINT                               DTSCS76
02665      ELSE                                                         DTSCS76
02666      IF NOT MAP-FORCE-PRINT-VALID                                 DTSCS76
02667         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
02668         PERFORM S1501-ERROR THRU S1501-EXIT                       DTSCS76
02669      ELSE                                                         DTSCS76
02670         IF WRK-MPRF-NO-88                                         DTSCS76
02671         AND MAP-FORCE-PRINT-YES                                   DTSCS76
02672            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02673            PERFORM S1501-ERROR THRU S1501-EXIT.                   DTSCS76
02674  S1500-EXIT.                                                      DTSCS76
02675      EXIT.                                                        DTSCS76
02676                                                                   DTSCS76
02677                                                                   DTSCS76
02678                                                                   DTSCS76
02679  S1501-ERROR.                                                     DTSCS76
02680      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FORCE-PRINT-A.         DTSCS76
02681                                                                   DTSCS76
02682      IF LCCM-NO-MSG                                               DTSCS76
02683         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
02684         MOVE CATB-CURSOR TO MAP-FORCE-PRINT-L                     DTSCS76
02685         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02686  S1501-EXIT.                                                      DTSCS76
02687      EXIT.                                                        DTSCS76
02688 /*****************************************************************DTSCS76
02689 *                                                                 DTSCS76
02690 ******************************************************************DTSCS76
02691  S1550-WAIVE-EXT-DATE.                                            DTSCS76
02692      MOVE +0 TO WRK-WAIVE-EXT-DATE.                               DTSCS76
02693                                                                   DTSCS76
02694                                                                   DTSCS76
02695      MOVE MAP-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA.            DTSCS76
02696                                                                   DTSCS76
02697      PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS76
02698                                                                   DTSCS76
02699      IF L015-NO-ENTRY                                             DTSCS76
02700          NEXT SENTENCE                                            DTSCS76
02701      ELSE                                                         DTSCS76
02702      IF L015-NOT-VALID                                            DTSCS76
02703          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
02704          PERFORM S1551-ERROR THRU S1551-EXIT                      DTSCS76
02705      ELSE                                                         DTSCS76
02706          IF WRK-MPRF-NO-88                                        DTSCS76
02707              MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS76
02708              PERFORM S1551-ERROR THRU S1551-EXIT                  DTSCS76
02709          ELSE                                                     DTSCS76
02710              MOVE L015-DATE TO WRK-WAIVE-EXT-DATE.                DTSCS76
02711  S1550-EXIT.                                                      DTSCS76
02712      EXIT.                                                        DTSCS76
02713                                                                   DTSCS76
02714                                                                   DTSCS76
02715                                                                   DTSCS76
02716  S1551-ERROR.                                                     DTSCS76
02717      MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS76
02718        TO MAP-WAIVE-EXT-MO-A                                      DTSCS76
02719           MAP-WAIVE-EXT-DA-A                                      DTSCS76
02720           MAP-WAIVE-EXT-YR-A.                                     DTSCS76
02721                                                                   DTSCS76
02722      IF LCCM-NO-MSG                                               DTSCS76
02723          MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS76
02724          MOVE CATB-CURSOR TO MAP-WAIVE-EXT-MO-L                   DTSCS76
02725          SET CURSOR-SET-YES TO TRUE.                              DTSCS76
02726  S1551-EXIT.                                                      DTSCS76
02727      EXIT.                                                        DTSCS76
02728 /*****************************************************************DTSCS76
02729 *                                                                 DTSCS76
02730 ******************************************************************DTSCS76
02731 *S1600-OL-FROM-TO-YRQ.                                            DTSCS76
02732 *****MOVE +0 TO WRK-OL-FROM-YRQ                                   DTSCS76
02733 ****************WRK-OL-TO-YRQ.                                    DTSCS76
02734                                                                   DTSCS76
02735 *****MOVE MAP-OL-FROM-YRQ-AREA TO L016-S-YRQ-AREA.                DTSCS76
02736 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
02737 *****IF L016-NO-ENTRY                                             DTSCS76
02738 ********NEXT SENTENCE                                             DTSCS76
02739 *****ELSE                                                         DTSCS76
02740 *****IF L016-NOT-VALID                                            DTSCS76
02741 ********MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS76
02742 ********PERFORM S1601-ERROR          THRU S1601-EXIT              DTSCS76
02743 *****ELSE                                                         DTSCS76
02744 ********IF WRK-MPRF-NO-88                                         DTSCS76
02745 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02746 ***********PERFORM S1601-ERROR         THRU S1601-EXIT            DTSCS76
02747 ********ELSE                                                      DTSCS76
02748 ************IF WRK-MELF-NO-88                                     DTSCS76
02749 ***************MOVE MSG-E76A-AREA TO WRK-MSG-AREA                 DTSCS76
02750 ***************PERFORM S1601-ERROR    THRU S1601-EXIT             DTSCS76
02751 ************ELSE                                                  DTSCS76
02752 ***************IF MELF-TAX-RPT-NO-88                              DTSCS76
02753 ******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA              DTSCS76
02754 ******************PERFORM S1601-ERROR  THRU S1601-EXIT            DTSCS76
02755 ***************ELSE                                               DTSCS76
02756 ******************MOVE L016-YRQ TO WRK-OL-FROM-YRQ.               DTSCS76
02757                                                                   DTSCS76
02758 *****MOVE MAP-OL-TO-YRQ-AREA TO L016-S-YRQ-AREA.                  DTSCS76
02759 *****PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
02760 *****IF L016-NO-ENTRY                                             DTSCS76
02761 ********MOVE WRK-OL-FROM-YRQ TO WRK-OL-TO-YRQ                     DTSCS76
02762 *****ELSE                                                         DTSCS76
02763 *****IF L016-NOT-VALID                                            DTSCS76
02764 ********MOVE EMSG-FIELD-NOT-VALID    TO WRK-MSG-AREA              DTSCS76
02765 ********PERFORM S1602-ERROR          THRU S1602-EXIT              DTSCS76
02766 ********GO TO S1600-EXIT                                          DTSCS76
02767 *****ELSE                                                         DTSCS76
02768 ********IF WRK-MPRF-NO-88                                         DTSCS76
02769 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02770 ***********PERFORM S1602-ERROR         THRU S1602-EXIT            DTSCS76
02771 ***********GO TO S1600-EXIT                                       DTSCS76
02772 ********ELSE                                                      DTSCS76
02773 ************IF WRK-MELF-NO-88                                     DTSCS76
02774 ***************MOVE MSG-E76A-AREA TO WRK-MSG-AREA                 DTSCS76
02775 ***************PERFORM S1602-ERROR    THRU S1602-EXIT             DTSCS76
02776 ***************GO TO S1600-EXIT                                   DTSCS76
02777 ************ELSE                                                  DTSCS76
02778 ***************IF MELF-TAX-RPT-NO-88                              DTSCS76
02779 ******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA              DTSCS76
02780 ******************PERFORM S1602-ERROR THRU S1602-EXIT             DTSCS76
02781 ******************GO TO S1600-EXIT                                DTSCS76
02782 ***************ELSE                                               DTSCS76
02783 ******************MOVE L016-YRQ TO WRK-OL-TO-YRQ.                 DTSCS76
02784                                                                   DTSCS76
02785 *****IF WRK-OL-TO-YRQ < WRK-OL-FROM-YRQ                           DTSCS76
02786 ********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS76
02787 ********PERFORM S1601-ERROR THRU S1601-EXIT                       DTSCS76
02788 ********PERFORM S1602-ERROR THRU S1602-EXIT                       DTSCS76
02789 ********GO TO S1600-EXIT.                                         DTSCS76
02790                                                                   DTSCS76
02791 *****IF WRK-5E-FROM-YRQ = +0                                      DTSCS76
02792 *********IF WRK-5E-TO-YRQ > +0                                    DTSCS76
02793 *************MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                 DTSCS76
02794 *************PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS76
02795 *************PERFORM S1602-ERROR THRU S1602-EXIT                  DTSCS76
02796 *************GO TO S1600-EXIT.                                    DTSCS76
02797                                                                   DTSCS76
02798 *****IF (WRK-FROM-YRQ = +0) AND (WRK-TO-YRQ = +0)                 DTSCS76
02799 *********GO TO S1600-EXIT                                         DTSCS76
02800 *****ELSE                                                         DTSCS76
02801 *********IF (WRK-TO-YRQ < WRK-5E-FROM-YRQ)                        DTSCS76
02802 ************************OR                                        DTSCS76
02803 ************(WRK-5E-TO-YRQ < WRK-FROM-YRQ)                        DTSCS76
02804 *************GO TO S1600-EXIT                                     DTSCS76
02805 *********ELSE                                                     DTSCS76
02806 *************MOVE MSG-E76D-AREA TO WRK-MSG-AREA                   DTSCS76
02807 *************PERFORM S1601-ERROR THRU S1601-EXIT                  DTSCS76
02808 *************PERFORM S1602-ERROR THRU S1602-EXIT.                 DTSCS76
02809 *S1600-EXIT.  EXIT.                                               DTSCS76
02810                                                                   DTSCS76
02811 *S1601-ERROR.                                                     DTSCS76
02812 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-FROM-YRQ-YR-A.     DTSCS76
02813 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-FROM-YRQ-Q-A.      DTSCS76
02814 *****IF LCCM-NO-MSG                                               DTSCS76
02815 ********MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS76
02816 ********MOVE CATB-CURSOR             TO MAP-5E-FROM-YRQ-YR-L      DTSCS76
02817 ********SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02818 *S1601-EXIT. EXIT.                                                DTSCS76
02819                                                                   DTSCS76
02820 *S1602-ERROR.                                                     DTSCS76
02821 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-TO-YRQ-YR-A.       DTSCS76
02822 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-5E-TO-YRQ-Q-A.        DTSCS76
02823 *****IF LCCM-NO-MSG                                               DTSCS76
02824 ********MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS76
02825 ********MOVE CATB-CURSOR             TO MAP-5E-TO-YRQ-YR-L        DTSCS76
02826 ********SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02827 *S1602-EXIT. EXIT.                                                DTSCS76
02828 /*****************************************************************DTSCS76
02829 *                                                                 DTSCS76
02830 ******************************************************************DTSCS76
02831 *S1700-5E-FORCE-PRINT.                                            DTSCS76
02832 *****IF MAP-5E-FORCE-PRINT = LOW-VALUES OR SPACES                 DTSCS76
02833 ********MOVE 'N' TO MAP-5E-FORCE-PRINT                            DTSCS76
02834 *****ELSE                                                         DTSCS76
02835 *****IF NOT MAP-5E-FORCE-PRINT-VALID                              DTSCS76
02836 ********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
02837 ********PERFORM S1701-ERROR THRU S1701-EXIT                       DTSCS76
02838 *****ELSE                                                         DTSCS76
02839 ********IF MAP-5E-FORCE-PRINT-YES                                 DTSCS76
02840 ***********IF WRK-MPRF-NO-88                                      DTSCS76
02841 **************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA         DTSCS76
02842 **************PERFORM S1701-ERROR THRU S1701-EXIT                 DTSCS76
02843 ***********ELSE                                                   DTSCS76
02844 **************IF WRK-MELF-NO-88                                   DTSCS76
02845 *****************MOVE MSG-E76A-AREA TO WRK-MSG-AREA               DTSCS76
02846 *****************PERFORM S1701-ERROR THRU S1701-EXIT              DTSCS76
02847 **************ELSE                                                DTSCS76
02848 *****************IF MELF-TAX-RPT-NO-88                            DTSCS76
02849 ******************* MOVE MSG-E76B-AREA TO WRK-MSG-AREA            DTSCS76
02850 ********************PERFORM S1701-ERROR THRU S1701-EXIT.          DTSCS76
02851 *S1700-EXIT. EXIT.                                                DTSCS76
02852                                                                   DTSCS76
02853 *S1701-ERROR.                                                     DTSCS76
02854 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-5E-FORCE-PRINT-A.      DTSCS76
02855 *****IF LCCM-NO-MSG                                               DTSCS76
02856 ********MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS76
02857 ********MOVE CATB-CURSOR             TO MAP-5E-FORCE-PRINT-L      DTSCS76
02858 ********SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02859 *S1701-EXIT. EXIT.                                                DTSCS76
02860 /*****************************************************************DTSCS76
02861 *                                                                 DTSCS76
02862 ******************************************************************DTSCS76
02863 *S1750-5E-WAIVE-EXT-DATE.                                         DTSCS76
02864 *****MOVE +0 TO WRK-5E-WAIVE-EXT-DATE.                            DTSCS76
02865                                                                   DTSCS76
02866 *****MOVE MAP-5E-WAIVE-EXT-DATE-AREA TO L015-S-DATE-AREA.         DTSCS76
02867 *****PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT.                DTSCS76
02868 *****IF L015-NO-ENTRY                                             DTSCS76
02869 *********NEXT SENTENCE                                            DTSCS76
02870 *****ELSE                                                         DTSCS76
02871 *****IF L015-NOT-VALID                                            DTSCS76
02872 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
02873 *********PERFORM S1751-ERROR THRU S1751-EXIT                      DTSCS76
02874 *****ELSE                                                         DTSCS76
02875 *********IF WRK-MPRF-NO-88                                        DTSCS76
02876 *************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA          DTSCS76
02877 *************PERFORM S1751-ERROR THRU S1751-EXIT                  DTSCS76
02878 *********ELSE                                                     DTSCS76
02879 *************IF WRK-MELF-NO-88                                    DTSCS76
02880 ****************MOVE MSG-E76A-AREA TO WRK-MSG-AREA                DTSCS76
02881 ****************PERFORM S1751-ERROR THRU S1751-EXIT               DTSCS76
02882 *************ELSE                                                 DTSCS76
02883 ****************IF MELF-TAX-RPT-NO-88                             DTSCS76
02884 *******************MOVE MSG-E76B-AREA TO WRK-MSG-AREA             DTSCS76
02885 *******************PERFORM S1751-ERROR THRU S1751-EXIT            DTSCS76
02886 ****************ELSE                                              DTSCS76
02887 *******************MOVE L015-DATE TO WRK-5E-WAIVE-EXT-DATE.       DTSCS76
02888 *S1750-EXIT.                                                      DTSCS76
02889 *****EXIT.                                                        DTSCS76
02890                                                                   DTSCS76
02891 *S1751-ERROR.                                                     DTSCS76
02892 *****MOVE CATB-UNPROT-NORM-NUM-MDTON                              DTSCS76
02893 *******TO MAP-5E-WAIVE-EXT-MO-A                                   DTSCS76
02894 **********MAP-5E-WAIVE-EXT-DA-A                                   DTSCS76
02895 **********MAP-5E-WAIVE-EXT-YR-A.                                  DTSCS76
02896                                                                   DTSCS76
02897 *****IF LCCM-NO-MSG                                               DTSCS76
02898 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                       DTSCS76
02899 *********MOVE CATB-CURSOR TO MAP-5E-WAIVE-EXT-MO-L                DTSCS76
02900 *********SET CURSOR-SET-YES TO TRUE.                              DTSCS76
02901 *S1751-EXIT.                                                      DTSCS76
02902 *****EXIT.                                                        DTSCS76
02903 /*****************************************************************DTSCS76
02904 *                                                                 DTSCS76
02905 ******************************************************************DTSCS76
02906 *S1800-NOTICE-OF-COVERAGE.                                        DTSCS76
02907 *****MOVE MAP-NOTICE-OF-COVERAGE-AREA TO L013-S-CNT-AREA.         DTSCS76
02908 *****PERFORM S013-COPY-CNT THRU S013-EXIT.                        DTSCS76
02909                                                                   DTSCS76
02910 *****IF L013-VALID                                                DTSCS76
02911 ********IF WRK-MPRF-NO-88                                         DTSCS76
02912 ********AND L013-CNT > 0                                          DTSCS76
02913 ***********MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02914 ***********PERFORM S1801-ERROR THRU S1801-EXIT                    DTSCS76
02915 ********ELSE                                                      DTSCS76
02916 ***********MOVE L013-CNT TO MAP-NOTICE-OF-COVERAGE-N              DTSCS76
02917 ***********PERFORM S1810-ACTIVE-EDIT THRU S1810-EXIT              DTSCS76
02918 *****ELSE                                                         DTSCS76
02919 *****IF L013-NO-ENTRY                                             DTSCS76
02920 ********MOVE SPACES TO MAP-NOTICE-OF-COVERAGE                     DTSCS76
02921 *****ELSE                                                         DTSCS76
02922 *****IF L013-INVALID-NEGATIVE                                     DTSCS76
02923 ********MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA                DTSCS76
02924 ********PERFORM S1801-ERROR THRU S1801-EXIT                       DTSCS76
02925 *****ELSE                                                         DTSCS76
02926 *****IF L013-EXCEEDS-MIN-MAX                                      DTSCS76
02927 *********MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS76
02928 *********PERFORM S1801-ERROR THRU S1801-EXIT                      DTSCS76
02929 *****ELSE                                                         DTSCS76
02930 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
02931 *********PERFORM S1801-ERROR THRU S1801-EXIT.                     DTSCS76
02932 *S1800-EXIT. EXIT.                                                DTSCS76
02933                                                                   DTSCS76
02934 *S1801-ERROR.                                                     DTSCS76
02935 *****MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-NOTICE-OF-COVERAGE-A. DTSCS76
02936 *****IF LCCM-NO-MSG                                               DTSCS76
02937 ********MOVE WRK-MSG-AREA            TO LCCM-MSG-AREA             DTSCS76
02938 ********MOVE CATB-CURSOR             TO MAP-NOTICE-OF-COVERAGE-L  DTSCS76
02939 ********SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02940 *S1801-EXIT. EXIT.                                                DTSCS76
02941                                                                   DTSCS76
02942 *S1810-ACTIVE-EDIT.                                               DTSCS76
02943 *****IF (WRK-MPRF-NO-88)                                          DTSCS76
02944 *************OR                                                   DTSCS76
02945 ********(L013-CNT = +0)                                           DTSCS76
02946 *********GO TO S1810-EXIT.                                        DTSCS76
02947                                                                   DTSCS76
02948 *****IF MPRF-STATUS-ACT-88                                        DTSCS76
02949 *********NEXT SENTENCE                                            DTSCS76
02950 *****ELSE                                                         DTSCS76
02951 *********MOVE MSG-E767-AREA TO WRK-MSG-AREA                       DTSCS76
02952 *********PERFORM S1801-ERROR THRU S1801-EXIT.                     DTSCS76
02953 *S1810-EXIT.                                                      DTSCS76
02954 *****EXIT.                                                        DTSCS76
02955 /*****************************************************************DTSCS76
02956 *                                                                 DTSCS76
02957 ******************************************************************DTSCS76
02958  S1900-NOTICE-OF-SUBJECT.                                         DTSCS76
02959      IF MAP-NOTICE-OF-SUBJECT = LOW-VALUES OR SPACES              DTSCS76
02960         MOVE 'N' TO MAP-NOTICE-OF-SUBJECT                         DTSCS76
02961      ELSE                                                         DTSCS76
02962      IF NOT MAP-NOTICE-OF-SUBJECT-VALID                           DTSCS76
02963         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
02964         PERFORM S1901-ERROR THRU S1901-EXIT                       DTSCS76
02965      ELSE                                                         DTSCS76
02966         IF WRK-MPRF-NO-88                                         DTSCS76
02967           AND MAP-NOTICE-OF-SUBJECT-YES                           DTSCS76
02968            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
02969            PERFORM S1901-ERROR THRU S1901-EXIT                    DTSCS76
02970         ELSE                                                      DTSCS76
02971            PERFORM S1910-SUBJECT-EDIT THRU S1910-EXIT.            DTSCS76
02972  S1900-EXIT.                                                      DTSCS76
02973      EXIT.                                                        DTSCS76
02974                                                                   DTSCS76
02975                                                                   DTSCS76
02976                                                                   DTSCS76
02977  S1901-ERROR.                                                     DTSCS76
02978      MOVE CATB-UNPROT-NORM-AN-MDTON                               DTSCS76
02979        TO MAP-NOTICE-OF-SUBJECT-A.                                DTSCS76
02980                                                                   DTSCS76
02981      IF LCCM-NO-MSG                                               DTSCS76
02982         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
02983         MOVE CATB-CURSOR TO MAP-NOTICE-OF-SUBJECT-L               DTSCS76
02984         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
02985  S1901-EXIT.                                                      DTSCS76
02986      EXIT.                                                        DTSCS76
02987                                                                   DTSCS76
02988                                                                   DTSCS76
02989  S1910-SUBJECT-EDIT.                                              DTSCS76
02990      IF (WRK-MPRF-NO-88)                                          DTSCS76
02991             OR                                                    DTSCS76
02992         (MAP-NOTICE-OF-SUBJECT-NO)                                DTSCS76
02993          GO TO S1910-EXIT.                                        DTSCS76
02994                                                                   DTSCS76
02995      IF MPRF-STATUS-SUB-88                                        DTSCS76
02996          NEXT SENTENCE                                            DTSCS76
02997      ELSE                                                         DTSCS76
02998          MOVE MSG-E765-AREA TO WRK-MSG-AREA                       DTSCS76
02999          PERFORM S1901-ERROR THRU S1901-EXIT.                     DTSCS76
03000  S1910-EXIT.                                                      DTSCS76
03001      EXIT.                                                        DTSCS76
03002 /*****************************************************************DTSCS76
03003 *                                                                 DTSCS76
03004 ******************************************************************DTSCS76
03005  S2000-REQUEST-FOR-FEIN.                                          DTSCS76
03006      IF MAP-REQUEST-FOR-FEIN = LOW-VALUES OR SPACES               DTSCS76
03007         MOVE 'N' TO MAP-REQUEST-FOR-FEIN                          DTSCS76
03008      ELSE                                                         DTSCS76
03009      IF NOT MAP-REQUEST-FOR-FEIN-VALID                            DTSCS76
03010         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03011         PERFORM S2001-ERROR THRU S2001-EXIT                       DTSCS76
03012      ELSE                                                         DTSCS76
03013         IF WRK-MPRF-NO-88                                         DTSCS76
03014            IF MAP-REQUEST-FOR-FEIN-YES                            DTSCS76
03015               MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA         DTSCS76
03016               PERFORM S2001-ERROR THRU S2001-EXIT                 DTSCS76
03017            ELSE                                                   DTSCS76
03018               NEXT SENTENCE                                       DTSCS76
03019         ELSE                                                      DTSCS76
03020            IF MAP-REQUEST-FOR-FEIN-YES                            DTSCS76
03021               IF MPRF-CLASS-CHG-ONLY-88                           DTSCS76
03022                  MOVE MSG-E768-AREA TO WRK-MSG-AREA               DTSCS76
03023                  PERFORM S2001-ERROR THRU S2001-EXIT.             DTSCS76
03024  S2000-EXIT.                                                      DTSCS76
03025      EXIT.                                                        DTSCS76
03026                                                                   DTSCS76
03027                                                                   DTSCS76
03028                                                                   DTSCS76
03029  S2001-ERROR.                                                     DTSCS76
03030      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-REQUEST-FOR-FEIN-A.    DTSCS76
03031                                                                   DTSCS76
03032      IF LCCM-NO-MSG                                               DTSCS76
03033         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03034         MOVE CATB-CURSOR TO MAP-REQUEST-FOR-FEIN-L                DTSCS76
03035         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03036  S2001-EXIT.                                                      DTSCS76
03037      EXIT.                                                        DTSCS76
03038 /*****************************************************************DTSCS76
03039 *                                                                 DTSCS76
03040 ******************************************************************DTSCS76
03041  S2100-ADDR-TYPE.                                                 DTSCS76
03042      IF MAP-ADDR-TYPE = SPACES OR LOW-VALUES                      DTSCS76
03043          SET MAP-ADDR-TAX-88 TO TRUE                              DTSCS76
03044      ELSE                                                         DTSCS76
03045      IF MAP-ADDR-VALID-88                                         DTSCS76
03046         NEXT SENTENCE                                             DTSCS76
03047      ELSE                                                         DTSCS76
03048          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
03049          PERFORM S2101-ERROR THRU S2101-EXIT.                     DTSCS76
03050  S2100-EXIT.                                                      DTSCS76
03051      EXIT.                                                        DTSCS76
03052                                                                   DTSCS76
03053                                                                   DTSCS76
03054                                                                   DTSCS76
03055  S2101-ERROR.                                                     DTSCS76
03056      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-TYPE-A            DTSCS76
03057                                                                   DTSCS76
03058      IF LCCM-NO-MSG                                               DTSCS76
03059         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03060         MOVE CATB-CURSOR TO MAP-ADDR-TYPE-L                       DTSCS76
03061         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03062  S2101-EXIT.                                                      DTSCS76
03063      EXIT.                                                        DTSCS76
03064 /*****************************************************************DTSCS76
03065 *                                                                 DTSCS76
03066 ******************************************************************DTSCS76
03067  S2200-ADDR-NBR.                                                  DTSCS76
03068      INSPECT MAP-ADDR-ID-NO                                       DTSCS76
03069          CONVERTING LOW-VALUES TO SPACES.                         DTSCS76
03070                                                                   DTSCS76
03071                                                                   DTSCS76
03072      IF MAP-ADDR-ID-NO = SPACES                                   DTSCS76
03073          IF MAP-ADDR-TAD-88                                       DTSCS76
03074              IF WRK-MPRF-NO-88                                    DTSCS76
03075                  GO TO S2200-EXIT                                 DTSCS76
03076              ELSE                                                 DTSCS76
03077                  PERFORM S2210-ADDR-LOOKUP THRU S2210-EXIT        DTSCS76
03078                  GO TO S2200-EXIT                                 DTSCS76
03079          ELSE                                                     DTSCS76
03080              MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA             DTSCS76
03081              PERFORM S2201-ERROR THRU S2201-EXIT                  DTSCS76
03082              GO TO S2200-EXIT.                                    DTSCS76
03083                                                                   DTSCS76
03084                                                                   DTSCS76
03085      IF MAP-ADDR-TAD-88                                           DTSCS76
03086          MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA              DTSCS76
03087          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS76
03088          GO TO S2200-EXIT.                                        DTSCS76
03089                                                                   DTSCS76
03090                                                                   DTSCS76
03091      MOVE MAP-ADDR-ID-NO-AREA TO L013-S-CNT-AREA.                 DTSCS76
03092                                                                   DTSCS76
03093      MOVE +1 TO L013-MIN-CNT                                      DTSCS76
03094                                                                   DTSCS76
03095      MOVE +999 TO L013-MAX-CNT.                                   DTSCS76
03096                                                                   DTSCS76
03097      PERFORM S013-COUNT-FROM-SCREEN THRU S013-EXIT.               DTSCS76
03098                                                                   DTSCS76
03099      IF L013-VALID                                                DTSCS76
03100          MOVE L013-CNT TO MAP-ADDR-ID-NO-N                        DTSCS76
03101          IF MAP-ADDR-TAA-OPO-88                                   DTSCS76
03102              PERFORM S2220-ADDR-TAA-OPO THRU S2220-EXIT           DTSCS76
03103          ELSE                                                     DTSCS76
03104              NEXT SENTENCE                                        DTSCS76
03105      ELSE                                                         DTSCS76
03106      IF L013-NO-ENTRY                                             DTSCS76
03107          MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                 DTSCS76
03108          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS76
03109      ELSE                                                         DTSCS76
03110      IF L013-INVALID-NEGATIVE                                     DTSCS76
03111          MOVE EMSG-INVALID-NEGATIVE TO WRK-MSG-AREA               DTSCS76
03112          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS76
03113      ELSE                                                         DTSCS76
03114      IF L013-EXCEEDS-MIN-MAX                                      DTSCS76
03115          MOVE EMSG-EXCEEDS-MIN-MAX TO WRK-MSG-AREA                DTSCS76
03116          PERFORM S2201-ERROR THRU S2201-EXIT                      DTSCS76
03117      ELSE                                                         DTSCS76
03118          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
03119          PERFORM S2201-ERROR THRU S2201-EXIT.                     DTSCS76
03120  S2200-EXIT.                                                      DTSCS76
03121      EXIT.                                                        DTSCS76
03122                                                                   DTSCS76
03123                                                                   DTSCS76
03124                                                                   DTSCS76
03125  S2201-ERROR.                                                     DTSCS76
03126      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ADDR-ID-NO-A.         DTSCS76
03127                                                                   DTSCS76
03128      IF LCCM-NO-MSG                                               DTSCS76
03129         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03130         MOVE CATB-CURSOR TO MAP-ADDR-ID-NO-L                      DTSCS76
03131         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03132  S2201-EXIT.                                                      DTSCS76
03133      EXIT.                                                        DTSCS76
03134                                                                   DTSCS76
03135                                                                   DTSCS76
03136                                                                   DTSCS76
03137  S2210-ADDR-LOOKUP.                                               DTSCS76
03138      IF WRK-MPRF-NO-88                                            DTSCS76
03139         GO TO S2210-EXIT.                                         DTSCS76
03140                                                                   DTSCS76
03141      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS76
03142                                                                   DTSCS76
03143      IF MAP-ADDR-TAX-88                                           DTSCS76
03144          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS76
03145          SET L111-ID-NO-TAD-MAIL-88 TO TRUE                       DTSCS76
03146      ELSE                                                         DTSCS76
03147      IF MAP-ADDR-PHY-88                                           DTSCS76
03148          SET L111-LOOKUP-TAD-88 TO TRUE                           DTSCS76
03149          SET L111-ID-NO-TAD-PHYS-88 TO TRUE                       DTSCS76
03150      ELSE                                                         DTSCS76
03151          GO TO S899-ABEND.                                        DTSCS76
03152                                                                   DTSCS76
03153      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS76
03154                                                                   DTSCS76
03155      IF L111-ADDR-NOT-FOUND-88                                    DTSCS76
03156         MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                      DTSCS76
03157         PERFORM S2101-ERROR THRU S2101-EXIT.                      DTSCS76
03158  S2210-EXIT.                                                      DTSCS76
03159      EXIT.                                                        DTSCS76
03160                                                                   DTSCS76
03161                                                                   DTSCS76
03162                                                                   DTSCS76
03163  S2220-ADDR-TAA-OPO.                                              DTSCS76
03164      IF WRK-MPRF-NO-88                                            DTSCS76
03165         GO TO S2210-EXIT.                                         DTSCS76
03166                                                                   DTSCS76
03167      MOVE WRK-EMP-NO TO L111-EMP-NO.                              DTSCS76
03168                                                                   DTSCS76
03169      IF MAP-ADDR-TAX-ALT-88                                       DTSCS76
03170          SET L111-LOOKUP-TAA-88 TO TRUE                           DTSCS76
03171      ELSE                                                         DTSCS76
03172      IF MAP-ADDR-OPO-88                                           DTSCS76
03173          SET L111-LOOKUP-OPO-88 TO TRUE                           DTSCS76
03174      ELSE                                                         DTSCS76
03175          GO TO S899-ABEND.                                        DTSCS76
03176                                                                   DTSCS76
03177      IF L013-CNT = +0                                             DTSCS76
03178         MOVE 1 TO L111-ID-NO                                      DTSCS76
03179      ELSE                                                         DTSCS76
03180         MOVE L013-CNT TO L111-ID-NO.                              DTSCS76
03181                                                                   DTSCS76
03182      PERFORM S111-ADDR-LOOKUP THRU S111-EXIT.                     DTSCS76
03183                                                                   DTSCS76
03184      IF L111-ADDR-NOT-FOUND-88                                    DTSCS76
03185         MOVE EMSG-NO-ADDRESS TO WRK-MSG-AREA                      DTSCS76
03186         PERFORM S2201-ERROR THRU S2201-EXIT.                      DTSCS76
03187  S2220-EXIT.                                                      DTSCS76
03188      EXIT.                                                        DTSCS76
03189 /*****************************************************************DTSCS76
03190 *                                                                 DTSCS76
03191 ******************************************************************DTSCS76
03192  S2300-AR-AUDIT-TRAIL.                                            DTSCS76
03193      IF MAP-AR-AUDIT-TRAIL = LOW-VALUES OR SPACES                 DTSCS76
03194         MOVE 'N' TO MAP-AR-AUDIT-TRAIL                            DTSCS76
03195      ELSE                                                         DTSCS76
03196      IF NOT MAP-AR-AUDIT-TRAIL-VALID                              DTSCS76
03197         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03198         PERFORM S2301-ERROR THRU S2301-EXIT                       DTSCS76
03199      ELSE                                                         DTSCS76
03200      IF WRK-MPRF-NO-88                                            DTSCS76
03201      AND MAP-AR-AUDIT-TRAIL-YES                                   DTSCS76
03202         MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA               DTSCS76
03203         PERFORM S2301-ERROR THRU S2301-EXIT                       DTSCS76
03204      ELSE                                                         DTSCS76
03205      IF MAP-AR-AUDIT-TRAIL-YES                                    DTSCS76
03206      AND MPRF-TOT-BALANCE-AMT NOT > +0                            DTSCS76
03207         MOVE  MSG-E762-AREA TO WRK-MSG-AREA                       DTSCS76
03208         PERFORM S2301-ERROR THRU S2301-EXIT.                      DTSCS76
03209  S2300-EXIT.                                                      DTSCS76
03210      EXIT.                                                        DTSCS76
03211                                                                   DTSCS76
03212                                                                   DTSCS76
03213                                                                   DTSCS76
03214  S2301-ERROR.                                                     DTSCS76
03215      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-AR-AUDIT-TRAIL-A.      DTSCS76
03216                                                                   DTSCS76
03217      IF LCCM-NO-MSG                                               DTSCS76
03218         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03219         MOVE CATB-CURSOR TO MAP-AR-AUDIT-TRAIL-L                  DTSCS76
03220         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03221  S2301-EXIT.                                                      DTSCS76
03222      EXIT.                                                        DTSCS76
03223 /*****************************************************************DTSCS76
03224 *                                                                 DTSCS76
03225 ******************************************************************DTSCS76
03226 /*****************************************************************DTSCS76
03227 *                                                                 DTSCS76
03228 ******************************************************************DTSCS76
03229  S2400-STMT-FROM-TO-YRQ.                                          DTSCS76
03230      MOVE +0 TO WRK-STMT-FROM-YRQ                                 DTSCS76
03231                 WRK-STMT-TO-YRQ.                                  DTSCS76
03232                                                                   DTSCS76
03233                                                                   DTSCS76
03234      MOVE MAP-STMT-FROM-YRQ-AREA TO L016-S-YRQ-AREA.              DTSCS76
03235                                                                   DTSCS76
03236      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
03237                                                                   DTSCS76
03238      IF L016-NO-ENTRY                                             DTSCS76
03239         NEXT SENTENCE                                             DTSCS76
03240      ELSE                                                         DTSCS76
03241      IF L016-NOT-VALID                                            DTSCS76
03242         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03243         PERFORM S2401-ERROR THRU S2401-EXIT                       DTSCS76
03244      ELSE                                                         DTSCS76
03245         IF WRK-MPRF-NO-88                                         DTSCS76
03246            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
03247            PERFORM S2401-ERROR THRU S2401-EXIT                    DTSCS76
03248         ELSE                                                      DTSCS76
03249            MOVE L016-YRQ TO WRK-STMT-FROM-YRQ.                    DTSCS76
03250                                                                   DTSCS76
03251                                                                   DTSCS76
03252      MOVE MAP-STMT-TO-YRQ-AREA TO L016-S-YRQ-AREA.                DTSCS76
03253                                                                   DTSCS76
03254      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT.                 DTSCS76
03255                                                                   DTSCS76
03256      IF L016-NO-ENTRY                                             DTSCS76
03257         MOVE WRK-STMT-FROM-YRQ TO WRK-STMT-TO-YRQ                 DTSCS76
03258      ELSE                                                         DTSCS76
03259      IF L016-NOT-VALID                                            DTSCS76
03260         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03261         PERFORM S2402-ERROR THRU S2402-EXIT                       DTSCS76
03262         GO TO S2400-EXIT                                          DTSCS76
03263      ELSE                                                         DTSCS76
03264         IF WRK-MPRF-NO-88                                         DTSCS76
03265            MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA            DTSCS76
03266            PERFORM S2402-ERROR THRU S2402-EXIT                    DTSCS76
03267            GO TO S2400-EXIT                                       DTSCS76
03268         ELSE                                                      DTSCS76
03269            MOVE L016-YRQ TO WRK-STMT-TO-YRQ.                      DTSCS76
03270                                                                   DTSCS76
03271                                                                   DTSCS76
03272      IF WRK-STMT-TO-YRQ > +0                                      DTSCS76
03273      IF WRK-STMT-FROM-YRQ > WRK-STMT-TO-YRQ                       DTSCS76
03274         MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                      DTSCS76
03275         PERFORM S2401-ERROR THRU S2401-EXIT                       DTSCS76
03276         PERFORM S2402-ERROR THRU S2402-EXIT                       DTSCS76
03277         GO TO S2400-EXIT.                                         DTSCS76
03278                                                                   DTSCS76
03279                                                                   DTSCS76
03280      IF WRK-STMT-FROM-YRQ = +0                                    DTSCS76
03281          IF WRK-STMT-TO-YRQ > +0                                  DTSCS76
03282              MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                 DTSCS76
03283              PERFORM S2401-ERROR THRU S2401-EXIT                  DTSCS76
03284              PERFORM S2402-ERROR THRU S2402-EXIT                  DTSCS76
03285              GO TO S2400-EXIT.                                    DTSCS76
03286  S2400-EXIT.                                                      DTSCS76
03287      EXIT.                                                        DTSCS76
03288                                                                   DTSCS76
03289                                                                   DTSCS76
03290                                                                   DTSCS76
03291  S2401-ERROR.                                                     DTSCS76
03292      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-FROM-YRQ-YR-A.   DTSCS76
03293                                                                   DTSCS76
03294      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-FROM-YRQ-Q-A.    DTSCS76
03295                                                                   DTSCS76
03296      IF LCCM-NO-MSG                                               DTSCS76
03297         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03298         MOVE CATB-CURSOR TO MAP-STMT-FROM-YRQ-YR-L                DTSCS76
03299         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03300  S2401-EXIT.                                                      DTSCS76
03301      EXIT.                                                        DTSCS76
03302                                                                   DTSCS76
03303  S2402-ERROR.                                                     DTSCS76
03304      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-TO-YRQ-YR-A.     DTSCS76
03305                                                                   DTSCS76
03306      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-STMT-TO-YRQ-Q-A.      DTSCS76
03307                                                                   DTSCS76
03308      IF LCCM-NO-MSG                                               DTSCS76
03309         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03310         MOVE CATB-CURSOR TO MAP-STMT-TO-YRQ-YR-L                  DTSCS76
03311         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03312  S2402-EXIT.                                                      DTSCS76
03313       EXIT.                                                       DTSCS76
03314 /*****************************************************************DTSCS76
03315 *                                                                 DTSCS76
03316 ******************************************************************DTSCS76
03317  S2500-RESPONSIBLE-OP-ID.                                         DTSCS76
03318      IF MAP-RESPONSIBLE-OP-ID EQUAL LOW-VALUES OR SPACES          DTSCS76
03319          MOVE LCCM-RESP-OP-ID TO MAP-RESPONSIBLE-OP-ID.           DTSCS76
03320                                                                   DTSCS76
03321      IF MAP-RESPONSIBLE-OP-ID = LCCM-OP-ID                        DTSCS76
03322         MOVE MAP-RESPONSIBLE-OP-ID TO LCCM-RESP-OP-ID             DTSCS76
03323         GO TO S2500-EXIT.                                         DTSCS76
03324                                                                   DTSCS76
03325      MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID.                    DTSCS76
03326                                                                   DTSCS76
03327      PERFORM S082-OP-ID-LOOKUP  THRU S082-EXIT.                   DTSCS76
03328                                                                   DTSCS76
03329      IF (L082-VALID-OP)                                           DTSCS76
03330             AND                                                   DTSCS76
03331         (L082-EXTERNAL-88)                                        DTSCS76
03332          MOVE MAP-RESPONSIBLE-OP-ID TO LCCM-RESP-OP-ID            DTSCS76
03333      ELSE                                                         DTSCS76
03334          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
03335          PERFORM S2501-ERROR THRU S2501-EXIT.                     DTSCS76
03336  S2500-EXIT.                                                      DTSCS76
03337      EXIT.                                                        DTSCS76
03338                                                                   DTSCS76
03339                                                                   DTSCS76
03340                                                                   DTSCS76
03341  S2501-ERROR.                                                     DTSCS76
03342      MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-RESPONSIBLE-OP-ID-A.   DTSCS76
03343                                                                   DTSCS76
03344      IF LCCM-NO-MSG                                               DTSCS76
03345         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03346         MOVE CATB-CURSOR TO MAP-RESPONSIBLE-OP-ID-L               DTSCS76
03347         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03348  S2501-EXIT.                                                      DTSCS76
03349      EXIT.                                                        DTSCS76
03350  S2600-WAGE-REQUEST.                                              DTSCS76
03351      MOVE MAP-SSN-AREA TO L020-S-SSN-AREA.                        DTSCS76
03352      PERFORM S020-SCREEN-SSN THRU S020-EXIT.                      DTSCS76
03353      IF L020-NO-ENTRY                                             DTSCS76
03354         GO TO S2600-EXIT                                          DTSCS76
03355      ELSE                                                         DTSCS76
03356      IF L020-NOT-VALID                                            DTSCS76
03357         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03358         PERFORM S2601-ERROR THRU S2601-EXIT                       DTSCS76
03359         GO TO S2600-EXIT.                                         DTSCS76
03360                                                                   DTSCS76
03361      MOVE L020-SSN TO L081-CLAIMANT-SSN.                          DTSCS76
03362      PERFORM S081-CLAIMANT-NAME-LOOKUP THRU S081-EXIT.            DTSCS76
03363      IF L081-NAME-FOUND                                           DTSCS76
03364         MOVE L081-CLAIMANT-NAME TO MAP-CLAIMANT-NAME              DTSCS76
03365      ELSE                                                         DTSCS76
03366         MOVE SPACES        TO MAP-CLAIMANT-NAME                   DTSCS76
03367         MOVE MSG-E76G-AREA TO WRK-MSG-AREA                        DTSCS76
03368         PERFORM S2601-ERROR THRU S2601-EXIT                       DTSCS76
03369         GO TO S2600-EXIT.                                         DTSCS76
03370                                                                   DTSCS76
03371      MOVE LCCM-CURR-RUN-DATE TO L004-DATE.                        DTSCS76
03372      PERFORM S004-FROM-DATE  THRU S004-EXIT.                      DTSCS76
03373      ADD +4                  TO L004-ABS-QTR.                     DTSCS76
03374      PERFORM S004-FROM-ABS   THRU S004-EXIT.                      DTSCS76
03375                                                                   DTSCS76
03376      MOVE MAP-WR-YRQ1-AREA TO L016-S-YRQ-AREA                     DTSCS76
03377      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS76
03378      IF L016-NO-ENTRY                                             DTSCS76
03379         MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA                  DTSCS76
03380         PERFORM S2602-ERROR THRU S2602-EXIT                       DTSCS76
03381         GO TO S2600-EXIT                                          DTSCS76
03382      ELSE                                                         DTSCS76
03383      IF L016-NOT-VALID                                            DTSCS76
03384         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03385         PERFORM S2602-ERROR THRU S2602-EXIT                       DTSCS76
03386         GO TO S2600-EXIT.                                         DTSCS76
03387                                                                   DTSCS76
03388      IF L016-YRQ >  L004-QTR-5-9                                  DTSCS76
03389         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03390         PERFORM S2602-ERROR THRU S2602-EXIT                       DTSCS76
03391         GO TO S2600-EXIT.                                         DTSCS76
03392                                                                   DTSCS76
03393      MOVE MAP-WR-YRQ2-AREA TO L016-S-YRQ-AREA                     DTSCS76
03394      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS76
03395      IF L016-NO-ENTRY                                             DTSCS76
03396         NEXT SENTENCE                                             DTSCS76
03397      ELSE                                                         DTSCS76
03398      IF L016-NOT-VALID                                            DTSCS76
03399         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03400         PERFORM S2603-ERROR THRU S2603-EXIT                       DTSCS76
03401         GO TO S2600-EXIT.                                         DTSCS76
03402                                                                   DTSCS76
03403      IF L016-YRQ >  L004-QTR-5-9                                  DTSCS76
03404         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03405         PERFORM S2603-ERROR THRU S2603-EXIT                       DTSCS76
03406         GO TO S2600-EXIT.                                         DTSCS76
03407                                                                   DTSCS76
03408      MOVE MAP-WR-YRQ3-AREA TO L016-S-YRQ-AREA                     DTSCS76
03409      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS76
03410      IF L016-NO-ENTRY                                             DTSCS76
03411         NEXT SENTENCE                                             DTSCS76
03412      ELSE                                                         DTSCS76
03413      IF L016-NOT-VALID                                            DTSCS76
03414         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03415         PERFORM S2604-ERROR THRU S2604-EXIT                       DTSCS76
03416         GO TO S2600-EXIT.                                         DTSCS76
03417                                                                   DTSCS76
03418      IF L016-YRQ >  L004-QTR-5-9                                  DTSCS76
03419         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03420         PERFORM S2604-ERROR THRU S2604-EXIT                       DTSCS76
03421         GO TO S2600-EXIT.                                         DTSCS76
03422                                                                   DTSCS76
03423      MOVE MAP-WR-YRQ4-AREA TO L016-S-YRQ-AREA                     DTSCS76
03424      PERFORM S016-YRQ-FROM-SCREEN THRU S016-EXIT                  DTSCS76
03425      IF L016-NO-ENTRY                                             DTSCS76
03426         NEXT SENTENCE                                             DTSCS76
03427      ELSE                                                         DTSCS76
03428      IF L016-NOT-VALID                                            DTSCS76
03429         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03430         PERFORM S2605-ERROR THRU S2605-EXIT                       DTSCS76
03431         GO TO S2600-EXIT.                                         DTSCS76
03432                                                                   DTSCS76
03433      IF L016-YRQ >  L004-QTR-5-9                                  DTSCS76
03434         MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                 DTSCS76
03435         PERFORM S2604-ERROR THRU S2604-EXIT                       DTSCS76
03436         GO TO S2600-EXIT.                                         DTSCS76
03437                                                                   DTSCS76
03438  S2600-EXIT. EXIT.                                                DTSCS76
03439                                                                   DTSCS76
03440  S2601-ERROR.                                                     DTSCS76
03441      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SSN-1-A               DTSCS76
03442                                         MAP-SSN-2-A               DTSCS76
03443                                         MAP-SSN-3-A.              DTSCS76
03444      IF LCCM-NO-MSG                                               DTSCS76
03445         MOVE WRK-MSG-AREA  TO LCCM-MSG-AREA                       DTSCS76
03446         MOVE CATB-CURSOR   TO MAP-SSN-1-L                         DTSCS76
03447         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03448  S2601-EXIT. EXIT.                                                DTSCS76
03449                                                                   DTSCS76
03450  S2602-ERROR.                                                     DTSCS76
03451      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ1-YR-A          DTSCS76
03452                                         MAP-WR-YRQ1-Q-A.          DTSCS76
03453      IF LCCM-NO-MSG                                               DTSCS76
03454         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03455         MOVE CATB-CURSOR TO MAP-WR-YRQ1-YR-L                      DTSCS76
03456         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03457  S2602-EXIT.                                                      DTSCS76
03458      EXIT.                                                        DTSCS76
03459  S2603-ERROR.                                                     DTSCS76
03460      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ2-YR-A          DTSCS76
03461                                         MAP-WR-YRQ2-Q-A.          DTSCS76
03462      IF LCCM-NO-MSG                                               DTSCS76
03463         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03464         MOVE CATB-CURSOR TO MAP-WR-YRQ2-YR-L                      DTSCS76
03465         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03466  S2603-EXIT.                                                      DTSCS76
03467      EXIT.                                                        DTSCS76
03468  S2604-ERROR.                                                     DTSCS76
03469      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ3-YR-A          DTSCS76
03470                                         MAP-WR-YRQ3-Q-A.          DTSCS76
03471      IF LCCM-NO-MSG                                               DTSCS76
03472         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03473         MOVE CATB-CURSOR TO MAP-WR-YRQ3-YR-L                      DTSCS76
03474         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03475  S2604-EXIT.                                                      DTSCS76
03476      EXIT.                                                        DTSCS76
03477  S2605-ERROR.                                                     DTSCS76
03478      MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-WR-YRQ4-YR-A          DTSCS76
03479                                         MAP-WR-YRQ4-Q-A.          DTSCS76
03480      IF LCCM-NO-MSG                                               DTSCS76
03481         MOVE WRK-MSG-AREA TO LCCM-MSG-AREA                        DTSCS76
03482         MOVE CATB-CURSOR TO MAP-WR-YRQ4-YR-L                      DTSCS76
03483         SET CURSOR-SET-YES TO TRUE.                               DTSCS76
03484  S2605-EXIT.                                                      DTSCS76
03485      EXIT.                                                        DTSCS76
03486      EJECT                                                        DTSCS76
03487  S3000-RPTS-EDITS.                                                DTSCS76
03488      IF WRK-MPRF-NO-88                                            DTSCS76
03489          GO TO S3000-EXIT.                                        DTSCS76
03490                                                                   DTSCS76
03491      IF MPRF-STATUS-SUB-88                                        DTSCS76
03492          NEXT SENTENCE                                            DTSCS76
03493      ELSE                                                         DTSCS76
03494          MOVE MSG-E765-AREA TO WRK-MSG-AREA                       DTSCS76
03495          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS76
03496                                                                   DTSCS76
03497      MOVE WRK-FROM-YRQ TO L004-QTR-5-9.                           DTSCS76
03498      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSCS76
03499                                                                   DTSCS76
03500      SET WRK-ANN-LIABLE-NO-88  TO TRUE.                           DTSCS76
03501      SET WRK-ANN-FILER-NO-88   TO TRUE.                           DTSCS76
03502                                                                   DTSCS76
03503      IF MPRF-ORG-HSEHLD-DMSTIC-88                                 DTSCS76
03504         SET L410-MODE-INPUT-YRQ-88 TO TRUE                        DTSCS76
03505         MOVE WRK-EMP-NO              TO L410-EMP-NO               DTSCS76
03506         MOVE WRK-FROM-YRQ            TO L410-YRQ                  DTSCS76
03507         PERFORM S410-FILING-SCHEDULE THRU S410-EXIT               DTSCS76
03508         IF L410-ANN-SCHED-88                                      DTSCS76
03509            SET WRK-ANN-FILER-YES-88  TO TRUE.                     DTSCS76
03510                                                                   DTSCS76
03511      PERFORM S3100-CHECK-LIAB-AND-RATE THRU S3100-EXIT            DTSCS76
03512          UNTIL (LCCM-MSG)                                         DTSCS76
03513                    OR                                             DTSCS76
03514                (L004-QTR-5-9 > WRK-TO-YRQ)                        DTSCS76
03515                    OR                                             DTSCS76
03516                (L004-INVALID-QTR).                                DTSCS76
03517                                                                   DTSCS76
03518      IF WRK-ANN-FILER-YES-88                                      DTSCS76
03519         IF WRK-ANN-LIABLE-NO-88                                   DTSCS76
03520            MOVE WRK-FROM-YRQ TO L004-QTR-5-9                      DTSCS76
03521            PERFORM S004-FROM-5 THRU S004-EXIT                     DTSCS76
03522            MOVE L004-SLASH-QTR TO MSG-E766-SLASH-QTR              DTSCS76
03523            MOVE MSG-E766-AREA TO WRK-MSG-AREA                     DTSCS76
03524            PERFORM S1401-ERROR THRU S1401-EXIT.                   DTSCS76
03525                                                                   DTSCS76
03526      IF LCCM-MSG                                                  DTSCS76
03527          GO TO S3000-EXIT.                                        DTSCS76
03528                                                                   DTSCS76
03529      IF MAP-FORCE-PRINT-YES                                       DTSCS76
03530          GO TO S3000-EXIT.                                        DTSCS76
03531                                                                   DTSCS76
03532                                                                   DTSCS76
03533      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSCS76
03534                                                                   DTSCS76
03535      MOVE WRK-EMP-NO TO MQTR-EMP-NO.                              DTSCS76
03536                                                                   DTSCS76
03537      SET MQTR-QTR-88 TO TRUE.                                     DTSCS76
03538                                                                   DTSCS76
03539      MOVE WRK-FROM-YRQ TO MQTR-YRQ.                               DTSCS76
03540                                                                   DTSCS76
03541      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSCS76
03542                                                                   DTSCS76
03543      PERFORM S810-START-BROWSE THRU S810-EXIT.                    DTSCS76
03544                                                                   DTSCS76
03545      PERFORM S3200-CHECK-FOR-RPT THRU S3200-EXIT                  DTSCS76
03546          UNTIL L810-NO-REC-88.                                    DTSCS76
03547                                                                   DTSCS76
03548      IF WRK-ANN-FILER-YES-88                                      DTSCS76
03549         PERFORM S3300-ANNUAL-REPORT  THRU S3300-EXIT              DTSCS76
03550         IF LCCM-MSG                                               DTSCS76
03551             GO TO S3000-EXIT.                                     DTSCS76
03552                                                                   DTSCS76
03553      PERFORM S3400-MASS-MAILING      THRU S3400-EXIT.             DTSCS76
03554                                                                   DTSCS76
03555  S3000-EXIT.                                                      DTSCS76
03556      EXIT.                                                        DTSCS76
03557                                                                   DTSCS76
03558                                                                   DTSCS76
03559                                                                   DTSCS76
03560  S3100-CHECK-LIAB-AND-RATE.                                       DTSCS76
03561      MOVE WRK-EMP-NO TO L381-EMP-NO.                              DTSCS76
03562                                                                   DTSCS76
03563      MOVE L004-QTR-5-9 TO L381-YRQ.                               DTSCS76
03564                                                                   DTSCS76
03565      MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS.                       DTSCS76
03566                                                                   DTSCS76
03567      PERFORM S381-DETERM-LIABILITY THRU S381-EXIT.                DTSCS76
03568                                                                   DTSCS76
03569      IF WRK-ANN-FILER-YES-88                                      DTSCS76
03570         IF L381-LIABLE-88                                         DTSCS76
03571            SET WRK-ANN-LIABLE-YES-88 TO TRUE                      DTSCS76
03572         END-IF                                                    DTSCS76
03573      ELSE                                                         DTSCS76
03574      IF L381-NOT-LIABLE-88                                        DTSCS76
03575          MOVE L004-SLASH-QTR TO MSG-E766-SLASH-QTR                DTSCS76
03576          MOVE MSG-E766-AREA TO WRK-MSG-AREA                       DTSCS76
03577          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS76
03578          GO TO S3100-EXIT.                                        DTSCS76
03579                                                                   DTSCS76
03580      IF L381-CLASS-SELF-INS-88                                    DTSCS76
03581          NEXT SENTENCE                                            DTSCS76
03582      ELSE                                                         DTSCS76
03583          IF L381-UI-RATE-NOT-FOUND-88                             DTSCS76
03584              MOVE L004-SLASH-QTR TO MSG-E761-SLASH-QTR            DTSCS76
03585              MOVE MSG-E761-AREA TO WRK-MSG-AREA                   DTSCS76
03586              PERFORM S1401-ERROR THRU S1401-EXIT                  DTSCS76
03587              GO TO S3100-EXIT.                                    DTSCS76
03588                                                                   DTSCS76
03589      ADD +1 TO L004-ABS-QTR.                                      DTSCS76
03590                                                                   DTSCS76
03591      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSCS76
03592  S3100-EXIT.                                                      DTSCS76
03593      EXIT.                                                        DTSCS76
03594                                                                   DTSCS76
03595                                                                   DTSCS76
03596                                                                   DTSCS76
03597  S3200-CHECK-FOR-RPT.                                             DTSCS76
03598      MOVE MSKL-REC TO MQTR-REC.                                   DTSCS76
03599                                                                   DTSCS76
03600      IF MQTR-YRQ > WRK-TO-YRQ                                     DTSCS76
03601          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS76
03602          SET L810-NO-REC-88 TO TRUE                               DTSCS76
03603          GO TO S3200-EXIT.                                        DTSCS76
03604                                                                   DTSCS76
03605      IF MQTR-CURR-RCVD-88                                         DTSCS76
03606          MOVE MSG-E763-AREA TO WRK-MSG-AREA                       DTSCS76
03607          PERFORM S1501-ERROR THRU S1501-EXIT                      DTSCS76
03608          PERFORM S810-END-BROWSE THRU S810-EXIT                   DTSCS76
03609          SET L810-NO-REC-88 TO TRUE                               DTSCS76
03610          GO TO S3200-EXIT.                                        DTSCS76
03611                                                                   DTSCS76
03612      PERFORM S810-READ-NEXT THRU S810-EXIT.                       DTSCS76
03613  S3200-EXIT.                                                      DTSCS76
03614      EXIT.                                                        DTSCS76
03615      EJECT                                                        DTSCS76
03616  S3300-ANNUAL-REPORT.                                             DTSCS76
03617                                                                   DTSCS76
03618      MOVE WRK-FROM-YRQ    TO L004-QTR-5-9.                        DTSCS76
03619      IF L004-QTR-5-Q = 1                                          DTSCS76
03620         NEXT SENTENCE                                             DTSCS76
03621      ELSE                                                         DTSCS76
03622          MOVE MSG-E76F-AREA TO WRK-MSG-AREA                       DTSCS76
03623          PERFORM S1401-ERROR THRU S1401-EXIT.                     DTSCS76
03624                                                                   DTSCS76
03625      MOVE WRK-TO-YRQ    TO L004-QTR-5-9.                          DTSCS76
03626      IF L004-QTR-5-Q = 4                                          DTSCS76
03627         NEXT SENTENCE                                             DTSCS76
03628      ELSE                                                         DTSCS76
03629          MOVE MSG-E76F-AREA TO WRK-MSG-AREA                       DTSCS76
03630          PERFORM S1402-ERROR THRU S1402-EXIT.                     DTSCS76
03631  S3300-EXIT.                                                      DTSCS76
03632      EXIT.                                                        DTSCS76
03633                                                                   DTSCS76
03634  S3400-MASS-MAILING.                                              DTSCS76
03635      IF WRK-ANN-FILER-YES-88                                      DTSCS76
03636         MOVE WRK-FROM-YRQ              TO L004-QTR-5-9            DTSCS76
03637         MOVE L004-QTR-5-YR             TO L415-YR                 DTSCS76
03638         SET L415-MODE-INPUT-YEAR-88    TO TRUE                    DTSCS76
03639         PERFORM S415-HOUSEHOLD-DATES   THRU S415-EXIT             DTSCS76
03640         IF L415-NOT-FOUND-88                                      DTSCS76
03641            MOVE MSG-E76H-AREA TO WRK-MSG-AREA                     DTSCS76
03642            PERFORM S1401-ERROR THRU S1401-EXIT                    DTSCS76
03643         END-IF                                                    DTSCS76
03644      ELSE                                                         DTSCS76
03645         IF WRK-FROM-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ            DTSCS76
03646            MOVE MSG-E76H-AREA TO WRK-MSG-AREA                     DTSCS76
03647            PERFORM S1401-ERROR THRU S1401-EXIT                    DTSCS76
03648         END-IF                                                    DTSCS76
03649      END-IF.                                                      DTSCS76
03650                                                                   DTSCS76
03651  S3400-EXIT.                                                      DTSCS76
03652      EXIT.                                                        DTSCS76
03653      EJECT                                                        DTSCS76
03654  S4000-WAIVE-EDITS.                                               DTSCS76
03655      IF WRK-FROM-YRQ = +0                                         DTSCS76
03656          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS76
03657          PERFORM S1401-ERROR THRU S1401-EXIT                      DTSCS76
03658          PERFORM S1551-ERROR THRU S1551-EXIT                      DTSCS76
03659          GO TO S4000-EXIT.                                        DTSCS76
03660                                                                   DTSCS76
03661                                                                   DTSCS76
03662      IF WRK-TO-YRQ > LCCM-LAST-UC30-MASS-MAIL-YRQ                 DTSCS76
03663          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS76
03664          PERFORM S1402-ERROR THRU S1402-EXIT                      DTSCS76
03665          PERFORM S1551-ERROR THRU S1551-EXIT                      DTSCS76
03666          GO TO S4000-EXIT.                                        DTSCS76
03667                                                                   DTSCS76
03668                                                                   DTSCS76
03669      MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9.                DTSCS76
03670                                                                   DTSCS76
03671      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS76
03672                                                                   DTSCS76
03673      ADD +45 TO L001-JUL-ABS-DAY.                                 DTSCS76
03674                                                                   DTSCS76
03675      PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSCS76
03676                                                                   DTSCS76
03677      IF (WRK-WAIVE-EXT-DATE < LCCM-CURR-MAIL-DATE)                DTSCS76
03678              OR                                                   DTSCS76
03679         (WRK-WAIVE-EXT-DATE > L001-FED-8-DATE-9)                  DTSCS76
03680          MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
03681          PERFORM S1551-ERROR THRU S1551-EXIT                      DTSCS76
03682          GO TO S4000-EXIT.                                        DTSCS76
03683                                                                   DTSCS76
03684                                                                   DTSCS76
03685      MOVE WRK-TO-YRQ TO L004-QTR-5-9.                             DTSCS76
03686                                                                   DTSCS76
03687      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSCS76
03688                                                                   DTSCS76
03689      IF L004-QTR-DEFAULT-DUE-DATE NOT < WRK-WAIVE-EXT-DATE        DTSCS76
03690          MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS76
03691          PERFORM S1402-ERROR THRU S1402-EXIT                      DTSCS76
03692          PERFORM S1551-ERROR THRU S1551-EXIT                      DTSCS76
03693          GO TO S4000-EXIT.                                        DTSCS76
03694  S4000-EXIT.                                                      DTSCS76
03695      EXIT.                                                        DTSCS76
03696      EJECT                                                        DTSCS76
03697 *S4500-5E-WAIVE-EDITS.                                            DTSCS76
03698 *****IF WRK-5E-FROM-YRQ = +0                                      DTSCS76
03699 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS76
03700 *********PERFORM S1601-ERROR THRU S1601-EXIT                      DTSCS76
03701 *********PERFORM S1751-ERROR THRU S1751-EXIT                      DTSCS76
03702 *********GO TO S4500-EXIT.                                        DTSCS76
03703                                                                   DTSCS76
03704 *****IF WRK-5E-TO-YRQ > LCCM-LAST-UI5-MASS-MAIL-YRQ               DTSCS76
03705 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS76
03706 *********PERFORM S1602-ERROR THRU S1602-EXIT                      DTSCS76
03707 *********PERFORM S1751-ERROR THRU S1751-EXIT                      DTSCS76
03708 *********GO TO S4500-EXIT.                                        DTSCS76
03709                                                                   DTSCS76
03710 *****MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9.                DTSCS76
03711 *****PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSCS76
03712 *****ADD +45 TO L001-JUL-ABS-DAY.                                 DTSCS76
03713 *****PERFORM S001-FROM-ABS-DAY THRU S001-EXIT.                    DTSCS76
03714                                                                   DTSCS76
03715 *****IF (WRK-5E-WAIVE-EXT-DATE < LCCM-CURR-MAIL-DATE)             DTSCS76
03716 *************OR                                                   DTSCS76
03717 ********(WRK-5E-WAIVE-EXT-DATE > L001-FED-8-DATE-9)               DTSCS76
03718 *********MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA                DTSCS76
03719 *********PERFORM S1751-ERROR THRU S1751-EXIT                      DTSCS76
03720 *********GO TO S4500-EXIT.                                        DTSCS76
03721                                                                   DTSCS76
03722 *****MOVE WRK-5E-TO-YRQ TO L004-QTR-5-9.                          DTSCS76
03723 *****PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSCS76
03724                                                                   DTSCS76
03725 *****IF L004-QTR-DEFAULT-DUE-DATE NOT < WRK-5E-WAIVE-EXT-DATE     DTSCS76
03726 *********MOVE EMSG-CROSS-EDIT TO WRK-MSG-AREA                     DTSCS76
03727 *********PERFORM S1602-ERROR THRU S1602-EXIT                      DTSCS76
03728 *********PERFORM S1751-ERROR THRU S1751-EXIT                      DTSCS76
03729 *********GO TO S4500-EXIT.                                        DTSCS76
03730 *S4500-EXIT.                                                      DTSCS76
03731 *****EXIT.                                                        DTSCS76
03732 /*****************************************************************DTSCS76
03733 * LOCK SCREEN FOR UPDATE CONFIRMATION                            *DTSCS76
03734 ******************************************************************DTSCS76
03735  S8100-SET-LOCK-ATTRB.                                            DTSCS76
03736      MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN                      DTSCS76
03737                                   WRK-ATB-NUM.                    DTSCS76
03738                                                                   DTSCS76
03739      PERFORM S8900-SET-ATTRB THRU S8900-EXIT.                     DTSCS76
03740                                                                   DTSCS76
03741      MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A                  DTSCS76
03742                                   MAP-EMP-NO-2-A                  DTSCS76
03743                                   MAP-GOTO-A.                     DTSCS76
03744  S8100-EXIT.                                                      DTSCS76
03745      EXIT.                                                        DTSCS76
03746                                                                   DTSCS76
03747                                                                   DTSCS76
03748                                                                   DTSCS76
03749 ******************************************************************DTSCS76
03750 * SET ATTIBUTE BYTES FOR UPDATE ACCESS                           *DTSCS76
03751 ******************************************************************DTSCS76
03752  S8200-SET-UPDATE-ATTRB.                                          DTSCS76
03753      MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN.                 DTSCS76
03754                                                                   DTSCS76
03755      MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM.               DTSCS76
03756                                                                   DTSCS76
03757                                                                   DTSCS76
03758      PERFORM S8900-SET-ATTRB THRU S8900-EXIT.                     DTSCS76
03759  S8200-EXIT.                                                      DTSCS76
03760      EXIT.                                                        DTSCS76
03761                                                                   DTSCS76
03762                                                                   DTSCS76
03763                                                                   DTSCS76
03764 ******************************************************************DTSCS76
03765 *  SET ATTRIBUTE BYTES FOR INQUIRY STATUS                        *DTSCS76
03766 ******************************************************************DTSCS76
03767  S8300-SET-INQ-ATTRB.                                             DTSCS76
03768      MOVE CATB-ASKIP-BRT-MDTON  TO WRK-ATB-AN                     DTSCS76
03769                                    WRK-ATB-NUM.                   DTSCS76
03770                                                                   DTSCS76
03771                                                                   DTSCS76
03772      PERFORM S8900-SET-ATTRB THRU S8900-EXIT.                     DTSCS76
03773  S8300-EXIT.                                                      DTSCS76
03774      EXIT.                                                        DTSCS76
03775                                                                   DTSCS76
03776                                                                   DTSCS76
03777                                                                   DTSCS76
03778  S8900-SET-ATTRB.                                                 DTSCS76
03779      MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A             DTSCS76
03780                                        MAP-EMP-NO-2-A.            DTSCS76
03781                                                                   DTSCS76
03782      MOVE CATB-ASKIP-BRT-MDTON  TO MAP-PRIMARY-NAME-A.            DTSCS76
03783                                                                   DTSCS76
03784      MOVE WRK-ATB-NUM TO MAP-MAILING-LABELS-A                     DTSCS76
03785 *************************MAP-ELF-LABELS-A                         DTSCS76
03786                          MAP-FROM-YRQ-YR-A                        DTSCS76
03787                          MAP-FROM-YRQ-Q-A                         DTSCS76
03788                          MAP-TO-YRQ-YR-A                          DTSCS76
03789                          MAP-TO-YRQ-Q-A                           DTSCS76
03790                          MAP-WAIVE-EXT-MO-A                       DTSCS76
03791                          MAP-WAIVE-EXT-DA-A                       DTSCS76
03792                          MAP-WAIVE-EXT-YR-A                       DTSCS76
03793                          MAP-STMT-FROM-YRQ-YR-A                   DTSCS76
03794                          MAP-STMT-FROM-YRQ-Q-A                    DTSCS76
03795                          MAP-STMT-TO-YRQ-YR-A                     DTSCS76
03796                          MAP-STMT-TO-YRQ-Q-A                      DTSCS76
03797 *************************MAP-5E-WAIVE-EXT-MO-A                    DTSCS76
03798 *************************MAP-5E-WAIVE-EXT-DA-A                    DTSCS76
03799 *************************MAP-5E-WAIVE-EXT-YR-A                    DTSCS76
03800                          MAP-SSN-1-A                              DTSCS76
03801                          MAP-SSN-2-A                              DTSCS76
03802                          MAP-SSN-3-A                              DTSCS76
03803                          MAP-WR-YRQ1-YR-A                         DTSCS76
03804                          MAP-WR-YRQ1-Q-A                          DTSCS76
03805                          MAP-WR-YRQ2-YR-A                         DTSCS76
03806                          MAP-WR-YRQ2-Q-A                          DTSCS76
03807                          MAP-WR-YRQ3-YR-A                         DTSCS76
03808                          MAP-WR-YRQ3-Q-A                          DTSCS76
03809                          MAP-WR-YRQ4-YR-A                         DTSCS76
03810                          MAP-WR-YRQ4-Q-A                          DTSCS76
03811                          MAP-ADDR-ID-NO-A.                        DTSCS76
03812 *************************MAP-NOTICE-OF-COVERAGE-A.                DTSCS76
03813                                                                   DTSCS76
03814 *****MOVE WRK-ATB-AN TO MAP-ELF-IND-A                             DTSCS76
03815 ************************MAP-5E-FORCE-PRINT-A.                     DTSCS76
03816                                                                   DTSCS76
03817      MOVE WRK-ATB-AN TO MAP-FORCE-PRINT-A                         DTSCS76
03818                         MAP-NOTICE-OF-SUBJECT-A                   DTSCS76
03819                         MAP-REQUEST-FOR-FEIN-A                    DTSCS76
03820                         MAP-ADDR-TYPE-A                           DTSCS76
03821                         MAP-AR-AUDIT-TRAIL-A                      DTSCS76
03822                         MAP-RESPONSIBLE-OP-ID-A.                  DTSCS76
03823                                                                   DTSCS76
03824      MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A.                 DTSCS76
03825  S8900-EXIT.                                                      DTSCS76
03826      EXIT.                                                        DTSCS76
03827 /*****************************************************************DTSCS76
03828 * MAP ROUTINES                                                   *DTSCS76
03829 ******************************************************************DTSCS76
03830  S9100-RECEIVE.                                                   DTSCS76
03831      SET L851-RECEIVE-88 TO TRUE.                                 DTSCS76
03832                                                                   DTSCS76
03833      MOVE WRK-SCR-ID TO L851-SCR-ID.                              DTSCS76
03834                                                                   DTSCS76
03835      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS76
03836                                                                   DTSCS76
03837      MOVE L851-AID TO LCCM-AID.                                   DTSCS76
03838                                                                   DTSCS76
03839      MOVE L851-CURSOR TO LCCM-CURSOR.                             DTSCS76
03840  S9100-EXIT.                                                      DTSCS76
03841      EXIT.                                                        DTSCS76
03842                                                                   DTSCS76
03843                                                                   DTSCS76
03844                                                                   DTSCS76
03845  S9200-SEND-DATAONLY.                                             DTSCS76
03846      MOVE LOW-VALUES TO MAP-AREA.                                 DTSCS76
03847                                                                   DTSCS76
03848      IF LCCM-NO-MSG                                               DTSCS76
03849          NEXT SENTENCE                                            DTSCS76
03850      ELSE                                                         DTSCS76
03851          PERFORM S805-MSG-AREA THRU S805-EXIT.                    DTSCS76
03852                                                                   DTSCS76
03853      IF CURSOR-SET-GOTO                                           DTSCS76
03854          MOVE CATB-CURSOR TO MAP-GOTO-L                           DTSCS76
03855      ELSE                                                         DTSCS76
03856          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS76
03857                                                                   DTSCS76
03858      SET L851-SEND-DATAONLY-88 TO TRUE.                           DTSCS76
03859                                                                   DTSCS76
03860      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS76
03861                                                                   DTSCS76
03862      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS76
03863  S9200-EXIT.                                                      DTSCS76
03864      EXIT.                                                        DTSCS76
03865                                                                   DTSCS76
03866                                                                   DTSCS76
03867                                                                   DTSCS76
03868  S9300-SEND-MAP.                                                  DTSCS76
03869      MOVE  LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE.             DTSCS76
03870                                                                   DTSCS76
03871      MOVE  LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME.             DTSCS76
03872                                                                   DTSCS76
03873      MOVE  LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME.         DTSCS76
03874                                                                   DTSCS76
03875      IF SCR-ACCESS-UPDATE                                         DTSCS76
03876          PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT               DTSCS76
03877      ELSE                                                         DTSCS76
03878          PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.             DTSCS76
03879                                                                   DTSCS76
03880      PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT.                   DTSCS76
03881                                                                   DTSCS76
03882      PERFORM S805-MSG-AREA THRU S805-EXIT.                        DTSCS76
03883                                                                   DTSCS76
03884      IF CURSOR-SET-NO                                             DTSCS76
03885          MOVE CATB-CURSOR TO MAP-EMP-NO-1-L.                      DTSCS76
03886                                                                   DTSCS76
03887      SET L851-SEND-88 TO TRUE.                                    DTSCS76
03888                                                                   DTSCS76
03889      PERFORM S9900-PREPARE-SEND THRU S9900-EXIT.                  DTSCS76
03890                                                                   DTSCS76
03891      PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT.               DTSCS76
03892  S9300-EXIT.                                                      DTSCS76
03893      EXIT.                                                        DTSCS76
03894                                                                   DTSCS76
03895                                                                   DTSCS76
03896                                                                   DTSCS76
03897  S9310-UPDATE-FKEYS.                                              DTSCS76
03898      PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT.                 DTSCS76
03899                                                                   DTSCS76
03900      MOVE CFKD-ADD TO MAP-KEY-ADD.                                DTSCS76
03901                                                                   DTSCS76
03902      IF LCCM-SCR-CLEAR                                            DTSCS76
03903          NEXT SENTENCE                                            DTSCS76
03904      ELSE                                                         DTSCS76
03905      IF LCCM-SCR-INQUIRE                                          DTSCS76
03906          NEXT SENTENCE                                            DTSCS76
03907      ELSE                                                         DTSCS76
03908      IF LCCM-SCR-UPDATE-LOCKED                                    DTSCS76
03909          MOVE LOW-VALUES TO MAP-KEY-ADD                           DTSCS76
03910      ELSE                                                         DTSCS76
03911          NEXT SENTENCE.                                           DTSCS76
03912  S9310-EXIT.                                                      DTSCS76
03913      EXIT.                                                        DTSCS76
03914                                                                   DTSCS76
03915                                                                   DTSCS76
03916                                                                   DTSCS76
03917  S9320-INQUIRY-FKEYS.                                             DTSCS76
03918      MOVE LOW-VALUES TO MAP-KEY-ADD.                              DTSCS76
03919                                                                   DTSCS76
03920 *****PERFORM S9321-JUMP-KEYS THRU S9321-EXIT.                     DTSCS76
03921  S9320-EXIT.                                                      DTSCS76
03922      EXIT.                                                        DTSCS76
03923                                                                   DTSCS76
03924                                                                   DTSCS76
03925                                                                   DTSCS76
03926 *S9321-JUMP-KEYS.                                                 DTSCS76
03927 *****MOVE CFKD-REG-INQ TO  MAP-KEY-REG-INQ.                       DTSCS76
03928 *****MOVE CFKD-REG-SEARCH TO  MAP-KEY-SEARCH.                     DTSCS76
03929 *****MOVE CFKD-COLL-INQ TO  MAP-KEY-COLL-INQ.                     DTSCS76
03930 *****MOVE CFKD-QTR-INQ TO  MAP-KEY-QTR-INQ.                       DTSCS76
03931 *S9321-EXIT.                                                      DTSCS76
03932 *****EXIT.                                                        DTSCS76
03933                                                                   DTSCS76
03934                                                                   DTSCS76
03935                                                                   DTSCS76
03936  S9330-DSCR-FIELDS.                                               DTSCS76
03937      MOVE LOW-VALUES TO MAP-PRIMARY-NAME.                         DTSCS76
03938                                                                   DTSCS76
03939      IF WRK-MPRF-YES-88                                           DTSCS76
03940          MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME               DTSCS76
03941      ELSE                                                         DTSCS76
03942      IF WRK-MPRF-NO-88                                            DTSCS76
03943         MOVE 'MAY BE ARCHIVED' TO MAP-PRIMARY-NAME.               DTSCS76
03944                                                                   DTSCS76
03945      IF MAP-RESPONSIBLE-OP-ID = LOW-VALUES OR SPACES              DTSCS76
03946          MOVE LOW-VALUES TO MAP-RESPONSIBLE-OP-ID-DSCR            DTSCS76
03947      ELSE                                                         DTSCS76
03948      IF MAP-RESPONSIBLE-OP-ID = LCCM-OP-ID                        DTSCS76
03949          MOVE LCCM-OP-NAME TO MAP-RESPONSIBLE-OP-ID-DSCR          DTSCS76
03950      ELSE                                                         DTSCS76
03951          MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID                 DTSCS76
03952          PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT                 DTSCS76
03953          MOVE L082-NAME TO MAP-RESPONSIBLE-OP-ID-DSCR.            DTSCS76
03954  S9330-EXIT.                                                      DTSCS76
03955      EXIT.                                                        DTSCS76
03956                                                                   DTSCS76
03957                                                                   DTSCS76
03958                                                                   DTSCS76
03959  S9900-PREPARE-SEND.                                              DTSCS76
03960      MOVE WRK-SCR-ID TO L851-SCR-ID                               DTSCS76
03961                         LCCM-SCR-ID.                              DTSCS76
03962                                                                   DTSCS76
03963      MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND.                    DTSCS76
03964                                                                   DTSCS76
03965      MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE.                         DTSCS76
03966  S9900-EXIT.                                                      DTSCS76
03967      EXIT.                                                        DTSCS76
