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