00001  IDENTIFICATION DIVISION.                                         11/27/01
00002  PROGRAM-ID.             DTSBR520.                                DTSBR520
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV013
00004  DATE-WRITTEN.           NOVEMBER 1994.                           DTSBR520
00005  DATE-COMPILED.                                                   DTSBR520
00006                                                                   DTSBR520
00007 *****                                                             DTSBR520
00008 *                                                                 DTSBR520
00009 *    FUNCTION:  LIST OF EMPLOYERS WHO QUALIFY FOR A PENALTY RATE  DTSBR520
00010 *               (EITHER EFFECTIVE OR INEFFECTIVE).                DTSBR520
00011 *                                                                 DTSBR520
00012 *                                                                 DTSBR520
00013 *    MODIFICATION HISTORY:                                        DTSBR520
00014 *                                                                 DTSBR520
00015 * 12-03-96 CLONED FROM DTSBR518 THEN MODIFIED TO ALSO HANDLE      DTSBR520
00016 *          EMPLOYERS WITH AN INEFFECTIVE PENALTY RATE (AS SHOWN   DTSBR520
00017 *          BY A * UNDER "INEFFECTIVE" ON THE REPORT).             DTSBR520
00018 *          REFERENCE RFP #FOR KEN OLSON   AUTHOR OF CHANGE - SFW  DTSBR520
00019 *                                                                 DTSBR520
00020 * MM-DD-YY MODIFY TO MEET DUTAS PROGRAMMING MODIFICATIONS.        DTSBR520
00021 *          REFERENCE RFP #****            AUTHOR OF CHANGE - DVS  DTSBR520
00022 *                                                                 DTSBR520
00023 *                                                                 DTSBR520
00024 *    DESCRIPTION:                                                 DTSBR520
00025 *                                                                 DTSBR520
00026 *        THIS MODULE REPORTS ON ALL EMPLOYERS WHO, FOR A          DTSBR520
00027 *        PARAMETER SPECIFIED EFFECTIVE QUARTER, "QUALIFY" FOR     DTSBR520
00028 *        A PENALTY RATE.                                          DTSBR520
00029 *                                                                 DTSBR520
00030 *        THIS IS AN "AT LEAST ONCE" MODULE.                       DTSBR520
00031 *                                                                 DTSBR520
00032 *                                                                 DTSBR520
00033 *    RECORDS READ:                                                DTSBR520
00034 *                                                                 DTSBR520
00035 *        NONE.                                                    DTSBR520
00036 *                                                                 DTSBR520
00037 *                                                                 DTSBR520
00038 *    PRINTED OUTPUTS:                                             DTSBR520
00039 *                                                                 DTSBR520
00040 *        520R1  EMPLOYERS QUALIFIED FOR A PENALTY RATE            DTSBR520
00041 *                                                                 DTSBR520
00042 *                                                                 DTSBR520
00043 *    RECORDS WRITTEN:                                             DTSBR520
00044 *                                                                 DTSBR520
00045 *        NONE.                                                    DTSBR520
00046 *                                                                 DTSBR520
00047 *                                                                 DTSBR520
00048 *    MODULES CALLED:                                              DTSBR520
00049 *                                                                 DTSBR520
00050 *                                                                 DTSBR520
00051 *****                                                             DTSBR520
00052      EJECT                                                        DTSBR520
00053  ENVIRONMENT DIVISION.                                            DTSBR520
00054                                                                   DTSBR520
00055  CONFIGURATION SECTION.                                           DTSBR520
00056  SPECIAL-NAMES. C01 IS TOP-OF-PAGE.                               DTSBR520
00057                                                                   DTSBR520
00058  INPUT-OUTPUT SECTION.                                            DTSBR520
00059                                                                   DTSBR520
00060  FILE-CONTROL.                                                    DTSBR520
00061      SELECT PRT-FILE ASSIGN TO RPT520R1.                          DTSBR520
00062                                                                   DTSBR520
00063  DATA DIVISION.                                                   DTSBR520
00064                                                                   DTSBR520
00065  FILE SECTION.                                                    DTSBR520
00066                                                                   DTSBR520
00067  FD  PRT-FILE                                                     DTSBR520
00068      RECORDING MODE IS F.                                         DTSBR520
00069  01  REPORT-LISTING                  PIC  X(133).                 DTSBR520
00070                                                                   DTSBR520
00071  WORKING-STORAGE SECTION.                                         DTSBR520
000715 77  PAN-VALET PICTURE X(24) VALUE '013DTSBR520  11/27/01'.       DTSBR520
00072                                                                   DTSBR520
00073  01  WRK-AREA.                                                    DTSBR520
00074      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +520.DTSBR520
00075      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR520
00076      05  WS-CONSTANT                 PIC S9(03)  COMP-3 VALUE +1. DTSBR520
00077      05  WS-EFF-QTR-UNPACK           PIC  9(05).                  DTSBR520
00078      05  WS-EXP-YR-DISP              PIC  X(04).                  DTSBR520
00079      05  WS-PENALTY-RATE             PIC  X(07).                  DTSBR520
00080      05  WS-COMPUTED-RATE            PIC  X(07).                  DTSBR520
00081                                                                   DTSBR520
00082      05  WS-LINE-CNT                 PIC S9(02) COMP-3 VALUE 60.  DTSBR520
00083      05  WS-LINE-CNT2                PIC S9(02) COMP-3 VALUE +0.  DTSBR520
00084      05  WS-PAGE-CNT                 PIC S9(03) COMP-3 VALUE +0.  DTSBR520
00085      05  WS-DETAIL-CNT               PIC S9(07)  COMP-3 VALUE +0. DTSBR520
00086      05  WS-POSITIVE-RESERVE-AMT    PIC S9(09)V99 COMP-3 VALUE +0.DTSBR520
00087      05  WS-TRUST-FUND-INTEREST-AMT PIC S9(09)V99 COMP-3 VALUE +0.DTSBR520
00088                                                                   DTSBR520
00089  01  L004-LINK-AREA.                                              DTSBR520
00090  ++INCLUDE DTSIL004                                               DTSBR520
00091      EJECT                                                        DTSBR520
00092                                                                   DTSBR520
00093  01  PAGE-HEADING.                                                DTSBR520
00094      05  HDR-LINE-1.                                              DTSBR520
00095          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00096          10  FILLER                  PIC  X(05)                   DTSBR520
00097                 VALUE '520R1'.                                    DTSBR520
00098          10  FILLER                  PIC  X(35)  VALUE SPACES.    DTSBR520
00099          10  HDR-AGY-NAME-LINE1      PIC  X(50).                  DTSBR520
00100          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR520
00101          10  FILLER                  PIC  X(05)                   DTSBR520
00102                 VALUE 'DATE:'.                                    DTSBR520
00103          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00104          10  HDR-SYS-DATE            PIC  X(08).                  DTSBR520
00105      05  HDR-LINE-2.                                              DTSBR520
00106          10  FILLER                  PIC  X(41)  VALUE SPACES.    DTSBR520
00107          10  HDR-AGY-NAME-LINE2      PIC  X(50).                  DTSBR520
00108          10  FILLER                  PIC  X(28)  VALUE SPACES.    DTSBR520
00109          10  FILLER                  PIC  X(05)                   DTSBR520
00110                 VALUE 'TIME:'.                                    DTSBR520
00111          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00112          10  HDR-SYS-TIME            PIC  X(08).                  DTSBR520
00113      05  HDR-LINE-3.                                              DTSBR520
00114          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00115          10  FILLER                  PIC  X(35)                   DTSBR520
00116                 VALUE 'ROUTE TO:  REGISTRATION AND RATES'.        DTSBR520
00117          10  FILLER                  PIC  X(83)  VALUE SPACES.    DTSBR520
00118          10  FILLER                  PIC  X(05)                   DTSBR520
00119                 VALUE 'PAGE:'.                                    DTSBR520
00120          10  FILLER                  PIC  X(03)  VALUE SPACES.    DTSBR520
00121          10  HDR-PAGE-CNT            PIC  ZZ,ZZ9.                 DTSBR520
00122      05  HDR-LINE-4.                                              DTSBR520
00123          10  FILLER                  PIC  X(12)  VALUE SPACES.    DTSBR520
00124          10  FILLER                  PIC  X(20)                   DTSBR520
00125                 VALUE '                    '.                     DTSBR520
00126          10  FILLER                  PIC  X(12)  VALUE SPACES.    DTSBR520
00127          10  FILLER                  PIC  X(40)                   DTSBR520
00128                VALUE 'TRUST FUND INTEREST DISTRIBUTION REPORT'.   DTSBR520
00129      05  HDR-LINE-5.                                              DTSBR520
00130          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00131          10  FILLER                  PIC  X(20)                   DTSBR520
00132                VALUE 'RATE EFFECTIVE QTR: '.                      DTSBR520
00133          10  HDR-EFF-QTR-UNPACK      PIC  99/9.                   DTSBR520
00134      05  HDR-LINE-6                  PIC  X(133) VALUE SPACES.    DTSBR520
00135      05  HDR-LINE-7                  PIC  X(133) VALUE SPACES.    DTSBR520
00136      05  HDR-LINE-8.                                              DTSBR520
00137          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00138          10  FILLER                  PIC  X(20)                   DTSBR520
00139                VALUE 'TOT TRUST FUND INT: '.                      DTSBR520
00140          10  HDR-TOT-TRUST-FUND-INT-AMT PIC  -ZZZ,ZZZ,ZZ9.99.     DTSBR520
00141      05  HDR-LINE-9                  PIC  X(133) VALUE SPACES.    DTSBR520
00142      05  HDR-LINE-10                 PIC  X(133) VALUE SPACES.    DTSBR520
00143      05  HDR-LINE-11.                                             DTSBR520
00144          10  FILLER                  PIC  X(62)  VALUE SPACES.    DTSBR520
00145          10  FILLER                  PIC  X(08)                   DTSBR520
00146                 VALUE 'POSITIVE'.                                 DTSBR520
00147          10  FILLER                  PIC  X(11)  VALUE SPACES.    DTSBR520
00148          10  FILLER                  PIC  X(11)                   DTSBR520
00149                 VALUE 'DISTRIBUTED'.                              DTSBR520
00150      05  HDR-LINE-12.                                             DTSBR520
00151          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00152          10  FILLER                  PIC  X(26)                   DTSBR520
00153                 VALUE 'EMP NO       PRIMARY NAME'.                DTSBR520
00154          10  FILLER                  PIC  X(36)  VALUE SPACES.    DTSBR520
00155          10  FILLER                  PIC  X(07)                   DTSBR520
00156                 VALUE 'RESERVE'.                                  DTSBR520
00157          10  FILLER                  PIC  X(14)  VALUE SPACES.    DTSBR520
00158          10  FILLER                  PIC  X(08)                   DTSBR520
00159                 VALUE 'INTEREST'.                                 DTSBR520
00160                                                                   DTSBR520
00161  01  DETAIL-LINE.                                                 DTSBR520
00162      05  DTL-LINE-2.                                              DTSBR520
00163          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00164          10  DTL-EMP-NO              PIC  999B999.                DTSBR520
00165          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR520
00166          10  DTL-PRIMARY-NAME        PIC  X(40).                  DTSBR520
00167          10  DTL-POSITIVE-RESERVE-AMT PIC -ZZ,ZZZ,ZZZ,ZZ9.99.     DTSBR520
00168          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR520
00169          10  DTL-TRUST-FUND-INTEREST-AMT PIC -ZZ,ZZZ,ZZZ,ZZ9.99.  DTSBR520
00170                                                                   DTSBR520
00171  01  CONTROL-FOOTING-FINAL.                                       DTSBR520
00172      05  CTF-LINE-3.                                              DTSBR520
00173          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00174          10  FILLER                  PIC  X(31)                   DTSBR520
00175                 VALUE '  TOTAL    EMPLOYER COUNT:  '.             DTSBR520
00176          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR520
00177          10  CTF-DETAIL-CNT          PIC ZZZ,ZZ9.                 DTSBR520
00178          10  FILLER                  PIC  X(10)  VALUE SPACES.    DTSBR520
00179          10  CTF-POSITIVE-RESERVE-AMT PIC -ZZZZ,ZZZ,ZZZ,ZZ9.99.   DTSBR520
00180          10  FILLER                  PIC  X(02)  VALUE SPACES.    DTSBR520
00181          10  CTF-TRUST-FUND-INTEREST-AMT PIC -ZZZZ,ZZZ,ZZZ,ZZ9.99.DTSBR520
00182      05  CTF-LINE-7.                                              DTSBR520
00183          10  FILLER                  PIC  X(26)  VALUE SPACES.    DTSBR520
00184          10  FILLER                  PIC  X(17)                   DTSBR520
00185                 VALUE '*** END OF REPORT'.                        DTSBR520
00186      EJECT                                                        DTSBR520
00187  LINKAGE SECTION.                                                 DTSBR520
00188                                                                   DTSBR520
00189  01  LRCM-LINK-AREA.                                              DTSBR520
00190  ++INCLUDE DTSILRCM                                               DTSBR520
00191      EJECT                                                        DTSBR520
00192  01  R520-REC.                                                    DTSBR520
00193  ++INCLUDE DTSIR520                                               DTSBR520
00194      EJECT                                                        DTSBR520
00195  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR520
00196                           R520-REC.                               DTSBR520
00197      IF FIRST-TIME-IND = 'Y'                                      DTSBR520
00198          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR520
00199          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR520
00200                                                                   DTSBR520
00201      IF LRCM-EOR-88                                               DTSBR520
00202          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR520
00203      ELSE                                                         DTSBR520
00204          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR520
00205                                                                   DTSBR520
00206      GOBACK.                                                      DTSBR520
00207                                                                   DTSBR520
00208  I1000-INITIATE.                                                  DTSBR520
00209                                                                   DTSBR520
00210      OPEN OUTPUT PRT-FILE.                                        DTSBR520
00211      MOVE LRCM-SYS-DATE TO HDR-SYS-DATE.                          DTSBR520
00212      MOVE LRCM-SYS-TIME TO HDR-SYS-TIME.                          DTSBR520
00213      MOVE LRCM-AGY-NAME-LINE1 TO HDR-AGY-NAME-LINE1.              DTSBR520
00214      MOVE LRCM-AGY-NAME-LINE2 TO HDR-AGY-NAME-LINE2.              DTSBR520
00215      MOVE SPACES TO REPORT-LISTING.                               DTSBR520
00216                                                                   DTSBR520
00217      IF LRCM-EOR-88                                               DTSBR520
00218          MOVE ZEROES TO WS-EFF-QTR-UNPACK                         DTSBR520
00219      ELSE                                                         DTSBR520
00220          MOVE R520-EFF-QTR TO WS-EFF-QTR-UNPACK                   DTSBR520
00221      END-IF.                                                      DTSBR520
00222                                                                   DTSBR520
00223  I1000-EXIT.                                                      DTSBR520
00224      EXIT.                                                        DTSBR520
00225                                                                   DTSBR520
00226  P1000-PROCESS.                                                   DTSBR520
00227                                                                   DTSBR520
00228      MOVE WS-EFF-QTR-UNPACK (3:3)     TO HDR-EFF-QTR-UNPACK.      DTSBR520
00229      MOVE R520-TOT-TRUST-FUND-INT-AMT    TO                       DTSBR520
00230            HDR-TOT-TRUST-FUND-INT-AMT.                            DTSBR520
00231      MOVE R520-EMP-NO                 TO DTL-EMP-NO.              DTSBR520
00232      MOVE R520-PRIMARY-NAME           TO DTL-PRIMARY-NAME.        DTSBR520
00233      MOVE R520-POSITIVE-RESERVE-AMT   TO DTL-POSITIVE-RESERVE-AMT.DTSBR520
00234      MOVE R520-TRUST-FUND-INTEREST-AMT   TO                       DTSBR520
00235            DTL-TRUST-FUND-INTEREST-AMT.                           DTSBR520
00236      ADD R520-POSITIVE-RESERVE-AMT    TO WS-POSITIVE-RESERVE-AMT. DTSBR520
00237      ADD R520-TRUST-FUND-INTEREST-AMT    TO                       DTSBR520
00238            WS-TRUST-FUND-INTEREST-AMT.                            DTSBR520
00239      PERFORM P2000-PRINT-HEADER THRU P2000-EXIT.                  DTSBR520
00240      WRITE REPORT-LISTING FROM DTL-LINE-2 AFTER 2.                DTSBR520
00241      ADD +2    TO WS-LINE-CNT2.                                   DTSBR520
00242      ADD +1 TO WS-DETAIL-CNT.                                     DTSBR520
00243                                                                   DTSBR520
00244  P1000-EXIT.                                                      DTSBR520
00245      EXIT.                                                        DTSBR520
00246                                                                   DTSBR520
00247  P2000-PRINT-HEADER.                                              DTSBR520
00248                                                                   DTSBR520
00249      IF WS-LINE-CNT GREATER 58 OR                                 DTSBR520
00250           WS-LINE-CNT2 GREATER 58                                 DTSBR520
00251         MOVE +0          TO WS-LINE-CNT                           DTSBR520
00252         MOVE +0          TO WS-LINE-CNT2                          DTSBR520
00253         ADD  +1          TO WS-PAGE-CNT                           DTSBR520
00254         MOVE WS-PAGE-CNT TO HDR-PAGE-CNT                          DTSBR520
00255         WRITE REPORT-LISTING FROM HDR-LINE-1                      DTSBR520
00256                 AFTER TOP-OF-PAGE                                 DTSBR520
00257         WRITE REPORT-LISTING FROM HDR-LINE-2 AFTER 1              DTSBR520
00258         WRITE REPORT-LISTING FROM HDR-LINE-3 AFTER 1              DTSBR520
00259         WRITE REPORT-LISTING FROM HDR-LINE-4 AFTER 1              DTSBR520
00260         WRITE REPORT-LISTING FROM HDR-LINE-5 AFTER 1              DTSBR520
00261         WRITE REPORT-LISTING FROM HDR-LINE-6 AFTER 1              DTSBR520
00262         WRITE REPORT-LISTING FROM HDR-LINE-7 AFTER 1              DTSBR520
00263         WRITE REPORT-LISTING FROM HDR-LINE-8 AFTER 1              DTSBR520
00264         WRITE REPORT-LISTING FROM HDR-LINE-9 AFTER 1              DTSBR520
00265         WRITE REPORT-LISTING FROM HDR-LINE-10 AFTER 1             DTSBR520
00266         WRITE REPORT-LISTING FROM HDR-LINE-11 AFTER 1             DTSBR520
00267         WRITE REPORT-LISTING FROM HDR-LINE-12 AFTER 1             DTSBR520
00268         ADD +12   TO WS-LINE-CNT2.                                DTSBR520
00269                                                                   DTSBR520
00270  P2000-EXIT.                                                      DTSBR520
00271      EXIT.                                                        DTSBR520
00272                                                                   DTSBR520
00273  T1000-TERMINATE.                                                 DTSBR520
00274                                                                   DTSBR520
00275      IF WS-LINE-CNT GREATER 51 OR                                 DTSBR520
00276           WS-LINE-CNT2 GREATER 51                                 DTSBR520
00277         MOVE +0          TO WS-LINE-CNT                           DTSBR520
00278         MOVE +0          TO WS-LINE-CNT2                          DTSBR520
00279         ADD  +1          TO WS-PAGE-CNT                           DTSBR520
00280         MOVE WS-PAGE-CNT TO HDR-PAGE-CNT                          DTSBR520
00281         WRITE REPORT-LISTING FROM HDR-LINE-1                      DTSBR520
00282                 AFTER TOP-OF-PAGE                                 DTSBR520
00283         WRITE REPORT-LISTING FROM HDR-LINE-2 AFTER 1              DTSBR520
00284         WRITE REPORT-LISTING FROM HDR-LINE-3 AFTER 1              DTSBR520
00285         WRITE REPORT-LISTING FROM HDR-LINE-4 AFTER 1              DTSBR520
00286         WRITE REPORT-LISTING FROM HDR-LINE-5 AFTER 1              DTSBR520
00287         WRITE REPORT-LISTING FROM HDR-LINE-6 AFTER 1              DTSBR520
00288         WRITE REPORT-LISTING FROM HDR-LINE-7 AFTER 1              DTSBR520
00289         WRITE REPORT-LISTING FROM HDR-LINE-8 AFTER 1              DTSBR520
00290         WRITE REPORT-LISTING FROM HDR-LINE-9 AFTER 1              DTSBR520
00291         WRITE REPORT-LISTING FROM HDR-LINE-10 AFTER 1             DTSBR520
00292         WRITE REPORT-LISTING FROM HDR-LINE-11 AFTER 1             DTSBR520
00293         WRITE REPORT-LISTING FROM HDR-LINE-12 AFTER 1             DTSBR520
00294         ADD +12   TO WS-LINE-CNT2.                                DTSBR520
00295                                                                   DTSBR520
00296      MOVE WS-POSITIVE-RESERVE-AMT    TO CTF-POSITIVE-RESERVE-AMT. DTSBR520
00297      MOVE WS-TRUST-FUND-INTEREST-AMT TO                           DTSBR520
00298              CTF-TRUST-FUND-INTEREST-AMT.                         DTSBR520
00299      MOVE WS-DETAIL-CNT              TO CTF-DETAIL-CNT.           DTSBR520
00300      WRITE REPORT-LISTING FROM CTF-LINE-3 AFTER 3.                DTSBR520
00301      WRITE REPORT-LISTING FROM CTF-LINE-7 AFTER 4.                DTSBR520
00302                                                                   DTSBR520
00303      CLOSE PRT-FILE.                                              DTSBR520
00304                                                                   DTSBR520
00305  T1000-EXIT.                                                      DTSBR520
00306      EXIT.                                                        DTSBR520
00307      EJECT                                                        DTSBR520
00308                                                                   DTSBR520
00309 *S999-ABEND.                                                      DTSBR520
00310 *    SKIP1                                                        DTSBR520
00311 *    CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR520
00312 *    SKIP2                                                        DTSBR520
00313 *S999-EXIT.                                                       DTSBR520
00314 *    EXIT.                                                        DTSBR520
00315                                                                   DTSBR520
