00001  IDENTIFICATION DIVISION.                                         06/30/99
00002  PROGRAM-ID.             DTSBR723.                                DTSBR723
00003  AUTHOR.                 MT DEPT OF LABOR/UI PROGRAMMING SECTION     LV017
00004  DATE-WRITTEN.           DECEMBER 1994.                           DTSBR723
00005  DATE-COMPILED.                                                   DTSBR723
00006      SKIP3                                                        DTSBR723
00007 *****                                                             DTSBR723
00008 *                                                                 DTSBR723
00009 *    FUNCTION:  RQC EXPERIENCE RATING UNIVERSE RECORD BUILD.      DTSBR723
00010 *                                                                 DTSBR723
00011 *                                                                 DTSBR723
00012 *    MODIFICATION HISTORY:                                        DTSBR723
00013 *                                                                 DTSBR723
00014 * 12-11-94 INITIAL DEVELOPMENT                                    DTSBR723
00015 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR723
00016 *                                                                 DTSBR723
00017 * 04-07-95 RECOMPILED FOR R991-UNIT-DSCR PER CHANGE REQUEST 064   DTSBR723
00018 *          REFERENCE RFP #RAP             AUTHOR OF CHANGE - SFW  DTSBR723
00019 *                                                                 DTSBR723
00020 * 06-30-99 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS         CL**2
00021 *          REFERENCE RFP #****            AUTHOR OF CHANGE - DVS     CL**2
00022 *                                                                 DTSBR723
00023 *                                                                 DTSBR723
00024 *    DESCRIPTION:                                                 DTSBR723
00025 *                                                                 DTSBR723
00026 *        THIS MODULE CREATES A FILE OF RQC EXPERIENCE RATING      DTSBR723
00027 *        TRANSACTION RECORDS FOR EXPORT TO THE DEPARTMENTAL RQC   DTSBR723
00028 *        SYSTEM.                                                  DTSBR723
00029 *                                                                 DTSBR723
00030 *        THIS IS AN "AT LEAST ONCE" MODULE.                       DTSBR723
00031 *                                                                 DTSBR723
00032 *                                                                 DTSBR723
00033 *    RECORDS READ:                                                DTSBR723
00034 *                                                                 DTSBR723
00035 *        NONE.                                                    DTSBR723
00036 *                                                                 DTSBR723
00037 *                                                                 DTSBR723
00038 *    PRINTED OUTPUTS:                                             DTSBR723
00039 *                                                                 DTSBR723
00040 *        NONE.                                                    DTSBR723
00041 *                                                                 DTSBR723
00042 *                                                                 DTSBR723
00043 *    RECORDS WRITTEN:                                             DTSBR723
00044 *                                                                 DTSBR723
00045 *        723R1  RQC EXPERIENCE RATING UNIVERSE RECORDS.           DTSBR723
00046 *                                                                 DTSBR723
00047 *                                                                 DTSBR723
00048 *    MODULES CALLED:                                              DTSBR723
00049 *                                                                 DTSBR723
00050 *        DTSBR991 EXPORT CONTROL REPORT MODULE                       CL**2
00051 *                                                                 DTSBR723
00052 *                                                                 DTSBR723
00053 *****                                                             DTSBR723
00054      EJECT                                                        DTSBR723
00055  ENVIRONMENT DIVISION.                                            DTSBR723
00056      SKIP2                                                        DTSBR723
00057  INPUT-OUTPUT SECTION.                                            DTSBR723
00058      SKIP1                                                        DTSBR723
00059  FILE-CONTROL.                                                    DTSBR723
00060      SELECT EXPORT-FILE ASSIGN TO RPT723R1                        DTSBR723
00061          FILE STATUS IS WS-FILE-STATUS.                           DTSBR723
00062      SKIP3                                                        DTSBR723
00063  DATA DIVISION.                                                   DTSBR723
00064      SKIP3                                                        DTSBR723
00065  FILE SECTION.                                                    DTSBR723
00066      SKIP2                                                        DTSBR723
00067  FD  EXPORT-FILE                                                  DTSBR723
00068      RECORDING MODE IS F                                          DTSBR723
00069      BLOCK CONTAINS 0 RECORDS.                                    DTSBR723
00070  01  EXPORT-REC                     PIC  X(161).                  DTSBR723
00071      EJECT                                                        DTSBR723
00072  WORKING-STORAGE SECTION.                                         DTSBR723
000725 77  PAN-VALET PICTURE X(24) VALUE '017DTSBR723  06/30/99'.       DTSBR723
00073      SKIP3                                                        DTSBR723
00074  01  WRK-AREA.                                                    DTSBR723
00075      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +723.DTSBR723
00076      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR723
00077      05  WS-FILE-STATUS              PIC  X(02).                  DTSBR723
00078          88  FILE-OK-88                          VALUE '00'.      DTSBR723
00079      SKIP3                                                        DTSBR723
00080  01  WS-GETSER-PARAMETERS.                                        DTSBR723
00081      05  WS-GETSER-VOL-SER           PIC  X(30).                  DTSBR723
00082      05  WS-GETSER-DATASET-NAME      PIC  X(44).                  DTSBR723
00083      05  WS-GETSER-VOLUME-COUNT      PIC  9(03).                  DTSBR723
00084      05  WS-GETSER-DD-NAME           PIC  X(08).                  DTSBR723
00085      05  WS-GETSER-STEP-NAME         PIC  X(08).                  DTSBR723
00086      SKIP3                                                        DTSBR723
00087  01  WS-EXPORT-REC.                                               DTSBR723
00088      05  WS-DATE-CREATED             PIC S9(08).                  DTSBR723
00089      05  WS-EFF-YRQ                  PIC S9(05).                  DTSBR723
00090      05  WS-EMP-NO                   PIC S9(06).                  DTSBR723
00091      05  WS-PRIMARY-NAME             PIC  X(40).                     CL**2
00092      05  WS-YEAR-1                   PIC S9(04).                  DTSBR723
00093      05  WS-TAX-WAGE-YEAR-1          PIC S9(11).                  DTSBR723
00094      05  WS-YEAR-2                   PIC S9(04).                  DTSBR723
00095      05  WS-TAX-WAGE-YEAR-2          PIC S9(11).                  DTSBR723
00096      05  WS-YEAR-3                   PIC S9(04).                  DTSBR723
00097      05  WS-TAX-WAGE-YEAR-3          PIC S9(11).                  DTSBR723
00098      05  WS-AVG-TAX-WAGE             PIC S9(11).                  DTSBR723
00099      05  WS-COMPUTED-RATE            PIC S9(01)V9(04).            DTSBR723
00100      05  WS-PENALTY-RATE             PIC S9(01)V9(04).            DTSBR723
00101      05  WS-UI-PAID                  PIC S9(09).                  DTSBR723
00102      05  WS-BEN-CHARGED              PIC S9(09).                  DTSBR723
00103      05  WS-RESERVE                  PIC S9(09).                  DTSBR723
00104      05  WS-RESERVE-RATIO            PIC S9(03)V9(06).            DTSBR723
00105      EJECT                                                        DTSBR723
00106  01  L001-LINK-AREA.                                              DTSBR723
00107  ++INCLUDE DTSIL001                                                  CL*12
00108      EJECT                                                        DTSBR723
00109  01  L055-LINK-AREA.                                                 CL*12
00110  ++INCLUDE DTSIL055                                                  CL*12
00111      EJECT                                                           CL*12
00112  01  R991-REC.                                                    DTSBR723
00113  ++INCLUDE DTSIR991                                                  CL*12
00114      EJECT                                                        DTSBR723
00115  LINKAGE SECTION.                                                 DTSBR723
00116      SKIP3                                                        DTSBR723
00117  01  LRCM-LINK-AREA.                                              DTSBR723
00118  ++INCLUDE DTSILRCM                                                  CL*12
00119      EJECT                                                        DTSBR723
00120  01  R723-REC.                                                    DTSBR723
00121  ++INCLUDE DTSIR723                                                  CL*12
00122      EJECT                                                        DTSBR723
00123  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR723
00124                           R723-REC.                               DTSBR723
00125      SKIP2                                                        DTSBR723
00126      IF FIRST-TIME-IND = 'Y'                                      DTSBR723
00127          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR723
00128          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR723
00129      SKIP1                                                        DTSBR723
00130      IF LRCM-EOR-88                                               DTSBR723
00131          PERFORM T1000-TERMINATE THRU T1000-EXIT                  DTSBR723
00132      ELSE                                                         DTSBR723
00133          PERFORM P1000-PROCESS THRU P1000-EXIT.                   DTSBR723
00134      SKIP2                                                        DTSBR723
00135      GOBACK.                                                      DTSBR723
00136      EJECT                                                        DTSBR723
00137  I1000-INITIATE.                                                  DTSBR723
00138      SKIP1                                                        DTSBR723
00139      OPEN OUTPUT EXPORT-FILE.                                     DTSBR723
00140      MOVE '723' TO R991-MOD.                                      DTSBR723
00141      MOVE 'TPS DESK' TO R991-ROUTE1.                                 CL**3
00142      MOVE 'ENFORCEMENT UNIT    ' TO R991-ROUTE2.                     CL*17
00143      MOVE 'EXPERIENCE RATING UNIVERSE RECORDS'                    DTSBR723
00144         TO R991-DATA-TYPE.                                        DTSBR723
00145      MOVE 'RECORDS' TO R991-UNIT-DSCR.                            DTSBR723
00146      MOVE +0 TO R991-UNIT-COUNT.                                  DTSBR723
00147      SKIP1                                                        DTSBR723
00148      ACCEPT L001-FED-6-DATE-9 FROM DATE.                          DTSBR723
00149      SET L001-FROM-FED-6 TO TRUE.                                 DTSBR723
00150      PERFORM S001-DATE THRU S001-EXIT.                            DTSBR723
00151      MOVE L001-FED-8-DATE-9 TO WS-DATE-CREATED.                   DTSBR723
00152      SKIP2                                                        DTSBR723
00153  I1000-EXIT.                                                      DTSBR723
00154      EXIT.                                                        DTSBR723
00155      EJECT                                                        DTSBR723
00156  P1000-PROCESS.                                                   DTSBR723
00157      SKIP1                                                        DTSBR723
00158      MOVE R723-EFF-YRQ TO WS-EFF-YRQ L055-EFF-YRQ.                   CL**4
00159      PERFORM S055-FROM-EFF-YRQ THRU S055-EXIT.                       CL**4
00160      PERFORM P1010-SET-WAGES THRU P1010-EXIT                         CL**4
00161              VARYING  R723-WAGES-IDX FROM 1 BY 1                     CL**4
00162              UNTIL  R723-WAGES-IDX GREATER 3.                        CL**4
00163                                                                      CL**4
00164      MOVE R723-EMP-NO TO WS-EMP-NO.                               DTSBR723
00165      MOVE R723-PRIMARY-NAME TO WS-PRIMARY-NAME.                      CL**2
00166      MOVE R723-AVG-TAX-WAGE  TO  WS-AVG-TAX-WAGE                     CL*16
00167      MOVE R723-COMPUTED-RATE TO WS-COMPUTED-RATE.                 DTSBR723
00168      MOVE R723-PENALTY-RATE  TO WS-PENALTY-RATE.                     CL*13
00169      MOVE R723-UI-TAX-PAID-AMT  TO  WS-UI-PAID.                      CL*13
00170      MOVE R723-BENEFITS-CHARGED-AMT                                  CL*13
00171                                 TO  WS-BEN-CHARGED.                  CL*13
00172      MOVE R723-CURRENT-RESERVE-AMT TO WS-RESERVE.                    CL**9
00173      MOVE R723-RESERVE-RATIO TO WS-RESERVE-RATIO.                 DTSBR723
00174      ADD +1 TO R991-UNIT-COUNT.                                   DTSBR723
00175      WRITE EXPORT-REC FROM WS-EXPORT-REC.                         DTSBR723
00176      IF FILE-OK-88                                                DTSBR723
00177          NEXT SENTENCE                                            DTSBR723
00178      ELSE                                                         DTSBR723
00179          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBR723
00180      SKIP2                                                        DTSBR723
00181  P1000-EXIT.                                                      DTSBR723
00182      EXIT.                                                        DTSBR723
00183      EJECT                                                        DTSBR723
00184  P1010-SET-WAGES.                                                    CL**3
00185      SET L055-WAGES-IDX TO R723-WAGES-IDX.                           CL*14
00186      EVALUATE TRUE                                                   CL**7
00187      WHEN  R723-WAGES-IDX = 1                                        CL**4
00188          MOVE R723-TAX-WAGE (R723-WAGES-IDX) TO                      CL**4
00189                                       WS-TAX-WAGE-YEAR-1             CL**6
00190          MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) TO WS-YEAR-1      CL**5
00191          DISPLAY 'YEAR 1 ' WS-YEAR-1                                 CL**8
00192      WHEN  R723-WAGES-IDX = 2                                        CL**5
00193          MOVE R723-TAX-WAGE (R723-WAGES-IDX) TO                      CL**5
00194                                       WS-TAX-WAGE-YEAR-2             CL**6
00195          MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) TO WS-YEAR-2      CL**5
00196          DISPLAY 'YEAR 2 ' WS-YEAR-2                                 CL**8
00197      WHEN  R723-WAGES-IDX = 3                                        CL**5
00198          MOVE R723-TAX-WAGE (R723-WAGES-IDX) TO                      CL**5
00199                                       WS-TAX-WAGE-YEAR-3             CL**6
00200          MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) TO WS-YEAR-3      CL**5
00201          DISPLAY 'YEAR 3 ' WS-YEAR-3                                 CL**8
00202      END-EVALUATE.                                                   CL*11
00203  P1010-EXIT.                                                         CL**3
00204      EXIT.                                                           CL**3
00205  T1000-TERMINATE.                                                 DTSBR723
00206      SKIP1                                                        DTSBR723
00207      IF R991-UNIT-COUNT = +0                                      DTSBR723
00208          MOVE SPACES TO R991-DATASET-NAME.                           CL**3
00209      PERFORM R991-EXPORT-CONTROL-REPORT THRU R991-EXIT.           DTSBR723
00210      CLOSE EXPORT-FILE.                                           DTSBR723
00211      SKIP2                                                        DTSBR723
00212  T1000-EXIT.                                                      DTSBR723
00213      EXIT.                                                        DTSBR723
00214      EJECT                                                        DTSBR723
00215  R991-EXPORT-CONTROL-REPORT.                                      DTSBR723
00216      SKIP1                                                        DTSBR723
00217      CALL 'DTSBR991' USING LRCM-LINK-AREA                            CL**2
00218                            R991-REC.                              DTSBR723
00219      SKIP2                                                        DTSBR723
00220  R991-EXIT.                                                       DTSBR723
00221      EXIT.                                                        DTSBR723
00222      SKIP3                                                        DTSBR723
00223  S001-DATE.                                                       DTSBR723
00224      SKIP1                                                        DTSBR723
00225      CALL 'DTSBU001' USING L001-LINK-AREA.                           CL**2
00226      SKIP2                                                        DTSBR723
00227  S001-EXIT.                                                       DTSBR723
00228      EXIT.                                                        DTSBR723
00229      SKIP3                                                        DTSBR723
00230  S055-FROM-EFF-YRQ.                                                  CL**4
00231      SET L055-FROM-EFF-YRQ-88 TO TRUE.                               CL**4
00232      GO TO S055-EXP-PERIOD.                                          CL**4
00233                                                                      CL**4
00234  S055-EXP-PERIOD.                                                    CL**4
00235      CALL 'DTSBU055' USING L055-LINK-AREA.                           CL**4
00236  S055-EXIT.                                                          CL**4
00237      EXIT.                                                           CL**4
00238      SKIP3                                                           CL**4
00239  S999-ABEND.                                                      DTSBR723
00240      SKIP1                                                        DTSBR723
00241      CALL 'DTSBU999' USING WRK-ABEND-CD.                             CL**2
00242      SKIP2                                                        DTSBR723
00243  S999-EXIT.                                                       DTSBR723
00244      EXIT.                                                        DTSBR723
