00001  IDENTIFICATION DIVISION.                                         11/27/01
00002  PROGRAM-ID.             DTSBR506.                                DTSBR506
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV041
00004  DATE-WRITTEN.           DECEMBER 1994.                           DTSBR506
00005  DATE-COMPILED.                                                   DTSBR506
00006      SKIP3                                                        DTSBR506
00007 *****                                                             DTSBR506
00008 *                                                                 DTSBR506
00009 *    CALLING SEQUENCE:  DTSBD720 WRITES DTSIR506 RECORDS          DTSBR506
00010 *                       DTSBR506 READS  DTSIR506 RECORDS          DTSBR506
00011 *                       TO PRODUCE THE RATE CUTOFF                DTSBR506
00012 * TRANSFERS OF EXPERIENCE REPORT.                                 DTSBR506
00013 *                                                                 DTSBR506
00014 *    FUNCTION:  RATE CUTOFF TRANSFERS OF EXPERIENCE.              DTSBR506
00015 *                                                                 DTSBR506
00016 *                                                                 DTSBR506
00017 *    MODIFICATION HISTORY:                                        DTSBR506
00018 *                                                                 DTSBR506
00019 * 11-27-2001 CHANGED TO PROCESS PAGE LENGTH PROPERLY - LEFT OVER  DTSBR506
00020 *            FROM CONVERSION FROM REPRT WRTR & OLD MONT. CODE     DTSBR506
00021 *                                           AUTHOR OF CHANGE - JHPDTSBR506
00022 *                                                                 DTSBR506
00023 * 07-19-1999 PICKUP MODIFICATION.  WHEN R506-EFF-QTR IS EQUAL TO  DTSBR506
00024 *            LRCM-PICKUP-YRQ, DISPLAY PICKUP 'PU' ON REPORT       DTSBR506
00025 *            REFERENCE: PICKUP DIR          AUTHOR OF CHANGE - DVSDTSBR506
00026 *                                                                 DTSBR506
00027 * 04-29-1999 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS.   DTSBR506
00028 *            REFERENCE RFP #****            AUTHOR OF CHANGE - DVSDTSBR506
00029 *                                                                 DTSBR506
00030 * 12-16-94 INITIAL DEVELOPMENT                                    DTSBR506
00031 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR506
00032 *                                                                 DTSBR506
00033 *    DESCRIPTION:                                                 DTSBR506
00034 *                                                                 DTSBR506
00035 *        THE MODULE LISTS ALL TRANSFERS OF EXPERIENCE THAT WENT   DTSBR506
00036 *        INTO THE CREATION OF RATE CUTOFF RECORDS IN THE YEARLY   DTSBR506
00037 *        RATING RUN.                                              DTSBR506
00038 *                                                                 DTSBR506
00039 *                                                                 DTSBR506
00040 *    RECORDS READ:                                                DTSBR506
00041 *                                                                 DTSBR506
00042 *        NONE.                                                    DTSBR506
00043 *                                                                 DTSBR506
00044 *                                                                 DTSBR506
00045 *    PRINTED OUTPUTS:                                             DTSBR506
00046 *                                                                 DTSBR506
00047 *        506R1  RATE CUTOFF TRANSFERS OF EXPERIENCE               DTSBR506
00048 *                                                                 DTSBR506
00049 *                                                                 DTSBR506
00050 *    RECORDS WRITTEN:                                             DTSBR506
00051 *                                                                 DTSBR506
00052 *        NONE.                                                    DTSBR506
00053 *                                                                 DTSBR506
00054 *                                                                 DTSBR506
00055 *    MODULES CALLED:                                              DTSBR506
00056 *                                                                 DTSBR506
00057 *        DTSBU001 DATE EDIT/CONVERSION MODULE                     DTSBR506
00058 *        DTSBU004 QUARTER CONVERSION MODULE                       DTSBR506
00059 *        DTSBU031 TRANSFER CODE EDIT/DESCRIPTION MODULE           DTSBR506
00060 *                                                                 DTSBR506
00061 *                                                                 DTSBR506
00062 *****                                                             DTSBR506
00063      EJECT                                                        DTSBR506
00064  ENVIRONMENT DIVISION.                                            DTSBR506
00065                                                                   DTSBR506
00066  CONFIGURATION SECTION.                                           DTSBR506
00067  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR506
00068                                                                   DTSBR506
00069  INPUT-OUTPUT SECTION.                                            DTSBR506
00070                                                                   DTSBR506
00071  FILE-CONTROL.                                                    DTSBR506
00072      SELECT PRT-FILE ASSIGN TO RPT506R1.                          DTSBR506
00073                                                                   DTSBR506
00074  DATA DIVISION.                                                   DTSBR506
00075                                                                   DTSBR506
00076  FILE SECTION.                                                    DTSBR506
00077                                                                   DTSBR506
00078  FD  PRT-FILE                                                     DTSBR506
00079      RECORDING MODE IS F.                                         DTSBR506
00080  01  REPORT-LISTING1                 PIC  X(133).                 DTSBR506
00081                                                                   DTSBR506
00082  WORKING-STORAGE SECTION.                                         DTSBR506
000825 77  PAN-VALET PICTURE X(24) VALUE '041DTSBR506  11/27/01'.       DTSBR506
00083                                                                   DTSBR506
00084  01  WRK-AREA.                                                    DTSBR506
00085      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +506.DTSBR506
00086      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR506
00087      05  SUB                         PIC S9(04)  COMP  VALUE ZERO.DTSBR506
00088                                                                   DTSBR506
00089      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  DTSBR506
00090      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR506
00091                                                                   DTSBR506
00092      05  WS-MISS-RPT-CNT             PIC S9(03).                  DTSBR506
00093      05  WS-EARLIEST-LIAB-DATE-X     PIC 9(08) BLANK WHEN ZEROES. DTSBR506
00094      05  WS-EARLIEST-LIAB-DATE REDEFINES                          DTSBR506
00095          WS-EARLIEST-LIAB-DATE-X     PIC X(08).                   DTSBR506
00096      05  WS-TOT-UI-TAX-BALANCE-AMT   PIC S9(09)V99.               DTSBR506
00097      05  WS-UI-TAX-PAID-AMT          PIC S9(09)V99.               DTSBR506
00098      05  WS-PRIOR-RESERVE-AMT        PIC S9(09)V99.               DTSBR506
00099      05  WS-BENEFITS-CHARGED-AMT     PIC S9(09)V99.               DTSBR506
00100      05  WS-WAGES-TABLE.                                          DTSBR506
00101          10 WS-WAGES-AREA OCCURS 3 TIMES.                         DTSBR506
00102             15 WS-WAGES-DATE-AREA.                                DTSBR506
00103                20  WS-WAGES-FROM-YRQ        PIC X(04).            DTSBR506
00104                20  WS-FILLER-1              PIC X(01).            DTSBR506
00105                20  WS-WAGES-THRU-YRQ        PIC X(04).            DTSBR506
00106             15  WS-TOT-WAGE                 PIC S9(11)V9(02).     DTSBR506
00107             15  WS-TAX-WAGE                 PIC S9(11)V9(02).     DTSBR506
00108      EJECT                                                        DTSBR506
00109  01  PAGE-HEADING.                                                DTSBR506
00110      05  HDR-LINE-1.                                              DTSBR506
00111          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00112          10  FILLER                  PIC  X(05)                   DTSBR506
00113                 VALUE '506R1'.                                    DTSBR506
00114          10  FILLER                  PIC  X(35)  VALUE SPACES.    DTSBR506
00115          10  HDR-AGY-NAME-LINE1      PIC  X(50).                  DTSBR506
00116          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR506
00117          10  FILLER                  PIC  X(05)                   DTSBR506
00118                 VALUE 'DATE:'.                                    DTSBR506
00119          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00120          10  HDR-SYS-DATE            PIC  X(08).                  DTSBR506
00121      05  HDR-LINE-2.                                              DTSBR506
00122          10  FILLER                  PIC  X(41)  VALUE SPACES.    DTSBR506
00123          10  HDR-AGY-NAME-LINE2      PIC  X(50).                  DTSBR506
00124          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR506
00125          10  FILLER                  PIC  X(05)                   DTSBR506
00126                 VALUE 'TIME:'.                                    DTSBR506
00127          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00128          10  HDR-SYS-TIME            PIC  X(08).                  DTSBR506
00129      05  HDR-LINE-3.                                              DTSBR506
00130          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00131          10  FILLER                  PIC  X(33)                   DTSBR506
00132                 VALUE 'ROUTE TO: REGISTRATION AND RATES '.        DTSBR506
00133          10  FILLER                  PIC  X(85)  VALUE SPACES.    DTSBR506
00134          10  FILLER                  PIC  X(05)                   DTSBR506
00135                 VALUE 'PAGE:'.                                    DTSBR506
00136          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR506
00137          10  HDR-PAGE-CNT            PIC  ZZ,ZZ9.                 DTSBR506
00138      05  HDR-LINE-4.                                              DTSBR506
00139          10  FILLER                  PIC  X(12)  VALUE SPACES.    DTSBR506
00140          10  FILLER                  PIC  X(20)                   DTSBR506
00141                 VALUE '                    '.                     DTSBR506
00142          10  FILLER                  PIC  X(16)  VALUE SPACES.    DTSBR506
00143          10  FILLER                  PIC  X(35)                   DTSBR506
00144                VALUE 'RATE CUTOFF TRANSFERS OF EXPERIENCE'.       DTSBR506
00145      05  HDR-LINE-5                  PIC  X(133) VALUE SPACES.    DTSBR506
00146      05  HDR-LINE-6.                                              DTSBR506
00147          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00148          10  FILLER                  PIC  X(20)                   DTSBR506
00149                 VALUE '   RATE EXP CUTOFF: '.                     DTSBR506
00150          10  WS-EXP-CUTOFF-DATE      PIC  X(08).                  DTSBR506
00151      05  HDR-LINE-7.                                              DTSBR506
00152          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00153          10  FILLER                  PIC  X(20)                   DTSBR506
00154                 VALUE 'RATE EFFECTIVE QTR: '.                     DTSBR506
00155          10  WS-EFF-QTR              PIC  X(04).                  DTSBR506
00156      05  HDR-LINE-8                  PIC  X(133) VALUE SPACES.    DTSBR506
00157      05  HDR-LINE-9.                                              DTSBR506
00158          10  FILLER                  PIC  X(13)  VALUE SPACES.    DTSBR506
00159          10  FILLER                  PIC  X(04)                   DTSBR506
00160                 VALUE 'PRED'.                                     DTSBR506
00161      05  HDR-LINE-10.                                             DTSBR506
00162          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00163          10  FILLER                  PIC  X(30)                   DTSBR506
00164                 VALUE 'EMP NO     EMP NO     EFF DATE'.           DTSBR506
00165          10  FILLER                  PIC  X(35)  VALUE SPACES.    DTSBR506
00166          10  FILLER                  PIC  X(10)                   DTSBR506
00167                 VALUE ' TOT WAGES'.                               DTSBR506
00168          10  FILLER                  PIC  X(07)  VALUE SPACES.    DTSBR506
00169          10  FILLER                  PIC  X(11)                   DTSBR506
00170                 VALUE '  TAX WAGES'.                              DTSBR506
00171                                                                   DTSBR506
00172  01  DETAIL-LINE.                                                 DTSBR506
00173      05  DTL-LINE-2.                                              DTSBR506
00174          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00175          10  DTL-SUCC-EMP-NO         PIC  999B999.                DTSBR506
00176          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR506
00177          10  DTL-PRED-EMP-NO         PIC  999B999.                DTSBR506
00178          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR506
00179          10  WS-REL-EFF-DATE         PIC  X(08).                  DTSBR506
00180          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00181          10  DTL-PRIOR-RESERVE-AMT   PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBR506
00182          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00183          10  FILLER                  PIC X(11)                    DTSBR506
00184                 VALUE ':RESERVE  '.                               DTSBR506
00185          10  DTL-TOT-WAGE-1          PIC  ZZ,ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00186          10  DTL-TAX-WAGE-1          PIC  ZZ,ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00187          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00188          10  FILLER                  PIC  X(01)                   DTSBR506
00189                 VALUE ':'.                                        DTSBR506
00190          10  DTL-WAGES-DATE-AREA-1   PIC  X(09).                  DTSBR506
00191          10  FILLER                  PIC  X(06)  VALUE SPACES.    DTSBR506
00192          10  DTL-EARLIEST-LIAB-DATE  PIC  X(08).                  DTSBR506
00193          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR506
00194          10  FILLER                  PIC  X(11)                   DTSBR506
00195                 VALUE ':FRST LIAB '.                              DTSBR506
00196                                                                   DTSBR506
00197      05  DTL-LINE-3.                                              DTSBR506
00198          10  FILLER                  PIC  X(32)  VALUE SPACES.    DTSBR506
00199          10  DTL-UI-TAX-PAID-AMT     PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBR506
00200          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00201          10  FILLER                  PIC X(11)                    DTSBR506
00202                 VALUE ':UI TAX PD '.                              DTSBR506
00203          10  DTL-TOT-WAGE-2          PIC  ZZ,ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00204          10  DTL-TAX-WAGE-2          PIC  ZZ,ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00205          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00206          10  FILLER                  PIC X(01)                    DTSBR506
00207                 VALUE ':'.                                        DTSBR506
00208          10  DTL-WAGES-DATE-AREA-2   PIC X(09).                   DTSBR506
00209          10  FILLER                  PIC  X(11)  VALUE SPACE.     DTSBR506
00210          10  DTL-MISS-RPT-CNT        PIC  ZZ9.                    DTSBR506
00211          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR506
00212          10  FILLER                  PIC  X(11)                   DTSBR506
00213                 VALUE ':MISS RPTS '.                              DTSBR506
00214                                                                   DTSBR506
00215      05  DTL-LINE-4.                                              DTSBR506
00216          10  FILLER                  PIC  X(32)  VALUE SPACES.    DTSBR506
00217          10  DTL-BENEFITS-CHARGED-AMT PIC  ZZZ,ZZZ,ZZ9.99-.       DTSBR506
00218          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00219          10  FILLER                  PIC X(11)                    DTSBR506
00220                 VALUE ':BEN CHGD  '.                              DTSBR506
00221          10  DTL-TOT-WAGE-3          PIC  ZZ,ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00222          10  DTL-TAX-WAGE-3          PIC  ZZ,ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00223          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00224          10  FILLER                  PIC  X(01)                   DTSBR506
00225                 VALUE ':'.                                        DTSBR506
00226          10  DTL-WAGES-DATE-AREA-3   PIC  X(09).                  DTSBR506
00227          10  DTL-TOT-UI-TAX-BALANCE-AMT PIC  ZZZ,ZZZ,ZZ9.99-.     DTSBR506
00228          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR506
00229          10  FILLER                  PIC  X(11)                   DTSBR506
00230                 VALUE ':UI TAX DUE'.                              DTSBR506
00231                                                                   DTSBR506
00232  01  CONTROL-FOOTING-FINAL.                                       DTSBR506
00233      05  CTF-LINE-4.                                              DTSBR506
00234          10  FILLER                  PIC  X(17)  VALUE SPACES.    DTSBR506
00235          10  FILLER                  PIC  X(17)                   DTSBR506
00236                 VALUE '*** END OF REPORT'.                        DTSBR506
00237      EJECT                                                        DTSBR506
00238  01  L001-LINK-AREA.                                              DTSBR506
00239  ++INCLUDE DTSIL001                                               DTSBR506
00240      EJECT                                                        DTSBR506
00241  01  L004-LINK-AREA.                                              DTSBR506
00242  ++INCLUDE DTSIL004                                               DTSBR506
00243      EJECT                                                        DTSBR506
00244  01  L031-LINK-AREA.                                              DTSBR506
00245  ++INCLUDE DTSIL031                                               DTSBR506
00246      EJECT                                                        DTSBR506
00247  LINKAGE SECTION.                                                 DTSBR506
00248                                                                   DTSBR506
00249  01  LRCM-LINK-AREA.                                              DTSBR506
00250  ++INCLUDE DTSILRCM                                               DTSBR506
00251      EJECT                                                        DTSBR506
00252  01  R506-REC.                                                    DTSBR506
00253  ++INCLUDE DTSIR506                                               DTSBR506
00254      EJECT                                                        DTSBR506
00255  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR506
00256                           R506-REC.                               DTSBR506
00257      IF FIRST-TIME-IND = 'Y'                                      DTSBR506
00258          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR506
00259          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR506
00260                                                                   DTSBR506
00261      IF LRCM-EOR-88                                               DTSBR506
00262          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR506
00263      ELSE                                                         DTSBR506
00264          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR506
00265                                                                   DTSBR506
00266      GOBACK.                                                      DTSBR506
00267                                                                   DTSBR506
00268                                                                   DTSBR506
00269  I1000-INITIATE.                                                  DTSBR506
00270                                                                   DTSBR506
00271      OPEN OUTPUT PRT-FILE.                                        DTSBR506
00272      MOVE LRCM-SYS-DATE TO HDR-SYS-DATE.                          DTSBR506
00273      MOVE LRCM-SYS-TIME TO HDR-SYS-TIME.                          DTSBR506
00274      MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1.              DTSBR506
00275      MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2.              DTSBR506
00276      MOVE SPACES TO REPORT-LISTING1.                              DTSBR506
00277                                                                   DTSBR506
00278      MOVE R506-EXP-CUTOFF-DATE TO L001-FED-8-DATE-9.              DTSBR506
00279      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR506
00280      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR506
00281      MOVE L001-SLASH-DATE TO WS-EXP-CUTOFF-DATE.                  DTSBR506
00282                                                                   DTSBR506
00283      IF LRCM-PICKUP-YRQ = R506-EFF-QTR                            DTSBR506
00284         MOVE 'PU  ' TO WS-EFF-QTR                                 DTSBR506
00285      ELSE                                                         DTSBR506
00286         MOVE R506-EFF-QTR TO L004-QTR-5-9                         DTSBR506
00287         PERFORM S004-FROM-5 THRU S004-EXIT                        DTSBR506
00288         MOVE L004-SLASH-QTR TO WS-EFF-QTR.                        DTSBR506
00289                                                                   DTSBR506
00290      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                  DTSBR506
00291  I1000-EXIT.                                                      DTSBR506
00292      EXIT.                                                        DTSBR506
00293      EJECT                                                        DTSBR506
00294  P1000-PROCESS.                                                   DTSBR506
00295                                                                   DTSBR506
00296      MOVE R506-PRIOR-RESERVE-AMT      TO WS-PRIOR-RESERVE-AMT.    DTSBR506
00297      MOVE R506-UI-TAX-PAID-AMT        TO WS-UI-TAX-PAID-AMT.      DTSBR506
00298      MOVE R506-BENEFITS-CHARGED-AMT   TO WS-BENEFITS-CHARGED-AMT. DTSBR506
00299      MOVE R506-REL-EFF-DATE TO L001-FED-8-DATE-9.                 DTSBR506
00300      SET L001-FROM-FED-8 TO TRUE.                                 DTSBR506
00301      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR506
00302      MOVE L001-SLASH-DATE TO WS-REL-EFF-DATE.                     DTSBR506
00303                                                                   DTSBR506
00304      INITIALIZE SUB.                                              DTSBR506
00305      PERFORM P1010-WAGES-AREA  THRU P1010-EXIT                    DTSBR506
00306              VARYING R506-WAGES-IDX FROM 1 BY 1                   DTSBR506
00307              UNTIL R506-WAGES-IDX GREATER THAN 3.                 DTSBR506
00308                                                                   DTSBR506
00309      INITIALIZE WS-EARLIEST-LIAB-DATE-X                           DTSBR506
00310      IF   R506-EARLIEST-LIAB-DATE GREATER ZEROES                  DTSBR506
00311           MOVE R506-EARLIEST-LIAB-DATE TO L001-FED-8-DATE-9       DTSBR506
00312           SET L001-FROM-FED-8 TO TRUE                             DTSBR506
00313           PERFORM S001-DATE THRU S001-EXIT                        DTSBR506
00314           MOVE L001-SLASH-DATE TO WS-EARLIEST-LIAB-DATE.          DTSBR506
00315                                                                   DTSBR506
00316      MOVE R506-MISS-RPT-CNT           TO WS-MISS-RPT-CNT.         DTSBR506
00317      MOVE R506-TOT-UI-TAX-BALANCE-AMT TO WS-TOT-UI-TAX-BALANCE-AMTDTSBR506
00318                                                                   DTSBR506
00319      MOVE R506-SUCC-EMP-NO          TO DTL-SUCC-EMP-NO.           DTSBR506
00320      MOVE R506-PRED-EMP-NO          TO DTL-PRED-EMP-NO.           DTSBR506
00321      MOVE WS-PRIOR-RESERVE-AMT      TO DTL-PRIOR-RESERVE-AMT.     DTSBR506
00322      MOVE WS-TOT-WAGE (1)           TO DTL-TOT-WAGE-1.            DTSBR506
00323      MOVE WS-TAX-WAGE (1)           TO DTL-TAX-WAGE-1.            DTSBR506
00324      MOVE WS-WAGES-DATE-AREA (1)    TO DTL-WAGES-DATE-AREA-1.     DTSBR506
00325      MOVE WS-EARLIEST-LIAB-DATE     TO DTL-EARLIEST-LIAB-DATE.    DTSBR506
00326      MOVE WS-UI-TAX-PAID-AMT        TO DTL-UI-TAX-PAID-AMT.       DTSBR506
00327      MOVE WS-TOT-WAGE (2)           TO DTL-TOT-WAGE-2.            DTSBR506
00328      MOVE WS-TAX-WAGE (2)           TO DTL-TAX-WAGE-2.            DTSBR506
00329      MOVE WS-WAGES-DATE-AREA (2)    TO DTL-WAGES-DATE-AREA-2.     DTSBR506
00330      MOVE WS-MISS-RPT-CNT           TO DTL-MISS-RPT-CNT.          DTSBR506
00331      MOVE WS-BENEFITS-CHARGED-AMT   TO DTL-BENEFITS-CHARGED-AMT.  DTSBR506
00332      MOVE WS-TOT-WAGE (3)           TO DTL-TOT-WAGE-3.            DTSBR506
00333      MOVE WS-TAX-WAGE (3)           TO DTL-TAX-WAGE-3.            DTSBR506
00334      MOVE WS-WAGES-DATE-AREA (3)    TO DTL-WAGES-DATE-AREA-3.     DTSBR506
00335      MOVE WS-TOT-UI-TAX-BALANCE-AMT TO DTL-TOT-UI-TAX-BALANCE-AMT.DTSBR506
00336                                                                   DTSBR506
00337      WRITE REPORT-LISTING1 FROM DTL-LINE-2 AFTER 2.               DTSBR506
00338      WRITE REPORT-LISTING1 FROM DTL-LINE-3 AFTER 1.               DTSBR506
00339      WRITE REPORT-LISTING1 FROM DTL-LINE-4 AFTER 1.               DTSBR506
00340      ADD +4 TO WS-LINE-CNT.                                       DTSBR506
00341                                                                   DTSBR506
00342      IF WS-LINE-CNT > 55                                          DTSBR506
00343          PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.              DTSBR506
00344                                                                   DTSBR506
00345  P1000-EXIT.                                                      DTSBR506
00346      EXIT.                                                        DTSBR506
00347      EJECT                                                        DTSBR506
00348  P1010-WAGES-AREA.                                                DTSBR506
00349      ADD 1 TO SUB.                                                DTSBR506
00350      IF   R506-WAGES-FROM-YRQ (R506-WAGES-IDX) GREATER ZEROS      DTSBR506
00351           MOVE R506-WAGES-FROM-YRQ (R506-WAGES-IDX)               DTSBR506
00352                TO L004-QTR-5-9                                    DTSBR506
00353           PERFORM S004-FROM-5 THRU S004-EXIT                      DTSBR506
00354           MOVE L004-SLASH-QTR TO WS-WAGES-FROM-YRQ (SUB)          DTSBR506
00355           MOVE '-'            TO WS-FILLER-1 (SUB)                DTSBR506
00356      ELSE                                                         DTSBR506
00357           MOVE SPACES TO WS-WAGES-FROM-YRQ (SUB)                  DTSBR506
00358           MOVE SPACES TO WS-FILLER-1 (SUB)                        DTSBR506
00359      END-IF.                                                      DTSBR506
00360                                                                   DTSBR506
00361      IF   R506-WAGES-THRU-YRQ (R506-WAGES-IDX) GREATER ZEROS      DTSBR506
00362           MOVE R506-WAGES-THRU-YRQ (R506-WAGES-IDX)               DTSBR506
00363                TO L004-QTR-5-9                                    DTSBR506
00364           PERFORM S004-FROM-5 THRU S004-EXIT                      DTSBR506
00365           MOVE L004-SLASH-QTR TO WS-WAGES-THRU-YRQ (SUB)          DTSBR506
00366           MOVE '-'            TO WS-FILLER-1 (SUB)                DTSBR506
00367      ELSE                                                         DTSBR506
00368           MOVE SPACES TO WS-WAGES-THRU-YRQ (SUB)                  DTSBR506
00369           MOVE SPACES TO WS-FILLER-1 (SUB)                        DTSBR506
00370      END-IF.                                                      DTSBR506
00371                                                                   DTSBR506
00372      MOVE R506-TOT-WAGE (R506-WAGES-IDX) TO WS-TOT-WAGE (SUB).    DTSBR506
00373      MOVE R506-TAX-WAGE (R506-WAGES-IDX) TO WS-TAX-WAGE (SUB).    DTSBR506
00374  P1010-EXIT.                                                      DTSBR506
00375      EXIT.                                                        DTSBR506
00376                                                                   DTSBR506
00377  P2000-PRINT-HEADER.                                              DTSBR506
00378                                                                   DTSBR506
00379      MOVE +0          TO WS-LINE-CNT                              DTSBR506
00380      ADD  +1          TO WS-PAGE-CNT                              DTSBR506
00381      MOVE WS-PAGE-CNT TO HDR-PAGE-CNT                             DTSBR506
00382      WRITE REPORT-LISTING1 FROM HDR-LINE-1                        DTSBR506
00383              AFTER TOP-OF-PAGE.                                   DTSBR506
00384      WRITE REPORT-LISTING1 FROM HDR-LINE-2 AFTER 1                DTSBR506
00385      WRITE REPORT-LISTING1 FROM HDR-LINE-3 AFTER 1                DTSBR506
00386      WRITE REPORT-LISTING1 FROM HDR-LINE-4 AFTER 1                DTSBR506
00387      WRITE REPORT-LISTING1 FROM HDR-LINE-5 AFTER 1                DTSBR506
00388      WRITE REPORT-LISTING1 FROM HDR-LINE-6 AFTER 1                DTSBR506
00389      WRITE REPORT-LISTING1 FROM HDR-LINE-7 AFTER 1                DTSBR506
00390      WRITE REPORT-LISTING1 FROM HDR-LINE-8 AFTER 1                DTSBR506
00391      WRITE REPORT-LISTING1 FROM HDR-LINE-9 AFTER 1                DTSBR506
00392      WRITE REPORT-LISTING1 FROM HDR-LINE-10 AFTER 1               DTSBR506
00393      ADD +10   TO WS-LINE-CNT.                                    DTSBR506
00394                                                                   DTSBR506
00395  P2000-EXIT.                                                      DTSBR506
00396      EXIT.                                                        DTSBR506
00397                                                                   DTSBR506
00398  T1000-TERMINATE.                                                 DTSBR506
00399                                                                   DTSBR506
00400                                                                   DTSBR506
00401      WRITE REPORT-LISTING1 FROM CTF-LINE-4 AFTER 2.               DTSBR506
00402      CLOSE PRT-FILE.                                              DTSBR506
00403                                                                   DTSBR506
00404  T1000-EXIT.                                                      DTSBR506
00405      EXIT.                                                        DTSBR506
00406                                                                   DTSBR506
00407  S001-DATE.                                                       DTSBR506
00408                                                                   DTSBR506
00409      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBR506
00410                                                                   DTSBR506
00411  S001-EXIT.                                                       DTSBR506
00412      EXIT.                                                        DTSBR506
00413                                                                   DTSBR506
00414  S004-FROM-5.                                                     DTSBR506
00415                                                                   DTSBR506
00416      SET L004-FROM-5 TO TRUE.                                     DTSBR506
00417                                                                   DTSBR506
00418      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBR506
00419                                                                   DTSBR506
00420  S004-EXIT.                                                       DTSBR506
00421      EXIT.                                                        DTSBR506
00422                                                                   DTSBR506
00423 *S031-CODES-DESCRIPTION.                                          DTSBR506
00424 *                                                                 DTSBR506
00425 *    CALL 'DTSBU031' USING L031-LINK-AREA.                        DTSBR506
00426 *                                                                 DTSBR506
00427 *S031-EXIT.                                                       DTSBR506
00428 *    EXIT.                                                        DTSBR506
00429                                                                   DTSBR506
00430 *S999-ABEND.                                                      DTSBR506
00431 *                                                                 DTSBR506
00432 *    CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR506
00433 *                                                                 DTSBR506
00434 *S999-EXIT.                                                       DTSBR506
00435 *    EXIT.                                                        DTSBR506
