00001  IDENTIFICATION DIVISION.                                         10/28/09
00002  PROGRAM-ID.             DTSCU055                                 DTSCU055
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV012
00004  DATE-WRITTEN            JULY 1994.                               DTSCU055
00005  DATE-COMPILED.                                                   DTSCU055
00006      SKIP3                                                        DTSCU055
00007 *****                                                             DTSCU055
00008 *                                                                 DTSCU055
00009 *    FUNCTION:   RATING EXPERIENCE PERIOD MODULE.                 DTSCU055
00010 *                                                                 DTSCU055
00011 *    MODIFICATION LOG:                                            DTSCU055
00012 *                                                                 DTSCU055
00013 *    07/12/94  CLONED FROM DTSCU055.                              DTSCU055
00014 *              WORK ORDER:                      PROGRAMMER: RHC   DTSCU055
00015 *                                                                 DTSCU055
00016 *    11/09/1998  REVIEWED AND MODIFIED FOR DC.                    DTSCU055
00017 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU055
00018 *                                                                 DTSCU055
00019 *    11/09/1998  CLONED FROM DTSBU055.                            DTSCU055
00020 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU055
00021 *                                                                 DTSCU055
00022 *    12/05/2006  MODIFIED FOR ALTERNATE BASE PERIOD.              DTSCU055
00023 *                REFERENCE: ALTERNATE BASE      PROGRAMMER: GD    DTSCU055
00024 *                                                                 DTSCU055
00025 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU055
00026 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU055
00027 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU055
00028 *                                                                 DTSCU055
00029 *                                                                 DTSCU055
00030 *    DESCRIPTION:                                                 DTSCU055
00031 *                                                                 DTSCU055
00032 *****                                                             DTSCU055
00033  SKIP3                                                            DTSCU055
00034  ENVIRONMENT DIVISION.                                            DTSCU055
00035                                                                   DTSCU055
00036  DATA DIVISION.                                                   DTSCU055
00037  SKIP3                                                            DTSCU055
00038  WORKING-STORAGE SECTION.                                         DTSCU055
000385 77  PAN-VALET PICTURE X(24) VALUE '012DTSCU055  10/28/09'.       DTSCU055
00039                                                                   DTSCU055
00040  01  WRK-AREA.                                                    DTSCU055
00041      05  WRK-ABEND-CODE                      PIC  X(04)           DTSCU055
00042                                                  VALUE 'U055'.    DTSCU055
00043 *************************************************************     DTSCU055
00044 * THE FIRST YEAR IN WHICH BENEFIT ELIGIBILITY DETERMINATIONS      DTSCU055
00045 * CAN USE THE ALTERNATE BASE PERIOD:                              DTSCU055
00046 *************************************************************     DTSCU055
00047      05  WRK-ALT-BASE-START-YEAR             PIC S9(04) COMP      DTSCU055
00048                                                  VALUE +2003.     DTSCU055
00049                                                                   DTSCU055
00050      05  WS-YRQ-X.                                                DTSCU055
00051          10  WS-YR                           PIC  9(04).          DTSCU055
00052          10  WS-Q                            PIC  9(01).          DTSCU055
00053      05  WS-YRQ-9 REDEFINES WS-YRQ-X         PIC  9(05).          DTSCU055
00054      EJECT                                                        DTSCU055
00055  01  L001-COMM-AREA.                                              DTSCU055
00056  ++INCLUDE DTSIL001                                               DTSCU055
00057      EJECT                                                        DTSCU055
00058  01  L004-COMM-AREA.                                              DTSCU055
00059  ++INCLUDE DTSIL004                                               DTSCU055
00060      EJECT                                                        DTSCU055
00061  01  L006-COMM-AREA.                                              DTSCU055
00062  ++INCLUDE DTSIL006                                               DTSCU055
00063      EJECT                                                        DTSCU055
00064  LINKAGE SECTION.                                                 DTSCU055
00065  01  DFHCOMMAREA.                                                 DTSCU055
00066  ++INCLUDE DTSIL055                                               DTSCU055
00067      EJECT                                                        DTSCU055
00068  PROCEDURE DIVISION.                                              DTSCU055
00069                                                                   DTSCU055
00070                                                                   DTSCU055
00071      IF L055-FROM-EFF-YRQ-88                                      DTSCU055
00072          PERFORM P1000-FROM-EFF-YRQ THRU P1000-EXIT               DTSCU055
00073      ELSE                                                         DTSCU055
00074          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00075                                                                   DTSCU055
00076                                                                   DTSCU055
00077      EXEC CICS                                                    DTSCU055
00078          RETURN                                                   DTSCU055
00079      END-EXEC.                                                    DTSCU055
00080                                                                   DTSCU055
00081                                                                   DTSCU055
00082      GOBACK.                                                      DTSCU055
00083      EJECT                                                        DTSCU055
00084  P1000-FROM-EFF-YRQ.                                              DTSCU055
00085      MOVE L055-EFF-YRQ TO L006-YRQ.                               DTSCU055
00086                                                                   DTSCU055
00087      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSCU055
00088                                                                   DTSCU055
00089      IF L006-RTE-YR-START-YRQ = L055-EFF-YRQ                      DTSCU055
00090          CONTINUE                                                 DTSCU055
00091      ELSE                                                         DTSCU055
00092          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00093                                                                   DTSCU055
00094                                                                   DTSCU055
00095      MOVE L055-EFF-YRQ TO WS-YRQ-9.                               DTSCU055
00096                                                                   DTSCU055
00097                                                                   DTSCU055
00098      MOVE 19390701 TO L055-PRIOR-RESERVE-FROM-DATE.               DTSCU055
00099                                                                   DTSCU055
00100                                                                   DTSCU055
00101      COMPUTE L001-FED-8-YR = WS-YR - 2.                           DTSCU055
00102                                                                   DTSCU055
00103      MOVE 06 TO L001-FED-8-MO.                                    DTSCU055
00104                                                                   DTSCU055
00105      MOVE 30 TO L001-FED-8-DA.                                    DTSCU055
00106                                                                   DTSCU055
00107      MOVE L001-FED-8-DATE-9 TO L055-PRIOR-RESERVE-THRU-DATE.      DTSCU055
00108                                                                   DTSCU055
00109                                                                   DTSCU055
00110      COMPUTE L001-FED-8-YR = WS-YR - 2.                           DTSCU055
00111                                                                   DTSCU055
00112      MOVE 07 TO L001-FED-8-MO.                                    DTSCU055
00113                                                                   DTSCU055
00114      MOVE 01 TO L001-FED-8-DA.                                    DTSCU055
00115                                                                   DTSCU055
00116      MOVE L001-FED-8-DATE-9 TO L055-UI-TAX-PAID-FROM-DATE.        DTSCU055
00117                                                                   DTSCU055
00118                                                                   DTSCU055
00119      COMPUTE L001-FED-8-YR = WS-YR - 1.                           DTSCU055
00120                                                                   DTSCU055
00121      MOVE 06 TO L001-FED-8-MO.                                    DTSCU055
00122                                                                   DTSCU055
00123      MOVE 30 TO L001-FED-8-DA.                                    DTSCU055
00124                                                                   DTSCU055
00125      MOVE L001-FED-8-DATE-9 TO L055-UI-TAX-PAID-THRU-DATE.        DTSCU055
00126                                                                   DTSCU055
00127                                                                   DTSCU055
00128      COMPUTE L001-FED-8-YR = WS-YR - 2.                           DTSCU055
00129                                                                   DTSCU055
00130      MOVE 04 TO L001-FED-8-MO.                                    DTSCU055
00131                                                                   DTSCU055
00132      MOVE 01 TO L001-FED-8-DA.                                    DTSCU055
00133                                                                   DTSCU055
00134      MOVE L001-FED-8-DATE-9 TO L055-TRUST-FUND-INT-FROM-DATE.     DTSCU055
00135                                                                   DTSCU055
00136                                                                   DTSCU055
00137      COMPUTE L001-FED-8-YR = WS-YR - 1.                           DTSCU055
00138                                                                   DTSCU055
00139      MOVE 03 TO L001-FED-8-MO.                                    DTSCU055
00140                                                                   DTSCU055
00141      MOVE 31 TO L001-FED-8-DA.                                    DTSCU055
00142                                                                   DTSCU055
00143      MOVE L001-FED-8-DATE-9 TO L055-TRUST-FUND-INT-THRU-DATE.     DTSCU055
00144                                                                   DTSCU055
00145                                                                   DTSCU055
00146      MOVE L055-UI-TAX-PAID-FROM-DATE                              DTSCU055
00147        TO L055-UI-BEN-CHGD-FROM-DATE.                             DTSCU055
00148                                                                   DTSCU055
00149                                                                   DTSCU055
00150      MOVE L055-UI-TAX-PAID-THRU-DATE                              DTSCU055
00151        TO L055-UI-BEN-CHGD-THRU-DATE.                             DTSCU055
00152                                                                   DTSCU055
00153                                                                   DTSCU055
00154      MOVE L055-PRIOR-RESERVE-FROM-DATE                            DTSCU055
00155        TO L055-CURRENT-RESERVE-FROM-DATE.                         DTSCU055
00156                                                                   DTSCU055
00157                                                                   DTSCU055
00158      COMPUTE L001-FED-8-YR = WS-YR - 1.                           DTSCU055
00159                                                                   DTSCU055
00160      MOVE 06 TO L001-FED-8-MO.                                    DTSCU055
00161                                                                   DTSCU055
00162      MOVE 30 TO L001-FED-8-DA.                                    DTSCU055
00163                                                                   DTSCU055
00164      MOVE L001-FED-8-DATE-9 TO L055-CURRENT-RESERVE-THRU-DATE.    DTSCU055
00165                                                                   DTSCU055
00166                                                                   DTSCU055
00167 *************************************************************     DTSCU055
00168 * ADJUST NONCLASSIFIED-FROM-DATE BASED ON WHETHER THE RATING      DTSCU055
00169 * YEAR - 4 IS LESS THAN THE YEAR IN WHICH ALTERNATE BASE          DTSCU055
00170 * TOOK EFFECT.                                                    DTSCU055
00171 *************************************************************     DTSCU055
00172      COMPUTE L001-FED-8-YR = WS-YR - 4.                           DTSCU055
00173                                                                   DTSCU055
00174      IF WS-YR < WRK-ALT-BASE-START-YEAR                           DTSCU055
00175         MOVE 04             TO L001-FED-8-MO                      DTSCU055
00176      ELSE                                                         DTSCU055
00177         MOVE 07             TO L001-FED-8-MO                      DTSCU055
00178      END-IF.                                                      DTSCU055
00179                                                                   DTSCU055
00180      MOVE 01                TO L001-FED-8-DA.                     DTSCU055
00181                                                                   DTSCU055
00182      MOVE L001-FED-8-DATE-9 TO L055-NONCLASSIFIED-FROM-DATE.      DTSCU055
00183                                                                   DTSCU055
00184                                                                   DTSCU055
00185      MOVE L055-PRIOR-RESERVE-FROM-DATE TO L004-DATE.              DTSCU055
00186                                                                   DTSCU055
00187      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00188                                                                   DTSCU055
00189      IF L004-INVALID-QTR                                          DTSCU055
00190          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00191                                                                   DTSCU055
00192      MOVE L004-QTR-5-9 TO L055-PRIOR-RESERVE-FROM-YRQ.            DTSCU055
00193                                                                   DTSCU055
00194                                                                   DTSCU055
00195      MOVE L055-PRIOR-RESERVE-THRU-DATE TO L004-DATE.              DTSCU055
00196                                                                   DTSCU055
00197      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00198                                                                   DTSCU055
00199      IF L004-INVALID-QTR                                          DTSCU055
00200          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00201                                                                   DTSCU055
00202      MOVE L004-QTR-5-9 TO L055-PRIOR-RESERVE-THRU-YRQ.            DTSCU055
00203                                                                   DTSCU055
00204                                                                   DTSCU055
00205      MOVE L055-UI-TAX-PAID-FROM-DATE TO L004-DATE.                DTSCU055
00206                                                                   DTSCU055
00207      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00208                                                                   DTSCU055
00209      IF L004-INVALID-QTR                                          DTSCU055
00210          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00211                                                                   DTSCU055
00212      MOVE L004-QTR-5-9 TO L055-UI-TAX-PAID-FROM-YRQ.              DTSCU055
00213                                                                   DTSCU055
00214                                                                   DTSCU055
00215      MOVE L055-UI-TAX-PAID-THRU-DATE TO L004-DATE.                DTSCU055
00216                                                                   DTSCU055
00217      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00218                                                                   DTSCU055
00219      IF L004-INVALID-QTR                                          DTSCU055
00220          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00221                                                                   DTSCU055
00222      MOVE L004-QTR-5-9 TO L055-UI-TAX-PAID-THRU-YRQ.              DTSCU055
00223                                                                   DTSCU055
00224                                                                   DTSCU055
00225      MOVE L055-TRUST-FUND-INT-FROM-DATE TO L004-DATE.             DTSCU055
00226                                                                   DTSCU055
00227      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00228                                                                   DTSCU055
00229      IF L004-INVALID-QTR                                          DTSCU055
00230          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00231                                                                   DTSCU055
00232      MOVE L004-QTR-5-9 TO L055-TRUST-FUND-INT-FROM-YRQ.           DTSCU055
00233                                                                   DTSCU055
00234                                                                   DTSCU055
00235      MOVE L055-TRUST-FUND-INT-THRU-DATE TO L004-DATE.             DTSCU055
00236                                                                   DTSCU055
00237      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00238                                                                   DTSCU055
00239      IF L004-INVALID-QTR                                          DTSCU055
00240          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00241                                                                   DTSCU055
00242      MOVE L004-QTR-5-9 TO L055-TRUST-FUND-INT-THRU-YRQ.           DTSCU055
00243                                                                   DTSCU055
00244                                                                   DTSCU055
00245      MOVE L055-UI-BEN-CHGD-FROM-DATE TO L004-DATE.                DTSCU055
00246                                                                   DTSCU055
00247      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00248                                                                   DTSCU055
00249      IF L004-INVALID-QTR                                          DTSCU055
00250          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00251                                                                   DTSCU055
00252      MOVE L004-QTR-5-9 TO L055-UI-BEN-CHGD-FROM-YRQ.              DTSCU055
00253                                                                   DTSCU055
00254                                                                   DTSCU055
00255      MOVE L055-UI-BEN-CHGD-THRU-DATE TO L004-DATE.                DTSCU055
00256                                                                   DTSCU055
00257      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00258                                                                   DTSCU055
00259      IF L004-INVALID-QTR                                          DTSCU055
00260          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00261                                                                   DTSCU055
00262      MOVE L004-QTR-5-9 TO L055-UI-BEN-CHGD-THRU-YRQ.              DTSCU055
00263                                                                   DTSCU055
00264                                                                   DTSCU055
00265      MOVE L055-CURRENT-RESERVE-FROM-DATE TO L004-DATE.            DTSCU055
00266                                                                   DTSCU055
00267      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00268                                                                   DTSCU055
00269      IF L004-INVALID-QTR                                          DTSCU055
00270          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00271                                                                   DTSCU055
00272      MOVE L004-QTR-5-9 TO L055-CURRENT-RESERVE-FROM-YRQ.          DTSCU055
00273                                                                   DTSCU055
00274                                                                   DTSCU055
00275      MOVE L055-CURRENT-RESERVE-THRU-DATE TO L004-DATE.            DTSCU055
00276                                                                   DTSCU055
00277      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00278                                                                   DTSCU055
00279      IF L004-INVALID-QTR                                          DTSCU055
00280          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00281                                                                   DTSCU055
00282      MOVE L004-QTR-5-9 TO L055-CURRENT-RESERVE-THRU-YRQ.          DTSCU055
00283                                                                   DTSCU055
00284                                                                   DTSCU055
00285      MOVE L055-NONCLASSIFIED-FROM-DATE TO L004-DATE.              DTSCU055
00286                                                                   DTSCU055
00287      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00288                                                                   DTSCU055
00289      IF L004-INVALID-QTR                                          DTSCU055
00290          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00291                                                                   DTSCU055
00292      MOVE L004-QTR-5-9 TO L055-NONCLASSIFIED-FROM-YRQ.            DTSCU055
00293                                                                   DTSCU055
00294                                                                   DTSCU055
00295                                                                   DTSCU055
00296                                                                   DTSCU055
00297      COMPUTE L001-FED-8-YR = WS-YR - 4.                           DTSCU055
00298                                                                   DTSCU055
00299      MOVE 04 TO L001-FED-8-MO.                                    DTSCU055
00300                                                                   DTSCU055
00301      MOVE 01 TO L001-FED-8-DA.                                    DTSCU055
00302                                                                   DTSCU055
00303      MOVE L001-FED-8-DATE-9 TO L055-WAGES-FROM-DATE (1).          DTSCU055
00304                                                                   DTSCU055
00305                                                                   DTSCU055
00306      COMPUTE L001-FED-8-YR = WS-YR - 3.                           DTSCU055
00307                                                                   DTSCU055
00308      MOVE 03 TO L001-FED-8-MO.                                    DTSCU055
00309                                                                   DTSCU055
00310      MOVE 31 TO L001-FED-8-DA.                                    DTSCU055
00311                                                                   DTSCU055
00312      MOVE L001-FED-8-DATE-9 TO L055-WAGES-THRU-DATE (1).          DTSCU055
00313                                                                   DTSCU055
00314                                                                   DTSCU055
00315      MOVE L055-WAGES-FROM-DATE (1) TO L004-DATE.                  DTSCU055
00316                                                                   DTSCU055
00317      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00318                                                                   DTSCU055
00319      IF L004-INVALID-QTR                                          DTSCU055
00320          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00321                                                                   DTSCU055
00322      MOVE L004-QTR-5-9 TO L055-WAGES-FROM-YRQ (1).                DTSCU055
00323                                                                   DTSCU055
00324                                                                   DTSCU055
00325      MOVE L055-WAGES-THRU-DATE (1) TO L004-DATE.                  DTSCU055
00326                                                                   DTSCU055
00327      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00328                                                                   DTSCU055
00329      IF L004-INVALID-QTR                                          DTSCU055
00330          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00331                                                                   DTSCU055
00332      MOVE L004-QTR-5-9 TO L055-WAGES-THRU-YRQ (1).                DTSCU055
00333                                                                   DTSCU055
00334                                                                   DTSCU055
00335                                                                   DTSCU055
00336                                                                   DTSCU055
00337      COMPUTE L001-FED-8-YR = WS-YR - 3.                           DTSCU055
00338                                                                   DTSCU055
00339      MOVE 04 TO L001-FED-8-MO.                                    DTSCU055
00340                                                                   DTSCU055
00341      MOVE 01 TO L001-FED-8-DA.                                    DTSCU055
00342                                                                   DTSCU055
00343      MOVE L001-FED-8-DATE-9 TO L055-WAGES-FROM-DATE (2).          DTSCU055
00344                                                                   DTSCU055
00345                                                                   DTSCU055
00346      COMPUTE L001-FED-8-YR = WS-YR - 2.                           DTSCU055
00347                                                                   DTSCU055
00348      MOVE 03 TO L001-FED-8-MO.                                    DTSCU055
00349                                                                   DTSCU055
00350      MOVE 31 TO L001-FED-8-DA.                                    DTSCU055
00351                                                                   DTSCU055
00352      MOVE L001-FED-8-DATE-9 TO L055-WAGES-THRU-DATE (2).          DTSCU055
00353                                                                   DTSCU055
00354                                                                   DTSCU055
00355      MOVE L055-WAGES-FROM-DATE (2) TO L004-DATE.                  DTSCU055
00356                                                                   DTSCU055
00357      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00358                                                                   DTSCU055
00359      IF L004-INVALID-QTR                                          DTSCU055
00360          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00361                                                                   DTSCU055
00362      MOVE L004-QTR-5-9 TO L055-WAGES-FROM-YRQ (2).                DTSCU055
00363                                                                   DTSCU055
00364                                                                   DTSCU055
00365      MOVE L055-WAGES-THRU-DATE (2) TO L004-DATE.                  DTSCU055
00366                                                                   DTSCU055
00367      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00368                                                                   DTSCU055
00369      IF L004-INVALID-QTR                                          DTSCU055
00370          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00371                                                                   DTSCU055
00372      MOVE L004-QTR-5-9 TO L055-WAGES-THRU-YRQ (2).                DTSCU055
00373                                                                   DTSCU055
00374                                                                   DTSCU055
00375                                                                   DTSCU055
00376                                                                   DTSCU055
00377      COMPUTE L001-FED-8-YR = WS-YR - 2.                           DTSCU055
00378                                                                   DTSCU055
00379      MOVE 04 TO L001-FED-8-MO.                                    DTSCU055
00380                                                                   DTSCU055
00381      MOVE 01 TO L001-FED-8-DA.                                    DTSCU055
00382                                                                   DTSCU055
00383      MOVE L001-FED-8-DATE-9 TO L055-WAGES-FROM-DATE (3).          DTSCU055
00384                                                                   DTSCU055
00385                                                                   DTSCU055
00386      COMPUTE L001-FED-8-YR = WS-YR - 1.                           DTSCU055
00387                                                                   DTSCU055
00388      MOVE 03 TO L001-FED-8-MO.                                    DTSCU055
00389                                                                   DTSCU055
00390      MOVE 31 TO L001-FED-8-DA.                                    DTSCU055
00391                                                                   DTSCU055
00392      MOVE L001-FED-8-DATE-9 TO L055-WAGES-THRU-DATE (3).          DTSCU055
00393                                                                   DTSCU055
00394                                                                   DTSCU055
00395      MOVE L055-WAGES-FROM-DATE (3) TO L004-DATE.                  DTSCU055
00396                                                                   DTSCU055
00397      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00398                                                                   DTSCU055
00399      IF L004-INVALID-QTR                                          DTSCU055
00400          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00401                                                                   DTSCU055
00402      MOVE L004-QTR-5-9 TO L055-WAGES-FROM-YRQ (3).                DTSCU055
00403                                                                   DTSCU055
00404                                                                   DTSCU055
00405      MOVE L055-WAGES-THRU-DATE (3) TO L004-DATE.                  DTSCU055
00406                                                                   DTSCU055
00407      PERFORM S004-FROM-DATE THRU S004-EXIT.                       DTSCU055
00408                                                                   DTSCU055
00409      IF L004-INVALID-QTR                                          DTSCU055
00410          PERFORM S899-ABEND THRU S899-EXIT.                       DTSCU055
00411                                                                   DTSCU055
00412      MOVE L004-QTR-5-9 TO L055-WAGES-THRU-YRQ (3).                DTSCU055
00413  P1000-EXIT.                                                      DTSCU055
00414      EXIT.                                                        DTSCU055
00415      EJECT                                                        DTSCU055
00416  S004-FROM-DATE.                                                  DTSCU055
00417      SET L004-FROM-DATE TO TRUE.                                  DTSCU055
00418      GO TO S004-YRQ.                                              DTSCU055
00419                                                                   DTSCU055
00420  S004-YRQ.                                                        DTSCU055
00421      EXEC CICS                                                    DTSCU055
00422          LINK                                                     DTSCU055
00423              PROGRAM ('DTSCU004')                                 DTSCU055
00424              COMMAREA (L004-COMM-AREA)                            DTSCU055
00425      END-EXEC.                                                    DTSCU055
00426  S004-EXIT.                                                       DTSCU055
00427      EXIT.                                                        DTSCU055
00428      SKIP3                                                        DTSCU055
00429  S006-FROM-QTR.                                                   DTSCU055
00430      SET L006-FROM-QTR TO TRUE.                                   DTSCU055
00431      GO TO S006-RATE-YEAR.                                        DTSCU055
00432                                                                   DTSCU055
00433  S006-RATE-YEAR.                                                  DTSCU055
00434      EXEC CICS                                                    DTSCU055
00435          LINK                                                     DTSCU055
00436              PROGRAM ('DTSCU006')                                 DTSCU055
00437              COMMAREA (L006-COMM-AREA)                            DTSCU055
00438      END-EXEC.                                                    DTSCU055
00439  S006-EXIT.                                                       DTSCU055
00440      EXIT.                                                        DTSCU055
00441      EJECT                                                        DTSCU055
00442  S899-ABEND.                                                      DTSCU055
00443      EXEC CICS                                                    DTSCU055
00444          ABEND                                                    DTSCU055
00445            ABCODE (WRK-ABEND-CODE)                                DTSCU055
00446      END-EXEC.                                                    DTSCU055
00447  S899-EXIT.                                                       DTSCU055
00448      EXIT.                                                        DTSCU055
