00001  IDENTIFICATION DIVISION.                                         03/19/08
00002  PROGRAM-ID.             DTSCU422.                                DTSCU422
00003  AUTHOR.                 TRW.                                        LV009
00004  DATE-WRITTEN.           FEBRUARY 2002.                           DTSCU422
00005  DATE-COMPILED.                                                   DTSCU422
00006      SKIP3                                                        DTSCU422
00007 *****                                                             DTSCU422
00008 *               ***  ANNUAL REPORT VERSION  ***                   DTSCU422
00009 *                                                                 DTSCU422
00010 *    FUNCTION:  CREATE A TEMPORARY STORAGE FILE CONTAINING THE    DTSCU422
00011 *               SSN OF EACH WORKER REPORTED DURING THE LAST YEAR  DTSCU422
00012 *               OR THE CURRENT YEAR FOR A GIVEN EMPLOYER, AND     DTSCU422
00013 *               THE WAGES REPORTED DURING THE CURRENT YEAR.       DTSCU422
00014 *                                                                 DTSCU422
00015 *               THIS PROGRAM IS USED TO PREFILL THE ANNUAL REPORT DTSCU422
00016 *               ENTRY SCREEN (27) WITH SSNS FOR ALL WORKERS       DTSCU422
00017 *               REPORTED, AND TO RETURN THE TOTAL WAGES PREVIOUSLYDTSCU422
00018 *               REPORTED FOR USE IN CALCULATING TAXABLE WAGES     DTSCU422
00019 *               FOR SUPPLEMENTAL REPORTS.                         DTSCU422
00020 *                                                                 DTSCU422
00021 *    MODIFICATION LOG:                                            DTSCU422
00022 *                                                                 DTSCU422
00023 *    02/18/2002  INITIAL DEVELOPMENT.                             DTSCU422
00024 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU422
00025 *                                                                 DTSCU422
00026 *    03/24/2004  ADDED P2000 TO FIND NAMES IN WAGE NAME FILE.     DTSCU422
00027 *                WORK ORDER: EFT                  PROGRAMMER: GD  DTSCU422
00028 *                                                                 DTSCU422
00029 *    04/08/2004  CORRECTED PROBLEM IN LOADING DATA TO TEMP        DTSCU422
00030 *                STORAGE IN P3200. CODE THAT TESTED WHEN          DTSCU422
00031 *                SUBSCRIPT EXCEEDED WRK-WAGE-TBL-MAX WAS          DTSCU422
00032 *                INCORRECT, AND THE FIRST WAGE ITEM ON THE        DTSCU422
00033 *                NEW PAGE WAS BEING DROPPED.                      DTSCU422
00034 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU422
00035 *                                                                 DTSCU422
00036 *    03/19/2008  CORRECTED PROBLEM IN P1920 (INSERT ROW INTO      DTSCU422
00037 *                SSN TABLE.  OLD ROW WAS NOT INITIALIZED AFTER    DTSCU422
00038 *                OLD DATA MOVED TO NEW ROW.                       DTSCU422
00039 *                WORK ORDER:                      PROGRAMMER: GD  DTSCU422
00040 *                                                                 DTSCU422
00041 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU422
00042 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU422
00043 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU422
00044 *                                                                 DTSCU422
00045 *                                                                 DTSCU422
00046 *    DESCRIPTION:                                                 DTSCU422
00047 *                                                                 DTSCU422
00048 *        DTSCU422 READ THE EMPLOYER-ORIENTED WAGE HISTORY FILE    DTSCU422
00049 *        (WGH) FOR A GIVEN EMPLOYER, AND RETURNS THE SSNS OF      DTSCU422
00050 *        ALL WORKERS REPORTED, AND ANY WAGES PREVIOUSLY           DTSCU422
00051 *        REPORTED FOR THE CURRENT YEAR.                           DTSCU422
00052 *                                                                 DTSCU422
00053 *                                                                 DTSCU422
00054 *    GENERAL SPECIFICATIONS:                                      DTSCU422
00055 *                                                                 DTSCU422
00056 *                                                                 DTSCU422
00057 *                                                                 DTSCU422
00058 *                                                                 DTSCU422
00059 *    COMMAND SPECIFIC SPECIFICATIONS:                             DTSCU422
00060 *                                                                 DTSCU422
00061 *                                                                 DTSCU422
00062 *                                                                 DTSCU422
00063 *****                                                             DTSCU422
00064      SKIP3                                                        DTSCU422
00065  DATA DIVISION.                                                   DTSCU422
00066  WORKING-STORAGE SECTION.                                         DTSCU422
000665 77  PAN-VALET PICTURE X(24) VALUE '009DTSCU422  03/19/08'.       DTSCU422
00067      SKIP3                                                        DTSCU422
00068  01  WRK-AREA.                                                    DTSCU422
00069      05  WRK-ABEND-CD             PIC  X(04)      VALUE 'U422'.   DTSCU422
00070                                                                   DTSCU422
00071      05  WRK-MOD-NAME             PIC  X(08)  VALUE 'DTSCU422'.   DTSCU422
00072                                                                   DTSCU422
00073      05  TBL-SUB                  PIC S9(04) COMP.                DTSCU422
00074      05  TBL-CNT                  PIC S9(04) COMP VALUE +0.       DTSCU422
00075      05  TBL-MAX                  PIC S9(04) COMP                 DTSCU422
00076                                          VALUE +250.              DTSCU422
00077      05  SSN-SUB                  PIC S9(04) COMP.                DTSCU422
00078      05  NXT-SUB                  PIC S9(04) COMP.                DTSCU422
00079                                                                   DTSCU422
00080      05  WRK-INDEX-IND               PIC  X(01).                  DTSCU422
00081          88  WRK-INDEX-NULL-88           VALUE '0'.               DTSCU422
00082          88  WRK-INDEX-POSITION-FOUND-88 VALUE '1'.               DTSCU422
00083          88  WRK-INDEX-SSN-FOUND-88      VALUE '2'.               DTSCU422
00084          88  WRK-INDEX-FOUND-88          VALUE '1' '2'.           DTSCU422
00085                                                                   DTSCU422
00086      05  WRK-TOT-CURR-WAGE           PIC S9(11)V99 COMP-3.        DTSCU422
00087      05  WRK-MAX-SSN                 PIC S9(09)    COMP-3         DTSCU422
00088                                         VALUE +0.                 DTSCU422
00089      05  WRK-LAST-DUMMY-SSN          PIC S9(09)    COMP-3         DTSCU422
00090                                         VALUE +0.                 DTSCU422
00091                                                                   DTSCU422
00092      05  PRIOR-QTR1                  PIC S9(05)    COMP-3.        DTSCU422
00093      05  PRIOR-QTR2                  PIC S9(05)    COMP-3.        DTSCU422
00094      05  PRIOR-QTR3                  PIC S9(05)    COMP-3.        DTSCU422
00095      05  PRIOR-QTR4                  PIC S9(05)    COMP-3.        DTSCU422
00096                                                                   DTSCU422
00097      05  WRK-SSN-TBL OCCURS 250 TIMES.                            DTSCU422
00098          10  WRK-SSN                 PIC S9(09)    COMP-3.        DTSCU422
00099              88  WRK-SSN-DUMMY-88  VALUE +1 THRU +999999.         DTSCU422
00100          10  WRK-SSN-NAME            PIC  X(03).                  DTSCU422
00101          10  WRK-QTR1-CURR-WAGE      PIC S9(07)V99 COMP-3.        DTSCU422
00102          10  WRK-QTR1-PRIOR-WAGE     PIC S9(07)V99 COMP-3.        DTSCU422
00103          10  WRK-QTR2-CURR-WAGE      PIC S9(07)V99 COMP-3.        DTSCU422
00104          10  WRK-QTR2-PRIOR-WAGE     PIC S9(07)V99 COMP-3.        DTSCU422
00105          10  WRK-QTR3-CURR-WAGE      PIC S9(07)V99 COMP-3.        DTSCU422
00106          10  WRK-QTR3-PRIOR-WAGE     PIC S9(07)V99 COMP-3.        DTSCU422
00107          10  WRK-QTR4-CURR-WAGE      PIC S9(07)V99 COMP-3.        DTSCU422
00108          10  WRK-QTR4-PRIOR-WAGE     PIC S9(07)V99 COMP-3.        DTSCU422
00109                                                                   DTSCU422
00110      05  WRK-WAGE-TBL-MAX         PIC S9(04) COMP                 DTSCU422
00111                                          VALUE +10.               DTSCU422
00112      05  TS-SUB                   PIC S9(04) COMP.                DTSCU422
00113      05  ITEM-LENGTH              PIC S9(04) COMP                 DTSCU422
00114                                          VALUE +1007.             DTSCU422
00115      EJECT                                                        DTSCU422
00116  01  L004-COMM-AREA.                                              DTSCU422
00117  ++INCLUDE DTSIL004                                               DTSCU422
00118                                                                   DTSCU422
00119  01  L829-COMM-AREA.                                              DTSCU422
00120      05  L829-CONTROL-BLOCK.                                      DTSCU422
00121  ++INCLUDE DTSIL829                                               DTSCU422
00122      05  L829-REC                         PIC X(1007).            DTSCU422
00123                                                                   DTSCU422
00124  01  L427-COMM-AREA.                                              DTSCU422
00125  ++INCLUDE DTSIL427                                               DTSCU422
00126                                                                   DTSCU422
00127  01  L881-COMM-AREA.                                              DTSCU422
00128      05  L881-CONTROL-BLOCK.                                      DTSCU422
00129  ++INCLUDE DTSIL881                                               DTSCU422
00130                                                                   DTSCU422
00131      05  WWGH-COMM-REC.                                           DTSCU422
00132  ++INCLUDE DTSIWWGH                                               DTSCU422
00133                                                                   DTSCU422
00134  01  L882-COMM-AREA.                                              DTSCU422
00135      05  L882-CONTROL-BLOCK.                                      DTSCU422
00136  ++INCLUDE DTSIL882                                               DTSCU422
00137                                                                   DTSCU422
00138      05  WNAM-COMM-REC.                                           DTSCU422
00139  ++INCLUDE DTSIWNAM                                               DTSCU422
00140                                                                   DTSCU422
00141  LINKAGE SECTION.                                                 DTSCU422
00142      SKIP3                                                        DTSCU422
00143  01  DFHCOMMAREA.                                                 DTSCU422
00144  ++INCLUDE DTSIL422                                               DTSCU422
00145      EJECT                                                        DTSCU422
00146  PROCEDURE DIVISION.                                              DTSCU422
00147                                                                   DTSCU422
00148      PERFORM I0000-INIT-TABLE         THRU I0000-EXIT.            DTSCU422
00149                                                                   DTSCU422
00150      PERFORM P0000-PROCESS            THRU P0000-EXIT.            DTSCU422
00151                                                                   DTSCU422
00152      GOBACK.                                                      DTSCU422
00153      EJECT                                                        DTSCU422
00154  I0000-INIT-TABLE.                                                DTSCU422
00155      PERFORM                                                      DTSCU422
00156         VARYING SSN-SUB FROM +1 BY +1                             DTSCU422
00157         UNTIL SSN-SUB > TBL-MAX                                   DTSCU422
00158            MOVE ZERO       TO WRK-SSN (SSN-SUB)                   DTSCU422
00159                               WRK-QTR1-CURR-WAGE (SSN-SUB)        DTSCU422
00160                               WRK-QTR1-PRIOR-WAGE (SSN-SUB)       DTSCU422
00161                               WRK-QTR2-CURR-WAGE (SSN-SUB)        DTSCU422
00162                               WRK-QTR2-PRIOR-WAGE (SSN-SUB)       DTSCU422
00163                               WRK-QTR3-CURR-WAGE (SSN-SUB)        DTSCU422
00164                               WRK-QTR3-PRIOR-WAGE (SSN-SUB)       DTSCU422
00165                               WRK-QTR4-CURR-WAGE (SSN-SUB)        DTSCU422
00166                               WRK-QTR4-PRIOR-WAGE (SSN-SUB)       DTSCU422
00167            MOVE SPACES     TO WRK-SSN-NAME (SSN-SUB)              DTSCU422
00168      END-PERFORM.                                                 DTSCU422
00169                                                                   DTSCU422
00170      MOVE L422-QTR1                    TO L004-QTR-5-9.           DTSCU422
00171      SUBTRACT 1                        FROM L004-QTR-5-YR.        DTSCU422
00172      MOVE L004-QTR-5-9                 TO PRIOR-QTR1.             DTSCU422
00173                                                                   DTSCU422
00174      MOVE L422-QTR2                    TO L004-QTR-5-9.           DTSCU422
00175      SUBTRACT 1                        FROM L004-QTR-5-YR.        DTSCU422
00176      MOVE L004-QTR-5-9                 TO PRIOR-QTR2.             DTSCU422
00177                                                                   DTSCU422
00178      MOVE L422-QTR3                    TO L004-QTR-5-9.           DTSCU422
00179      SUBTRACT 1                        FROM L004-QTR-5-YR.        DTSCU422
00180      MOVE L004-QTR-5-9                 TO PRIOR-QTR3.             DTSCU422
00181                                                                   DTSCU422
00182      MOVE L422-QTR4                    TO L004-QTR-5-9.           DTSCU422
00183      SUBTRACT 1                        FROM L004-QTR-5-YR.        DTSCU422
00184      MOVE L004-QTR-5-9                 TO PRIOR-QTR4.             DTSCU422
00185                                                                   DTSCU422
00186  I0000-EXIT.                                                      DTSCU422
00187      EXIT.                                                        DTSCU422
00188                                                                   DTSCU422
00189  P0000-PROCESS.                                                   DTSCU422
00190                                                                   DTSCU422
00191      PERFORM P1000-CURR-WWGH-WAGES          THRU P1000-EXIT.      DTSCU422
00192                                                                   DTSCU422
00193      PERFORM P2000-FIND-NAMES               THRU P2000-EXIT.      DTSCU422
00194                                                                   DTSCU422
00195      PERFORM P3000-SAVE-TO-TS               THRU P3000-EXIT.      DTSCU422
00196                                                                   DTSCU422
00197  P0000-EXIT.                                                      DTSCU422
00198      EXIT.                                                        DTSCU422
00199                                                                   DTSCU422
00200 **************************************************************    DTSCU422
00201 *  THIS PROCEDURE CHECKS THE WAGE HISTORY FILE TO FIND THE        DTSCU422
00202 *  WORKERS THAT THE EMPLOYER REPORTED PREVIOUSLY.  THE SSNS       DTSCU422
00203 *  OF THESE WORKERS ARE RETURNED TO THE REPORT ENTRY SCREEN       DTSCU422
00204 *  TO SIMPLIFY DATA ENTRY - THE SCREEN USER DOES NOT NEED TO      DTSCU422
00205 *  RE-ENTER THE SSNS.  ONLY THE NAME CHECK AND WAGES ARE          DTSCU422
00206 *  REQUIRED.                                                      DTSCU422
00207 *                                                                 DTSCU422
00208 *  THE SEARCH STARTS WITH THE PRIOR YEAR AND CONTINUES THROUGH    DTSCU422
00209 *  THE CURRENT YEAR.  ANY CURRENT YEAR WAGES ON FILE ARE          DTSCU422
00210 *  RETURNED IN THE L422 LINKAGE AREA.                             DTSCU422
00211 *                                                                 DTSCU422
00212 *  IF L422-KEY = LOW-VALUES (MEANING THAT THIS IS THE             DTSCU422
00213 *  FIRST CALL TO THE PROGRAM), START THE BROWSE AT THE FIRST      DTSCU422
00214 *  QUARTER OF THE PRIOR YEAR.  AFTER THE FIRST CALL,              DTSCU422
00215 *  L422-KEY WILL CONTAIN THE KEY OF THE LAST RECORD READ.         DTSCU422
00216 *  IN THIS CASE, START THE BROWSE WITH THE RECORD FOLLOWING       DTSCU422
00217 *  THE LAST ONE READ.                                             DTSCU422
00218 **************************************************************    DTSCU422
00219  P1000-CURR-WWGH-WAGES.                                           DTSCU422
00220      MOVE ZERO                      TO TBL-SUB.                   DTSCU422
00221      SET L422-ERR-NO-88             TO TRUE.                      DTSCU422
00222                                                                   DTSCU422
00223      PERFORM P1100-SCAN-WWGH        THRU P1100-EXIT.              DTSCU422
00224                                                                   DTSCU422
00225  P1000-EXIT.                                                      DTSCU422
00226      EXIT.                                                        DTSCU422
00227                                                                   DTSCU422
00228  P1100-SCAN-WWGH.                                                 DTSCU422
00229      MOVE LOW-VALUE                    TO WWGH-COMM-REC.          DTSCU422
00230      MOVE L422-EMP-NO                  TO WWGH-EMP-NO.            DTSCU422
00231      MOVE L422-QTR1                    TO L004-QTR-5-9.           DTSCU422
00232      SUBTRACT 1                        FROM L004-QTR-5-YR.        DTSCU422
00233                                                                   DTSCU422
00234      PERFORM S881A-START-BROWSE        THRU S881A-EXIT.           DTSCU422
00235                                                                   DTSCU422
00236      IF L881-OK-88                                                DTSCU422
00237         PERFORM P1110-SCAN-WAGE-FILE   THRU P1110-EXIT            DTSCU422
00238            UNTIL L881-NO-REC-88                                   DTSCU422
00239            OR L422-ERR-IND NOT = '00'.                            DTSCU422
00240                                                                   DTSCU422
00241  P1100-EXIT.                                                      DTSCU422
00242      EXIT.                                                        DTSCU422
00243                                                                   DTSCU422
00244  P1110-SCAN-WAGE-FILE.                                            DTSCU422
00245      IF WWGH-EMP-NO                   NOT = L422-EMP-NO           DTSCU422
00246      OR WWGH-YRQ                      >     L422-QTR4             DTSCU422
00247         PERFORM S881C-END-BROWSE      THRU S881C-EXIT             DTSCU422
00248         SET L881-NO-REC-88            TO TRUE                     DTSCU422
00249         GO TO P1110-EXIT                                          DTSCU422
00250      ELSE                                                         DTSCU422
00251         IF L422-RPT-TYPE-ORIG-88                                  DTSCU422
00252         AND WWGH-SSN < +1000000                                   DTSCU422
00253            NEXT SENTENCE                                          DTSCU422
00254         END-IF                                                    DTSCU422
00255         PERFORM P1900-FIND-INDEX      THRU P1900-EXIT             DTSCU422
00256         IF L422-ERR-NO-88                                         DTSCU422
00257            PERFORM P1111-MOVE-WAGES   THRU P1111-EXIT             DTSCU422
00258         ELSE                                                      DTSCU422
00259            GO TO P1110-EXIT.                                      DTSCU422
00260                                                                   DTSCU422
00261      PERFORM S881B-READ-NEXT       THRU S881B-EXIT.               DTSCU422
00262                                                                   DTSCU422
00263  P1110-EXIT.                                                      DTSCU422
00264      EXIT.                                                        DTSCU422
00265                                                                   DTSCU422
00266  P1111-MOVE-WAGES.                                                DTSCU422
00267      MOVE WWGH-SSN         TO WRK-SSN (TBL-SUB)                   DTSCU422
00268                                                                   DTSCU422
00269      EVALUATE TRUE                                                DTSCU422
00270         WHEN WWGH-YRQ = L422-QTR1                                 DTSCU422
00271            ADD WWGH-EARNINGS TO WRK-QTR1-CURR-WAGE (TBL-SUB)      DTSCU422
00272         WHEN WWGH-YRQ = L422-QTR2                                 DTSCU422
00273            ADD WWGH-EARNINGS TO WRK-QTR2-CURR-WAGE (TBL-SUB)      DTSCU422
00274         WHEN WWGH-YRQ = L422-QTR3                                 DTSCU422
00275            ADD WWGH-EARNINGS TO WRK-QTR3-CURR-WAGE (TBL-SUB)      DTSCU422
00276         WHEN WWGH-YRQ = L422-QTR4                                 DTSCU422
00277            ADD WWGH-EARNINGS TO WRK-QTR4-CURR-WAGE (TBL-SUB)      DTSCU422
00278         WHEN WWGH-YRQ = PRIOR-QTR1                                DTSCU422
00279            ADD WWGH-EARNINGS TO WRK-QTR1-PRIOR-WAGE (TBL-SUB)     DTSCU422
00280         WHEN WWGH-YRQ = PRIOR-QTR2                                DTSCU422
00281            ADD WWGH-EARNINGS TO WRK-QTR2-PRIOR-WAGE (TBL-SUB)     DTSCU422
00282         WHEN WWGH-YRQ = PRIOR-QTR3                                DTSCU422
00283            ADD WWGH-EARNINGS TO WRK-QTR3-PRIOR-WAGE (TBL-SUB)     DTSCU422
00284         WHEN WWGH-YRQ = PRIOR-QTR4                                DTSCU422
00285            ADD WWGH-EARNINGS TO WRK-QTR4-PRIOR-WAGE (TBL-SUB)     DTSCU422
00286      END-EVALUATE.                                                DTSCU422
00287                                                                   DTSCU422
00288  P1111-EXIT.                                                      DTSCU422
00289      EXIT.                                                        DTSCU422
00290                                                                   DTSCU422
00291                                                                   DTSCU422
00292  P1900-FIND-INDEX.                                                DTSCU422
00293      SET WRK-INDEX-NULL-88            TO TRUE.                    DTSCU422
00294                                                                   DTSCU422
00295      IF WWGH-SSN > WRK-MAX-SSN                                    DTSCU422
00296         IF TBL-CNT < TBL-MAX                                      DTSCU422
00297            ADD +1                          TO TBL-CNT             DTSCU422
00298            MOVE TBL-CNT                    TO TBL-SUB             DTSCU422
00299            SET WRK-INDEX-POSITION-FOUND-88 TO TRUE                DTSCU422
00300            MOVE WWGH-SSN                   TO WRK-MAX-SSN         DTSCU422
00301         ELSE                                                      DTSCU422
00302            SET L422-ERR-OVER-250-88        TO TRUE                DTSCU422
00303         END-IF                                                    DTSCU422
00304      ELSE                                                         DTSCU422
00305         PERFORM P1910-SEARCH-TABLE         THRU P1910-EXIT        DTSCU422
00306         IF WRK-INDEX-POSITION-FOUND-88                            DTSCU422
00307            IF TBL-CNT < TBL-MAX                                   DTSCU422
00308               PERFORM P1920-INSERT-SSN     THRU P1920-EXIT        DTSCU422
00309            ELSE                                                   DTSCU422
00310               SET L422-ERR-OVER-250-88     TO TRUE                DTSCU422
00311            END-IF                                                 DTSCU422
00312         END-IF                                                    DTSCU422
00313      END-IF.                                                      DTSCU422
00314                                                                   DTSCU422
00315  P1900-EXIT.                                                      DTSCU422
00316      EXIT.                                                        DTSCU422
00317                                                                   DTSCU422
00318  P1910-SEARCH-TABLE.                                              DTSCU422
00319      PERFORM                                                      DTSCU422
00320         VARYING SSN-SUB FROM +1 BY +1                             DTSCU422
00321         UNTIL WRK-INDEX-FOUND-88                                  DTSCU422
00322         OR SSN-SUB > TBL-CNT                                      DTSCU422
00323            IF WRK-SSN (SSN-SUB) = WWGH-SSN                        DTSCU422
00324               SET WRK-INDEX-SSN-FOUND-88 TO TRUE                  DTSCU422
00325               MOVE SSN-SUB TO TBL-SUB                             DTSCU422
00326            ELSE                                                   DTSCU422
00327               IF WWGH-SSN < WRK-SSN (SSN-SUB)                     DTSCU422
00328                  MOVE SSN-SUB TO TBL-SUB                          DTSCU422
00329                  SET WRK-INDEX-POSITION-FOUND-88 TO TRUE          DTSCU422
00330               END-IF                                              DTSCU422
00331            END-IF                                                 DTSCU422
00332      END-PERFORM.                                                 DTSCU422
00333                                                                   DTSCU422
00334  P1910-EXIT.                                                      DTSCU422
00335      EXIT.                                                        DTSCU422
00336                                                                   DTSCU422
00337  P1920-INSERT-SSN.                                                DTSCU422
00338      PERFORM                                                      DTSCU422
00339         VARYING SSN-SUB FROM TBL-CNT BY -1                        DTSCU422
00340         UNTIL SSN-SUB < TBL-SUB                                   DTSCU422
00341            COMPUTE NXT-SUB = SSN-SUB + 1                          DTSCU422
00342            MOVE WRK-SSN-TBL (SSN-SUB) TO WRK-SSN-TBL (NXT-SUB)    DTSCU422
00343            PERFORM P1921-INIT-ROW     THRU P1921-EXIT             DTSCU422
00344      END-PERFORM.                                                 DTSCU422
00345                                                                   DTSCU422
00346      ADD +1             TO TBL-CNT.                               DTSCU422
00347                                                                   DTSCU422
00348  P1920-EXIT.                                                      DTSCU422
00349      EXIT.                                                        DTSCU422
00350                                                                   DTSCU422
00351  P1921-INIT-ROW.                                                  DTSCU422
00352      MOVE ZERO       TO WRK-SSN (SSN-SUB)                         DTSCU422
00353                         WRK-QTR1-CURR-WAGE (SSN-SUB)              DTSCU422
00354                         WRK-QTR1-PRIOR-WAGE (SSN-SUB)             DTSCU422
00355                         WRK-QTR2-CURR-WAGE (SSN-SUB)              DTSCU422
00356                         WRK-QTR2-PRIOR-WAGE (SSN-SUB)             DTSCU422
00357                         WRK-QTR3-CURR-WAGE (SSN-SUB)              DTSCU422
00358                         WRK-QTR3-PRIOR-WAGE (SSN-SUB)             DTSCU422
00359                         WRK-QTR4-CURR-WAGE (SSN-SUB)              DTSCU422
00360                         WRK-QTR4-PRIOR-WAGE (SSN-SUB).            DTSCU422
00361      MOVE SPACES     TO WRK-SSN-NAME (SSN-SUB).                   DTSCU422
00362  P1921-EXIT.                                                      DTSCU422
00363      EXIT.                                                        DTSCU422
00364                                                                   DTSCU422
00365  P2000-FIND-NAMES.                                                DTSCU422
00366      PERFORM                                                      DTSCU422
00367        VARYING TBL-SUB FROM +1 BY +1                              DTSCU422
00368        UNTIL TBL-SUB > TBL-CNT                                    DTSCU422
00369          MOVE LOW-VALUE               TO WNAM-COMM-REC            DTSCU422
00370          MOVE WRK-SSN (TBL-SUB)       TO WNAM-SSN                 DTSCU422
00371          PERFORM S882A-START-BROWSE   THRU S882A-EXIT             DTSCU422
00372          IF L882-OK-88                                            DTSCU422
00373             MOVE WNAM-LAST-NAME (1:3)                             DTSCU422
00374                                       TO WRK-SSN-NAME (TBL-SUB)   DTSCU422
00375          END-IF                                                   DTSCU422
00376          PERFORM S882C-END-BROWSE     THRU S882C-EXIT             DTSCU422
00377      END-PERFORM.                                                 DTSCU422
00378                                                                   DTSCU422
00379  P2000-EXIT.                                                      DTSCU422
00380      EXIT.                                                        DTSCU422
00381                                                                   DTSCU422
00382  P3000-SAVE-TO-TS.                                                DTSCU422
00383      PERFORM P3100-INIT-TS      THRU P3100-EXIT.                  DTSCU422
00384                                                                   DTSCU422
00385      PERFORM P3200-BUILD-TS     THRU P3200-EXIT                   DTSCU422
00386         VARYING TBL-SUB FROM +1 BY +1                             DTSCU422
00387         UNTIL TBL-SUB > TBL-CNT.                                  DTSCU422
00388                                                                   DTSCU422
00389      IF TS-SUB > +0                                               DTSCU422
00390         MOVE L427-WAGE-AREA        TO L829-REC                    DTSCU422
00391         ADD +1                     TO L422-TS-CNT                 DTSCU422
00392         PERFORM S829B-WRITE        THRU S829B-EXIT.               DTSCU422
00393                                                                   DTSCU422
00394      MOVE WRK-LAST-DUMMY-SSN       TO L422-LAST-DUMMY-SSN.        DTSCU422
00395                                                                   DTSCU422
00396  P3000-EXIT.                                                      DTSCU422
00397      EXIT.                                                        DTSCU422
00398                                                                   DTSCU422
00399  P3100-INIT-TS.                                                   DTSCU422
00400      MOVE ZERO              TO L427-WAGE-TBL-CNT                  DTSCU422
00401                                TS-SUB                             DTSCU422
00402                                                                   DTSCU422
00403      MOVE L422-EMP-NO       TO L427-EMP-NO.                       DTSCU422
00404      SET L427-EDITED-NO-88  TO TRUE.                              DTSCU422
00405                                                                   DTSCU422
00406      PERFORM                                                      DTSCU422
00407         VARYING SSN-SUB FROM +1 BY +1                             DTSCU422
00408         UNTIL SSN-SUB > WRK-WAGE-TBL-MAX                          DTSCU422
00409            MOVE ZERO       TO L427-SSN (SSN-SUB)                  DTSCU422
00410                               L427-QTR1-WAGE-CHNG (SSN-SUB)       DTSCU422
00411                               L427-QTR1-CURR-WAGE (SSN-SUB)       DTSCU422
00412                               L427-QTR1-TAX-WAGE (SSN-SUB)        DTSCU422
00413                               L427-QTR1-PRIOR-WAGE (SSN-SUB)      DTSCU422
00414                               L427-QTR2-WAGE-CHNG (SSN-SUB)       DTSCU422
00415                               L427-QTR2-CURR-WAGE (SSN-SUB)       DTSCU422
00416                               L427-QTR2-TAX-WAGE (SSN-SUB)        DTSCU422
00417                               L427-QTR2-PRIOR-WAGE (SSN-SUB)      DTSCU422
00418                               L427-QTR3-WAGE-CHNG (SSN-SUB)       DTSCU422
00419                               L427-QTR3-CURR-WAGE (SSN-SUB)       DTSCU422
00420                               L427-QTR3-TAX-WAGE (SSN-SUB)        DTSCU422
00421                               L427-QTR3-PRIOR-WAGE (SSN-SUB)      DTSCU422
00422                               L427-QTR4-WAGE-CHNG (SSN-SUB)       DTSCU422
00423                               L427-QTR4-CURR-WAGE (SSN-SUB)       DTSCU422
00424                               L427-QTR4-TAX-WAGE (SSN-SUB)        DTSCU422
00425                               L427-QTR4-PRIOR-WAGE (SSN-SUB)      DTSCU422
00426            MOVE SPACES     TO L427-SSN-NAME (SSN-SUB)             DTSCU422
00427            SET L427-SSN-NO-ENTRY-88 (SSN-SUB)       TO TRUE       DTSCU422
00428            SET L427-SSN-NAME-NO-ENTRY-88 (SSN-SUB)  TO TRUE       DTSCU422
00429            SET L427-QTR1-NO-ENTRY-88 (SSN-SUB)      TO TRUE       DTSCU422
00430            SET L427-QTR2-NO-ENTRY-88 (SSN-SUB)      TO TRUE       DTSCU422
00431            SET L427-QTR3-NO-ENTRY-88 (SSN-SUB)      TO TRUE       DTSCU422
00432            SET L427-QTR4-NO-ENTRY-88 (SSN-SUB)      TO TRUE       DTSCU422
00433      END-PERFORM.                                                 DTSCU422
00434                                                                   DTSCU422
00435  P3100-EXIT.                                                      DTSCU422
00436      EXIT.                                                        DTSCU422
00437                                                                   DTSCU422
00438  P3200-BUILD-TS.                                                  DTSCU422
00439      ADD +1                        TO TS-SUB.                     DTSCU422
00440      IF TS-SUB > WRK-WAGE-TBL-MAX                                 DTSCU422
00441         MOVE L427-WAGE-AREA        TO L829-REC                    DTSCU422
00442         ADD +1                     TO L422-TS-CNT                 DTSCU422
00443         PERFORM S829B-WRITE        THRU S829B-EXIT                DTSCU422
00444         PERFORM P3100-INIT-TS      THRU P3100-EXIT                DTSCU422
00445         MOVE +1                    TO TS-SUB                      DTSCU422
00446         MOVE TS-SUB                TO L427-WAGE-TBL-CNT           DTSCU422
00447         PERFORM P3210-MOVE-DATA    THRU P3210-EXIT                DTSCU422
00448      ELSE                                                         DTSCU422
00449         MOVE TS-SUB                TO L427-WAGE-TBL-CNT           DTSCU422
00450         PERFORM P3210-MOVE-DATA    THRU P3210-EXIT                DTSCU422
00451      END-IF.                                                      DTSCU422
00452                                                                   DTSCU422
00453  P3200-EXIT.                                                      DTSCU422
00454      EXIT.                                                        DTSCU422
00455                                                                   DTSCU422
00456  P3210-MOVE-DATA.                                                 DTSCU422
00457      MOVE WRK-SSN (TBL-SUB)        TO L427-SSN (TS-SUB).          DTSCU422
00458      MOVE WRK-SSN-NAME (TBL-SUB)   TO L427-SSN-NAME (TS-SUB).     DTSCU422
00459                                                                   DTSCU422
00460      IF L422-RPT-TYPE-SUPPL-88                                    DTSCU422
00461      OR L422-RPT-TYPE-WD-88                                       DTSCU422
00462         SET L427-SSN-CURR-WAGE-88 (TS-SUB)     TO TRUE            DTSCU422
00463      ELSE                                                         DTSCU422
00464         SET L427-SSN-PRE-FILL-88 (TS-SUB)      TO TRUE.           DTSCU422
00465                                                                   DTSCU422
00466      MOVE WRK-QTR1-CURR-WAGE (TBL-SUB)                            DTSCU422
00467                               TO L427-QTR1-CURR-WAGE (TS-SUB).    DTSCU422
00468      MOVE WRK-QTR1-PRIOR-WAGE (TBL-SUB)                           DTSCU422
00469                               TO L427-QTR1-PRIOR-WAGE (TS-SUB).   DTSCU422
00470      MOVE WRK-QTR2-CURR-WAGE (TBL-SUB)                            DTSCU422
00471                               TO L427-QTR2-CURR-WAGE (TS-SUB).    DTSCU422
00472      MOVE WRK-QTR2-PRIOR-WAGE (TBL-SUB)                           DTSCU422
00473                               TO L427-QTR2-PRIOR-WAGE (TS-SUB).   DTSCU422
00474      MOVE WRK-QTR3-CURR-WAGE (TBL-SUB)                            DTSCU422
00475                               TO L427-QTR3-CURR-WAGE (TS-SUB).    DTSCU422
00476      MOVE WRK-QTR3-PRIOR-WAGE (TBL-SUB)                           DTSCU422
00477                               TO L427-QTR3-PRIOR-WAGE (TS-SUB).   DTSCU422
00478      MOVE WRK-QTR4-CURR-WAGE (TBL-SUB)                            DTSCU422
00479                               TO L427-QTR4-CURR-WAGE (TS-SUB).    DTSCU422
00480      MOVE WRK-QTR4-PRIOR-WAGE (TBL-SUB)                           DTSCU422
00481                               TO L427-QTR4-PRIOR-WAGE (TS-SUB).   DTSCU422
00482                                                                   DTSCU422
00483      IF L422-RPT-TYPE-SUPPL-88                                    DTSCU422
00484      OR L422-RPT-TYPE-WD-88                                       DTSCU422
00485         ADD +1                       TO TS-SUB                    DTSCU422
00486         MOVE WRK-SSN (TBL-SUB)       TO L427-SSN (TS-SUB)         DTSCU422
00487         MOVE WRK-SSN-NAME (TBL-SUB)  TO L427-SSN-NAME (TS-SUB)    DTSCU422
00488         IF WRK-SSN-DUMMY-88 (TBL-SUB)                             DTSCU422
00489            SET L427-SSN-DUMMY-88 (TS-SUB)      TO TRUE            DTSCU422
00490            IF WRK-SSN (TBL-SUB)       > WRK-LAST-DUMMY-SSN        DTSCU422
00491               MOVE WRK-SSN (TBL-SUB) TO WRK-LAST-DUMMY-SSN        DTSCU422
00492            END-IF                                                 DTSCU422
00493         ELSE                                                      DTSCU422
00494            SET L427-SSN-PRE-FILL-88 (TS-SUB)   TO TRUE            DTSCU422
00495         END-IF                                                    DTSCU422
00496         MOVE WRK-QTR1-CURR-WAGE (TBL-SUB)                         DTSCU422
00497                               TO L427-QTR1-CURR-WAGE (TS-SUB)     DTSCU422
00498         MOVE WRK-QTR1-PRIOR-WAGE (TBL-SUB)                        DTSCU422
00499                               TO L427-QTR1-PRIOR-WAGE (TS-SUB)    DTSCU422
00500         MOVE WRK-QTR2-CURR-WAGE (TBL-SUB)                         DTSCU422
00501                               TO L427-QTR2-CURR-WAGE (TS-SUB)     DTSCU422
00502         MOVE WRK-QTR2-PRIOR-WAGE (TBL-SUB)                        DTSCU422
00503                               TO L427-QTR2-PRIOR-WAGE (TS-SUB)    DTSCU422
00504         MOVE WRK-QTR3-CURR-WAGE (TBL-SUB)                         DTSCU422
00505                               TO L427-QTR3-CURR-WAGE (TS-SUB)     DTSCU422
00506         MOVE WRK-QTR3-PRIOR-WAGE (TBL-SUB)                        DTSCU422
00507                               TO L427-QTR3-PRIOR-WAGE (TS-SUB)    DTSCU422
00508         MOVE WRK-QTR4-CURR-WAGE (TBL-SUB)                         DTSCU422
00509                               TO L427-QTR4-CURR-WAGE (TS-SUB)     DTSCU422
00510         MOVE WRK-QTR4-PRIOR-WAGE (TBL-SUB)                        DTSCU422
00511                               TO L427-QTR4-PRIOR-WAGE (TS-SUB).   DTSCU422
00512                                                                   DTSCU422
00513  P3210-EXIT.                                                      DTSCU422
00514      EXIT.                                                        DTSCU422
00515                                                                   DTSCU422
00516  S004-FROM-5.                                                     DTSCU422
00517      SET L004-FROM-5 TO TRUE.                                     DTSCU422
00518      EXEC CICS                                                    DTSCU422
00519         LINK                                                      DTSCU422
00520            PROGRAM('DTSCU004')                                    DTSCU422
00521            COMMAREA(L004-COMM-AREA)                               DTSCU422
00522      END-EXEC.                                                    DTSCU422
00523                                                                   DTSCU422
00524  S004-EXIT.                                                       DTSCU422
00525      EXIT.                                                        DTSCU422
00526                                                                   DTSCU422
00527  S829B-WRITE.                                                     DTSCU422
00528      SET L829-WRITE-88     TO TRUE.                               DTSCU422
00529      PERFORM S829Z-QUEUE-IO     THRU S829Z-EXIT.                  DTSCU422
00530                                                                   DTSCU422
00531  S829B-EXIT.                                                      DTSCU422
00532      EXIT.                                                        DTSCU422
00533                                                                   DTSCU422
00534  S829Z-QUEUE-IO.                                                  DTSCU422
00535      MOVE L422-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX.          DTSCU422
00536      MOVE 'W' TO L829-QUEUE-NAME-SUFFIX.                          DTSCU422
00537      MOVE ITEM-LENGTH TO L829-REC-LENGTH.                         DTSCU422
00538      SET L829-DEFAULT-STORAGE-88 TO TRUE.                         DTSCU422
00539                                                                   DTSCU422
00540      EXEC CICS LINK                                               DTSCU422
00541          PROGRAM ('DTSCU829')                                     DTSCU422
00542          COMMAREA (L829-COMM-AREA)                                DTSCU422
00543      END-EXEC.                                                    DTSCU422
00544                                                                   DTSCU422
00545  S829Z-EXIT.                                                      DTSCU422
00546      EXIT.                                                        DTSCU422
00547                                                                   DTSCU422
00548  S881A-START-BROWSE.                                              DTSCU422
00549      SET L881-START-BROWSE-88 TO TRUE.                            DTSCU422
00550      PERFORM S881Z-WWGH-IO    THRU S881Z-EXIT.                    DTSCU422
00551                                                                   DTSCU422
00552  S881A-EXIT.                                                      DTSCU422
00553      EXIT.                                                        DTSCU422
00554                                                                   DTSCU422
00555  S881B-READ-NEXT.                                                 DTSCU422
00556      SET L881-READ-NEXT-88 TO TRUE.                               DTSCU422
00557      PERFORM S881Z-WWGH-IO    THRU S881Z-EXIT.                    DTSCU422
00558                                                                   DTSCU422
00559  S881B-EXIT.                                                      DTSCU422
00560      EXIT.                                                        DTSCU422
00561                                                                   DTSCU422
00562  S881C-END-BROWSE.                                                DTSCU422
00563      SET L881-END-BROWSE-88 TO TRUE.                              DTSCU422
00564      PERFORM S881Z-WWGH-IO    THRU S881Z-EXIT.                    DTSCU422
00565                                                                   DTSCU422
00566  S881C-EXIT.                                                      DTSCU422
00567      EXIT.                                                        DTSCU422
00568                                                                   DTSCU422
00569  S881Z-WWGH-IO.                                                   DTSCU422
00570      EXEC CICS                                                    DTSCU422
00571         LINK                                                      DTSCU422
00572            PROGRAM('DTSCU881')                                    DTSCU422
00573            COMMAREA(L881-COMM-AREA)                               DTSCU422
00574      END-EXEC.                                                    DTSCU422
00575                                                                   DTSCU422
00576  S881Z-EXIT.                                                      DTSCU422
00577      EXIT.                                                        DTSCU422
00578                                                                   DTSCU422
00579  S882A-START-BROWSE.                                              DTSCU422
00580      SET L882-START-BROWSE-88 TO TRUE.                            DTSCU422
00581      PERFORM S882Z-WNAM-IO    THRU S882Z-EXIT.                    DTSCU422
00582                                                                   DTSCU422
00583  S882A-EXIT.                                                      DTSCU422
00584      EXIT.                                                        DTSCU422
00585                                                                   DTSCU422
00586  S882C-END-BROWSE.                                                DTSCU422
00587      SET L882-END-BROWSE-88 TO TRUE.                              DTSCU422
00588      PERFORM S882Z-WNAM-IO    THRU S882Z-EXIT.                    DTSCU422
00589                                                                   DTSCU422
00590  S882C-EXIT.                                                      DTSCU422
00591      EXIT.                                                        DTSCU422
00592                                                                   DTSCU422
00593  S882Z-WNAM-IO.                                                   DTSCU422
00594      EXEC CICS                                                    DTSCU422
00595         LINK                                                      DTSCU422
00596            PROGRAM('DTSCU882')                                    DTSCU422
00597            COMMAREA(L882-COMM-AREA)                               DTSCU422
00598      END-EXEC.                                                    DTSCU422
00599                                                                   DTSCU422
00600  S882Z-EXIT.                                                      DTSCU422
00601      EXIT.                                                        DTSCU422
00602                                                                   DTSCU422
00603                                                                   DTSCU422
00604  S899-ABEND.                                                      DTSCU422
00605      EXEC CICS                                                    DTSCU422
00606         ABEND                                                     DTSCU422
00607            ABCODE(WRK-ABEND-CD)                                   DTSCU422
00608      END-EXEC.                                                    DTSCU422
00609  S899-EXIT.                                                       DTSCU422
00610      EXIT.                                                        DTSCU422
