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